| 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 | |
|---|
