rplctn/uploader.pl

   1 #! /perl/bin/perl
   2 #
   3 # Uploader: upload one or more RFC822-format messages in the specified
   4 # directory to a (local) SMTP server for on-delivery.
   5 #
   6 # Written by Ewen McNeill, 18/11/1997.
   7 #
   8 # This program scans the specified directory for messages to send (all
   9 # files in the directory are considered to be messages).  Any messages
  10 # that are found are instantiated as Mail::Internet objects, and then
  11 # delivered with SMTP to the local SMTP server.
  12 #
  13 #---------------------------------------------------------------------------
  14
  15 use 5;
  16
  17 use DirHandle;                      # Directory handling
  18 use Net::SMTP;                      # Simple Mail Transfer Protocol
  19
  20 require "sendconf.ph";              # Sender configuration information
  21
  22 #---------------------------------------------------------------------------
  23
  24 # Subroutines
  25
  26 # SendMessage: expects filename of message to send (and that the file will
  27 #              exist in the outbound directory).
  28 #
  29 # Sends the message to the SMTP server for on-delivery, and if that is successful
  30 # moves the original file into the sent area.
  31 #
  32 # Returns 1 if the file is delivered to the SMTP server, and 0 otherwise.
  33
  34 sub sendmessage
  35 {
  36   my ($filename) = @_;
  37   die "No file to send\n" if (! defined($filename));
  38
  39   if ( ! open(MSG, "<$SendConf::outgoing/$filename") )
  40   {
  41     warn "Unable to open \"$SendConf::outgoing/$filename\" -- skipping file\n";
  42     return 0;
  43   }
  44
  45   # Note: need to specify who to say on the HELO line, because Windows isn't
  46   # particularly good at figuring it out.
  47   my $smtp = Net::SMTP->new($SendConf::SMTPserver,
  48                             Hello => $SendConf::myhostname);
  49   if (!defined($smtp))
  50   {
  51     warn "Cannot contact SMTP server: $SendConf::SMTPserver\n";
  52     warn "Skipping file: $filename\n";
  53     return 0;
  54   }
  55
  56   my $rc;
  57
  58   # Do the envelope stuff
  59   $rc = $smtp -> mail($SendConf::myemail);
  60   if (! $rc)
  61   { warn "Error encountered sending envelope from\n"; }
  62   else
  63   {
  64     $rc = $smtp -> to($SendConf::theiremail);
  65     if (! $rc)
  66     { warn "Error encountered sending envelope to\n"; }
  67     else
  68     {
  69       $rc = $smtp -> to($SendConf::copyemail);
  70       if (! $rc)
  71       { warn "Error encountered sending envelope cc\n"; }
  72     }
  73   }
  74
  75   if (! $rc)
  76   {
  77     warn "Cannot start mail.  Abandoning mail transfer ($filename).\n";
  78     $smtp->reset();
  79     $smtp->quit();
  80     return 0;
  81   }
  82
  83   # Send out the body
  84   $rc = $smtp->data();
  85   if (! $rc)
  86   {
  87     warn "Problems starting message data ($filename).  Abandoning transfer.\n";
  88     $smtp->reset();
  89     $smtp->quit();
  90     return 0;
  91   }
  92
  93   while(<MSG>)
  94   {
  95     $rc = $smtp->datasend($_);
  96     if (! $rc)
  97     { warn "Problems sending data line: $_\n";
  98       warn "Attempting to continue.\n";       # XXX -- is this wise?
  99     }
 100   }
 101   $rc = $smtp->dataend();
 102   if ($rc)
 103   { # Message was delivered correctly, tidy up.
 104     close(MSG);
 105     $smtp->quit();
 106
 107     unlink("$SendConf::outgoingprocessed/$filename") &&
 108       warn "Removed older copy of \"$filename\" from processed directory\n";
 109
 110     rename("$SendConf::outgoing/$filename",
 111            "$SendConf::outgoingprocessed/$filename") ||
 112       warn "Message transfered correctly, unable to move out of way ($filename)\n";
 113
 114     return 1;
 115   }
 116   else
 117   { # Problems sending the message -- leave it alone.
 118     close(MSG);
 119     $smtp->reset();
 120     $smtp->quit();
 121     warn "Problems sending message ($filename).  Leaving to try again later.\n";
 122
 123     return 0;
 124   }
 125 }
 126
 127 #---------------------------------------------------------------------------
 128
 129 # Mainline
 130
 131 # Check configuration values are set
 132
 133 die "No outgoing directory" if (! defined($SendConf::outgoing));
 134 die "No processed directory" if (! defined($SendConf::outgoingprocessed));
 135 die "No SMTP server" if (! defined($SendConf::SMTPserver));
 136 die "No local email address" if (! defined($SendConf::myemail));
 137 die "No remote email address" if (! defined($SendConf::theiremail));
 138 die "Who am I anyway?" if (! defined($SendConf::myhostname));
 139
 140 # Scan the directory for files to process, and if there are any process them
 141 # one at a time.
 142
 143 my $numprocessed = 0;
 144
 145 my $dir = new DirHandle $SendConf::outgoing;
 146 if (defined $dir)
 147 {
 148   #print "Scanning directory: ", $SendConf::outgoing, "\n";
 149   my $file = "";
 150   while (defined($file = $dir->read))
 151   {
 152     if (-f "$SendConf::outgoing/$file")
 153     { if (sendmessage($file))
 154       { $numprocessed++; }
 155     }
 156   }
 157 }
 158 else
 159 {
 160   warn "Unable to read from directory: ", $SendConf::senddir, "\n";
 161   print "0 files processed.\n";
 162   exit 0;
 163 }
 164
 165 if ($numprocessed != 1)
 166 { print "$numprocessed files processsed.\n"; }
 167 else
 168 { print "1 file processed.\n"; }
 169
 170 exit $numprocessed;