# $Header: /u/ra/raines/src/tk/tkmail2/maildb.pl,v 1.3 1995/06/28 17:30:40 raines Exp $
#####################################################################
# Mail Server by Paul Raines, SLAC
#
# hacked from a script by
#                Francois Allard, Carleton University, Math dept.
#                    '
#####################################################################

# name and home directory of user
$whoami = (getpwuid($<))[0];
$homedir = (getpwuid($<))[7];

# holds explanation of last error
$lasterror = "";

# signal for end of stdin reading for wish process
$signalend = "#.\004.END.\004.";
$signalmime = "#.\004.MIME.\004.";
$signalmimeend = "#.\004.MIMEEND.\004.";
$signalexfile = "#.\004.EXFILE.\004.";

# file to serve as main mailbox
$options{"mail-mbox"} = "mbox";
$mbox = <~/mbox>;

# command to pipe message too for mailing
$options{"mail-deliver"} = "sendmail";
$sendmail = "/usr/lib/sendmail -bm -t";

# temporary directory to use
$options{"mail-tmpdir"} = "tmpdir";
$tmpdir = "/usr/tmp";

# remove empty folders
$options{"mail-remove-empty"} = "delempty";
$delempty = 1;

# whether to parse mime messages
$options{"mime-parse"} = "parsemime";
$parsemime = 1;

# list of desired headers for displaying
$options{"header-retain"} = "hdrview";
@hdrview = ("From", "Date", "Subject", "To", "Cc", "Message-Id");

# list of desired headers for stripping
$options{"header-strip"} = "hdrhide";
@hdrhide = ();

# format codes supported for summaries
$options{"headlist-format"} = "sumformat";
$sumformat = "%-20.20F  %3m %2d %5h %4l  %-45.45s";
$formatcode{"d"} = "sm-mday";
$formatcode{"h"} = "sm-hour";
$formatcode{"m"} = "sm-month";
$formatcode{"w"} = "sm-wday";
$formatcode{"y"} = "sm-year";
$formatcode{"D"} = "date";
$formatcode{"f"} = "sm-from";
$formatcode{"F"} = "fullname";
$formatcode{"i"} = "message-id";
$formatcode{"s"} = "subject";
$formatcode{"c"} = "mesg-chars";
$formatcode{"l"} = "mesg-lines";

@formatnumeric = ("sm-mday", "sm-year", "mesg-chars", 
		  "mesg-lines", "time-received", "time-sent");
$formatnumeric = "dycl";

# start of unique names for file descriptors
# each folder will have an associative array %mesg_$fid to hold
# per message info using as a key $mesg_num,$whatever. For example,
# if $fid held the value A005 and $mesg_num held 12, then
#    local(*messages) = "mesg_$fid";
#    print %messages{$mesg_num,"mesg-lines"};
# would print the number of lines in message 12 in folder A005
%mesgfields = ("sm-from", 1, "sm-date", 1, "mesg-chars", 1,
	       "mesg-lines", 1, "sm-wday", 1, "sm-month", 1,
	       "sm-mday", 1, "sm-hour", 1, "sm-year", 1,
	       "status", 1, "fullname", 1);

# used for file handles
$nexthandle = 'A000';

# used for message ids
$nextmesgid = 'AA0000';

# used for tmp files
$nexttmp = 'A000';

# assoc arrays to store folder specific statistics indexed by FID
%foldernum=();			# number of messages in folder
%foldername=();			# name of folder
%folderlast=();			# last message viewed in this folder
%foldersize=();			# keep track of file size for checks
%folderdel=();			# keep track of number of mesgs deleted
%foldermrk=();			# keep track of mesgs needed to marked read
%foldermod=();			# keep track if folder modified since last backup
%folderbak=();			# name of backup file for folder
%folderfid=();			# reversed assoc array of %foldername
%folderino=();			# map dev,inode to FID
%folderprot=();			# whether folder is read only

# cleanup memory and locks for a file
sub cleanfolder {
  local($fid,$filename) = @_;
  local($dev,$ino,$stat,@fail);

  # unlock folder
  if ($stat = &unlockfid($fid,$filename)) {
    return($stat);
  }

  # remove possbile mime files
  local(*mimefiles) = "mime_$fid";
  @fail = grep(!unlink($mimefiles{$_}),keys(%mimefiles));
  if ($debug) {
    print STDERR "Could not remove ", join(" ",@fail), "\n" if @fail;
  }
  eval "undef \%mime_$fid";

  eval "undef \%mesg_$fid";
  delete $folderfid{$filename};
  delete $foldernum{$fid};
  delete $foldername{$fid};
  delete $foldersize{$fid};
  delete $folderdel{$fid};
  delete $folderlast{$fid};
  delete $folderprot{$fid};
  delete $foldermrk{$fid};
  delete $foldermod{$fid};
  delete $folderbak{$fid};
  ($dev,$ino) = stat($filename);
  delete $folderino{$dev,$ino};

  return("0");
}

# makes sure to kill wish process when doing a die
sub diesafe {
  local($warning) = @_;
  $SIG{'CHLD'} = "";
  &towish('exit');
  die $warning;
}

#check if really at beginning of new message
sub newmsg {
  local($_) = @_;
  if (m/^${gt}From +[^ ]+ +[A-Za-z]+ +[A-Za-z]+ +[ 0-9A-Za-z:+-]+\s*$/o) {
    return 1;
  }
  return 0;
}

# remove parenthetical comments from rfc822 header
sub nocomment {
  local($_) = @_;
  s/\s*\([^\)]*\)\s*//g;
  return($_);
}

# send a line to wish process making sure arguments are
# properly enclosed in {}'s
sub towish {
  local($command, @args)  = @_;
  print WISH $command;
  foreach (@args) {
    print WISH " {$_}";    
  }
  print WISH "\n";
}

# subroutines for safe I/O processing
sub ioset { $! = 0; }
sub ioerror {
  if ($! =~ m/Interrupted system call/) {
    return 1;
  } else {
    return 0;
  }
}

# safely obtain a line
sub safeio {
  local($fid) = @_;
  do {
    $! = 0; $ret = <$fid>;
  } while ($! =~ m/Interrupted system call/);
  return($ret);
}

# safely read a line
sub saferead {
  local($fid,*buf,$len) = @_;
  local($ret);
  do {
    $! = 0; $ret = read($fid,$buf,$len);
  } while ($! =~ m/Interrupted system call/);
  return($ret);
}

# safely run a command in wish interp
sub wishcmd {
  local($command)  = @_;
  print WISH "if {[catch {$command} res]} ",
    "{puts stderr \$errorInfo; puts stdout ERROR} else {puts stdout OKAY}\n";
  print WISH "flush stdout\n";
  chop($stat = &safeio("WISH"));
  if ($stat ne "OKAY") {
    print STDERR "$stat running Tcl command: $command\n" if $debug;
    return(1);
  } else { return(0); }
}

# run a command in the background returning its PID
sub runbg {
  local($cmd) = @_;
  local($pid);

  print STDERR "Running $cmd in the background\n" if $debug;
 BGFORK: {
   if ($pid = fork) {
     return($pid);
   } elsif (defined $pid) {
     exec($cmd) || die "FATAL ERROR: Can't execute $cmd\n";
   } elsif ($! =~ /No more process/) {
     sleep 5;
     redo FORK;
   } else {
     $lasterror = "Can't fork: $!\n";
     return("0");
   }
 }
}

sub lockfid {
  local($fid,$filename) = @_;
  local($stat,$retries) = ( 0, 0);

  while ($retries < 10) {
    $stat = &dolockfid($fid,$filename);
    if ($stat != $EWOULDBLOCK) { return($stat); }
    $retries++; sleep(1);
  }
  return($EWOULDBLOCK);
}

sub checkpid {
  local($pid) = @_;

  print STDERR "Checking PS for pid $pid\n";
  if (open(PS, "ps -ea |")) {
    while (<PS>) {
      if (m/^\s*$pid\s/) {
	close(PS); return(1);
      }
    }
  }
  close(PS);
  print STDERR "\tDidn't find it.\n";
  return(0);
}

# try to lock file using flock and *.lock
sub dolockfid {
  local($fid,$filename) = @_;
  local($locked,$lockfile,$stat,$lpid);

  $locked = 0;
  $lockfile = $filename . ".lock";
  if ( ! -e $lockfile) {
    $stat = open(FLOCK,"+>" . $lockfile);
  } else {
    $stat = open(FLOCK,"+<" . $lockfile);
  }
  if ($stat) {
    seek(FLOCK,0,0);
    chop($lpid = &safeio("FLOCK"));
    if ($lpid ne "") {
      if (open(PS, "ps -ea |")) {
	while (<PS>) {
	  if (m/^ *$lpid /) {
	    close(PS); close(FLOCK);
	    $lasterror = "$filename already locked by process $lpid\n";
	    return($EWOULDBLOCK);
	  }
	}
	$lasterror = "$filename appears to be already locked by another process ($lpid).\n";
	$lasterror .= "This could be another mail reader or one on a different machine over NFS.\n";
	$lasterror .= "The lockfile might have been left behind by a previous tkmail session\n";
	$lasterror .= "that exited unexpectedly. If you believe no other process is using \n";
	$lasterror .= "this folder, remove the lockfile and try again\n";
	close(FLOCK);
	return($EWOULDBLOCK);
      } else {
	close(FLOCK);
	$lasterror = "Can't open since $lockfile exists. Can't check with ps";
	return($EWOULDBLOCK);
      }
    }
    seek(FLOCK,0,0);
    print FLOCK "$$\n\n";
    truncate(FLOCK,tell(FLOCK));
    close(FLOCK) || warn "Close of $lockfile exited with $?\n";
    $locked = 1;
  } else {
    $lasterror = "$lockfile: $!";
  }
  $stat = eval("flock($fid, $LOCK_EX & $LOCK_NB)");
  if (defined($stat) && $stat == 0) {
    $locked = 1;
  } elsif (defined($stat)) {
    if ($! == $EWOULDBLOCK) {
      $lasterror = "Can't lock since $filename is already flocked";
      return($EWOULDBLOCK);
    } else {
      $lasterror = "$filename: $!";
    }
  }
  if (!$locked) {
    $lasterror = "Unable to lock $filename with flock or *.lock\n";
    return("255");
  }
  return("0");
}

# unlock file
sub unlockfid {
  local($fid,$filename) = @_;
  local($lockfile,$pid);

  $lockfile = $filename . ".lock";
  eval("flock($fid, $LOCK_UN)");
  if (-e $lockfile) {
    if (!open(FLOCK,$lockfile)) {
      $lasterror = "$lockfile: $!";
      return(sprintf("%d",$!));
    }
    $pid = &safeio("FLOCK");
    close(FLOCK) || warn "Close of $lockfile exited with $?";
    if ($pid != $$) {
      warn "$lockfile doesn't contain TkMail's process id";
    } else {
      unlink($lockfile);
    }
  }
  return("0");
}

# Open a file as a mail folder and sort it as a list of messages
# where each message is a list of lines. Parse the header info to
# create a database of vital statistics for each message.
#	filename - name of folder to read
sub openfolder {
  local($filename,$readonly) = @_;
  local($mesg_num,$dateinfo,$tmp,$fid,$dev,$ino,$bfid);
  local($field,$hdr,$body,$basename,$dirname,$filepos);
  local($oldfilepos,$trash,$stat,$h,$mesg_lines,$tmpfile);
  local(@hdr);

  # check if folder already opened
  ($dev,$ino) = stat($filename);

  ($dirname,$basename) = $filename =~ q!(.*/)([^/]*)$!;
  if ( $basename eq "" ) { $basename = $filename; }

  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
    print STDERR "Reopening $filename with $fid, $dev, $ino\n" if $debug;
  } else {
    # get filehandle for folder
    $fid = ++$nexthandle;
    if ($readonly || ( -e $filename && ! -w $filename) ) {
      $folderprot{$fid} = 1;
      if (!open($fid, "<$filename")) {
	$lasterror = "$filename: $!";
	return(sprintf("%d",$!));
      }	
    } else {
      $folderprot{$fid} = 0;
      $bfid = "B$fid";
      # first open backup file for folder
      # $tmpfile = $filename . "_tkmail$$";
      $tmpfile = "$dirname\#$basename\#";
      if ( -s $tmpfile ) {
	warn "Tempfile $tmpfile already exists. Moving to ${tmpfile}.old\n";
	if (!rename($tmpfile,"${tmpfile}.old")) {
	  warn "Can't move $tmpfile to ${tmpfile}.old\n$!\n";
	}
      }
      # if folder doesn't exist, create zero length file
      if ( ! -e $filename) {
	$stat = !open($fid, "+>$filename");
	($dev,$ino) = stat($filename);
      } else {
	$stat = !open($fid, "+<$filename");
      }
      if ($stat) {
	$lasterror = "$filename: $!";
	return(sprintf("%d",$!));
      }
      # try to lock file
      if($stat = &lockfid($fid,$filename)) {
	close($fid);
	return($stat);
      }
    }
    # store database items for file
    $folderino{$dev,$ino} = $fid;
    seek($fid,0,2);
    $foldersize{$fid} = tell($fid);
    $folderdel{$fid} = 0;
    $foldermod{$fid} = 0;
    $foldermrk{$fid} = 0;
    $folderbak{$fid} = $tmpfile;
  }
  seek($fid,0,0); # go to top of file

  # create assoc array to store message info for FID
  eval "\%mesg_$fid = ()";
  local(*messages) = "mesg_$fid";

  # Check that it is a valid mail folder
  if ( -s $filename ) {
    $_ = &safeio("$fid");
    if (!&newmsg($_)) {
      $tell = tell;
      $lasterror = "$filename is not a valid mail folder. First line ($tell):\n$_\n";
      &unlockfid($fid,$filename);
	return("255");
    }
  }
  seek($fid,0,0);
 
  # Parse each line of file for mesg separation and header info
  $mesg_num=0;
  $oldfilepos=0;
  $mesg_lines=0;    
  $filepos = tell($fid);

  $! = 0;
  while (<$fid>) {
    while ($! =~ m/Interrupted system call/) {
      $! = ""; <$fid>;
    }
    if (m/^.?From/o && &newmsg($_)) {
      chop;
      # Append last message to folder contents
      $messages{$mesg_num,"mesg-lines"} = $mesg_lines;
      $messages{$mesg_num,"mesg-chars"} = $filepos - $oldfilepos;

      # process the first sendmail standard "From" line
      ++$mesg_num;
      if (m/^>From/o) { $messages{$mesg_num,"status"} = "RO"; }
      ($tmp,$messages{$mesg_num,"sm-from"},$dateinfo) = split(m/\s+/,$_,3);
      ($messages{$mesg_num,"sm-wday"}, $messages{$mesg_num,"sm-month"}, 
       $messages{$mesg_num,"sm-mday"}, $messages{$mesg_num,"sm-hour"}, 
       $messages{$mesg_num,"sm-year"}) = 
	 $dateinfo =~ m/ *(\w+) *(\w+) *(\d+) *(\d+:\d+):*\d*[A-Za-z ]*(\d+)/;
      $messages{$mesg_num,"sm-date"} = $dateinfo;
      $messages{$mesg_num,"time-received"} = 
	&local2time($messages{$mesg_num,"sm-mday"},
		    $messages{$mesg_num,"sm-month"},
		    $messages{$mesg_num,"sm-year"},
		    $messages{$mesg_num,"sm-hour"},$localtz);
      $messages{$mesg_num,"deleted"} = 0;
      $messages{$mesg_num,"viewed"} = 0;
      $messages{$mesg_num,"file-pos"} = $filepos;
      $filepos = tell;

      # make associative array of headers
      $field = "trash";
      while (<$fid>){
	chop;
	if ( $_ eq "" ) { last; }
	if (s/^\s+/ /) {
	  $messages{$mesg_num,$field} .= $_; 
	} else {
	  ($field,$body) = /(\S+):\s+(.*)/;
	  $field =~ tr/A-Z/a-z/;
	  $messages{$mesg_num,$field} =  $body;
	  $mesgfields{$field}++;
  	}
      }

      # try to get senders real name
      if (defined($messages{$mesg_num,"from"})) {
	$body = $messages{$mesg_num,"from"};
	if ($body =~ m/"(.+)" <.*>/ ) {
	  $messages{$mesg_num,"fullname"} = $1;
	} elsif ($body =~ m/(.+) <.*>/ ) {
	  $messages{$mesg_num,"fullname"} = $1;
	} elsif ($body =~ m/^[^\(]*\((.+)\)[^\)]*$/ ) {
	  $messages{$mesg_num,"fullname"} = $1;
	} elsif ($body =~ m/<(.+)>/ ) {
	  $messages{$mesg_num,"fullname"} = $1;
	} else {
	  $messages{$mesg_num,"fullname"} = $body;
	}
      } else { 
	$messages{$mesg_num,"fullname"} = $messages{$mesg_num,"sm-from"};
      }

      if (defined($messages{$mesg_num,"date"})) {
	$messages{$mesg_num,"time-sent"} =
	  &date2time($messages{$mesg_num,"date"});
      } else {
	$messages{$mesg_num,"time-sent"} =
	  $messages{$mesg_num,"time-received"};
      }

      $oldfilepos = tell;
      $mesg_lines=0;
    } else {
      $mesg_lines++;
    }
    $filepos = tell;
  }
  $messages{$mesg_num,"mesg-lines"} = $mesg_lines;
  $messages{$mesg_num,"mesg-chars"} = $filepos-$oldfilepos;

  $foldernum{$fid} = $mesg_num;
  $foldername{$fid} = $filename;
  $folderfid{$filename} = $fid;

  print STDERR "Read in $filename as $fid with $mesg_num messages\n" if $debug;
  return("0");
}

# echo headers for given file and mesg num
sub listheaders {
  local($filename,$mesg_num) = @_;
  local($fid,$fieldname,$dev,$ino);

  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (listheaders).";
    return("255");
  }

  # goto to beginning of requested message in file
  $fid = $folderfid{$filename};
  if (!defined($fid)) {
    $lasterror = "File $filename has not been opened (listheaders).";
    return("255");
  }
  local(*messages) = "mesg_$fid";

  # send field keys and field bodies
  foreach (keys %mesgfields) {
    if (/\S/ && defined($messages{$mesg_num,$_})) {
      print WISH $_, "\004", $messages{$mesg_num,$_}, "\n";
    }
  }
  return("0");
}

sub getheader {
  local($filename,$mesg_num,$field) = @_;
  local($fid,$fieldname,$dev,$ino);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (getheader).";
    return("255");
  }
  local(*messages) = "mesg_$fid";

  # send field keys and field bodies
  if (defined($messages{$mesg_num,$field})) {
      &towish($messages{$mesg_num,$field});
  }
  return("0");
}

sub numbermesgs {
  local($filename) = @_;
  local($dev,$ino);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (numbermesgs).";
    return("255");
  }

  &towish($foldernum{$fid});
  return 0;
}

sub readheaders {
  local($filename,$mesg_num,$full) = @_;
  local($dev,$ino);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (readheaders).";
    return("255");
  }

  local(*messages) = "mesg_$fid";
  if (!defined($messages{$mesg_num,"file-pos"})) {
    $lasterror = "File $filename has no message number $mesg_num.";
    return("255");
  }

  seek($fid,$messages{$mesg_num,"file-pos"},0);
  $_ = &safeio("$fid");
  if (!&newmsg($_)) {
    $lasterror = "Program out of sync with message postion in $filename.\n";
    $lasterror .= "Please report this bug to author.\n";
    return("255");
  }

  if (&echoheaders($fid,"WISH",$mesg_num,$full)) {
    return 0;
  } else { return 255; }
}

sub echoheaders {
  local($fid,$target,$mesg_num,$full) = @_;
  local($hdr,$fieldname,$trash,$line,$printerr);
  local(*messages) = "mesg_$fid";


  if (!$full && scalar(@hdrview)) {
    foreach $hdr (@hdrview) {
      ($fieldname = $hdr) =~ tr/A-Z/a-z/;
      if (defined($messages{$mesg_num,$fieldname}) &&
	  $messages{$mesg_num,$fieldname} ne "") {
	if (!print($target "$hdr: $messages{$mesg_num,$fieldname}\n")) {
	  return 0;
	}
      }
    }
    do {
      &ioset;
      while(<$fid> ne "\n" && !eof ){};
    } while (&ioerror);
  } else {
    $echo = 0;
    do {
      &ioset;
      while(($line = <$fid>) && ($line ne "\n") && !eof) {
	if($line =~ m/^\s/) {
	  if ($echo) { 
	    if (!print($target $line)) {
	      return 0; 
	    }
	  }
	} else {
	  $echo = 0;
	  ($hdr,$trash) = split(": *",$line,2);
	  if ($full || !scalar(grep($hdr eq $_,@hdrhide))) {
	    $echo = 1;
	    if (!print($target $line)) {
	      return 0; 
	    }
	  }
	}
      }
    } while (&ioerror);
  }
  return 1;
}

# echo a message from current folder
#	filename  - folder to message from
#	mesg_num  - message number to insert
#	strip	  - whether to strip away all headers
sub readmesg {
  local($filename,$mesg_num,$strip) = @_;
  local($fid,$fieldname,$buf,$len,$readend,$dev,$ino);
  local($type,$tmpfile,$subtype,$param,$enc,$id,$desc,$bound);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (readmesg).";
    return("255");
  }

  local(*messages) = "mesg_$fid";
  if (!defined($messages{$mesg_num,"file-pos"})) {
    $lasterror = "File $filename has no message number $mesg_num.";
    return("255");
  }

  seek($fid,$messages{$mesg_num,"file-pos"},0);
  $_ = &safeio("$fid");
  if (!&newmsg($_)) {
    $lasterror = "Program out of sync with message postion in $filename.\n";
    $lasterror .= "Please report this bug to author.\n";
    return("255");
  }

  # send only desired headers for message
  if ($strip) {
    do {
      &ioset;
      while(<$fid> ne "\n" && !eof){};
    } while (&ioerror);
  } else {
    &echoheaders($fid,"WISH",$mesg_num,0);
    &towish("");
  }

  # parse mime
  if ($parsemime && defined($messages{$mesg_num,"mime-version"}) &&
      $messages{$mesg_num,"mime-version"} eq "1.0") {
    print STDERR "Parsing MIME message\n" if $debug;

    # load mime code if needed
    if (!defined(&parsemimemulti)) {
      if (!defined($stat = eval('require "mime.pl"'))) {
	$lasterror = "Can't load mime.pl:$@\n";
	return("255");
      }
    }

    ($type,$param) = 
      split(m/;/,$messages{$mesg_num,"content-type"},2);
    $type =~ tr/A-Z/a-z/;
    ($type,$subtype) = split(m/\//,&nocomment($type));
    $enc = &nocomment($messages{$mesg_num,"content-transfer-encoding"});
    $enc =~ tr/A-Z/a-z/;
    $id = &nocomment($messages{$mesg_num,"content-id"});
    $desc = &nocomment($messages{$mesg_num,"content-description"});

    if ($type =~ m/multipart/i) {
      ($bound) = $param =~ m/boundary=\"*([^;\"]+)/i;
      &parsemimemulti($fid,$messages{$mesg_num,"file-pos"},
		      $subtype,$bound);
    } else {
      if ($type eq "") { 
	$type = "text"; $subtype = "plain"; $param = "charset=us-ascii";
      }
      &parsemime($fid,$messages{$mesg_num,"file-pos"},
		 $type,$subtype,$param,$enc,
		 $id,$desc,"mixed","");
    }
    print STDERR "Finished Parsing MIME message\n" if $debug;

  } else {

    if ($parsemime && defined($messages{$mesg_num,"mime-version"})) {
      print WISH qq|\nWARNING! Unknown MIME-Version: $messages{$mesg_num,"mime-version"}\n\n|;
    }

    # send mesg body
    if ($mesg_num == $foldernum{$fid} || 
	!defined($messages{$mesg_num+1,"file-pos"})) {
      $readend = $foldersize{$fid};
    } else { $readend = $messages{$mesg_num+1,"file-pos"}; }
    $len = $readend - tell($fid);
    if ($len < 1) {
      print WISH "WARNING!  This messages appears to have no body!\n";
    } elsif (&saferead($fid,*buf,$len) != $len) {
      $lasterror = "Read short than expected for $filename.\n";
      $lasterror .= "Please report this bug to author.\n";
      return("255");
    } else { 
      while( -e ($tmpfile = "${tmpdir}/tkmail_$<." . $nexttmp++)) { 1;}
      if (!open(TMPMSG,">$tmpfile")) {
	print WISH $buf; 
      } else {
	print TMPMSG $buf;
	print TMPMSG "\n";
	close(TMPMSG);
	&towish($signalexfile);
	&towish($tmpfile);
      }
    }
  }

  $folderlast{$fid} = $mesg_num;
  $messages{$mesg_num,"viewed"} = 1;
  if (!($messages{$mesg_num,"status"} =~ m/R/) &&
      !$folderprot{$fid}) { 
    $foldermrk{$fid} = 1;
    $foldermod{$fid} = 1;
  }
  return("0");
}

# mark list of mesgs for deletion
sub deletemesg {
  local($filename,$doit,@mesgs) = @_;
  local($fid,$fieldname,$dev,$ino);

  # make sure doit is 1 or 0
  if ($doit) { $doit = 1; }
  else { $doit = 0; }

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (deletemesg).";
    return("255");
  }

  local(*messages) = "mesg_$fid";
  foreach (@mesgs) {
    if (!defined($messages{$_,"file-pos"})) {
      $lasterror = "File $filename has no message number $mesg_num.";
      return("255");
    }
  }

  foreach (@mesgs) {
    if ($doit != $messages{$_,"deleted"}) {
      $foldermod{$fid} = 1;
      if ($doit) {$folderdel{$fid}++;}
      else {$folderdel{$fid}--;}
      $messages{$_,"deleted"} = $doit;
    }
  }
  return("0");
}

# return list of message marked for deletion
sub listdelete {
  local($filename) = @_;
  local($i,$fid,$dev,$ino);

  # get filename FID
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (listdelete).";
    return("255");
  }
  local(*messages) = "mesg_$fid";

  for ($i=1;$i<=$foldernum{$fid};$i++) {
    if ($messages{$i,"deleted"}) { 
      &towish($i);
    }
  }
  return("0");
}

# close file, processing deletes and marking proper status of each mesg
sub closefolder {
  local($filename,$backup,$sorted,$sortkey) = @_;
  local($fid,$end,$stop,$tmpfile,$changed,$stat,$bfid);
  local($rstart,$rend,$readerr,$printerr,*buf,$len,@numlist);

  # a quiting signal here would be touchy
  $sigspecial = 1;

  # clear last error since we will want to ignore some errors
  # and just append to their message strings
  $lasterror = "";

  # get filename FID
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (closefolder).";
    if ($sigspecial == 2) { &safequit("1"); }
    $sigspecial = 0;
    return("255");
  }

  if ($folderprot{$fid}) {
    # remove locks and database elements associated with this file
    &cleanfolder($fid,$filename);
    close($fid);
    print STDERR "Closed $filename with FID $fid\n" if $debug;
    if ($folderdel{$fid} || $foldermrk{$fid}) {
      $lasterror = "ERROR: $filename is read-only. Changes not saved.\n";
      if ($sigspecial == 2) { &safequit("1"); }
      $sigspecial = 0;
      return("255");
    }
    if ($sigspecial == 2) { &safequit("1"); }
    $sigspecial = 0;
    return("0");
  }
  seek($fid,0,2);
  $end = tell($fid);

  local(*messages) = "mesg_$fid";
  $tmpfile = $folderbak{$fid};

  # process deletes and other changes if needed
  $stat = 0;
  if ( (($folderdel{$fid} || $foldermrk{$fid}) && !$backup) || 
      $sorted || ($backup && $foldermod{$fid} == 1)) {
    $foldermod{$fid} = 0;
    $changed = 1;

    $bfid = "B$fid";
    if (!open($bfid, ">$tmpfile")) {
      print STDERR "$tmpfile: $!\n" if $debug;
      while( -e ($tmpfile = "${tmpdir}/\#$basename\#" . $nexttmp++)) { 1;}
      if (!open($bfid, ">$tmpfile")) {
	$lasterror .= "Can't open backup file $tmpfile\n$!";
	if ($sigspecial == 2) { &safequit("1"); }
	$sigspecial = 0;
	return(sprintf("%d",$!));
      }
      $folderbak{$fid} = $tmpfile;
    }

    $delnum = 0; # keep track of number of deletions
    seek($bfid,0,0);

    # mark current end of file
    seek($fid,0,2);
    $rend = tell($fid);

    if ($sorted) {
      &mesgsort($fid,*numlist,1,$foldernum{$fid},$sortkey);
    } else {
      @numlist = 1 .. $foldernum{$fid};
    }

    print STDERR "Processing changes for $filename ($foldernum{$fid})\n" if $debug;
    $readerr = 0; $printerr = 0;
    $rstart = 0;
  CLOSE: foreach $i (@numlist) {

      # if mesg deleted, skip writing it to tmpfile
      if ($messages{$i,"deleted"}) { 
	$delnum++;
	print STDERR "(Removed $i)" if $debug;

      } elsif (!($messages{$i,"status"} =~ m/R/) && 
	    $messages{$i,"viewed"}) {

	# find end of message
	if ($i == $foldernum{$fid}) {
	  seek($fid,0,2);
	  $rstart = $rend;
	} else {
	  $rstart = $messages{$i+1,"file-pos"}
	}

	#write out header upto Status field
	seek($fid,$messages{$i,"file-pos"},0);
	do {
	  &ioset;
	  while(<$fid>) {
	    if ($_ eq "\n") { 
	      if (!print($bfid "Status: RO\n\n")) {
		$printerr = 1; last CLOSE;
	      }
	      last;
	    }
	    elsif (m/^[Ss]tatus:/) {
	      if (!print($bfid "Status: RO\n")) {
		$printerr = 1; last CLOSE;
	      }
	      last;
	    }
	    if (!print($bfid $_)) {
	      $printerr = 1; last CLOSE;
	    }
	    if (tell($fid) >= $rstart) {
	      last;
	    }
	  }
	} while (&ioerror);
	print STDERR "(Marked $i)" if $debug;

	# write out rest of message
	if (tell($fid) < $rstart) {
	  $len = $rstart - tell($fid);
	  if (&saferead($fid,*buf,$len) != $len) { 
	    $readerr = 1; last CLOSE;
	  } else { 
	    if (!print($bfid $buf)) {
	      $printerr = 1; last CLOSE;
	    }
	  }
	}	  
      } else {

	# find end of message
	if ($i == $foldernum{$fid}) {
	  $rstart = $rend;
	} else {
	  $rstart = $messages{$i+1,"file-pos"}
	}
	print STDERR "(Copied $i)" if $debug;

	# transfer message
	$len = $rstart - $messages{$i,"file-pos"};
	if ($len > 0) {
	  seek($fid,$messages{$i,"file-pos"},0);
	  if (&saferead($fid,*buf,$len) != $len) { 
	    $readerr = 1; last CLOSE;
	  } else { 
	    if (!print($bfid $buf)) {
	      $printerr = 1; last CLOSE;
	    }
	  }
	}

      }
    }

    # write rest of folder if needed
    if (!$printerr) {
      seek($fid,0,2);
      print STDERR "($rend - ", tell($fid), ")" if $debug;
      if (!$readerr && $rend < tell($fid)) {
	$len = tell($fid) - $rend;
	seek($fid,$rend,0);
	if (&saferead($fid,*buf,$len) != $len) { 
	  $readerr = 1; last CLOSE;
	} else { 
	  if (!print($bfid $buf)) {
	    $printerr = 1; last CLOSE;
	  }
	}
      }
    }
    close($bfid);

    print STDERR "\n" if $debug;

    if ($readerr) {
      $lasterror .= "Read error from $filename\n$!\n";
      $lasterror .= "Saving processed $filename to $tmpfile\n";
      $stat = 255;
    } elsif ($printerr) {
      $lasterror .= "Write error to $tmpfile\n$!\n";
      $lasterror .= "Leaving $filename unchanged\n";
      $stat = 255;
    } elsif (tell($fid) != $end || $folderdel{$fid} != $delnum) {
      # check that we deleted the expected number of messages and that
      # we have copied over all of file desired
      $lasterror .= "Out of sync error deleting messages from $filename\n";
      $lasterror .= "Tell: " . tell($fid) . " != $end and $folderdel{$fid} != $delnum\n";
      $lasterror .= "Saving processed $filename to $tmpfile\n";
      $stat = 255;
    }
  } else { $changed = 0; }

  if ($backup) {
    if ($sigspecial == 2) { &safequit("1"); }
    $sigspecial = 0;
    return($stat);
  }

  # check if file has been messed with outside tkmail
  if ( !$stat && $end != $foldersize{$fid}) {
    $lasterror .= "File $filename modified externally while open\n";
    $lasterror .= "Changes left in $tmpfile.\n";
    $lasterror .= "  $end != $foldersize{$fid}\n";
    $stat = 255;
  }

  # remove locks and database elements associated with this file
  &cleanfolder($fid,$filename);
  close($fid);
  print STDERR "Closed $filename with FID $fid\n" if $debug;

  # move tmpfile to real file name
  if (!$stat && $changed) {
    if (!rename($tmpfile,$filename)) {
      $lasterror .= "Can't move $tmpfile to $filename\n$!\n";
      $stat = sprintf("%d",$!);
    }
  } else {
    if ( -e $tmpfile) {
      unlink($tmpfile);
    }
  }
  # if file is empty, remove it
  if ( ! -s $filename && $delempty ) {
    unlink($filename);
  }
  if ($sigspecial == 2) { &safequit("1"); }
  $sigspecial = 0;
  return($stat);
}

sub savemesg {
  local($filename,$mesg_num,$target,$strip) = @_;
  local($fid,$tfid,$fieldname,$dev,$ino,$filepos,$newfile);
  local($len,$buf,$readend,$printerr,$stat);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (savemesg).";
    return("255");
  }

  # get info for requested message number
  local(*messages) = "mesg_$fid";
  if (!defined($messages{$mesg_num,"file-pos"})) {
    $lasterror = "File $filename has no message number $mesg_num.";
    return("255");
  }
  seek($fid,$messages{$mesg_num,"file-pos"},0);

  # check if target already opened as folder
  ($dev,$ino) = stat($target);
  if (defined($folderino{$dev,$ino})) {
    $newfile = 0;
    $tfid = $folderino{$dev,$ino};
    if ($folderprot{$tfid}) {
      $lasterror = "ERROR: $target is read-only. Cannot incorporate.\n";
      return("255");
    }
    if ($strip) {
      $lasterror = "Cannot save stripped message to an open folder.\n";
      return("255");
    }
    seek($tfid,0,2);
    $filepos = tell($tfid);
    print STDERR "Saving $mesg_num from $filename to open folder $target\n" if $debug;
  } else {
    $newfile = 1;
    # open target file
    if (!open(TFILE,">>$target")) {
      $lasterror = "$target: $!";
      return(sprintf("%d",$!));
    }
    $tfid = TFILE;
    print STDERR "Saving $mesg_num from $filename to file $target\n" if $debug;
  }
  if ($fid eq $tfid) {
    $lasterror = "Can't copy from and to same file\n";
    return("255");
  }

  if ($strip) {
    # send only desired headers for message
    $stat = &echoheaders($fid,$tfid,$mesg_num,0);
    $stat = print($tfid "\n");
  } else {
    # print the message signal line (From ...)
    $_ = &safeio("$fid");
    $stat = print($tfid $_);
  }
  if (!$stat) {
    $lasterror = "Error writing to $target.\n$!\n";
    if ($newfile) {
      close(TFILE);
    } else {
      truncate($tfid,$filepos);
    }
    return("255");
  }

  if ($mesg_num == $foldernum{$fid} || 
      !defined($messages{$mesg_num+1,"file-pos"})) {
    $readend = $foldersize{$fid};
  } else { $readend = $messages{$mesg_num+1,"file-pos"}; }
  $len = $readend - tell($fid);
  if (&saferead($fid,*buf,$len) != $len) {
    $lasterror = "Read shorter than expected for copy from $filename.\n";
    $lasterror .= "Please report this bug to author.\n";
    return("255");
  } else { 
    if (!print($tfid $buf)) {
      $lasterror = "Error writing to $target.\n$!\n";
      if ($newfile) {
	close(TFILE);
      } else {
	truncate($tfid,$filepos);
      }
      return("255");
    }
  }

  if ($newfile) {
    close(TFILE); 
  } else {
    # copy message info 
    local(*tmessages) = "mesg_$tfid";
    $new_mesg = ++$foldernum{$tfid};
    $tmessages{$new_mesg, "file-pos"} = $filepos;
    $tmessages{$new_mesg, "deleted"} = 0;
    # send field keys and field bodies
    foreach (keys %mesgfields) {
      if (defined($messages{$mesg_num,$_})) {
	$tmessages{$new_mesg, $_} = $messages{$mesg_num, $_};
      }
    }
    seek($tfid,0,2);
    $foldersize{$tfid} = tell($tfid);
  }
  return("0");
}

sub mesgsort {
  local($fid,*numlist,$start,$stop,$sortkey) = @_;
  local(%numsort,$i);

  local(*messages) = "mesg_$fid";
  @numlist = ();

  ($sortkey = $sortkey) =~ tr/A-Z/a-z/;
  if ($sortkey ne "normal" && $sortkey ne "") {
    print STDERR "Sorting summary on $sortkey\n" if $debug;
    foreach $i ($start .. $stop) {
      $numsort{$i} = $messages{$i,$sortkey};
    }
    if ($sortkey eq "subject") {
      @numlist = sort {&cmpsubj($messages{$a,$sortkey},$messages{$b,$sortkey},$a,$b)} keys(%numsort);
    } elsif (grep($_ eq $sortkey,@formatnumeric)) {
      @numlist = sort {&cmpnumeric($messages{$a,$sortkey},$messages{$b,$sortkey},$a,$b)} keys(%numsort);
    } else {
      @numlist = sort {&cmpstring($messages{$a,$sortkey},$messages{$b,$sortkey},$a,$b)} keys(%numsort);
    }
  } else {
    @numlist = $start .. $stop;
  }
}

sub listsummary {
  local($filename,$start,$stop,$reverse,$sortkey) = @_;
  local($i,$fid,$field,$sumarray,$formatline,@formatarray,$status);
  local($tfid,$tmpfile,@numlist);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (listsummary).";
    return("255");
  }
  local(*messages) = "mesg_$fid";
  if ($stop eq "end" || $stop > $foldernum{$fid}) {
    $stop = $foldernum{$fid};
  }
  if ($start < 1) { $start = 1; }

  # determine whether large enough to use temp file
  $tfid = "WISH";
  if ( $stop - $start > 50 ) {
    while( -e ($tmpfile = "${tmpdir}/tkmail_$<." . $nexttmp++)) { 1;}
    if (open(TMPLST,">$tmpfile")) { $tfid = "TMPLST"; }
  }

  # added space needed for some reason by Chinese encoding users
  $formatline = $sumformat . " ";
  &createsummary(*formatline,*formatarray);

  &mesgsort($fid,*numlist,$start,$stop,$sortkey);
  if ($reverse) {
    @numlist = reverse(@numlist);
  }

  foreach $i (@numlist) {
    if ($messages{$i,"deleted"}) { next; }
    if (defined($messages{$i,"status"})) {
      if ($messages{$i,"status"} =~ m/R/ ) {
	$status = " ";
      } else { $status = "U"; }
    } else { $status = "N"; }
    if ($messages{$i,"viewed"}) { $status = " "; }
    @sumarray = ();
    foreach $field (@formatarray) {
      push(@sumarray, $messages{$i,$field});
    }
    print $tfid sprintf("%1s%4d " . $formatline,$status,$i,@sumarray), "\n";
  }
  if ( $tfid eq "TMPLST" ) { 
    close(TMPLST); 
    &towish($signalexfile);
    &towish($tmpfile);
 }
  return("0");
}

sub cmpnumeric {
  local($val1,$val2,$a,$b) = @_;
  local($ret);

  $ret = $val1 <=> $val2;
  if ($ret == 0) {
    return $a <=> $b;
  } else { return $ret; }
}

sub cmpstring {
  local($val1,$val2,$a,$b) = @_;
  local($ret);

  $ret = $val1 cmp $val2;
  if ($ret == 0) {
    return $a <=> $b;
  } else { return $ret; }
}

sub cmpsubj {
  local($subj1,$subj2,$a,$b) = @_;
  local($ret);

  $subj1 =~ s/^re: *//i;
  $subj2 =~ s/^re: *//i;
  $ret = $subj1 cmp $subj2;
  if ($ret == 0) {
    return $a <=> $b;
  } else { return $ret; }
    
}

sub expandsymbols {
  local($filename,$mesg_num,$formatline) = @_;
  local($fid,$field,$sumarray,@formatarray,$status);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (expandsymbols).";
    return("255");
  }
  local(*messages) = "mesg_$fid";

  &createsummary(*formatline,*formatarray);
  @sumarray = ();
  foreach $field (@formatarray) {
    push(@sumarray, $messages{$mesg_num,$field});
  }
  &towish(sprintf($formatline,@sumarray));
  return("0");
}

sub createsummary {
  local(*formatline,*formatarray)= @_;
  local($width,$code);

  @formatarray = ();
  while ($formatline =~ m/%([ 0-9\+\#\.\-]*)([clhmwyifFsdD])/) {
    ($width, $code) = ($1, $2);
    push(@formatarray, $formatcode{"$code"});
    if ($code =~ m/[$formatnumeric]/) {
      $formatline =~ s/%$width$code/\376${width}d/;
    } else {
      $formatline =~ s/%$width$code/\376${width}s/;
    }
  }
  $formatline =~ s/\376/%/g;
  return("0");
}

sub mesgid {
  local($sec,$min,$hour,$mday,$mon,$year,$mesgid);

  ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
  $nextmesgid++;
  $year = substr($year,-2,2);
  $mesgid = sprintf("<%s-%02d%02d%02d%02d%02d.%s%d@%s>", $whoami, $year, $mon, 
		    $mday, $hour, $min, $nextmesgid, $$, $fullhostname);

  &towish($mesgid);
  return("0");
}

sub boundary {
  local($sec,$min,$hour,$mday,$mon,$year,$datestr,$boundary);

  ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
  $year = substr($year,-2,2);
  $datestr = sprintf("%02d%02d%02d%02d%02d%02d", $year, $mon, 
		     $mday, $hour, $min, $sec);
  $datestr =~ tr/0-9/a-j/;
  $boundary = sprintf("%s-%s-%d", $datestr, $fullhostname, $$);

  &towish($boundary);
  return("0");
}

sub sendmail {

  print STDERR "Mailing text using $sendmail ... " if $debug;
  $sendcmd = qq!open(SENDMAIL, "| $sendmail")!;
  if (!eval($sendcmd)) {
    print STDERR "ERROR.\n" if $debug;
    $lasterror = "Can't execute delivery command: $sendmail\n$@";
    do {
      &ioset;
      while (<WISH> ne "$signalend\n") { 1; }
    } while (&ioerror);
    &towish("$signalend 255");
    return 255;
  }

  do {
    &ioset;
    while(<WISH>) {
      if ($_ eq "$signalend\n") {
	# let wish continue since sendmail can take awhile
	&towish("$signalend 0");
	last; 
      }
      print SENDMAIL $_;
    }
  } while (&ioerror);
  close(SENDMAIL) || warn("Sendmail exited with $?");
  print STDERR "Done.\n" if $debug;
  return 0;
}

sub readfile {
  local($filename) = @_;

  if (!open(TFILE,$filename)) {
    $lasterror = "$filename: $!";
    return(sprintf("%d",$!));
  }
  
  do { 
    &ioset;
    while (<TFILE>) {
      chop;
      &towish("$_");
    }
  } while (&ioerror);
  close(TFILE);
  return("0");
}

sub writefile {
  local($target,$overwrite) = @_;
  local($mode);

  $mode = ">>";
  if ($overwrite) { $mode = ">"; }

  # open target file
  if (!open(TFILE,"$mode$target")) {
    $lasterror = "$target: $!";
    return(sprintf("%d",$!));
  }

  do {
    &ioset;
    while(<WISH>) {
      if ($_ eq "$signalend\n") {
	last; 
      }
      if (!print(TFILE $_)) {
	$lasterror = "Error writing to $target\n$!\n";
	close(TFILE);
	return("255");
      }
    }
  } while (&ioerror);
  close(TFILE) || warn("Close file exited with $?");
  return("0");
}

sub filetest {
  local($op,$filename) = @_;
  local($res);

  $res = eval "$op \"$filename\"";
  if ($res ne "") {
    &towish("$res");
  } else {
    &towish("0");
  }
  return("0");
}

##S checkmail
### check for new mail
### return number of new messages
sub checkmail {
  local($filename) = @_;
  local($cnt,$size);

  # use lastcheck to keep track of end of file
  if (!defined($lastcheck{$filename})) {
    $lastcheck{$filename} = 0;
  }

  # if file doesn't exist, it is "empty"
  if (! -e $filename) {
    $lastcheck{$filename} = 0;
    return("0");
  }

  $cnt = -1;
  $size = -s $filename;
  if ($size > $lastcheck{$filename}) {
    if (!open(TFILE,"$filename")) {
      $lasterror = "$filename: $!";
      return(sprintf("%d",$!));
    }
    seek(TFILE,$lastcheck{$filename},0);
    $cnt = 0;
    do {
      &ioset;
      while (<TFILE>) {
	if (m/^.*From/o && &newmsg($_)) {
	  $cnt++;
	}	
      }
    } while (&ioerror);
    $lastcheck{$filename} = tell;
    close(TFILE);
    &towish("$cnt");
  } else {
    $lastcheck{$filename} = $size;
  }
  return("0");
}

sub checkappend {
  local($filename) = @_;
  local($fid,$dev,$ino,$cnt);

  # goto to beginning of requested message in file
  ($dev,$ino) = stat($filename);
  if (defined($folderino{$dev,$ino})) {
    $fid = $folderino{$dev,$ino};
  } else {
    $lasterror = "File $filename has not been opened (checkappend).";
    return("255");
  }

  seek($fid,0,2);
  if ($foldersize{$fid} < tell($fid)) {
    $cnt = &parseappend($fid,$foldersize{$fid});
    if ($cnt < 1) { 
      $lasterror = "Appended text to $filename was not a valid mail message!\n";
      $lasterror .= "WARNING: This folder is corrupt.\n";
      return("255"); }
    &towish($cnt);
  } else { &towish("0"); }

  return("0");
}

sub writemesg {
  local($target,$overwrite) = @_;
  local($savefile,$stat);

  while( -e ($savefile = "${tmpdir}/tkmail$<" . $nexttmp++)) { 1;}
  if ($stat = &writefile($savefile,$overwrite)) {
    return($stat);
  }
  $stat = &incorpmail($savefile,$target);
  if ( -e $savefile ) { unlink($savefile); }
  return($stat);
}

sub create_smfrom {
  local($addr) = @_;
  local($sec,$min,$hour,$mday,$mon,$year,$wday,$thisday,$month);

  ($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time);
  $thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
  $month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
  return("From $addr $thisday $month $mday $hour:$min:$sec $year\n");
}

##S incorpmail
sub incorpmail {
  local($spoolfile,$target) = @_;
  local($fid,$tfid,$fieldname,$dev,$ino,$filepos,$stat,$sigspecial);
  local($mesg_num,$dateinfo,$tmp,$newfile,$field,$body,$printerr);

  # make sure source is not an open folder
  if (defined($folderfid{$spoolfile})) {
    $lasterror = "Can't incorporate from open folder\n$!\n";
    return(sprintf("%d",$!));
  }

  # check for use of lockfile or Emacs movemail
  if ($usemovemail) {
    $curmask = umask;
    umask 022;
    $incfile = "$tmpdir/incorp_tkmail$$";
    if ( -e "$incfile") {
      $lasterror = "The file $incfile already exists.\n";
      return("255");
    }
    if (!eval(q!open(TMP, "$movemail $spoolfile $incfile |")!)) {
      $lasterror = "Can't run movemail: $!\n";
      return("255");
    }
    if (!close(TMP)) {
      $lasterror = "Error using movemail: $!\n";
      return("255");
    }
    umask $curmask;
    $spoolfile = $incfile;
  }

  # check if target already opened as folder
  ($dev,$ino) = stat($target);
  if (defined($folderino{$dev,$ino})) {
    $newfile = 0;
    $tfid = $folderino{$dev,$ino};
    if ($folderprot{$tfid}) {
      $lasterror = "ERROR: $target is read-only. Cannot incorporate.\n";
      return("255");
    }
    $mesg_num = $foldernum{$tfid};
    seek($tfid,0,2);
    $filepos = tell($tfid);
    print STDERR "Incorporating from $spoolfile to open folder $target\n" if $debug;
  } else {
    $newfile = 1;
    # open target file
    if (!open(TFILE,">>$target")) {
      $lasterror = "$target: $!";
      return(sprintf("%d",$!));
    }
    $tfid = TFILE;
    print STDERR "Incorporating from $spoolfile to file $target\n" if $debug;
  }


  # open spoolfile to get new mail from
  if (!open(SPOOL,"$spoolfile")) {
    $lasterror = "Can't open spoolfile $spoolfile\n";
    return("255");
  }
  if ($uselockfile) {
    if (!eval(q!open(TMP, "$lockfile -ml |")!)) {
      $lasterror = "Can't lock using lockfile: $!\n";
      return("255");
    }
    if (!close(TMP)) {
      $lasterror = "Error using lockfile: $!\n";
      return("255");
    }
  } 
  elsif ($stat = &lockfid(SPOOL,"$spoolfile")) {
    return($stat);
  }

  # a quiting signal here would be touchy
  $sigspecial = 1;

  seek(SPOOL,0,0);
  # if file doesn't have a sm-from line, create a bogus one
  if (!&newmsg(&safeio("SPOOL"))) {
    if (!print($tfid &create_smfrom($whoami))) {
      $lasterror = "Error writing to $target\n$!\n";
      if ($sigspecial == 2) { &safequit("1"); }
      $sigspecial = 0;
      return("255");
    }
  }
  seek(SPOOL,0,0);

  $printerr = 0;
  $cnt = 0;

  do {
    &ioset;
   SPOOLIT: while(<SPOOL>) {
      # look for beginning of next message
      if (m/^.*From/o && &newmsg($_)) { $cnt++; }
      if (!print($tfid $_)) {
	$printerr = 1; last SPOOLIT;
      }
    }
  } while (&ioerror);
  if ($newfile) { 
    close(TFILE); 
  } elsif (!$printerr) {
    &parseappend($tfid,$filepos);
  }
  if ($printerr) {
    $lasterror = "Can't write to $target.\n$!\n";
  } else {
    &towish($cnt);
    print STDERR "Incorporated $cnt total messages.\n" if $debug;
    $lasterror = "";
  }

  $stat = 0;
  if ($uselockfile) {
    if (!eval(q!open(TMP, "$lockfile -mu |")!)) {
      $lasterror .= "Can't unlock using lockmail: $!\n";
      $stat = 255;
    }
    if (!close(TMP)) {
      $lasterror .= "Error using lockmail: $!\n";
      $stat = 255;
    }
  } 
  else {
    $stat = &unlockfid(SPOOL,"$spoolfile");
  }
  close(SPOOL) || warn "Close of $spoolfile exited with $?";

  if ($printerr) {
    if (!$newfile) { truncate($tfid,$filepos); }
    if ($sigspecial == 2) { &safequit("1"); }
    $sigspecial = 0;
    return("255");
  }

  if ($sigspecial == 2) { &safequit("1"); }
  $sigspecial = 0;
  if ($stat) {
    return($stat);
  }

  if (!unlink("$spoolfile")) {
    if (!truncate("$spoolfile",0)) {
      $lasterror = "$spoolfile: $!\n";
      return(sprintf("%d",$!));
    }
  }
  # update check mail statistics for spoolfile
  if (defined($lastcheck{$spoolfile})) {
    $lastcheck{$spoolfile} = 0;
  }
  return("0");
}

sub parseappend {
  local($tfid,$pos) = @_;
  local($mesg_lines,$cnt,$tmp,$mesg_num,$body,$field,$filepos);
  
  seek($tfid,$pos,0);

  local(*messages) = "mesg_$tfid";
  $mesg_num = $foldernum{$tfid};
  $filepos = $pos;
  $mesg_lines=0;
  $cnt = 0;

  do {
    &ioset;
    while(<$tfid>) {
      # look for beginning of next message
      if (m/^.*From/o && &newmsg($_)) {
	chop;

	if ($cnt) {
	  $messages{$mesg_num,"mesg-lines"} = $mesg_lines;
	  $messages{$mesg_num,"mesg-chars"} = 
	    tell($tfid)-$messages{$mesg_num,"file-pos"};
	}
	$cnt++;

	# process this messages header
	++$mesg_num;
	if (m/^>From/) { $messages{$mesg_num,"status"} = "RO"; }
	($tmp,$messages{$mesg_num,"sm-from"},$dateinfo) = split(m/\s+/,$_,3);
	($messages{$mesg_num,"sm-wday"}, $messages{$mesg_num,"sm-month"}, 
	 $messages{$mesg_num,"sm-mday"}, $messages{$mesg_num,"sm-hour"}, 
	 $messages{$mesg_num,"sm-year"}) = 
	   $dateinfo =~ m/ *(\w+) *(\w+) *(\d+) *(\d+:\d+):*\d*[A-Za-z ]*(\d+)/;
	$messages{$mesg_num,"sm-date"} = $dateinfo;
	$messages{$mesg_num,"time-received"} = 
	  &local2time($messages{$mesg_num,"sm-mday"},
		      $messages{$mesg_num,"sm-month"},
		      $messages{$mesg_num,"sm-year"},
		      $messages{$mesg_num,"sm-hour"},$localtz);
	$messages{$mesg_num,"deleted"} = 0;
	$messages{$mesg_num,"file-pos"} = $filepos;
	print STDERR "Adding message $mesg_num at ", 
	$messages{$mesg_num,"file-pos"}, " in $tfid\n" if $debug;

	$field = "trash";
	while ($_ = &safeio($tfid)) {
	  if($_ eq "\n" || eof ) { last; }
	  chop;
	  if (s/^\s+/ /) {
	    $messages{$mesg_num,$field} .= $_; 
	  } else {
	    ($field,$body) = /(\S+):\s+(.*)/;
	    $field =~ tr/A-Z/a-z/;
	    $messages{$mesg_num,$field} = $body;
	    $mesgfields{$field}++;
	  }
	}

	# try to get senders real name
	if (defined($messages{$mesg_num,"from"})) {
	  $body = $messages{$mesg_num,"from"};
	  if ($body =~ m/"(.+)" <.*>/ ) {
	    $messages{$mesg_num,"fullname"} = $1;
	  } elsif ($body =~ m/(.+) <.*>/ ) {
	    $messages{$mesg_num,"fullname"} = $1;
	  } elsif ($body =~ m/^[^\(]*\((.+)\)[^\)]*$/ ) {
	    $messages{$mesg_num,"fullname"} = $1;
	  } elsif ($body =~ m/<(.+)>/ ) {
	    $messages{$mesg_num,"fullname"} = $1;
	  } else {
	    $messages{$mesg_num,"fullname"} = $body;
	  }
	} else { 
	  $messages{$mesg_num,"fullname"} = $messages{$mesg_num,"sm-from"};
	}

	if (defined($messages{$mesg_num,"date"})) {
	  $messages{$mesg_num,"time-sent"} =
	    &date2time($messages{$mesg_num,"date"});
	} else {
	  $messages{$mesg_num,"time-sent"} =
	    $messages{$mesg_num,"time-received"};
	}

	$mesg_lines=0;
      }
      $filepos = tell($tfid);
      $mesg_lines++;
    }
  } while (&ioerror);

  $messages{$mesg_num,"mesg-lines"} = $mesg_lines;
  $messages{$mesg_num,"mesg-chars"} =
	tell($tfid)-$messages{$mesg_num,"file-pos"};
  $foldernum{$tfid} = $mesg_num;
  seek($tfid,0,2);
  $foldersize{$tfid} = tell($tfid);

  return($cnt);
}

sub samefiles {
  local($file1,$file2) = @_;

  ($dev1,$ino1) = stat($file1);
  ($dev2,$ino2) = stat($file2);
 
  if ($dev1 == $dev2 && $ino1 == $ino2) {
    &towish("1");
  } else {
    &towish("0");
  }
  return("0");
}

sub safequit {
  local($status) = @_;
  foreach $name (keys %folderfid) {
    if ($stat = &closefolder($name,0,0)) {
      print STDERR $lasterror;
    }
  }
  exit($status);
}

#
# SIGNAL HANDLING
#

# tells sighandler that we interupted something touchy
$sigspecial = 0;

sub sighandler {
  local($sig) = @_;
  print STDERR "Caught a SIG$sig--shutting down\n";
  if ($sigspecial == 1) {
    $sigspecial = 2;
    $SIG{'INT'} = 'sighandler';
    $SIG{'QUIT'} = 'sighandler';
    $SIG{'TERM'} = 'sighandler';
    $SIG{'HUP'} = 'sighandler';
    $SIG{'TRAP'} = 'sighandler';
    $SIG{'KILL'} = 'sighandler';
    $SIG{'BUS'} = 'sighandler';
    return;
  }
  &safequit(1);
  $SIG{'CHLD'} = "";
  &towish("exit");
}

$SIG{'INT'} = 'sighandler';
$SIG{'QUIT'} = 'sighandler';
$SIG{'TERM'} = 'sighandler';
$SIG{'HUP'} = 'sighandler';
$SIG{'TRAP'} = 'sighandler';
$SIG{'KILL'} = 'sighandler';
$SIG{'BUS'} = 'sighandler';

sub querywish {
  local($sig) = @_;

  &towish("puts stderr \$errorInfo");
  $SIG{'USR1'} = 'querywish'; 
}
$SIG{'USR1'} = "querywish"; 

sub flushwish {
  local($sig) = @_;
  print STDERR "Caught a SIG$sig--flushing wish\n";

  &towish("$signalend");
  $SIG{'USR2'} = "flushwish"; 
}
$SIG{'USR2'} = "flushwish"; 


#
# STARTUP
#

#system "stty -echo -raw";

# get full host name for message ids
open(HOST, "hostname|");
chop($hostname = &safeio("HOST"));
close(HOST);
($fullhostname) = gethostbyname("$hostname");

# verify that WISH is alive
$SIG{'ALRM'} = "testpid";
alarm 8;

# setup WISH globals from user info
&towish("set mfp(debug) {$debug}");
&towish("set mfp(version) {$version}");
&towish("set mfp(tkmaillib) {$tkmaillib}");
&towish("set mfp(setfile) {$opt_personal}");
&towish("set mfp(user) {$whoami}");
&towish("set mfp(homedir) {$homedir}");
&towish("set mfp(base64-enc) {$base64enc}");
&towish("set mfp(qprnt-enc) {$quotprenc}");

# source WISH libraries
if ( -r "$tkmaillib/viewer.tcl" ) {
  if(&wishcmd("source $tkmaillib/dbperl.tcl")) {
    &diesafe("Aborting tkmail.");
  }
  if(&wishcmd("source $tkmaillib/viewer.tcl")) {
    &diesafe("Aborting tkmail.");
  }
} else {
  print STDERR "Can't find libraries in $tkmaillib!\n";
  &diesafe("Aborting tkmail.");
}

print STDERR "Sourcing $opt_global and $opt_personal\n" if $debug;
&wishcmd("source $opt_global") if -r $opt_global;
if ( $ENV{'MAIL'} ne "" ) {
  &wishcmd("set mf(mail-system) {$ENV{'MAIL'}}");
}
&wishcmd("source $opt_personal") if -r $opt_personal;

print STDERR "Calling tkmail-init\n" if $debug;
print WISH "if {[catch {mfv:tkmail-init ", join(" ",@startargs),
  "} res]} {puts stderr \$errorInfo; puts stdout mfdb:quit;",
  "flush stdout; exit}\n";

#
# MAIN LOOP
#
print STDERR "Starting main loop\n" if $debug;
do {
  &ioset;
  while(<WISH>) {
    chop;
    $stat = 0;
    ($command, $args) = split("\t",$_,2);
    if ($command eq "mfdb:folder-open") {
      $stat = &openfolder(split("\t",$args));
    } elsif ($command eq "mfdb:folder-close") {
      $stat = &closefolder($args,0,0);
    } elsif ($command eq "mfdb:folder-backup") {
      $stat = &closefolder($args,1,0);
    } elsif ($command eq "mfdb:folder-summary") {
      $stat = &listsummary(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-expand-symbols") {
      ($filename,$num,$form) = split("\t",$args,3);
      $stat = &expandsymbols($filename,$num,$form);
    } elsif ($command eq "mfdb:proc-deletes") {
      ($filename,$sorted,$sortkey) = split("\t",$args,3);
      if (!($stat = &closefolder($filename,0,$sorted,$sortkey))) {
	$stat = &openfolder($filename,0);
      }
    } elsif ($command eq "mfdb:mail-incorp") {
      $stat = &incorpmail(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-read") {
      $stat = &readmesg(split("\t",$args));
    } elsif ($command eq "mfdb:headers-read") {
      $stat = &readheaders(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-save") {
      $stat = &savemesg(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-delete") {
      $stat = &deletemesg(split("\t",$args));
    } elsif ($command eq "mfdb:list-delete") {
      $stat = &listdelete(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-write") {
      $stat = &writemesg(split("\t",$args));
    } elsif ($command eq "mfdb:parse-partial") {
      $stat = &parsepartial(split("\t",$args));
    } elsif ($command eq "mfdb:parse-rfc822") {
      $stat = &parserfc822(split("\t",$args));
    } elsif ($command eq "mfdb:parse-enc-octet") {
      $stat = &parseoctet(split("\t",$args));
    } elsif ($command eq "mfdb:mime-decode") {
      $stat = &mimedecode(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-headers") {
      $stat = &listheaders(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-get-header") {
      $stat = &getheader(split("\t",$args));
    } elsif ($command eq "mfdb:mesg-id") {
      $stat = &mesgid;
    } elsif ($command eq "mfdb:boundary") {
      $stat = &boundary;
    } elsif ($command eq "mfdb:mail-check") {
      $stat = &checkmail(split("\t",$args));
    } elsif ($command eq "mfdb:check-append") {
      $stat = &checkappend(split("\t",$args));
    } elsif ($command eq "mfdb:file-read") {
      $stat = &readfile(split("\t",$args));
    } elsif ($command eq "mfdb:file-write") {
      $stat = &writefile(split("\t",$args));
    } elsif ($command eq "mfdb:folder-num-mesgs") {
      $stat = &numbermesgs($args);
    } elsif ($command eq "mfdb:file-test") {
      $stat = &filetest(split("\t",$args));
    } elsif ($command eq "mfdb:same-files") {
      $stat = &samefiles(split("\t",$args));
    } elsif ($command eq "mfdb:mail-send") {
      &sendmail;
      next; # already sent end signal
    } elsif ($command eq "mfdb:option-set") {
      ($trash,$option,$data) = split("\t",$_,3);
      eval "\$" . $options{$option} . " = \$data";
      print STDERR "Set option ". $options{$option} . " to $data\n" if $debug;
    } elsif ($command eq "mfdb:option-list-set") {
      ($trash,$option,@data) = split("\t",$_);
      eval "\@" . $options{$option} . " = \@data";
      print STDERR "Set option $option to (", join(" ",@data), ")\n" if $debug;
    } elsif ($command eq "mfdb:quit") {
      $SIG{'ALRM'} = '';
      $SIG{'CHLD'} = '';
      &safequit("0");
    } elsif ($command eq "mfdb:run-command") {
      $stat = &runbg($args);
    } elsif ($command eq "mfdb:last-error") {
      &towish($lasterror);
    } elsif ($command eq "mfdb:perl-eval") {
      print STDERR "Evaling: $args\n";
      eval($args);
    } else {
      print STDERR "Unknown server command: $_\n" if $debug;
    }
    # signal to wish end of answer
    # print STDERR "$command -> ";
    &towish("$signalend $stat");
  }
} while (&ioerror);

1;

