rplctn/decoder.pl

   1 #! /perl/bin/perl -w
   2 #
   3 # Decoder: process one or more RFC822 messages containing MIME encoded
   4 #          files (as produced by encoder), into the constituant files.
   5 #
   6 # Written by Ewen McNeill, 19/11/1997.
   7 #
   8 # This program scans the supplied directory for files; each file is
   9 # considered to be a message.  If the message is in a suitable format
  10 # then, the enclosed ZIP file will be extracted into a temporary file,
  11 # and then decompressed into the received directory.  Each file that
  12 # is successfully processed is then moved into the processed directory.
  13 #
  14 #---------------------------------------------------------------------------
  15
  16 use 5;
  17
  18 use Cwd;                           # So we know where we are!
  19 use DirHandle;                     # Scanning directories
  20 use Mail::Header;                  # Internet mail messages
  21 use MIME::Base64;                  # MIME encoding.
  22 use strict;
  23
  24 require "recvconf.ph";             # Configuration of receive tools.
  25
  26 #---------------------------------------------------------------------------
  27
  28 # Subroutines
  29
  30 # DecodeMessage -- expects to receive a filename
  31 #
  32 # The file is assumed to be in the incoming directory.  It is treated as
  33 # a RFC822 message, the headers read in, and scanned for suitable things.
  34 #
  35 # If it is suitable, then the enclosed file is extracted into the temporary
  36 # directory, and the file is unzipped into the load directory.
  37 #
  38 # Returns 1 if message processed successfully; 0 otherwise.
  39
  40 sub decodemessage
  41 {
  42   my ($filename) = @_;
  43   die "No filename" if (! defined($filename));
  44
  45   #print "Processing: $filename\n";
  46
  47   if (! open(MSG, "<$RecvConf::downloaded/$filename"))
  48   {
  49     warn "Unable to open \"$RecvConf::downloaded/$filename\" -- skipping\n";
  50     return 0;
  51   }
  52
  53   my $message = new Mail::Header(\*MSG);
  54   if (! defined($message))
  55   {
  56     warn "Unable to create new Internet Message Header object\n";
  57     close(MSG);
  58     return 0;
  59   }
  60
  61   my $subject = $message->get('Subject');
  62   my $mime    = $message->get('MIME-Version');
  63   my $content = $message->get('Content-Type');
  64   my $encoding= $message->get('Content-Transfer-Encoding');
  65
  66   if (!defined($subject) || !defined($mime) || !defined($content) ||
  67       !defined($encoding))
  68   {
  69     warn "Required header fields missing from file ($filename) -- skipping\n";
  70     close(MSG);
  71     return 0;
  72   }
  73
  74   if ($subject !~ /^Transfer of ".*"$/)
  75   {
  76     warn "Subject line invalid in file ($filename) -- skipping\n";
  77     close(MSG);
  78     return 0;
  79   }
  80   if ($mime !~ /^1.0/)
  81   {
  82     warn "Unexpected MIME version in file ($filename) -- skipping\n";
  83     close(MSG);
  84     return 0;
  85   }
  86   if ($content !~ /^application\/x-zip-compressed; name="\S+\.zip"$/)
  87   {
  88     warn "Unexpected Content-Type in file ($filename) -- skipping\n";
  89     warn "Content: $content\n";
  90     close(MSG);
  91     return 0;
  92   }
  93   if ($encoding !~ /^base64$/)
  94   {
  95     warn "Unexpected encoding in file ($filename) -- skipping\n";
  96     close(MSG);
  97     return 0;
  98   }
  99
 100   # Okay, looks like our message.  The rest of it should be a base64
 101   # encoded file, so we'll pull that into an scalar, and decode it.
 102
 103   my $base64len  = -s "$RecvConf::downloaded/$filename";
 104   my $base64text;
 105   read MSG, $base64text, $base64len;
 106   my $rawtext    = decode_base64($base64text);
 107
 108   close(MSG);
 109
 110   if (!defined($rawtext) || !defined($base64text))
 111   {
 112     warn "Error decoding file from message in file ($filename) -- skipping\n";
 113     return 0;
 114   }
 115
 116   # Now we'd better save that somewhere.  We used a fixed filename because
 117   # (a) it makes us less vulnerable to attacks from outside, and (b) it
 118   # makes life easier for decoding, and (c) it ensures the old ones go
 119   # away anyway.
 120
 121   if (! open(ZIP, ">$RecvConf::tempdir/received.zip"))
 122   {
 123     warn "Unable to open temporary file: $RecvConf::tempdir/received.zip\n";
 124     return 0;
 125   }
 126
 127   # Switch it into binary mode -- important since we're about to write
 128   # binary data out to it!
 129   binmode ZIP;
 130
 131   if (! print ZIP $rawtext)
 132   {
 133     warn "Unable to write data out to temporary file.  Abandoning file.\n";
 134     close(ZIP);
 135     unlink("$RecvConf::tempdir/received.zip") ||
 136       warn "Stray temporary file remains -- unable to remove\n";
 137     return 0;
 138   }
 139
 140   if (! close(ZIP))
 141   {
 142     warn "Unable to close temporary zip file.  Abandoning.\n";
 143     unlink("$RecvConf::tempdir/received.zip") ||
 144       warn "Stray temporary file remains -- unable to remove\n";
 145     return 0;
 146   }
 147
 148   # We've got it in a temporary file, now we need to extract the file out
 149   # of the zip, and into the destination directory.  We get the zip program
 150   # to do most of this hard work, and assume it worked unless the zip program
 151   # complains to us.
 152   #
 153   # WARNING: Do NOT extract directories.  Make certain they are junked, not
 154   # only to ensure the files end up where we want them, but to reduce the
 155   # security concerns.
 156   #
 157   # NOTE: we use the overwrite flag to avoid things hanging on files existing
 158   # and to get the (hopefully) latest copy in the directory.
 159   #
 160   # WARNING: pkunzip doesn't appear to have a way to fix the output directory
 161   # somewhere other than "current directory"; and it is not possible to
 162   # reliably change directories then give a full path to the ZIP 'cause
 163   # chances are on a Windows system it'll have spaces in it.
 164   #
 165   # Thus: Infozip 5.1 or greater is required.
 166   #
 167   # Note: remove -q if you want to see zip at work.
 168   #
 169   my $zipfile = "$RecvConf::tempdir/received.zip";
 170
 171   my $rc = system("unzip -o -j -q $zipfile -d $RecvConf::recvdir");
 172
 173   unlink("$RecvConf::tempdir/received.zip") ||
 174     warn "Unable to remove temporary file -- stray remains\n";
 175
 176   if ($rc != 0)
 177   {
 178     warn "Unzip failed.  Abandoning file ($filename)\n";
 179     return 0;
 180   }
 181   else
 182   { # Unzipped successfully, move file into processed directory
 183     unlink("$RecvConf::downloadprocessed/$filename") &&
 184       warn "Removed old copy of \"$RecvConf::downloadprocessed/$filename\"\n";
 185     rename("$RecvConf::downloaded/$filename",
 186            "$RecvConf::downloadprocessed/$filename") ||
 187       warn "Unable to rename \"$filename\" into processed directory\n";
 188
 189     # Yippee, it worked.
 190     return 1;
 191   }
 192 }
 193
 194 #---------------------------------------------------------------------------
 195
 196 # Mainline
 197
 198 die "No download directory"  if (! defined($RecvConf::downloaded));
 199 die "No processed directory" if (! defined($RecvConf::downloadprocessed));
 200 die "No received directory"  if (! defined($RecvConf::recvdir));
 201 die "No temporary directory" if (! defined($RecvConf::tempdir));
 202
 203 my $numprocessed = 0;
 204 my $dir = new DirHandle $RecvConf::downloaded;
 205 if (defined $dir)
 206 {
 207   #print "Scanning directory: ", $RecvConf::downloaded, "\n";
 208   my $file = "";
 209   while (defined($file = $dir->read))
 210   {
 211     if (-f "$RecvConf::downloaded/$file")
 212     { if (decodemessage($file))
 213       { $numprocessed++; }
 214     }
 215   }
 216 }
 217 else
 218 {
 219   warn "Unable to read from directory: ", $RecvConf::downloaded, "\n";
 220   print "0 files processed.\n";
 221   exit 0;
 222 }
 223
 224 if ($numprocessed != 1)
 225 { print "$numprocessed files processsed.\n"; }
 226 else
 227 { print "1 file processed.\n"; }
 228
 229 exit $numprocessed;