138032Speter#!/usr/bin/perl
238032Speter# doublebounce.pl
338032Speter#
4110560Sgshapiro# Return a doubly-bounced e-mail to postmaster.  Specific to sendmail,
5110560Sgshapiro# updated to work on sendmail 8.12.6.
638032Speter#
7110560Sgshapiro# Based on the original doublebounce.pl code by jr@terra.net, 12/4/97.
8110560Sgshapiro# Updated by bicknell@ufp.org, 12/4/2002 to understand new sendmail DSN
9110560Sgshapiro# bounces.  Code cleanup also performed, mainly making things more
10110560Sgshapiro# robust.
1138032Speter#
12110560Sgshapiro# Original intro included below, lines with ##
13110560Sgshapiro##	attempt to return a doubly-bounced email to a postmaster
14110560Sgshapiro##	jr@terra.net, 12/4/97
15110560Sgshapiro##
16110560Sgshapiro##	invoke by creating an mail alias such as:
17110560Sgshapiro##		doublebounce:	"|/usr/local/sbin/doublebounce"
18110560Sgshapiro##	then adding this line to your sendmail.cf:
19110560Sgshapiro##		O DoubleBounceAddress=doublebounce
20110560Sgshapiro##
21110560Sgshapiro##	optionally, add a "-d" flag in the aliases file, to send a
22110560Sgshapiro##	debug trace to your own postmaster showing what is going on
23110560Sgshapiro##
24110560Sgshapiro##	this allows the "postmaster" address to still go to a human being,
25110560Sgshapiro##	while bounce messages can go to this script, which will bounce them
26110560Sgshapiro##	back to the postmaster at the sending site.
27110560Sgshapiro##
28110560Sgshapiro##	the algorithm is to scan the double-bounce error report generated
29110560Sgshapiro##	by sendmail on stdin, for the original message (it starts after the
30110560Sgshapiro##	second "Orignal message follows" marker), look for From, Sender, and
31110560Sgshapiro##	Received headers from the point closest to the sender back to the point
32110560Sgshapiro##	closest to us, and try to deliver a double-bounce report back to a
33110560Sgshapiro##	postmaster at one of these sites in the hope that they can
34110560Sgshapiro##	return the message to the original sender, or do something about
35110560Sgshapiro##	the fact that that sender's return address is not valid.
3638032Speter
3738032Speteruse Socket;
38110560Sgshapirouse Getopt::Std;
39120256Sgshapirouse File::Temp;
40110560Sgshapirouse Sys::Syslog qw(:DEFAULT setlogsock);
41110560Sgshapirouse strict;
42110560Sgshapirouse vars qw( $opt_d $tmpfile);
4338032Speter
4438032Speter# parseaddr()
4538032Speter#	parse hostname from From: header
4638032Speter#
4738032Spetersub parseaddr {
48110560Sgshapiro  my($hdr) = @_;
49110560Sgshapiro  my($addr);
5038032Speter
51110560Sgshapiro  if ($hdr =~ /<.*>/) {
52110560Sgshapiro    ($addr) = $hdr =~ m/<(.*)>/;
53110560Sgshapiro    $addr =~ s/.*\@//;
54110560Sgshapiro    return $addr;
55110560Sgshapiro  }
56110560Sgshapiro  if ($addr =~ /\s*\(/) {
57110560Sgshapiro    ($addr) = $hdr =~ m/\s*(.*)\s*\(/;
58110560Sgshapiro    $addr =~ s/.*\@//;
59110560Sgshapiro    return $addr;
60110560Sgshapiro  }
61110560Sgshapiro  ($addr) = $hdr =~ m/\s*(.*)\s*/;
62110560Sgshapiro  $addr =~ s/.*\@//;
63110560Sgshapiro  return $addr;
6438032Speter}
6538032Speter
6638032Speter# sendbounce()
6738032Speter#	send bounce to postmaster
6838032Speter#
6938032Speter#	this re-invokes sendmail in immediate and quiet mode to try
7038032Speter#	to deliver to a postmaster.  sendmail's exit status tells us
71110560Sgshapiro#	whether the delivery attempt really was successful.
7238032Speter#
73110560Sgshapirosub send_bounce {
74110560Sgshapiro  my($addr, $from) = @_;
75110560Sgshapiro  my($st);
76110560Sgshapiro  my($result);
7738032Speter
78110560Sgshapiro  my($dest) = "postmaster\@" . parseaddr($addr);
79110560Sgshapiro
80110560Sgshapiro  if ($opt_d) {
81110560Sgshapiro    syslog ('info', "Attempting to send to user $dest");
82110560Sgshapiro  }
83110560Sgshapiro  open(MAIL, "| /usr/sbin/sendmail -oeq $dest");
84110560Sgshapiro  print MAIL <<EOT;
85110560SgshapiroFrom: Mail Delivery Subsystem <mail-router>
8638032SpeterSubject: Postmaster notify: double bounce
87110560SgshapiroReply-To: nobody
88110560SgshapiroErrors-To: nobody
8938032SpeterPrecedence: junk
9038032SpeterAuto-Submitted: auto-generated (postmaster notification)
9138032Speter
92110560SgshapiroThe following message was received for an invalid recipient.  The
93110560Sgshapirosender's address was also invalid.  Since the message originated
94110560Sgshapiroat or transited through your mailer, this notification is being
95110560Sgshapirosent to you in the hope that you will determine the real originator
96110560Sgshapiroand have them correct their From or Sender address.
9738032Speter
98110560SgshapiroThe from header on the original e-mail was: $from.
9938032Speter
100110560Sgshapiro   ----- The following is a double bounce -----
10138032Speter
10238032SpeterEOT
103110560Sgshapiro
104110560Sgshapiro  open(MSG, "<$tmpfile");
105110560Sgshapiro  print MAIL <MSG>;
106110560Sgshapiro  close(MSG);
107110560Sgshapiro  $result = close(MAIL);
108110560Sgshapiro  if ($result) {
109110560Sgshapiro    syslog('info', 'doublebounce successfully sent to %s', $dest);
110110560Sgshapiro  }
111110560Sgshapiro  return $result;
11238032Speter}
113110560Sgshapiro
114110560Sgshapirosub main {
115110560Sgshapiro  # Get our command line options
116110560Sgshapiro  getopts('d');
117110560Sgshapiro
118110560Sgshapiro  # Set up syslog
119110560Sgshapiro  setlogsock('unix');
120110560Sgshapiro  openlog('doublebounce', 'pid', 'mail');
121110560Sgshapiro
122110560Sgshapiro  if ($opt_d) {
123110560Sgshapiro    syslog('info', 'Processing a doublebounce.');
124110560Sgshapiro  }
125110560Sgshapiro
126110560Sgshapiro  # The bounced e-mail may be large, so we'd better not try to buffer
127110560Sgshapiro  # it in memory, get a temporary file.
128120256Sgshapiro  $tmpfile = tmpnam();
129110560Sgshapiro
130110560Sgshapiro  if (!open(MSG, ">$tmpfile")) {
131110560Sgshapiro    syslog('err', "Unable to open temporary file $tmpfile");
132110560Sgshapiro    exit(75); # 75 is a temporary failure, sendmail should retry
133110560Sgshapiro  }
134110560Sgshapiro  print(MSG <STDIN>);
135110560Sgshapiro  close(MSG);
136110560Sgshapiro  if (!open(MSG, "<$tmpfile")) {
137110560Sgshapiro    syslog('err', "Unable to reopen temporary file $tmpfile");
138110560Sgshapiro    exit(74); # 74 is an IO error
139110560Sgshapiro  }
140110560Sgshapiro
141110560Sgshapiro  # Ok, now we can get down to business, find the original message
142110560Sgshapiro  my($skip_lines, $in_header, $headers_found, @addresses);
143110560Sgshapiro  $skip_lines = 0;
144110560Sgshapiro  $in_header = 0;
145110560Sgshapiro  $headers_found = 0;
146110560Sgshapiro  while (<MSG>) {
147110560Sgshapiro    if ($skip_lines > 0) {
148110560Sgshapiro      $skip_lines--;
149110560Sgshapiro      next;
150110560Sgshapiro    }
151110560Sgshapiro    chomp;
152110560Sgshapiro    # Starting message depends on your version of sendmail
153110560Sgshapiro    if (/^   ----- Original message follows -----$/ ||
154110560Sgshapiro        /^   ----Unsent message follows----$/ ||
155110560Sgshapiro        /^Content-Type: message\/rfc822$/) {
156110560Sgshapiro      # Found the original message
157110560Sgshapiro      $skip_lines++;
158110560Sgshapiro      $in_header = 1;
159110560Sgshapiro      $headers_found++;
160110560Sgshapiro      next;
161110560Sgshapiro    }
162110560Sgshapiro    if (/^$/) {
163110560Sgshapiro      if ($headers_found >= 2) {
164110560Sgshapiro         # We only process two deep, even if there are more
165110560Sgshapiro         last;
166110560Sgshapiro      }
167110560Sgshapiro      if ($in_header) {
168110560Sgshapiro         # We've found the end of a header, scan for the next one
169110560Sgshapiro         $in_header = 0;
170110560Sgshapiro      }
171110560Sgshapiro      next;
172110560Sgshapiro    }
173110560Sgshapiro    if ($in_header) {
174110560Sgshapiro      if (! /^[ \t]/) {
175110560Sgshapiro        # New Header
176110560Sgshapiro        if (/^(received): (.*)/i ||
177110560Sgshapiro            /^(reply-to): (.*)/i ||
178110560Sgshapiro            /^(sender): (.*)/i ||
179110560Sgshapiro            /^(from): (.*)/i ) {
180110560Sgshapiro          $addresses[$headers_found]{$1} = $2;
181110560Sgshapiro        }
182110560Sgshapiro        next;
183110560Sgshapiro      } else {
184110560Sgshapiro        # continuation header
185110560Sgshapiro        # we should really process these, but we don't yet
186110560Sgshapiro        next;
187110560Sgshapiro      }
188110560Sgshapiro    } else {
189110560Sgshapiro      # Nothing to do if we're not in a header
190110560Sgshapiro      next;
191110560Sgshapiro    }
192110560Sgshapiro  }
193110560Sgshapiro  close(MSG);
194110560Sgshapiro
195110560Sgshapiro  # Start with the original (inner) sender
196110560Sgshapiro  my($addr, $sent);
197110560Sgshapiro  foreach $addr (keys %{$addresses[2]}) {
198110560Sgshapiro    if ($opt_d) {
199110560Sgshapiro      syslog('info', "Trying to send to $addresses[2]{$addr} - $addresses[2]{\"From\"}");
200110560Sgshapiro    }
201110560Sgshapiro    $sent = send_bounce($addresses[2]{$addr}, $addresses[2]{"From"});
202110560Sgshapiro    last if $sent;
203110560Sgshapiro  }
204110560Sgshapiro  if (!$sent && $opt_d) {
205110560Sgshapiro    if ($opt_d) {
206110560Sgshapiro      syslog('info', 'Unable to find original sender, falling back.');
207110560Sgshapiro    }
208110560Sgshapiro    foreach $addr (keys %{$addresses[1]}) {
209110560Sgshapiro      if ($opt_d) {
210110560Sgshapiro        syslog('info', "Trying to send to $addresses[2]{$addr} - $addresses[2]{\"From\"}");
211110560Sgshapiro      }
212110560Sgshapiro      $sent = send_bounce($addresses[1]{$addr}, $addresses[2]{"From"});
213110560Sgshapiro      last if $sent;
214110560Sgshapiro    }
215110560Sgshapiro    if (!$sent) {
216110560Sgshapiro      syslog('info', 'Unable to find anyone to send a doublebounce notification');
217110560Sgshapiro    }
218110560Sgshapiro  }
219110560Sgshapiro
220110560Sgshapiro  unlink($tmpfile);
221110560Sgshapiro}
222110560Sgshapiro
223110560Sgshapiromain();
224110560Sgshapiroexit(0);
225110560Sgshapiro
226