bounce-resender.pl revision 64562 
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