contrib/sendmail-8.13.4/contrib/bounce-resender.pl

   1 #!/usr/local/bin/perl -w
   2 #
   3 # bounce-resender: constructs mail queue from bounce spool for
   4 #  subsequent reprocessing by sendmail
   5 #
   6 # usage: given a mail spool full of (only) bounced mail called "bounces":
   7 #        # mkdir -m0700 bqueue; cd bqueue && bounce-resender < ../bounces
   8 #        # cd ..
   9 #        # chown -R root bqueue; chmod 600 bqueue/*
  10 #        # /usr/lib/sendmail -bp -oQ`pwd`/bqueue | more   # does it look OK?
  11 #        # /usr/lib/sendmail -q -oQ`pwd`/bqueue -oT99d &  # run the queue
  12 #
  13 # ** also read messages at end! **
  14 #
  15 # Brian R. Gaeke <brg@EECS.Berkeley.EDU> Thu Feb 18 13:40:10 PST 1999
  16 #
  17 #############################################################################
  18 # This script has NO WARRANTY, NO BUG FIXES, and NO SUPPORT.  You will
  19 # need to modify it for your site and for your operating system, unless
  20 # you are in the EECS Instructional group at UC Berkeley. (Search forward
  21 # for two occurrences of "FIXME".)
  22 #
  23
  24 $state = "MSG_START";
  25 $ctr = 0;
  26 $lineno = 0;
  27 $getnrl = 0;
  28 $nrl = "";
  29 $uname = "PhilOS";  # You don't want to change this here.
  30 $myname = $0;
  31 $myname =~ s,.*/([^/]*),$1,;
  32
  33 chomp($hostname = `hostname`);
  34 chomp($uname = `uname`);
  35
  36 # FIXME: Define the functions "major" and "minor" for your OS.
  37 if ($uname eq "SunOS") {
  38         # from h2ph < /usr/include/sys/sysmacros.h on
  39         # SunOS torus.CS.Berkeley.EDU 5.6 Generic_105182-11 i86pc i386 i86pc
  40     eval 'sub O_BITSMINOR () {8;}' unless defined(&O_BITSMINOR);
  41     eval 'sub O_MAXMAJ () {0x7f;}' unless defined(&O_MAXMAJ);
  42     eval 'sub O_MAXMIN () {0xff;}' unless defined(&O_MAXMIN);
  43         eval 'sub major {
  44             local($x) = @_;
  45             eval "((($x) >>  &O_BITSMINOR)   &O_MAXMAJ)";
  46         }' unless defined(&major);
  47         eval 'sub minor {
  48             local($x) = @_;
  49             eval "(($x)   &O_MAXMIN)";
  50         }' unless defined(&minor);
  51 } else {
  52         die "How do you calculate major and minor device numbers on $uname?\n";
  53 }
  54
  55 sub ignorance { $ignored{$state}++; }
  56
  57 sub unmunge {
  58         my($addr) = @_;
  59         $addr =~ s/_FNORD_/ /g;
  60         # remove (Real Name)
  61         $addr =~ s/^(.*)\([^\)]*\)(.*)$/$1$2/
  62                 if $addr =~ /^.*\([^\)]*\).*$/;
  63         # extract <user@host> if it appears
  64         $addr =~ s/^.*<([^>]*)>.*$/$1/
  65                 if $addr =~ /^.*<[^>]*>.*$/;
  66         # strip leading, trailing blanks
  67         $addr =~ s/^\s*(.*)\s*/$1/;
  68         # nuke local domain
  69     # FIXME: Add a regular expression for your local domain here.
  70         $addr =~
  71          s/@(cory|po|pasteur|torus|parker|cochise|franklin).(ee)?cs.berkeley.edu//i;
  72         return $addr;
  73 }
  74
  75 print STDERR "$0: running on $hostname ($uname)\n";
  76
  77 open(INPUT,$ARGV[0]) || die "$ARGV[0]: $!\n";
  78
  79 sub working {
  80         my($now);
  81         $now = localtime;
  82         print STDERR "$myname: Working... $now\n";
  83 }
  84
  85 &working();
  86
  87 while (! eof INPUT) {
  88         # get a new line
  89         if ($state eq "IN_MESSAGE_HEADER") {
  90                 # handle multi-line headers
  91                 if ($nrl ne "" || $getnrl != 0) {
  92                         $_ = $nrl;
  93                         $getnrl = 0;
  94                         $nrl = "";
  95                 } else {
  96                         $_ = <INPUT>; $lineno++;
  97                 }
  98                 unless ($_ =~ /^\s*$/) {
  99                         while ($nrl eq "") {
 100                                 $nrl = <INPUT>; $lineno++;
 101                                 if ($nrl =~ /^\s+[^\s].*$/) { # continuation line
 102                                         chomp($_);
 103                                         $_ .= "_FNORD_" . $nrl;
 104                                         $nrl = "";
 105                                 } elsif ($nrl =~ /^\s*$/) { # end of headers
 106                                         $getnrl++;
 107                                         last;
 108                                 }
 109                         }
 110                 }
 111         } else {
 112                 # normal single line
 113                 if ($nrl ne "") {
 114                         $_ = $nrl; $nrl = "";
 115                 } else {
 116                         $_ = <INPUT>; $lineno++;
 117                 }
 118         }
 119
 120         if ($state eq "WAIT_FOR_FROM") {
 121                 if (/^From \S+.*$/) {
 122                         $state = "MSG_START";
 123                 } else {
 124                         &ignorance();
 125                 }
 126         } elsif ($state eq "MSG_START") {
 127                 if (/^\s+boundary=\"([^\"]*)\".*$/) {
 128                         $boundary = $1;
 129                         $state = "GOT_BOUNDARY";
 130                         $ctr++;
 131                 } else {
 132                         &ignorance();
 133                 }
 134         } elsif ($state eq "GOT_BOUNDARY") {
 135                 if (/^--$boundary/) {
 136                         $next = <INPUT>; $lineno++;
 137                         if ($next =~ /^Content-Type: message\/rfc822/) {
 138                                 $hour = (localtime)[2];
 139                                 $char = chr(ord("A") + $hour);
 140                                 $ident = sprintf("%sAA%05d",$char,99999 - $ctr);
 141                                 $qf = "qf$ident";
 142                                 $df = "df$ident";
 143                                 @rcpt = ();
 144                                 open(MSGHDR,">$qf") || die "Can't write to $qf: $!\n";
 145                                 open(MSGBODY,">$df") || die "Can't write to $df: $!\n";
 146                                 chmod(0600, $qf, $df);
 147                                 $state = "IN_MESSAGE_HEADER";
 148                                 $header = $body = "";
 149                                 $messageid = "bounce-resender-$ctr";
 150                                 $fromline = "MAILER-DAEMON";
 151                                 $ctencod = "7BIT";
 152                                 # skip a bit, brother maynard (boundary is separated from
 153                                 #  the header by a blank line)
 154                                 $next = <INPUT>; $lineno++;
 155                                 unless ($next =~ /^\s*$/) {
 156                                         print MSGHDR $next;
 157                                 }
 158                         }
 159                 } else {
 160                         &ignorance();
 161                 }
 162
 163                 $next = $char = $hour = undef;
 164         } elsif ($state eq "IN_MESSAGE_HEADER") {
 165                 if (!(/^--$boundary/ || /^\s*$/)) {
 166                         if (/^Message-[iI][dD]:\s+<([^@]+)@[^>]*>.*$/) {
 167                                 $messageid = $1;
 168                         } elsif (/^From:\s+(.*)$/) {
 169                                 $fromline = $sender = $1;
 170                                 $fromline = unmunge($fromline);
 171                         } elsif (/^Content-[Tt]ransfer-[Ee]ncoding:\s+(.*)$/) {
 172                                 $ctencod = $1;
 173                         } elsif (/^(To|[Cc][Cc]):\s+(.*)$/) {
 174                                 $toaddrs = $2;
 175                                 foreach $toaddr (split(/,/,$toaddrs)) {
 176                                         $toaddr = unmunge($toaddr);
 177                                         push(@rcpt,$toaddr);
 178                                 }
 179                         }
 180                         $headerline = $_;
 181                         # escape special chars
 182                         # (Perhaps not. It doesn't seem to be necessary (yet)).
 183             #$headerline =~ s/([\(\)<>@,;:\\".\[\]])/\\$1/g;
 184                         # purely heuristic ;-)
 185             $headerline =~ s/Return-Path:/?P?Return-Path:/g;
 186                         # save H-line to write to qf, later
 187                         $header .= "H$headerline";
 188
 189                         $headerline = $toaddr = $toaddrs = undef;
 190                 } elsif (/^\s*$/) {
 191                         # write to qf
 192                         ($dev, $ino) = (stat($df))[0 .. 1];
 193                         ($maj, $min) = (major($dev), minor($dev));
 194                         $time = time();
 195                         print MSGHDR "V2\n";
 196                         print MSGHDR "B$ctencod\n";
 197                         print MSGHDR "S$sender\n";
 198                         print MSGHDR "I$maj/$min/$ino\n";
 199                         print MSGHDR "K$time\n";
 200                         print MSGHDR "T$time\n";
 201                         print MSGHDR "D$df\n";
 202                         print MSGHDR "N1\n";
 203                         print MSGHDR "MDeferred: manually-requeued bounced message\n";
 204                         foreach $r (@rcpt) {
 205                                 print MSGHDR "RP:$r\n";
 206                         }
 207                         $header =~ s/_FNORD_/\n/g;
 208                         print MSGHDR $header;
 209                         print MSGHDR "HMessage-ID: <$messageid@$hostname>\n"
 210                                 if ($messageid =~ /bounce-resender/);
 211                         print MSGHDR ".\n";
 212                         close MSGHDR;
 213
 214                         # jump to state waiting for message body
 215                         $state = "IN_MESSAGE_BODY";
 216
 217                         $dev = $ino = $maj = $min = $r = $time = undef;
 218                 } elsif (/^--$boundary/) {
 219                         # signal an error
 220                         print "$myname: Header without message! Line $lineno qf $qf\n";
 221
 222                         # write to qf anyway (SAME AS ABOVE, SHOULD BE A PROCEDURE)
 223                         ($dev, $ino) = (stat($df))[0 .. 1];
 224                         ($maj, $min) = (major($dev), minor($dev));
 225                         $time = time();
 226                         print MSGHDR "V2\n";
 227                         print MSGHDR "B$ctencod\n";
 228                         print MSGHDR "S$sender\n";
 229                         print MSGHDR "I$maj/$min/$ino\n";
 230                         print MSGHDR "K$time\n";
 231                         print MSGHDR "T$time\n";
 232                         print MSGHDR "D$df\n";
 233                         print MSGHDR "N1\n";
 234                         print MSGHDR "MDeferred: manually-requeued bounced message\n";
 235                         foreach $r (@rcpt) {
 236                                 print MSGHDR "RP:$r\n";
 237                         }
 238                         $header =~ s/_FNORD_/\n/g;
 239                         print MSGHDR $header;
 240                         print MSGHDR "HMessage-ID: <$messageid@$hostname>\n"
 241                                 if ($messageid =~ /bounce-resender/);
 242                         print MSGHDR ".\n";
 243                         close MSGHDR;
 244
 245                         # jump to state waiting for next bounce message
 246                         $state = "WAIT_FOR_FROM";
 247
 248                         $dev = $ino = $maj = $min = $r = $time = undef;
 249                 } else {
 250                         # never got here
 251                         &ignorance();
 252                 }
 253         } elsif ($state eq "IN_MESSAGE_BODY") {
 254                 if (/^--$boundary/) {
 255                         print MSGBODY $body;
 256                         close MSGBODY;
 257                         $state = "WAIT_FOR_FROM";
 258                 } else {
 259                         $body .= $_;
 260                 }
 261         }
 262         if ($lineno % 1900 == 0) { &working(); }
 263 }
 264
 265 close INPUT;
 266
 267 foreach $x (keys %ignored) {
 268         print STDERR
 269                 "$myname: ignored $ignored{$x} lines of bounce spool in state $x\n";
 270 }
 271 print STDERR
 272         "$myname: processed $lineno lines of input and wrote $ctr messages\n";
 273 print STDERR
 274         "$myname: remember to chown the queue files to root before running:\n";
 275 chomp($pwd = `pwd`);
 276 print STDERR "$myname:      # sendmail -q -oQ$pwd -oT99d &\n";
 277
 278 print STDERR "$myname: to test the newly generated queue:\n";
 279 print STDERR "$myname:      # sendmail -bp -oQ$pwd | more\n";
 280
 281 exit 0;
 282