#!/usr/bin/perl

# bounce.pl
# Joe Hartley (joe.hartley@ingenta.com - work address
#              jh@brainiac.com - permanent home address
#
# This script takes a majordomo list name and the approve_passwd for that
# list as arguments, then scans stdin (which is assumed to be a bounced 
# majordomo post) for the invalid address, then unsubs that address from 
# the majordomo list named.
#
# This script was designed to be part of the list-owner alias so that it
# can be invoked automatically when email bounces.   Example:
#  owner-foo-l: me@domain.com,"|/usr/local/majordomo/bounce.pl foo-l PhonyPW"
#
# V1.0 - 27 July, 2001
# V1.1 - 07 August, 2001 - Support for MS Exchange, which in typical
#        MS form doesn't deign to use the RFC822 defined error codes.
#        I hate Microsoft so very, very much.
# 

# Set this to the domain your majordomo runs under
$our_domain = "yourdomain.com";

# Set this to the executable on your system
$mailer = "/bin/mail";

# This flag gets turned on when an Exchange error is detected
$evil = 0;

if ($ARGV[0]) {
   $listname = $ARGV[0]; 
   }
else {
   die("No listname was specified!\n");
   }

if ($ARGV[1]) {
   $passwd = $ARGV[1]; 
   }
else {
   die("No password was specified for $listname!\n");
   }

while (<STDIN>) {
   chop;

   if (/550/ || /554/) { 
      # We found the offending address.
      # 550 is the code usually used to signify no user, but some MTAs 
      # (like Yahoo's) use 554.
      @fields = split(/</);
      while (@fields) {
         $testline = pop(@fields);
         $idx = index($testline, "@");
         if ($idx != -1) {
            $idx = index($testline, ">");
            if ($idx != -1) {
               # We found a closing angle bracket; this is a simple parse.
               $addrline = substr($testline, 0, $idx);
               }
            else {
               # In this case, we found the error code and an @ sign, but
               # no closing bracket.  This makes things more difficult, as
               # the offending email address was not delimited by brackets.
               # Let's break it up using the space as a delimiter, find the
               # @ sign, and trim any trailing dots off the end of that line,
               # since there seem to always be 3 dots after the address in
               # these cases.
               @f2 = split(/ /);
               while (@f2) {
                  $t2 = pop(@f2);
                  $idx = index($t2, "@");
                  if ($idx != -1) {
                     $idx = index($t2, "...");
                     if ($idx != -1) {
                        $addrline = substr($t2, 0, $idx);
                        }
                     }
                  } # end while (@f2)
	       } # end else (no angle brackets)
            push(@addrlist, $addrline);
            } # end if(@ found in testline)
         } # end while(@fields)
      } # end if(550 || 554)

   elsif (/did not reach the following recipient/) {
      # This matches the non-standard error Exchange barfs out, but the
      # actual address is a few lines down, so we need a flag.
      $evil = 1;
      } # end if (we found Exchange)

   elsif (/SMTP/ && ($evil == 1)) {
      @fields = split(/;/);
      while (@fields) {
         $testline = pop(@fields);
         $idx = index($testline, "@");
         if ($idx != -1) {
            # At this point, we've found the portion of the string that
            # has the offending address.  It will take the form
            # dda:SMTP=user@domain.com so we have to strip off the extra
            $idx = index($testline, "=");
            if ($idx != -1) {
               $addrline = substr($testline, $idx+1);
               }
            push(@addrlist, $addrline);
            } # end if (/@/)
         } #end while (@fields)
      } # End of processing the Exchange crud
   } # end while(<STDIN>)


# The list of addresses has been built; discard the duplicates.
# This is ugly; maybe later I'll think of a more elegant way to do this.
foreach $addr1 (@addrlist) {
   $match = 0;
   foreach $addr2 (@finallist) {
      if ($addr1 eq $addr2) {
         $match = 1;
         }
      }
   if ($match == 0) {
      # Only add addresses > 5 characters long; this stops us from trying
      # to unsub an empty line.
      if (length($addr1) > 5) {
         push(@finallist, $addr1);
         }
      }
   }

# Debugging output - uncomment as desired
#print "Final tally:\n";
#for $addr (@finallist) {
#   print "Removing $addr\n";
#   }
#die "End of program\n";

# Finally, send the email to majordomo
$result =  open (MAIL,"|-");
die "Couldn't open pipe to mail subprocess" unless defined($result);
exec "$mailer majordomo\@$our_domain" or die "Couldn't exec mail"
   if $result == 0;
for $addr (@finallist) {
   print MAIL "approve $passwd unsubscribe $listname $addr\n";
   }
close MAIL;