283 lines
7.7 KiB
Perl
Executable File
283 lines
7.7 KiB
Perl
Executable File
#!/usr/local/bin/perl -w
|
|
#
|
|
# bounce-resender: constructs mail queue from bounce spool for
|
|
# subsequent reprocessing by sendmail
|
|
#
|
|
# usage: given a mail spool full of (only) bounced mail called "bounces":
|
|
# # mkdir -m0700 bqueue; cd bqueue && bounce-resender < ../bounces
|
|
# # cd ..
|
|
# # chown -R root bqueue; chmod 600 bqueue/*
|
|
# # /usr/lib/sendmail -bp -oQ`pwd`/bqueue | more # does it look OK?
|
|
# # /usr/lib/sendmail -q -oQ`pwd`/bqueue -oT99d & # run the queue
|
|
#
|
|
# ** also read messages at end! **
|
|
#
|
|
# Brian R. Gaeke <brg@EECS.Berkeley.EDU> Thu Feb 18 13:40:10 PST 1999
|
|
#
|
|
#############################################################################
|
|
# This script has NO WARRANTY, NO BUG FIXES, and NO SUPPORT. You will
|
|
# need to modify it for your site and for your operating system, unless
|
|
# you are in the EECS Instructional group at UC Berkeley. (Search forward
|
|
# for two occurrences of "FIXME".)
|
|
#
|
|
|
|
$state = "MSG_START";
|
|
$ctr = 0;
|
|
$lineno = 0;
|
|
$getnrl = 0;
|
|
$nrl = "";
|
|
$uname = "PhilOS"; # You don't want to change this here.
|
|
$myname = $0;
|
|
$myname =~ s,.*/([^/]*),$1,;
|
|
|
|
chomp($hostname = `hostname`);
|
|
chomp($uname = `uname`);
|
|
|
|
# FIXME: Define the functions "major" and "minor" for your OS.
|
|
if ($uname eq "SunOS") {
|
|
# from h2ph < /usr/include/sys/sysmacros.h on
|
|
# SunOS torus.CS.Berkeley.EDU 5.6 Generic_105182-11 i86pc i386 i86pc
|
|
eval 'sub O_BITSMINOR () {8;}' unless defined(&O_BITSMINOR);
|
|
eval 'sub O_MAXMAJ () {0x7f;}' unless defined(&O_MAXMAJ);
|
|
eval 'sub O_MAXMIN () {0xff;}' unless defined(&O_MAXMIN);
|
|
eval 'sub major {
|
|
local($x) = @_;
|
|
eval "((($x) >> &O_BITSMINOR) &O_MAXMAJ)";
|
|
}' unless defined(&major);
|
|
eval 'sub minor {
|
|
local($x) = @_;
|
|
eval "(($x) &O_MAXMIN)";
|
|
}' unless defined(&minor);
|
|
} else {
|
|
die "How do you calculate major and minor device numbers on $uname?\n";
|
|
}
|
|
|
|
sub ignorance { $ignored{$state}++; }
|
|
|
|
sub unmunge {
|
|
my($addr) = @_;
|
|
$addr =~ s/_FNORD_/ /g;
|
|
# remove (Real Name)
|
|
$addr =~ s/^(.*)\([^\)]*\)(.*)$/$1$2/
|
|
if $addr =~ /^.*\([^\)]*\).*$/;
|
|
# extract <user@host> if it appears
|
|
$addr =~ s/^.*<([^>]*)>.*$/$1/
|
|
if $addr =~ /^.*<[^>]*>.*$/;
|
|
# strip leading, trailing blanks
|
|
$addr =~ s/^\s*(.*)\s*/$1/;
|
|
# nuke local domain
|
|
# FIXME: Add a regular expression for your local domain here.
|
|
$addr =~
|
|
s/@(cory|po|pasteur|torus|parker|cochise|franklin).(ee)?cs.berkeley.edu//i;
|
|
return $addr;
|
|
}
|
|
|
|
print STDERR "$0: running on $hostname ($uname)\n";
|
|
|
|
open(INPUT,$ARGV[0]) || die "$ARGV[0]: $!\n";
|
|
|
|
sub working {
|
|
my($now);
|
|
$now = localtime;
|
|
print STDERR "$myname: Working... $now\n";
|
|
}
|
|
|
|
&working();
|
|
|
|
while (! eof INPUT) {
|
|
# get a new line
|
|
if ($state eq "IN_MESSAGE_HEADER") {
|
|
# handle multi-line headers
|
|
if ($nrl ne "" || $getnrl != 0) {
|
|
$_ = $nrl;
|
|
$getnrl = 0;
|
|
$nrl = "";
|
|
} else {
|
|
$_ = <INPUT>; $lineno++;
|
|
}
|
|
unless ($_ =~ /^\s*$/) {
|
|
while ($nrl eq "") {
|
|
$nrl = <INPUT>; $lineno++;
|
|
if ($nrl =~ /^\s+[^\s].*$/) { # continuation line
|
|
chomp($_);
|
|
$_ .= "_FNORD_" . $nrl;
|
|
$nrl = "";
|
|
} elsif ($nrl =~ /^\s*$/) { # end of headers
|
|
$getnrl++;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
# normal single line
|
|
if ($nrl ne "") {
|
|
$_ = $nrl; $nrl = "";
|
|
} else {
|
|
$_ = <INPUT>; $lineno++;
|
|
}
|
|
}
|
|
|
|
if ($state eq "WAIT_FOR_FROM") {
|
|
if (/^From \S+.*$/) {
|
|
$state = "MSG_START";
|
|
} else {
|
|
&ignorance();
|
|
}
|
|
} elsif ($state eq "MSG_START") {
|
|
if (/^\s+boundary=\"([^\"]*)\".*$/) {
|
|
$boundary = $1;
|
|
$state = "GOT_BOUNDARY";
|
|
$ctr++;
|
|
} else {
|
|
&ignorance();
|
|
}
|
|
} elsif ($state eq "GOT_BOUNDARY") {
|
|
if (/^--$boundary/) {
|
|
$next = <INPUT>; $lineno++;
|
|
if ($next =~ /^Content-Type: message\/rfc822/) {
|
|
$hour = (localtime)[2];
|
|
$char = chr(ord("A") + $hour);
|
|
$ident = sprintf("%sAA%05d",$char,99999 - $ctr);
|
|
$qf = "qf$ident";
|
|
$df = "df$ident";
|
|
@rcpt = ();
|
|
open(MSGHDR,">$qf") || die "Can't write to $qf: $!\n";
|
|
open(MSGBODY,">$df") || die "Can't write to $df: $!\n";
|
|
chmod(0600, $qf, $df);
|
|
$state = "IN_MESSAGE_HEADER";
|
|
$header = $body = "";
|
|
$messageid = "bounce-resender-$ctr";
|
|
$fromline = "MAILER-DAEMON";
|
|
$ctencod = "7BIT";
|
|
# skip a bit, brother maynard (boundary is separated from
|
|
# the header by a blank line)
|
|
$next = <INPUT>; $lineno++;
|
|
unless ($next =~ /^\s*$/) {
|
|
print MSGHDR $next;
|
|
}
|
|
}
|
|
} else {
|
|
&ignorance();
|
|
}
|
|
|
|
$next = $char = $hour = undef;
|
|
} elsif ($state eq "IN_MESSAGE_HEADER") {
|
|
if (!(/^--$boundary/ || /^\s*$/)) {
|
|
if (/^Message-[iI][dD]:\s+<([^@]+)@[^>]*>.*$/) {
|
|
$messageid = $1;
|
|
} elsif (/^From:\s+(.*)$/) {
|
|
$fromline = $sender = $1;
|
|
$fromline = unmunge($fromline);
|
|
} elsif (/^Content-[Tt]ransfer-[Ee]ncoding:\s+(.*)$/) {
|
|
$ctencod = $1;
|
|
} elsif (/^(To|[Cc][Cc]):\s+(.*)$/) {
|
|
$toaddrs = $2;
|
|
foreach $toaddr (split(/,/,$toaddrs)) {
|
|
$toaddr = unmunge($toaddr);
|
|
push(@rcpt,$toaddr);
|
|
}
|
|
}
|
|
$headerline = $_;
|
|
# escape special chars
|
|
# (Perhaps not. It doesn't seem to be necessary (yet)).
|
|
#$headerline =~ s/([\(\)<>@,;:\\".\[\]])/\\$1/g;
|
|
# purely heuristic ;-)
|
|
$headerline =~ s/Return-Path:/?P?Return-Path:/g;
|
|
# save H-line to write to qf, later
|
|
$header .= "H$headerline";
|
|
|
|
$headerline = $toaddr = $toaddrs = undef;
|
|
} elsif (/^\s*$/) {
|
|
# write to qf
|
|
($dev, $ino) = (stat($df))[0 .. 1];
|
|
($maj, $min) = (major($dev), minor($dev));
|
|
$time = time();
|
|
print MSGHDR "V2\n";
|
|
print MSGHDR "B$ctencod\n";
|
|
print MSGHDR "S$sender\n";
|
|
print MSGHDR "I$maj/$min/$ino\n";
|
|
print MSGHDR "K$time\n";
|
|
print MSGHDR "T$time\n";
|
|
print MSGHDR "D$df\n";
|
|
print MSGHDR "N1\n";
|
|
print MSGHDR "MDeferred: manually-requeued bounced message\n";
|
|
foreach $r (@rcpt) {
|
|
print MSGHDR "RP:$r\n";
|
|
}
|
|
$header =~ s/_FNORD_/\n/g;
|
|
print MSGHDR $header;
|
|
print MSGHDR "HMessage-ID: <$messageid@$hostname>\n"
|
|
if ($messageid =~ /bounce-resender/);
|
|
print MSGHDR ".\n";
|
|
close MSGHDR;
|
|
|
|
# jump to state waiting for message body
|
|
$state = "IN_MESSAGE_BODY";
|
|
|
|
$dev = $ino = $maj = $min = $r = $time = undef;
|
|
} elsif (/^--$boundary/) {
|
|
# signal an error
|
|
print "$myname: Header without message! Line $lineno qf $qf\n";
|
|
|
|
# write to qf anyway (SAME AS ABOVE, SHOULD BE A PROCEDURE)
|
|
($dev, $ino) = (stat($df))[0 .. 1];
|
|
($maj, $min) = (major($dev), minor($dev));
|
|
$time = time();
|
|
print MSGHDR "V2\n";
|
|
print MSGHDR "B$ctencod\n";
|
|
print MSGHDR "S$sender\n";
|
|
print MSGHDR "I$maj/$min/$ino\n";
|
|
print MSGHDR "K$time\n";
|
|
print MSGHDR "T$time\n";
|
|
print MSGHDR "D$df\n";
|
|
print MSGHDR "N1\n";
|
|
print MSGHDR "MDeferred: manually-requeued bounced message\n";
|
|
foreach $r (@rcpt) {
|
|
print MSGHDR "RP:$r\n";
|
|
}
|
|
$header =~ s/_FNORD_/\n/g;
|
|
print MSGHDR $header;
|
|
print MSGHDR "HMessage-ID: <$messageid@$hostname>\n"
|
|
if ($messageid =~ /bounce-resender/);
|
|
print MSGHDR ".\n";
|
|
close MSGHDR;
|
|
|
|
# jump to state waiting for next bounce message
|
|
$state = "WAIT_FOR_FROM";
|
|
|
|
$dev = $ino = $maj = $min = $r = $time = undef;
|
|
} else {
|
|
# never got here
|
|
&ignorance();
|
|
}
|
|
} elsif ($state eq "IN_MESSAGE_BODY") {
|
|
if (/^--$boundary/) {
|
|
print MSGBODY $body;
|
|
close MSGBODY;
|
|
$state = "WAIT_FOR_FROM";
|
|
} else {
|
|
$body .= $_;
|
|
}
|
|
}
|
|
if ($lineno % 1900 == 0) { &working(); }
|
|
}
|
|
|
|
close INPUT;
|
|
|
|
foreach $x (keys %ignored) {
|
|
print STDERR
|
|
"$myname: ignored $ignored{$x} lines of bounce spool in state $x\n";
|
|
}
|
|
print STDERR
|
|
"$myname: processed $lineno lines of input and wrote $ctr messages\n";
|
|
print STDERR
|
|
"$myname: remember to chown the queue files to root before running:\n";
|
|
chomp($pwd = `pwd`);
|
|
print STDERR "$myname: # sendmail -q -oQ$pwd -oT99d &\n";
|
|
|
|
print STDERR "$myname: to test the newly generated queue:\n";
|
|
print STDERR "$myname: # sendmail -bp -oQ$pwd | more\n";
|
|
|
|
exit 0;
|
|
|