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 33chomp($hostname = `hostname`); 34chomp($uname = `uname`); 35 36# FIXME: Define the functions "major" and "minor" for your OS. 37if ($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 55sub ignorance { $ignored{$state}++; } 56 57sub 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 75print STDERR "$0: running on $hostname ($uname)\n"; 76 77open(INPUT,$ARGV[0]) || die "$ARGV[0]: $!\n"; 78 79sub working { 80 my($now); 81 $now = localtime; 82 print STDERR "$myname: Working... $now\n"; 83} 84 85&working(); 86 87while (! 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 265close INPUT; 266 267foreach $x (keys %ignored) { 268 print STDERR 269 "$myname: ignored $ignored{$x} lines of bounce spool in state $x\n"; 270} 271print STDERR 272 "$myname: processed $lineno lines of input and wrote $ctr messages\n"; 273print STDERR 274 "$myname: remember to chown the queue files to root before running:\n"; 275chomp($pwd = `pwd`); 276print STDERR "$myname: # sendmail -q -oQ$pwd -oT99d &\n"; 277 278print STDERR "$myname: to test the newly generated queue:\n"; 279print STDERR "$myname: # sendmail -bp -oQ$pwd | more\n"; 280 281exit 0; 282 283