1 #!@PERL@ -sw 2 # 3 # Package: am-utils-6.x 4 # Author: James Tanis <jtt (at] 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 you 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 (!$noverify && !&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 if (!defined($MAILDIR) || $MAILDIR eq "") { 577 die "MAILDIR must be defined\n"; 578 } 579 chdir ( $MAILDIR ) || die "Cannot change to $MAILDIR (`x' bit not set?)"; 580 581 # 582 # slurp in directory 583 # 584 opendir (MAIL, ".") || die "Cannot open $MAILDIR (`r' bit not set?)"; 585 @allentries= readdir (MAIL); 586 closedir (MAIL); 587 @allnames = grep (!/$LOCALMAILJUNK|$MAILJUNK/, @allentries); 588 589 # Open chanel to SMTP for verification -- unless this option is 590 # configured off. 591 592 if ( ! $noverify ) { 593 local($addr, $port,$sockaddr); 594 595 socket (VRFY, &AF_INET, &SOCK_STREAM, 0) || 596 die "Could not create TCP socket (SMTP channel)"; 597 598 $addr = (gethostbyname($SMTPHOST))[4]; # Just use the first addr 599 600 die "Could not obtain STMP host ($SMTPHOST) address" 601 if ( $addr eq "" ); 602 603 $port = (getservbyname('smtp','tcp'))[2]; # Get smtp port. 604 die "Could not obtain SMTP port number" if (!defined($port)); 605 606 printf("SMTP: address: %s port: $port\n", 607 join ('.',unpack('C4',$addr))) if ($debug); 608 609 $sockaddr = sockaddr_in($port, $addr); 610 611 printf("Sockaddr: %s\n", join (' ',unpack('C14',$sockaddr))) if ($debug); 612 613 connect (VRFY, $sockaddr) || 614 die "Could not connect to SMTP daemon on $SMTPHOST"; 615 616 print "Establshed SMTP channel\n" if ($debug); 617 618 &smtp_recv; # Greet wait 619 &smtp_send("helo $SMTPHOST"); # Helo message for picky SMTPs 620 &smtp_recv; # Helo reply 621 622 # Connection is up and ready to VRFY 623 } 624 625 # main stuff starts here 626 foreach $currentTO (@allnames) { 627 next if ( &Check_user == $ABORT_RESEND); 628 629 # just delete the file if too small to be real mail 630 if ((stat($currentTO))[7] < 5) { 631 print "Too small to be real mail, unlinking $currentTO" if $debug; 632 unlink $currentTO; 633 } 634 635 undef (@wanderers); # Just reset this at each pass. 636 @wanderers=grep (/$currentTO\.\d+/, @allentries); 637 638 $remail_file = &Lock_file($currentTO,$FALSE); # Need to lock the spool. 639 640 next if ( $remail_file eq $ABORT_RESEND); # Could not get that lock 641 642 push (@wanderers, $remail_file); # Try to resend "old" files. 643 print "List to remail: @wanderers\n" if ($debug); 644 # check if there is something to remail 645 &Remail_all if ( defined @wanderers && !$nomail); 646 } 647 648 # this stuff should run at the end 649 foreach $file (grep (/$LOCALMAILJUNK/,@allentries)) { 650 651 if ($debug) { 652 print "Would unlink $file\n" if ($debug); 653 } else { 654 unlink $file if (-f $file); 655 } 656 657 } 658 &Clean_up; # Do a clean exit. 659
Indexes created Tue Feb 24 01:34:59 UTC 2026