1 #!/usr/local/bin/perl -w
3 # bounce-resender: constructs mail queue from bounce spool for
4 # subsequent reprocessing by sendmail
6 # usage: given a mail spool full of (only) bounced mail called "bounces":
7 # # mkdir -m0700 bqueue; cd bqueue && bounce-resender < ../bounces
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
13 # ** also read messages at end! **
15 # Brian R. Gaeke <brg@EECS.Berkeley.EDU> Thu Feb 18 13:40:10 PST 1999
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".)
29 $uname = "PhilOS"; # You don't want to change this here.
31 $myname =~ s,.*/([^/]*),$1,;
33 chomp($hostname = `hostname`);
34 chomp($uname = `uname`);
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);
45 eval "((($x) >> &O_BITSMINOR) &O_MAXMAJ)";
46 }' unless defined(&major);
49 eval "(($x) &O_MAXMIN)";
50 }' unless defined(&minor);
52 die "How do you calculate major and minor device numbers on $uname?\n";
55 sub ignorance { $ignored{$state}++; }
59 $addr =~ s/_FNORD_/ /g;
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/;
69 # FIXME: Add a regular expression for your local domain here.
71 s/@(cory|po|pasteur|torus|parker|cochise|franklin).(ee)?cs.berkeley.edu//i;
75 print STDERR "$0: running on $hostname ($uname)\n";
77 open(INPUT,$ARGV[0]) || die "$ARGV[0]: $!\n";
82 print STDERR "$myname: Working... $now\n";
89 if ($state eq "IN_MESSAGE_HEADER") {
90 # handle multi-line headers
91 if ($nrl ne "" || $getnrl != 0) {
96 $_ = <INPUT>; $lineno++;
98 unless ($_ =~ /^\s*$/) {
100 $nrl = <INPUT>; $lineno++;
101 if ($nrl =~ /^\s+[^\s].*$/) { # continuation line
103 $_ .= "_FNORD_" . $nrl;
105 } elsif ($nrl =~ /^\s*$/) { # end of headers
114 $_ = $nrl; $nrl = "";
116 $_ = <INPUT>; $lineno++;
120 if ($state eq "WAIT_FOR_FROM") {
121 if (/^From \S+.*$/) {
122 $state = "MSG_START";
126 } elsif ($state eq "MSG_START") {
127 if (/^\s+boundary=\"([^\"]*)\".*$/) {
129 $state = "GOT_BOUNDARY";
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);
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";
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*$/) {
163 $next = $char = $hour = undef;
164 } elsif ($state eq "IN_MESSAGE_HEADER") {
165 if (!(/^--$boundary/ || /^\s*$/)) {
166 if (/^Message-[iI][dD]:\s+<([^@]+)@[^>]*>.*$/) {
168 } elsif (/^From:\s+(.*)$/) {
169 $fromline = $sender = $1;
170 $fromline = unmunge($fromline);
171 } elsif (/^Content-[Tt]ransfer-[Ee]ncoding:\s+(.*)$/) {
173 } elsif (/^(To|[Cc][Cc]):\s+(.*)$/) {
175 foreach $toaddr (split(/,/,$toaddrs)) {
176 $toaddr = unmunge($toaddr);
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";
189 $headerline = $toaddr = $toaddrs = undef;
192 ($dev, $ino) = (stat($df))[0 .. 1];
193 ($maj, $min) = (major($dev), minor($dev));
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";
203 print MSGHDR "MDeferred: manually-requeued bounced message\n";
205 print MSGHDR "RP:$r\n";
207 $header =~ s/_FNORD_/\n/g;
208 print MSGHDR $header;
209 print MSGHDR "HMessage-ID: <$messageid@$hostname>\n"
210 if ($messageid =~ /bounce-resender/);
214 # jump to state waiting for message body
215 $state = "IN_MESSAGE_BODY";
217 $dev = $ino = $maj = $min = $r = $time = undef;
218 } elsif (/^--$boundary/) {
220 print "$myname: Header without message! Line $lineno qf $qf\n";
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));
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";
234 print MSGHDR "MDeferred: manually-requeued bounced message\n";
236 print MSGHDR "RP:$r\n";
238 $header =~ s/_FNORD_/\n/g;
239 print MSGHDR $header;
240 print MSGHDR "HMessage-ID: <$messageid@$hostname>\n"
241 if ($messageid =~ /bounce-resender/);
245 # jump to state waiting for next bounce message
246 $state = "WAIT_FOR_FROM";
248 $dev = $ino = $maj = $min = $r = $time = undef;
253 } elsif ($state eq "IN_MESSAGE_BODY") {
254 if (/^--$boundary/) {
257 $state = "WAIT_FOR_FROM";
262 if ($lineno % 1900 == 0) { &working(); }
267 foreach $x (keys %ignored) {
269 "$myname: ignored $ignored{$x} lines of bounce spool in state $x\n";
272 "$myname: processed $lineno lines of input and wrote $ctr messages\n";
274 "$myname: remember to chown the queue files to root before running:\n";
276 print STDERR "$myname: # sendmail -q -oQ$pwd -oT99d &\n";
278 print STDERR "$myname: to test the newly generated queue:\n";
279 print STDERR "$myname: # sendmail -bp -oQ$pwd | more\n";