rplctn/mail-err.pl

   1 #! /perl/bin/perl
   2 #
   3 # Uploader: upload the "rplctn\dump\log\seq-err.log" file to a (local)
   4 # SMTP server for on-delivery.  Addressees for the message are
   5 # specified in a err-conf.ph file.
   6 #
   7 # Written by Andrew McMillan, 2/5/1998.  All credit to Ewen McNeill, for
   8 # the programs (encoder.pl / uploader.pl) which this is plagiarised from,
   9 # and of course the errors are all mine.
  10 #
  11 # This program looks for the log file which (if it exists) is converted into
  12 # an internet e-mail message and then instantiated as a Mail::Internet object,
  13 # to be delivered with SMTP to the local SMTP server.
  14 #
  15 #---------------------------------------------------------------------------
  16
  17 use 5;
  18
  19 use DirHandle;                      # Read directories (the OO way)
  20 use Mail::Header;
  21 use strict;
  22 use Net::SMTP;                      # Simple Mail Transfer Protocol
  23
  24 require "sendconf.ph";              # Sender configuration information
  25 require "recvconf.ph";              # Receiver configuration information
  26 require "err-conf.ph";                  # Error notification configuration
  27
  28 #---------------------------------------------------------------------------
  29
  30 # Subroutines
  31
  32 # SendMessage: expects filename of message to send (and that the file will
  33 #              exist in the outbound directory).
  34 #
  35 # Sends the message to the SMTP server for on-delivery, and if that is successful
  36 # moves the original file into the sent area.
  37 #
  38 # Returns 1 if the file is delivered to the SMTP server, and 0 otherwise.
  39
  40 sub sendmessage
  41 {
  42   my ($filename) = @_;
  43   die "No file to send\n" if (! defined($filename));
  44
  45   if ( ! open(MSG, "<$SendConf::outgoing/$filename") )
  46   {
  47     warn "Unable to open \"$SendConf::outgoing/$filename\" -- skipping file\n";
  48     return 0;
  49   }
  50
  51   # Note: need to specify who to say on the HELO line, because Windows isn't
  52   # particularly good at figuring it out.
  53   my $smtp = Net::SMTP->new($SendConf::SMTPserver,
  54                             Hello => $SendConf::myhostname);
  55   if (!defined($smtp))
  56   {
  57     warn "Cannot contact SMTP server: $SendConf::SMTPserver\n";
  58     warn "Skipping file: $filename\n";
  59     return 0;
  60   }
  61
  62   my $rc;
  63
  64   # Do the envelope stuff
  65   $rc = $smtp -> mail($SendConf::myemail);
  66   if (! $rc)
  67   { warn "Error encountered sending envelope from\n"; }
  68   else
  69   {
  70     $rc = $smtp -> to($SendConf::theiremail);
  71     if (! $rc)
  72     { warn "Error encountered sending envelope to\n"; }
  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 #---------------------------------------------------------------------------
 130 # constructmessage: expects a filename to process (including directory);
 131 #
 132 # At present this simply prepends suitable RFC822 headers and cutesy bits
 133
 134 # Returns 1 if the file is processed correctly, 0 otherwise.
 135
 136 sub constructmessage
 137 {
 138   my ($pathname) = @_;
 139   die "Filename undefined" if (!defined($pathname));
 140
 141   my @fileparts = split( '/', $pathname );
 142   my $filename = "";
 143   my $remainder = "";
 144   ($filename, $remainder) = reverse @fileparts;
 145
 146   print "Filename to process = ", $pathname, "\n";
 147   print "Base filename = ", $filename, "\n";
 148
 149   # Now we have the filename we can start building the message.
 150
 151   if (open MESSAGE, ">$SendConf::outgoing/$filename")
 152   {
 153     # Now we can rock and roll.  We've got an input file and an output file.
 154     # Let's build the header first.
 155
 156     my $header = new Mail::Header;
 157     $header->add("From",    $SendConf::myemail);
 158     $header->add("To",      $ErrorConf::sendlogto);
 159     $header->add("Subject", "HELP\!  Replication file not received in sequence\!");
 160
 161     # And spit it out to the file.
 162     $header->print(\*MESSAGE);
 163     print MESSAGE "\n";
 164     print MESSAGE "\n";
 165     print MESSAGE "OK, I seem to be having a problem here with a replication file which\n";
 166     print MESSAGE "has gone missing.  If one of you could arrange for the file indicated\n";
 167     print MESSAGE "in the error message below to be re-sent I could continue to do my job.\n";
 168     print MESSAGE "\n";
 169     print MESSAGE "------------------- start of error messages -----------------\n";
 170
 171     # Now we need to append the file of errors
 172     if (open FROM, "<$pathname")
 173     {
 174       my $filebuf;
 175       while( read( FROM, $filebuf, 4096)) {
 176         print MESSAGE $filebuf;
 177       }
 178     }
 179
 180     # Now some trailer stuff.
 181     print MESSAGE "-------------------- end of error messages ------------------\n";
 182     print MESSAGE "\n";
 183     print MESSAGE "\n";
 184     print MESSAGE "All help gratefully appreciated,\n";
 185     print MESSAGE "                                   Deus Ex Machina\n";
 186     print MESSAGE "\n";
 187
 188     # And we're done -- clean things up.
 189     close(FROM);
 190     close(MESSAGE);
 191     return 1;
 192   }
 193   else
 194   {
 195     warn "Could not open output file: ", $SendConf::outgoing, "/", $filename, "\n";
 196     return 0;
 197   }
 198 }
 199
 200
 201 #---------------------------------------------------------------------------
 202
 203 # Mainline
 204
 205 # Check configuration values are set
 206
 207 die "No outgoing directory" if (! defined($SendConf::outgoing));
 208 die "No processed directory" if (! defined($SendConf::outgoingprocessed));
 209 die "No SMTP server" if (! defined($SendConf::SMTPserver));
 210 die "No local email address" if (! defined($SendConf::myemail));
 211 die "No remote email address" if (! defined($SendConf::theiremail));
 212 die "Who am I anyway?" if (! defined($SendConf::myhostname));
 213
 214 my $numprocessed = 0;
 215
 216 if (-f "$ErrorConf::seqlogfile")
 217 {
 218   constructmessage($ErrorConf::seqlogfile);
 219
 220   my $dir = new DirHandle $SendConf::outgoing;
 221   if (defined $dir)
 222   {
 223     print "Scanning directory: ", $SendConf::outgoing, "\n";
 224     my $file = "";
 225     while (defined($file = $dir->read))
 226     {
 227       if (-f "$SendConf::outgoing/$file")
 228       { if (sendmessage($file))
 229         {
 230           $numprocessed++;
 231           unlink $ErrorConf::seqlogfile;
 232         }
 233       }
 234     }
 235   }
 236   else
 237   {
 238     warn "Unable to read from directory: ", $SendConf::senddir, "\n";
 239     print "0 files processed.\n";
 240     exit 0;
 241   }
 242 }
 243
 244
 245 if ($numprocessed != 1)
 246 { print "$numprocessed messages processsed.\n"; }
 247 else
 248 { print "1 message processed.\n"; }
 249
 250 exit $numprocessed;