#!/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 = "/etc/mail/mailman";

$MMLISTDIR = "/etc/mailman/lists";

$SENDMAIL = "/usr/lib/sendmail -oem -oi";

$VERSION = '$Id: mm-handler,v 1.2 2002/04/05 19:41:09 bwarsaw Exp $';

## 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);

	}

}