Article 1469 of alt.sources:
Xref: feenix.metronet.com alt.sources:1469 comp.lang.perl:3688
Newsgroups: alt.sources,comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!anaxagoras.ils.nwu.edu!news.acns.nwu.edu!math.ohio-state.edu!cs.utexas.edu!uunet!mcsun!ieunet!tcdcs!maths.tcd.ie!jm
From: jm@maths.tcd.ie (Justin Mason)
Subject: Re: perl script to unpack ftpmail (and other) binaries
Organization: Universal Media Netweb (Ireland) Inc.
Date: Thu, 24 Jun 1993 20:24:39 GMT
Message-ID: <1993Jun24.202439.14373@maths.tcd.ie>
References: <MUTS.93Jun21205807@muts.hacktic.nl> <MERLYN.93Jun24080622@kandinsky.intel.com>
Lines: 692

merlyn@ora.com (Randal L. Schwartz) writes:

>Hmm.  Time for everyone to post their favorite uudecoders...
>This one is really robust, being very picky about the lines it tries
>to decode, and handling all sorts of weird uuencoders that do strange
>things like put lowercase letters after the stuff (yuck).

You think that's robust! ;)

At present, procftpmail knows about ftpmail@decwrl.dec.com,
ftpmail@src.doc.ic.ac.uk, mailserv@nic.funet.fi, and
mailserv@garbo.uwasa.fi. Formats known are: uuencoding, btoa-encoding,
and BinHex (which it leaves alone).

I haven't looked at it recently (ie. since getting legit ftp access :),
so the code could be a bit heinous.

It'll handle out-of-order message parts, multiple retrievals at
once, and non-mailserver formats. It allows you to decode several
ftpmails at once, avoiding the fact that they decode into
"ftpmail"... etc. etc. etc.

It works with MH: if you use ftpmail or nic.funet.fi much,
I suggest using these lines in your .maildelivery file:

# special processing for FTPMail and mailservers
From nobody@pa.dec.com | ? "/usr/local/lib/mh/rcvstore +ftp"
From ftpmail@cs.uow.edu.au | ? "/usr/local/lib/mh/rcvstore +ftp"
From mailserv@garbo.uwasa.fi | ? "/usr/local/lib/mh/rcvstore +ftp"
From mailserver-reply@nic.funet.fi | ? "/usr/local/lib/mh/rcvstore +ftp"

(make sure +ftp exists first). Then make an alias that does:

	alias pf="cd ~/ftp; procftpmail -rmm -inbox +ftp"

It's quite nifty.

--
Justin Mason  (Iona Technologies' unix caretaker, fixer-upper and disk-filler)

<jm@maths.tcd.ie> -- play (I read news here)    -><-     phone: +353-1-6790677
<jmason@iona.ie>  -- work (MIME spoken here)    -><-       fax: +353-1-6798039

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  procftpmail
# Wrapped by jm@salmon on Thu Jun 24 21:19:39 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'procftpmail' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'procftpmail'\"
else
echo shar: Extracting \"'procftpmail'\" \(18080 characters\)
sed "s/^X//" >'procftpmail' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X
Xsub Usage { print <<USAGE; # -----------------------
X
XProcFTPMail - automatic FTP-by-mail reply processor.
X
Xusage: procftpmail [options] -inbox +incoming-folder
X
Xoptions are:
X  -rmm:    decoded parts will be rmm'ed rather than refiled.
X  -nomove: decoded parts will be left where they were.
X  -outbox: folder to refile decoded parts to (unless overridden
X	   by -rmm or -nomove). Defaults to +decoded.
X
XThis scans incoming-folder and processes all replies from known
Xmailservers found by uudecoding split and uuencoded files, storing
Xthem by site, and scanning status messages for pertinent information.
XWhen this is finished, it will, depending on the -rmm or -nomove
Xoptions, either refile the successfully decoded file parts to
Xdecoded-folder for easy rmm'ing, rmm them straight away, or neither.
X
Xincoming-folder defaults to +ftp, if it exists; if not, +inbox is used.
X
XAt present, procftpmail knows about ftpmail@decwrl.dec.com,
Xftpmail@src.doc.ic.ac.uk, mailserv@nic.funet.fi, and
Xmailserv@garbo.uwasa.fi. Formats known are: uuencoding, btoa-encoding,
Xand BinHex (which it leaves alone).
X
XUSAGE
Xexit 1; } # ----------------------------------------
X
X# uue_condition is the trigger condition that states that all lines
X# after and including this one are part of a uuencoded file.
X
X$UUE_CONDITION = '/^begin / || /^end$/ || ' .
X    '(/^M/ && (length $_ <= 63 || length $_ >= 61))';
X
X# --------------------------------------------------
X# ditto for atob_condition, except for btoa encoding.
X
X$ATOB_CONDITION = '/^xbtoa/ || (length $_ == 79)';
X
X# --------------------------------------------------
X# scan format for the lines.
X
X$SCANFORM = '%(void(rclock{date}))%<(gt 15768000)%3(month{date})' .
X    '/%02(year{date})%|%<(gt 604800)%2(mday{date}) %03(month{date}) %|' .
X    '%<(gt 86400) %4(day{date}) %|%02(hour{date}):%02(min{date})%>%>' .
X    '%>%<{date} %|*%>%3(msg) %{subject}%<{body}<<%{body}%>';
X
X# --------------------------------------------------
X# headers to keep for log messages.
X
X%LOG_HEADERS = ("From", "+", "Date", "+");
X
X# --------------------------------------------------
X# Debug mode: (binary) 0xxx
X#			  ^ trace part-tracking
X#			 ^ put decode stream into "debug-decode"
X
X# $debug = 3;
X
X# --------------------------------------------------
X# work-to-do identifiers:
X
X$STD_UUE	= -1;	# it's standard uuencode.
X$STD_BTOA	=  1;	# it's standard btoa-encoding.
X$FTPMAIL_UUE	=  2;	# uuencoded and decodes into "ftpmail.uu".
X$TRAILING_CRAP	=  3;	# each chunk is followed by text starting with /^--/.
X$NEEDS_TAG	=  4;	# it's a dir and should be tagged as such.
X$FUNET_CHECK	=  5;	# check a results message from nic.funet.fi.
X$FTPMAIL_CHECK	=  6;	# check a results message from ftpmail.
X$DOC_FTP_CHECK	=  7;	# check a results message from doc.ic.ac.uk.
X$DOC_DIR_TAG	=  8;	# it's a dir from doc.ic.ac.uk.
X
X# doc.ic.ac.uk has a funny part order -- aa, ab, ac, ... cz, da, db, etc.
X$DOC_FTP_CODE_BASECHAR = unpack("C", 'a');
X
X# --------------------------------------------------
X
X$unique_queue_marker = "CHECK_RESULTS";
X$unique_queue_id = "${unique_queue_marker}#aa";
X
X# --------------------------------------------------
X
Xrequire 'newgetopt.pl';
X&NGetOpt("nomove", "rmm", "outbox=s", "inbox=s") || &Usage;
X
X# require 'getopts.pl';
X# &Getopts('nrd:f:') || &Usage;
X
Xif ($opt_inbox) {
X  $folder = $opt_inbox;
X} else {
X  $mhpath = `mhpath +ftp`; chop $mhpath;
X  if (-d $mhpath) {
X    $folder = "+ftp";
X  } else {
X    $folder = "+inbox";
X  }
X}
Xif ($opt_outbox) {
X  $decoded = $opt_outbox;
X} else {
X  $decoded = "+decoded";
X}
X
X&scan_folder;
Xprint "\n--------------------",
X  " $msgs messages: $parts parts, ", ($msgs - $parts),
X  " skipped. --------------------\n";
X$| = 1;
X&process_files;
X&refile_done;
Xexit;
X
X################################
X# queue a results message check
X
Xsub queue_check {
X  if ($_[0] == $FUNET_CHECK) {
X    $site{$unique_queue_id} = "nic.funet.fi";
X  } elsif ($_[0] == $DOC_FTP_CHECK) {
X    $site{$unique_queue_id} = "ftpmail@doc.ic.ac.uk";
X  } elsif ($_[0] == $DOC_DIR_TAG) {
X    $site{$unique_queue_id} = "ftpmail@doc.ic.ac.uk";
X  } else {	# must be FTPMAIL_CHECK
X    $site{$unique_queue_id} = "ftpmail@decwrl.dec.com";
X  }
X  $files{$unique_queue_id} = $_[0];
X  $locs{$unique_queue_id} = $_[1];
X
X# trim whitespace from date
X  $_ = " $_[2] "; s/^\s+(.*)\s+/\1/; $reqs{$unique_queue_id} = $_;
X
X# disassemble, magic-increment and reassemble the unique id.
X# I hate this sort of shit.
X  $unique_queue_id =~ /#/ && ($x = $', $x++, $unique_queue_id = "$`#$x");
X}
X
X################################
X# process the files and results indicated
X
Xsub process_files {
X  for $file (keys %files) {
X    if ($file =~ /^${unique_queue_marker}/o) {
X      print "\n** results of request from $site{$file} [text]\n";
X      $msg = $locs{$file};
X      $date = $reqs{$file};
X      &check_results;
X      next;
X    }
X    $real = $name{$file};
X    $extract_dir = $reqs{$file};
X    print "\n** $extract_dir: $real from $site{$file}:$locs{$file} [";
X
X    if ($work_to_do{$file} == $STD_BTOA) {
X      print "btoa encoded]\n";
X      &decode_type("| atob > /tmp/decode.errors.$$ 2>&1",
X	  $ATOB_CONDITION, $real);
X    } elsif (($work_to_do{$file} != $NEEDS_TAG) &&
X	      ($work_to_do{$file} != $TEXT)) {
X      print "uuencoded]\n";
X      &decode_type("| uudecode > /tmp/decode.errors.$$ 2>&1", $UUE_CONDITION,
X	  ($work_to_do{$file} != $FTPMAIL_UUE) ? $real : "ftpmail.uu");
X    } else {				# not encoded - just output it
X      print "text]\n";
X      unlink("/tmp/decode.errors.$$");
X      &decode_type("> _tmpfile", '/^$/', "_tmpfile");
X    }
X  }
X}
X
X################################
X# scan the mh folder for ftpmail/funet/garbo mailserver replies
X
Xsub scan_folder {
X  print "Scanning folder $folder:\n";
X  open(SC, "scan $folder -format '$SCANFORM' -width 255 |");
X  $parts = $msgs = 0;
X  while (<SC>) {
X    /^(......)\s*(\d+) / || next;
X    $msgs++; $msg = $2; $date = $1; $_ = $'; $date =~ s/\s*$/:/;
X
X  ###### funet NIC mailserver
X    if (/^part (\d+) of (\d+) - ([^<]+)<</) {
X      $parts++; $f = $3; $siz = int $2; $text = $';
X      $p = int $1;
X
X      ($f =~ /^FIND\s*\`(.*)\'\s*result/) && (&ls_to_filename("find", $1));
X      ($f =~ /^DIR\s*(.*)/) && (&ls_to_filename("dir", $1));
X      ($f =~ /^SEND\s*(.*)/) && ($f = $1);
X
X      &std_subs;
X
X      $locs{$f} = "";			# very difficult to work this out
X      $reqs{$f} = $site{$f} = "nic.funet.fi";
X      if ($text =~ /^xbtoa/) {
X	$work_to_do{$f} = $STD_BTOA;
X      } elsif ($text =~ /^\(This file must be converted with BinHex/) {
X	$work_to_do{$f} = $STD_TEXT;
X      } elsif ($text =~ /^begin/) {
X	$work_to_do{$f} = $STD_UUE;
X      }
X      ($siz == $p) && ($last{$f} = $p,
X	  printf("%4d %-7s %4s %s\n", $msg, $date, "[$p]", $real));
X
X  ###### DECWRL's FTPMail server
X    } elsif (/^part (...) of ([^(]+)\((.*)@(.+)\) \[(.*)\] \((.*)\)<</) {
X      $parts++; chop($f = $2); $loc = $3; $site = $4; $req = $5; $atts = $6;
X      $p = int $1;
X
X      # these aren't encoded, but they do need to be captioned
X      ($f =~ /^dir\s*(.*)/) && (&ls_to_filename("dir", $1));
X      ($f =~ /^ls\s*(.*)/) && (&ls_to_filename("ls", $1));
X
X      &std_subs;
X
X      $locs{$f} = $loc;
X      $reqs{$f} = $req;
X      $site{$f} = $site;
X      ($atts =~ /uuencode/) && ($work_to_do{$f} = $FTPMAIL_UUE);
X      ($atts =~ /last/) && ($last{$f} = $p,
X	  printf("%4d %-7s %4s %s\n", $msg, $date, "[$p]", $real));
X
X  ###### doc.ic.ac.uk's FTPMail server (multipart)
X    } elsif (/^\[(..)\/(..)\] ([^:]+):(\S+) ([^<]+)<</) {
X      $enc1 = $1; $enc2 = $2;
X      $parts++; $site = $3; $loc = $4; $req = $5;
X
X      $c1 = unpack("C", chop $enc1);
X      $c2 = unpack("C", chop $enc1);
X
X      $p  = ($c1 - $DOC_FTP_CODE_BASECHAR) +
X	  ($c2 - $DOC_FTP_CODE_BASECHAR) * 26 + 1;
X
X      if ($req =~ /^get (\S+) uuencoded/) {
X	$f = $1;
X	&std_subs;
X
X      } elsif ($req =~ /^get (\S+)$/) {
X	$f = $1;
X	&std_subs;
X	$work_to_do{$f} = $STD_TEXT;
X
X      } elsif ($req =~ /^dir/) {
X	&ls_to_filename("dir", $loc);
X	&std_subs;
X	$last{$f} = $p;
X
X	printf("%4d %-7s %4s dir from %s:%s\n",
X	    $msg, $date, "[1]", $site, $loc);
X      }
X
X      $locs{$f} = $loc;
X      $reqs{$f} = $site{$f} = $site;
X
X      if (!$last{$f}) {
X	$c1 = unpack("C", chop $enc2);
X	$c2 = unpack("C", chop $enc2);
X
X	$last{$f} = ($c1 - $DOC_FTP_CODE_BASECHAR) +
X	    ($c2 - $DOC_FTP_CODE_BASECHAR) * 26 + 1;
X
X	printf("%4d %-7s %4s %s from %s:%s\n",
X	    $msg, $date, "[$last{$f}]", $real{$f}, $site, $loc);
X      }
X
X  ###### doc.ic.ac.uk's FTPMail server (single-part)
X    } elsif (/^([^:]+):(\S+) ([^<]+)<</) {
X      $parts++; $site = $1; $loc = $2; $req = $3;
X
X      $p = 1;
X
X      if ($req =~ /^get (\S+) uuencoded/) {
X	$f = $1;
X	&std_subs;
X	printf("%4d %-7s %4s %s:%s\n",
X	    $msg, $date, "[1]", $site, $loc);
X
X      } elsif ($req =~ /^get (\S+)$/) {
X	$f = $1;
X	&std_subs;
X	$work_to_do{$f} = $STD_TEXT;
X	printf("%4d %-7s %4s %s:%s\n",
X	    $msg, $date, "[1]", $site, $loc);
X
X      } elsif ($req =~ /^dir/) {
X	&ls_to_filename("dir", $loc);
X	&std_subs;
X	printf("%4d %-7s %4s dir from %s:%s\n",
X	    $msg, $date, "[1]", $site, $loc);
X      }
X
X      $last{$f} = $p;
X      $locs{$f} = $loc;
X      $reqs{$f} = $site{$f} = $site;
X
X  ###### garbo.uwasa.fi mailserver
X    } elsif (/^(\d+):(\d+) : (.*)<</) {
X      $parts++; $f = $3; $siz = int $2; $p = int $1;
X
X      &std_subs;
X
X      $locs{$f} = "";			# very difficult to work this out
X      $reqs{$f} = $site{$f} = "garbo.uwasa.fi";
X      $work_to_do{$f} = $TRAILING_CRAP;
X      ($siz == $p) && ($last{$f} = $p,
X	  printf("%4d %-7s %4s %s\n", $msg, $date, "[$p]", $real));
X
X  #####
X    } elsif (/^your ftpmail request has been received/) {
X#     printf("%4d %-7s      decwrl.dec.com ftpmail receipt\n", $msg, $date);
X      &check_receipt;
X
X  #####
X    } elsif (/^ftpmail job completed<</) {
X      printf("%4d %-7s      doc.ic.ac.uk ftpmail results message\n",
X	  $msg, $date);
X
X      &queue_check($DOC_FTP_CHECK, $msg, $date);
X
X  #####
X    } elsif (/^results of ftpmail request/) {
X      printf("%4d %-7s      decwrl.dec.com ftpmail results message\n",
X	  $msg, $date);
X  #   &check_results;
X      &queue_check($FTPMAIL_CHECK, $msg, $date);
X
X  #####
X    } elsif (/^Re: mailserv-request<</) {
X      printf("%4d %-7s      nic.funet.fi results message\n", $msg, $date);
X  #   &check_results;
X      &queue_check($FUNET_CHECK, $msg, $date);
X
X  #####
X    } else {
X      chop; $subj = substr($_, 0, 60);
X      printf("%4d %-7s     \"%s\"\n", $msg, $date, $subj);
X    }
X  }
X  close SC;
X}
X
X################################
X# check a results message for errors
X
Xsub check_results {
X  $scan = $_[0]; $x = 0;
X  open(IN, "show $folder $msg |");
X
X  print "  [$date message $msg]\n";
X  while (<IN>) {
X    s/^\s*//;
X
X  # ftpmail messages
X
X    if (/^-/) {
X      /^--- connecting to (.*)...$/ && ($host = $1);
X      /^--- getting file \((\S*) as/ && ($file = $1);
X      next;
X    }
X
X    /^Connecting to / && ($host = $');
X
X    /^5\d\d[- ]/ && ($x++, print "    $'");
X
X    /^!!! (.*) failed/ &&
X	($x++, print "    $host: $1 failed ($file)\n");
X
X  # funet-nic messages
X
X    # I do this _all_ the time (grr!)
X    /^\*\* .get. is not a recognized command/ &&
X	($x++, print "    use \"send\", not \"get\"!\n");
X
X    /^\*\* / && ($x++, print "    $'");
X
X    /^\* Retrieving of file \`(.*)\' failed.  File not available.$/ &&
X	($x++, print "    $1 not found!\n");
X
X    /^> ([a-z]+) (.*)$/ && ($cmd = $1, $arg = $2);
X    /^\* Found (.*) matches.$/ && ($matches = $1);
X
X  # inline directory/find listings, etc. from funet-nic
X
X    /^\*## Short listing$/ && ($x++, &read_inline(0));
X    /^\* ----------------$/ && ($x++, &read_inline($matches));
X  }
X
X  close IN;
X  ($x == 0) && print "  no errors\n";
X  push (@to_refile, $msg);
X}
X
X################################
X# get a nic.funet.fi directory/find out of inline
X
Xsub read_inline {
X  $is_find = $_[0];	# also doubles as the no of matches
X  if ($is_find < 10) {
X    print "  inline find listing: \"$cmd $arg\" ($matches matches)\n";
X  }
X  while (<IN>) {
X    s/^\*://g;
X    if ($is_find) {
X      last if (/^\* ----------------/);	# end of inline find
X      print "  >>> $_" if ($is_find < 10);
X    } else {
X      last if (/^\*## end of listing/);	# end of inline dir
X    }
X    push(@inline, $_);				# inline segment
X  }
X
X  &ls_to_filename($cmd, $arg, 1);			# note the 1 -> inline.
X  $loc = "nic.funet.fi"; (!-e $loc) && (mkdir($loc, 0777));
X
X  open(INLINE, "> $loc/$f");
X  print INLINE "nic.funet.fi: output of \"$cmd $arg\"";
X  $is_find && (print INLINE " ($matches matches)");
X  print INLINE "\n";
X  print INLINE @inline; close INLINE; @inline = ();
X
X  if (!$is_find) {
X    print "  inline directory listing: $loc/$f\n";
X  } elsif ($is_find > 10) {
X    print "  inline find listing: \"$cmd $arg\" ($matches matches)\n";
X  }
X}
X
X################################
X# check a receipt message for errors
X
Xsub check_receipt {
X  $scan = $_[0];
X
X  open(TRANS, "> _trans");
X  open(IN, "show $folder $msg |"); $x = 0; $trans = 0; $where = "";
X  %headers = ();
X  while (<IN>) {
X    /^([A-Z]\S+): / && ($LOG_HEADERS{$1}) && ($headers{$1} = $_);
X    /^There are (\d+) jobs/ && ($x = $1);
X    /^error shown below/ && ($x = "error");
X    /^>>> commands are:$/ && ($x = "help");
X
X    /^  -- End Of Ftpmail Transcript --/ && ($trans = 0);
X
X    if ($trans) {
X      ($where ne "") && (print TRANS $_);
X      push(@body, $_);
X      /^>>> Connect to (\S*) as/ || next;
X
X      $where = $1;
X      if ($x eq "error") {
X	$line = "$where: error!";
X      } elsif ($x eq "help") {
X	$line = "$where: help file";
X      } else {
X	$line = "$where: no. $x in queue";
X      }
X      $headers{"Subject"} = "Subject: $line\n";
X      for $i (keys %headers) { print TRANS $headers{$i}; }
X      print TRANS "\n";
X      for $i (@body) { print TRANS $i; }
X    }
X    /^  -- Ftpmail Submission Transcript --/ && ($trans = 1);
X  }
X  close IN;
X
X  close TRANS;
X  system("refile -file _trans +logs");
X
X  if ($x eq "error") {
X    printf("%4d %-7s      error!\n", $msg, $date);
X  } elsif ($x eq "help") {
X    printf("%4d %-7s      FTPMail help file\n", $msg, $date);
X  } else {
X    printf("%4d %-7s      receipt ($line)\n", $msg, $date);
X  }
X}
X
X################################
X# perform some standard substitutions that apply for both ftpmail
X# and the funet mailserver.
X
Xsub std_subs {
X  $real = $f;
X  $real =~ s,^.*/([^/]+)$,\1,g;		# get the basename
X  $real =~ s/[^-_+.=@;:A-Za-z0-9]//g;	# for find results, etc.
X
X  $f =~ s/[^A-Za-z0-9]/_/g;		# make a valid variable name
X  $f =~ s/^[0-9]/x/;			# we need numbers, but !as first char
X  $name{$f} = $real;
X  print "$f[$p] = $msg;\n" if ($debug & 1);
X  eval "\$$f[$p] = $msg;" || die($@);
X  $files{$f}++;
X
X  if ($to_be_tagged) {		# this has to happen after filename->ident
X    $work_to_do{$f} = $NEEDS_TAG;
X    $dir_tag{$f} = $dir_tag;
X    $to_be_tagged = 0;
X  }
X}
X
X################################
X# make a filename out of an ls command, eg (with /home as CWD)
X# "ls /home/jmason" -> "ls-home-jmason"
X# "ls jmason" -> "ls-home-jmason"
X# "ls" -> "ls-home"
X
Xsub ls_to_filename {
X  $cmd = $_[0]; $wh = $_[1]; $inline = $_[2];
X  if ($wh eq '') {		# handle relative directories
X    $f = "$cmd-$loc";
X  } elsif ($wh =~ /^\//) {
X    $f = "$cmd-$wh";
X  } else {
X    $f = "$cmd-$loc/$wh";
X  }
X  $f =~ s,[/*?],-,g; $f =~ s, ,.,g; $f=~ s,-+,-,g;
X  (!$inline) &&
X    ($to_be_tagged++, $dir_tag = "$cmd $wh"); # mark it as to-be-tagged
X}
X
X################################
X# $conditions is the conditions to start outputting the lines read.
X# $cmd is the command to output to.
X
X# return value is 0 on success, 1 on fail, 2 on fail and no output file.
X
Xsub decode_type {
X  $cmd = $_[0]; $conditions = $_[1];
X  $filename = $_[2];
X
X  ($work_to_do{$file} == $TRAILING_CRAP) && ($crap_text_after_uue = 1);
X
X  @parts = (0);		# we don't need no element 0
X  if (!$last{$file}) {
X    print "  last part is missing, skipping decode.\n";
X    return;
X  }
X  for ($part=1; $part<=$last{$file}; $part++) {
X    if (!($msg = eval join("","\$",$file,"[",$part,"]"))) {
X      print "  part $part is missing, skipping decode.\n";
X      return;
X    }
X    push(@parts, $msg);
X  }
X
X  unlink $filename if (-e $filename);
X  if ($debug & 2) {
X    open(UU, "> debug-decode");
X  } else {
X    open(UU, "$cmd");
X  }
X  open(DH, ">> Decode.Headers");
X  $decerrs = "/tmp/decode.errors.$$";
X
X  if ($work_to_do{$file} == $NEEDS_TAG) {
X    print UU "$extract_dir: output of \"$dir_tag{$file}\"\n\n";
X  }
X
X  for ($part=1; $part<=$last{$file}; $part++) {
X    printf("  part %-8s", "$part..."); $lines = 0;
X    $msg = $parts[$part];
X    printf("[msg %-5s", "$msg]");	# pad it out nicely
X    open(IN, "show $folder $msg |");
X    if ($crap_text_after_uue) {
X	$check_for_crap_text = '($infile = 0) if ($infile && /^--/);';
X    }
X    $infile = 0; eval '			# use eval for speed
X      while (<IN>) {
X	($infile = 1) if (($infile == 0) && ('.$conditions.'));
X	'.$check_for_crap_text.'
X	if ($infile) {
X	  $lines++;
X	  print UU $_;
X	} else {
X	  print DH $_;
X	}
X      }
X    ';
X    close IN;
X    printf("%9d lines.\n", $lines);
X  }
X  close UU;
X  close DH;
X  if (-e $decerrs && ! -z _) {
X    open (ERRS, "< $decerrs");
X    $errs = join(' ', <ERRS>);
X    close ERRS; $errs =~ s/\s+/ /g; $errs =~ s/\s+$//g;
X    ($errs ne '') && ($errs = " -- $errs");
X    print "decode failed$errs.\n";
X  } else {
X    (!-e $extract_dir) && (mkdir($extract_dir, 0777));
X    if (-e "$extract_dir/$real") {
X      $tail = "aa";		# don't overwrite anything
X      while (-e "$extract_dir/$real.$tail") { $tail++; }
X      $real .= ".$tail";
X    }
X    rename($filename, "$extract_dir/$real");
X    print "  ",`ls -l $extract_dir/$real`;
X    push (@to_refile, @parts);
X  }
X}
X
X################################
X# refile the parts that we've safely processed.
X
Xsub refile_done {
X  if (!$opt_nomove && (($no = $#to_refile) > 1)) {
X    open (RMM, "| sh -i > /dev/null 2>&1");
X    if ($opt_rmm) {
X      print "Rmm'ing $no messages.\n";
X      $cmd = "rmm $folder";
X      $postcmd = "";
X    } else {
X      print "Refiling $no messages into $decoded.\n";
X      $cmd = "refile -src $folder";
X      $postcmd = "$decoded";
X    }
X    foreach $msg (@to_refile) { print RMM "$cmd $msg $postcmd\n"; }
X    close RMM;
X  }
X}
END_OF_FILE
if test 18080 -ne `wc -c <'procftpmail'`; then
    echo shar: \"'procftpmail'\" unpacked with wrong size!
fi
chmod +x 'procftpmail'
# end of 'procftpmail'
fi
echo shar: End of shell archive.
exit 0



.