Merge from vendor branch GDB:
[dragonfly.git] / 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