#!/usr/bin/perl -T

# tinymail.pl: a tiny webmail script for mobile devices (e.g. cellphone)
# features: pagination of output, gzip compression, minimalist screen footprint

# see rfc3501.txt for IMAP syntax

# Andrew Daviel TRIUMF Jun 2007
# released under Apache Licence 2.0 http://www.apache.org/licenses/LICENSE-2.0

# version 0.2

$domain = 'example.com' ; 
$method = $ENV{'REQUEST_METHOD'} ;
$path = $ENV{'PATH_INFO'} ;
$agent = $ENV{'HTTP_USER_AGENT'} ;
$content_type = $ENV{'CONTENT_TYPE'} ;
$content_length = $ENV{'CONTENT_LENGTH'} ;
$cookie = $ENV{'HTTP_COOKIE'} ;
$query = $ENV{'QUERY_STRING'} ;
$referer = $ENV{'HTTP_REFERER'};
$len = $ENV{'CONTENT_LENGTH'};
$script = $ENV{'SCRIPT_NAME'};
$auth = $ENV{'AUTH_TYPE'} ;
$SSL = $ENV{'HTTPS'} ;
if ($ENV{'REMOTE_USER'} =~ /^([\w\-]+)$/) {
  $user = $1 ; # untaint
   my ($name,$passwd,$uid,$gid, $quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam ($user) ;
  chdir ($dir) ;
} else {
  $user = 'nobody'; 
}
$debug = 0 ; 
$ENV{'PATH'} = "/usr/local/sbin:/usr/sbin:/bin:/usr/local/bin:" ;
$gzip = ($ENV{'HTTP_ACCEPT_ENCODING'} =~ /gzip/) ;
$gzip = 1 ;

#$| = 1 ;

# lengths to trim index fields to:
$nowidth = 4 ;
$flagwidth = 2 ;
$fromwidth = 15 ;
$datewidth = 8;
$subjwidth = 25 ;
$soft = 50 ; $hard = 80 ;
$ppage0 = 20 ; # default lines per page
$format = '%'.$nowidth.'d ' ;
$format .= '%'.$flagwidth.'.'.$flagwidth.'s ' ;
$format .= '%-'.$fromwidth.'.'.$fromwidth.'s ' ;
$format .= '%-'.$datewidth.'.'.$datewidth.'s ' ;
$format .= '%-'.$subjwidth.'.'.$subjwidth."s\n" ;
$spaces = '                          ' ;


if ($method eq 'POST') {
  read(STDIN, $buffer, $len) ;
} elsif ($method eq 'GET') {
  $buffer = $query ;
}
foreach $pair (split(/&/, $buffer)) {
  $pair =~ tr/+/ /;
  $pair =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  ($name, $value) = split(/=/, $pair);
  $F{$name} = $value ;
}

$debug = $F{'debug'} ;
$table = $F{'table'} ;
$ppage = $F{'ppage'} ; unless ($ppage) { $ppage = $ppage0 ; }
$msg = $F{'msg'} ; $op = $F{'op'} ;
$part = $F{'part'} ; $type = $F{'type'} ; 
$start=$F{'start'} ; $code = $F{'code'} ;
if ($F{'submit'} eq 'Prev' or $F{'submit'} eq 'Back') { $start = $F{'prev'} ; }
$mailbox = $F{'mailbox'} ;
if ($F{'to'} =~ /^([\w\-\.]+\@[\w\-\.]+)$/ or $F{'to'} =~ /<([\w\-\.]+\@[\w\-\.]+)>/) { $recip = $1 ; }

use IPC::Open2;
$SIG{'TERM'} = "clean" ;
$SIG{'INT'} = "clean" ;


unless ($mailbox) { $mailbox = 'INBOX' ; }

if ($op eq 'Read' and $type and $msg and $part) {
  if ($type =~ /^image/i or !$gzip) {
    print "Content-Type: $type\nVary: Accept-Encoding\n\n" ;
  } else {
    print "Content-Type: $type\nContent-Encoding: x-gzip\nVary: Accept-Encoding\n\n" ;
  }
$| = 1 ;
print STDERR "Content-Type: $type msg $msg part $part\n" ;
  $pid = open2(\*RDRFH, \*WTRFH, "imapd") ; $seq = 0 ;
  &send("SELECT $mailbox") ;
  &rdselect ;
  &send("FETCH $msg BODY[$part]") ; $body = '' ;
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_<br>\n" ; &logout ; }
    if (/^\* [\d]+ FETCH/) { next ; }
    if (/^\)$/) { next ; }
    if ($type =~ /text.html/i) {
      s/<script/<\$cript/ig ;  # defang JS
      s/javascript:/java\$cript:/ig ;
    }
    $body .= "$_\n" ;
  }
  &logout ;
}

if ($gzip) {
  print "Content-Type: text/html; charset=iso-8859-1\nContent-Encoding: x-gzip\nVary: Accept-Encoding\n\n" ;
} else {
  print "Content-Type: text/html; charset=iso-8859-1\nVary: Accept-Encoding\n\n" ;
}

$body=<<EOT;
<title>TinyMail for $user</title>
EOT
if ($mailbox) { 
  $body.= "<h3>$user: $mailbox</h3>\n" ;
} else {
  $body.= "<h2>TinyMail for $user</h2>\n" ;
}
if ($debug>1) {
  foreach $v (keys %F) {
    $body.="$v=$F{$v}<br>\n" ;
  }
}
$body.=<<EOT;
<form action=$script>
<input type=submit name=op value=New>
<input type=submit name=op value=Fldrs>
EOT
unless ($op eq 'Folders' or $op eq 'Fldrs') {
  $body.=<<EOT;
<input type=hidden name=mailbox value=\"$mailbox\">
<input type=submit name=op value=Index>
EOT
#from<input type=text size=3 name=start>
}
if ($op eq 'Index') {
  $body .= "<input type=submit name=op value=Xpung>\n" ;
}
if ($op eq 'Read') {
  $body .= "<input type=hidden name=msg value=$msg>\n" ;
  $body .= "<input type=submit name=op value=Reply>\n" ;
  $body .= "<input type=submit name=op value=Del>\n" ;
}
$body .= "</form>\n" ;
if ($debug) { $body .= "Format \"$format\"<br>\n" ; }
$pid = open2(\*RDRFH, \*WTRFH, "imapd") ; $seq = 0 ;
if ($op eq 'Folders' or $op eq 'Fldrs') {
  $body .= "Folder: $maiilbox<br>\n" ;
  &send("FIND MAILBOXES *") ;
  &rdlist ;
} elsif ($op eq 'Read') {
  unless ($start) { $start = 1 ; }
  if ($F{'submit'} eq 'Prev') { $msg-- ; }
  if ($F{'submit'} eq 'Next') { $msg++ ; }
  &send("SELECT $mailbox") ;
  &rdselect ;
  if ($msg>0) {
    &send("FETCH $msg BODY[HEADER.FIELDS (Date From Subject To)]") ;
    &rdhead ;
    $body .= "F: $from0<br>\nD: $date0<br>\nS: $subject0<br>\nT: $to0<br>\n" ;
#    unless ($part) {
      &send("FETCH $msg BODYSTRUCTURE") ;
      &rdbs ;
#    } 
    unless ($part) { $part = $part1 ; } # from doblock
    unless ($part) { $part = 1 ; } # no MIME
    &send("FETCH $msg BODY[$part]") ;
    &rdbody($part) ;

    $back = $msg-1 ; $fwd = $msg+1 ;
    $body.=<<EOT;
<form action=$script>
<input type=hidden name=mailbox value=\"$mailbox\">
<input type=hidden name=op value=Read>
<input type=hidden name=msg value=$msg>
EOT
    if ($back>=1) { $body.= "<input type=submit name=submit value=Prev>\n" ; }
    if ($fwd<=$exists) { $body.= "<input type=submit name=submit value=Next>\n" ; }
    $body.= "</form>\n" ;
  } else {
    $body .= "No msg $msg\n" ;
  }
} elsif ($op eq 'New') {
  $body.=<<EOT;
<form action=$script method=POST>
T:<input type=text name=to><br>
S:<input type=text name=subject><br>
<textarea name=data rows=8 cols=30></textarea>
<br><input type=submit name=op value=Send>
</form>
EOT
  &logout ;
} elsif ($op eq 'Reply') {
  &send("SELECT $mailbox") ;
  &rdselect ;
  &send("FETCH $msg BODY.PEEK[HEADER.FIELDS (Date From Subject To)]") ;
  &rdhead ;
  $body.=<<EOT;
<form action=$script method=POST>
T:<input type=text name=to value=\"$from0\"><br>
S:<input type=text name=subject value=\"Re. $subject0\"><br>
<textarea name=data rows=8 cols=30></textarea>
<input type=hidden name=msg value=$msg>
<input type=hidden name=mailbox value=\"$mailbox\">
<br><input type=submit name=op value=Send>
</form>
EOT
  &logout ;
} elsif ($op eq 'Send') {
  &mailto;
  $body.="Sent message to $recip<br>\n" ;
  $body.="From $fquser<br>\n" ;
#  $body.="UID $< EUID $><br>\n" ;
  if ($msg) {
    &send("SELECT $mailbox") ;
    &rdselect ;
    &send("STORE $msg +Flags (\\ANSWERED)") ;
    &rdloop ;
    &logout ;
  }
  &logout ;
} elsif ($op eq 'Del') {
  &send("SELECT $mailbox") ;
  &rdselect ;
  &send("STORE $msg +Flags (\\DELETED)") ;
  &rddel ;
  $body.="Deleted msg. $msg<br>\n" ;
  &logout ;
} elsif ($op eq 'Xpung') {
  &send("SELECT $mailbox") ;
  &rdselect ;
  &send("EXPUNGE") ;
  &rdxpung ;
  $body.=" from $mailbox<br>\n" ;
  &logout ;
} elsif ($op eq 'Index') {
  &send("SELECT $mailbox") ;
  &rdselect ;
  $body .= "$mailbox $exists msgs $recent rcnt<br>\n" ;
  unless ($start) { $start = $msg ; } # if just reading a message
  unless ($start) {
    $start = $exists - $ppage ;
    if ($recent > $ppage) { $start = $exists - $recent ; }
  }
  if ($start<1) { $start = 1 ; }
  $prev = $start - $ppage ;  if ($prev<1) { $prev = 1 ; }
  $next = $start + $ppage ;
  unless ($exists) { &logout ; }
  if ($next < $exists and 0) {
    $body .=<<EOT;
<form action=$script>
<input type=hidden name=mailbox value=\"$mailbox\">
<input type=hidden name=start value=$next>
<input type=hidden name=op value=Index>
<input type=submit name=submit value=Next>
</form>
EOT
  }
  if ($table) {
    $body .= "<table>\n<tr><th>No</th><th>S</th><th>From</th><th>Date</th><th>Subject</th></tr>\n" ;
  } else {
    $body .= "<pre><b>\n" ;
    $body .= sprintf($format,0,'S','From','Date','Subject') ;
    $body .= "</b>" ;
  }
  for ($i=$start;$i<=($start+$ppage);$i++) {
    if ($i>$exists) { last ; }
    if ($debug) { $body .= "$i\n" ; }
    $flags = '' ; 
    &send("FETCH $i BODY.PEEK[HEADER.FIELDS (Date From Subject To)]") ;
    &rdhead ;
#    &send("FETCH $i RFC822.SIZE") ;  # size
    &send("FETCH $i FLAGS") ; 
    &rdflags ;
    $flags = substr($flags.$spaces,0,$flagwidth) ;

    if ($table) {
      $body .= "<tr><td>$i</td><td>$flags</td><td>$from</td><td>$date</td><td>$subject</td></tr>\n" ;
    } else {
      $hfrom = "<a href=\"$script?msg=$i\&op=Read\&mailbox=$mailbox\">$from</a>" ;
      #printf($format,$i,$flags,$from,$date,$subject) ;
      $body .= sprintf("%4d %s %s %s %s\n",$i,$flags,$hfrom,$date,$subject) ;
      #print "$i $flags $from $date $subject\n" ;
    }
  }
  if ($table) {
    $body .= "</table>\n" ;
  } else {
    $body .= "</pre>\n" ;
  }
  $body .=<<EOT;
<form action=$script>
<input type=hidden name=mailbox value=\"$mailbox\">
<input type=hidden name=start value=$next>
<input type=hidden name=prev value=$prev>
<input type=hidden name=op value=Index>
EOT
  if ($prev > 0)  { $body .= "<input type=submit name=submit value=Prev>\n" ; }
  if ($next <= $exists) { $body .= "<input type=submit name=submit value=Next>\n" ; }
  $body .= "</form>\n" ;
} # op

&logout ;

&send("FETCH 2 BODY.PEEK[HEADER.FIELDS (Date From Subject To)]") ;
&rdloop ;
&send("FETCH 2 RFC822.SIZE") ;  # size
&rdloop ;
&send("FETCH 2 BODY[1]") ; # first part, usually text
&rdloop ;
# 1 fetch 3 flags
# * 3 FETCH (FLAGS (\Seen NonJunk))

sub send {
  my $msg = shift(@_) ;
  $seq++ ; 
  print WTRFH "$seq $msg\n" ; 
  if ($debug) { $body .= "Send $seq $msg\n" ; }
}

sub clean {
  print STDERR "$0 - caught a SIG@_\n";
  kill (15,$pid) ;
  waitpid ($pid, 0) ;
  &exitr ;
}

sub logout {
  &send("LOGOUT") ;
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) { $body .= "$_<br>\n" ; }
    if (/^$seq OK.*LOGOUT completed/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "$_<br>\n" ; &exitr ; }
  }
  waitpid ($pid, 0) ;
  &exitr ;
}
sub exitr {
  if ($code eq 'QUOTED-PRINTABLE') {
    $body =~ s/=\n//g;
    $body =~ s/=([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  }
  if ($type =~ /^image/i or !$gzip) {
    if ($code eq 'BASE64') {
      open (OUT,"|mmencode -u") ;
      print OUT $body ;
      close (OUT) ;
    } else {
      print $body ;
    }
  } else {
    if ($code eq 'BASE64') {
      open (OUT,"|mmencode -u|gzip") ;
    } else {
      open (OUT,"|gzip") ;
    }
    print OUT $body ;
    close (OUT) ;
  }
  exit ;
}
sub rdloop {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    $body .= "$_<br>\n" ;
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_<br>\n" ; &logout ; }
  }
}


sub rdlist {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) { $body .= "$_<br>\n" ; }
    if (/\* MAILBOX (.*)/) {
      $mailbox = $1 ;
      $body .= "<a href=\"$script?op=Index&mailbox=$mailbox\">$mailbox</a><br>\n" ;
    }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_\n" ; &logout ; }
  }
}

sub rdhead {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) {$body .= "$_<br>\n" ; }
    if (/^From:[\s]+(.*)/i) { $from = $from0 = $1 ; }
    if (/^To:[\s]+(.*)/i) { $to = $to0 = $1 ; }
    if (/^Subject:[\s]+(.*)/i) { $subject = $subject0 = $1 ; }
    if (/^Date:[\s]+(.*)/i) { $date = $date0 = $1 ; }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_\n" ; &logout ; }
  }
  $date =~ s/[\s]+[\d]{4}.*// ; # strip year, time
  $date =~ tr/ ,//d ; # strip space
  unless ($from =~ /^</) { $from =~ s/<.*// ; }
  $from =~ tr/"><//d;
  $from =~ s/^[\s]+// ; $from =~ s/[\s]+$// ;
  $from = substr($from.$spaces,0,$fromwidth) ;
  $from = &escape($from) ; $from0 = &escape($from0) ;
  $date =  substr($date.$spaces,0,$datewidth) ;
  $subject =~ tr/"><//d;
  $subject =~ s/^[\s]+// ; $subject =~ s/[\s]+$// ; # strip leading, trailing spaces
  if ($subject =~ /\[SPAM\][\s]+(.*)/) {
    $subject = $1 ; $flags .= 'J' ;
  }
  if ($subject =~ /^SPAM [\d\.]+:[\s]+(.*)/) {
    $subject = $1 ; $flags .= 'J' ;
  }
  if ($subject =~ /^[\d\.]+\/[\d\.]+:[\s]+(.*)/) {
    $subject = $1 ; $flags .= 'J' ;  # spam
  }

  $subject = substr($subject.$spaces,0,$subjwidth) ;
  $subject = &escape($subject) ; $subject0 = &escape($subject0) ;
  $to0 =  &escape($to0) ;
}

sub escape {
  local $_ = shift(@_) ;
  s/&/&amp;/g ;
  s/</&lt;/g ;
  s/>/&gt;/g ;
  s/"/&quot;/g ;
  return $_ ;
}

sub rdflags {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) {$body .= "$_<br>\n" ; }
    if (/^\*[\s]+[\d]+[\s]+FETCH[\s]+\(FLAGS[\s]+\((.*)\)/) {
      my $F = $1 ;
      if ($F =~ /Junk/) { $flags .= 'J' ; }
      if ($F =~ /Answered/) { $flags .= 'A' ; }
      if ($F =~ /Flagged/) { $flags .= '*' ; }
      if ($F =~ /Deleted/) { $flags .= 'D' ; }
      unless ($F =~ /Seen/) { $flags .= 'N' ; }
    }
    if ($debug) { $body .= "Flags: $flags<br>\n" ; }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "</table>Error: $_\n" ; &logout ; }
  }
}
sub rdselect {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if (/\*[\s]+([\d]+)[\s]+EXISTS/) {
      $exists = $1 ;
    } elsif (/\*[\s]+([\d]+)[\s]+RECENT/) {
      $recent = $1 ;
    } else {
      if ($debug) { $body .= "$_\n" ; }
    }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_\n" ; &logout ; }
  }
}
sub rdbody {
  my $part = shift ;
  my $bsize = 0 ; my $out = '' ; my $size = 0 ; my $n = 0 ;
  my $html = 0 ;
  $body .= "<pre>" ; $body2 = '' ;
  while (<RDRFH>) {
    if ($bsize) { $size += length ; }
    chomp ; tr/\r//d ;
    if ($debug) { $body2 .= "$n $_<br>\n" ; }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_<br>\n" ; &logout ; }
    if (/^\* [\d]+ FETCH.*{([\d]+)}/) {
      $bsize = $1 ;
      next ;
    }
    if (/^\* [\d]+ FETCH/) { next ; }
    if ($_ eq ')') { next ; }
    if (/<html>/i or /<title>/i) {
      $html = 1 ;
      $body2 .= "</pre>\n" ;
    }
    $n++ ;
    if ($n >= $start and $n < ($start + $ppage)) {
      s/<script/<\$cript/ig ;  # defang JS
      s/javascript:/java\$cript:/ig ;
      # wtai dialler handling
      if (/\+[\d][\s\.\-][\d]{3}-[\d]{3}-[\d]{4}/) {
	s%\+([\d])([\s\.\-])([\d]{3})([\s\.\-])([\d]{3})([\s\.\-])([\d]{4})%<a href=wtai://wp/mc;$1$3$5$7>+$1$2$3$4$5$6$7</a>% ;
      } elsif (/[\d]{3}[\s\.\-][\d]{3}[\s\.\-][\d]{4}/) {
	s%([\d]{3})([\s\.\-])([\d]{3})([\s\.\-])([\d]{4})%<a href=wtai://wp/mc;$1$3$5>$1$2$3$4$5</a>% ;
      } elsif (/\([\d]{3}\)[\s\.\-][\d]{3}[\s\.\-][\d]{4}/) {
	s%\(([\d]{3})\)([\s\.\-])([\d]{3})([\s\.\-])([\d]{4})%<a href=wtai://wp/mc;$1$3$5>($1)$2$3$4$5</a>% ;
      }

      if ($code{$part} eq 'QUOTED-PRINTABLE') {
        if (/=$/) {
          s/=$// ;
          s/=([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
          $body2 .= $_ ;
        } else {
          s/=([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
          $body2 .= "$_\n" ;
        }
      } else {
        $body2 .= "$_\n" ;
      }
    }
  }
  unless ($html) { $body2 = &wrap($body2) ; }
  $body .= $body2 ;
  if ($debug) { $body .= "Body size: $size/$bsize<br>\n" ; }
#  if ($n >= ($start + $ppage)) {
   if ($n > $ppage) {
    $next = $start + $ppage ;
    if ($start>1) { $prev = $start - $ppage ; }
    if ($prev < 1) { $prev = 1 ; }
    unless ($html) { $body .= "</pre>\n" ; }
    $body .=<<EOT;
<form action=$script>
<input type=hidden name=mailbox value=\"$mailbox\">
<input type=hidden name=start value=$next>
<input type=hidden name=prev value=$prev>
<input type=hidden name=op value=Read>
<input type=hidden name=msg value=$msg>
EOT
    if ($part ne '') { $body .= "<input type=hidden name=part value=$part>\n" ; }
    if ($prev > 0)  { $body .= "<input type=submit name=submit value=Back>\n" ; }
    $body .= "<input type=submit name=submit value=More>\n" ;
    $body .= "</form>\n" ;
    $html = 1 ;
  }
  unless ($html) { $body .= "</pre>\n" ; }
  $body .= "<hr><a href=http://tiny.triumf.ca/tinymail.var>About</a>\n" ;
}
sub mailto {
  unless ($recip) {
    $body .= "Error; bad recipient\n" ;
    return ;
  }
  $fquser = $user . '@' . $domain ;
  unless (open(MAIL, "|sendmail -f $fquser $recip $user") ) {
    $body .= "Error; mail not sent\n" ;
    print STDERR "$0 error opening mailprog\n" ;
    &exitr ;  # not &logout since not logged in to IMAP
  }
  print MAIL<<EOT;
Subject: $F{'subject'}
From: $fquser
To: $F{'to'}
X-Mailer: Tinymail

$F{'data'}
EOT
  close(MAIL) ;
}

sub rddel {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) { $body .= "$_<br>\n" ; }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_<br>\n" ; &logout ; }
  }
}
sub rdxpung {
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) { $body .= "$_<br>\n" ; }
    if (/^$seq OK (.*)/) {
      $body .= "$1\n" ;
      last ;
    }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_<br>\n" ; &logout ; }
  }
}


sub rdbs {
  my $bsize = 0 ; my $out = '' ; my $size = 0 ; my $n = 0 ;
  my $html = 0 ;
  while (<RDRFH>) {
    chomp ; tr/\r//d ;
    if ($debug) { $body .= "$n $_<br>\n" ; }
    if (/^$seq OK/) { last ; }
    if (/^[\d]+ NO/ or /^[\d]+ BAD/) { $body .= "Error: $_<br>\n" ; &logout ; }
    unless (/^\* [\d]+ FETCH .BODYSTRUCTURE/) { next ; }
    &dobs($_) ;
  }
}

sub dobs {
  my $L = shift ;
  my $quoted = 0 ; my @block ; my $level = 0 ; my %block ; my $string = '' ;
  my @F ;
  foreach $c (split(//,$L)) {
    $string .= $c ;
    if ($c eq '"') { $quoted ^= 1 ; }
    if ($c eq '(' and !$quoted) {
      $level++ ;
      $block[$level]++ ;
    } elsif ($c eq ')' and !$quoted) {
      $level-- ;
    } elsif ($level) {
      $block = join('.',@block[1..$level]) ;
      $block{$block} .= $c ;
    }
  }
  if ($debug) {
    foreach $block (keys %block) {
      print "Block $block: $block{$block}\n" ;
      $block{$block} =~ tr/ / /s ;
      #$block{$block} =~ tr/"//d ;
      @F = &qsplit(' ',$block{$block}) ;
      if ($block eq '1') { next ; }
      $F[0] =~ tr/"//d ; $F[1] =~  tr/"//d ;
      if ($F[0] eq 'BOUNDARY') { next ; }
      if ($F[0] eq 'TEXT') {
	$body .= "  Block $block: $F[0]/$F[1] coding $F[4] $F[5] bytes $F[6] lines<br>\n" ;
      } else {
	$body .= "  Block $block: $F[0]/$F[1] coding $F[4] $F[5] bytes desc $F[3]<br>\n" ;
      }
    }
  }

  if ($block{'1.1'} =~ /^[\s]*.(MIXED)/ or $block{'1.1'} =~ /^[\s]*.(ALTERNATIVE)/) {
    $body .= "$1<br>\n" ;
    if ($block{'1.1.1'} =~ /^[\s]*.(MIXED)/ or $block{'1.1.1'} =~ /^[\s]*.(ALTERNATIVE)/) {
      $body .= "$1<br>\n" ;
      for ($b=1;$b<10;$b++) {
        $block = $block{"1.1.1.$b"} ;
        unless ($block) { last ; }
        if ($block =~ /^[\s]*.BOUNDARY/) { next ; }
        &doblock($block,"1.$b") ;  $block =~ tr/ / /s ;
        @F = &qsplit(' ',$block) ; $F[4] =~ tr/"//d ;
        $code{"1.$b"} = $F[4] ;
      }
      for ($b=2;$b<10;$b++) {
        $block = $block{"1.1.$b"} ;
        unless ($block) { last ; }
        if ($block =~ /^[\s]*.BOUNDARY/) { next ; }
        &doblock($block,$b) ; $block =~ tr/ / /s ;
        @F = &qsplit(' ',$block) ; $F[4] =~ tr/"//d ;
        $code{$b} = $F[4] ;
      }
    } else {
      for ($b=1;$b<10;$b++) {
        $block = $block{"1.1.$b"} ;
        unless ($block) { last ; }
        if ($block =~ /^[\s]*.BOUNDARY/) { next ; }
        &doblock($block,$b) ; $block =~ tr/ / /s ;
        @F = &qsplit(' ',$block) ;  $F[4] =~ tr/"//d ;
        $code{$b} = $F[4] ;
      }
    }
  } else {
    $block = $block{'1.1'} ;
    &doblock($block,1) ; $block =~ tr/ / /s ;
    @F = &qsplit(' ',$block) ;  $F[4] =~ tr/"//d ;
    $code{1} = $F[4] ;
  }

}

# 1.1 text plain - normal = body[1]
# 1.1 alternative - 1.1.1 = body[1], 1.1.2 = body[2]
# 1.1 mixed - 1.1.1 = body[1], 1.1.2 = body[2]
# 1.1 mixed - 1.1.1 alternative 1.1.2 = body[2] = gif, 1.1.1.1 = body[1.1], 1.1.1.2 = body[1.2]
sub qsplit {
  my $c = shift ; my $C ; my $i = 0 ;
  my $s = shift ; my $quoted = 0 ; my @s ;
  foreach $C (split(//,$s)) {
    if ($C eq '"') { $quoted ^= 1 ; }
    if (!$quoted and $C eq $c) { $i++ ; next ; }
    $s[$i] .= $C ;
  }
  return @s ;
}
sub doblock {
  my $block = shift ; my $n = shift ;
  unless ($part1) { $part1 = $n ; }
  $block =~ tr/ / /s ;
  my @F = &qsplit(' ',$block) ; $F[0] =~ tr/"//d ; $F[1] =~  tr/"//d ;  $F[4] =~  tr/"//d ;

  if ($debug) { $body .= "doblock $block<br>\n" ; }

  if ($F[0] eq 'TEXT') {
 #   $body .= "BODY[$n] <a href=\"$script?msg=$msg\&op=Read\&mailbox=$mailbox\&part=$n\">$F[0]/$F[1]</a> coding $F[4] $F[5] bytes $F[6] lines<br>\n" ;
    if ($n ne '1') { $body .= "<a href=\"$script?msg=$msg\&op=Read\&mailbox=$mailbox\&part=$n\&type=$F[0]%2f$F[1]\&code=$F[4]\">$F[0]/$F[1]</a>  $F[5]B $F[6]L<br>\n" ; }
  } else {
 #   $body .= "BODY[$n] <a href=\"$script?msg=$msg\&op=Read\&mailbox=$mailbox\&part=$n\">$F[0]/$F[1]</a> coding $F[4] $F[5] bytes desc $F[3]<br>\n" ;
    $body .= "<a href=\"$script?msg=$msg\&op=Read\&mailbox=$mailbox\&part=$n\&type=$F[0]%2f$F[1]\&code=$F[4]\">$F[0]/$F[1]</a> $F[5]B $F[3]<br>\n" ;
  }
}

sub wrap {
  #my @text = split(//,shift) ;
  my $text ; my $n = 0 ;
  foreach $c (split(//,shift)) {
    if ($c eq "\n") { $n = 0 ; }
    if ($c eq ' ' and $n > $soft) {
      $text .= "\n" ;
      $n = 0 ;
      next ;
    }
    if ($n > $hard) {
      $text .= "\n" ;
      $n = 0 ;
    }
    $text .= $c ; $n++ ;
  }
  return $text ;
}