contrib/mm-handler

   1 #!/usr/local/bin/perl
   2 ##
   3 ## Sendmail mailer for Mailman
   4 ##
   5 ## Simulates these aliases:
   6 ##
   7 ##testlist:              "|/home/mailman/mail/mailman post testlist"
   8 ##testlist-admin:        "|/home/mailman/mail/mailman admin testlist"
   9 ##testlist-bounces:      "|/home/mailman/mail/mailman bounces testlist"
  10 ##testlist-confirm:      "|/home/mailman/mail/mailman confirm testlist"
  11 ##testlist-join:         "|/home/mailman/mail/mailman join testlist"
  12 ##testlist-leave:        "|/home/mailman/mail/mailman leave testlist"
  13 ##testlist-owner:        "|/home/mailman/mail/mailman owner testlist"
  14 ##testlist-request:      "|/home/mailman/mail/mailman request testlist"
  15 ##testlist-subscribe:    "|/home/mailman/mail/mailman subscribe testlist"
  16 ##testlist-unsubscribe:  "|/home/mailman/mail/mailman unsubscribe testlist"
  17 ##owner-testlist:        testlist-owner
  18
  19 ## Some assembly required.
  20 $MMWRAPPER = "/home/mailman/mail/mailman";
  21 $MMLISTDIR = "/home/mailman/lists";
  22 $SENDMAIL = "/usr/lib/sendmail -oem -oi";
  23 $VERSION = '$Id: mm-handler 5100 2002-04-05 19:41:09Z bwarsaw $';
  24
  25 ## Comment this if you offer local user addresses.
  26 $NOUSERS = "\nPersonal e-mail addresses are not offered by this server.";
  27
  28 # uncomment for debugging....
  29 #$DEBUG = 1;
  30
  31 use FileHandle;
  32 use Sys::Hostname;
  33 use Socket;
  34
  35 ($VERS_STR = $VERSION) =~ s/^\$\S+\s+(\S+),v\s+(\S+\s+\S+\s+\S+).*/\1 \2/;
  36
  37 $BOUNDARY = sprintf("%08x-%d", time, time % $$);
  38
  39 ## Informative, non-standard rejection letter
  40 sub mail_error {
  41         my ($in, $to, $list, $server, $reason) = @_;
  42         my $sendmail;
  43
  44         if ($server && $server ne "") {
  45                 $servname = $server;
  46         } else {
  47                 $servname = "This server";
  48                 $server = &get_ip_addr;
  49         }
  50
  51         #$sendmail = new FileHandle ">/tmp/mm-$$";
  52         $sendmail = new FileHandle "|$SENDMAIL $to";
  53         if (!defined($sendmail)) {
  54                 print STDERR "$0: cannot exec \"$SENDMAIL\"\n";
  55                 exit (-1);
  56         }
  57
  58         $sendmail->print ("From: MAILER-DAEMON\@$server
  59 To: $to
  60 Subject: Returned mail: List unknown
  61 Mime-Version: 1.0
  62 Content-type: multipart/mixed; boundary=\"$BOUNDARY\"
  63 Content-Disposition: inline
  64
  65 --$BOUNDARY
  66 Content-Type: text/plain; charset=us-ascii
  67 Content-Description: Error processing your mail
  68 Content-Disposition: inline
  69
  70 Your mail for $list could not be sent:
  71         $reason
  72
  73 For a list of publicly-advertised mailing lists hosted on this server,
  74 visit this URL:
  75         http://$server/
  76
  77 If this does not resolve your problem, you may write to:
  78         postmaster\@$server
  79 or
  80         mailman-owner\@$server
  81
  82
  83 $servname delivers e-mail to registered mailing lists
  84 and to the administrative addresses defined and required by IETF
  85 Request for Comments (RFC) 2142 [1].
  86 $NOUSERS
  87
  88 The Internet Engineering Task Force [2] (IETF) oversees the development
  89 of open standards for the Internet community, including the protocols
  90 and formats employed by Internet mail systems.
  91
  92 For your convenience, your original mail is attached.
  93
  94
  95 [1] Crocker, D. \"Mailbox Names for Common Services, Roles and
  96     Functions\".  http://www.ietf.org/rfc/rfc2142.txt
  97
  98 [2] http://www.ietf.org/
  99
 100 --$BOUNDARY
 101 Content-Type: message/rfc822
 102 Content-Description: Your undelivered mail
 103 Content-Disposition: attachment
 104
 105 ");
 106
 107         while ($_ = <$in>) {
 108                 $sendmail->print ($_);
 109         }
 110
 111         $sendmail->print ("\n");
 112         $sendmail->print ("--$BOUNDARY--\n");
 113
 114         close($sendmail);
 115 }
 116
 117 ## Get my IP address, in case my sendmail doesn't tell me my name.
 118 sub get_ip_addr {
 119         my $host = hostname;
 120         my $ip = gethostbyname($host);
 121         return inet_ntoa($ip);
 122 }
 123
 124 ## Split an address into its base list name and the appropriate command
 125 ## for the relevant function.
 126 sub split_addr {
 127         my ($addr) = @_;
 128         my ($list, $cmd);
 129         my @validfields = qw(admin bounces confirm join leave owner request
 130                                 subscribe unsubscribe);
 131
 132         if ($addr =~ /(.*)-(.*)\+.*$/) {
 133                 $list = $1;
 134                 $cmd = "$2";
 135         } else {
 136                 $addr =~ /(.*)-(.*)$/;
 137                 $list = $1;
 138                 $cmd = $2;
 139         }
 140         if (grep /^$cmd$/, @validfields) {
 141                 if ($list eq "owner") {
 142                         $list = $cmd;
 143                         $cmd = "owner";
 144                 }
 145         } else {
 146                 $list = $addr;
 147                 $cmd = "post";
 148         }
 149
 150         return ($list, $cmd);
 151 }
 152
 153 ## The time, formatted as for an mbox's "From_" line.
 154 sub mboxdate {
 155         my ($time) = @_;
 156         my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
 157         my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
 158         my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
 159                 localtime($time);
 160
 161         ## Two-digit year handling complies with RFC 2822 (section 4.3),
 162         ## with the addition that three-digit years are accommodated.
 163         if ($year < 50) {
 164                 $year += 2000;
 165         } elsif ($year < 1900) {
 166                 $year += 1900;
 167         }
 168
 169         return sprintf ("%s %s %2d %02d:%02d:%02d %d",
 170                 $days[$wday], $months[$mon], $mday,
 171                 $hour, $min, $sec, $year);
 172 }
 173
 174 BEGIN: {
 175         $sender = undef;
 176         $server = undef;
 177         @to = ();
 178         while ($#ARGV >= 0) {
 179                 if ($ARGV[0] eq "-r") {
 180                         $sender = $ARGV[1];
 181                         shift @ARGV;
 182                 } elsif (!defined($server)) {
 183                         $server = $ARGV[0];
 184                 } else {
 185                         push(@to, $ARGV[0]);
 186                 }
 187                 shift @ARGV;
 188         }
 189
 190         if ($DEBUG) {
 191                 $to = join(',', @to);
 192                 print STDERR "to: $to\n";
 193                 print STDERR "sender: $sender\n";
 194                 print STDERR "server: $server\n";
 195                 exit(-1);
 196         }
 197
 198 ADDR:   for $addr (@to) {
 199                 $prev = undef;
 200                 $list = $addr;
 201
 202                 $cmd= "post";
 203                 if (! -f "$MMLISTDIR/$list/config.pck") {
 204                         ($list, $cmd) = &split_addr($list);
 205                         if (! -f "$MMLISTDIR/$list/config.pck") {
 206                                 $was_to = $addr;
 207                                 $was_to .= "\@$server" if ("$server" ne "");
 208                                 mail_error(\*STDIN, $sender, $was_to, $server,
 209                                         "no list named \"$list\" is known by $server");
 210                                 next ADDR;
 211                         }
 212                 }
 213
 214                 $wrapper = new FileHandle "|$MMWRAPPER $cmd $list";
 215                 if (!defined($wrapper)) {
 216                         ## Defer?
 217                         print STDERR "$0: cannot exec ",
 218                                 "\"$MMWRAPPER $cmd $list\": deferring\n";
 219                         exit (-1);
 220                 }
 221
 222                 # Don't need these without the "n" flag on the mailer def....
 223                 #$date = &mboxdate(time);
 224                 #$wrapper->print ("From $sender  $date\n");
 225
 226                 # ...because we use these instead.
 227                 $from_ = <STDIN>;
 228                 $wrapper->print ($from_);
 229
 230                 $wrapper->print ("X-Mailman-Handler: $VERSION\n");
 231                 while (<STDIN>) {
 232                         $wrapper->print ($_);
 233                 }
 234                 close($wrapper);
 235         }
 236 }