rplctn/encoder.pl

   1 #! /perl/bin/perl -w
   2 #
   3 # Encoder: encode one or more files in specified directory (in configuration
   4 # file) into RFC822 messages to be sent by electronic mail.
   5 #
   6 # Written by Ewen McNeill, 18/11/1997.
   7 #
   8 # The specified directory is searched for files, and each file found is processed
   9 # into an individual message in the outbound directory.  The original is then
  10 # moved into the processed directory.
  11 #
  12 # At present the processing for an individual file consists of:
  13 #    compression with the Zip utility (to reduce overall size)
  14 #    MIME (base64) encoding
  15 #    RFC822 (and MIME) headers prepended.
  16 #
  17 #---------------------------------------------------------------------------
  18
  19 use 5;
  20
  21 use DirHandle;                 # Read directories (the OO way)
  22 use MIME::Base64;              # Base64 encoding
  23 use Mail::Header;
  24 use strict;
  25
  26 require "sendconf.ph";         # Configuration information for sender
  27
  28 #---------------------------------------------------------------------------
  29
  30 # Subroutines
  31
  32 # Processfile: expects filename to process (without directory); file is assumed
  33 #              to be in the senddir directory.
  34 #
  35 # At present this: Builds a Zip of the incoming file,
  36 #                  prepends suitable RFC822 (and MIME) headers,
  37 #                  and then appends base64 encoding of the file.
  38
  39 # Returns 1 if the file is processed correctly, 0 otherwise.
  40
  41 sub processfile
  42 {
  43   my ($filename) = @_;
  44   die "Filename undefined" if (!defined($filename));
  45
  46   #print "Filename to process = ", $filename, "\n";
  47
  48   # Figure out name of zip file to build
  49   my ($zipfile) = $filename;
  50
  51   if ($filename =~ /\.(\S+)/)
  52   {  $zipfile =~ s/\.\S+/.zip/; }
  53   else
  54   {  $zipfile = $filename . ".zip"; }
  55
  56   #print "Zip file = ", $zipfile, "\n";
  57
  58   # Build Zip file (note: make sure this junks directories, use "-j" with
  59   # InfoZip; also make sure it accepts "/" slashes :-) )
  60   #
  61   # XXX -- it'd be nice if we could hide stdout while doing this.
  62   my $rc =
  63      system("zip -j $SendConf::tempdir/$zipfile $SendConf::senddir/$filename");
  64
  65   if ($rc != 0)
  66   {
  67     warn "Zip failed! (RC = $rc)  Skipping $SendConf::senddir/$filename\n";
  68     return 0;
  69   }
  70
  71   # Now we have the zip file, at $SendConf::tempdir/$zipfile, so we can start
  72   # building the message.
  73
  74   if (! open ZIP, "$SendConf::tempdir/$zipfile")
  75   {
  76     warn "Unable to open zip file at: $SendConf::tempdir/$zipfile -- skipping\n";
  77     return 0;
  78   }
  79
  80   # Zip files have binary data, so we need binary mode for them.
  81   binmode ZIP;
  82
  83   if (open MESSAGE, ">$SendConf::outgoing/$filename")
  84   {
  85     # Now we can rock and roll.  We've got an input file and an output file.
  86     # Let's build the header first.
  87
  88     my $header = new Mail::Header;
  89     $header->add("From",    $SendConf::myemail);
  90     $header->add("To",      $SendConf::theiremail);
  91     $header->add("Subject", "Transfer of \"" . $filename . "\"");
  92
  93     # MIME headers (these are a hack based on the headers Microsoft mail
  94     # spits out; they'll do for now)
  95     $header->add("MIME-Version", "1.0");
  96     $header->add("Content-Type", "application/x-zip-compressed; name=\"$zipfile\"");
  97     $header->add("Content-Transfer-Encoding", "base64");
  98
  99     # And spit it out to the file.
 100     $header->print(\*MESSAGE);
 101     print MESSAGE "\n";
 102
 103 #    # This next bit is a waste of time, but we need two parts to satisfy
 104 #    # multipart/mixed.  XXX -- remove this bit when find proper type for above.
 105 #    print MESSAGE "--- cut here ---\n";
 106 #    print MESSAGE "Content-Type: text/plain; charset=\"us-ascii\"\n";
 107 #    print MESSAGE "Content-Transfer-Encoding: 7bit\n";
 108 #    print MESSAGE "\n";
 109 #    print MESSAGE "Attached, one zip file.  One size fits all.\n";
 110 #    print MESSAGE "\n";
 111
 112     # Introduce our file
 113 #    print MESSAGE "--- cut here ---\n";
 114 #    print MESSAGE "Content-Type: application/x-zip-compressed; name=\"" .
 115 #                  $zipfile . "\"\n";
 116 #    print MESSAGE "Content-Transfer-Encoding: base64\n";
 117 #    print MESSAGE "\n";
 118
 119     # Now we need to base64 encode the file, and spit that out next.
 120     # WARNING: <ZIP> style read-it-all often doesn't seem to in Win32 port,
 121     #          so use read to read things in.  Read for file length, plus a
 122     #          bit more just to be sure we got it all :-)
 123     #
 124     my $thezip;
 125     my $ziplen = -s "$SendConf::tempdir/$zipfile";
 126     read ZIP, $thezip, $ziplen + 1024;
 127     my $base64zip = encode_base64($thezip);
 128     print MESSAGE $base64zip;
 129
 130     # Now some MIME trailer stuff.
 131     print MESSAGE "\n";
 132 #    print MESSAGE "--- cut here ---\n";
 133
 134     # And we're done -- clean things up.
 135     close(ZIP);
 136     close(MESSAGE);
 137     unlink("$SendConf::tempdir/$zipfile");
 138     unlink("$SendConf::sendprocessed/$filename") &&
 139       warn "Removed older copy of \"$filename\" from processed directory\n";
 140     rename("$SendConf::senddir/$filename","$SendConf::sendprocessed/$filename") ||
 141       warn "Unable to rename \"$filename\" into processed directory.\n";
 142
 143     return 1;
 144   }
 145   else
 146   {
 147     warn "Could not open output file: ", $SendConf::outgoing, "/", $filename, "\n";
 148     unlink $SendConf::tempdir . "/" . $zipfile;
 149     return 0;
 150   }
 151 }
 152
 153
 154
 155 #---------------------------------------------------------------------------
 156 # Mainline
 157
 158 # Check configuration values are set
 159
 160 die if (! defined($SendConf::senddir));
 161 die if (! defined($SendConf::sendprocessed));
 162 die if (! defined($SendConf::outgoing));
 163 die if (! defined($SendConf::myemail));
 164 die if (! defined($SendConf::theiremail));
 165
 166 # Scan the directory for files to process, and if there are any process them
 167 # one at a time.
 168
 169 my $numprocessed = 0;
 170
 171 my $dir = new DirHandle $SendConf::senddir;
 172 if (defined $dir)
 173 {
 174   #print "Scanning directory: ", $SendConf::senddir, "\n";
 175   my $file = "";
 176   while (defined($file = $dir->read))
 177   {
 178     if (-f "$SendConf::senddir/$file")
 179     { if (processfile($file))
 180       { $numprocessed++; }
 181     }
 182   }
 183 }
 184 else
 185 {
 186   warn "Unable to read from directory: ", $SendConf::senddir, "\n";
 187   print "0 files processed.\n";
 188   exit 0;
 189 }
 190
 191 if ($numprocessed != 1)
 192 { print "$numprocessed files processsed.\n"; }
 193 else
 194 { print "1 file processed.\n"; }
 195
 196 exit $numprocessed;
 197