|
|
@@ -1,235 +0,0 @@
|
|
|
-#!@l_prefix@/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 = "@l_prefix@/libexec/mailman/mail/mailman";
|
|
|
-$MMLISTDIR = "@l_prefix@/var/mailman/lists";
|
|
|
-$SENDMAIL = "@l_prefix@/sbin/sendmail -oem -oi";
|
|
|
-$VERSION = '$Id: mailman-sendmail.pl,v 1.1 2005/04/30 17:18:54 rse 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, @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);
|
|
|
- }
|
|
|
-}
|