contrib/amd/scripts/lostaltmail.in

   1 #!@PERL@ -sw
   2 #
   3 # Package:      am-utils-6.0
   4 # Author:       James Tanis <jtt@cs.columbia.edu>
   5 #
   6
   7 ############################################################################
   8 #
   9 # lostaltmail -- remail files files found alt_mail (or -a argument to hlfsd) to
  10 # whomever should receive it. This version is for SMTP varient which
  11 # support VRFY as a non-expanding verifier!!! (sendmail V8 is a an
  12 # example).
  13 #
  14 # Usage: lostaltmail [-debug] [-nomail] [-noverify]
  15 #
  16 #               GLOBAL VARIABLES (as if you care :-) )
  17 # Probably a very incomplete list.
  18 #
  19 # Everything in the config file for this program *and* ...
  20 #
  21 # $debug: set it from the command line with -debug. Does the obvious
  22 # $nomail: set it from the command line with -nomail. *Not* implied by
  23 #        $debug
  24 # $currentTO: The addresss we are currently checking on.  Actually this is
  25 #       left over from an earlier version of lostaltmail and will hopefully
  26 #       go away.
  27 # $noverify: set it from the address line. Avoid verification of $currentTO.
  28 #       This should be relatively safe as long as your are willing to
  29 #       endure bounces from mail that cannot be redelivered as opposed to
  30 #       just getting a warning. UNTESTED (but should work).
  31 #
  32 # $logopen: state variable indicating weather the log file (should there be
  33 #       one) is in fact open.
  34 #
  35 # @allentries: Array of all the directory entries in $MAILDIR
  36 # @allnames: Array of all *likely* recipients. It is created from @allentries
  37 #       sans junk files (see $MAILJUNK and $LOCALMAILJUNK)
  38 # @wanderers: Array of all the files associated with a *single* address
  39 #       which might need remailing.  Should lostaltmail die unexpectedly,
  40 #       it might leave a temporary file containing messages it was
  41 #       currently trying to deliver.  These will get picked and resent
  42 #       later.
  43 #
  44 # VRFY: Handle onto SMTP verification channel.  Not to be confused with mail
  45 #       delivery; only verification occurs accross this handle.
  46 #
  47 ############################################################################
  48
  49 ##############################################################################
  50 #                                                                            #
  51 #                               SMTP_SEND                                    #
  52 #                                                                            #
  53 ##############################################################################
  54 #
  55 # Send a message to the smtp channel. Inserts the necessary NEWLINE if it
  56 # does not exist;
  57 # I stole this from myself. It shouldn nott be printing errors to STDERR, but
  58 # this is a quick hack.
  59 #
  60 sub smtp_send {
  61     local ($msg) = @_;
  62     local ($length);
  63
  64     $length=length($msg);
  65
  66     if ( $msg !~ /^.*\n$/ ) {
  67         $msg = $msg . "\n";
  68         $length++;
  69     }
  70
  71
  72     if ( ! syswrite (VRFY, $msg, $length)) {
  73         print STDERR "Failing SMTP write: $msg";
  74         return 0;
  75     }
  76
  77     return 1;
  78 }
  79
  80 ##############################################################################
  81 #                                                                            #
  82 #                               SMTP_RECV                                    #
  83 #                                                                            #
  84 ##############################################################################
  85 #
  86 # Read in lines from SMTP connection and return the final
  87 #       Really hideous -- please excuse.
  88 #
  89 sub smtp_recv {
  90     local ($line,$rin, $win, $ein, $readbuf, $ret);
  91     $readbuf = "";
  92
  93     $rin = $win = $ein = '';    # Null fd sets,
  94     vec ($rin, fileno(VRFY), 1) = 1; # Stolen straight from the example;
  95     $ein = $rin | $win;         # This is probably useless
  96
  97
  98 LINE_OF_INPUT:
  99     while (1) {                 # Read in all the input
 100
 101         if ((select ( $rin, $win, $ein, 600.0))[0]  == 0 ) {
 102             print "select returned -1" if ($debug);
 103             return -1;  # timeout
 104         }
 105         sysread (VRFY, $readbuf, 1024);
 106         chop ($readbuf);
 107
 108         foreach $line ( split('\n', $readbuf)) {
 109
 110             # This loop is actually needed since V8 has a multi-line greet.
 111
 112             ( $line =~ /^(\d\d\d).*/ && ($SMTP_retval=$1)) ||
 113                 warn "Badly formed reply from SMTP peer: $line\n";
 114
 115             # Space after return code indicates EOT
 116
 117             if ($line =~ /^\d\d\d /) {
 118                 $ret = $line;   # Oddly $line is in a different context here;
 119                                 # and thus we need to export it out of the
 120                                 # while loop via $ret.
 121                 last LINE_OF_INPUT;
 122             }
 123         } # End of read.
 124     } # End of input.
 125
 126     return $ret;
 127 }
 128
 129
 130
 131
 132 ##############################################################################
 133 #                                                                            #
 134 #                               LOG_INFO                                     #
 135 #                                                                            #
 136 ##############################################################################
 137 #
 138 #
 139 # Opens appropriate logging file -- STDOUT (cron) or temp file (mail).
 140 #
 141 sub Log_info {
 142     local($message) = @_;
 143
 144     if ( !$logopened )  {
 145         if ( $MAILGRUNT eq "" || $debug) {
 146             open (LOGFILE, ">-") || die  "Unable to open stdout";
 147         }
 148         else {
 149             # Snarf the log into a tmp file for final mailing to MAILGRUNT
 150             $logfile = $LOGFILE . ".$$";
 151             open (LOGFILE, (">". "$logfile")) || die "Unable to create log file";
 152         }
 153     }
 154
 155     $logopened=1;               # Note that the log is now open
 156
 157     # Heart of the function.
 158     print LOGFILE "$message";
 159
 160     print LOGFILE "\n" if ( index($message,"\n") == -1 );
 161 }
 162
 163 ##############################################################################
 164 #                                                                            #
 165 #                               LOCK_FILE                                    #
 166 #                                                                            #
 167 ##############################################################################
 168
 169 #
 170 # Tries to grab a lock on the supplied file name.
 171 # Spins for a bit if it can't on the assumption that the lock will be released
 172 #       quickly.  If it times out and it's allowed to requeue, it will defer
 173 #       until later, other wise write a message to loginfo.
 174
 175 # If a recurring error or really unexpected situation arrises, return
 176 #       ABORT_RESEND
 177 #
 178 #  PARAMETERS
 179 # mailfile: path to the file to resend.
 180 # should_requeue: BOOLEAN - TRUE if the mailfile should be put on the
 181 # queue for a later retry if we can not finish
 182 # now.
 183
 184 sub Lock_file {
 185
 186     local($mailfile,$should_requeue,$i,$new_lost_file) = @_;
 187
 188 # We need to rename the current mailbox so that mail can loop back into it if
 189 # the resent mail just gets looped right back to us.
 190     $new_lost_file = $mailfile . ".$$";
 191
 192 #  make a tmpfile name based on mailfile;
 193     $lostlockfile = "$mailfile" . "$LOCKEXT";
 194
 195     if ( ! open(LOCKFILE, (">" . $lostlockfile)) ) {
 196         printf(STDERR "Could not create lostlockfile for %s: %s\n", $mailfile,$!);
 197         return $ABORT_RESEND;
 198     }
 199     close(LOCKFILE);
 200
 201     $maillockfile = "$mailfile" . "$LOCAL_LOCK_EXT";
 202
 203     for ($i=0; $i < $LOCK_RETRIES && ! link ($lostlockfile, $maillockfile);
 204          $i++) {
 205         sleep(1);
 206     }
 207
 208     unlink($lostlockfile);      # No matter what eliminate our cruft
 209
 210     if ( $i == $LOCK_RETRIES ) {
 211         &Log_info("Could not grab lock on: " . "$mailfile" . " :timed out");
 212         if ( $should_requeue ) {
 213             &Log_info("Requeing " . "$mailfile" . " for later retry");
 214             $retry_list .= " $mailfile";
 215         }
 216         else {
 217             &Log_info("Giving up on: " . "$mailfile");
 218         }
 219
 220         return $ABORT_RESEND;
 221     }
 222
 223     # We created the link and therefore have the lock
 224
 225     if (rename ($mailfile, $new_lost_file) == 0 ){
 226         # Failed to rename file -- this is serious.
 227         unlink($maillockfile);
 228         return $ABORT_RESEND;
 229     }
 230
 231     unlink($maillockfile);
 232     return $new_lost_file;
 233
 234 }
 235
 236 ##############################################################################
 237 #                                                                            #
 238 #                       PARSE NEXT MAIL MESSAGE                              #
 239 #                                                                            #
 240 ##############################################################################
 241 #
 242 # Parameters:
 243 #  mailfile: handle of mailfile to use.
 244 #
 245 # Parses the next message in the mail file and inserts it in $current_msg
 246 #
 247 sub Get_next_msg {
 248     local($mailfile,$found_body_delimiter) = @_;
 249
 250     # If this is the first message in the spool file, read the first line
 251     # otherwise use the MESSAGE_DELIM line from the previous message (which we
 252     # were forced to overread).
 253
 254     $done=$FALSE;
 255     $found_body_delimiter=$FALSE;
 256
 257     # This if eats the very first "From " line and should never fire again.
 258     if ( ! defined $current_msg ) {<$mailfile>};
 259     undef ($current_msg);       # Erase the old message.
 260
 261
 262     # Read the mailfile and pass through all the lines up until the next
 263     # message delimiter. Kill any previous resend headers.
 264     while ( <$mailfile> ) {
 265         last if (/$MESSAGE_DELIM/);
 266         next if ( !$found_body_delimiter && /[Rr][Ee][Ss][Ee][Nn][Tt]-.+:/);
 267         if (  !$found_body_delimiter && /^$HEADER_BODY_DELIM/) {
 268             &Splice_in_resent_headers();
 269             $found_body_delimiter=$TRUE;
 270         }
 271         if (defined($current_msg)) {
 272             $current_msg .= $_;
 273         } else {
 274             $current_msg = $_;
 275         }
 276     }
 277
 278     # Return TRUE when we have hit the end of the file.
 279     if (!defined($_) || $_ eq "" ) {
 280         return $TRUE;
 281     } else {
 282         return $FALSE;
 283     }
 284 }
 285
 286 ##############################################################################
 287 #                                                                            #
 288 #                       SPLICE IN RESENT_HEADERS                             #
 289 #                                                                            #
 290 ##############################################################################
 291 #
 292 # Insert the Resent- headers at the *current location* of the message stream
 293 # (In Engish, print out a few Resent-X: lines and return :-) )
 294 # In addition splice in the X-resent-info: header.
 295
 296 #
 297 # Paremters: None.
 298 # Return: None
 299 #
 300 sub Splice_in_resent_headers {
 301     local($date,$utctime,$weekday,$time,$month,$hostname);
 302
 303     $current_msg .= "$RESENT_TO" . "$currentTO" . "\n";
 304     $current_msg .= "$RESENT_FROM" . "$SYSTEM_FROM_ADDRESS" . "\n";
 305
 306     # Calculate date and time.  It is a bit of a shame to do this each time
 307     # the time needs to be acurate.
 308
 309     @utctime=gmtime(time);
 310
 311     $weekday=(Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$utctime[6]];
 312
 313
 314     # If the minutes or second do not take two columns each, patch em up.
 315     if ( $utctime[1] < 10 ) {
 316         if ( $utctime[0] < 10 ) {
 317             $time=sprintf("%d:0%d:0%d",$utctime[2],$utctime[1],$utctime[0]);
 318         }
 319         else {
 320             $time=sprintf("%d:0%d:%d",$utctime[2],$utctime[1],$utctime[0]);
 321         }
 322     }
 323     else {
 324         if ( $utctime[0] < 10 ) {
 325             $time=sprintf("%d:%d:0%d",$utctime[2],$utctime[1],$utctime[0]);
 326         }
 327         else {
 328             $time=sprintf("%d:%2d:%2d",$utctime[2],$utctime[1],$utctime[0]);
 329         }
 330     }
 331
 332     $month=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$utctime[4]];
 333
 334     # Ensure Y2K format
 335     $date=sprintf("%s, %d %s %d %s UTC", $weekday, $utctime[3], $month, $utctime[5]+1900, $time);
 336
 337     $current_msg .= "$RESENT_DATE" . $date . "\n";
 338
 339     if ( defined $RESENT_INFO && $RESENT_INFO ne "") {
 340         $hostname=`uname -n`;
 341         $current_msg .= "$RESENT_INFO" . "Lost mail resent from ". $hostname;
 342     }
 343
 344     return;
 345 }
 346
 347 ##############################################################################
 348 #                                                                            #
 349 #                               DO_REMAIL                                    #
 350 #                                                                            #
 351 ##############################################################################
 352 #
 353 # Actually resends the mail.   Talks to the process configured as $MAILER
 354 # We need better handling.
 355 #
 356 sub Do_remail {
 357     open (MAILER, "| $MAILER $currentTO") || return $ABORT_RESEND;
 358     print MAILER $current_msg;
 359     close (MAILER);
 360 }
 361
 362 ##############################################################################
 363 #                                                                            #
 364 #                               CLEAN_UP                                     #
 365 #                                                                            #
 366 ##############################################################################
 367 #
 368 # Clean up my messes.
 369 #
 370 sub Clean_up {
 371     local ($hostname);
 372
 373     # Ugly local hack that you should never have seen, but I forgot to
 374     # remove.  Hopefully it did not kill you (I tried as you see), but you
 375     # should eiter remove or update it for yourself.  I find the message
 376     # subject needs to have the hostname to be useful.
 377     #
 378     chop ($hostname=`uname -n`);
 379     $LOG_SUBJECT="$LOG_SUBJECT from $hostname" if ( $hostname =~ /.*\.cs\.columbia\.edu/ );
 380     #
 381     # End of ugly local hack
 382
 383     # Mail any log info to MAILGRUNT.
 384     if (defined($logfile) && $logfile ne "" ) {
 385         close (LOGFILE);        # Flush logfile output.
 386         if ( -s $logfile ) {
 387             open (MAILER, "| $MAILER $MAILGRUNT");
 388
 389             print MAILER "To: $MAILGRUNT\n";
 390             print MAILER "Subject: $LOG_SUBJECT\n";
 391             print MAILER "$HEADER_BODY_DELIM";
 392
 393             open (LOGFILE, "< $logfile");
 394
 395             while (<LOGFILE>) {
 396                 print MAILER $_;
 397             }
 398             close (MAILER);
 399             close (LOGFILE);
 400         }
 401
 402         unlink($logfile);
 403     }
 404     exit(0);
 405 }
 406
 407
 408 ##############################################################################
 409 #                                                                            #
 410 #                               COLLECT_WANDERERS                            #
 411 #                                                                            #
 412 ##############################################################################
 413
 414 #
 415 # Collects other files that appear to be mail file for the $currentTO
 416 # but were not remailed successfully.
 417 #
 418 # Parameters: none (but uses $currentTO)
 419 # Return:  True if a old mail directory is found. False otherwise.
 420 # Side effects: $wanderers set.
 421 #
 422 sub Collect_wanderers {
 423
 424     undef (@wanderers);
 425
 426     # Slurp in the directory and close.
 427
 428     return ($found);
 429 }
 430
 431 #############################################################################
 432 #                                                                           #
 433 #                               REMAIL ALL                                  #
 434 #                                                                           #
 435 #############################################################################
 436
 437 #
 438 # Takes an array of files that all seem to share a common repcipient and
 439 # remails them if possible.
 440 #
 441 # Parameters: None (uses @wanderers).
 442 #
 443 sub Remail_all {
 444     local($file,$i);
 445
 446     $i=0;
 447     foreach $file (@wanderers) {
 448         if ( !open (LOSTFILE, "< $file"))  {
 449             &Log_info("Could not open " . "$file" . " for remailing");
 450             next;
 451         }
 452
 453         do {                    # Power loop!
 454             $done = &Get_next_msg(LOSTFILE); # Retrieve the next message...
 455             &Do_remail;         # and remail it.
 456         } until $done;
 457         undef ($current_msg);   # Erase the final remailed message.
 458
 459         close(LOSTFILE);        # Tidy up.
 460
 461         unlink ($file);         # Remove the remailed file
 462         $i++;
 463     }
 464
 465 }
 466
 467 #############################################################################
 468 #                                                                           #
 469 #                               CHECK_USER                                  #
 470 #                                                                           #
 471 #############################################################################
 472
 473 #
 474 # Checks the password tables for the uid of $currentTO. If the user is
 475 # uid 0 (ie *supposed* to get mail in altmail) or unknown the resend is
 476 # aborted.
 477 #
 478 #
 479 sub Check_user {
 480     local (@passwdinfo);
 481     undef (@passwdinfo);
 482
 483     if ( !&vrfy_user($currentTO) ) {
 484         &Log_info("Possible non user mail file: $currentTO");
 485         return $ABORT_RESEND;
 486     }
 487
 488     @passwdinfo = getpwnam($currentTO);
 489
 490     print "Non user mailable mail: Name: $currentTO\n"
 491         if ( $debug && ! defined @passwdinfo );
 492
 493     return !$ABORT_RESEND if ( ! defined @passwdinfo ); # A non user but evidently mailable
 494
 495     print "Check User(): Name: $currentTO  -- UID: $passwdinfo[2]\n" if ($debug);
 496
 497     return $ABORT_RESEND if ( $passwdinfo[2] == 0 );
 498
 499
 500     return !$ABORT_RESEND;
 501 }
 502
 503 #############################################################################
 504 #                                                                           #
 505 #                               VRFY USER                                   #
 506 #                                                                           #
 507 #############################################################################
 508 #
 509 # Use SMTP VRFY to insure that argument is in fact a legal mail id.
 510 #  Boolean: TRUE if mailable account, FALSE if not.
 511
 512 sub vrfy_user {
 513
 514         local ($mailname,$repl) = @_;
 515
 516         if ( !&smtp_send("vrfy $mailname") ) {
 517             &Log_info("Failed sending to vrfy smtp command for: $mailname");
 518             return 0;
 519         }
 520
 521         $repl = &smtp_recv;
 522
 523         print "VRFY REPLY: $repl\n" if ($debug);
 524
 525         return ( $repl =~ /^2\d\d/ );
 526
 527
 528 }
 529
 530
 531 #############################################################################
 532 #                                                                           #
 533 #                               MAIN PROC                                   #
 534 #                                                                           #
 535 #############################################################################
 536
 537 # dummy code to shut up perl -w
 538 $debug = 0 if !defined($debug);
 539 print $nomail if $debug > 1;
 540 print $RESENT_FROM if $debug > 1;
 541 print $logopen if $debug > 1;
 542 print $LOCAL_LOCK_EXT if $debug > 1;
 543 print $RESENT_TO if $debug > 1;
 544 print $LOCKEXT if $debug > 1;
 545 print $RESENT_DATE if $debug > 1;
 546 print $MESSAGE_DELIM if $debug > 1;
 547 print $SMTP_retval if $debug > 1;
 548 print $found if $debug > 1;
 549 print $retry_list if $debug > 1;
 550 print $MAILJUNK if $debug > 1;
 551 print $noverify if $debug > 1;
 552 print $SYSTEM_FROM_ADDRESS if $debug > 1;
 553
 554 # BEGIN: stuff
 555 $prefix="@prefix@";
 556 $CONFIGDIR="@sysconfdir@";      # Directory where global config lives
 557 require "$CONFIGDIR/lostaltmail.conf" if (-f "$CONFIGDIR/lostaltmail.conf");
 558 require "/etc/global/lostaltmail.conf" if (-f "/etc/global/lostaltmail.conf");
 559 require "/etc/os/lostaltmail.conf" if (-f "/etc/os/lostaltmail.conf");
 560 require "/etc/local/lostaltmail.conf" if (-f "/etc/local/lostaltmail.conf");
 561
 562
 563 require "ctime.pl";
 564 use Socket;
 565 #require "sys/socket.ph";
 566
 567 # SET some initial state variales
 568 $logopen = 0;
 569
 570 #
 571 # Change to alt_dir
 572 #
 573 # Important!! This directory should be local.  Folks will be responsible
 574 # for finding this out for themselves.
 575 #
 576 chdir ( $MAILDIR ) || die "Cannot change to $MAILDIR (`x' bit not set?)";
 577
 578 #
 579 # slurp in directory
 580 #
 581 opendir (MAIL, ".") || die "Cannot open $MAILDIR (`r' bit not set?)";
 582 @allentries= readdir (MAIL);
 583 closedir (MAIL);
 584 @allnames = grep (!/$LOCALMAILJUNK|$MAILJUNK/, @allentries);
 585
 586 # Open chanel to SMTP for verification -- unless this option is
 587 # configured off.
 588
 589 if ( ! $noverify ) {
 590     local($addr, $port,$sockaddr);
 591
 592     socket (VRFY, &AF_INET, &SOCK_STREAM, 0) ||
 593         die "Could not create TCP socket (SMTP channel)";
 594
 595     $addr = (gethostbyname($SMTPHOST))[4]; # Just use the first addr
 596
 597     die "Could not obtain STMP host ($SMTPHOST) address"
 598         if ( $addr eq "" );
 599
 600     $port = (getservbyname('smtp','tcp'))[2]; # Get smtp port.
 601     die "Could not obtain SMTP port number" if (!defined($port));
 602
 603     printf("SMTP: address: %s   port: $port\n",
 604            join ('.',unpack('C4',$addr))) if ($debug);
 605
 606     $sockaddr = sockaddr_in($port, $addr);
 607
 608     printf("Sockaddr: %s\n", join (' ',unpack('C14',$sockaddr))) if ($debug);
 609
 610     connect (VRFY, $sockaddr) ||
 611         die "Could not connect to SMTP daemon on $SMTPHOST";
 612
 613     print "Establshed SMTP channel\n" if ($debug);
 614
 615     &smtp_recv; # Greet wait
 616     &smtp_send("helo $SMTPHOST"); # Helo message for picky SMTPs
 617     &smtp_recv;         # Helo reply
 618
 619     # Connection is up and ready to VRFY
 620 }
 621
 622 # main stuff starts here
 623 foreach $currentTO (@allnames) {
 624     next if ( &Check_user == $ABORT_RESEND);
 625
 626     undef (@wanderers); # Just reset this at each pass.
 627     @wanderers=grep (/$currentTO\.\d+/, @allentries);
 628
 629     $remail_file = &Lock_file($currentTO,$FALSE); # Need to lock the spool.
 630
 631     next if ( $remail_file eq $ABORT_RESEND); # Could not get that lock
 632
 633     push (@wanderers, $remail_file); # Try to resend "old" files.
 634     print "List to remail: @wanderers\n" if ($debug);
 635     # check if  there is something to remail
 636     &Remail_all if ( defined @wanderers && !$nomail);
 637 }
 638
 639 # this stuff should run at the end
 640 foreach $file (grep (/$LOCALMAILJUNK/,@allentries)) {
 641
 642     if ($debug) {
 643         print "Would unlink $file\n" if ($debug);
 644     } else {
 645         unlink $file  if (-f $file);
 646     }
 647
 648 }
 649 &Clean_up;                      # Do a clean exit.