diff options
Diffstat (limited to 'contrib/mm-handler')
| -rw-r--r-- | contrib/mm-handler | 236 |
1 files changed, 0 insertions, 236 deletions
diff --git a/contrib/mm-handler b/contrib/mm-handler deleted file mode 100644 index 0535cbfb8..000000000 --- a/contrib/mm-handler +++ /dev/null @@ -1,236 +0,0 @@ -#!/usr/local/bin/perl -## -## Sendmail mailer for Mailman -## -## Simulates these aliases: -## -##testlist: "|/home/mailman/mail/mailman post testlist" -##testlist-admin: "|/home/mailman/mail/mailman admin testlist" -##testlist-bounces: "|/home/mailman/mail/mailman bounces testlist" -##testlist-confirm: "|/home/mailman/mail/mailman confirm testlist" -##testlist-join: "|/home/mailman/mail/mailman join testlist" -##testlist-leave: "|/home/mailman/mail/mailman leave testlist" -##testlist-owner: "|/home/mailman/mail/mailman owner testlist" -##testlist-request: "|/home/mailman/mail/mailman request testlist" -##testlist-subscribe: "|/home/mailman/mail/mailman subscribe testlist" -##testlist-unsubscribe: "|/home/mailman/mail/mailman unsubscribe testlist" -##owner-testlist: testlist-owner - -## Some assembly required. -$MMWRAPPER = "/home/mailman/mail/mailman"; -$MMLISTDIR = "/home/mailman/lists"; -$SENDMAIL = "/usr/lib/sendmail -oem -oi"; -$VERSION = '$Id: mm-handler 5100 2002-04-05 19:41:09Z bwarsaw $'; - -## Comment this if you offer local user addresses. -$NOUSERS = "\nPersonal e-mail addresses are not offered by this server."; - -# uncomment for debugging.... -#$DEBUG = 1; - -use FileHandle; -use Sys::Hostname; -use Socket; - -($VERS_STR = $VERSION) =~ s/^\$\S+\s+(\S+),v\s+(\S+\s+\S+\s+\S+).*/\1 \2/; - -$BOUNDARY = sprintf("%08x-%d", time, time % $$); - -## Informative, non-standard rejection letter -sub mail_error { - my ($in, $to, $list, $server, $reason) = @_; - my $sendmail; - - if ($server && $server ne "") { - $servname = $server; - } else { - $servname = "This server"; - $server = &get_ip_addr; - } - - #$sendmail = new FileHandle ">/tmp/mm-$$"; - $sendmail = new FileHandle "|$SENDMAIL $to"; - if (!defined($sendmail)) { - print STDERR "$0: cannot exec \"$SENDMAIL\"\n"; - exit (-1); - } - - $sendmail->print ("From: MAILER-DAEMON\@$server -To: $to -Subject: Returned mail: List unknown -Mime-Version: 1.0 -Content-type: multipart/mixed; boundary=\"$BOUNDARY\" -Content-Disposition: inline - ---$BOUNDARY -Content-Type: text/plain; charset=us-ascii -Content-Description: Error processing your mail -Content-Disposition: inline - -Your mail for $list could not be sent: - $reason - -For a list of publicly-advertised mailing lists hosted on this server, -visit this URL: - http://$server/ - -If this does not resolve your problem, you may write to: - postmaster\@$server -or - mailman-owner\@$server - - -$servname delivers e-mail to registered mailing lists -and to the administrative addresses defined and required by IETF -Request for Comments (RFC) 2142 [1]. -$NOUSERS - -The Internet Engineering Task Force [2] (IETF) oversees the development -of open standards for the Internet community, including the protocols -and formats employed by Internet mail systems. - -For your convenience, your original mail is attached. - - -[1] Crocker, D. \"Mailbox Names for Common Services, Roles and - Functions\". http://www.ietf.org/rfc/rfc2142.txt - -[2] http://www.ietf.org/ - ---$BOUNDARY -Content-Type: message/rfc822 -Content-Description: Your undelivered mail -Content-Disposition: attachment - -"); - - while ($_ = <$in>) { - $sendmail->print ($_); - } - - $sendmail->print ("\n"); - $sendmail->print ("--$BOUNDARY--\n"); - - close($sendmail); -} - -## Get my IP address, in case my sendmail doesn't tell me my name. -sub get_ip_addr { - my $host = hostname; - my $ip = gethostbyname($host); - return inet_ntoa($ip); -} - -## Split an address into its base list name and the appropriate command -## for the relevant function. -sub split_addr { - my ($addr) = @_; - my ($list, $cmd); - my @validfields = qw(admin bounces confirm join leave owner request - subscribe unsubscribe); - - if ($addr =~ /(.*)-(.*)\+.*$/) { - $list = $1; - $cmd = "$2"; - } else { - $addr =~ /(.*)-(.*)$/; - $list = $1; - $cmd = $2; - } - if (grep /^$cmd$/, @validfields) { - if ($list eq "owner") { - $list = $cmd; - $cmd = "owner"; - } - } else { - $list = $addr; - $cmd = "post"; - } - - return ($list, $cmd); -} - -## The time, formatted as for an mbox's "From_" line. -sub mboxdate { - my ($time) = @_; - my @days = qw(Sun Mon Tue Wed Thu Fri Sat); - my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); - my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = - localtime($time); - - ## Two-digit year handling complies with RFC 2822 (section 4.3), - ## with the addition that three-digit years are accommodated. - if ($year < 50) { - $year += 2000; - } elsif ($year < 1900) { - $year += 1900; - } - - return sprintf ("%s %s %2d %02d:%02d:%02d %d", - $days[$wday], $months[$mon], $mday, - $hour, $min, $sec, $year); -} - -BEGIN: { - $sender = undef; - $server = undef; - @to = (); - while ($#ARGV >= 0) { - if ($ARGV[0] eq "-r") { - $sender = $ARGV[1]; - shift @ARGV; - } elsif (!defined($server)) { - $server = $ARGV[0]; - } else { - push(@to, $ARGV[0]); - } - shift @ARGV; - } - - if ($DEBUG) { - $to = join(',', @to); - print STDERR "to: $to\n"; - print STDERR "sender: $sender\n"; - print STDERR "server: $server\n"; - exit(-1); - } - -ADDR: for $addr (@to) { - $prev = undef; - $list = $addr; - - $cmd= "post"; - if (! -f "$MMLISTDIR/$list/config.pck") { - ($list, $cmd) = &split_addr($list); - if (! -f "$MMLISTDIR/$list/config.pck") { - $was_to = $addr; - $was_to .= "\@$server" if ("$server" ne ""); - mail_error(\*STDIN, $sender, $was_to, $server, - "no list named \"$list\" is known by $server"); - next ADDR; - } - } - - $wrapper = new FileHandle "|$MMWRAPPER $cmd $list"; - if (!defined($wrapper)) { - ## Defer? - print STDERR "$0: cannot exec ", - "\"$MMWRAPPER $cmd $list\": deferring\n"; - exit (-1); - } - - # Don't need these without the "n" flag on the mailer def.... - #$date = &mboxdate(time); - #$wrapper->print ("From $sender $date\n"); - - # ...because we use these instead. - $from_ = <STDIN>; - $wrapper->print ($from_); - - $wrapper->print ("X-Mailman-Handler: $VERSION\n"); - while (<STDIN>) { - $wrapper->print ($_); - } - close($wrapper); - } -} |
