selinux-refpolicy/testing/mailman/mail/mm-handler
2005-11-10 22:12:53 +00:00

237 lines
5.8 KiB
Perl

#!/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);
}
}