From 6d999fe8d345dc9089bae9a389009304129bd71c Mon Sep 17 00:00:00 2001 From: Peter Wemm Date: Thu, 28 Aug 2008 02:32:16 +0000 Subject: Pass 2 of flattening sendmail vendor area. --- contrib/README | 10 + contrib/bitdomain.c | 409 +++++++++ contrib/bounce-resender.pl | 282 ++++++ contrib/bsdi.mc | 191 ++++ contrib/buildvirtuser | 216 +++++ contrib/cidrexpand | 138 +++ contrib/dnsblaccess.m4 | 94 ++ contrib/domainmap.m4 | 105 +++ contrib/doublebounce.pl | 225 +++++ contrib/etrn.0 | 58 ++ contrib/etrn.pl | 218 +++++ contrib/expn.pl | 1360 +++++++++++++++++++++++++++++ contrib/link_hash.sh | 36 + contrib/mail.local.linux | 205 +++++ contrib/mailprio | 557 ++++++++++++ contrib/mh.patch | 193 ++++ contrib/mmuegel | 2079 ++++++++++++++++++++++++++++++++++++++++++++ contrib/movemail.conf | 35 + contrib/movemail.pl | 106 +++ contrib/passwd-to-alias.pl | 31 + contrib/qtool.8 | 228 +++++ contrib/qtool.pl | 1324 ++++++++++++++++++++++++++++ contrib/re-mqueue.pl | 258 ++++++ contrib/rmail.oldsys.patch | 108 +++ contrib/smcontrol.pl | 413 +++++++++ contrib/socketmapClient.pl | 67 ++ contrib/socketmapServer.pl | 98 +++ 27 files changed, 9044 insertions(+) create mode 100644 contrib/README create mode 100644 contrib/bitdomain.c create mode 100755 contrib/bounce-resender.pl create mode 100644 contrib/bsdi.mc create mode 100755 contrib/buildvirtuser create mode 100755 contrib/cidrexpand create mode 100644 contrib/dnsblaccess.m4 create mode 100644 contrib/domainmap.m4 create mode 100644 contrib/doublebounce.pl create mode 100644 contrib/etrn.0 create mode 100755 contrib/etrn.pl create mode 100755 contrib/expn.pl create mode 100644 contrib/link_hash.sh create mode 100644 contrib/mail.local.linux create mode 100644 contrib/mailprio create mode 100644 contrib/mh.patch create mode 100644 contrib/mmuegel create mode 100644 contrib/movemail.conf create mode 100755 contrib/movemail.pl create mode 100755 contrib/passwd-to-alias.pl create mode 100644 contrib/qtool.8 create mode 100755 contrib/qtool.pl create mode 100644 contrib/re-mqueue.pl create mode 100644 contrib/rmail.oldsys.patch create mode 100755 contrib/smcontrol.pl create mode 100755 contrib/socketmapClient.pl create mode 100755 contrib/socketmapServer.pl (limited to 'contrib') diff --git a/contrib/README b/contrib/README new file mode 100644 index 000000000000..1098f48ea52b --- /dev/null +++ b/contrib/README @@ -0,0 +1,10 @@ +Everything in this directory (except this file) has been contributed. +We will not fix bugs in these programs. Contact the original author +for assistance. + +Some of these are patches to sendmail itself. You may need to take +care -- some of the patches may be out of date with the latest release +of sendmail. Also, the previous comment applies -- patches belong to +the original author, not to us. + +$Revision: 8.2 $, Last updated $Date: 1999/09/24 05:46:47 $ diff --git a/contrib/bitdomain.c b/contrib/bitdomain.c new file mode 100644 index 000000000000..0b7073d39215 --- /dev/null +++ b/contrib/bitdomain.c @@ -0,0 +1,409 @@ +/* + * By John G. Myers, jgm+@cmu.edu + * Version 1.2 + * + * Process a BITNET "internet.listing" file, producing output + * suitable for input to makemap. + * + * The input file can be obtained via anonymous FTP to bitnic.educom.edu. + * Change directory to "netinfo" and get the file internet.listing + * The file is updated monthly. + * + * Feed the output of this program to "makemap hash /etc/mail/bitdomain.db" + * to create the table used by the "FEATURE(bitdomain)" config file macro. + * If your sendmail does not have the db library compiled in, you can instead + * use "makemap dbm /etc/mail/bitdomain" and + * "FEATURE(bitdomain,`dbm -o /etc/mail/bitdomain')" + * + * The bitdomain table should be rebuilt monthly. + */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* don't use sizeof because sizeof(long) is different on 64-bit machines */ +#define SHORTSIZE 2 /* size of a short (really, must be 2) */ +#define LONGSIZE 4 /* size of a long (really, must be 4) */ + +typedef union +{ + HEADER qb1; + char qb2[PACKETSZ]; +} querybuf; + +extern int h_errno; +extern char *malloc(); +extern char *optarg; +extern int optind; + +char *lookup(); + +main(argc, argv) +int argc; +char **argv; +{ + int opt; + + while ((opt = getopt(argc, argv, "o:")) != -1) { + switch (opt) { + case 'o': + if (!freopen(optarg, "w", stdout)) { + perror(optarg); + exit(1); + } + break; + + default: + fprintf(stderr, "usage: %s [-o outfile] [internet.listing]\n", + argv[0]); + exit(1); + } + } + + if (optind < argc) { + if (!freopen(argv[optind], "r", stdin)) { + perror(argv[optind]); + exit(1); + } + } + readfile(stdin); + finish(); + exit(0); +} + +/* + * Parse and process an input file + */ +readfile(infile) +FILE *infile; +{ + int skippingheader = 1; + char buf[1024], *node, *hostname, *p; + + while (fgets(buf, sizeof(buf), infile)) { + for (p = buf; *p && isspace(*p); p++); + if (!*p) { + skippingheader = 0; + continue; + } + if (skippingheader) continue; + + node = p; + for (; *p && !isspace(*p); p++) { + if (isupper(*p)) *p = tolower(*p); + } + if (!*p) { + fprintf(stderr, "%-8s: no domain name in input file\n", node); + continue; + } + *p++ = '\0'; + + for (; *p && isspace(*p); p++) ; + if (!*p) { + fprintf(stderr, "%-8s no domain name in input file\n", node); + continue; + } + + hostname = p; + for (; *p && !isspace(*p); p++) { + if (isupper(*p)) *p = tolower(*p); + } + *p = '\0'; + + /* Chop off any trailing .bitnet */ + if (strlen(hostname) > 7 && + !strcmp(hostname+strlen(hostname)-7, ".bitnet")) { + hostname[strlen(hostname)-7] = '\0'; + } + entry(node, hostname, sizeof(buf)-(hostname - buf)); + } +} + +/* + * Process a single entry in the input file. + * The entry tells us that "node" expands to "domain". + * "domain" can either be a domain name or a bitnet node name + * The buffer pointed to by "domain" may be overwritten--it + * is of size "domainlen". + */ +entry(node, domain, domainlen) +char *node; +char *domain; +char *domainlen; +{ + char *otherdomain, *p, *err; + + /* See if we have any remembered information about this node */ + otherdomain = lookup(node); + + if (otherdomain && strchr(otherdomain, '.')) { + /* We already have a domain for this node */ + if (!strchr(domain, '.')) { + /* + * This entry is an Eric Thomas FOO.BITNET kludge. + * He doesn't want LISTSERV to do transitive closures, so we + * do them instead. Give the the domain expansion for "node" + * (which is in "otherdomian") to FOO (which is in "domain") + * if "domain" doesn't have a domain expansion already. + */ + p = lookup(domain); + if (!p || !strchr(p, '.')) remember(domain, otherdomain); + } + } + else { + if (!strchr(domain, '.') || valhost(domain, domainlen)) { + remember(node, domain); + if (otherdomain) { + /* + * We previously mapped the node "node" to the node + * "otherdomain". If "otherdomain" doesn't already + * have a domain expansion, give it the expansion "domain". + */ + p = lookup(otherdomain); + if (!p || !strchr(p, '.')) remember(otherdomain, domain); + } + } + else { + switch (h_errno) { + case HOST_NOT_FOUND: + err = "not registered in DNS"; + break; + + case TRY_AGAIN: + err = "temporary DNS lookup failure"; + break; + + case NO_RECOVERY: + err = "non-recoverable nameserver error"; + break; + + case NO_DATA: + err = "registered in DNS, but not mailable"; + break; + + default: + err = "unknown nameserver error"; + break; + } + + fprintf(stderr, "%-8s %s %s\n", node, domain, err); + } + } +} + +/* + * Validate whether the mail domain "host" is registered in the DNS. + * If "host" is a CNAME, it is expanded in-place if the expansion fits + * into the buffer of size "hbsize". Returns nonzero if it is, zero + * if it is not. A BIND error code is left in h_errno. + */ +int +valhost(host, hbsize) + char *host; + int hbsize; +{ + register u_char *eom, *ap; + register int n; + HEADER *hp; + querybuf answer; + int ancount, qdcount; + int ret; + int type; + int qtype; + char nbuf[1024]; + + if ((_res.options & RES_INIT) == 0 && res_init() == -1) + return (0); + + _res.options &= ~(RES_DNSRCH|RES_DEFNAMES); + _res.retrans = 30; + _res.retry = 10; + + qtype = T_ANY; + + for (;;) { + h_errno = NO_DATA; + ret = res_querydomain(host, "", C_IN, qtype, + &answer, sizeof(answer)); + if (ret <= 0) + { + if (errno == ECONNREFUSED || h_errno == TRY_AGAIN) + { + /* the name server seems to be down */ + h_errno = TRY_AGAIN; + return 0; + } + + if (h_errno != HOST_NOT_FOUND) + { + /* might have another type of interest */ + if (qtype == T_ANY) + { + qtype = T_A; + continue; + } + else if (qtype == T_A) + { + qtype = T_MX; + continue; + } + } + + /* otherwise, no record */ + return 0; + } + + /* + ** This might be a bogus match. Search for A, MX, or + ** CNAME records. + */ + + hp = (HEADER *) &answer; + ap = (u_char *) &answer + sizeof(HEADER); + eom = (u_char *) &answer + ret; + + /* skip question part of response -- we know what we asked */ + for (qdcount = ntohs(hp->qdcount); qdcount--; ap += ret + QFIXEDSZ) + { + if ((ret = dn_skipname(ap, eom)) < 0) + { + return 0; /* ???XXX??? */ + } + } + + for (ancount = ntohs(hp->ancount); --ancount >= 0 && ap < eom; ap += n) + { + n = dn_expand((u_char *) &answer, eom, ap, + (u_char *) nbuf, sizeof nbuf); + if (n < 0) + break; + ap += n; + GETSHORT(type, ap); + ap += SHORTSIZE + LONGSIZE; + GETSHORT(n, ap); + switch (type) + { + case T_MX: + case T_A: + return 1; + + case T_CNAME: + /* value points at name */ + if ((ret = dn_expand((u_char *)&answer, + eom, ap, (u_char *)nbuf, sizeof(nbuf))) < 0) + break; + if (strlen(nbuf) < hbsize) { + (void)strcpy(host, nbuf); + } + return 1; + + default: + /* not a record of interest */ + continue; + } + } + + /* + ** If this was a T_ANY query, we may have the info but + ** need an explicit query. Try T_A, then T_MX. + */ + + if (qtype == T_ANY) + qtype = T_A; + else if (qtype == T_A) + qtype = T_MX; + else + return 0; + } +} + +struct entry { + struct entry *next; + char *node; + char *domain; +}; +struct entry *firstentry; + +/* + * Find any remembered information about "node" + */ +char *lookup(node) +char *node; +{ + struct entry *p; + + for (p = firstentry; p; p = p->next) { + if (!strcmp(node, p->node)) { + return p->domain; + } + } + return 0; +} + +/* + * Mark the node "node" as equivalent to "domain". "domain" can either + * be a bitnet node or a domain name--if it is the latter, the mapping + * will be written to stdout. + */ +remember(node, domain) +char *node; +char *domain; +{ + struct entry *p; + + if (strchr(domain, '.')) { + fprintf(stdout, "%-8s %s\n", node, domain); + } + + for (p = firstentry; p; p = p->next) { + if (!strcmp(node, p->node)) { + p->domain = malloc(strlen(domain)+1); + if (!p->domain) { + goto outofmemory; + } + strcpy(p->domain, domain); + return; + } + } + + p = (struct entry *)malloc(sizeof(struct entry)); + if (!p) goto outofmemory; + + p->next = firstentry; + firstentry = p; + p->node = malloc(strlen(node)+1); + p->domain = malloc(strlen(domain)+1); + if (!p->node || !p->domain) goto outofmemory; + strcpy(p->node, node); + strcpy(p->domain, domain); + return; + + outofmemory: + fprintf(stderr, "Out of memory\n"); + exit(1); +} + +/* + * Walk through the database, looking for any cases where we know + * node FOO is equivalent to node BAR and node BAR has a domain name. + * For those cases, give FOO the same domain name as BAR. + */ +finish() +{ + struct entry *p; + char *domain; + + for (p = firstentry; p; p = p->next) { + if (!strchr(p->domain, '.') && (domain = lookup(p->domain))) { + remember(p->node, domain); + } + } +} + diff --git a/contrib/bounce-resender.pl b/contrib/bounce-resender.pl new file mode 100755 index 000000000000..9253cddff283 --- /dev/null +++ b/contrib/bounce-resender.pl @@ -0,0 +1,282 @@ +#!/usr/local/bin/perl -w +# +# bounce-resender: constructs mail queue from bounce spool for +# subsequent reprocessing by sendmail +# +# usage: given a mail spool full of (only) bounced mail called "bounces": +# # mkdir -m0700 bqueue; cd bqueue && bounce-resender < ../bounces +# # cd .. +# # chown -R root bqueue; chmod 600 bqueue/* +# # /usr/lib/sendmail -bp -oQ`pwd`/bqueue | more # does it look OK? +# # /usr/lib/sendmail -q -oQ`pwd`/bqueue -oT99d & # run the queue +# +# ** also read messages at end! ** +# +# Brian R. Gaeke Thu Feb 18 13:40:10 PST 1999 +# +############################################################################# +# This script has NO WARRANTY, NO BUG FIXES, and NO SUPPORT. You will +# need to modify it for your site and for your operating system, unless +# you are in the EECS Instructional group at UC Berkeley. (Search forward +# for two occurrences of "FIXME".) +# + +$state = "MSG_START"; +$ctr = 0; +$lineno = 0; +$getnrl = 0; +$nrl = ""; +$uname = "PhilOS"; # You don't want to change this here. +$myname = $0; +$myname =~ s,.*/([^/]*),$1,; + +chomp($hostname = `hostname`); +chomp($uname = `uname`); + +# FIXME: Define the functions "major" and "minor" for your OS. +if ($uname eq "SunOS") { + # from h2ph < /usr/include/sys/sysmacros.h on + # SunOS torus.CS.Berkeley.EDU 5.6 Generic_105182-11 i86pc i386 i86pc + eval 'sub O_BITSMINOR () {8;}' unless defined(&O_BITSMINOR); + eval 'sub O_MAXMAJ () {0x7f;}' unless defined(&O_MAXMAJ); + eval 'sub O_MAXMIN () {0xff;}' unless defined(&O_MAXMIN); + eval 'sub major { + local($x) = @_; + eval "((($x) >> &O_BITSMINOR) &O_MAXMAJ)"; + }' unless defined(&major); + eval 'sub minor { + local($x) = @_; + eval "(($x) &O_MAXMIN)"; + }' unless defined(&minor); +} else { + die "How do you calculate major and minor device numbers on $uname?\n"; +} + +sub ignorance { $ignored{$state}++; } + +sub unmunge { + my($addr) = @_; + $addr =~ s/_FNORD_/ /g; + # remove (Real Name) + $addr =~ s/^(.*)\([^\)]*\)(.*)$/$1$2/ + if $addr =~ /^.*\([^\)]*\).*$/; + # extract if it appears + $addr =~ s/^.*<([^>]*)>.*$/$1/ + if $addr =~ /^.*<[^>]*>.*$/; + # strip leading, trailing blanks + $addr =~ s/^\s*(.*)\s*/$1/; + # nuke local domain + # FIXME: Add a regular expression for your local domain here. + $addr =~ + s/@(cory|po|pasteur|torus|parker|cochise|franklin).(ee)?cs.berkeley.edu//i; + return $addr; +} + +print STDERR "$0: running on $hostname ($uname)\n"; + +open(INPUT,$ARGV[0]) || die "$ARGV[0]: $!\n"; + +sub working { + my($now); + $now = localtime; + print STDERR "$myname: Working... $now\n"; +} + +&working(); + +while (! eof INPUT) { + # get a new line + if ($state eq "IN_MESSAGE_HEADER") { + # handle multi-line headers + if ($nrl ne "" || $getnrl != 0) { + $_ = $nrl; + $getnrl = 0; + $nrl = ""; + } else { + $_ = ; $lineno++; + } + unless ($_ =~ /^\s*$/) { + while ($nrl eq "") { + $nrl = ; $lineno++; + if ($nrl =~ /^\s+[^\s].*$/) { # continuation line + chomp($_); + $_ .= "_FNORD_" . $nrl; + $nrl = ""; + } elsif ($nrl =~ /^\s*$/) { # end of headers + $getnrl++; + last; + } + } + } + } else { + # normal single line + if ($nrl ne "") { + $_ = $nrl; $nrl = ""; + } else { + $_ = ; $lineno++; + } + } + + if ($state eq "WAIT_FOR_FROM") { + if (/^From \S+.*$/) { + $state = "MSG_START"; + } else { + &ignorance(); + } + } elsif ($state eq "MSG_START") { + if (/^\s+boundary=\"([^\"]*)\".*$/) { + $boundary = $1; + $state = "GOT_BOUNDARY"; + $ctr++; + } else { + &ignorance(); + } + } elsif ($state eq "GOT_BOUNDARY") { + if (/^--$boundary/) { + $next = ; $lineno++; + if ($next =~ /^Content-Type: message\/rfc822/) { + $hour = (localtime)[2]; + $char = chr(ord("A") + $hour); + $ident = sprintf("%sAA%05d",$char,99999 - $ctr); + $qf = "qf$ident"; + $df = "df$ident"; + @rcpt = (); + open(MSGHDR,">$qf") || die "Can't write to $qf: $!\n"; + open(MSGBODY,">$df") || die "Can't write to $df: $!\n"; + chmod(0600, $qf, $df); + $state = "IN_MESSAGE_HEADER"; + $header = $body = ""; + $messageid = "bounce-resender-$ctr"; + $fromline = "MAILER-DAEMON"; + $ctencod = "7BIT"; + # skip a bit, brother maynard (boundary is separated from + # the header by a blank line) + $next = ; $lineno++; + unless ($next =~ /^\s*$/) { + print MSGHDR $next; + } + } + } else { + &ignorance(); + } + + $next = $char = $hour = undef; + } elsif ($state eq "IN_MESSAGE_HEADER") { + if (!(/^--$boundary/ || /^\s*$/)) { + if (/^Message-[iI][dD]:\s+<([^@]+)@[^>]*>.*$/) { + $messageid = $1; + } elsif (/^From:\s+(.*)$/) { + $fromline = $sender = $1; + $fromline = unmunge($fromline); + } elsif (/^Content-[Tt]ransfer-[Ee]ncoding:\s+(.*)$/) { + $ctencod = $1; + } elsif (/^(To|[Cc][Cc]):\s+(.*)$/) { + $toaddrs = $2; + foreach $toaddr (split(/,/,$toaddrs)) { + $toaddr = unmunge($toaddr); + push(@rcpt,$toaddr); + } + } + $headerline = $_; + # escape special chars + # (Perhaps not. It doesn't seem to be necessary (yet)). + #$headerline =~ s/([\(\)<>@,;:\\".\[\]])/\\$1/g; + # purely heuristic ;-) + $headerline =~ s/Return-Path:/?P?Return-Path:/g; + # save H-line to write to qf, later + $header .= "H$headerline"; + + $headerline = $toaddr = $toaddrs = undef; + } elsif (/^\s*$/) { + # write to qf + ($dev, $ino) = (stat($df))[0 .. 1]; + ($maj, $min) = (major($dev), minor($dev)); + $time = time(); + print MSGHDR "V2\n"; + print MSGHDR "B$ctencod\n"; + print MSGHDR "S$sender\n"; + print MSGHDR "I$maj/$min/$ino\n"; + print MSGHDR "K$time\n"; + print MSGHDR "T$time\n"; + print MSGHDR "D$df\n"; + print MSGHDR "N1\n"; + print MSGHDR "MDeferred: manually-requeued bounced message\n"; + foreach $r (@rcpt) { + print MSGHDR "RP:$r\n"; + } + $header =~ s/_FNORD_/\n/g; + print MSGHDR $header; + print MSGHDR "HMessage-ID: <$messageid@$hostname>\n" + if ($messageid =~ /bounce-resender/); + print MSGHDR ".\n"; + close MSGHDR; + + # jump to state waiting for message body + $state = "IN_MESSAGE_BODY"; + + $dev = $ino = $maj = $min = $r = $time = undef; + } elsif (/^--$boundary/) { + # signal an error + print "$myname: Header without message! Line $lineno qf $qf\n"; + + # write to qf anyway (SAME AS ABOVE, SHOULD BE A PROCEDURE) + ($dev, $ino) = (stat($df))[0 .. 1]; + ($maj, $min) = (major($dev), minor($dev)); + $time = time(); + print MSGHDR "V2\n"; + print MSGHDR "B$ctencod\n"; + print MSGHDR "S$sender\n"; + print MSGHDR "I$maj/$min/$ino\n"; + print MSGHDR "K$time\n"; + print MSGHDR "T$time\n"; + print MSGHDR "D$df\n"; + print MSGHDR "N1\n"; + print MSGHDR "MDeferred: manually-requeued bounced message\n"; + foreach $r (@rcpt) { + print MSGHDR "RP:$r\n"; + } + $header =~ s/_FNORD_/\n/g; + print MSGHDR $header; + print MSGHDR "HMessage-ID: <$messageid@$hostname>\n" + if ($messageid =~ /bounce-resender/); + print MSGHDR ".\n"; + close MSGHDR; + + # jump to state waiting for next bounce message + $state = "WAIT_FOR_FROM"; + + $dev = $ino = $maj = $min = $r = $time = undef; + } else { + # never got here + &ignorance(); + } + } elsif ($state eq "IN_MESSAGE_BODY") { + if (/^--$boundary/) { + print MSGBODY $body; + close MSGBODY; + $state = "WAIT_FOR_FROM"; + } else { + $body .= $_; + } + } + if ($lineno % 1900 == 0) { &working(); } +} + +close INPUT; + +foreach $x (keys %ignored) { + print STDERR + "$myname: ignored $ignored{$x} lines of bounce spool in state $x\n"; +} +print STDERR + "$myname: processed $lineno lines of input and wrote $ctr messages\n"; +print STDERR + "$myname: remember to chown the queue files to root before running:\n"; +chomp($pwd = `pwd`); +print STDERR "$myname: # sendmail -q -oQ$pwd -oT99d &\n"; + +print STDERR "$myname: to test the newly generated queue:\n"; +print STDERR "$myname: # sendmail -bp -oQ$pwd | more\n"; + +exit 0; + diff --git a/contrib/bsdi.mc b/contrib/bsdi.mc new file mode 100644 index 000000000000..5175a34a3030 --- /dev/null +++ b/contrib/bsdi.mc @@ -0,0 +1,191 @@ +Return-Path: sanders@austin.BSDI.COM +Received: from hofmann.CS.Berkeley.EDU (hofmann.CS.Berkeley.EDU [128.32.34.35]) by orodruin.CS.Berkeley.EDU (8.6.9/8.7.0.Beta0) with ESMTP id KAA28278 for ; Sat, 10 Dec 1994 10:49:08 -0800 +Received: from austin.BSDI.COM (austin.BSDI.COM [137.39.95.2]) by hofmann.CS.Berkeley.EDU (8.6.9/8.6.6.Beta11) with ESMTP id KAA09482 for ; Sat, 10 Dec 1994 10:49:03 -0800 +Received: from austin.BSDI.COM (sanders@localhost [127.0.0.1]) by austin.BSDI.COM (8.6.9/8.6.9) with ESMTP id MAA14919 for ; Sat, 10 Dec 1994 12:49:01 -0600 +Message-Id: <199412101849.MAA14919@austin.BSDI.COM> +To: Eric Allman +Subject: Re: sorting mailings lists with fastest delivery users first +In-reply-to: Your message of Sat, 10 Dec 1994 08:25:30 PST. +References: <199412101625.IAA15407@mastodon.CS.Berkeley.EDU> +From: Tony Sanders +Organization: Berkeley Software Design, Inc. +Date: Sat, 10 Dec 1994 12:49:00 -0600 +Sender: sanders@austin.BSDI.COM + +(some random text deleted) + +I'll send you something else I've hacked up. You are free to use this +or do with it as you like (I hereby make all my parts public domain). +It's a sample .mc file that has comments (mostly taken from the README) +and examples describing most of the common things people need to setup. + +# +# /usr/share/sendmail/cf/sample.mc +# +# Do not edit /etc/sendmail.cf directly unless you cannot do what you +# want in the master config file (/usr/share/sendmail/cf/sample.mc). +# To create /etc/sendmail.cf from the master: +# cd /usr/share/sendmail/cf +# mv /etc/sendmail.cf /etc/sendmail.cf.save +# m4 < sample.mc > /etc/sendmail.cf +# +# Then kill and restart sendmail: +# sh -c 'set `cat /var/run/sendmail.pid`; kill $1; shift; eval "$@"' +# +# See /usr/share/sendmail/README for help in building a configuration file. +# +include(`../m4/cf.m4') +VERSIONID(`@(#)$Id: bsdi.mc,v 8.1 1999/02/06 18:44:08 gshapiro Exp $') + +dnl # Specify your OS type below +OSTYPE(`bsd4.4') + +dnl # NOTE: `dnl' is the m4 command for delete-to-newline; these are +dnl # used to prevent those lines from appearing in the sendmail.cf. +dnl # +dnl # UUCP-only sites should configure FEATURE(`nodns') and SMART_HOST. +dnl # The uucp-dom mailer requires MAILER(smtp). For more info, see +dnl # `UUCP Config' at the end of this file. + +dnl # If you are not running DNS at all, it is important to use +dnl # FEATURE(nodns) to avoid having sendmail queue everything +dnl # waiting for the name server to come up. +dnl # Example: +dnl FEATURE(`nodns') + +dnl # Use FEATURE(`nocanonify') to skip address canonification via $[ ... $]. +dnl # This would generally only be used by sites that only act as mail gateways +dnl # or which have user agents that do full canonification themselves. +dnl # You may also want to use: +dnl # define(`confBIND_OPTS',`-DNSRCH -DEFNAMES') +dnl # to turn off the usual resolver options that do a similar thing. +dnl # Examples: +dnl FEATURE(`nocanonify') +dnl define(`confBIND_OPTS',`-DNSRCH -DEFNAMES') + +dnl # If /bin/hostname is not set to the FQDN (Full Qualified Domain Name; +dnl # for example, foo.bar.com) *and* you are not running a nameserver +dnl # (that is, you do not have an /etc/resolv.conf and are not running +dnl # named) *and* the canonical name for your machine in /etc/hosts +dnl # (the canonical name is the first name listed for a given IP Address) +dnl # is not the FQDN version then define NEED_DOMAIN and specify your +dnl # domain using `DD' (for example, if your hostname is `foo.bar.com' +dnl # then use DDbar.com). If in doubt, just define it anyway; doesn't hurt. +dnl # Examples: +dnl define(`NEED_DOMAIN', `1') +dnl DDyour.site.domain + +dnl # Define SMART_HOST if you want all outgoing mail to go to a central +dnl # site. SMART_HOST applies to names qualified with non-local names. +dnl # Example: +dnl define(`SMART_HOST', `smtp:firewall.bar.com') + +dnl # Define MAIL_HUB if you want all incoming mail sent to a +dnl # centralized hub, as for a shared /var/spool/mail scheme. +dnl # MAIL_HUB applies to names qualified with the name of the +dnl # local host (e.g., "eric@foo.bar.com"). +dnl # Example: +dnl define(`MAIL_HUB', `smtp:mailhub.bar.com') + +dnl # LOCAL_RELAY is a site that will handle unqualified names, this is +dnl # basically for site/company/department wide alias forwarding. By +dnl # default mail is delivered on the local host. +dnl # Example: +dnl define(`LOCAL_RELAY', `smtp:mailgate.bar.com') + +dnl # Relay hosts for fake domains: .UUCP .BITNET .CSNET +dnl # Examples: +dnl define(`UUCP_RELAY', `mailer:your_relay_host') +dnl define(`BITNET_RELAY', `mailer:your_relay_host') +dnl define(`CSNET_RELAY', `mailer:your_relay_host') + +dnl # Define `MASQUERADE_AS' is used to hide behind a gateway. +dnl # add any accounts you wish to be exposed (i.e., not hidden) to the +dnl # `EXPOSED_USER' list. +dnl # Example: +dnl MASQUERADE_AS(`some.other.host') + +dnl # If masquerading, EXPOSED_USER defines the list of accounts +dnl # that retain the local hostname in their address. +dnl # Example: +dnl EXPOSED_USER(`postmaster hostmaster webmaster') + +dnl # If masquerading is enabled (using MASQUERADE_AS above) then +dnl # FEATURE(allmasquerade) will cause recipient addresses to +dnl # masquerade as being from the masquerade host instead of +dnl # getting the local hostname. Although this may be right for +dnl # ordinary users, it breaks local aliases that aren't exposed +dnl # using EXPOSED_USER. +dnl # Example: +dnl FEATURE(allmasquerade) + +dnl # Include any required mailers +MAILER(local) +MAILER(smtp) +MAILER(uucp) + +LOCAL_CONFIG +# If this machine should be accepting mail as local for other hostnames +# that are MXed to this hostname then add those hostnames below using +# a line like: +# Cw bar.com +# The most common case where you need this is if this machine is supposed +# to be accepting mail for the domain. That is, if this machine is +# foo.bar.com and you have an MX record in the DNS that looks like: +# bar.com. IN MX 0 foo.bar.com. +# Then you will need to add `Cw bar.com' to the config file for foo.bar.com. +# DO NOT add Cw entries for hosts whom you simply store and forward mail +# for or else it will attempt local delivery. So just because bubba.bar.com +# is MXed to your machine you should not add a `Cw bubba.bar.com' entry +# unless you want local delivery and your machine is the highest-priority +# MX entry (that is is has the lowest preference value in the DNS. + +LOCAL_RULE_0 +# `LOCAL_RULE_0' can be used to introduce alternate delivery rules. +# For example, let's say you accept mail via an MX record for widgets.com +# (don't forget to add widgets.com to your Cw list, as above). +# +# If wigets.com only has an AOL address (widgetsinc) then you could use: +# R$+ <@ widgets.com.> $#smtp $@aol.com. $:widgetsinc<@aol.com.> +# +# Or, if widgets.com was connected to you via UUCP as the UUCP host +# widgets you might have: +# R$+ <@ widgets.com.> $#uucp $@widgets $:$1<@widgets.com.> + +dnl ### +dnl ### UUCP Config +dnl ### + +dnl # `SITECONFIG(site_config_file, name_of_site, connection)' +dnl # site_config_file the name of a file in the cf/siteconfig +dnl # directory (less the `.m4') +dnl # name_of_site the actual name of your UUCP site +dnl # connection one of U, W, X, or Y; where U means the sites listed +dnl # in the config file are connected locally; W, X, and Y +dnl # build remote UUCP hub classes ($=W, etc). +dnl # You will need to create the specific site_config_file in +dnl # /usr/share/sendmail/siteconfig/site_config_file.m4 +dnl # The site_config_file contains a list of directly connected UUCP hosts, +dnl # e.g., if you only connect to UUCP site gargoyle then you could just: +dnl # echo 'SITE(gargoyle)' > /usr/share/sendmail/siteconfig/uucp.foobar.m4 +dnl # Example: +dnl SITECONFIG(`uucp.foobar', `foobar', U) + +dnl # If you are on a local SMTP-based net that connects to the outside +dnl # world via UUCP, you can use LOCAL_NET_CONFIG to add appropriate rules. +dnl # For example: +dnl # define(`SMART_HOST', suucp:uunet) +dnl # LOCAL_NET_CONFIG +dnl # R$* < @ $* .$m. > $* $#smtp $@ $2.$m. $: $1 < @ $2.$m. > $3 +dnl # This will cause all names that end in your domain name ($m) to be sent +dnl # via SMTP; anything else will be sent via suucp (smart UUCP) to uunet. +dnl # If you have FEATURE(nocanonify), you may need to omit the dots after +dnl # the $m. +dnl # +dnl # If you are running a local DNS inside your domain which is not +dnl # otherwise connected to the outside world, you probably want to use: +dnl # define(`SMART_HOST', smtp:fire.wall.com) +dnl # LOCAL_NET_CONFIG +dnl # R$* < @ $* . > $* $#smtp $@ $2. $: $1 < @ $2. > $3 +dnl # That is, send directly only to things you found in your DNS lookup; +dnl # anything else goes through SMART_HOST. diff --git a/contrib/buildvirtuser b/contrib/buildvirtuser new file mode 100755 index 000000000000..a35a6e71e93d --- /dev/null +++ b/contrib/buildvirtuser @@ -0,0 +1,216 @@ +#!/usr/bin/perl -w + +# Copyright (c) 1999-2004, 2007 Gregory Neil Shapiro. All Rights Reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# 3. Neither the name of the author nor the names of its contributors +# may be used to endorse or promote products derived from this software +# without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. + +# $Id: buildvirtuser,v 1.8 2007/10/08 18:44:15 gshapiro Exp $ + +=head1 NAME + +buildvirtuser - Build virtusertable support from a directory of files + +=head1 SYNOPSIS + + buildvirtuser [-f] [-t] + +=head1 DESCRIPTION + +buildvirtuser will build /etc/mail/virtusertable.db and /etc/mail/virthosts +based on the contents of the directory /etc/mail/virtusers/. That +directory should contain one file per virtual domain with the filename +matching the virtual domain name and the contents containing a list of +usernames on the left and the actual address for that username on the +right. An empty left column translates to the default for that domain. +Blank lines and lines beginning with '#' are ignored. Occurrences of +$DOMAIN in the file are replaced by the current domain being processed. +Occurrences of $LHS in the right hand side are replaced by the address on +the left hand side. + +The -f option forces the database to be rebuilt regardless of whether +any file changes were detected. + +The -t option instructs the program to build a text file instead of a +database. The text file can then be used with makemap. + +=head1 CONFIGURATION + +In order to function properly, sendmail must be configured to use these +files with: + + FEATURE(`virtusertable')dnl + VIRTUSER_DOMAIN_FILE(`/etc/mail/virthosts')dnl + +If a new domain is added (i.e., by adding a new file to +/etc/mail/virtusers/), the sendmail daemon must be restarted for the change +to take affect. + +=head1 EXAMPLES + +Here is an example file from the /etc/mail/virtusers/ directory: + +=head2 /etc/mail/virtusers/example.org: + + # Services + MAILER-DAEMON gshapiro+bounce.$DOMAIN@example.net + postmaster gshapiro+$LHS.$DOMAIN@example.net + webmaster gshapiro+$LHS.$DOMAIN@example.net + + # Defaults + error:nouser No such user + + # Users + gshapiro gshapiro+$DOMAIN@example.net + zoe zoe@example.com + +=head1 AUTHOR + +Gregory Neil Shapiro EFE + +=cut + +use strict; +use File::stat; +use Getopt::Std; + +my $makemap = "/usr/sbin/makemap"; +my $dbtype = "hash"; +my $maildir = "/etc/mail"; +my $virthosts = "$maildir/virthosts"; +my $newvirthosts = "$maildir/virthosts.new"; +my $virts = "$maildir/virtusers"; +my $newvirt = "$maildir/virtusertable.new.db"; +my $virt = "$maildir/virtusertable.db"; +my %virt = (); +my $newest = 0; +my ($lhs, $domain, $key, $value); +my $opts = {}; + +sub preserve_perms ($$) +{ + my $old = shift; + my $new = shift; + my $st; + + $st = stat($old); + return if (!defined($st)); + chmod($st->mode, $new) || warn "Could not chmod($st->mode, $new): $!\n"; + chown($st->uid, $st->gid, $new) || warn "Could not chmod($st->uid, $st->gid, $new): $!\n"; +} + +getopts('ft', $opts) || die "Usage: $0 [-f] [-t]\n"; + +if ($opts->{t}) +{ + $newvirt = "$maildir/virtusertable.new"; + $virt = "$maildir/virtusertable"; +} + +opendir(VIRTS, $virts) || die "Could not open directory $virts: $!\n"; +my @virts = grep { -f "$virts/$_" } readdir(VIRTS); +closedir(VIRTS) || die "Could not close directory $virts: $!\n"; + +foreach $domain (@virts) +{ + next if ($domain =~ m/^\./); + open(DOMAIN, "$virts/$domain") || die "Could not open file $virts/$domain: $!\n"; + my $line = 0; + my $mtime = 0; + my $st = stat("$virts/$domain"); + $mtime = $st->mtime if (defined($st)); + if ($mtime > $newest) + { + $newest = $mtime; + } +LINE: while () + { + chomp; + $line++; + next LINE if /^#/; + next LINE if /^$/; + if (m/^([^\t ]*)[\t ]+(.*)$/) + { + if (defined($1)) + { + $lhs = "$1"; + $key = "$1\@$domain"; + } + else + { + $lhs = ""; + $key = "\@$domain"; + } + $value = $2; + } + else + { + warn "Bogus line $line in $virts/$domain\n"; + } + + # Variable subsitution + $key =~ s/\$DOMAIN/$domain/g; + $value =~ s/\$DOMAIN/$domain/g; + $value =~ s/\$LHS/$lhs/g; + $virt{$key} = $value; + } + close(DOMAIN) || die "Could not close $virts/$domain: $!\n"; +} + +my $virtmtime = 0; +my $st = stat($virt); +$virtmtime = $st->mtime if (defined($st)); +if ($opts->{f} || $virtmtime < $newest) +{ + print STDOUT "Rebuilding $virt\n"; +# logger -s -t ${prog} -p mail.info "Rebuilding ${basedir}/virtusertable" + if ($opts->{t}) + { + open(MAKEMAP, ">$newvirt") || die "Could not open $newvirt: $!\n"; + } + else + { + open(MAKEMAP, "|$makemap $dbtype $newvirt") || die "Could not start makemap: $!\n"; + } + + foreach $key (keys %virt) + { + print MAKEMAP "$key\t\t$virt{$key}\n"; + } + close(MAKEMAP) || die "Could not close makemap ($?): $!\n"; + preserve_perms($virt, $newvirt); + rename($newvirt, $virt) || die "Could not rename $newvirt to $virt: $!\n"; + + open(VIRTHOST, ">$newvirthosts") || die "Could not open file $newvirthosts: $!\n"; + foreach $domain (sort @virts) + { + next if ($domain =~ m/^\./); + print VIRTHOST "$domain\n"; + } + close(VIRTHOST) || die "Could not close $newvirthosts: $!\n"; + preserve_perms($virthosts, $newvirthosts); + rename($newvirthosts, $virthosts) || die "Could not rename $newvirthosts to $virthosts: $!\n"; +} +exit 0; diff --git a/contrib/cidrexpand b/contrib/cidrexpand new file mode 100755 index 000000000000..f277481ca567 --- /dev/null +++ b/contrib/cidrexpand @@ -0,0 +1,138 @@ +#!/usr/bin/perl -w + +# $Id: cidrexpand,v 8.8 2006/08/07 17:18:37 ca Exp $ +# +# v 0.4 +# +# 17 July 2000 Derek J. Balling (dredd@megacity.org) +# +# Acts as a preparser on /etc/mail/access_db to allow you to use address/bit +# notation. +# +# If you have two overlapping CIDR blocks with conflicting actions +# e.g. 10.2.3.128/25 REJECT and 10.2.3.143 ACCEPT +# make sure that the exceptions to the more general block are specified +# later in the access_db. +# +# the -r flag to makemap will make it "do the right thing" +# +# Modifications +# ------------- +# 26 Jul 2001 Derek Balling (dredd@megacity.org) +# Now uses Net::CIDR because it makes life a lot easier. +# +# 5 Nov 2002 Richard Rognlie (richard@sendmail.com) +# Added code to deal with the prefix tags that may now be included in +# the access_db +# +# Added clarification in the notes for what to do if you have +# exceptions to a larger CIDR block. +# +# 26 Jul 2006 Richard Rognlie (richard@sendmail.com> +# Added code to strip "comments" (anything after a non-escaped #) +# # characters after a \ or within quotes (single and double) are +# left intact. +# +# e.g. +# From:1.2.3.4 550 Die spammer # spammed us 2006.07.26 +# becomes +# From:1.2.3.4 550 Die spammer +# +# 3 August 2006 +# +# Corrected a bug to have it handle the special case of "0.0.0.0/0" +# since Net::CIDR doesn't handle it properly. +# +# usage: +# cidrexpand < /etc/mail/access | makemap -r hash /etc/mail/access +# +# +# Report bugs to: +# + + +use strict; +use Net::CIDR; +use Getopt::Std; + +our ($opt_c,$opt_t); +getopts('ct:'); + +my $spaceregex = '\s+'; +if ($opt_t) +{ + $spaceregex = $opt_t; +} + +while (<>) +{ + chomp; + my ($prefix,$left,$right,$space); + + if ( (/\#/) && $opt_c ) + { + # print "checking...\n"; + my $i; + my $qtype=''; + for ($i=0 ; $i -r`'ifdef(`EDNSBL_TO',`EDNSBL_TO',`5') +') +divert(-1) +define(`_EDNSBL_SRV_', `ifelse(len(X`'_ARG_),`1',`blackholes.mail-abuse.org',_ARG_)')dnl +define(`_EDNSBL_MSG_', `ifelse(len(X`'_ARG2_),`1',`"550 Rejected: " $`'&{client_addr} " listed at '_EDNSBL_SRV_`"',`_ARG2_')')dnl +define(`_EDNSBL_MSG_TMP_', `ifelse(_ARG3_,`t',`"451 Temporary lookup failure of " $`'&{client_addr} " at '_EDNSBL_SRV_`"',`_ARG3_')')dnl +define(`_EDNSBL_KEY_', `ifelse(len(X`'_ARG4_),`1',`dnsblaccess',_ARG4_)')dnl +divert(8) +# DNS based IP address spam list _EDNSBL_SRV_ +R$* $: $&{client_addr} +dnl IPv6? +R$-.$-.$-.$- $: $(ednsbl $4.$3.$2.$1._EDNSBL_SRV_. $: OK $) <>$1.$2.$3.$4 +ROK<>$* $: OKSOFAR +R$+<>$* $: > +R$* $- .<>$* <$(access _EDNSBL_KEY_`:'$1$2 $@$3 $@`'_EDNSBL_SRV_ $: ? $)> $1 <>$3 +R$* <>$* $:<$(access _EDNSBL_KEY_`:' $@$2 $@`'_EDNSBL_SRV_ $: ? $)> <>$2 +ifelse(len(X`'_ARG3_),`1', +`R<$*>$* $: TMPOK', +`R<$*>$* $#error $@ 4.4.3 $: _EDNSBL_MSG_TMP_') +R<$={Accept}>$* $: OKSOFAR +R $* $#error $@ $1.$2.$3 $: $4 +R $* $#error $: $1 +R $* $#discard $: discard +R<$*> $* $#error $@ 5.7.1 $: _EDNSBL_MSG_ +divert(-1) diff --git a/contrib/domainmap.m4 b/contrib/domainmap.m4 new file mode 100644 index 000000000000..6d56e8406e35 --- /dev/null +++ b/contrib/domainmap.m4 @@ -0,0 +1,105 @@ +divert(-1)changequote(<<, >>)<< +----------------------------------------------------------------------------- + + FEATURE(domainmap) Macro + + The existing virtusertable feature distributed with sendmail is a good + basic approach to virtual hosting, but it is missing a few key + features: + + 1. Ability to have a different map for each domain. + 2. Ability to perform virtual hosting for domains which are not in $=w. + 3. Ability to use a centralized network-accessible database (such as + PH) which is keyed on username alone (as opposed to the + fully-qualified email address). + + The FEATURE(domainmap) macro neatly solves these problems. + + The basic syntax of the macro is: + FEATURE(domainmap, `domain.com', `map definition ...')dnl + + To illustrate how it works, here is an example: + FEATURE(domainmap, `foo.com', `dbm -o /etc/mail/foo-users')dnl + + In this example, mail sent to user@foo.com will be rewritten by the + domainmap. The username will be looked up in the DBM map + /etc/mail/foo-users, which looks like this: + jsmith johnsmith@mailbox.foo.com + jdoe janedoe@sandbox.bar.com + + So mail sent to jsmith@foo.com will be relayed to + johnsmith@mailbox.foo.com, and mail sent to jdoe@foo.com will be + relayed to janedoe@sandbox.bar.com. + + The FEATURE(domainmap) Macro supports the user+detail syntax by + stripping off the +detail portion before the domainmap lookup and + tacking it back on to the result. Using the example above, mail sent + to jsmith+sometext@foo.com will be rewritten as + johnsmith+sometext@mailbox.foo.com. + + If one of the elements in the $=w class (i.e., "local" delivery hosts) + is a domain specified in a FEATURE(domainmap) entry, you need to use + the LOCAL_USER(username) macro to specify the list of users for whom + domainmap lookups should not be done. + + To use this macro, simply copy this file into the cf/feature directory + in the sendmail source tree. For more information, please see the + following URL: + + http://www-dev.cites.uiuc.edu/sendmail/domainmap/ + + Feedback is welcome. + + Mark D. Roth + +----------------------------------------------------------------------------- +>>changequote(`, ')undivert(-1)divert + +ifdef(`_DOMAIN_MAP_',`',`dnl +LOCAL_RULE_0 +# do mapping for domains where applicable +R$* $=O $* <@ $={MappedDomain} .> $@ $>Recurse $1 $2 $3 Strip extraneous routing +R$+ <@ $={MappedDomain} .> $>DomainMapLookup $1 <@ $2 .> domain mapping + +LOCAL_RULESETS +########################################################################### +### Ruleset DomainMapLookup -- special rewriting for mapped domains ### +########################################################################### + +SDomainMapLookup +R $=L <@ $=w .> $@ $1 <@ $2 .> weed out local users, in case +# Cw contains a mapped domain +R $+ <@ $+> $: $1 <@ $2 > <$&{addr_type}> check if sender +R $+ <@ $+> $#smtp $@ $2 $: $1 @ $2 do not process sender +ifdef(`DOMAINMAP_NO_REGEX',`dnl +R $+ <@ $+> <$*> $: $1 <@ $2> <$2> find domain +R $+ <$+> <$+ . $+> $1 <$2> < $(dequote $3 "_" $4 $) > +# change "." to "_" +R $+ <$+> <$+ .> $: $1 <$2> < $(dequote "domain_" $3 $) > +# prepend "domain_" +dnl',`dnl +R $+ <@ $+> <$*> $: $1 <@ $2> <$2 :NOTDONE:> find domain +R $+ <$+> <$+ . :NOTDONE:> $1 <$2> < $(domainmap_regex $3 $: $3 $) > +# change "." and "-" to "_" +R $+ <$+> <$+> $: $1 <$2> < $(dequote "domain_" $3 $) > +# prepend "domain_" +dnl') +R $+ <$+> <$+> $: $1 <$2> <$3> $1 find user name +R $+ <$+> <$+> $+ + $* $: $1 <$2> <$3> $4 handle user+detail syntax +R $+ <$+> <$+> $+ $: $1 <$2> $( $3 $4 $: $) +# do actual domain map lookup +R $+ <$+> $#error $@ 5.1.1 $: "550 email address lookup in domain map failed" +R $+ <@ $+> $* $* $#dsmtp $@ localhost $: $1 @ $2 +# queue it up for later delivery +R $+ + $* <$+> $+ @ $+ $: $1 + $2 <$3> $4 + $2 @ $5 +# reset original user+detail +R $+ <$+> $+ $@ $>Recurse $3 recanonify + +ifdef(`DOMAINMAP_NO_REGEX',`',`dnl +LOCAL_CONFIG +K domainmap_regex regex -a.:NOTDONE: -s1,2 -d_ (.*)[-\.]([^-\.]*)$ +')define(`_DOMAIN_MAP_',`1')') + +LOCAL_CONFIG +C{MappedDomain} _ARG_ +K `domain_'translit(_ARG_, `.-', `__') _ARG2_ -T diff --git a/contrib/doublebounce.pl b/contrib/doublebounce.pl new file mode 100644 index 000000000000..dc26ab84f1a7 --- /dev/null +++ b/contrib/doublebounce.pl @@ -0,0 +1,225 @@ +#!/usr/bin/perl +# doublebounce.pl +# +# Return a doubly-bounced e-mail to postmaster. Specific to sendmail, +# updated to work on sendmail 8.12.6. +# +# Based on the original doublebounce.pl code by jr@terra.net, 12/4/97. +# Updated by bicknell@ufp.org, 12/4/2002 to understand new sendmail DSN +# bounces. Code cleanup also performed, mainly making things more +# robust. +# +# Original intro included below, lines with ## +## attempt to return a doubly-bounced email to a postmaster +## jr@terra.net, 12/4/97 +## +## invoke by creating an mail alias such as: +## doublebounce: "|/usr/local/sbin/doublebounce" +## then adding this line to your sendmail.cf: +## O DoubleBounceAddress=doublebounce +## +## optionally, add a "-d" flag in the aliases file, to send a +## debug trace to your own postmaster showing what is going on +## +## this allows the "postmaster" address to still go to a human being, +## while bounce messages can go to this script, which will bounce them +## back to the postmaster at the sending site. +## +## the algorithm is to scan the double-bounce error report generated +## by sendmail on stdin, for the original message (it starts after the +## second "Orignal message follows" marker), look for From, Sender, and +## Received headers from the point closest to the sender back to the point +## closest to us, and try to deliver a double-bounce report back to a +## postmaster at one of these sites in the hope that they can +## return the message to the original sender, or do something about +## the fact that that sender's return address is not valid. + +use Socket; +use Getopt::Std; +use File::Temp; +use Sys::Syslog qw(:DEFAULT setlogsock); +use strict; +use vars qw( $opt_d $tmpfile); + +# parseaddr() +# parse hostname from From: header +# +sub parseaddr { + my($hdr) = @_; + my($addr); + + if ($hdr =~ /<.*>/) { + ($addr) = $hdr =~ m/<(.*)>/; + $addr =~ s/.*\@//; + return $addr; + } + if ($addr =~ /\s*\(/) { + ($addr) = $hdr =~ m/\s*(.*)\s*\(/; + $addr =~ s/.*\@//; + return $addr; + } + ($addr) = $hdr =~ m/\s*(.*)\s*/; + $addr =~ s/.*\@//; + return $addr; +} + +# sendbounce() +# send bounce to postmaster +# +# this re-invokes sendmail in immediate and quiet mode to try +# to deliver to a postmaster. sendmail's exit status tells us +# whether the delivery attempt really was successful. +# +sub send_bounce { + my($addr, $from) = @_; + my($st); + my($result); + + my($dest) = "postmaster\@" . parseaddr($addr); + + if ($opt_d) { + syslog ('info', "Attempting to send to user $dest"); + } + open(MAIL, "| /usr/sbin/sendmail -oeq $dest"); + print MAIL < +Subject: Postmaster notify: double bounce +Reply-To: nobody +Errors-To: nobody +Precedence: junk +Auto-Submitted: auto-generated (postmaster notification) + +The following message was received for an invalid recipient. The +sender's address was also invalid. Since the message originated +at or transited through your mailer, this notification is being +sent to you in the hope that you will determine the real originator +and have them correct their From or Sender address. + +The from header on the original e-mail was: $from. + + ----- The following is a double bounce ----- + +EOT + + open(MSG, "<$tmpfile"); + print MAIL ; + close(MSG); + $result = close(MAIL); + if ($result) { + syslog('info', 'doublebounce successfully sent to %s', $dest); + } + return $result; +} + +sub main { + # Get our command line options + getopts('d'); + + # Set up syslog + setlogsock('unix'); + openlog('doublebounce', 'pid', 'mail'); + + if ($opt_d) { + syslog('info', 'Processing a doublebounce.'); + } + + # The bounced e-mail may be large, so we'd better not try to buffer + # it in memory, get a temporary file. + $tmpfile = tmpnam(); + + if (!open(MSG, ">$tmpfile")) { + syslog('err', "Unable to open temporary file $tmpfile"); + exit(75); # 75 is a temporary failure, sendmail should retry + } + print(MSG ); + close(MSG); + if (!open(MSG, "<$tmpfile")) { + syslog('err', "Unable to reopen temporary file $tmpfile"); + exit(74); # 74 is an IO error + } + + # Ok, now we can get down to business, find the original message + my($skip_lines, $in_header, $headers_found, @addresses); + $skip_lines = 0; + $in_header = 0; + $headers_found = 0; + while () { + if ($skip_lines > 0) { + $skip_lines--; + next; + } + chomp; + # Starting message depends on your version of sendmail + if (/^ ----- Original message follows -----$/ || + /^ ----Unsent message follows----$/ || + /^Content-Type: message\/rfc822$/) { + # Found the original message + $skip_lines++; + $in_header = 1; + $headers_found++; + next; + } + if (/^$/) { + if ($headers_found >= 2) { + # We only process two deep, even if there are more + last; + } + if ($in_header) { + # We've found the end of a header, scan for the next one + $in_header = 0; + } + next; + } + if ($in_header) { + if (! /^[ \t]/) { + # New Header + if (/^(received): (.*)/i || + /^(reply-to): (.*)/i || + /^(sender): (.*)/i || + /^(from): (.*)/i ) { + $addresses[$headers_found]{$1} = $2; + } + next; + } else { + # continuation header + # we should really process these, but we don't yet + next; + } + } else { + # Nothing to do if we're not in a header + next; + } + } + close(MSG); + + # Start with the original (inner) sender + my($addr, $sent); + foreach $addr (keys %{$addresses[2]}) { + if ($opt_d) { + syslog('info', "Trying to send to $addresses[2]{$addr} - $addresses[2]{\"From\"}"); + } + $sent = send_bounce($addresses[2]{$addr}, $addresses[2]{"From"}); + last if $sent; + } + if (!$sent && $opt_d) { + if ($opt_d) { + syslog('info', 'Unable to find original sender, falling back.'); + } + foreach $addr (keys %{$addresses[1]}) { + if ($opt_d) { + syslog('info', "Trying to send to $addresses[2]{$addr} - $addresses[2]{\"From\"}"); + } + $sent = send_bounce($addresses[1]{$addr}, $addresses[2]{"From"}); + last if $sent; + } + if (!$sent) { + syslog('info', 'Unable to find anyone to send a doublebounce notification'); + } + } + + unlink($tmpfile); +} + +main(); +exit(0); + diff --git a/contrib/etrn.0 b/contrib/etrn.0 new file mode 100644 index 000000000000..66f7975d1393 --- /dev/null +++ b/contrib/etrn.0 @@ -0,0 +1,58 @@ +System Administration Commands etrn(1M) + + +NAME + etrn - start mail queue run + +SYNOPSIS + etrn [-v] server-host [client-hosts] + +DESCRIPTION + SMTP's ETRN command allows an SMTP client and server to + interact, giving the server an opportunity to start the pro­ + cessing of its queues for messages to go to a given host. + This is meant to be used in start-up conditions, as well as + for mail nodes that have transient connections to their ser­ + vice providers. + + The etrn utility initiates an SMTP session with the host + server-host and sends one or more ETRN commands as follows: + If no client-hosts are specified, etrn looks up every host + name for which sendmail(1M) accepts email and, for each + name, sends an ETRN command with that name as the argument. + If any client-hosts are specified, etrn uses each of these + as arguments for successive ETRN commands. + +OPTIONS + The following option is supported: + + -v The normal mode of operation for etrn is to do all of + its work silently. The -v option makes it verbose, + which causes etrn to display its conversations with + the remote SMTP server. + +ENVIRONMENT + No environment variables are used. + +FILES + /etc/mail/sendmail.cf + sendmail configuration file + +SEE ALSO + sendmail(1M), RFC 1985. + +CAVEATS + Not all SMTP servers support ETRN. + +CREDITS + Leveraged from David Muir Sharnoff's expn.pl script. Chris­ + tian von Roques added support for args and fixed a couple of + bugs. + +AVAILABILITY + The latest version of etrn is available in the contrib + directory of the sendmail distribution through anonymous ftp + at ftp://ftp.sendmail.org/ucb/src/sendmail/. + +AUTHOR + John T. Beck diff --git a/contrib/etrn.pl b/contrib/etrn.pl new file mode 100755 index 000000000000..2d50cb42c95b --- /dev/null +++ b/contrib/etrn.pl @@ -0,0 +1,218 @@ +#!/usr/local/bin/perl -w +# +# Copyright (c) 1996-2000 by John T. Beck +# All rights reserved. +# +# Copyright (c) 2000 by Sun Microsystems, Inc. +# All rights reserved. +# +#ident "@(#)etrn.pl 1.1 00/09/06 SMI" + +require 5.005; # minimal Perl version required +use strict; +use English; + +# hardcoded constants, should work fine for BSD-based systems +use Socket; +use Getopt::Std; +use vars qw($opt_v); +my $sockaddr = 'S n a4 x8'; + +# system requirements: +# must have 'hostname' program. + +my $port = 'smtp'; +select(STDERR); + +chop(my $name = `hostname || uname -n`); + +(my $hostname, my $aliases, my $type, my $len, undef) = gethostbyname($name); + +my $usage = "Usage: $PROGRAM_NAME [-v] host [args]"; +getopts('v'); +my $verbose = $opt_v; +my $server = shift(@ARGV); +my @hosts = @ARGV; +die $usage unless $server; +my @cwfiles = (); +my $alarm_action = ""; + +if (!@hosts) { + push(@hosts, $hostname); + + open(CF, "){ + # look for a line starting with "Fw" + if (/^Fw.*$/) { + my $cwfile = $ARG; + chop($cwfile); + my $optional = /^Fw-o/; + # extract the file name + $cwfile =~ s,^Fw[^/]*,,; + + # strip the options after the filename + $cwfile =~ s/ [^ ]+$//; + + if (-r $cwfile) { + push (@cwfiles, $cwfile); + } else { + die "$cwfile is not readable" unless $optional; + } + } + # look for a line starting with "Cw" + if (/^Cw(.*)$/) { + my @cws = split (' ', $1); + while (@cws) { + my $thishost = shift(@cws); + push(@hosts, $thishost) + unless $thishost =~ "$hostname|localhost"; + } + } + } + close(CF); + + for my $cwfile (@cwfiles) { + if (open(CW, "<$cwfile")) { + while () { + next if /^\#/; + my $thishost = $ARG; + chop($thishost); + push(@hosts, $thishost) + unless $thishost =~ $hostname; + } + close(CW); + } else { + die "open $cwfile: $ERRNO"; + } + } +} + +($name, $aliases, my $proto) = getprotobyname('tcp'); +($name, $aliases, $port) = getservbyname($port, 'tcp') + unless $port =~ /^\d+/; + +# look it up + +($name, $aliases, $type, $len, my $thataddr) = gethostbyname($server); +(!defined($name)) && die "gethostbyname failed, unknown host $server"; + +# get a connection +my $that = pack($sockaddr, &AF_INET, $port, $thataddr); +socket(S, &AF_INET, &SOCK_STREAM, $proto) + || die "socket: $ERRNO"; +print "server = $server\n" if (defined($verbose)); +&alarm("connect to $server"); +if (! connect(S, $that)) { + die "cannot connect to $server: $ERRNO\n"; +} +alarm(0); +select((select(S), $OUTPUT_AUTOFLUSH = 1)[0]); # don't buffer output to S + +# read the greeting +&alarm("greeting with $server"); +while () { + alarm(0); + print if $verbose; + if (/^(\d+)([- ])/) { + # SMTP's initial greeting response code is 220. + if ($1 != 220) { + &alarm("giving up after bad response from $server"); + &read_response($2, $verbose); + alarm(0); + print STDERR "$server: NOT 220 greeting: $ARG" + if ($verbose); + } + last if ($2 eq " "); + } else { + print STDERR "$server: NOT 220 greeting: $ARG" + if ($verbose); + close(S); + } + &alarm("greeting with $server"); +} +alarm(0); + +&alarm("sending ehlo to $server"); +&ps("ehlo $hostname"); +my $etrn_support = 0; +while () { + if (/^250([- ])ETRN(.+)$/) { + $etrn_support = 1; + } + print if $verbose; + last if /^\d+ /; +} +alarm(0); + +if ($etrn_support) { + print "ETRN supported\n" if ($verbose); + &alarm("sending etrn to $server"); + while (@hosts) { + $server = shift(@hosts); + &ps("etrn $server"); + while () { + print if $verbose; + last if /^\d+ /; + } + sleep(1); + } +} else { + print "\nETRN not supported\n\n" +} + +&alarm("sending 'quit' to $server"); +&ps("quit"); +while () { + print if $verbose; + last if /^\d+ /; +} +close(S); +alarm(0); + +select(STDOUT); +exit(0); + +# print to the server (also to stdout, if -v) +sub ps +{ + my ($p) = @_; + print ">>> $p\n" if $verbose; + print S "$p\n"; +} + +sub alarm +{ + ($alarm_action) = @_; + alarm(10); + $SIG{ALRM} = 'handle_alarm'; +} + +sub handle_alarm +{ + &giveup($alarm_action); +} + +sub giveup +{ + my $reason = @_; + (my $pk, my $file, my $line); + ($pk, $file, $line) = caller; + + print "Timed out during $reason\n" if $verbose; + exit(1); +} + +# read the rest of the current smtp daemon's response (and toss it away) +sub read_response +{ + (my $done, $verbose) = @_; + (my @resp); + print my $s if $verbose; + while (($done eq "-") && ($s = ) && ($s =~ /^\d+([- ])/)) { + print $s if $verbose; + $done = $1; + push(@resp, $s); + } + return @resp; +} diff --git a/contrib/expn.pl b/contrib/expn.pl new file mode 100755 index 000000000000..85de08a7f419 --- /dev/null +++ b/contrib/expn.pl @@ -0,0 +1,1360 @@ +#!/usr/bin/perl +'di '; +'ds 00 \\"'; +'ig 00 '; +# +# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. +# + +use 5.001; +use IO::Socket; +use Fcntl; + +# system requirements: +# must have 'nslookup' and 'hostname' programs. + +# $OrigHeader: /home/muir/bin/RCS/expn,v 3.11 1997/09/10 08:14:02 muir Exp muir $ + +# TODO: +# less magic should apply to command-line addresses +# less magic should apply to local addresses +# add magic to deal with cross-domain cnames +# disconnect & reconnect after 25 commands to the same sendmail 8.8.* host + +# Checklist: (hard addresses) +# 250 Kimmo Suominen <"|/usr/local/mh/lib/slocal -user kim"@grendel.tac.nyc.ny.us> +# harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) [dead] +# bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) [dead] +# dan@tc.cornell.edu -> brown@tiberius (.tc.cornell.edu) + +############################################################################# +# +# Copyright (c) 1993 David Muir Sharnoff +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# 3. All advertising materials mentioning features or use of this software +# must display the following acknowledgement: +# This product includes software developed by the David Muir Sharnoff. +# 4. The name of David Sharnoff may not be used to endorse or promote products +# derived from this software without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE DAVID MUIR SHARNOFF ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL DAVID MUIR SHARNOFF BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# This copyright notice derrived from material copyrighted by the Regents +# of the University of California. +# +# Contributions accepted. +# +############################################################################# + +# overall structure: +# in an effort to not trace each address individually, but rather +# ask each server in turn a whole bunch of questions, addresses to +# be expanded are queued up. +# +# This means that all accounting w.r.t. an address must be stored in +# various arrays. Generally these arrays are indexed by the +# string "$addr *** $server" where $addr is the address to be +# expanded "foo" or maybe "foo@bar" and $server is the hostname +# of the SMTP server to contact. +# + +# important global variables: +# +# @hosts : list of servers still to be contacted +# $server : name of the current we are currently looking at +# @users = $users{@hosts[0]} : addresses to expand at this server +# $u = $users[0] : the current address being expanded +# $names{"$users[0] *** $server"} : the 'name' associated with the address +# $mxbacktrace{"$users[0] *** $server"} : record of mx expansion +# $mx_secondary{$server} : other mx relays at the same priority +# $domainify_fallback{"$users[0] *** $server"} : alternative names to try +# instead of $server if $server doesn't work +# $temporary_redirect{"$users[0] *** $server"} : when trying alternates, +# temporarily channel all tries along current path +# $giveup{$server} : do not bother expanding addresses at $server +# $verbose : -v +# $watch : -w +# $vw : -v or -w +# $debug : -d +# $valid : -a +# $levels : -1 +# $S : the socket connection to $server + +$have_nslookup = 1; # we have the nslookup program +$port = 'smtp'; +$av0 = $0; +$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,; +$ENV{'PATH'} .= ":/usr/ucb" unless $ENV{'PATH'} =~ m,/usr/ucb,; +select(STDERR); + +$0 = "$av0 - running hostname"; +chop($name = `hostname || uname -n`); + +$0 = "$av0 - lookup host FQDN and IP addr"; +($hostname,$aliases,$type,$len,$thisaddr) = gethostbyname($name); + +$0 = "$av0 - parsing args"; +$usage = "Usage: $av0 [-1avwd] user[\@host] [user2[host2] ...]"; +for $a (@ARGV) { + die $usage if $a eq "-"; + while ($a =~ s/^(-.*)([1avwd])/$1/) { + eval '$'."flag_$2 += 1"; + } + next if $a eq "-"; + die $usage if $a =~ /^-/; + &expn(&parse($a,$hostname,undef,1)); +} +$verbose = $flag_v; +$watch = $flag_w; +$vw = $flag_v + $flag_w; +$debug = $flag_d; +$valid = $flag_a; +$levels = $flag_1; + +die $usage unless @hosts; +if ($valid) { + if ($valid == 1) { + $validRequirement = 0.8; + } elsif ($valid == 2) { + $validRequirement = 1.0; + } elsif ($valid == 3) { + $validRequirement = 0.9; + } else { + $validRequirement = (1 - (1/($valid-3))); + print "validRequirement = $validRequirement\n" if $debug; + } +} + +HOST: +while (@hosts) { + $server = shift(@hosts); + @users = split(' ',$users{$server}); + delete $users{$server}; + + # is this server already known to be bad? + $0 = "$av0 - looking up $server"; + if ($giveup{$server}) { + &giveup('mx domainify',$giveup{$server}); + next; + } + + # do we already have an mx record for this host? + next HOST if &mxredirect($server,*users); + + # look it up, or try for an mx. + $0 = "$av0 - gethostbyname($server)"; + + ($name,$aliases,$type,$len,$thataddr) = gethostbyname($server); + # if we can't get an A record, try for an MX record. + unless($thataddr) { + &mxlookup(1,$server,"$server: could not resolve name",*users); + next HOST; + } + + # get a connection, or look for an mx + $0 = "$av0 - socket to $server"; + + $S = new IO::Socket::INET ( + 'PeerAddr' => $server, + 'PeerPort' => $port, + 'Proto' => 'tcp'); + + if (! $S || ($debug == 10 && $server =~ /relay\d.UU.NET$/i)) { + $0 = "$av0 - $server: could not connect: $!\n"; + $emsg = $!; + unless (&mxlookup(0,$server,"$server: could not connect: $!",*users)) { + &giveup('mx',"$server: Could not connect: $emsg"); + } + next HOST; + } + $S->autoflush(1); + + # read the greeting + $0 = "$av0 - talking to $server"; + &alarm("greeting with $server",''); + while(<$S>) { + alarm(0); + print if $watch; + if (/^(\d+)([- ])/) { + if ($1 != 220) { + $0 = "$av0 - bad numeric response from $server"; + &alarm("giving up after bad response from $server",''); + &read_response($2,$watch); + alarm(0); + print STDERR "$server: NOT 220 greeting: $_" + if ($debug || $vw); + if (&mxlookup(0,$server,"$server: did not respond with a 220 greeting",*users)) { + close($S); + next HOST; + } + } + last if ($2 eq " "); + } else { + $0 = "$av0 - bad response from $server"; + print STDERR "$server: NOT 220 greeting: $_" + if ($debug || $vw); + unless (&mxlookup(0,$server,"$server: did not respond with SMTP codes",*users)) { + &giveup('',"$server: did not talk SMTP"); + } + close($S); + next HOST; + } + &alarm("greeting with $server",''); + } + alarm(0); + + # if this causes problems, remove it + $0 = "$av0 - sending helo to $server"; + &alarm("sending helo to $server",""); + &ps("helo $hostname"); + while(<$S>) { + print if $watch; + last if /^\d+ /; + } + alarm(0); + + # try the users, one by one + USER: + while(@users) { + $u = shift(@users); + $0 = "$av0 - expanding $u [\@$server]"; + + # do we already have a name for this user? + $oldname = $names{"$u *** $server"}; + + print &compact($u,$server)." ->\n" if ($verbose && ! $valid); + if ($valid) { + # + # when running with -a, we delay taking any action + # on the results of our query until we have looked + # at the complete output. @toFinal stores expansions + # that will be final if we take them. @toExpn stores + # expnansions that are not final. @isValid keeps + # track of our ability to send mail to each of the + # expansions. + # + @isValid = (); + @toFinal = (); + @toExpn = (); + } + +# ($ecode,@expansion) = &expn_vrfy($u,$server); + (@foo) = &expn_vrfy($u,$server); + ($ecode,@expansion) = @foo; + if ($ecode) { + &giveup('',$ecode,$u); + last USER; + } + + for $s (@expansion) { + $s =~ s/[\n\r]//g; + $0 = "$av0 - parsing $server: $s"; + + $skipwatch = $watch; + + if ($s =~ /^[25]51([- ]).*<(.+)>/) { + print "$s" if $watch; + print "(pretending 250$1<$2>)" if ($debug && $watch); + print "\n" if $watch; + $s = "250$1<$2>"; + $skipwatch = 0; + } + + if ($s =~ /^250([- ])(.+)/) { + print "$s\n" if $skipwatch; + ($done,$addr) = ($1,$2); + ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname, $#expansion == 0); + print "($newhost, $newaddr, $newname) = &parse($addr, $server, $oldname)\n" if $debug; + if (! $newhost) { + # no expansion is possible w/o a new server to call + if ($valid) { + push(@isValid, &validAddr($newaddr)); + push(@toFinal,$newaddr,$server,$newname); + } else { + &verbose(&final($newaddr,$server,$newname)); + } + } else { + $newmxhost = &mx($newhost,$newaddr); + print "$newmxhost = &mx($newhost)\n" + if ($debug && $newhost ne $newmxhost); + $0 = "$av0 - parsing $newaddr [@$newmxhost]"; + print "levels = $levels, level{$u *** $server} = ".$level{"$u *** $server"}."\n" if ($debug > 1); + # If the new server is the current one, + # it would have expanded things for us + # if it could have. Mx records must be + # followed to compare server names. + # We are also done if the recursion + # count has been exceeded. + if (&trhost($newmxhost) eq &trhost($server) || ($levels && $level{"$u *** $server"} >= $levels)) { + if ($valid) { + push(@isValid, &validAddr($newaddr)); + push(@toFinal,$newaddr,$newmxhost,$newname); + } else { + &verbose(&final($newaddr,$newmxhost,$newname)); + } + } else { + # more work to do... + if ($valid) { + push(@isValid, &validAddr($newaddr)); + push(@toExpn,$newmxhost,$newaddr,$newname,$level{"$u *** $server"}); + } else { + &verbose(&expn($newmxhost,$newaddr,$newname,$level{"$u *** $server"})); + } + } + } + last if ($done eq " "); + next; + } + # 550 is a known code... Should the be + # included in -a output? Might be a bug + # here. Does it matter? Can assume that + # there won't be UNKNOWN USER responses + # mixed with valid users? + if ($s =~ /^(550)([- ])/) { + if ($valid) { + print STDERR "\@$server:$u ($oldname) USER UNKNOWN\n"; + } else { + &verbose(&final($u,$server,$oldname,"USER UNKNOWN")); + } + last if ($2 eq " "); + next; + } + # 553 is a known code... + if ($s =~ /^(553)([- ])/) { + if ($valid) { + print STDERR "\@$server:$u ($oldname) USER AMBIGUOUS\n"; + } else { + &verbose(&final($u,$server,$oldname,"USER AMBIGUOUS")); + } + last if ($2 eq " "); + next; + } + # 252 is a known code... + if ($s =~ /^(252)([- ])/) { + if ($valid) { + print STDERR "\@$server:$u ($oldname) REFUSED TO VRFY\n"; + } else { + &verbose(&final($u,$server,$oldname,"REFUSED TO VRFY")); + } + last if ($2 eq " "); + next; + } + &giveup('',"$server: did not grok '$s'",$u); + last USER; + } + + if ($valid) { + # + # now we decide if we are going to take these + # expansions or roll them back. + # + $avgValid = &average(@isValid); + print "avgValid = $avgValid\n" if $debug; + if ($avgValid >= $validRequirement) { + print &compact($u,$server)." ->\n" if $verbose; + while (@toExpn) { + &verbose(&expn(splice(@toExpn,0,4))); + } + while (@toFinal) { + &verbose(&final(splice(@toFinal,0,3))); + } + } else { + print "Tossing some valid to avoid invalid ".&compact($u,$server)."\n" if ($avgValid > 0.0 && ($vw || $debug)); + print &compact($u,$server)." ->\n" if $verbose; + &verbose(&final($u,$server,$newname)); + } + } + } + + &alarm("sending 'quit' to $server",''); + $0 = "$av0 - sending 'quit' to $server"; + &ps("quit"); + while(<$S>) { + print if $watch; + last if /^\d+ /; + } + close($S); + alarm(0); +} + +$0 = "$av0 - printing final results"; +print "----------\n" if $vw; +select(STDOUT); +for $f (sort @final) { + print "$f\n"; +} +unlink("/tmp/expn$$"); +exit(0); + + +# abandon all attempts deliver to $server +# register the current addresses as the final ones +sub giveup +{ + local($redirect_okay,$reason,$user) = @_; + local($us,@so,$nh,@remaining_users); + local($pk,$file,$line); + ($pk, $file, $line) = caller; + + $0 = "$av0 - giving up on $server: $reason"; + # + # add back a user if we gave up in the middle + # + push(@users,$user) if $user; + # + # don't bother with this system anymore + # + unless ($giveup{$server}) { + $giveup{$server} = $reason; + print STDERR "$reason\n"; + } + print "Giveup at $file:$line!!! redirect okay = $redirect_okay; $reason\n" if $debug; + # + # Wait! + # Before giving up, see if there is a chance that + # there is another host to redirect to! + # (Kids, don't do this at home! Hacking is a dangerous + # crime and you could end up behind bars.) + # + for $u (@users) { + if ($redirect_okay =~ /\bmx\b/) { + next if &try_fallback('mx',$u,*server, + *mx_secondary, + *already_mx_fellback); + } + if ($redirect_okay =~ /\bdomainify\b/) { + next if &try_fallback('domainify',$u,*server, + *domainify_fallback, + *already_domainify_fellback); + } + push(@remaining_users,$u); + } + @users = @remaining_users; + for $u (@users) { + print &compact($u,$server)." ->\n" if ($verbose && $valid && $u); + &verbose(&final($u,$server,$names{"$u *** $server"},$reason)); + } +} +# +# This routine is used only within &giveup. It checks to +# see if we really have to giveup or if there is a second +# chance because we did something before that can be +# backtracked. +# +# %fallback{"$user *** $host"} tracks what is able to fallback +# %fellback{"$user *** $host"} tracks what has fallen back +# +# If there is a valid backtrack, then queue up the new possibility +# +sub try_fallback +{ + local($method,$user,*host,*fall_table,*fellback) = @_; + local($us,$fallhost,$oldhost,$ft,$i); + + if ($debug > 8) { + print "Fallback table $method:\n"; + for $i (sort keys %fall_table) { + print "\t'$i'\t\t'$fall_table{$i}'\n"; + } + print "Fellback table $method:\n"; + for $i (sort keys %fellback) { + print "\t'$i'\t\t'$fellback{$i}'\n"; + } + print "U: $user H: $host\n"; + } + + $us = "$user *** $host"; + if (defined $fellback{$us}) { + # + # Undo a previous fallback so that we can try again + # Nested fallbacks are avoided because they could + # lead to infinite loops + # + $fallhost = $fellback{$us}; + print "Already $method fell back from $us -> \n" if $debug; + $us = "$user *** $fallhost"; + $oldhost = $fallhost; + } elsif (($method eq 'mx') && (defined $mxbacktrace{$us}) && (defined $mx_secondary{$mxbacktrace{$us}})) { + print "Fallback an MX expansion $us -> \n" if $debug; + $oldhost = $mxbacktrace{$us}; + } else { + print "Oldhost($host, $us) = " if $debug; + $oldhost = $host; + } + print "$oldhost\n" if $debug; + if (((defined $fall_table{$us}) && ($ft = $us)) || ((defined $fall_table{$oldhost}) && ($ft = $oldhost))) { + print "$method Fallback = ".$fall_table{$ft}."\n" if $debug; + local(@so,$newhost); + @so = split(' ',$fall_table{$ft}); + $newhost = shift(@so); + print "Falling back ($method) $us -> $newhost (from $oldhost)\n" if $debug; + if ($method eq 'mx') { + if (! defined ($mxbacktrace{"$user *** $newhost"})) { + if (defined $mxbacktrace{"$user *** $oldhost"}) { + print "resetting oldhost $oldhost to the original: " if $debug; + $oldhost = $mxbacktrace{"$user *** $oldhost"}; + print "$oldhost\n" if $debug; + } + $mxbacktrace{"$user *** $newhost"} = $oldhost; + print "mxbacktrace $user *** $newhost -> $oldhost\n" if $debug; + } + $mx{&trhost($oldhost)} = $newhost; + } else { + $temporary_redirect{$us} = $newhost; + } + if (@so) { + print "Can still $method $us: @so\n" if $debug; + $fall_table{$ft} = join(' ',@so); + } else { + print "No more fallbacks for $us\n" if $debug; + delete $fall_table{$ft}; + } + if (defined $create_host_backtrack{$us}) { + $create_host_backtrack{"$user *** $newhost"} + = $create_host_backtrack{$us}; + } + $fellback{"$user *** $newhost"} = $oldhost; + &expn($newhost,$user,$names{$us},$level{$us}); + return 1; + } + delete $temporary_redirect{$us}; + $host = $oldhost; + return 0; +} +# return 1 if you could send mail to the address as is. +sub validAddr +{ + local($addr) = @_; + $res = &do_validAddr($addr); + print "validAddr($addr) = $res\n" if $debug; + $res; +} +sub do_validAddr +{ + local($addr) = @_; + local($urx) = "[-A-Za-z_.0-9+]+"; + + # \u + return 0 if ($addr =~ /^\\/); + # ?@h + return 1 if ($addr =~ /.\@$urx$/); + # @h:? + return 1 if ($addr =~ /^\@$urx\:./); + # h!u + return 1 if ($addr =~ /^$urx!./); + # u + return 1 if ($addr =~ /^$urx$/); + # ? + print "validAddr($addr) = ???\n" if $debug; + return 0; +} +# Some systems use expn and vrfy interchangeably. Some only +# implement one or the other. Some check expn against mailing +# lists and vrfy against users. It doesn't appear to be +# consistent. +# +# So, what do we do? We try everything! +# +# +# Ranking of result codes: good: 250, 251/551, 252, 550, anything else +# +# Ranking of inputs: best: user@host.domain, okay: user +# +# Return value: $error_string, @responses_from_server +sub expn_vrfy +{ + local($u,$server) = @_; + local(@c) = ('expn', 'vrfy'); + local(@try_u) = $u; + local(@ret,$code); + + if (($u =~ /(.+)@(.+)/) && (&trhost($2) eq &trhost($server))) { + push(@try_u,$1); + } + + TRY: + for $c (@c) { + for $try_u (@try_u) { + &alarm("${c}'ing $try_u on $server",'',$u); + &ps("$c $try_u"); + alarm(0); + $s = <$S>; + if ($s eq '') { + return "$server: lost connection"; + } + if ($s !~ /^(\d+)([- ])/) { + return "$server: garbled reply to '$c $try_u'"; + } + if ($1 == 250) { + $code = 250; + @ret = ("",$s); + push(@ret,&read_response($2,$debug)); + return (@ret); + } + if ($1 == 551 || $1 == 251) { + $code = $1; + @ret = ("",$s); + push(@ret,&read_response($2,$debug)); + next; + } + if ($1 == 252 && ($code == 0 || $code == 550)) { + $code = 252; + @ret = ("",$s); + push(@ret,&read_response($2,$watch)); + next; + } + if ($1 == 550 && $code == 0) { + $code = 550; + @ret = ("",$s); + push(@ret,&read_response($2,$watch)); + next; + } + &read_response($2,$watch); + } + } + return "$server: expn/vrfy not implemented" unless @ret; + return @ret; +} +# sometimes the old parse routine (now parse2) didn't +# reject funky addresses. +sub parse +{ + local($oldaddr,$server,$oldname,$one_to_one) = @_; + local($newhost, $newaddr, $newname, $um) = &parse2($oldaddr,$server,$oldname,$one_to_one); + if ($newaddr =~ m,^["/],) { + return (undef, $oldaddr, $newname) if $valid; + return (undef, $um, $newname); + } + return ($newhost, $newaddr, $newname); +} + +# returns ($new_smtp_server,$new_address,$new_name) +# given a response from a SMTP server ($newaddr), the +# current host ($server), the old "name" and a flag that +# indicates if it is being called during the initial +# command line parsing ($parsing_args) +sub parse2 +{ + local($newaddr,$context_host,$old_name,$parsing_args) = @_; + local(@names) = $old_name; + local($urx) = "[-A-Za-z_.0-9+]+"; + local($unmangle); + + # + # first, separate out the address part. + # + + # + # [NAME] + # [NAME] <[(NAME)] ADDR + # ADDR [(NAME)] + # (NAME) ADDR + # [(NAME)] + # + if ($newaddr =~ /^\<(.*)\>$/) { + print "\n" if $debug; + ($newaddr) = &trim($1); + print "na = $newaddr\n" if $debug; + } + if ($newaddr =~ /^([^\<\>]*)\<([^\<\>]*)\>([^\<\>]*)$/) { + # address has a < > pair in it. + print "N:$1 N:$3\n" if $debug; + ($newaddr) = &trim($2); + unshift(@names, &trim($3,$1)); + print "na = $newaddr\n" if $debug; + } + if ($newaddr =~ /^([^\(\)]*)\(([^\(\)]*)\)([^\(\)]*)$/) { + # address has a ( ) pair in it. + print "A:$1 (N:$2) A:$3\n" if $debug; + unshift(@names,&trim($2)); + local($f,$l) = (&trim($1),&trim($3)); + if (($f && $l) || !($f || $l)) { + # address looks like: + # foo (bar) baz or (bar) + # not allowed! + print STDERR "Could not parse $newaddr\n" if $vw; + return(undef,$newaddr,&firstname(@names)); + } + $newaddr = $f if $f; + $newaddr = $l if $l; + print "newaddr now = $newaddr\n" if $debug; + } + # + # @foo:bar + # j%k@l + # a@b + # b!a + # a + # + $unmangle = $newaddr; + if ($newaddr =~ /^\@($urx)\:(.+)$/) { + print "(\@:)" if $debug; + # this is a bit of a cheat, but it seems necessary + return (&domainify($1,$context_host,$2),$2,&firstname(@names),$unmangle); + } + if ($newaddr =~ /^(.+)\@($urx)$/) { + print "(\@)" if $debug; + return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); + } + if ($parsing_args) { + if ($newaddr =~ /^($urx)\!(.+)$/) { + return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names),$unmangle); + } + if ($newaddr =~ /^($urx)$/) { + return ($context_host,$newaddr,&firstname(@names),$unmangle); + } + print STDERR "Could not parse $newaddr\n"; + } + print "(?)" if $debug; + return(undef,$newaddr,&firstname(@names),$unmangle); +} +# return $u (@$server) unless $u includes reference to $server +sub compact +{ + local($u, $server) = @_; + local($se) = $server; + local($sp); + $se =~ s/(\W)/\\$1/g; + $sp = " (\@$server)"; + if ($u !~ /$se/i) { + return "$u$sp"; + } + return $u; +} +# remove empty (spaces don't count) members from an array +sub trim +{ + local(@v) = @_; + local($v,@r); + for $v (@v) { + $v =~ s/^\s+//; + $v =~ s/\s+$//; + push(@r,$v) if ($v =~ /\S/); + } + return(@r); +} +# using the host part of an address, and the server name, add the +# servers' domain to the address if it doesn't already have a +# domain. Since this sometimes fails, save a back reference so +# it can be unrolled. +sub domainify +{ + local($host,$domain_host,$u) = @_; + local($domain,$newhost); + + # cut of trailing dots + $host =~ s/\.$//; + $domain_host =~ s/\.$//; + + if ($domain_host !~ /\./) { + # + # domain host isn't, keep $host whatever it is + # + print "domainify($host,$domain_host) = $host\n" if $debug; + return $host; + } + + # + # There are several weird situtations that need to be + # accounted for. They have to do with domain relay hosts. + # + # Examples: + # host server "right answer" + # + # shiva.cs cs.berkeley.edu shiva.cs.berkeley.edu + # shiva cs.berkeley.edu shiva.cs.berekley.edu + # cumulus reed.edu @reed.edu:cumulus.uucp + # tiberius tc.cornell.edu tiberius.tc.cornell.edu + # + # The first try must always be to cut the domain part out of + # the server and tack it onto the host. + # + # A reasonable second try is to tack the whole server part onto + # the host and for each possible repeated element, eliminate + # just that part. + # + # These extra "guesses" get put into the %domainify_fallback + # array. They will be used to give addresses a second chance + # in the &giveup routine + # + + local(%fallback); + + local($long); + $long = "$host $domain_host"; + $long =~ tr/A-Z/a-z/; + print "long = $long\n" if $debug; + if ($long =~ s/^([^ ]+\.)([^ ]+) \2(\.[^ ]+\.[^ ]+)/$1$2$3/) { + # matches shiva.cs cs.berkeley.edu and returns shiva.cs.berkeley.edu + print "condensed fallback $host $domain_host -> $long\n" if $debug; + $fallback{$long} = 9; + } + + local($fh); + $fh = $domain_host; + while ($fh =~ /\./) { + print "FALLBACK $host.$fh = 1\n" if $debug > 7; + $fallback{"$host.$fh"} = 1; + $fh =~ s/^[^\.]+\.//; + } + + $fallback{"$host.$domain_host"} = 2; + + ($domain = $domain_host) =~ s/^[^\.]+//; + $fallback{"$host$domain"} = 6 + if ($domain =~ /\./); + + if ($host =~ /\./) { + # + # Host is already okay, but let's look for multiple + # interpretations + # + print "domainify($host,$domain_host) = $host\n" if $debug; + delete $fallback{$host}; + $domainify_fallback{"$u *** $host"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; + return $host; + } + + $domain = ".$domain_host" + if ($domain !~ /\..*\./); + $newhost = "$host$domain"; + + $create_host_backtrack{"$u *** $newhost"} = $domain_host; + print "domainify($host,$domain_host) = $newhost\n" if $debug; + delete $fallback{$newhost}; + $domainify_fallback{"$u *** $newhost"} = join(' ',sort {$fallback{$b} <=> $fallback{$a};} keys %fallback) if %fallback; + if ($debug) { + print "fallback = "; + print $domainify_fallback{"$u *** $newhost"} + if defined($domainify_fallback{"$u *** $newhost"}); + print "\n"; + } + return $newhost; +} +# return the first non-empty element of an array +sub firstname +{ + local(@names) = @_; + local($n); + while(@names) { + $n = shift(@names); + return $n if $n =~ /\S/; + } + return undef; +} +# queue up more addresses to expand +sub expn +{ + local($host,$addr,$name,$level) = @_; + if ($host) { + $host = &trhost($host); + + if (($debug > 3) || (defined $giveup{$host})) { + unshift(@hosts,$host) unless $users{$host}; + } else { + push(@hosts,$host) unless $users{$host}; + } + $users{$host} .= " $addr"; + $names{"$addr *** $host"} = $name; + $level{"$addr *** $host"} = $level + 1; + print "expn($host,$addr,$name)\n" if $debug; + return "\t$addr\n"; + } else { + return &final($addr,'NONE',$name); + } +} +# compute the numerical average value of an array +sub average +{ + local(@e) = @_; + return 0 unless @e; + local($e,$sum); + for $e (@e) { + $sum += $e; + } + $sum / @e; +} +# print to the server (also to stdout, if -w) +sub ps +{ + local($p) = @_; + print ">>> $p\n" if $watch; + print $S "$p\n"; +} +# return case-adjusted name for a host (for comparison purposes) +sub trhost +{ + # treat foo.bar as an alias for Foo.BAR + local($host) = @_; + local($trhost) = $host; + $trhost =~ tr/A-Z/a-z/; + if ($trhost{$trhost}) { + $host = $trhost{$trhost}; + } else { + $trhost{$trhost} = $host; + } + $trhost{$trhost}; +} +# re-queue users if an mx record dictates a redirect +# don't allow a user to be redirected more than once +sub mxredirect +{ + local($server,*users) = @_; + local($u,$nserver,@still_there); + + $nserver = &mx($server); + + if (&trhost($nserver) ne &trhost($server)) { + $0 = "$av0 - mx redirect $server -> $nserver\n"; + for $u (@users) { + if (defined $mxbacktrace{"$u *** $nserver"}) { + push(@still_there,$u); + } else { + $mxbacktrace{"$u *** $nserver"} = $server; + print "mxbacktrace{$u *** $nserver} = $server\n" + if ($debug > 1); + &expn($nserver,$u,$names{"$u *** $server"}); + } + } + @users = @still_there; + if (! @users) { + return $nserver; + } else { + return undef; + } + } + return undef; +} +# follow mx records, return a hostname +# also follow temporary redirections comming from &domainify and +# &mxlookup +sub mx +{ + local($h,$u) = @_; + + for (;;) { + if (defined $mx{&trhost($h)} && $h ne $mx{&trhost($h)}) { + $0 = "$av0 - mx expand $h"; + $h = $mx{&trhost($h)}; + return $h; + } + if ($u) { + if (defined $temporary_redirect{"$u *** $h"}) { + $0 = "$av0 - internal redirect $h"; + print "Temporary redirect taken $u *** $h -> " if $debug; + $h = $temporary_redirect{"$u *** $h"}; + print "$h\n" if $debug; + next; + } + $htr = &trhost($h); + if (defined $temporary_redirect{"$u *** $htr"}) { + $0 = "$av0 - internal redirect $h"; + print "temporary redirect taken $u *** $h -> " if $debug; + $h = $temporary_redirect{"$u *** $htr"}; + print "$h\n" if $debug; + next; + } + } + return $h; + } +} +# look up mx records with the name server. +# re-queue expansion requests if possible +# optionally give up on this host. +sub mxlookup +{ + local($lastchance,$server,$giveup,*users) = @_; + local(*T); + local(*NSLOOKUP); + local($nh, $pref,$cpref); + local($o0) = $0; + local($nserver); + local($name,$aliases,$type,$len,$thataddr); + local(%fallback); + + return 1 if &mxredirect($server,*users); + + if ((defined $mx{$server}) || (! $have_nslookup)) { + return 0 unless $lastchance; + &giveup('mx domainify',$giveup); + return 0; + } + + $0 = "$av0 - nslookup of $server"; + sysopen(T,"/tmp/expn$$",O_RDWR|O_CREAT|O_EXCL,0600) || die "open > /tmp/expn$$: $!\n"; + print T "set querytype=MX\n"; + print T "$server\n"; + close(T); + $cpref = 1.0E12; + undef $nserver; + open(NSLOOKUP,"nslookup < /tmp/expn$$ 2>&1 |") || die "open nslookup: $!"; + while() { + print if ($debug > 2); + if (/mail exchanger = ([-A-Za-z_.0-9+]+)/) { + $nh = $1; + if (/preference = (\d+)/) { + $pref = $1; + if ($pref < $cpref) { + $nserver = $nh; + $cpref = $pref; + } elsif ($pref) { + $fallback{$pref} .= " $nh"; + } + } + } + if (/Non-existent domain/) { + # + # These addresss are hosed. Kaput! Dead! + # However, if we created the address in the + # first place then there is a chance of + # salvation. + # + 1 while(); + close(NSLOOKUP); + return 0 unless $lastchance; + &giveup('domainify',"$server: Non-existent domain",undef,1); + return 0; + } + + } + close(NSLOOKUP); + unlink("/tmp/expn$$"); + unless ($nserver) { + $0 = "$o0 - finished mxlookup"; + return 0 unless $lastchance; + &giveup('mx domainify',"$server: Could not resolve address"); + return 0; + } + + # provide fallbacks in case $nserver doesn't work out + if (defined $fallback{$cpref}) { + $mx_secondary{$server} = $fallback{$cpref}; + } + + $0 = "$av0 - gethostbyname($nserver)"; + ($name,$aliases,$type,$len,$thataddr) = gethostbyname($nserver); + + unless ($thataddr) { + $0 = $o0; + return 0 unless $lastchance; + &giveup('mx domainify',"$nserver: could not resolve address"); + return 0; + } + print "MX($server) = $nserver\n" if $debug; + print "$server -> $nserver\n" if $vw && !$debug; + $mx{&trhost($server)} = $nserver; + # redeploy the users + unless (&mxredirect($server,*users)) { + return 0 unless $lastchance; + &giveup('mx domainify',"$nserver: only one level of mx redirect allowed"); + return 0; + } + $0 = "$o0 - finished mxlookup"; + return 1; +} +# if mx expansion did not help to resolve an address +# (ie: foo@bar became @baz:foo@bar, then undo the +# expansion). +# this is only used by &final +sub mxunroll +{ + local(*host,*addr) = @_; + local($r) = 0; + print "looking for mxbacktrace{$addr *** $host}\n" + if ($debug > 1); + while (defined $mxbacktrace{"$addr *** $host"}) { + print "Unrolling MX expnasion: \@$host:$addr -> " + if ($debug || $verbose); + $host = $mxbacktrace{"$addr *** $host"}; + print "\@$host:$addr\n" + if ($debug || $verbose); + $r = 1; + } + return 1 if $r; + $addr = "\@$host:$addr" + if ($host =~ /\./); + return 0; +} +# register a completed expnasion. Make the final address as +# simple as possible. +sub final +{ + local($addr,$host,$name,$error) = @_; + local($he); + local($hb,$hr); + local($au,$ah); + + if ($error =~ /Non-existent domain/) { + # + # If we created the domain, then let's undo the + # damage... + # + if (defined $create_host_backtrack{"$addr *** $host"}) { + while (defined $create_host_backtrack{"$addr *** $host"}) { + print "Un&domainifying($host) = " if $debug; + $host = $create_host_backtrack{"$addr *** $host"}; + print "$host\n" if $debug; + } + $error = "$host: could not locate"; + } else { + # + # If we only want valid addresses, toss out + # bad host names. + # + if ($valid) { + print STDERR "\@$host:$addr ($name) Non-existent domain\n"; + return ""; + } + } + } + + MXUNWIND: { + $0 = "$av0 - final parsing of \@$host:$addr"; + ($he = $host) =~ s/(\W)/\\$1/g; + if ($addr !~ /@/) { + # addr does not contain any host + $addr = "$addr@$host"; + } elsif ($addr !~ /$he/i) { + # if host part really something else, use the something + # else. + if ($addr =~ m/(.*)\@([^\@]+)$/) { + ($au,$ah) = ($1,$2); + print "au = $au ah = $ah\n" if $debug; + if (defined $temporary_redirect{"$addr *** $ah"}) { + $addr = "$au\@".$temporary_redirect{"$addr *** $ah"}; + print "Rewrite! to $addr\n" if $debug; + next MXUNWIND; + } + } + # addr does not contain full host + if ($valid) { + if ($host =~ /^([^\.]+)(\..+)$/) { + # host part has a . in it - foo.bar + ($hb, $hr) = ($1, $2); + if ($addr =~ /\@([^\.\@]+)$/ && ($1 eq $hb)) { + # addr part has not . + # and matches beginning of + # host part -- tack on a + # domain name. + $addr .= $hr; + } else { + &mxunroll(*host,*addr) + && redo MXUNWIND; + } + } else { + &mxunroll(*host,*addr) + && redo MXUNWIND; + } + } else { + $addr = "${addr}[\@$host]" + if ($host =~ /\./); + } + } + } + $name = "$name " if $name; + $error = " $error" if $error; + if ($valid) { + push(@final,"$name<$addr>"); + } else { + push(@final,"$name<$addr>$error"); + } + "\t$name<$addr>$error\n"; +} + +sub alarm +{ + local($alarm_action,$alarm_redirect,$alarm_user) = @_; + alarm(3600); + $SIG{ALRM} = 'handle_alarm'; +} +# this involves one great big ugly hack. +# the "next HOST" unwinds the stack! +sub handle_alarm +{ + &giveup($alarm_redirect,"Timed out during $alarm_action",$alarm_user); + next HOST; +} + +# read the rest of the current smtp daemon's response (and toss it away) +sub read_response +{ + local($done,$watch) = @_; + local(@resp); + print $s if $watch; + while(($done eq "-") && ($s = <$S>) && ($s =~ /^\d+([- ])/)) { + print $s if $watch; + $done = $1; + push(@resp,$s); + } + return @resp; +} +# print args if verbose. Return them in any case +sub verbose +{ + local(@tp) = @_; + print "@tp" if $verbose; +} +# to pass perl -w: +@tp; +$flag_a; +$flag_d; +$flag_1; +%already_domainify_fellback; +%already_mx_fellback; +&handle_alarm; +################### BEGIN PERL/TROFF TRANSITION +.00 ; + +'di +.nr nl 0-1 +.nr % 0 +.\\"'; __END__ +.\" ############## END PERL/TROFF TRANSITION +.TH EXPN 1 "March 11, 1993" +.AT 3 +.SH NAME +expn \- recursively expand mail aliases +.SH SYNOPSIS +.B expn +.RI [ -a ] +.RI [ -v ] +.RI [ -w ] +.RI [ -d ] +.RI [ -1 ] +.IR user [@ hostname ] +.RI [ user [@ hostname ]]... +.SH DESCRIPTION +.B expn +will use the SMTP +.B expn +and +.B vrfy +commands to expand mail aliases. +It will first look up the addresses you provide on the command line. +If those expand into addresses on other systems, it will +connect to the other systems and expand again. It will keep +doing this until no further expansion is possible. +.SH OPTIONS +The default output of +.B expn +can contain many lines which are not valid +email addresses. With the +.I -aa +flag, only expansions that result in legal addresses +are used. Since many mailing lists have an illegal +address or two, the single +.IR -a , +address, flag specifies that a few illegal addresses can +be mixed into the results. More +.I -a +flags vary the ratio. Read the source to track down +the formula. With the +.I -a +option, you should be able to construct a new mailing +list out of an existing one. +.LP +If you wish to limit the number of levels deep that +.B expn +will recurse as it traces addresses, use the +.I -1 +option. For each +.I -1 +another level will be traversed. So, +.I -111 +will traverse no more than three levels deep. +.LP +The normal mode of operation for +.B expn +is to do all of its work silently. +The following options make it more verbose. +It is not necessary to make it verbose to see what it is +doing because as it works, it changes its +.BR argv [0] +variable to reflect its current activity. +To see how it is expanding things, the +.IR -v , +verbose, flag will cause +.B expn +to show each address before +and after translation as it works. +The +.IR -w , +watch, flag will cause +.B expn +to show you its conversations with the mail daemons. +Finally, the +.IR -d , +debug, flag will expose many of the inner workings so that +it is possible to eliminate bugs. +.SH ENVIRONMENT +No environment variables are used. +.SH FILES +.PD 0 +.B /tmp/expn$$ +.B temporary file used as input to +.BR nslookup . +.SH SEE ALSO +.BR aliases (5), +.BR sendmail (8), +.BR nslookup (8), +RFC 823, and RFC 1123. +.SH BUGS +Not all mail daemons will implement +.B expn +or +.BR vrfy . +It is not possible to verify addresses that are served +by such daemons. +.LP +When attempting to connect to a system to verify an address, +.B expn +only tries one IP address. Most mail daemons +will try harder. +.LP +It is assumed that you are running domain names and that +the +.BR nslookup (8) +program is available. If not, +.B expn +will not be able to verify many addresses. It will also pause +for a long time unless you change the code where it says +.I $have_nslookup = 1 +to read +.I $have_nslookup = +.IR 0 . +.LP +Lastly, +.B expn +does not handle every valid address. If you have an example, +please submit a bug report. +.SH CREDITS +In 1986 or so, Jon Broome wrote a program of the same name +that did about the same thing. It has since suffered bit rot +and Jon Broome has dropped off the face of the earth! +(Jon, if you are out there, drop me a line) +.SH AVAILABILITY +The latest version of +.B expn +is available through anonymous ftp at +.IR ftp://ftp.idiom.com/pub/muir-programs/expn . +.SH AUTHOR +.I David Muir Sharnoff\ \ \ \ diff --git a/contrib/link_hash.sh b/contrib/link_hash.sh new file mode 100644 index 000000000000..843c920d62c2 --- /dev/null +++ b/contrib/link_hash.sh @@ -0,0 +1,36 @@ +#!/bin/sh +## +## Copyright (c) 2000 Sendmail, Inc. and its suppliers. +## All rights reserved. +## +## $Id: link_hash.sh,v 1.2 2000/04/25 00:12:28 ca Exp $ +## +# +# ln a certificate to its hash +# +SSL=openssl +if test $# -ge 1 +then + for i in $@ + do + C=$i.pem + test -f $C || C=$i + if test -f $C + then + H=`$SSL x509 -noout -hash < $C`.0 + if test -h $H -o -f $H + then + echo link $H to $C exists + else + ln -s $C $H + fi + else + echo "$0: cannot open $C" + exit 2 + fi + done +else + echo "$0: missing name" + exit 1 +fi +exit 0 diff --git a/contrib/mail.local.linux b/contrib/mail.local.linux new file mode 100644 index 000000000000..42d2c3c3d9ce --- /dev/null +++ b/contrib/mail.local.linux @@ -0,0 +1,205 @@ +From: Karl London +Message-Id: <199308111712.SAA05454@borg.demon.co.uk> +Subject: Final port of mail.local to Linux +To: eric@cs.berkeley.edu +Date: Wed, 11 Aug 1993 18:12:27 +0100 (BST) +X-Mailer: ELM [version 2.4 PL21] +MIME-Version: 1.0 +Content-Type: text/plain; charset=US-ASCII +Content-Transfer-Encoding: 7bit +Content-Length: 11415 + +Hi, + Sorry about this.. This is a final version of mail.local for +linux.. + +This is what I would like to see distributed with 8.6 if poss... + +Karl + +-------------- + +begin 600 mail.local.linux.tar.Z +M'YV0;<*D8>."S9LQ8=B\`,"PH<.'$"-*G$BQHL6*(&C`N`$#!@@`($#$N%'# +M(TB1)$V&7,D2A$<0-6C,D$%3QHT8+V/HI$$#9(V+0(,*'4HT8ITY=,+("0E@ +MC5(V122.G>1@7IE$'8<,&A&O8Q,VSA?Z< +M#/C3X7V7(9,&J6LQ=>BD>>,&1!@W9(!P5&]I]#?'&W7(,49O_P4H1H%*5;>= +M'&W,P0((=TR'AG%+97@6@G3$U\8;])F1!D+Z\7>A4KW!`5T;T]$Q'PAPR/&& +M'6F0,>-99B7'&PC;D?=&AFZ<`<(8_-&7HAMSQ,;'%MY(;;^BWX(5GU0<" +M&_7)YB62`$ZW'Y/^`=@FD&\(2:216([!AD!KR?$>:C)8^1N6=-R7WZ'%L?E@ +M6G)(R%T;4)ZI7HTDUB&F@2%DW9J%<)AH@ +MK$$:]"@(D4Z:1J4@L*F&&0\)X=^TA4)I5G0I6$NE,(M6:"19I1A5H)L<2C@ +M'+UYV6=Q!YI!QQTL4IMJL%C",6EUR#:J[,'^C;$&GG>P,5]PV4H97@*[^A(\7$7/ZGCA:>T#:B.K$7_*,<9H:LPOB +MERZ.H=V)C>_7H6MTR-B?BQ36)QU_E\9'!1))3`'"%$\80<4504A1!`BU@P"% +M%$]8D00111`!@A!9@##[[[X?48035-@>A!/*#_$$]5(D(4055#PAA>U@@!&$ +M[;6?<`((UQ,1W_7-%X'%\$5,8;OXP#(6K@`X$3GD`%$/"O"4F@@O_"=Z'GQ2<)^N.?_P`H0.H5$`2Y`T$3 +MBB"%(2!A@$$00A+X1X7FM0\$1LB@$^IG.R/@+PC"ZQT!AU`%)O1.>%60`A2> +M,(4BO,]W(&C@%!08!!`FSTK`A6]>XG +MA=1LCPK=^U[XQK>\W_$OADQP(JY\V$;X13$)OAL"%0Z(/4`609"$',+QP!@$ +M)EQH"E`X9!(:>2'Y%2&$O"%34B$(FVRC+G-8/6OB[WM30"`/LZC!`%8! +M"@3<7@KB@X0G7,&++$Q-$+;IOQMNCWU.:-[SQ->\%-Y1AC34Y/_.^+PV(M"- +MW`L"(F\'QR0(,CX'G6$&%8J_.5:0E0E<8`.=<`0)II%_:J0F"MM(P3-*X0JU +M*X)M>E<[!V81H,WC71:>&<$4/@\$_`2F&8.'.]T!L`B5_*(6DQ#,(!#!>$U4 +MGD_/*#QL>D^C-01F?*90!1=&\92I+$+L3I,`(*!@!"DHRUGHUA8T)*`&+A`, +M"J0F!ZI9S38Q>,%(7I"#&(3G!0H8P\$"M:&BK#Q006!V9R`V]^0(4 +M@C"[+S!AEU307P)$\`(ZM`$.+S`(0@B"A=*:5@0*"(UJ5_L5@HAV+*T-RVA= +M,(;5@F8N=RR%[NP9"0PJ$$-!B.3FMBD(XSAR0T@8]OF#N5,E_D(9[@R +M7>=:][K8E:IIVN.,= +M>=G+/+9*3YH@)H?VC!4UFPH4O+B%M0%%RT`(4A"#%#6J"#&*0A;"D(8.=H2&'H7,420CE))`Y:0.1VE*N*K2E03,L;0E4!P9!@TOU8%29*5AIFIFK>A/D(=/*R.A!=&+?>3Q3[Z@PR^2C2M@`VO9H4B6L(7MUV$&EIBO=F:QS96!;ZKJ +MV,<6Y>=EA<%D*%,9&5A6,!BK`&:S;ERK('=@G.DL<[7V61F`MIH9B8%HRVDO +MTMZ[-++*]VD"B]K4JE:&JRGJ;L/BVI:^)B^Q2;!LX4*;6B*VWJ)I.SKK.&-/^KV6G3X%@:_`0YB@B,<@+Z&.&4OKD6.JUEQ)'>T`)G!;MT<7N>&_P[5=D7=7>]^%SQ=&@]YRF.>&=&H +MQNH!-'MOC"/XQ$<^\Z%O"NK[^?L"VL7Y^LGU!6V\(74BR%6;8@]'.IPG7QD7Q"E,,0B +M'A$*25QB$Y_X.RE2T8I$P.)#)]A%I89QC&7\:?3`R$:(5E2.1*_CU_&H1]3D +MW8\-#.0@LQCZ0XZ^E8N,NR-O%TE%4K+IE]Q?)L,)T4^&TH2-+"5853F;5FJ= +MI+'<(BW!KD&QXU)XQ./E)<$H5*X2TYC(!($RF>E,7$&3A=.LYC6AGD)^=I.R +MX(SZ.#,X!7.V$9WJA#H"VRF%=\;3"?/$53WO^<4V#F&?4?TY"K7HQX%*H:#! +ME%$)=2%7P%`N=5.=!$<2-7K%U#T7A2L"N%&TYU&]%U*O1%(F=00H-3TJA3\M +MQ4(PU40SU3WIA($/Y4QL05=``(] +MH``B8%9HE1I%1B>R01MXA1NZ85[`43#]QEY'@V]*$U_9`6[?P05NP`6F<5]B +M6!S[Q1[SX0)T*`([$%B%HQT@,!H@H"M_4B"RH0))*%AFP(1.J(@*8!EZ(Q*J(R$ +MM6/`*(PO<"`FHR;0F(S+^(O-^`(FHC+;V(O4"%GZ88XO4"#C*(V^6(US8!!G +ML([=R`-F,`;#01!H@(SD:%CF2`9B((_3:%AP<`?ND8_1.(_ZL18`V8YUT!Q( +M49#ZR([4"!W=\08+28T/N1\7R8QT0`:`\H\&R8T!Z8U<4R0;^8F(Q59N@5J- +MU80%4@8)8`3@QP0)D`!^-0*.]9(),$LR^4TT"0.,I8@)H".`HB\@\`62A0(H +MH(@7(H67H0(ID`*!:`=OD",)0)%'F91+.1Q-*66RX91+H0(7X@)D&953695D +MD`!)9@9Y\"!F@!Q("05*"9:G898*()1(P1V1I95T"952J0!4:95'$0;!D95R +MB0*!209VJ0!?X08HH!1G,`8<=@9V,$\)H(C^(0>1&8@)T)J"9F<:1\U0R-AL'($>1H#R9F8*8478@9D +M<"'3EA"<607%OT`:!2)K5Y@;PB`(B,(IBP08B<"&7=022 +MQ4+$(P7>^03@B4HS])>D"9VHT@,25$1,P)EWX"LJ,QNTL2'N&1QTH)J/J9F2 +MF9F4>2$B0`9FH`-RH`,B$)4@$`+N602Y8YD),`<>(H7W:1NC69,(`3$@<`)D +M<`(Z4).&*`:_M@:;$R!(\EG;(@;UR8BD69-BD"9AL`:VJ(9 +M:J-RX*$@BAHB:C(E.B8HJA\JVALL6I.7B1PHP)X0F@`L09$HT).OEYUUP`;Z +MX3&]T0+(H9J@DJ`SF@#LZ8FSJ9EA^J(*(Z,Z6J,;^@,Y6I..%097ZC)*.IC! +M@0)_69-]0)J0.08@T`+NZ:4`PIF@"0(K$*APL)K3N:2S$0*?J9F5V:)V6@9X +MNJBC09JXD@3(,::(&')E(#HF,A\78F!S,V^5$YT@H)_P6"!X&BWU=FM0BAK, +M^2]T((5L<2&/!AT9`C&CJJ&EJC9C"BMEH9O<87$#`:NX@B1RL%]PD&?^LI^+ +MPIS@$:N`E0"SFI]JPIR52IJ$B`(A,*8F8`*-VJ08AZUTL*J.J:!\P`>8NA(A +M@`(#Z8GZ.9!I0Z[1J:Y\0"-WT`(^,)!?,*L,*B`Y$I4M.J;N":]W(*]J,I#: +MRIP*^@/ZRJ_^2C<@H`.?^`,82XOK&2#NF9=I8J]MD*<3,AO%61[N"0/6]*B4 +M:4TKL`*@":$E"P)\X)Y$V89-.IRG\;*MB0?3@0(E^Y=[.HG[^;%.ZIR7J`+L +M*9JDF4-Y=!IF``>*)S5>;,">@KH#*[4H8`)T8+5LD*>TJYA/ZQK# +M809-"@<":@085P+%@;S=>:IMT)2VB[NZNY@),+9;``-9Z)XGP`4P<`*<.;(^ +M.[:>&`/69`;Z.0[W8:P3KH\`A(`9C\+?H^XG&BZK+ +M6P.3JZ2]FU;Y,08H<`(^<`+!"0=Y2KG@>[(SNJ\)Y:HA/D!]J+!MA +M<(AEX,2094VZLF2?JS3\-@=*/&4=EA#*TH>G4:UIO,9E;,)`@L*SFY@I\):$ +M-0=HX,.^R:0[;"-RX,,PNZQ3.I,"*B.?Q1VB>ZP8@CJ]09'<4;H)D"9TD"". +M*9Q`RU@UJR^.>XCS9IF8*9Q>>[1TH[01VBFW28E?(@:U*2']=;6=>8EN:085<@9;,!==<"'X809; +M@`,J@!,R0`/IC)MGL06H-#]RFT=.D+;4^994BV@VTLU_`C%EP+KJ6<0J@*FH +M003U03)#TA]L]:5A9Y,$'K7 +MG,N+VL6T$/=B1J +M308GC2S'BD4Q4QQK\1_%(=SU2=*(^#<"`MBYW8<*7:UX2\W"J85Y;1PNXIA< +MC4)?$`10$$G8PP=/\`5#X#N41=Y?<`7$XP1,H%!3@-CM-P52P`?QG017L$U2 +MH*`\X!)"?95$34&6B]D@T-3=;1^JO,D4B2=V69-1'=I4/<2D_!4,."?B+Q,/0>='=?QFR8\K.#+RN!0K;L!W*)GD"># +M(Z+-F0!$#-#'@1QL3="L>^,7`@.KUT1%L./30P2\"\E8+<,H,,[EW-5`4`(@ +M_H=EO19-F2!;?K=,2FEE4-"W+.:/5`1E_@5-1`6V,;BSL>7*F0*%^]^5:]0B +M(,J@6\HJ4^3+B^!+[K--_@8-WLI03M@S.N70:N423IKS:"*-D<,OK +MG+YIL+[MN\Z2[0/^7;#?@@);[HDH:QW(T=_8K,=+`:B'N,V^;JCNZ09W\*1X +MJ^R>:'+30:E@+F9U@!PKX.O7+`?\[=^3W:)#ODU*>J#(\S*&*8NW*VJWM\PX.B>+.21_KFD3&:C:^E)GNX+SNE_">]C\*$) +M`,,&#S`V7LTXJ^5O^>0)$>583MJ7&JNWHR:+M(<'QV^`@<.PSHPLG)@=@>H;8G_$1S'\MH8DIO^H1ZYR6@C +M:RT'<]('8M,L:N4?VJUC\-NVT:(P+(47W?#6'+']>@?_FB/FOJ]W_P5G,+"/ +MC+IF$(S*2/>*N0,_&D7\<0*R@3'3\6`"`@=D`#!;C,B0+"EO`#&&+Y6)GP2? +M!2BBLYS6>1!K4/FDW<44#J%KV9;:(;QN/@=GD*6+C'+`>WZ>%]F[4J +M@`902YK$#W)\J/TAYYM9JS)N<-8YW?R6TB]?8`9J,1!Y\-^&*#5?PTSA;7IB+#,`!R?6D +M9E\.,X#<3V%]"*3``.<-=B)%V(\.4,!NIZ0JFX"#="`P\TD)6`-1?7RL0[>_]L8'JX)ZX'[]"`U]`_5$'%S&C*%B100$^T`<`0?4W +MUVP@^V."*`T._,`O8/[.P%E(84X0!X(NV="QI*`/F`-?8`M*N!GWZUP""%!@ +M38IMD3XU@0*"@!%`;#N$`>V2'4<$CH``:0)A3G`1+JI&`@$FL13@'LJ>Q"%:NB5;R*6#$K:L6M*!&8X5AH`C'* +M):D,KJ@5<`MR.0F]1;>DQ;[0$F2`3B`N,Z$F<(2<(`-L@&)@+F2QN4"7I2!= +MGD)7J"YY,3`*1LDP`LI**`*+5&-TG2*YLHK(3?P3"7KE!L@BQJ)+CD`/2`!> +MD0TH`%3B!'#`9GK`"Q@5C,4%[*-?)`;F@'M@%?%H;RV6P4@`!@R&CF`#8*,,4`RI2"0TAL?@$IPC9=B+F,$O4A?U +M:![;HWMD"'Y(!("A[Q(;PDL9(B^G33Z@E_0@:[)-&WH;PN+;T!>!`1[B(Z@I +M#WE(/2A`Z18?%8"!##!>YE,PF@*CH=@$CA$36&/,F`H(DQ:P+(_`@A`R?>C!CBD7=BSNP)F`<2GTR>*19\IC?T +M&D!3'R1%EK$4/)++0,B`4RQ$!83P=Z>"QZR*B/,JEJ2;J4)/TD!&R5U19XI# +ME<0SQ`+,9$E&@6*N3)=T%M""T-P:.5DMKD7+.)&-9BGDJDA#+CQ:I;D1+U+" +MG`5-`R0E9,OAD9_FON`+?5%J_,6IF33&K6"L&G_1:E[9J_D6L:;>^(F*L7$& +MY8AD"4>26=0'CU%P>,V,]#7`9D@(&V(S'*9$?$0V,H--V@R)U#!8I:V!:-1& +M:(@9;`-4[@V`/`XX,@$(R.X0;I;'N+$:QL+?I!N]$1T*Y*MT-V3#;,B-'T&Q +M^F.S_(_YYEO\JKJ!'-!-WJ@Q>X-0_@N#\S!VQ.`H'`PGZEF./`%QEDWD"!B4 +M(U@E&V.9,>3EQ^%HH(ITU`C3<*SOG(F$FG??!(/R(_Z`?W<2AF9X2DG:M3/[+.!7H@ +M7$>64)"O@T&*C_,X/A[$0(*0J2,S`PC-S"8JA(6X$!CR@[+*#2$G.P3J?)Z] +MTW>,B#@)/$S$B1A(C&EXC`CB43Q:A/'@DU\B1AI)Y/F8:83R1)V1Z3V&#AT1 +M`G9DD@B!/,(C/P_3*3T3A38:DKR90%)/((0DDN3U6!),\G]H3R>Q/:(D]QC( +M(A165HGON9G!Q^O4$I\Y=G2)\O$E*RB8.)]BDD&BS_1I)CSR^D@3BZ)]+@OW +MT2;CNRP`2!`NG$F;B`&6KS +M$.AH4:%0SPB4!^00!)8">W*05;1>4D.R-$0W!/*8(MT#GMA.)X!#4058!`ND +M2`&PNN3V(RP#@%`*`:)`S+'(EQP&QQ4K'"W@.'`I4X8U<.)V(P.A0C9`*YJ' +M!K#H4IB&&XJ%0H$?>D`50$U3`*?-D&I1QJ0JG%L=TUTY0HLZM0'H(*$`'("D +M/\)+"@`CXVAH_!NGUABSA+^(IQE$?O6*?%HYA6APH5A]-#H+&$*J%3QHLR\`? +MM9>$X]=LB%J&V@)$-&4+R9"3`A$5]1\$&_CR$WYTH"8<0HK$,FH]355J30ZL +MTI2&]4(7Y#@;**!\E+#^%2TJC4,5J74T452'CZHDRP1&56(*X-35/"1QI1Q$ +MF0@48;$_C*PZYD]15=*I63""7)C3`JE,\R-,&UV"+)7A`9PA'8#&3EV#ZV+" +M.$@L8$5+'`B0`4&5/O'0FP=2X,5A1/L99TE&`_,]/S#YR.E:7 +M0OEB#QU0;0@&%J``8$7^6Y!+P4^LI30P([P$14T3%K6&QE50.BB9:&8,AOH! +M4"@-UX1N/`*CF0.NHK9%&*SA`SP"(;JC2\XX9*($`39:Z(:8'L:CO6%.!YE* +M_Q0K_5.O=%)^L8+A(&UI%[$#SD,+*(`J@'!R*L00I$O2K=J(A0DP$*K:T`/\ +M(6+T5.?*%I+"9S&FR)2(,JWZ05M5Z6UUI3EB4G:6SQ):$JAI,2U_ZD25!$)&`L&R.I+A]:Q>J/%Z,.VQQC\%$%)91!QU`UA4-MB! +M&P`"P(/7$U8VXN.IA3)Z8<'#>SRS:#;-JMDURV;;K)M]LW`VSLK9.4MGZZR= +HO;-X-L_JV3W+9_NLG_VS@#;0"MI!2V@+K:$]M(@VT2K:1; Thu, 31 Oct 1996 09:29:47 -0800 (PST) +Received: from austin.bsdi.com (localhost [127.0.0.1]) by austin.bsdi.com (8.7.4/8.7.3) with ESMTP id KAA19250; Thu, 31 Oct 1996 10:28:18 -0700 (MST) +Message-Id: <199610311728.KAA19250@austin.bsdi.com> +To: Eric Allman +cc: marc@xfree86.org +Subject: Updated mailprio_0_93.shar +From: Tony Sanders +Organization: Berkeley Software Design, Inc. +Date: Thu, 31 Oct 1996 10:28:14 -0700 +Sender: sanders@austin.bsdi.com + +Eric, please update contrib/mailprio in the sendmail distribution +to this version at your convenience. Thanks. + +I've also made this available in: + ftp://ftp.earth.com/pub/postmaster/ + +mailprio_0_93.shar follows... + +#!/bin/sh +# This is a shell archive (produced by GNU sharutils 4.1). +# To extract the files from this archive, save it to some FILE, remove +# everything before the `!/bin/sh' line above, then type `sh FILE'. +# +# Made on 1996-10-31 10:07 MST by . +# +# Existing files will *not* be overwritten unless `-c' is specified. +# +# This shar contains: +# length mode name +# ------ ---------- ------------------------------------------ +# 8260 -rwxr-xr-x mailprio +# 3402 -rw-r--r-- mailprio.README +# 4182 -rwxr-xr-x mailprio_mkdb +# +touch -am 1231235999 $$.touch >/dev/null 2>&1 +if test ! -f 1231235999 && test -f $$.touch; then + shar_touch=touch +else + shar_touch=: + echo + echo 'WARNING: not restoring timestamps. Consider getting and' + echo "installing GNU \`touch', distributed in GNU File Utilities..." + echo +fi +rm -f 1231235999 $$.touch +# +# ============= mailprio ============== +if test -f 'mailprio' && test X"$1" != X"-c"; then + echo 'x - skipping mailprio (file already exists)' +else + echo 'x - extracting mailprio (text)' + sed 's/^X//' << 'SHAR_EOF' > 'mailprio' && +#!/usr/bin/perl +# +# mailprio,v 1.4 1996/10/31 17:03:52 sanders Exp +# Version 0.93 -- Thu Oct 31 09:42:25 MST 1996 +# +# mailprio -- setup mail priorities for a mailing list +# +# Copyright 1994, 1996, Tony Sanders +# Rights are hereby granted to download, use, modify, sell, copy, and +# redistribute this software so long as the original copyright notice +# and this list of conditions remain intact and modified versions are +# noted as such. +# +# I would also very much appreciate it if you could send me a copy of +# any changes you make so I can possibly integrate them into my version. +# +# Options: +# -p priority_database -- Specify database to use if not default +# -q -- Process sendmail V8.8.X queue format files +# +# Sort mailing lists or sendmail queue files by mailprio database. +# Files listed on the command line are locked and then sorted in place, in +# the absence of any file arguments it will read STDIN and write STDOUT. +# +# Examples: +# mailprio < mailing-list > sorted_list +# mailprio mailing-list1 mailing-list2 mailing-list3 ... +# mailprio -q /var/spool/mqueue/qf* +# To double check results: +# sort sorted_list > checkit; sort orig-mailing-list | diff - checkit +# +# To get the maximum value from a transaction delay based priority +# function you need to reorder the distribution list (and the mail +# queue files for that matter) fairly often; you could even have +# your mailing list software reorder the list before each outgoing +# message. +# +$usage = "Usage: mailprio [-p priodb] [-q] [mailinglists ...]\n"; +$home = "/home/sanders/lists"; +$priodb = "$home/mailprio"; +$locking = "flock"; # "flock" or "fcntl" +X +# In shell, it would go more or less like this: +# old_mailprio > /tmp/a +# fgrep -f lists/inet-access /tmp/a | sed -e 's/^.......//' > /tmp/b +# ; /tmp/b contains list of known users, faster delivery first +# fgrep -v -f /tmp/b lists/inet-access > /tmp/c +# ; put all unknown stuff at the top of new list for now +# echo '# -----' >> /tmp/c +# cat /tmp/b >> /tmp/c +X +$qflag = 0; +while ($main'ARGV[0] =~ /^-/) { +X $args = shift; +X if ($args =~ m/\?/) { print $usage; exit 0; } +X if ($args =~ m/q/) { $qflag = 1; } +X if ($args =~ m/p/) { +X $priodb = shift || die $usage, "-p requires argument\n"; } +} +X +push(@main'ARGV, '-') if ($#ARGV < 0); +while ($file = shift @ARGV) { +X if ($file eq "-") { +X $source = "main'STDIN"; +X $sink = "main'STDOUT"; +X } else { +X $sink = $source = "FH"; +X open($source, "+< $file") || do { warn "$file: $!\n"; next; }; +X if (!defined &seize($source, &LOCK_EX | &LOCK_NB)) { +X # couldn't get lock, just skip it +X close($source); +X next; +X } +X } +X +X local(*list); +X &process($source, *list); +X +X # setup to write output +X if ($file ne "-") { +X # zero the file (FH is hardcoded because truncate requires it, sigh) +X seek(FH, 0, 0) || die "$file: seek: $!\n"; +X truncate(FH, 0) || die "$file: truncate: $!\n"; +X } +X +X # do the dirty work +X &output($sink, *list); +X +X close($sink) || warn "$file: $!\n"; # close clears the lock +X close($source); +} +X +sub process { +X # Setup %list and @list +X local($source, *list) = @_; +X local($addr, $canon); +X while ($addr = <$source>) { +X chop $addr; +X next if $addr =~ /^# ----- /; # that's our line +X push(@list, $addr), next if $addr =~ /^\s*#/; # save comments +X if ($qflag) { +X next if $addr =~ m/^\./; +X push(@list, $addr), next if !($addr =~ s/^(R[^:]*:)//); +X $Rflags = $1; +X } +X $canon = &canonicalize((&simplify_address($addr))[0]); +X unless (defined $canon) { +X warn "$file: no address found: $addr\n"; +X push(@list, ($qflag?$Rflags:'') . $addr); # save it as is +X next; +X } +X if (defined $list{$canon}) { +X warn "$file: duplicate: ``$addr -> $canon''\n"; +X push(@list, ($qflag?$Rflags:'') . $addr); # save it as is +X next; +X } +X $list{$canon} = $addr; +X } +} +X +sub output { +X local($sink, *list) = @_; +X +X local($to, *prio, *userprio, *useracct); +X dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n"; +X foreach $to (keys %list) { +X if (defined $prio{$to}) { +X # add to list of found users (%userprio) and remove from %list +X # so that we know what users were not yet prioritized +X $userprio{$to} = $prio{$to}; # priority +X $useracct{$to} = $list{$to}; # string +X delete $list{$to}; +X } +X } +X dbmclose(%prio); +X +X # Put all the junk we found at the very top +X # (this might not always be a feature) +X print $sink join("\n", @list), "\n" if int(@list); +X +X # prioritized list of users +X if (int(keys %userprio)) { +X print $sink '# ----- prioritized users', "\n" unless $qflag; +X foreach $to (sort by_userprio keys %userprio) { +X die "Opps! Something is seriously wrong with useracct: $to\n" +X unless defined $useracct{$to}; +X print $sink 'RFD:' if $qflag; +X print $sink $useracct{$to}, "\n"; +X } +X } +X +X # unprioritized users go last, fast accounts will get moved up eventually +X # XXX: should go before the "really slow" prioritized users? +X if (int(keys %list)) { +X print $sink '# ----- unprioritized users', "\n" unless $qflag; +X foreach $to (keys %list) { +X print $sink 'RFD:' if $qflag; +X print $sink $list{$to}, "\n"; +X } +X } +X +X print $sink ".\n" if $qflag; +} +X +sub by_userprio { +X # sort first by priority, then by key. +X $userprio{$a} <=> $userprio{$b} || $a cmp $b; +} +X +# REPL-LIB --------------------------------------------------------------- +X +sub canonicalize { +X local($addr) = @_; +X # lowercase, strip leading/trailing whitespace +X $addr =~ y/A-Z/a-z/; $addr =~ s/^\s+//; $addr =~ s/\s+$//; $addr; +} +X +# @addrs = simplify_address($addr); +sub simplify_address { +X local($_) = shift; +X 1 while s/\([^\(\)]*\)//g; # strip comments +X 1 while s/"[^"]*"//g; # strip comments +X split(/,/); # split into parts +X foreach (@_) { +X 1 while s/.*<(.*)>.*/\1/; +X s/^\s+//; +X s/\s+$//; +X } +X @_; +} +X +### ---- ### +# +# Error codes +# +do 'errno.ph'; +eval 'sub ENOENT {2;}' unless defined &ENOENT; +eval 'sub EINTR {4;}' unless defined &EINTR; +eval 'sub EINVAL {22;}' unless defined &EINVAL; +X +# +# File locking +# +do 'sys/unistd.ph'; +eval 'sub SEEK_SET {0;}' unless defined &SEEK_SET; +X +do 'sys/file.ph'; +eval 'sub LOCK_SH {0x01;}' unless defined &LOCK_SH; +eval 'sub LOCK_EX {0x02;}' unless defined &LOCK_EX; +eval 'sub LOCK_NB {0x04;}' unless defined &LOCK_NB; +eval 'sub LOCK_UN {0x08;}' unless defined &LOCK_UN; +X +do 'fcntl.ph'; +eval 'sub F_GETFD {1;}' unless defined &F_GETFD; +eval 'sub F_SETFD {2;}' unless defined &F_SETFD; +eval 'sub F_GETFL {3;}' unless defined &F_GETFL; +eval 'sub F_SETFL {4;}' unless defined &F_SETFL; +eval 'sub O_NONBLOCK {0x0004;}' unless defined &O_NONBLOCK; +eval 'sub F_SETLK {8;}' unless defined &F_SETLK; # nonblocking +eval 'sub F_SETLKW {9;}' unless defined &F_SETLKW; # lockwait +eval 'sub F_RDLCK {1;}' unless defined &F_RDLCK; +eval 'sub F_UNLCK {2;}' unless defined &F_UNLCK; +eval 'sub F_WRLCK {3;}' unless defined &F_WRLCK; +$s_flock = "sslll"; # struct flock {type, whence, start, len, pid} +X +# return undef on failure +sub seize { +X local ($FH, $lock) = @_; +X local ($ret); +X if ($locking eq "flock") { +X $ret = flock($FH, $lock); +X return ($ret == 0 ? undef : 1); +X } else { +X local ($flock, $type) = 0; +X if ($lock & &LOCK_SH) { $type = &F_RDLCK; } +X elsif ($lock & &LOCK_EX) { $type = &F_WRLCK; } +X elsif ($lock & &LOCK_UN) { $type = &F_UNLCK; } +X else { $! = &EINVAL; return undef; } +X $flock = pack($s_flock, $type, &SEEK_SET, 0, 0, 0); +X $ret = fcntl($FH, ($lock & &LOCK_NB) ? &F_SETLK : &F_SETLKW, $flock); +X return ($ret == -1 ? undef : 1); +X } +} +SHAR_EOF + $shar_touch -am 1031100396 'mailprio' && + chmod 0755 'mailprio' || + echo 'restore of mailprio failed' + shar_count="`wc -c < 'mailprio'`" + test 8260 -eq "$shar_count" || + echo "mailprio: original size 8260, current size $shar_count" +fi +# ============= mailprio.README ============== +if test -f 'mailprio.README' && test X"$1" != X"-c"; then + echo 'x - skipping mailprio.README (file already exists)' +else + echo 'x - extracting mailprio.README (text)' + sed 's/^X//' << 'SHAR_EOF' > 'mailprio.README' && +mailprio README +X +mailprio.README,v 1.2 1996/10/31 17:03:54 sanders Exp +Version 0.93 -- Thu Oct 31 09:42:25 MST 1996 +X +Copyright 1994, 1996, Tony Sanders +Rights are hereby granted to download, use, modify, sell, copy, and +redistribute this software so long as the original copyright notice +and this list of conditions remain intact and modified versions are +noted as such. +X +I would also very much appreciate it if you could send me a copy of +any changes you make so I can possibly integrate them into my version. +X +The current version of this and other related mail tools are available in: +X ftp://ftp.earth.com/pub/postmaster/ +X +Even with the new persistent host status in sendmail V8.8.X this +function can still reduce the lag time distributing mail to a large +group of people. It also makes it a little more likely that everyone +will get mailing list mail in the order sent which can help reduce +duplicate postings. Basically, the goal is to put slow hosts at +the bottom of the list so that as many fast hosts are delivered +as quickly as possible. +X +CONTENTS +======== +X +X mailprio.README -- simple docs +X mailprio -- the address sorter +X mailprio_mkdb -- builds the database for the sorter +X +X +CHANGES +======= +X Version 0.92 +X Initial public release. +X +X Version 0.93 +X Updated to make use of the (somewhat) new xdelay statistic. +X Changed -q flag to support new sendmail queue file format (RFD:). +X Fixed argument parsing bug. +X Fixed bug with database getting "garbage" in it. +X +X +CONFIGURATION +============= +X +X You need to edit each script and ensure proper configuration. +X +X In mailprio check: #!perl path, $home, $priodb, $locking +X +X In mailprio_mkdb check: #!perl path, $home, $priodb, $maillog +X +X +USAGE: mailprio +=============== +X +X Usage: mailprio [-p priodb] [-q] [mailinglists ...] +X -p priority_database -- Specify database to use if not default +X -q -- Process sendmail queue format files +X [USE WITH CAUTION] +X +X Sort mailing lists or sendmail V8 queue files by mailprio database. +X Files listed on the command line are locked and then sorted in place, in +X the absence of any file arguments it will read STDIN and write STDOUT. +X +X Examples: +X mailprio < mailing-list > sorted_list +X mailprio mailing-list1 mailing-list2 mailing-list3 ... +X mailprio -q /var/spool/mqueue/qf* [not recommended] +X To double check results: +X sort sorted_list > checkit; sort orig-mailing-list | diff - checkit +X +X NOTE: +X To get the maximum value from a transaction delay based priority +X function you need to reorder the distribution list (and the mail +X queue files for that matter) fairly often; you could even have +X your mailing list software reorder the list before each outgoing +X message. +X +X +USAGE: mailprio_mkdb +==================== +X +X Usage: mailprio_mkdb [-l maillog] [-p priodb] +X -l maillog -- Specify maillog to process if not default +X -p priority_database -- Specify database to use if not default +X +X Builds the mail priority database using information from the maillog. +X +X Run at least nightly before you rotate the maillog. If you are +X going to run mailprio more often than that then you will need to +X load the current maillog information before that will do any good +X (and to keep from reloading the same information you will need +X some kind of incremental maillog information to load from). +SHAR_EOF + $shar_touch -am 1031100396 'mailprio.README' && + chmod 0644 'mailprio.README' || + echo 'restore of mailprio.README failed' + shar_count="`wc -c < 'mailprio.README'`" + test 3402 -eq "$shar_count" || + echo "mailprio.README: original size 3402, current size $shar_count" +fi +# ============= mailprio_mkdb ============== +if test -f 'mailprio_mkdb' && test X"$1" != X"-c"; then + echo 'x - skipping mailprio_mkdb (file already exists)' +else + echo 'x - extracting mailprio_mkdb (text)' + sed 's/^X//' << 'SHAR_EOF' > 'mailprio_mkdb' && +#!/usr/bin/perl +# +# mailprio_mkdb,v 1.5 1996/10/31 17:03:53 sanders Exp +# Version 0.93 -- Thu Oct 31 09:42:25 MST 1996 +# +# mailprio_mkdb -- make mail priority database based on delay times +# +# Copyright 1994, 1996, Tony Sanders +# Rights are hereby granted to download, use, modify, sell, copy, and +# redistribute this software so long as the original copyright notice +# and this list of conditions remain intact and modified versions are +# noted as such. +# +# I would also very much appreciate it if you could send me a copy of +# any changes you make so I can possibly integrate them into my version. +# +# The average function moves the value around quite rapidly (half-steps) +# which may or may not be a feature. This version uses the new xdelay +# statistic (new as of sendmail V8) which is per transaction. We also +# weight the result based on the overall delay. +# +# Something that might be worth doing for systems that don't support +# xdelay would be to compute an approximation of the transaction delay +# by sorting by messages-id and delay then computing the difference +# between adjacent delay values. +# +# To get the maximum value from a transaction delay based priority +# function you need to reorder the distribution list (and the mail +# queue files for that matter) fairly often; you could even have +# your mailing list software reorder the list before each outgoing +# message. +X +$usage = "Usage: mailprio_mkdb [-l maillog] [-p priodb]\n"; +$home = "/home/sanders/lists"; +$maillog = "/var/log/maillog"; +$priodb = "$home/mailprio"; +X +while ($ARGV[0] =~ /^-/) { +X $args = shift; +X if ($args =~ m/\?/) { print $usage; exit 0; } +X if ($args =~ m/l/) { +X $maillog = shift || die $usage, "-l requires argument\n"; } +X if ($args =~ m/p/) { +X $priodb = shift || die $usage, "-p requires argument\n"; } +} +X +$SIG{'PIPE'} = 'handle_pipe'; +X +# will merge with existing information +dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n"; +&getlog_stats($maillog, *prio); +dbmclose(%prio); +exit(0); +X +sub handle_pipe { +X dbmclose(%prio); +} +X +sub getlog_stats { +X local($maillog, *stats) = @_; +X local($to, $delay); +X local($h, $m, $s); +X open(MAILLOG, "< $maillog") || die "$maillog: $!\n"; +X while () { +X next unless / to=/ && / stat=/; +X next if / stat=queued/; +X if (/ stat=sent/i) { +X # read delay and xdelay and convert to seconds +X ($delay) = (m/ delay=([^,]*),/); +X next unless $delay; +X ($h, $m, $s) = split(/:/, $delay); +X $delay = ($h * 60 * 60) + ($m * 60) + $s; +X +X ($xdelay) = (m/ xdelay=([^,]*),/); +X next unless $xdelay; +X ($h, $m, $s) = split(/:/, $xdelay); +X $xdelay = ($h * 60 * 60) + ($m * 60) + $s; +X +X # Now weight the delay factor by the transaction delay (xdelay). +X $xdelay /= 300; # [0 - 1(@5 min)] +X $xdelay += 0.5; # [0.5 - 1.5] +X $xdelay = 1.5 if $xdelay > 1.5; # clamp +X $delay *= $xdelay; # weight delay by xdelay +X } +X elsif (/, stat=/) { +X # delivery failure of some sort (i.e. bad) +X $delay = 432000; # force 5 days +X } +X $delay = 1000000 if $delay > 1000000; +X +X # filter the address(es); isn't perfect but is "good enough" +X $to = $_; $to =~ s/^.* to=//; +X 1 while $to =~ s/\([^\(\)]*\)//g; # strip comments +X 1 while $to =~ s/"[^"]*"//g; # strip comments +X $to =~ s/, .*//; # remove other stat info +X foreach $addr (&simplify_address($to)) { +X next unless $addr; +X $addr = &canonicalize($addr); +X $stats{$addr} = $delay unless defined $stats{$addr}; # init +X # pseudo-average in the new delay (half-steps) +X # simple, moving average +X $stats{$addr} = int(($stats{$addr} + $delay) / 2); +X } +X } +X close(MAILLOG); +} +X +# REPL-LIB --------------------------------------------------------------- +X +sub canonicalize { +X local($addr) = @_; +X # lowercase, strip leading/trailing whitespace +X $addr =~ y/A-Z/a-z/; $addr =~ s/^\s+//; $addr =~ s/\s+$//; $addr; +} +X +# @addrs = simplify_address($addr); +sub simplify_address { +X local($_) = shift; +X 1 while s/\([^\(\)]*\)//g; # strip comments +X 1 while s/"[^"]*"//g; # strip comments +X split(/,/); # split into parts +X foreach (@_) { +X 1 while s/.*<(.*)>.*/\1/; +X s/^\s+//; +X s/\s+$//; +X } +X @_; +} +SHAR_EOF + $shar_touch -am 1031100396 'mailprio_mkdb' && + chmod 0755 'mailprio_mkdb' || + echo 'restore of mailprio_mkdb failed' + shar_count="`wc -c < 'mailprio_mkdb'`" + test 4182 -eq "$shar_count" || + echo "mailprio_mkdb: original size 4182, current size $shar_count" +fi +exit 0 diff --git a/contrib/mh.patch b/contrib/mh.patch new file mode 100644 index 000000000000..7b23a5b71dd4 --- /dev/null +++ b/contrib/mh.patch @@ -0,0 +1,193 @@ +Message-Id: <199309031900.OAA19417@ignatz.acs.depaul.edu> +To: bug-mh@ics.uci.edu +cc: mh-users@ics.uci.edu, eric@cs.berkeley.edu +Subject: MH-6.8.1/Sendmail 8.X (MH patch) updated +Date: Fri, 03 Sep 1993 14:00:46 -0500 +From: Dave Nelson + + + This patch will fix the "X-auth..." warnings from the newer +Sendmails (8.X) while continuing to work with the old sendmails. + + I think the following patch will make everyone happy. + + 1) Anybody with MH-6.8.1 can install this. It doesn't matter + what version of sendmail you're running. It doesn't matter + if you're not running sendmail (but it won't fix anything + for you). + + 2) No configuration file hacks. If the -client switch is + absent (the default), the new sendmails will get an EHLO + using what LocalName() returns as the hostname. On my systems, + this returns the FQDN. If the EHLO fails with a result between + 500 and 599 and the -client switch is not set, we give up on + sending EHLO/HELO and just go deliver the mail. + + 3) No new configuration options. + + 4) Retains the undocumented -client switch. One warning: it + is possible using the -client switch to cause the old sendmails + to return "I refuse to talk to myself". You could do this under + the old code as well. This will happen if you claim to be the + same system as the sendmail you're sending to is running on. + That's pointless, but possible. If you do this, just like under + the old code, you will get an error. + + 5) If you're running a site with both old and new sendmails, you only + have to build MH once. The code's the same; works with them + both. + + If you decide to install this, make sure that you look the patch +over and that you agree with what it is doing. It works for me, but I +can't test it on every possible combination. Make sure that it works +before you really install it for your users, if any. No promises. + + To install this, save this to a file in the mts/sendmail directory. +Feed it to patch. Patch will ignore the non-patch stuff. You should have +"mts sendmail/smtp" in your configuration file. This works with old and +new sendmails. Using "mts sendmail" will cause the new sendmails to +print an "X-auth..." warning about who owns the process piping the mail +message. I don't know of anyway of getting rid of these. + + mh-config (if necessary), make, make inst-all. + + +I hope this helps people. + +/dcn + +Dave Nelson +Academic Computer Services +DePaul University, Chicago + +*** smail.c Fri Sep 3 11:58:05 1993 +--- smail.c Fri Sep 3 11:57:27 1993 +*************** +*** 239,261 **** + return RP_RPLY; + } + +! if (client && *client) { +! doingEHLO = 1; +! result = smtalk (SM_HELO, "EHLO %s", client); +! doingEHLO = 0; + +! if (500 <= result && result <= 599) + result = smtalk (SM_HELO, "HELO %s", client); +! +! switch (result) { + case 250: +! break; + + default: + (void) sm_end (NOTOK); + return RP_RPLY; + } + } + + #ifndef ZMAILER + if (onex) +--- 239,276 ---- + return RP_RPLY; + } + +! doingEHLO = 1; +! result = smtalk (SM_HELO, "EHLO %s", +! (client && *client) ? client : LocalName()); +! doingEHLO = 0; +! +! switch (result) +! { +! case 250: +! break; + +! default: +! if (!(500 <= result && result <= 599)) +! { +! (void) sm_end (NOTOK); +! return RP_RPLY; +! } +! +! if (client && *client) +! { + result = smtalk (SM_HELO, "HELO %s", client); +! switch (result) +! { + case 250: +! break; + + default: + (void) sm_end (NOTOK); + return RP_RPLY; ++ } + } + } ++ + + #ifndef ZMAILER + if (onex) +*************** +*** 357,380 **** + return RP_RPLY; + } + +! if (client && *client) { +! doingEHLO = 1; +! result = smtalk (SM_HELO, "EHLO %s", client); +! doingEHLO = 0; + +! if (500 <= result && result <= 599) + result = smtalk (SM_HELO, "HELO %s", client); +! +! switch (result) { +! case 250: + break; + +! default: + (void) sm_end (NOTOK); + return RP_RPLY; + } + } +! + send_options: ; + if (watch && EHLOset ("XVRB")) + (void) smtalk (SM_HELO, "VERB on"); +--- 372,409 ---- + return RP_RPLY; + } + +! doingEHLO = 1; +! result = smtalk (SM_HELO, "EHLO %s", +! (client && *client) ? client : LocalName()); +! doingEHLO = 0; +! +! switch (result) +! { +! case 250: +! break; +! +! default: +! if (!(500 <= result && result <= 599)) +! { +! (void) sm_end (NOTOK); +! return RP_RPLY; +! } + +! if (client && *client) +! { + result = smtalk (SM_HELO, "HELO %s", client); +! switch (result) +! { +! case 250: + break; + +! default: + (void) sm_end (NOTOK); + return RP_RPLY; ++ } + } + } +! + send_options: ; + if (watch && EHLOset ("XVRB")) + (void) smtalk (SM_HELO, "VERB on"); diff --git a/contrib/mmuegel b/contrib/mmuegel new file mode 100644 index 000000000000..6db4a45189c1 --- /dev/null +++ b/contrib/mmuegel @@ -0,0 +1,2079 @@ +From: "Michael S. Muegel" +Message-Id: <199307280818.AA08111@cssun6.corp.mot.com> +Subject: Re: contributed software +To: eric@cs.berkeley.edu (Eric Allman) +Date: Wed, 28 Jul 1993 03:18:02 -0500 (CDT) +In-Reply-To: <199307221853.LAA04266@mastodon.CS.Berkeley.EDU> from "Eric Allman" at Jul 22, 93 11:53:47 am +X-Mailer: ELM [version 2.4 PL22] +Mime-Version: 1.0 +Content-Type: text/plain; charset=US-ASCII +Content-Transfer-Encoding: 7bit +Content-Length: 69132 + +OK. Here is a new shell archive. + +Cheers, +-Mike + +---- Cut Here and feed the following to sh ---- +#!/bin/sh +# This is a shell archive (produced by shar 3.49) +# To extract the files from this archive, save it to a file, remove +# everything above the "!/bin/sh" line above, and type "sh file_name". +# +# made 07/28/1993 08:13 UTC by mmuegel@mot.com (Michael S. Muegel) +# Source directory /home/ustart/NeXT/src/mail-tools/dist/foo +# +# existing files will NOT be overwritten unless -c is specified +# +# This shar contains: +# length mode name +# ------ ---------- ------------------------------------------ +# 4308 -r--r--r-- README +# 12339 -r--r--r-- libs/date.pl +# 3198 -r--r--r-- libs/elapsed.pl +# 4356 -r--r--r-- libs/mail.pl +# 6908 -r--r--r-- libs/mqueue.pl +# 7024 -r--r--r-- libs/newgetopts.pl +# 4687 -r--r--r-- libs/strings1.pl +# 1609 -r--r--r-- libs/timespec.pl +# 5212 -r--r--r-- man/cqueue.1 +# 2078 -r--r--r-- man/postclip.1 +# 6647 -r-xr-xr-x src/cqueue +# 1836 -r-xr-xr-x src/postclip +# +# ============= README ============== +if test -f 'README' -a X"$1" != X"-c"; then + echo 'x - skipping README (File already exists)' +else +echo 'x - extracting README (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'README' && +------------------------------------------------------------------------------- +Document Revision Control Information: +X mmuegel +X /usr/local/ustart/src/mail-tools/dist/foo/README,v +X 1.1 of 1993/07/28 08:12:53 +------------------------------------------------------------------------------- +X +1. Introduction +--------------- +X +These tools may be of use to those sites using sendmail. Both are written in +Perl. Our site, Mot.COM, receives a ton of mail being a top-level domain +gateway. We have over 24 domains under us. Needless to say, we must have +a robust mail system or my head, and others, would be on the chopping block. +X +2. Description +-------------- +X +The first tool, cqueue, checks the sendmail queue for problems. We use +it to flag problems with subdomain mail servers (and even our own servers +once in a while ;-). We run it via a cron job every hour during the day. +You may find this too frequent, however. +X +The other program, postclip, is used to "filter" non-deliverable NDNs that +get sent to our Postmaster account now and then. This ensures privacy of +e-mail and helps avoid disk problems from huge NDNs. It is different than +a brute force "just keep the header" approach because it tries hard to keep +other parts of the message that look like non-delivery information. +X +Both have been used for some time at our site with no problems. Everything +you need should be in this distribution: source, manual pages, and support +libs. See the manual pages for a complete description of each tool. +X +3. Installation +--------------- +X +No fancy Makefile simply because these tools are all under a large +hierarchy at my site. Installation should be a snap, however. Install +the nroff(1) man(5) manual pages from the man subdirectory to the +appropriate directory on your system. This might be something like +/usr/local/man/man1. +X +Next, install all of the Perl libraries located in the lib subdirectory +to your Perl library area. /usr/local/lib/perl is a good bet. The person +who installed Perl at your site will be able to tell you for sure. +X +Finally, you need to install the programs. Note that cqueue wants to +run setuid root by default. This is because the sendmail queue is normally +only readable by root or some special group. In order to let any user +run this suidperl is used. suidperl allows a Perl program to run with the +privileges of another user. +X +You will have to edit both the cqueue and postclip programs to change +the #! line at the top of each. Just change the pathname to whatever is +appropriate on your system. Note that Larry Wall's fixin program from +the Camel book can also be used to do this. It is very handy. It changes +#! lines by looking at your PATH. +X +If you do not have suidperl on your system change the #! line in cqueue +to reference perl instead of suidperl. +X +You may also wish to change some constants in cqueue. $DEF_QUEUE should be +changed to your queue directory if it is not /usr/spool/mqueue. $DEF_TIME +could be changed easy enough also. It is the time spec for the time duration +after which a mail message will be reported on if the -a option has not been +specified. See the manual page for more information and the format of this +constant (same as the -t argument). Then again, neither of these has to +be changed. Command line options are there to override their default +values. +X +After you have edited the programs as necessary, all that remains is to +install them to some executable directory. Install postclip mode 555 +and cqueue mode 4555 with owner root (if using suidperl) or mode 555 +(if not using suidperl). +X +4. Gripes, Comments, Etc +------------------------ +X +If you start using either of these let me know. I have other mail tools I +will likely post in the future if these prove useful. Also, if you think +something is just plain dumb/wrong/stupid let me know! +X +Cheers, +-Mike +X +-- ++----------------------------------------------------------------------------+ +| Michael S. Muegel | Internet E-Mail: mmuegel@mot.com | +| UNIX Applications Startup Group | Moto Dist E-Mail: X10090 | +| Corporate Information Office | Voice: (708) 576-0507 | +| Motorola | Fax: (708) 576-4153 | ++----------------------------------------------------------------------------+ +SHAR_EOF +chmod 0444 README || +echo 'restore of README failed' +Wc_c="`wc -c < 'README'`" +test 4308 -eq "$Wc_c" || + echo 'README: original size 4308, current size' "$Wc_c" +fi +# ============= libs/date.pl ============== +if test ! -d 'libs'; then + echo 'x - creating directory libs' + mkdir 'libs' +fi +if test -f 'libs/date.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/date.pl (File already exists)' +else +echo 'x - extracting libs/date.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/date.pl' && +;# +;# Name +;# date.pl - Perl emulation of (the output side of) date(1) +;# +;# Synopsis +;# require "date.pl"; +;# $Date = &date(time); +;# $Date = &date(time, $format); +;# +;# Description +;# This package implements the output formatting functions of date(1) in +;# Perl. The format options are based on those supported by Ultrix 4.0 +;# plus a couple of additions from SunOS 4.1.1 and elsewhere: +;# +;# %a abbreviated weekday name - Sun to Sat +;# %A full weekday name - Sunday to Saturday +;# %b abbreviated month name - Jan to Dec +;# %B full month name - January to December +;# %c date and time in local format [+] +;# %C date and time in long local format [+] +;# %d day of month - 01 to 31 +;# %D date as mm/dd/yy +;# %e day of month (space padded) - ` 1' to `31' +;# %E day of month (with suffix: 1st, 2nd, 3rd...) +;# %f month of year (space padded) - ` 1' to `12' +;# %h abbreviated month name - Jan to Dec +;# %H hour - 00 to 23 +;# %i hour (space padded) - ` 1' to `12' +;# %I hour - 01 to 12 +;# %j day of the year (Julian date) - 001 to 366 +;# %k hour (space padded) - ` 0' to `23' +;# %l date in ls(1) format +;# %m month of year - 01 to 12 +;# %M minute - 00 to 59 +;# %n insert a newline character +;# %p ante-meridiem or post-meridiem indicator (AM or PM) +;# %r time in AM/PM notation +;# %R time as HH:MM +;# %S second - 00 to 59 +;# %t insert a tab character +;# %T time as HH:MM:SS +;# %u date/time in date(1) required format +;# %U week number, Sunday as first day of week - 00 to 53 +;# %V date-time in SysV touch format (mmddHHMMyy) +;# %w day of week - 0 (Sunday) to 6 +;# %W week number, Monday as first day of week - 00 to 53 +;# %x date in local format [+] +;# %X time in local format [+] +;# %y last 2 digits of year - 00 to 99 +;# %Y all 4 digits of year ~ 1700 to 2000 odd ? +;# %z time zone from TZ environment variable w/ a trailing space +;# %Z time zone from TZ environment variable +;# %% insert a `%' character +;# %+ insert a `+' character +;# +;# [+]: These may need adjustment to fit local conventions, see below. +;# +;# For the sake of compatibility, a leading `+' in the format +;# specificaiton is removed if present. +;# +;# Remarks +;# This is version 3.4 of date.pl +;# +;# An extension of `ctime.pl' by Waldemar Kebsch (kebsch.pad@nixpbe.UUCP), +;# as modified by Marion Hakanson (hakanson@ogicse.ogi.edu). +;# +;# Unlike date(1), unknown format tags are silently replaced by "". +;# +;# defaultTZ is a blatant hack, but I wanted to be able to get date(1) +;# like behaviour by default and there does'nt seem to be an easy (read +;# portable) way to get the local TZ name back... +;# +;# For a cheap date, try... +;# +;# #!/usr/local/bin/perl +;# require "date.pl"; +;# exit print (&date(time, shift @ARGV) . "\n") ? 0 : 1; +;# +;# This package is redistributable under the same terms as apply to +;# the Perl 4.0 release. See the COPYING file in your Perl kit for +;# more information. +;# +;# Please send any bug reports or comments to tmcgonigal@gallium.com +;# +;# Modification History +;# Nmemonic Version Date Who +;# +;# NONE 1.0 02feb91 Terry McGonigal (tmcgonigal@gallium.com) +;# Created from ctime.pl +;# +;# NONE 2.0 07feb91 tmcgonigal +;# Added some of Marion Hakanson (hakanson@ogicse.ogi.edu)'s ctime.pl +;# TZ handling changes. +;# +;# NONE 2.1 09feb91 tmcgonigal +;# Corrected week number calculations. +;# +;# NONE 2.2 21oct91 tmcgonigal +;# Added ls(1) date format, `%l'. +;# +;# NONE 2.3 06nov91 tmcgonigal +;# Added SysV touch(1) date-time format, `%V' (pretty thin as +;# mnemonics go, I know, but `t' and `T' were both gone already!) +;# +;# NONE 2.4 05jan92 tmcgonigal +;# Corrected slight (cosmetic) problem with %V replacment string +;# +;# NONE 3.0 09jul92 tmcgonigal +;# Fixed a couple of problems with &ls as pointed out by +;# Thomas Richter (richter@ki1.chemie.fu-berlin.de), thanks Thomas! +;# Also added a couple of SunOS 4.1.1 strftime-ish formats, %i and %k +;# for space padded hours (` 1' to `12' and ` 0' to `23' respectivly), +;# and %C for locale long date/time format. Changed &mH to take a +;# pad char parameter to make to evaled code for %i and %k simpler. +;# Added %E for suffixed day-of-month (ie 1st, 3rd, 4th etc). +;# +;# NONE 3.1 16jul92 tmcgonigal +;# Added `%u' format to generate date/time in date(1) required +;# format (ie '%y%m%d%H%M.%S'). +;# +;# NONE 3.2 23jan93 tmcgonigal +;# Added `%f' format to generate space padded month numbers, added +;# `%E' to the header comments, it seems to have been left out (and +;# I'm sure I wanted to use it at some point in the past...). +;# +;# NONE 3.3 03feb93 tmcgonigal +;# Corrected some problems with AM/PM handling pointed out by +;# Michael S. Muegel (mmuegel@mot.com). Thanks Michael, I hope +;# this is the behaviour you were looking for, it seems more +;# correct to me... +;# +;# NONE 3.4 26jul93 tmcgonigal +;# Incorporated some fixes provided by DaviD W. Sanderson +;# (dws@ssec.wisc.edu): February was spelled incorrectly and +;# &wkno() was always using the current year while calculating +;# week numbers, regardless of year implied by the time value +;# passed to &date(). DaviD also contributed an improved &date() +;# test script, thanks DaviD, I appreciate the effort. Finally, +;# changed my mailling address from @gvc.com to @gallium.com +;# to reflect, well, my new address! +;# +;# SccsId = "%W% %E%" +;# +require 'timelocal.pl'; +package date; +X +# Months of the year +@MoY = ('January', 'February', 'March', 'April', 'May', 'June', +X 'July', 'August', 'September','October', 'November', 'December'); +X +# days of the week +@DoW = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', +X 'Thursday', 'Friday', 'Saturday'); +X +# CUSTOMIZE - defaults +$defaultTZ = 'CST'; # time zone (hack!) +$defaultFMT = '%a %h %e %T %z%Y'; # format (ala date(1)) +X +# CUSTOMIZE - `local' formats +$locTF = '%T'; # time (as HH:MM:SS) +$locDF = '%D'; # date (as mm/dd/yy) +$locDTF = '%a %b %d %T %Y'; # date/time (as dow mon dd HH:MM:SS yyyy) +$locLDTF = '%i:%M:%S %p %A %B %E %Y'; # long date/time (as HH:MM:SS a/p day month dom yyyy) +X +# Time zone info +$TZ; # wkno needs this info too +X +# define the known format tags as associative keys with their associated +# replacement strings as values. Each replacement string should be +# an eval-able expresion assigning a value to $rep. These expressions are +# eval-ed, then the value of $rep is substituted into the supplied +# format (if any). +%Tags = ( '%a', q|($rep = $DoW[$wday])=~ s/^(...).*/\1/|, # abbr. weekday name - Sun to Sat +X '%A', q|$rep = $DoW[$wday]|, # full weekday name - Sunday to Saturday +X '%b', q|($rep = $MoY[$mon]) =~ s/^(...).*/\1/|, # abbr. month name - Jan to Dec +X '%B', q|$rep = $MoY[$mon]|, # full month name - January to December +X '%c', q|$rep = $locDTF; 1|, # date/time in local format +X '%C', q|$rep = $locLDTF; 1|, # date/time in local long format +X '%d', q|$rep = &date'pad($mday, 2, "0")|, # day of month - 01 to 31 +X '%D', q|$rep = '%m/%d/%y'|, # date as mm/dd/yy +X '%e', q|$rep = &date'pad($mday, 2, " ")|, # day of month (space padded) ` 1' to `31' +X '%E', q|$rep = &date'dsuf($mday)|, # day of month (w/suffix) `1st' to `31st' +X '%f', q|$rep = &date'pad($mon+1, 2, " ")|, # month of year (space padded) ` 1' to `12' +X '%h', q|$rep = '%b'|, # abbr. month name (same as %b) +X '%H', q|$rep = &date'pad($hour, 2, "0")|, # hour - 00 to 23 +X '%i', q|$rep = &date'ampmH($hour, " ")|, # hour (space padded ` 1' to `12' +X '%I', q|$rep = &date'ampmH($hour, "0")|, # hour - 01 to 12 +X '%j', q|$rep = &date'pad($yday+1, 3, "0")|, # Julian date 001 - 366 +X '%k', q|$rep = &date'pad($hour, 2, " ")|, # hour (space padded) ` 0' to `23' +X '%l', q|$rep = '%b %d ' . &date'ls($year)|, # ls(1) style date +X '%m', q|$rep = &date'pad($mon+1, 2, "0")|, # month of year - 01 to 12 +X '%M', q|$rep = &date'pad($min, 2, "0")|, # minute - 00 to 59 +X '%n', q|$rep = "\n"|, # insert a newline +X '%p', q|$rep = &date'ampmD($hour)|, # insert `AM' or `PM' +X '%r', q|$rep = '%I:%M:%S %p'|, # time in AM/PM notation +X '%R', q|$rep = '%H:%M'|, # time as HH:MM +X '%S', q|$rep = &date'pad($sec, 2, "0")|, # second - 00 to 59 +X '%t', q|$rep = "\t"|, # insert a tab +X '%T', q|$rep = '%H:%M:%S'|, # time as HH:MM:SS +X '%u', q|$rep = '%y%m%d%H%M.%S'|, # daaate/time in date(1) required format +X '%U', q|$rep = &date'wkno($year, $yday, 0)|, # week number (weeks start on Sun) - 00 to 53 +X '%V', q|$rep = '%m%d%H%M%y'|, # SysV touch(1) date-time format (mmddHHMMyy) +X '%w', q|$rep = $wday; 1|, # day of week - Sunday = 0 +X '%W', q|$rep = &date'wkno($year, $yday, 1)|, # week number (weeks start on Mon) - 00 to 53 +X '%x', q|$rep = $locDF; 1|, # date in local format +X '%X', q|$rep = $locTF; 1|, # time in local format +X '%y', q|($rep = $year) =~ s/..(..)/\1/|, # last 2 digits of year - 00 to 99 +X '%Y', q|$rep = "$year"; 1|, # full year ~ 1700 to 2000 odd +X '%z', q|$rep = $TZ eq "" ? "" : "$TZ "|, # time zone from TZ env var (w/trail. space) +X '%Z', q|$rep = $TZ; 1|, # time zone from TZ env. var. +X '%%', q|$rep = '%'; $adv=1|, # insert a `%' +X '%+', q|$rep = '+'| # insert a `+' +); +X +sub main'date { +X local($time, $format) = @_; +X local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); +X local($pos, $tag, $rep, $adv) = (0, "", "", 0); +X +X # default to date/ctime format or strip leading `+'... +X if ($format eq "") { +X $format = $defaultFMT; +X } elsif ($format =~ /^\+/) { +X $format = $'; +X } +X +X # Use local time if can't find a TZ in the environment +X $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ; +X ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = +X &gettime ($TZ, $time); +X +X # Hack to deal with 'PST8PDT' format of TZ +X # Note that this can't deal with all the esoteric forms, but it +X # does recognize the most common: [:]STDoff[DST[off][,rule]] +X if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) { +X $TZ = $isdst ? $4 : $1; +X } +X +X # watch out in 2070... +X $year += ($year < 70) ? 2000 : 1900; +X +X # now loop throught the supplied format looking for tags... +X while (($pos = index ($format, '%')) != -1) { +X +X # grab the format tag +X $tag = substr($format, $pos, 2); +X $adv = 0; # for `%%' processing +X +X # do we have a replacement string? +X if (defined $Tags{$tag}) { +X +X # trap dead evals... +X if (! eval $Tags{$tag}) { +X print STDERR "date.pl: internal error: eval for $tag failed: $@\n"; +X return ""; +X } +X } else { +X $rep = ""; +X } +X +X # do the substitution +X substr ($format, $pos, 2) =~ s/$tag/$rep/; +X $pos++ if ($adv); +X } +X +X $format; +} +X +# dsuf - add `st', `nd', `rd', `th' to a date (ie 1st, 22nd, 29th) +sub dsuf { +X local ($mday) = @_; +X +X return $mday . 'st' if ($mday =~ m/.*1$/); +X return $mday . 'nd' if ($mday =~ m/.*2$/); +X return $mday . 'rd' if ($mday =~ m/.*3$/); +X return $mday . 'th'; +} +X +# weekno - figure out week number +sub wkno { +X local ($year, $yday, $firstweekday) = @_; +X local ($jan1, @jan1, $wks); +X +X # figure out the `time' value for January 1 of the given year +X $jan1 = &maketime ($TZ, 0, 0, 0, 1, 0, $year-1900); +X +X # figure out what day of the week January 1 was +X @jan1= &gettime ($TZ, $jan1); +X +X # and calculate the week number +X $wks = (($yday + ($jan1[6] - $firstweekday)) + 1)/ 7; +X $wks += (($wks - int($wks) > 0.0) ? 1 : 0); +X +X # supply zero padding +X &pad (int($wks), 2, "0"); +} +X +# ampmH - figure out am/pm (1 - 12) mode hour value, padded with $p (0 or ' ') +sub ampmH { local ($h, $p) = @_; &pad($h>12 ? $h-12 : ($h ? $h : 12), 2, $p); } +X +# ampmD - figure out am/pm designator +sub ampmD { shift @_ >= 12 ? "PM" : "AM"; } +X +# gettime - get the time via {local,gmt}time +sub gettime { ((shift @_) eq 'GMT') ? gmtime(shift @_) : localtime(shift @_); } +X +# maketime - make a time via time{local,gmt} +sub maketime { ((shift @_) eq 'GMT') ? &main'timegm(@_) : &main'timelocal(@_); } +X +# ls - generate the time/year portion of an ls(1) style date +sub ls { +X return ((&gettime ($TZ, time))[5] == @_[0]) ? "%R" : " %Y"; +} +X +# pad - pad $in with leading $pad until lenght $len +sub pad { +X local ($in, $len, $pad) = @_; +X local ($out) = "$in"; +X +X $out = $pad . $out until (length ($out) == $len); +X return $out; +} +X +1; +SHAR_EOF +chmod 0444 libs/date.pl || +echo 'restore of libs/date.pl failed' +Wc_c="`wc -c < 'libs/date.pl'`" +test 12339 -eq "$Wc_c" || + echo 'libs/date.pl: original size 12339, current size' "$Wc_c" +fi +# ============= libs/elapsed.pl ============== +if test -f 'libs/elapsed.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/elapsed.pl (File already exists)' +else +echo 'x - extracting libs/elapsed.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/elapsed.pl' && +;# NAME +;# elapsed.pl - convert seconds to elapsed time format +;# +;# AUTHOR +;# Michael S. Muegel +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/elapsed.pl,v +;# 1.1 of 1993/07/28 08:07:19 +X +package elapsed; +X +# Time field types +$DAYS = 1; +$HOURS = 2; +$MINUTES = 3; +$SECONDS = 4; +X +# The array contains four records each with four fields. The fields are, +# in order: +# +# Type Specifies what kind of time field this is. Once of +# $DAYS, $HOURS, $MINUTES, or $SECONDS. +# +# Multiplier Specifies what time field this is via the minimum +# number of seconds this time field may specify. For +# example, the minutes field would be non-zero +# when there are 60 or more seconds. +# +# Separator How to separate this time field from the next +# *greater* field. +# +# Format sprintf() format specifier on how to print this +# time field. +@MULT_AND_SEPS = ($DAYS, 60 * 60 * 24, "+", "%d", +X $HOURS, 60 * 60, ":", "%d", +X $MINUTES, 60, ":", "%02d", +X $SECONDS, 1, "", "%02d" +X ); +X +;############################################################################### +;# Seconds_To_Elapsed +;# +;# Coverts a seconds count to form [d+]h:mm:ss. If $Collapse +;# is true then the result is compacted somewhat. The string returned +;# will be of the form [d+][[h:]mm]:ss. +;# +;# Arguments: +;# $Seconds, $Collapse +;# +;# Examples: +;# &Seconds_To_Elapsed (0, 0) -> 0:00:00 +;# &Seconds_To_Elapsed (0, 1) -> :00 +;# +;# &Seconds_To_Elapsed (119, 0) -> 0:01:59 +;# &Seconds_To_Elapsed (119, 1) -> 01:59 +;# +;# &Seconds_To_Elapsed (3601, 0) -> 1:00:01 +;# &Seconds_To_Elapsed (3601, 1) -> 1:00:01 +;# +;# &Seconds_To_Elapsed (86401, 0) -> 1+0:00:01 +;# &Seconds_To_Elapsed (86401, 1) -> 1+:01 +;# +;# Returns: +;# $Elapsed +;############################################################################### +sub main'Seconds_To_Elapsed +{ +X local ($Seconds, $Collapse) = @_; +X local ($Type, $Multiplier, @Multipliers, $Separator, $DHMS_Used, +X $Elapsed, @Mult_And_Seps, $Print_Field); +X +X $Multiplier = 1; +X @Mult_And_Seps = @MULT_AND_SEPS; +X +X # Keep subtracting the number of seconds corresponding to a time field +X # from the number of seconds passed to the function. +X while (1) +X { +X ($Type, $Multiplier, $Separator, $Format) = splice (@Mult_And_Seps, 0, 4); +X last if (! $Multiplier); +X $Seconds -= $DHMS_Used * $Multiplier +X if ($DHMS_Used = int ($Seconds / $Multiplier)); +X +X # Figure out if we should print this field +X if ($Type == $DAYS) +X { +X $Print_Field = $DHMS_Used; +X } +X +X elsif ($Collapse) +X { +X if ($Type == $HOURS) +X { +X $Print_Field = $DHMS_Used; +X } +X elsif ($Type == $MINUTES) +X { +X $Print_Field = $DHMS_Used || $Printed_Field {$HOURS}; +X } +X else +X { +X $Format = ":%02d" +X if (! $Printed_Field {$MINUTES}); +X $Print_Field = 1; +X }; +X } +X +X else +X { +X $Print_Field = 1; +X }; +X +X $Printed_Field {$Type} = $Print_Field; +X $Elapsed .= sprintf ("$Format%s", $DHMS_Used, $Separator) +X if ($Print_Field); +X }; +X +X return ($Elapsed); +}; +X +1; +SHAR_EOF +chmod 0444 libs/elapsed.pl || +echo 'restore of libs/elapsed.pl failed' +Wc_c="`wc -c < 'libs/elapsed.pl'`" +test 3198 -eq "$Wc_c" || + echo 'libs/elapsed.pl: original size 3198, current size' "$Wc_c" +fi +# ============= libs/mail.pl ============== +if test -f 'libs/mail.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/mail.pl (File already exists)' +else +echo 'x - extracting libs/mail.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/mail.pl' && +;# NAME +;# mail.pl - perl function(s) to handle mail processing +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/mail.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp +X +package mail; +X +# Mailer statement to eval. $Users, $Subject, and $Verbose are substituted +# via eval +$BIN_MAILER = "/usr/ucb/mail \$Verbose -s '\$Subject' \$Users"; +X +# Sendmail command to use when $Use_Sendmail is true. +$SENDMAIL = '/usr/lib/sendmail $Verbose $Users'; +X +;############################################################################### +;# Send_Mail +;# +;# Sends $Message to $Users with a subject of $Subject. If $Message_Is_File +;# is true then $Message is assumed to be a filename pointing to the mail +;# message. This is a new option and thus the backwards-compatible hack. +;# $Users should be a space separated list of mail-ids. +;# +;# If everything went OK $Status will be 1 and $Error_Msg can be ignored; +;# otherwise, $Status will be 0 and $Error_Msg will contain an error message. +;# +;# If $Use_Sendmail is 1 then sendmail is used to send the message. Normally +;# a mailer such as Mail is used. By specifiying this you can include +;# headers in addition to text in either $Message or $Message_Is_File. +;# If either $Message or $Message_Is_File contain a Subject: header then +;# $Subject is ignored; otherwise, a Subject: header is automatically created. +;# Similar to the Subject: header, if a To: header does not exist one +;# is automatically created from the $Users argument. The mail is still +;# sent, however, to the recipients listed in $Users. This is keeping with +;# normal sendmail usage (header vs. envelope). +;# +;# In both bin mailer and sendmail modes $Verbose will turn on verbose mode +;# (normally just sendmail verbose mode output). +;# +;# Arguments: +;# $Users, $Subject, $Message, $Message_Is_File, $Verbose, $Use_Sendmail +;# +;# Returns: +;# $Status, $Error_Msg +;############################################################################### +sub main'Send_Mail +{ +X local ($Users, $Subject, $Message, $Message_Is_File, $Verbose, +X $Use_Sendmail) = @_; +X local ($BIN_MAILER_HANDLE, $Mailer_Command, $Header_Found, %Header_Map, +X $Header_Extra, $Mailer); +X +X # If the message is contained in a file read it in so we can have one +X # consistent interface +X if ($Message_Is_File) +X { +X undef $/; +X $Message_Is_File = 0; +X open (Message) || return (0, "error reading $Message: $!"); +X $Message = ; +X close (Message); +X }; +X +X # If sendmail mode see if we need to add some headers +X if ($Use_Sendmail) +X { +X # Determine if a header block is included in the message and what headers +X # are there +X foreach (split (/\n/, $Message)) +X { +X last if ($_ eq ""); +X $Header_Found = $Header_Map {$1} = 1 if (/^([A-Z]\S*): /); +X }; +X +X # Add some headers? +X if (! $Header_Map {"To"}) +X { +X $Header_Extra .= "To: " . join (", ", $Users) . "\n"; +X }; +X if (($Subject ne "") && (! $Header_Map {"Subject"})) +X { +X $Header_Extra .= "Subject: $Subject\n"; +X }; +X +X # Add the required blank line between header/body if there where no +X # headers to begin with +X if ($Header_Found) +X { +X $Message = "$Header_Extra$Message"; +X } +X else +X { +X $Message = "$Header_Extra\n$Message"; +X }; +X }; +X +X # Get a string that is the mail command +X $Verbose = ($Verbose) ? "-v" : ""; +X $Mailer = ($Use_Sendmail) ? $SENDMAIL : $BIN_MAILER; +X eval "\$Mailer = \"$Mailer\""; +X return (0, "error setting \$Mailer: $@") if ($@); +X +X # need to catch SIGPIPE in case the $Mailer call fails +X $SIG {'PIPE'} = "mail'Cleanup"; +X +X # Open mailer +X return (0, "can not open mail program: $Mailer") if (! open (MAILER, "| $Mailer")); +X +X # Send off the mail! +X print MAILER $Message; +X close (MAILER); +X return (0, "error running mail program: $Mailer") if ($?); +X +X # Everything must have went AOK +X return (1); +}; +X +;############################################################################### +;# Cleanup +;# +;# Simply here so we can catch SIGPIPE and not exit. +;# +;# Globals: +;# None +;# +;# Arguments: +;# None +;# +;# Returns: +;# Nothing exciting +;############################################################################### +sub Cleanup +{ +}; +X +1; +SHAR_EOF +chmod 0444 libs/mail.pl || +echo 'restore of libs/mail.pl failed' +Wc_c="`wc -c < 'libs/mail.pl'`" +test 4356 -eq "$Wc_c" || + echo 'libs/mail.pl: original size 4356, current size' "$Wc_c" +fi +# ============= libs/mqueue.pl ============== +if test -f 'libs/mqueue.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/mqueue.pl (File already exists)' +else +echo 'x - extracting libs/mqueue.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/mqueue.pl' && +;# NAME +;# mqueue.pl - functions to work with the sendmail queue +;# +;# DESCRIPTION +;# Both Get_Queue_IDs and Parse_Control_File are available to get +;# information about the sendmail queue. The cqueue program is a good +;# example of how these functions work. +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/mqueue.pl,v +;# 1.1 of 1993/07/28 08:07:19 +X +package mqueue; +X +;############################################################################### +;# Get_Queue_IDs +;# +;# Will figure out the queue IDs in $Queue that have both control and data +;# files. They are returned in @Valid_IDs. Those IDs that have a +;# control file and no data file are saved to the array globbed by +;# *Missing_Control_IDs. Likewise, those IDs that have a data file and no +;# control file are saved to the array globbed by *Missing_Data_IDs. +;# +;# If $Skip_Locked is true they a message that has a lock file is skipped +;# and will not show up in any of the arrays. +;# +;# If everything went AOK then $Status is 1; otherwise, $Status is 0 and +;# $Msg tells what went wrong. +;# +;# Globals: +;# None +;# +;# Arguments: +;# $Queue, $Skip_Locked, *Missing_Control_IDs, *Missing_Data_IDs +;# +;# Returns: +;# $Status, $Msg, @Valid_IDs +;############################################################################### +sub main'Get_Queue_IDs +{ +X local ($Queue, $Skip_Locked, *Missing_Control_IDs, +X *Missing_Data_IDs) = @_; +X local (*QUEUE, @Files, %Lock_IDs, %Data_IDs, %Control_IDs, $_); +X +X # Make sure that the * argument @arrays ar empty +X @Missing_Control_IDs = @Missing_Data_IDs = (); +X +X # Save each data, lock, and queue file in @Files +X opendir (QUEUE, $Queue) || return (0, "error getting directory listing of $Queue"); +X @Files = grep (/^(df|lf|qf)/, readdir (QUEUE)); +X closedir (QUEUE); +X +X # Create indexed list of data and control files. IF $Skip_Locked is true +X # then skip either if there is a lock file present. +X if ($Skip_Locked) +X { +X grep ((s/^lf//) && ($Lock_IDs {$_} = 1), @Files); +X grep ((s/^df//) && (! $Lock_IDs {$_}) && ($Data_IDs {$_} = 1), @Files); +X grep ((s/^qf//) && (! $Lock_IDs {$_}) && ($Control_IDs {$_} = 1), @Files); +X } +X else +X { +X grep ((s/^df//) && ($Data_IDs {$_} = 1), @Files); +X grep ((s/^qf//) && ($Control_IDs {$_} = 1), @Files); +X }; +X +X # Find missing control and data files and remove them from the lists of each +X @Missing_Control_IDs = sort (grep ((! $Control_IDs {$_}) && (delete $Data_IDs {$_}), keys (%Data_IDs))); +X @Missing_Data_IDs = sort (grep ((! $Data_IDs {$_} && (delete $Control_IDs {$_})), keys (%Control_IDs))); +X +X +X # Return the IDs in an appartently random order +X return (1, "", keys (%Control_IDs)); +}; +X +X +;############################################################################### +;# Parse_Control_File +;# +;# Will pase a sendmail queue control file for useful information. See the +;# Sendmail Installtion and Operation Guide (SMM:07) for a complete +;# explanation of each field. +;# +;# The following globbed variables are set (or cleared) by this function: +;# +;# $Sender The sender's address. +;# +;# @Recipients One or more addresses for the recipient of the mail. +;# +;# @Errors_To One or more addresses for addresses to which mail +;# delivery errors should be sent. +;# +;# $Creation_Time The job creation time in time(3) format. That is, +;# seconds since 00:00:00 GMT 1/1/70. +;# +;# $Priority An integer representing the current message priority. +;# This is used to order the queue. Higher numbers mean +;# lower priorities. +;# +;# $Status_Message The status of the mail message. It can contain any +;# text. +;# +;# @Headers Message headers unparsed but in their original order. +;# Headers that span multiple lines are not mucked with, +;# embedded \ns will be evident. +;# +;# In all e-mail addresses bounding <> pairs are stripped. +;# +;# If everything went AOK then $Status is 1. If the message with queue ID +;# $Queue_ID just does not exist anymore -1 is returned. This is very +;# possible and should be allowed for. Otherwise, $Status is 0 and $Msg +;# tells what went wrong. +;# +;# Globals: +;# None +;# +;# Arguments: +;# $Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time, +;# *Priority, *Status_Message, *Headers +;# +;# Returns: +;# $Status, $Msg +;############################################################################### +sub main'Parse_Control_File +{ +X local ($Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time, +X *Priority, *Status_Message, *Headers) = @_; +X local (*Control, $_, $Not_Empty); +X +X # Required variables and the associated control. If empty at the end of +X # parsing we return a bad status. +X @REQUIRED_INFO = ('$Creation_Time', 'T', '$Sender', 'S', '@Recipients', 'R', +X '$Priority', 'P'); +X +X # Open up the control file for read +X $Control = "$Queue/qf$Queue_ID"; +X if (! open (Control)) +X { +X return (-1) if ((-x $Queue) && (! -f "$Queue/qf$Queue_ID") && +X (! -f "$Queue/df$Queue_ID")); +X return (0, "error opening $Control for read: $!"); +X }; +X +X # Reset the globbed variables just in case +X $Sender = $Creation_Time = $Priority = $Status_Message = ""; +X @Recipients = @Errors_To = @Headers = (); +X +X # Look for a few things in the control file +X READ: while () +X { +X $Not_Empty = 1; +X chop; +X +X PARSE: +X { +X if (/^T(\d+)$/) +X { +X $Creation_Time = $1; +X } +X elsif (/^S(<)?([^>]+)/) +X { +X $Sender = $2; +X } +X elsif (/^R(<)?([^>]+)/) +X { +X push (@Recipients, $2); +X } +X elsif (/^E(<)?([^>]+)/) +X { +X push (@Errors_To, $2); +X } +X elsif (/^M(.*)/) +X { +X $Status_Message = $1; +X } +X elsif (/^P(\d+)$/) +X { +X $Priority = $1; +X } +X elsif (/^H(.*)/) +X { +X $Header = $1; +X while () +X { +X chop; +X last if (/^[A-Z]/); +X $Header .= "\n$_"; +X }; +X push (@Headers, $Header); +X redo PARSE if ($_); +X last if (eof); +X }; +X }; +X }; +X +X # If the file was empty scream bloody murder +X return (0, "empty control file") if (! $Not_Empty); +X +X # Yell if we could not find a required field +X while (($Var, $Control) = splice (@REQUIRED_INFO, 0, 2)) +X { +X eval "return (0, 'required control field $Control not found') +X if (! $Var)"; +X return (0, "error checking \$Var: $@") if ($@); +X }; +X +X # Everything went AOK +X return (1); +}; +X +1; +SHAR_EOF +chmod 0444 libs/mqueue.pl || +echo 'restore of libs/mqueue.pl failed' +Wc_c="`wc -c < 'libs/mqueue.pl'`" +test 6908 -eq "$Wc_c" || + echo 'libs/mqueue.pl: original size 6908, current size' "$Wc_c" +fi +# ============= libs/newgetopts.pl ============== +if test -f 'libs/newgetopts.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/newgetopts.pl (File already exists)' +else +echo 'x - extracting libs/newgetopts.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/newgetopts.pl' && +;# NAME +;# newgetopts.pl - a better newgetopt (which is a better getopts which is +;# a better getopt ;-) +;# +;# AUTHOR +;# Mike Muegel (mmuegel@mot.com) +;# +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/newgetopts.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp +X +;############################################################################### +;# New_Getopts +;# +;# Does not care about order of switches, options, and arguments like +;# getopts.pl. Thus all non-switches/options will be kept in ARGV even if they +;# are not at the end. If $Pass_Invalid is set all unkown options will be +;# passed back to the caller by keeping them in @ARGV. This is useful when +;# parsing a command line for your script while ignoring options that you +;# may pass to another script. If this is set New_Getopts tries to maintain +;# the switch clustering on the unkown switches. +;# +;# Accepts the special argument -usage to print the Usage string. Also accepts +;# the special option -version which prints the contents of the string +;# $VERSION. $VERSION may or may not have an embeded \n in it. If -usage +;# or -version are specified a status of -1 is returned. Note that the usage +;# option is only accepted if the usage string is not null. +;# +;# $Switches is just like the formal arguemnt of getopts.pl. $Usage is a usage +;# string with or without a trailing \n. *Switch_To_Order is an optional +;# pointer to the name of an associative array which will contain a mapping of +;# switch names to the order in which (if at all) the argument was entered. +;# +;# For example, if @ARGV contains -v, -x, test: +;# +;# $Switch_To_Order {"v"} = 1; +;# $Switch_To_Order {"x"} = 2; +;# +;# Note that in the case of multiple occurances of an option $Switch_To_Order +;# will store each occurance of the argument via a string that emulates +;# an array. This is done by using join ($;, ...). You can retrieve the +;# array by using split (/$;/, ...). +;# +;# *Split_ARGV is an optional pointer to an array which will conatin the +;# original switches along with their values. For the example used above +;# Split_ARGV would contain: +;# +;# @Split_ARGV = ("v", "", "x", "test"); +;# +;# Another exciting ;-) feature that newgetopts has. Along with creating the +;# normal $opt_ scalars for the last value of an argument the list @opt_ is +;# created. It is an array which contains all the values of arguments to the +;# basename of the variable. They are stored in the order which they occured +;# on the command line starting with $[. Note that blank arguments are stored +;# as "". Along with providing support for multiple options on the command +;# line this also provides a method of counting the number of times an option +;# was specified via $#opt_. +;# +;# Automatically resets all $opt_, @opt_, %Switch_To_Order, and @Split_ARGV +;# variables so that New_Getopts may be called more than once from within +;# the same program. Thus, if $opt_v is set upon entry to New_Getopts and +;# -v is not in @ARGV $opt_v will not be set upon exit. +;# +;# Arguments: +;# $Switches, $Usage, $Pass_Invalid, *Switch_To_Order, *Split_ARGV +;# +;# Returns: +;# -1, 0, or 1 depending on status (printed Usage/Version, OK, not OK) +;############################################################################### +sub New_Getopts +{ +X local($taint_argumentative, $Usage, $Pass_Invalid, *Switch_To_Order, +X *Split_ARGV) = @_; +X local(@args,$_,$first,$rest,$errs, @leftovers, @current_leftovers, +X %Switch_Found); +X local($[, $*, $Script_Name, $argumentative); +X +X # Untaint the argument cluster so that we can use this with taintperl +X $taint_argumentative =~ /^(.*)$/; +X $argumentative = $1; +X +X # Clear anything that might still be set from a previous New_Getopts +X # call. +X @Split_ARGV = (); +X +X # Get the basename of the calling script +X ($Script_Name = $0) =~ s/.*\///; +X +X # Make Usage have a trailing \n +X $Usage .= "\n" if ($Usage !~ /\n$/); +X +X @args = split( / */, $argumentative ); +X +X # Clear anything that might still be set from a previous New_Getopts call. +X foreach $first (@args) +X { +X next if ($first eq ":"); +X delete $Switch_Found {$first}; +X delete $Switch_To_Order {$first}; +X eval "undef \@opt_$first; undef \$opt_$first;"; +X }; +X +X while (@ARGV) +X { +X # Let usage through +X if (($ARGV[0] eq "-usage") && ($Usage ne "\n")) +X { +X print $Usage; +X exit (-1); +X } +X +X elsif ($ARGV[0] eq "-version") +X { +X if ($VERSION) +X { +X print $VERSION; +X print "\n" if ($VERSION !~ /\n$/); +X } +X else +X { +X warn "${Script_Name}: no version information available, sorry\n"; +X } +X exit (-1); +X } +X +X elsif (($_ = $ARGV[0]) =~ /^-(.)(.*)/) +X { +X ($first,$rest) = ($1,$2); +X $pos = index($argumentative,$first); +X +X $Switch_To_Order {$first} = join ($;, split (/$;/, $Switch_To_Order {$first}), ++$Order); +X +X if($pos >= $[) +X { +X if($args[$pos+1] eq ':') +X { +X shift(@ARGV); +X if($rest eq '') +X { +X $rest = shift(@ARGV); +X } +X +X eval "\$opt_$first = \$rest;"; +X eval "push (\@opt_$first, \$rest);"; +X push (@Split_ARGV, $first, $rest); +X } +X else +X { +X eval "\$opt_$first = 1"; +X eval "push (\@opt_$first, '');"; +X push (@Split_ARGV, $first, ""); +X +X if($rest eq '') +X { +X shift(@ARGV); +X } +X else +X { +X $ARGV[0] = "-$rest"; +X } +X } +X } +X +X else +X { +X # Save any other switches if $Pass_Valid +X if ($Pass_Invalid) +X { +X push (@current_leftovers, $first); +X } +X else +X { +X warn "${Script_Name}: unknown option: $first\n"; +X ++$errs; +X }; +X if($rest ne '') +X { +X $ARGV[0] = "-$rest"; +X } +X else +X { +X shift(@ARGV); +X } +X } +X } +X +X else +X { +X push (@leftovers, shift (@ARGV)); +X }; +X +X # Save any other switches if $Pass_Valid +X if ((@current_leftovers) && ($rest eq '')) +X { +X push (@leftovers, "-" . join ("", @current_leftovers)); +X @current_leftovers = (); +X }; +X }; +X +X # Automatically print Usage if a warning was given +X @ARGV = @leftovers; +X if ($errs != 0) +X { +X warn $Usage; +X return (0); +X } +X else +X { +X return (1); +X } +X +} +X +1; +SHAR_EOF +chmod 0444 libs/newgetopts.pl || +echo 'restore of libs/newgetopts.pl failed' +Wc_c="`wc -c < 'libs/newgetopts.pl'`" +test 7024 -eq "$Wc_c" || + echo 'libs/newgetopts.pl: original size 7024, current size' "$Wc_c" +fi +# ============= libs/strings1.pl ============== +if test -f 'libs/strings1.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/strings1.pl (File already exists)' +else +echo 'x - extracting libs/strings1.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/strings1.pl' && +;# NAME +;# strings1.pl - FUN with strings #1 +;# +;# NOTES +;# I wrote Format_Text_Block when I just started programming Perl so +;# it is probably not very Perlish code. Center is more like it :-). +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/strings1.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp +X +package strings1; +X +;###############################################################################;# Center +;# +;# Center $Text assuming the output should be $Columns wide. $Text can span +;# multiple lines, of course :-). Lines within $Text that contain only +;# whitespace are not centered and are instead collapsed. This may save time +;# when printing them later. +;# +;# Arguments: +;# $Text, $Columns +;# +;# Returns: +;# $Centered_Text +;############################################################################### +sub main'Center +{ +X local ($_, $Columns) = @_; +X local ($*) = 1; +X +X s@^(.*)$@" " x (($Columns - length ($1)) / 2) . $1@eg; +X s/^[\t ]*$//g; +X return ($_); +}; +X +;############################################################################### +;# Format_Text_Block +;# +;# Formats a text string to be printed to the display or other similar device. +;# Text in $String will be fomratted such that the following hold: +;# +;# + $String contains the (possibly) multi-line text to print. It is +;# automatically word-wrapped to fit in $Columns. +;# +;# + \n'd are maintained and are not folded. +;# +;# + $Offset is pre-pended before each separate line of text. +;# +;# + If $Offset_Once is $TRUE $Offset will only appear on the first line. +;# All other lines will be indented to match the amount of whitespace of +;# $Offset. +;# +;# + If $Bullet_Indent is $TRUE $Offset will only be applied to the begining +;# of lines as they occured in the original $String. Lines that are created +;# by this routine will always be indented by blank spaces. +;# +;# + If $Columns is 0 no word-wrap is done. This might be useful to still +;# to offset each line in a buffer. +;# +;# + If $Split_Expr is supplied the string is split on it. If not supplied +;# the string is split on " \t\/\-\,\." by default. +;# +;# + If $Offset_Blank is $TRUE then empty lines will have $Offset pre-pended +;# to them. Otherwise, they will still empty. +;# +;# This is a realy workhorse routine that I use in many places because of its +;# veratility. +;# +;# Arguments: +;# $String, $Offset, $Offset_Once, $Bullet_Indent, $Columns, $Split_Expr, +;# $Offset_Blank +;# +;# Returns: +;# $Buffer +;############################################################################### +sub main'Format_Text_Block +{ +X local ($String, $Real_Offset, $Offset_Once, $Bullet_Indent, $Columns, +X $Split_Expr, $Offset_Blank) = @_; +X +X local ($New_Line, $Line, $Chars_Per_Line, $Space_Offset, $Buffer, +X $Next_New_Line, $Num_Lines, $Num_Offsets, $Offset); +X local ($*) = 0; +X local ($BLANK_TAG) = "__FORMAT_BLANK__"; +X local ($Blank_Offset) = $Real_Offset if ($Offset_Blank); +X +X # What should we split on? +X $Split_Expr = " \\t\\/\\-\\,\\." if (! $Split_Expr); +X +X # Pre-process the string - convert blank lines to __FORMAT_BLANK__ sequence +X $String =~ s/\n\n/\n$BLANK_TAG\n/g; +X $String =~ s/^\n/$BLANK_TAG\n/g; +X $String =~ s/\n$/\n$BLANK_TAG/g; +X +X # If bad $Columns/$Offset combo or no $Columns make a VERRRYYY wide $Column +X $Offset = $Real_Offset; +X $Chars_Per_Line = 16000 if (($Chars_Per_Line = $Columns - length ($Offset)) <= 0); +X $Space_Offset = " " x length ($Offset); +X +X # Get a buffer +X foreach $Line (split ("\n", $String)) +X { +X $Offset = $Real_Offset if ($Bullet_Indent); +X +X # Find where to split the line +X if ($Line ne $BLANK_TAG) +X { +X $New_Line = ""; +X while ($Line =~ /^([$Split_Expr]*)([^$Split_Expr]+)/) +X { +X if (length ("$New_Line$&") >= $Chars_Per_Line) +X { +X $Next_New_Line = $+; +X $New_Line = "$Offset$New_Line$1"; +X $Buffer .= "\n" if ($Num_Lines++); +X $Buffer .= $New_Line; +X $Offset = $Space_Offset if (($Offset) && ($Offset_Once)); +X $New_Line = $Next_New_Line; +X ++$Num_Lines; +X } +X else +X { +X $New_Line .= $&; +X }; +X $Line = $'; +X }; +X +X $Buffer .= "\n" if ($Num_Lines++); +X $Buffer .= "$Offset$New_Line$Line"; +X $Offset = $Space_Offset if (($Offset) && ($Offset_Once)); +X } +X +X else +X { +X $Buffer .= "\n$Blank_Offset"; +X }; +X }; +X +X return ($Buffer); +X +}; +X +1; +SHAR_EOF +chmod 0444 libs/strings1.pl || +echo 'restore of libs/strings1.pl failed' +Wc_c="`wc -c < 'libs/strings1.pl'`" +test 4687 -eq "$Wc_c" || + echo 'libs/strings1.pl: original size 4687, current size' "$Wc_c" +fi +# ============= libs/timespec.pl ============== +if test -f 'libs/timespec.pl' -a X"$1" != X"-c"; then + echo 'x - skipping libs/timespec.pl (File already exists)' +else +echo 'x - extracting libs/timespec.pl (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'libs/timespec.pl' && +;# NAME +;# timespec.pl - convert a pre-defined time specifyer to seconds +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/timespec.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp +X +package timespec; +X +%TIME_SPEC_TO_SECONDS = ("s", 1, +X "m", 60, +X "h", 60 * 60, +X "d", 60 * 60 * 24 +X ); +X +$VALID_TIME_SPEC_EXPR = "[" . join ("", keys (%TIME_SPEC_TO_SECONDS)) . "]"; +X +;############################################################################### +;# Time_Spec_To_Seconds +;# +;# Converts a string of the form: +;# +;# ((s|m|h|d))+ +;# +;# to seconds. The second part of the time spec specifies seconds, minutes, +;# hours, or days, respectfully. The first part is the number of those untis. +;# There can be any number of such specifiers. As an example, 1h30m means 1 +;# hour and 30 minutes. +;# +;# If the parsing went OK then $Status is 1, $Msg is undefined, and $Seconds +;# is $Time_Spec converted to seconds. If something went wrong then $Status +;# is 0 and $Msg explains what went wrong. +;# +;# Arguments: +;# $Time_Spec +;# +;# Returns: +;# $Status, $Msg, $Seconds +;############################################################################### +sub main'Time_Spec_To_Seconds +{ +X $Time_Spec = $_[0]; +X +X $Seconds = 0; +X while ($Time_Spec =~ /^(\d+)($VALID_TIME_SPEC_EXPR)/) +X { +X $Seconds += $1 * $TIME_SPEC_TO_SECONDS {$2}; +X $Time_Spec = $'; +X }; +X +X return (0, "error parsing time spec: $Time_Spec") if ($Time_Spec ne ""); +X return (1, "", $Seconds); +X +}; +X +X +1; +SHAR_EOF +chmod 0444 libs/timespec.pl || +echo 'restore of libs/timespec.pl failed' +Wc_c="`wc -c < 'libs/timespec.pl'`" +test 1609 -eq "$Wc_c" || + echo 'libs/timespec.pl: original size 1609, current size' "$Wc_c" +fi +# ============= man/cqueue.1 ============== +if test ! -d 'man'; then + echo 'x - creating directory man' + mkdir 'man' +fi +if test -f 'man/cqueue.1' -a X"$1" != X"-c"; then + echo 'x - skipping man/cqueue.1 (File already exists)' +else +echo 'x - extracting man/cqueue.1 (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'man/cqueue.1' && +.TH CQUEUE 1L +\" +\" mmuegel +\" /usr/local/ustart/src/mail-tools/dist/foo/man/cqueue.1,v 1.1 1993/07/28 08:08:25 mmuegel Exp +\" +.ds mp \fBcqueue\fR +.de IB +.IP \(bu 2 +.. +.SH NAME +\*(mp - check sendmail queue for problems +.SH SYNOPSIS +.IP \*(mp 7 +[ \fB-abdms\fR ] [ \fB-q\fR \fIqueue-dir\fI ] [ \fB-t\fR \fItime\fR ] +[ \fB-u\fR \fIusers\fR ] [ \fB-w\fR \fIwidth\fR ] +.SH DESCRIPTION +Reports on problems in the sendmail queue. With no options this simply +means listing messages that have been in the queue longer than a default +period along with a summary of queue mail by host and status message. +.SH OPTIONS +.IP \fB-a\fR 14 +Report on all messages in the queue. This is equivalent to saying \fB-t\fR 0s. +You may like this command so much that you use it as a replacement for +\fBmqueue\fR. For example: +.sp 1 +.RS +.RS +\fBalias mqueue cqueue -a\fR +.RE +.RE +.IP \fB-b\fR 14 +Also report on bogus queue files. Those are files that +have data files and no control files or vice versa. +.IP \fB-d\fR +Print a detailed report of mail messages that have been queued longer than +the specified or default time. Information that is presented includes: +.RS +.RS +.IB +Sendmail queue identifier. +.IB +Date the message was first queued. +.IB +Sender of the message. +.IB +One or more recipients of the message. +.IB +An optional status of the message. This usually indicates why the message +has not been delivered. +.RE +.RE +.IP \fB-m\fR 14 +Mail off the results if any problems were found. +Normaly results are printed to stdout. If this option +is specified they are mailed to one or more users. Results +are not printed to stdout in this case. Results are \fBonly\fR +mailed if \*(mp found something wrong. +.IP "\fB-q\fR \fIqueue-dir\fI" +The sendmail mail queue directory. Default is \fB/usr/spool/mqueue\fR or +some other site configured value. +.IP "\fB-t\fR \fItime\fR" +List messages that have been in the queue longer than +\fItime\fR. Time should of the form: +.sp 1 +.RS +.RS +((s|m|h|d))+ +.sp 1 +.RE +.RE +.RS 14 +The second portion of the above definition +specifies seconds, minutes, hours, or +days, respectfully. The first portion is the number of +those units. There can be any number of such specifiers. +As an example, 1h30m means 1 hour and 30 minutes. +.sp 1 +The default is 2 hours. +.RE +.IP \fB-s\fR 14 +Print a summary of messages that have been queued longer than +the specified or default time. Two separate types of summaries are printed. +The first summarizes the queue messages by destination host. The host name +is gleaned from the recipient addresses for each message. +Thus the actual host names for this summary should be taken with a grain +of salt since ruleset 0 has not been applied to the address the host was +taken from nor were MX records consulted. It would be possible to add +this; however, the execution time of the script would increase +dramatically. The second summary is by status message. +.IP "\fB-u\fR \fIusers\fR" +Specify list of users to send a mail report to other than +the invoker. This option is only valid when \fB-m\fR has been +specified. Multiple recipients may be separated by spaces. +.IP "\fB-w\fR \fIwidth\fR" +Specify the page width to which the output should tailored. \fIwidth\fR +should be an integer representing some character position. The default is +80 or some other site configured value. Output is folded neatly to match +\fIwidth\fR. +.SH EXAMPLES +.nf +% \fBdate\fR +Tue Jan 19 12:07:20 CST 1993 +X +% \fBcqueue -t 21h45m -w 70\fR +X +Summary of messages in queue longer than 21:45:00 by destination +host: +X +X Number of +X Messages Destination Host +X --------- ---------------- +X 2 cigseg.rtsg.mot.com +X 1 mnesouth.corp.mot.com +X --------- +X 3 +X +Summary of messages in queue longer than 21:45:00 by status message: +X +X Number of +X Messages Status Message +X --------- -------------- +X 1 Deferred: Connection refused by mnesouth.corp.mot.com +X 2 Deferred: Host Name Lookup Failure +X --------- +X 3 +X +Detail of messages in queue longer than 21:45:00 sorted by creation +date: +X +X ID: AA20573 +X Date: 02:09:27 PM 01/18/93 +X Sender: melrose-place-owner@ferkel.ucsb.edu +X Recipient: pbaker@cigseg.rtsg.mot.com +X Status: Deferred: Host Name Lookup Failure +X +X ID: AA20757 +X Date: 02:11:30 PM 01/18/93 +X Sender: 90210-owner@ferkel.ucsb.edu +X Recipient: pbaker@cigseg.rtsg.mot.com +X Status: Deferred: Host Name Lookup Failure +X +X ID: AA21110 +X Date: 02:17:01 PM 01/18/93 +X Sender: rd_lap_wg@mdd.comm.mot.com +X Recipient: jim_mathis@mnesouth.corp.mot.com +X Status: Deferred: Connection refused by mnesouth.corp.mot.com +.fi +.SH AUTHOR +.nf +Michael S. Muegel (mmuegel@mot.com) +UNIX Applications Startup Group +Corporate Information Office, Schaumburg, IL +Motorola, Inc. +.fi +.SH COPYRIGHT NOTICE +Copyright 1993, Motorola, Inc. +.sp 1 +Permission to use, copy, modify and distribute without charge this +software, documentation, etc. is granted, provided that this +comment and the author's name is retained. The author nor Motorola assume any +responsibility for problems resulting from the use of this software. +.SH SEE ALSO +.nf +\fBsendmail(8)\fR +\fISendmail Installation and Operation Guide\fR. +.fi +SHAR_EOF +chmod 0444 man/cqueue.1 || +echo 'restore of man/cqueue.1 failed' +Wc_c="`wc -c < 'man/cqueue.1'`" +test 5212 -eq "$Wc_c" || + echo 'man/cqueue.1: original size 5212, current size' "$Wc_c" +fi +# ============= man/postclip.1 ============== +if test -f 'man/postclip.1' -a X"$1" != X"-c"; then + echo 'x - skipping man/postclip.1 (File already exists)' +else +echo 'x - extracting man/postclip.1 (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'man/postclip.1' && +.TH POSTCLIP 1L +\" +\" mmuegel +\" /usr/local/ustart/src/mail-tools/dist/foo/man/postclip.1,v 1.1 1993/07/28 08:08:25 mmuegel Exp +\" +.ds mp \fBpostclip\fR +.SH NAME +\*(mp - send only the headers to Postmaster +.SH SYNOPSIS +\*(mp [ \fB-v\fR ] [ \fIto\fR ... ] +.SH DESCRIPTION +\*(mp will forward non-delivery reports to a postmaster after deleting the body +of the message. This keeps bounced mail private and helps to avoid disk space problems. \*(mp tries its best to keep as much of the header trail as possible. +Hopefully only the original body of the message will be filtered. Only messages +that have a subject that begins with 'Returned mail:' are filtered. This +ensures that other mail is not accidently mucked with. Finally, note that +\fBsendmail\fR is used to deliver the message after it has been (possibly) +filtered. All of the original headers will remain intact. +.sp 1 +You can use this with any \fBsendmail\fR by modifying the Postmaster alias. +If you use IDA \fBsendmail\fR you could add the following to .m4: +.sp 1 +.RS +define(POSTMASTERBOUNCE, mailer-errors) +.RE +.sp 1 +In the aliases file, add a line similar to the following: +.sp 1 +.RS +mailer-errors: "|/usr/local/bin/postclip postmaster" +.RE +.SH OPTIONS +.IP \fB-v\fR +Be verbose about delivery. Probably only useful when debugging \*(mp. +.IP \fIto\fR +A list of one or more e-mail ids to send the modified +Postmaster messages to. If none are specified postmaster +is used. +.SH AUTHOR +.nf +Michael S. Muegel (mmuegel@mot.com) +UNIX Applications Startup Group +Corporate Information Office, Schaumburg, IL +Motorola, Inc. +.fi +.SH CREDITS +The original idea to filter Postmaster mail was taken from a script by +Christopher Davis . +.SH COPYRIGHT NOTICE +Copyright 1992, Motorola, Inc. +.sp 1 +Permission to use, copy, modify and distribute without charge this +software, documentation, etc. is granted, provided that this +comment and the author's name is retained. The author nor Motorola assume any +responsibility for problems resulting from the use of this software. +.SH SEE ALSO +.nf +\fBsendmail(8)\fR +.fi +SHAR_EOF +chmod 0444 man/postclip.1 || +echo 'restore of man/postclip.1 failed' +Wc_c="`wc -c < 'man/postclip.1'`" +test 2078 -eq "$Wc_c" || + echo 'man/postclip.1: original size 2078, current size' "$Wc_c" +fi +# ============= src/cqueue ============== +if test ! -d 'src'; then + echo 'x - creating directory src' + mkdir 'src' +fi +if test -f 'src/cqueue' -a X"$1" != X"-c"; then + echo 'x - skipping src/cqueue (File already exists)' +else +echo 'x - extracting src/cqueue (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'src/cqueue' && +#!/usr/local/ustart/bin/suidperl +X +# NAME +# cqueue - check sendmail queue for problems +# +# SYNOPSIS +# Type cqueue -usage +# +# AUTHOR +# Michael S. Muegel +# +# RCS INFORMATION +# mmuegel +# /usr/local/ustart/src/mail-tools/dist/foo/src/cqueue,v 1.1 1993/07/28 08:09:02 mmuegel Exp +X +# So that date.pl does not yell (Domain/OS version does a ``) +$ENV{'PATH'} = ""; +X +# A better getopts routine +require "newgetopts.pl"; +require "timespec.pl"; +require "mail.pl"; +require "date.pl"; +require "mqueue.pl"; +require "strings1.pl"; +require "elapsed.pl"; +X +($Script_Name = $0) =~ s/.*\///; +X +# Some defaults you may want to change +$DEF_TIME = "2h"; +$DEF_QUEUE = "/usr/spool/mqueue"; +$DEF_COLUMNS = 80; +$DATE_FORMAT = "%r %D"; +X +# Constants that probably should not be changed +$USAGE = "Usage: $Script_Name [ -abdms ] [ -q queue-dir ] [ -t time ] [ -u user ] [ -w width ]\n"; +$VERSION = "${Script_Name} by mmuegel; 1.1 of 1993/07/28 08:09:02"; +$SWITCHES = "abdmst:u:q:w:"; +$SPLIT_EXPR = '\s,\.@!%:'; +$ADDR_PART_EXPR = '[^!@%]+'; +X +# Let getopts parse for switches +$Status = &New_Getopts ($SWITCHES, $USAGE); +exit (0) if ($Status == -1); +exit (1) if (! $Status); +X +# Check args +die "${Script_Name}: -u only valid with -m\n" if (($opt_u) && (! $opt_m)); +die "${Script_Name}: -a not valid with -t option\n" if ($opt_a && $opt_t); +$opt_u = getlogin || (getpwuid ($<))[0] || $ENV{"USER"} || die "${Script_Name}: can not determine who you are!\n" if (! $opt_u); +X +# Set defaults +$opt_t = "0s" if ($opt_a); +$opt_t = $DEF_TIME if ($opt_t eq ""); +$opt_w = $DEF_COLUMNS if ($opt_w eq ""); +$opt_q = $DEF_QUEUE if ($opt_q eq ""); +$opt_s = $opt_d = 1 if (! ($opt_s || $opt_d)); +X +# Untaint the users to mail to +$opt_u =~ /^(.*)$/; +$Users = $1; +X +# Convert time option to seconds and seconds to elapsed form +die "${Script_Name}: $Msg\n" if (! (($Status, $Msg, $Seconds) = &Time_Spec_To_Seconds ($opt_t))[0]); +$Elapsed = &Seconds_To_Elapsed ($Seconds, 1); +$Time_Info = " longer than $Elapsed" if ($Seconds); +X +# Get the current time +$Current_Time = time; +$Current_Date = &date ($Current_Time, $DATE_FORMAT); +X +($Status, $Msg, @Queue_IDs) = &Get_Queue_IDs ($opt_q, 1, @Missing_Control_IDs, +X @Missing_Data_IDs); +die "$Script_Name: $Msg\n" if (! $Status); +X +# Yell about missing data/control files? +if ($opt_b) +{ +X +X $Report = "\nMessages missing control files:\n\n " . +X join ("\n ", @Missing_Control_IDs) . +X "\n" +X if (@Missing_Control_IDs); +X +X $Report .= "\nMessages missing data files:\n\n " . +X join ("\n ", @Missing_Data_IDs) . +X "\n" +X if (@Missing_Data_IDs); +}; +X +# See if any mail messages are older than $Seconds +foreach $Queue_ID (@Queue_IDs) +{ +X # Get lots of info about this sendmail message via the control file +X ($Status, $Msg) = &Parse_Control_File ($opt_q, $Queue_ID, *Sender, +X *Recipients, *Errors_To, *Creation_Time, *Priority, *Status_Message, +X *Headers); +X next if ($Status == -1); +X if (! $Status) +X { +X warn "$Script_Name: $Queue_ID: $Msg\n"; +X next; +X }; +X +X # Report on message if it is older than $Seconds +X if ($Current_Time - $Creation_Time >= $Seconds) +X { +X # Build summary by host information. Keep track of each host destination +X # encountered. +X if ($opt_s) +X { +X %Host_Map = (); +X foreach (@Recipients) +X { +X if ((/@($ADDR_PART_EXPR)$/) || (/($ADDR_PART_EXPR)!$ADDR_PART_EXPR$/)) +X { +X ($Host = $1) =~ tr/A-Z/a-z/; +X $Host_Map {$Host} = 1; +X } +X else +X { +X warn "$Script_Name: could not find host part from $_; contact author\n"; +X }; +X }; +X +X # For each unique target host add to its stats +X grep ($Host_Queued {$_}++, keys (%Host_Map)); +X +X # Build summary by message information. +X $Message_Queued {$Status_Message}++ if ($Status_Message); +X }; +X +X # Build long report information for this creation time (there may be +X # more than one message created at the same time) +X if ($opt_d) +X { +X $Creation_Date = &date ($Creation_Time, $DATE_FORMAT); +X $Recipient_Info = &Format_Text_Block (join (", ", @Recipients), +X " Recipient: ", 1, 0, $opt_w, $SPLIT_EXPR); +X $Time_To_Report {$Creation_Time} .= <<"EOS"; +X +X ID: $Queue_ID +X Date: $Creation_Date +X Sender: $Sender +$Recipient_Info +EOS +X +X # Add the status message if available to long report +X if ($Status_Message) +X { +X $Time_To_Report {$Creation_Time} .= &Format_Text_Block ($Status_Message, +X " Status: ", 1, 0, $opt_w, $SPLIT_EXPR) . "\n"; +X }; +X }; +X }; +X +}; +X +# Add the summary report by target host? +if ($opt_s) +{ +X foreach $Host (sort (keys (%Host_Queued))) +X { +X $Host_Report .= &Format_Text_Block ($Host, +X sprintf (" %-9d ", $Host_Queued{$Host}), 1, 0, $opt_w, +X $SPLIT_EXPR) . "\n"; +X $Num_Hosts += $Host_Queued{$Host}; +X }; +X if ($Host_Report) +X { +X chop ($Host_Report); +X $Report .= &Format_Text_Block("\nSummary of messages in queue$Time_Info by destination host:\n", "", 0, 0, $opt_w); +X +X $Report .= <<"EOS"; +X +X Number of +X Messages Destination Host +X --------- ---------------- +$Host_Report +X --------- +X $Num_Hosts +EOS +X }; +}; +X +# Add the summary by message report? +if ($opt_s) +{ +X foreach $Message (sort (keys (%Message_Queued))) +X { +X $Message_Report .= &Format_Text_Block ($Message, +X sprintf (" %-9d ", $Message_Queued{$Message}), 1, 0, $opt_w, +X $SPLIT_EXPR) . "\n"; +X $Num_Messages += $Message_Queued{$Message}; +X }; +X if ($Message_Report) +X { +X chop ($Message_Report); +X $Report .= &Format_Text_Block ("\nSummary of messages in queue$Time_Info by status message:\n", "", 0, 0, $opt_w); +X +X $Report .= <<"EOS"; +X +X Number of +X Messages Status Message +X --------- -------------- +$Message_Report +X --------- +X $Num_Messages +EOS +X }; +}; +X +# Add the detailed message reports? +if ($opt_d) +{ +X foreach $Time (sort { $a <=> $b} (keys (%Time_To_Report))) +X { +X $Report .= &Format_Text_Block ("\nDetail of messages in queue$Time_Info sorted by creation date:\n","", 0, 0, $opt_w) if (! $Detailed_Header++); +X $Report .= $Time_To_Report {$Time}; +X }; +}; +X +# Now mail or print the report +if ($Report) +{ +X $Report .= "\n"; +X if ($opt_m) +X { +X ($Status, $Msg) = &Send_Mail ($Users, "sendmail queue report for $Current_Date", $Report, 0); +X die "${Script_Name}: $Msg" if (! $Status); +X } +X +X else +X { +X print $Report; +X }; +X +}; +X +# I am outta here... +exit (0); +SHAR_EOF +chmod 0555 src/cqueue || +echo 'restore of src/cqueue failed' +Wc_c="`wc -c < 'src/cqueue'`" +test 6647 -eq "$Wc_c" || + echo 'src/cqueue: original size 6647, current size' "$Wc_c" +fi +# ============= src/postclip ============== +if test -f 'src/postclip' -a X"$1" != X"-c"; then + echo 'x - skipping src/postclip (File already exists)' +else +echo 'x - extracting src/postclip (Text)' +sed 's/^X//' << 'SHAR_EOF' > 'src/postclip' && +#!/usr/local/bin/perl +X +# NAME +# postclip - send only the headers to Postmaster +# +# SYNOPSIS +# postclip [ -v ] [ to ... ] +# +# AUTHOR +# Michael S. Muegel +# +# RCS INFORMATION +# /usr/local/ustart/src/mail-tools/dist/foo/src/postclip,v +# 1.1 of 1993/07/28 08:09:02 +X +# We use this to send off the mail +require "newgetopts.pl"; +require "mail.pl"; +X +# Get the basename of the script +($Script_Name = $0) =~ s/.*\///; +X +# Some famous constants +$USAGE = "Usage: $Script_Name [ -v ] [ to ... ]\n"; +$VERSION = "${Script_Name} by mmuegel; 1.1 of 1993/07/28 08:09:02"; +$SWITCHES = "v"; +X +# Let getopts parse for switches +$Status = &New_Getopts ($SWITCHES, $USAGE); +exit (0) if ($Status == -1); +exit (1) if (! $Status); +X +# Who should we send the modified mail to? +@ARGV = ("postmaster") if (! @ARGV); +$Users = join (" ", @ARGV); +@ARGV = (); +X +# Suck in the original header and save a few interesting lines +while (<>) +{ +X $Buffer .= $_ if (! /^From /); +X $Subject = $1 if (/^Subject:\s+(.*)$/); +X $From = $1 if (/^From:\s+(.*)$/); +X last if (/^$/); +}; +X +# Do not filter the message unless it has a subject and the subject indicates +# it is an NDN +if ($Subject && ($Subject =~ /^returned mail/i)) +{ +X # Slurp input by paragraph. Keep track of the last time we saw what +X # appeared to be NDN text. We keep this. +X $/ = "\n\n"; +X $* = 1; +X while (<>) +X { +X push (@Paragraphs, $_); +X $Last_Error_Para = $#Paragraphs +X if (/unsent message follows/i || /was not delivered because/); +X }; +X +X # Now save the NDN text into $Buffer +X $Buffer .= join ("", @Paragraphs [0..$Last_Error_Para]); +} +X +else +{ +X undef $/; +X $Buffer .= <>; +}; +X +# Send off the (possibly) modified mail +($Status, $Msg) = &Send_Mail ($Users, "", $Buffer, 0, $opt_v, 1); +die "$Script_Name: $Msg\n" if (! $Status); +SHAR_EOF +chmod 0555 src/postclip || +echo 'restore of src/postclip failed' +Wc_c="`wc -c < 'src/postclip'`" +test 1836 -eq "$Wc_c" || + echo 'src/postclip: original size 1836, current size' "$Wc_c" +fi +exit 0 + +-- ++----------------------------------------------------------------------------+ +| Michael S. Muegel | Internet E-Mail: mmuegel@mot.com | +| UNIX Applications Startup Group | Moto Dist E-Mail: X10090 | +| Corporate Information Office | Voice: (708) 576-0507 | +| Motorola | Fax: (708) 576-4153 | ++----------------------------------------------------------------------------+ + + "I'm disturbed, I'm depressed, I'm inadequate -- I've got it all!" + -- George from _Seinfeld_ diff --git a/contrib/movemail.conf b/contrib/movemail.conf new file mode 100644 index 000000000000..17009b81b0e8 --- /dev/null +++ b/contrib/movemail.conf @@ -0,0 +1,35 @@ +# Configuration script for movemail.pl + +my $minutes = 60; +my $hours = 3600; + +# Queue directories first..last + +@queues = qw( + /var/spool/mqueue/q1 + /var/spool/mqueue/q2 + /var/spool/mqueue/q3 +); + +# Base of subqueue name (optional). +# If used, queue directories are $queues[n]/$subqbase* +# Separate qf/df/xf directories are not supported. + +$subqbase = "subq"; + +# Age of mail when moved. Each element of the array must be greater than the +# previous element. + +@ages = ( + 30*$minutes, # q1 to q2 + 6*$hours # q2 to q3 +); + +# Location of script to move the mail + +$remqueue = "/usr/local/bin/re-mqueue.pl"; + +# Lock file to prevent more than one instance running (optional) +# Useful when running from cron + +$lockfile = "/var/spool/mqueue/movemail.lock"; diff --git a/contrib/movemail.pl b/contrib/movemail.pl new file mode 100755 index 000000000000..86bcb20118e5 --- /dev/null +++ b/contrib/movemail.pl @@ -0,0 +1,106 @@ +#!/usr/bin/perl -w +# +# Move old mail messages between queues by calling re-mqueue.pl. +# +# movemail.pl [config-script] +# +# Default config script is /usr/local/etc/movemail.conf. +# +# Graeme Hewson , June 2000 +# + +use strict; + +# Load external program as subroutine to avoid +# compilation overhead on each call + +sub loadsub { + my $fn = shift + or die "Filename not specified"; + my $len = (stat($fn))[7] + or die "Can't stat $fn: $!"; + open PROG, "< $fn" + or die "Can't open $fn: $!"; + my $prog; + read PROG, $prog, $len + or die "Can't read $fn: $!"; + close PROG; + eval join "", + 'return sub { my @ARGV = @_; $0 = $fn; no strict;', + "$prog", + '};'; +} + +my $progname = $0; +my $lastage = -1; +my $LOCK_EX = 2; +my $LOCK_NB = 4; + +# Load and eval config script + +my $conffile = shift || "/usr/local/etc/movemail.conf"; +my $len = (stat($conffile))[7] + or die "Can't stat $conffile: $!"; +open CONF, "< $conffile" + or die "Can't open $conffile: $!"; +my $conf; +read CONF, $conf, $len + or die "Can't read $conffile: $!"; +close CONF; +use vars qw(@queues $subqbase @ages $remqueue $lockfile); +eval $conf; + +if ($#queues < 1) { + print "$progname: there must be at least two queues\n"; + exit 1; +} + +if ($#ages != ($#queues - 1)) { + print "$progname: wrong number of ages (should be one less than number of queues)\n"; + exit 1; +} + +# Get lock or exit quietly. Useful when running from cron. + +if ($lockfile) { + open LOCK, ">>$lockfile" + or die "Can't open lock file: $!"; + unless (flock LOCK, $LOCK_EX|$LOCK_NB) { + close LOCK; + exit 0; + } +} + +my $remsub = loadsub($remqueue); + +# Go through directories in reverse order so as to check spool files only once + +for (my $n = $#queues - 1; $n >= 0; $n--) { + unless ($ages[$n] =~ /^\d+$/) { + print "$progname: invalid number $ages[$n] in ages array\n"; + exit 1; + } + unless ($lastage < 0 || $ages[$n] < $lastage) { + print "$progname: age $lastage is not > previous value $ages[$n]\n"; + exit 1; + } + $lastage = $ages[$n]; + if ($subqbase) { + my $subdir; + opendir(DIR, $queues[$n]) + or die "Can't open $queues[$n]: $!"; + foreach $subdir ( grep { /^$subqbase/ } readdir DIR) { + &$remsub("$queues[$n]/$subdir", "$queues[$n+1]/$subdir", + $ages[$n]); + } + closedir(DIR); + } else { + # Not using subdirectories + &$remsub($queues[$n], $queues[$n+1], $ages[$n]); + } +} + +if ($lockfile) { + unlink $lockfile; + close LOCK; +} diff --git a/contrib/passwd-to-alias.pl b/contrib/passwd-to-alias.pl new file mode 100755 index 000000000000..24bb7a1c544b --- /dev/null +++ b/contrib/passwd-to-alias.pl @@ -0,0 +1,31 @@ +#!/bin/perl + +# +# Convert GECOS information in password files to alias syntax. +# +# Contributed by Kari E. Hurtta +# + +print "# Generated from passwd by $0\n"; + +$wordpat = '([a-zA-Z]+?[a-zA-Z0-9-]*)?[a-zA-Z0-9]'; # 'DB2' +while (@a = getpwent) { + ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) = @a; + + ($fullname = $gcos) =~ s/,.*$//; + + if (!-d $dir || !-x $shell || $shell =~ m!/bin/(false|true)$!) { + print "$name: root\n"; # handle pseudo user + } + + $fullname =~ s/\.*[ _]+\.*/./g; + $fullname =~ tr [åäéöüÅÄÖÜ] [aaeouAAOU]; # 1997-06-15 + next if (!$fullname || lc($fullname) eq $name); # avoid nonsense + if ($fullname =~ /^$wordpat(\.$wordpat)*$/o) { # Ulrich Windl + print "$fullname: $name\n"; + } else { + print "# $fullname: $name\n"; # avoid strange names + } +}; + +endpwent; diff --git a/contrib/qtool.8 b/contrib/qtool.8 new file mode 100644 index 000000000000..0a4cbffee023 --- /dev/null +++ b/contrib/qtool.8 @@ -0,0 +1,228 @@ +.\" Copyright (c) 1999, 2001-2002 Sendmail, Inc. and its suppliers. +.\" All rights reserved. +.\" +.\" By using this file, you agree to the terms and conditions set +.\" forth in the LICENSE file which can be found at the top level of +.\" the sendmail distribution. +.\" +.\" +.\" $Id: qtool.8,v 8.20 2004/06/28 17:49:41 ca Exp $ +.\" +.TH QTOOL 8 "$Date: 2004/06/28 17:49:41 $" +.SH NAME +qtool +\- manipulate sendmail queues +.SH SYNOPSIS +.B qtool.pl +.RB [options] +target_directory source [source ...] +.PP +.B qtool.pl [-Q][-d|-b] +.RB [options] +source [source ...] +.SH DESCRIPTION +.B Qtool +moves the queue files used by sendmail between queues. It uses the same +locking mechanism as sendmail so can be safely used while sendmail is +running. +However, it should not be used when queue groups have been configured +to move queue files into directories to which they do not belong according +to the queue group selections made in the sendmail.cf file. +Unless you are absolutely sure you do not interfere with the queue group +selection mechanism, do not move queue files around. +.PP +With no options, +.B qtool +will move any queue files as specified by \fIsource\fP into +\fItarget_directory\fP. \fISource\fP can be either an individual +queue control file, a queue file id, or a queue directory. +.PP +If the -d option is specified, qtool will delete the messages specified by +source instead of moving them. +.PP +If the -b option is specified, the selected messages will be bounced by +running sendmail with the -OTimeout.queuereturn=now option. +.SS Options +.TP +\fB\-b\fP +Bounce all of the messages specified by source. The messages will be bounced +immediately. No attempt will be made to deliver the messages. +.TP +\fB\-C\fP configfile +Specify the sendmail config file. +Defaults to /etc/mail/sendmail.cf. +.TP +\fB\-d\fP +Delete all of the messages specified by source. +.TP +\fB\-e\fP \fIperl_expression\fP +Evaluate \fIperl_expression\fP for each queue file as specified +by \fIsource\fP. If \fIperl_expression\fP evaluates to true, then that +queue file is moved. See below for more detail on \fIperl_expression\fP. +.TP +\fB\-Q\fP +Operate on quarantined items +(queue control file begins with hf instead of qf). +.TP +\fB\-s\fP \fIseconds\fP +Move only the queue files specified by \fIsource\fP that have a +modification time older than \fIseconds\fP. +.SS Perl Expressions +You can use any valid perl expression. Inside the expression you have +access to a hash that contains many of the fields in the control file as +well as some other data about that queued message. The hash is called +\fI%msg\fP. If a field has multiple values (e.g. 'Recipient'), it will be +returned as an array, otherwise it will be returned as a scalar. Through +\fI%msg\fP, you can access the following variables: +.TP +\fBauth\fP +AUTH= parameter. +.TP +\fBbody_type\fP +Body type (\fB8BITMIME\fP, \fB7BIT\fP, or undefined). +.TP +\fBbody_last_mod_time\fP +The last time the body was modified since the epoch in seconds. +.TP +\fBbody_size\fP +The size of the body file in bytes. +.TP +\fBcontent-length\fP +Content-Length: header value (Solaris sendmail only). +.TP +\fBcontrolling_user\fP +The controlling user. +.TP +\fBcontrol_last_mod_time\fP +The last time the control file was modified since the epoch in seconds. +.TP +\fBcontrol_size\fP +The size of the control file in bytes. +.TP +\fBcreation_time\fP +The time when the control file was created. +.TP +\fBdata_file_name\fP +The data file name (deprecated). +.TP +\fBdeliver_by\fP +Deliver by flag and deadline for DELIVERBY ESMTP extension. +.TP +\fBenvid\fP +Original envelope id form ESMTP. +.TP +\fBerror_recipient\fP +The error recipient (deprecated). +.TP +\fBfinal_recipient\fP +Final recipient (for DSNs). +.TP +\fBflags\fP +Array of characters that can be the following values: +.PD 0 +.RS +8 +.TP 8 +w +warning message has been sent +.TP 8 +r +This is an error response or DSN +.TP 8 +8 +has 8 bit data in body +.TP 8 +b +delete Bcc: headers +.TP 8 +d +envelope has DSN RET= parameter +.TP 8 +n +don't return body +.PD +.RE +.TP +\fBheaders\fP +This is a Perl hash where the keys are rfc822 field names and the values +are rfc822 field values. If a field has only one value it will be returned +as a string. If a field has more than one value (e.g. 'Received') it will +be returned as a list of strings. +.TP +\fBinode_number\fP +The inode number for the data (body) file. +.TP +\fBnext_delivery_time\fP +Earliest time of next delivery attempt. +.TP +\fBnum_delivery_attempts\fP +Number of delivery attempts that have been made. +.TP +\fBmacro\fP +Defined macro. +.TP +\fBmessage\fP +Envelope status message. +.TP +\fBoriginal_recipient\fP +Original recipient (ORCPT= parameter). +.TP +\fBpriority\fP +Adjusted priority of message. +.TP +\fBquarantine_reason\fP +Quarantine reason for quarantined (held) envelopes. +.TP +\fBrecipient\fP +Array of character flags followed by colon and recipient name. Flags: +.PD 0 +.RS +8 +.TP 8 +N +Has NOTIFY= parameter. +.TP 8 +S +Success DSN requested. +.TP 8 +F +Failure DSN requested. +.TP 8 +D +Delay DSN requested. +.TP 8 +P +Primary address (not the result of alias/forward expansion). +.PD +.RE +.TP +\fBsender\fP +Sender +.TP +\fBversion\fP +Version of control file. +.SH EXAMPLES +.TP +\fBqtool.pl q2 q1\fP +Moves all of the queue files in queue q1 to queue q2. +.TP +\fBqtool.pl q2 q1/d6CLQh100847\fP +Moves the message with id d6CLQh100847 in queue q1 to queue q2. +.TP +\fBqtool.pl q2 q1/qfd6CLQh100847\fP +Moves the message with id d6CLQh100847 in queue q1 to queue q2. +.TP +\fBqtool.pl -e '$msg{num_delivery_attempts} == 3' /q2 /q1\fP +Moves all of the queue files that have had three attempted deliveries from +queue q1 to queue q2. +.SH BUGS +In sendmail 8.12, it is possible for a message's queue and data files (df) +to be stored in different queues. +In this situation, you must give qtool the pathname of the queue file, +not of the data file (df). +To be safe, never feed qtool the pathname of a data file (df). +.SH SEE ALSO +sendmail(8) +.SH HISTORY +The +.B qtool +command appeared in +sendmail 8.10. diff --git a/contrib/qtool.pl b/contrib/qtool.pl new file mode 100755 index 000000000000..d6a63ec17eba --- /dev/null +++ b/contrib/qtool.pl @@ -0,0 +1,1324 @@ +#!/usr/bin/env perl +## +## Copyright (c) 1998-2002 Sendmail, Inc. and its suppliers. +## All rights reserved. +## +## $Id: qtool.pl,v 8.29 2007/02/16 01:12:08 ca Exp $ +## +use strict; +use File::Basename; +use File::Copy; +use File::Spec; +use Fcntl qw(:flock :DEFAULT); +use Getopt::Std; + +## +## QTOOL +## This program is for moving files between sendmail queues. It is +## pretty similar to just moving the files manually, but it locks the files +## the same way sendmail does to prevent problems. +## +## NOTICE: Do not use this program to move queue files around +## if you use sendmail 8.12 and multiple queue groups. It may interfere +## with sendmail's internal queue group selection strategy and can cause +## mail to be not delivered. +## +## The syntax is the reverse of mv (ie. the target argument comes +## first). This lets you pick the files you want to move using find and +## xargs. +## +## Since you cannot delete queues while sendmail is running, QTOOL +## assumes that when you specify a directory as a source, you mean that you +## want all of the queue files within that directory moved, not the +## directory itself. +## +## There is a mechanism for adding conditionals for moving the files. +## Just create an Object with a check_move(source, dest) method and add it +## to the $conditions object. See the handling of the '-s' option for an +## example. +## + +## +## OPTION NOTES +## +## The -e option: +## The -e option takes any valid perl expression and evaluates it +## using the eval() function. Inside the expression the variable +## '$msg' is bound to the ControlFile object for the current source +## queue message. This lets you check for any value in the message +## headers or the control file. Here's an example: +## +## ./qtool.pl -e '$msg{num_delivery_attempts} >= 2' /q1 /q2 +## +## This would move any queue files whose number of delivery attempts +## is greater than or equal to 2 from the queue 'q2' to the queue 'q1'. +## +## See the function ControlFile::parse for a list of available +## variables. +## + +my %opts; +my %sources; +my $dst_name; +my $destination; +my $source_name; +my $source; +my $result; +my $action; +my $new_condition; +my $qprefix; +my $queuegroups = 0; +my $conditions = new Compound(); +my $fcntl_struct = 's H60'; +my $fcntl_structlockp = pack($fcntl_struct, Fcntl::F_WRLCK, + "000000000000000000000000000000000000000000000000000000000000"); +my $fcntl_structunlockp = pack($fcntl_struct, Fcntl::F_UNLCK, + "000000000000000000000000000000000000000000000000000000000000"); +my $lock_both = -1; + +Getopt::Std::getopts('bC:de:Qs:', \%opts); + +sub move_action +{ + my $source = shift; + my $destination = shift; + + $result = $destination->add($source); + if ($result) + { + print("$result.\n"); + } +} + +sub delete_action +{ + my $source = shift; + + return $source->delete(); +} + +sub bounce_action +{ + my $source = shift; + + return $source->bounce(); +} + +$action = \&move_action; +if (defined $opts{d}) +{ + $action = \&delete_action; +} +elsif (defined $opts{b}) +{ + $action = \&bounce_action; +} + +if (defined $opts{s}) +{ + $new_condition = new OlderThan($opts{s}); + $conditions->add($new_condition); +} + +if (defined $opts{e}) +{ + $new_condition = new Eval($opts{e}); + $conditions->add($new_condition); +} + +if (defined $opts{Q}) +{ + $qprefix = "hf"; +} +else +{ + $qprefix = "qf"; +} + +if ($action == \&move_action) +{ + $dst_name = shift(@ARGV); + if (!-d $dst_name) + { + print("The destination '$dst_name' must be an existing " . + "directory.\n"); + usage(); + exit; + } + $destination = new Queue($dst_name); +} + +# determine queue_root by reading config file +my $queue_root; +{ + my $config_file = "/etc/mail/sendmail.cf"; + if (defined $opts{C}) + { + $config_file = $opts{C}; + } + + my $line; + open(CONFIG_FILE, $config_file) or die "$config_file: $!"; + + ## Notice: we can only break out of this loop (using last) + ## when both entries (queue directory and group group) + ## have been found. + while ($line = ) + { + chomp $line; + if ($line =~ m/^O QueueDirectory=(.*)/) + { + $queue_root = $1; + if ($queue_root =~ m/(.*)\/[^\/]+\*$/) + { + $queue_root = $1; + } + # found also queue groups? + if ($queuegroups) + { + last; + } + } + if ($line =~ m/^Q.*/) + { + $queuegroups = 1; + if ($action == \&move_action) + { + print("WARNING: moving queue files around " . + "when queue groups are used may\n" . + "result in undelivered mail!\n"); + } + # found also queue directory? + if (defined $queue_root) + { + last; + } + } + } + close(CONFIG_FILE); + if (!defined $queue_root) + { + die "QueueDirectory option not defined in $config_file"; + } +} + +while (@ARGV) +{ + $source_name = shift(@ARGV); + $result = add_source(\%sources, $source_name); + if ($result) + { + print("$result.\n"); + exit; + } +} + +if (keys(%sources) == 0) +{ + exit; +} + +while (($source_name, $source) = each(%sources)) +{ + $result = $conditions->check_move($source, $destination); + if ($result) + { + $result = &{$action}($source, $destination); + if ($result) + { + print("$result\n"); + } + } +} + +sub usage +{ + print("Usage:\t$0 [options] directory source ...\n"); + print("\t$0 [-Q][-d|-b] source ...\n"); + print("Options:\n"); + print("\t-b\t\tBounce the messages specified by source.\n"); + print("\t-C configfile\tSpecify sendmail config file.\n"); + print("\t-d\t\tDelete the messages specified by source.\n"); + print("\t-e [perl expression]\n"); + print("\t\t\tMove only messages for which perl expression\n"); + print("\t\t\treturns true.\n"); + print("\t-Q\t\tOperate on quarantined files.\n"); + print("\t-s [seconds]\tMove only messages whose queue file is older\n"); + print("\t\t\tthan seconds.\n"); +} + +## +## ADD_SOURCE -- Adds a source to the source hash. +## +## Determines whether source is a file, directory, or id. Then it +## creates a QueuedMessage or Queue for that source and adds it to the +## list. +## +## Parameters: +## sources -- A hash that contains all of the sources. +## source_name -- The name of the source to add +## +## Returns: +## error_string -- Undef if ok. Error string otherwise. +## +## Notes: +## If a new source comes in with the same ID as a previous +## source, the previous source gets overwritten in the sources +## hash. This lets the user specify things like * and it still +## works nicely. +## + +sub add_source +{ + my $sources = shift; + my $source_name = shift; + my $source_base_name; + my $source_dir_name; + my $data_dir_name; + my $source_id; + my $source_prefix; + my $queued_message; + my $queue; + my $result; + + ($source_base_name, $source_dir_name) = File::Basename::fileparse($source_name); + $data_dir_name = $source_dir_name; + + $source_prefix = substr($source_base_name, 0, 2); + if (!-d $source_name && $source_prefix ne $qprefix && + $source_prefix ne 'df') + { + $source_base_name = "$qprefix$source_base_name"; + $source_name = File::Spec->catfile("$source_dir_name", + "$source_base_name"); + } + $source_id = substr($source_base_name, 2); + + if (!-e $source_name) + { + $source_name = File::Spec->catfile("$source_dir_name", "qf", + "$qprefix$source_id"); + if (!-e $source_name) + { + return "'$source_name' does not exist"; + } + $data_dir_name = File::Spec->catfile("$source_dir_name", "df"); + if (!-d $data_dir_name) + { + $data_dir_name = $source_dir_name; + } + $source_dir_name = File::Spec->catfile("$source_dir_name", + "qf"); + } + + if (-f $source_name) + { + $queued_message = new QueuedMessage($source_dir_name, + $source_id, + $data_dir_name); + $sources->{$source_id} = $queued_message; + return undef; + } + + if (!-d $source_name) + { + return "'$source_name' is not a plain file or a directory"; + } + + $queue = new Queue($source_name); + $result = $queue->read(); + if ($result) + { + return $result; + } + + while (($source_id, $queued_message) = each(%{$queue->{files}})) + { + $sources->{$source_id} = $queued_message; + } + + return undef; +} + +## +## LOCK_FILE -- Opens and then locks a file. +## +## Opens a file for read/write and uses flock to obtain a lock on the +## file. The flock is Perl's flock which defaults to flock on systems +## that support it. On systems without flock it falls back to fcntl +## locking. This script will also call fcntl explicitly if flock +## uses BSD semantics (i.e. if both flock() and fcntl() can successfully +## lock the file at the same time) +## +## Parameters: +## file_name -- The name of the file to open and lock. +## +## Returns: +## (file_handle, error_string) -- If everything works then +## file_handle is a reference to a file handle and +## error_string is undef. If there is a problem then +## file_handle is undef and error_string is a string +## explaining the problem. +## + +sub lock_file +{ + my $file_name = shift; + my $result; + + if ($lock_both == -1) + { + if (open(DEVNULL, '>/dev/null')) + { + my $flock_status = flock(DEVNULL, Fcntl::LOCK_EX | Fcntl::LOCK_NB); + my $fcntl_status = fcntl (DEVNULL, Fcntl::F_SETLK, $fcntl_structlockp); + close(DEVNULL); + + $lock_both = ($flock_status && $fcntl_status); + } + else + { + # Couldn't open /dev/null. Windows system? + $lock_both = 0; + } + } + + + $result = sysopen(FILE_TO_LOCK, $file_name, Fcntl::O_RDWR); + if (!$result) + { + return (undef, "Unable to open '$file_name': $!"); + } + + $result = flock(FILE_TO_LOCK, Fcntl::LOCK_EX | Fcntl::LOCK_NB); + if (!$result) + { + return (undef, "Could not obtain lock on '$file_name': $!"); + } + + if ($lock_both) + { + my $result2 = fcntl (FILE_TO_LOCK, Fcntl::F_SETLK, $fcntl_structlockp); + if (!$result2) + { + return (undef, "Could not obtain fcntl lock on '$file_name': $!"); + } + } + + return (\*FILE_TO_LOCK, undef); +} + +## +## UNLOCK_FILE -- Unlocks a file. +## +## Unlocks a file using Perl's flock. +## +## Parameters: +## file -- A file handle. +## +## Returns: +## error_string -- If undef then no problem. Otherwise it is a +## string that explains problem. +## + +sub unlock_file +{ + my $file = shift; + my $result; + + $result = flock($file, Fcntl::LOCK_UN); + if (!$result) + { + return "Unlock failed on '$result': $!"; + } + if ($lock_both) + { + my $result2 = fcntl ($file, Fcntl::F_SETLK, $fcntl_structunlockp); + if (!$result2) + { + return (undef, "Fcntl unlock failed on '$result': $!"); + } + } + + return undef; +} + +## +## MOVE_FILE -- Moves a file. +## +## Moves a file. +## +## Parameters: +## src_name -- The name of the file to be move. +## dst_nome -- The name of the place to move it to. +## +## Returns: +## error_string -- If undef then no problem. Otherwise it is a +## string that explains problem. +## + +sub move_file +{ + my $src_name = shift; + my $dst_name = shift; + my $result; + + $result = File::Copy::move($src_name, $dst_name); + if (!$result) + { + return "File move from '$src_name' to '$dst_name' failed: $!"; + } + + return undef; +} + + +## +## CONTROL_FILE - Represents a sendmail queue control file. +## +## This object represents represents a sendmail queue control file. +## It can parse and lock its file. +## + + +package ControlFile; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + my $queue_dir = shift; + $self->{id} = shift; + + $self->{file_name} = $queue_dir . '/' . $qprefix . $self->{id}; + $self->{headers} = {}; +} + +## +## PARSE - Parses the control file. +## +## Parses the control file. It just sticks each entry into a hash. +## If a key has more than one entry, then it points to a list of +## entries. +## + +sub parse +{ + my $self = shift; + if ($self->{parsed}) + { + return; + } + my %parse_table = + ( + 'A' => 'auth', + 'B' => 'body_type', + 'C' => 'controlling_user', + 'D' => 'data_file_name', + 'd' => 'data_file_directory', + 'E' => 'error_recipient', + 'F' => 'flags', + 'H' => 'parse_header', + 'I' => 'inode_number', + 'K' => 'next_delivery_time', + 'L' => 'content-length', + 'M' => 'message', + 'N' => 'num_delivery_attempts', + 'P' => 'priority', + 'Q' => 'original_recipient', + 'R' => 'recipient', + 'q' => 'quarantine_reason', + 'r' => 'final_recipient', + 'S' => 'sender', + 'T' => 'creation_time', + 'V' => 'version', + 'Y' => 'current_delay', + 'Z' => 'envid', + '!' => 'deliver_by', + '$' => 'macro' + ); + my $line; + my $line_type; + my $line_value; + my $member_name; + my $member; + my $last_type; + + open(CONTROL_FILE, "$self->{file_name}"); + while ($line = ) + { + $line_type = substr($line, 0, 1); + if ($line_type eq "\t" && $last_type eq 'H') + { + $line_type = 'H'; + $line_value = $line; + } + else + { + $line_value = substr($line, 1); + } + $member_name = $parse_table{$line_type}; + $last_type = $line_type; + if (!$member_name) + { + $member_name = 'unknown'; + } + if ($self->can($member_name)) + { + $self->$member_name($line_value); + } + $member = $self->{$member_name}; + if (!$member) + { + $self->{$member_name} = $line_value; + next; + } + if (ref($member) eq 'ARRAY') + { + push(@{$member}, $line_value); + next; + } + $self->{$member_name} = [$member, $line_value]; + } + close(CONTROL_FILE); + + $self->{parsed} = 1; +} + +sub parse_header +{ + my $self = shift; + my $line = shift; + my $headers = $self->{headers}; + my $last_header = $self->{last_header}; + my $header_name; + my $header_value; + my $first_char; + + $first_char = substr($line, 0, 1); + if ($first_char eq "?") + { + $line = substr($line, 3); + } + elsif ($first_char eq "\t") + { + if (ref($headers->{$last_header}) eq 'ARRAY') + { + $headers->{$last_header}[-1] = + $headers->{$last_header}[-1] . $line; + } + else + { + $headers->{$last_header} = $headers->{$last_header} . + $line; + } + return; + } + ($header_name, $header_value) = split(/:/, $line, 2); + $self->{last_header} = $header_name; + if (exists $headers->{$header_name}) + { + $headers->{$header_name} = [$headers->{$header_name}, + $header_value]; + } + else + { + $headers->{$header_name} = $header_value; + } +} + +sub is_locked +{ + my $self = shift; + + return (defined $self->{lock_handle}); +} + +sub lock +{ + my $self = shift; + my $lock_handle; + my $result; + + if ($self->is_locked()) + { + # Already locked + return undef; + } + + ($lock_handle, $result) = ::lock_file($self->{file_name}); + if (!$lock_handle) + { + return $result; + } + + $self->{lock_handle} = $lock_handle; + + return undef; +} + +sub unlock +{ + my $self = shift; + my $result; + + if (!$self->is_locked()) + { + # Not locked + return undef; + } + + $result = ::unlock_file($self->{lock_handle}); + + $self->{lock_handle} = undef; + + return $result; +} + +sub do_stat +{ + my $self = shift; + my $result; + my @result; + + $result = open(QUEUE_FILE, $self->{file_name}); + if (!$result) + { + return "Unable to open '$self->{file_name}': $!"; + } + @result = stat(QUEUE_FILE); + if (!@result) + { + return "Unable to stat '$self->{file_name}': $!"; + } + $self->{control_size} = $result[7]; + $self->{control_last_mod_time} = $result[9]; +} + +sub DESTROY +{ + my $self = shift; + + $self->unlock(); +} + +sub delete +{ + my $self = shift; + my $result; + + $result = unlink($self->{file_name}); + if (!$result) + { + return "Unable to delete $self->{file_name}: $!"; + } + return undef; +} + + +## +## DATA_FILE - Represents a sendmail queue data file. +## +## This object represents represents a sendmail queue data file. +## It is really just a place-holder. +## + +package DataFile; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + my $data_dir = shift; + $self->{id} = shift; + my $control_file = shift; + + $self->{file_name} = $data_dir . '/df' . $self->{id}; + return if -e $self->{file_name}; + $control_file->parse(); + return if !defined $control_file->{data_file_directory}; + $data_dir = $queue_root . '/' . $control_file->{data_file_directory}; + chomp $data_dir; + if (-d ($data_dir . '/df')) + { + $data_dir .= '/df'; + } + $self->{file_name} = $data_dir . '/df' . $self->{id}; +} + +sub do_stat +{ + my $self = shift; + my $result; + my @result; + + $result = open(QUEUE_FILE, $self->{file_name}); + if (!$result) + { + return "Unable to open '$self->{file_name}': $!"; + } + @result = stat(QUEUE_FILE); + if (!@result) + { + return "Unable to stat '$self->{file_name}': $!"; + } + $self->{body_size} = $result[7]; + $self->{body_last_mod_time} = $result[9]; +} + +sub delete +{ + my $self = shift; + my $result; + + $result = unlink($self->{file_name}); + if (!$result) + { + return "Unable to delete $self->{file_name}: $!"; + } + return undef; +} + + +## +## QUEUED_MESSAGE - Represents a queued sendmail message. +## +## This keeps track of the files that make up a queued sendmail +## message. +## Currently it has 'control_file' and 'data_file' as members. +## +## You can tie it to a fetch only hash using tie. You need to +## pass a reference to a QueuedMessage as the third argument +## to tie. +## + +package QueuedMessage; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + my $queue_dir = shift; + my $id = shift; + my $data_dir = shift; + + $self->{id} = $id; + $self->{control_file} = new ControlFile($queue_dir, $id); + if (!$data_dir) + { + $data_dir = $queue_dir; + } + $self->{data_file} = new DataFile($data_dir, $id, $self->{control_file}); +} + +sub last_modified_time +{ + my $self = shift; + my @result; + @result = stat($self->{data_file}->{file_name}); + return $result[9]; +} + +sub TIEHASH +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = shift; + return $self; +} + +sub FETCH +{ + my $self = shift; + my $key = shift; + + if (exists $self->{control_file}->{$key}) + { + return $self->{control_file}->{$key}; + } + if (exists $self->{data_file}->{$key}) + { + return $self->{data_file}->{$key}; + } + + return undef; +} + +sub lock +{ + my $self = shift; + + return $self->{control_file}->lock(); +} + +sub unlock +{ + my $self = shift; + + return $self->{control_file}->unlock(); +} + +sub move +{ + my $self = shift; + my $destination = shift; + my $df_dest; + my $qf_dest; + my $result; + + $result = $self->lock(); + if ($result) + { + return $result; + } + + $qf_dest = File::Spec->catfile($destination, "qf"); + if (-d $qf_dest) + { + $df_dest = File::Spec->catfile($destination, "df"); + if (!-d $df_dest) + { + $df_dest = $destination; + } + } + else + { + $qf_dest = $destination; + $df_dest = $destination; + } + + if (-e File::Spec->catfile($qf_dest, "$qprefix$self->{id}")) + { + $result = "There is already a queued message with id '$self->{id}' in '$destination'"; + } + + if (!$result) + { + $result = ::move_file($self->{data_file}->{file_name}, + $df_dest); + } + + if (!$result) + { + $result = ::move_file($self->{control_file}->{file_name}, + $qf_dest); + } + + $self->unlock(); + + return $result; +} + +sub parse +{ + my $self = shift; + + return $self->{control_file}->parse(); +} + +sub do_stat +{ + my $self = shift; + + $self->{control_file}->do_stat(); + $self->{data_file}->do_stat(); +} + +sub setup_vars +{ + my $self = shift; + + $self->parse(); + $self->do_stat(); +} + +sub delete +{ + my $self = shift; + my $result; + + $result = $self->{control_file}->delete(); + if ($result) + { + return $result; + } + $result = $self->{data_file}->delete(); + if ($result) + { + return $result; + } + + return undef; +} + +sub bounce +{ + my $self = shift; + my $command; + + $command = "sendmail -qI$self->{id} -O Timeout.queuereturn=now"; +# print("$command\n"); + system($command); +} + +## +## QUEUE - Represents a queued sendmail queue. +## +## This manages all of the messages in a queue. +## + +package Queue; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + + $self->{queue_dir} = shift; + $self->{files} = {}; +} + +## +## READ - Loads the queue with all of the objects that reside in it. +## +## This reads the queue's directory and creates QueuedMessage objects +## for every file in the queue that starts with 'qf' or 'hf' +## (depending on the -Q option). +## + +sub read +{ + my $self = shift; + my @control_files; + my $queued_message; + my $file_name; + my $id; + my $result; + my $control_dir; + my $data_dir; + + $control_dir = File::Spec->catfile($self->{queue_dir}, 'qf'); + + if (-e $control_dir) + { + $data_dir = File::Spec->catfile($self->{queue_dir}, 'df'); + if (!-e $data_dir) + { + $data_dir = $self->{queue_dir}; + } + } + else + { + $data_dir = $self->{queue_dir}; + $control_dir = $self->{queue_dir}; + } + + $result = opendir(QUEUE_DIR, $control_dir); + if (!$result) + { + return "Unable to open directory '$control_dir'"; + } + + @control_files = grep { /^$qprefix.*/ && -f "$control_dir/$_" } readdir(QUEUE_DIR); + closedir(QUEUE_DIR); + foreach $file_name (@control_files) + { + $id = substr($file_name, 2); + $queued_message = new QueuedMessage($control_dir, $id, + $data_dir); + $self->{files}->{$id} = $queued_message; + } + + return undef; +} + + +## +## ADD_QUEUED_MESSAGE - Adds a QueuedMessage to this Queue. +## +## Adds the QueuedMessage object to the hash and moves the files +## associated with the QueuedMessage to this Queue's directory. +## + +sub add_queued_message +{ + my $self = shift; + my $queued_message = shift; + my $result; + + $result = $queued_message->move($self->{queue_dir}); + if ($result) + { + return $result; + } + + $self->{files}->{$queued_message->{id}} = $queued_message; + + return $result; +} + +## +## ADD_QUEUE - Adds another Queue's QueuedMessages to this Queue. +## +## Adds all of the QueuedMessage objects in the passed in queue +## to this queue. +## + +sub add_queue +{ + my $self = shift; + my $queue = shift; + my $id; + my $queued_message; + my $result; + + while (($id, $queued_message) = each %{$queue->{files}}) + { + $result = $self->add_queued_message($queued_message); + if ($result) + { + print("$result.\n"); + } + } +} + +## +## ADD - Adds an item to this queue. +## +## Adds either a Queue or a QueuedMessage to this Queue. +## + +sub add +{ + my $self = shift; + my $source = shift; + my $type_name; + my $result; + + $type_name = ref($source); + + if ($type_name eq "QueuedMessage") + { + return $self->add_queued_message($source); + } + + if ($type_name eq "Queue") + { + return $self->add_queue($source); + } + + return "Queue does not know how to add a '$type_name'" +} + +sub delete +{ + my $self = shift; + my $id; + my $queued_message; + + while (($id, $queued_message) = each %{$self->{files}}) + { + $result = $queued_message->delete(); + if ($result) + { + print("$result.\n"); + } + } +} + +sub bounce +{ + my $self = shift; + my $id; + my $queued_message; + + while (($id, $queued_message) = each %{$self->{files}}) + { + $result = $queued_message->bounce(); + if ($result) + { + print("$result.\n"); + } + } +} + +## +## Condition Class +## +## This next section is for any class that has an interface called +## check_move(source, dest). Each class represents some condition to +## check for to determine whether we should move the file from +## source to dest. +## + + +## +## OlderThan +## +## This Condition Class checks the modification time of the +## source file and returns true if the file's modification time is +## older than the number of seconds the class was initialzed with. +## + +package OlderThan; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + + $self->{age_in_seconds} = shift; +} + +sub check_move +{ + my $self = shift; + my $source = shift; + + if ((time() - $source->last_modified_time()) > $self->{age_in_seconds}) + { + return 1; + } + + return 0; +} + +## +## Compound +## +## Takes a list of Move Condition Classes. Check_move returns true +## if every Condition Class in the list's check_move function returns +## true. +## + +package Compound; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + + $self->{condition_list} = []; +} + +sub add +{ + my $self = shift; + my $new_condition = shift; + + push(@{$self->{condition_list}}, $new_condition); +} + +sub check_move +{ + my $self = shift; + my $source = shift; + my $dest = shift; + my $condition; + my $result; + + foreach $condition (@{$self->{condition_list}}) + { + if (!$condition->check_move($source, $dest)) + { + return 0; + } + } + + return 1; +} + +## +## Eval +## +## Takes a perl expression and evaluates it. The ControlFile object +## for the source QueuedMessage is avaliable through the name '$msg'. +## + +package Eval; + +sub new +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + $self->initialize(@_); + return $self; +} + +sub initialize +{ + my $self = shift; + + $self->{expression} = shift; +} + +sub check_move +{ + my $self = shift; + my $source = shift; + my $dest = shift; + my $result; + my %msg; + + $source->setup_vars(); + tie(%msg, 'QueuedMessage', $source); + $result = eval($self->{expression}); + + return $result; +} diff --git a/contrib/re-mqueue.pl b/contrib/re-mqueue.pl new file mode 100644 index 000000000000..9f8d819eb18c --- /dev/null +++ b/contrib/re-mqueue.pl @@ -0,0 +1,258 @@ +#!/usr/bin/perl +# +# re-mqueue -- requeue messages from queueA to queueB based on age. +# +# Contributed by Paul Pomes . +# http://www.qualcomm.com/~ppomes/ +# +# Usage: re-mqueue [-d] queueA queueB seconds +# +# -d enable debugging +# queueA source directory +# queueB destination directory +# seconds select files older than this number of seconds +# +# Example: re-mqueue /var/spool/mqueue /var/spool/mqueue2 2700 +# +# Moves the qf* and df* files for a message from /var/spool/mqueue to +# /var/spool/mqueue2 if the df* file is over 2700 seconds old. +# +# The qf* file can't be used for age checking as it's partially re-written +# with the results of the last queue run. +# +# Rationale: With a limited number of sendmail processes allowed to run, +# messages that can't be delivered immediately slow down the ones that can. +# This becomes especially important when messages are being queued instead +# of delivered right away, or when the queue becomes excessively deep. +# By putting messages that have already failed one or more delivery attempts +# into another queue, the primary queue can be kept small and fast. +# +# On postoffice.cso.uiuc.edu, the primary sendmail daemon runs the queue +# every thirty minutes. Messages over 45 minutues old are moved to +# /var/spool/mqueue2 where sendmail runs every hour. Messages more than +# 3.25 hours old are moved to /var/spool/mqueue3 where sendmail runs every +# four hours. Messages more than a day old are moved to /var/spool/mqueue4 +# where sendmail runs three times a day. The idea is that a message is +# tried at least twice in the first three queues before being moved to the +# old-age ghetto. +# +# (Each must be re-formed into a single line before using in crontab) +# +# 08 * * * * /usr/local/libexec/re-mqueue /var/spool/mqueue ## /var/spool/mqueue2 2700 +# 11 * * * * /usr/lib/sendmail -oQ/var/spool/mqueue2 -q > ## > /var/log/mqueue2 2>&1 +# 38 * * * * /usr/local/libexec/re-mqueue /var/spool/mqueue2 +# /var/spool/mqueue3 11700 +# 41 1,5,9,13,17,21 * * * /usr/lib/sendmail -oQ/var/spool/mqueue3 -q ## > /var/log/mqueue3 2>&1 +# 48 * * * * /usr/local/libexec/re-mqueue /var/spool/mqueue3 +# /var/spool/mqueue4 100000 +#53 3,11,19 * * * /usr/lib/sendmail -oQ/var/spool/mqueue4 -q > ## > /var/log/mqueue4 2>&1 +# +# +# N.B., the moves are done with link(). This has two effects: 1) the mqueue* +# directories must all be on the same filesystem, and 2) the file modification +# times are not changed. All times must be cumulative from when the df* +# file was created. +# +# Copyright (c) 1995 University of Illinois Board of Trustees and Paul Pomes +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# 3. All advertising materials mentioning features or use of this software +# must display the following acknowledgement: +# This product includes software developed by the University of +# Illinois at Urbana and their contributors. +# 4. Neither the name of the University nor the names of their contributors +# may be used to endorse or promote products derived from this software +# without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE TRUSTEES AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE TRUSTEES OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# +# @(#)$OrigId: re-mqueue,v 1.3 1995/05/25 18:14:53 p-pomes Exp $ +# +# Updated by Graeme Hewson May 1999 +# +# 'use Sys::Syslog' for Perl 5 +# Move transcript (xf) files if they exist +# Allow zero-length df files (empty message body) +# Preserve $! for error messages +# +# Updated by Graeme Hewson April 2000 +# +# Improve handling of race between re-mqueue and sendmail +# +# Updated by Graeme Hewson June 2000 +# +# Don't exit(0) at end so can be called as subroutine +# +# NB This program can't handle separate qf/df/xf subdirectories +# as introduced in sendmail 8.10.0. +# + +use Sys::Syslog; + +$LOCK_EX = 2; +$LOCK_NB = 4; +$LOCK_UN = 8; + +# Count arguments, exit if wrong in any way. +die "Usage: $0 [-d] queueA queueB seconds\n" if ($#ARGV < 2); + +while ($_ = $ARGV[0], /^-/) { + shift; + last if /^--$/; + /^-d/ && $debug++; +} + +$queueA = shift; +$queueB = shift; +$age = shift; + +die "$0: $queueA not a directory\n" if (! -d $queueA); +die "$0: $queueB not a directory\n" if (! -d $queueB); +die "$0: $age isn't a valid number of seconds for age\n" if ($age =~ /\D/); + +# chdir to $queueA and read the directory. When a df* file is found, stat it. +# If it's older than $age, lock the corresponding qf* file. If the lock +# fails, give up and move on. Once the lock is obtained, verify that files +# of the same name *don't* already exist in $queueB and move on if they do. +# Otherwise re-link the qf* and df* files into $queueB then release the lock. + +chdir "$queueA" || die "$0: can't cd to $queueA: $!\n"; +opendir (QA, ".") || die "$0: can't open directory $queueA for reading: $!\n"; +@dfiles = grep(/^df/, readdir(QA)); +$now = time(); +($program = $0) =~ s,.*/,,; +&openlog($program, 'pid', 'mail'); + +# Loop through the dfiles +while ($dfile = pop(@dfiles)) { + print "Checking $dfile\n" if ($debug); + ($qfile = $dfile) =~ s/^d/q/; + ($xfile = $dfile) =~ s/^d/x/; + ($mfile = $dfile) =~ s/^df//; + if (! -e $qfile || -z $qfile) { + print "$qfile is gone or zero bytes - skipping\n" if ($debug); + next; + } + + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, + $atime,$mtime,$ctime,$blksize,$blocks) = stat($dfile); + if (! defined $mtime) { + print "$dfile is gone - skipping\n" if ($debug); + next; + } + + # Compare timestamps + if (($mtime + $age) > $now) { + printf ("%s is %d seconds old - skipping\n", $dfile, $now-$mtime) if ($debug); + next; + } + + # See if files of the same name already exist in $queueB + if (-e "$queueB/$dfile") { + print "$queueb/$dfile already exists - skipping\n" if ($debug); + next; + } + if (-e "$queueB/$qfile") { + print "$queueb/$qfile already exists - skipping\n" if ($debug); + next; + } + if (-e "$queueB/$xfile") { + print "$queueb/$xfile already exists - skipping\n" if ($debug); + next; + } + + # Try and lock qf* file + unless (open(QF, ">>$qfile")) { + print "$qfile: $!\n" if ($debug); + next; + } + $retval = flock(QF, $LOCK_EX|$LOCK_NB) || ($retval = -1); + if ($retval == -1) { + print "$qfile already flock()ed - skipping\n" if ($debug); + close(QF); + next; + } + print "$qfile now flock()ed\n" if ($debug); + + # Check df* file again in case sendmail got in + if (! -e $dfile) { + print "$mfile sent - skipping\n" if ($debug); + # qf* file created by ourselves at open? (Almost certainly) + if (-z $qfile) { + unlink($qfile); + } + close(QF); + next; + } + + # Show time! Do the link()s + if (link("$dfile", "$queueB/$dfile") == 0) { + $bang = $!; + &syslog('err', 'link(%s, %s/%s): %s', $dfile, $queueB, $dfile, $bang); + print STDERR "$0: link($dfile, $queueB/$dfile): $bang\n"; + exit (1); + } + if (link("$qfile", "$queueB/$qfile") == 0) { + $bang = $!; + &syslog('err', 'link(%s, %s/%s): %s', $qfile, $queueB, $qfile, $bang); + print STDERR "$0: link($qfile, $queueB/$qfile): $bang\n"; + unlink("$queueB/$dfile"); + exit (1); + } + if (-e "$xfile") { + if (link("$xfile", "$queueB/$xfile") == 0) { + $bang = $!; + &syslog('err', 'link(%s, %s/%s): %s', $xfile, $queueB, $xfile, $bang); + print STDERR "$0: link($xfile, $queueB/$xfile): $bang\n"; + unlink("$queueB/$dfile"); + unlink("$queueB/$qfile"); + exit (1); + } + } + + # Links created successfully. Unlink the original files, release the + # lock, and close the file. + print "links ok\n" if ($debug); + if (unlink($qfile) == 0) { + $bang = $!; + &syslog('err', 'unlink(%s): %s', $qfile, $bang); + print STDERR "$0: unlink($qfile): $bang\n"; + exit (1); + } + if (unlink($dfile) == 0) { + $bang = $!; + &syslog('err', 'unlink(%s): %s', $dfile, $bang); + print STDERR "$0: unlink($dfile): $bang\n"; + exit (1); + } + if (-e "$xfile") { + if (unlink($xfile) == 0) { + $bang = $!; + &syslog('err', 'unlink(%s): %s', $xfile, $bang); + print STDERR "$0: unlink($xfile): $bang\n"; + exit (1); + } + } + flock(QF, $LOCK_UN); + close(QF); + &syslog('info', '%s moved to %s', $mfile, $queueB); + print "Done with $dfile $qfile\n\n" if ($debug); +} diff --git a/contrib/rmail.oldsys.patch b/contrib/rmail.oldsys.patch new file mode 100644 index 000000000000..856fcf1f93eb --- /dev/null +++ b/contrib/rmail.oldsys.patch @@ -0,0 +1,108 @@ +From: Bill Gianopoulos +Message-Id: <199405191527.LAA03463@sccux1.msd.ray.com> +Subject: Patch to rmail to elliminate need for snprintf +To: sendmail@CS.Berkeley.EDU +Date: Thu, 19 May 1994 11:27:16 -0400 (EDT) + +I have written the following patch to rmail which removes the requirement +for snprintf while maintaining the protection from buffer overruns. It also +fixes it to compile with compilers which don't understand ANSI function +prototypes. Perhaps this should be included in the next version? + +*** rmail/rmail.c.orig Mon May 31 18:10:44 1993 +--- rmail/rmail.c Thu May 19 11:04:50 1994 +*************** +*** 78,86 **** +--- 78,109 ---- + #include + #include + ++ #ifdef __STDC__ + void err __P((int, const char *, ...)); + void usage __P((void)); ++ #else ++ void err (); ++ void usage (); ++ #endif + ++ #define strdup(s) strcpy(xalloc(strlen(s) + 1), s) ++ ++ char * ++ xalloc(sz) ++ register int sz; ++ { ++ register char *p; ++ ++ /* some systems can't handle size zero mallocs */ ++ if (sz <= 0) ++ sz = 1; ++ ++ p = malloc((unsigned) sz); ++ if (p == NULL) ++ err(EX_UNAVAILABLE, "Out of memory!!"); ++ return (p); ++ } ++ + int + main(argc, argv) + int argc; +*************** +*** 230,250 **** + args[i++] = "-oi"; /* Ignore '.' on a line by itself. */ + + if (from_sys != NULL) { /* Set sender's host name. */ +! if (strchr(from_sys, '.') == NULL) +! (void)snprintf(buf, sizeof(buf), + "-oMs%s.%s", from_sys, domain); +! else +! (void)snprintf(buf, sizeof(buf), "-oMs%s", from_sys); + if ((args[i++] = strdup(buf)) == NULL) + err(EX_TEMPFAIL, NULL); + } + /* Set protocol used. */ +! (void)snprintf(buf, sizeof(buf), "-oMr%s", domain); + if ((args[i++] = strdup(buf)) == NULL) + err(EX_TEMPFAIL, NULL); + + /* Set name of ``from'' person. */ +! (void)snprintf(buf, sizeof(buf), "-f%s%s", + from_path ? from_path : "", from_user); + if ((args[i++] = strdup(buf)) == NULL) + err(EX_TEMPFAIL, NULL); +--- 253,285 ---- + args[i++] = "-oi"; /* Ignore '.' on a line by itself. */ + + if (from_sys != NULL) { /* Set sender's host name. */ +! if (strchr(from_sys, '.') == NULL) { +! if ((strlen(from_sys) + strlen(domain) + 6) +! > sizeof(buf)) +! err(EX_DATAERR, "sender hostname too long"); +! (void)sprintf(buf, + "-oMs%s.%s", from_sys, domain); +! } +! else { +! if ((strlen(from_sys) + 5) > sizeof(buf)) +! err(EX_DATAERR ,"sender hostname too long"); +! (void)sprintf(buf, "-oMs%s", from_sys); +! } + if ((args[i++] = strdup(buf)) == NULL) + err(EX_TEMPFAIL, NULL); + } + /* Set protocol used. */ +! if ((strlen(domain) + 5) > sizeof(buf)) +! err(EX_DATAERR, "protocol name too long"); +! (void)sprintf(buf, "-oMr%s", domain); + if ((args[i++] = strdup(buf)) == NULL) + err(EX_TEMPFAIL, NULL); + + /* Set name of ``from'' person. */ +! if (((from_path ? strlen(from_path) : 0) + strlen(from_user) + 3) +! > sizeof(buf)) +! err(EX_DATAERR, "from address too long"); +! (void)sprintf(buf, "-f%s%s", + from_path ? from_path : "", from_user); + if ((args[i++] = strdup(buf)) == NULL) + err(EX_TEMPFAIL, NULL); +-- +William A. Gianopoulos; Raytheon Missile Systems Division +wag@sccux1.msd.ray.com diff --git a/contrib/smcontrol.pl b/contrib/smcontrol.pl new file mode 100755 index 000000000000..4987460e4d4e --- /dev/null +++ b/contrib/smcontrol.pl @@ -0,0 +1,413 @@ +#!/usr/local/bin/perl -w + +use strict; +use Getopt::Std; +use FileHandle; +use Socket; + +my $sendmailDaemon = "/usr/sbin/sendmail -q30m -bd"; + +########################################################################## +# +# &get_controlname -- read ControlSocketName option from sendmail.cf +# +# Parameters: +# none. +# +# Returns: +# control socket filename, undef if not found +# + +sub get_controlname +{ + my $cn = undef; + my $qd = undef; + + open(CF, ") + { + chomp; + if (/^O ControlSocketName\s*=\s*([^#]+)$/o) + { + $cn = $1; + } + if (/^O QueueDirectory\s*=\s*([^#]+)$/o) + { + $qd = $1; + } + if (/^OQ([^#]+)$/o) + { + $qd = $1; + } + } + close(CF); + if (not defined $cn) + { + return undef; + } + if ($cn !~ /^\//o) + { + return undef if (not defined $qd); + + $cn = $qd . "/" . $cn; + } + return $cn; +} + +########################################################################## +# +# &do_command -- send command to sendmail daemon view control socket +# +# Parameters: +# controlsocket -- filename for socket +# command -- command to send +# +# Returns: +# reply from sendmail daemon +# + +sub do_command +{ + my $controlsocket = shift; + my $command = shift; + my $proto = getprotobyname('ip'); + my @reply; + my $i; + + socket(SOCK, PF_UNIX, SOCK_STREAM, $proto) or return undef; + + for ($i = 0; $i < 4; $i++) + { + if (!connect(SOCK, sockaddr_un($controlsocket))) + { + if ($i == 3) + { + close(SOCK); + return undef; + } + sleep 1; + next; + } + last; + } + autoflush SOCK 1; + print SOCK "$command\n"; + @reply = ; + close(SOCK); + return join '', @reply; +} + +########################################################################## +# +# &sendmail_running -- check if sendmail is running via SMTP +# +# Parameters: +# none +# +# Returns: +# 1 if running, undef otherwise +# + +sub sendmail_running +{ + my $port = getservbyname("smtp", "tcp") || 25; + my $proto = getprotobyname("tcp"); + my $iaddr = inet_aton("localhost"); + my $paddr = sockaddr_in($port, $iaddr); + + socket(SOCK, PF_INET, SOCK_STREAM, $proto) or return undef; + if (!connect(SOCK, $paddr)) + { + close(SOCK); + return undef; + } + autoflush SOCK 1; + while () + { + if (/^(\d{3})([ -])/) + { + if ($1 != 220) + { + close(SOCK); + return undef; + } + } + else + { + close(SOCK); + return undef; + } + last if ($2 eq " "); + } + print SOCK "QUIT\n"; + while () + { + last if (/^\d{3} /); + } + close(SOCK); + return 1; +} + +########################################################################## +# +# &munge_status -- turn machine readable status into human readable text +# +# Parameters: +# raw -- raw results from sendmail daemon STATUS query +# +# Returns: +# human readable text +# + +sub munge_status +{ + my $raw = shift; + my $cooked = ""; + my $daemonStatus = ""; + + if ($raw =~ /^(\d+)\/(\d+)\/(\d+)\/(\d+)/mg) + { + $cooked .= "Current number of children: $1"; + if ($2 > 0) + { + $cooked .= " (maximum $2)"; + } + $cooked .= "\n"; + $cooked .= "QueueDir free disk space (in blocks): $3\n"; + $cooked .= "Load average: $4\n"; + } + while ($raw =~ /^(\d+) (.*)$/mg) + { + if (not $daemonStatus) + { + $daemonStatus = "(process $1) " . ucfirst($2) . "\n"; + } + else + { + $cooked .= "Child Process $1 Status: $2\n"; + } + } + return ($daemonStatus, $cooked); +} + +########################################################################## +# +# &start_daemon -- fork off a sendmail daemon +# +# Parameters: +# control -- control socket name +# +# Returns: +# Error message or "OK" if successful +# + +sub start_daemon +{ + my $control = shift; + my $pid; + + if ($pid = fork) + { + my $exitstat; + + waitpid $pid, 0 or return "Could not get status of created process: $!\n"; + $exitstat = $? / 256; + if ($exitstat != 0) + { + return "sendmail daemon startup exited with exit value $exitstat"; + } + } + elsif (defined $pid) + { + exec($sendmailDaemon); + die "Unable to start sendmail daemon: $!.\n"; + } + else + { + return "Could not create new process: $!\n"; + } + return "OK\n"; +} + +########################################################################## +# +# &stop_daemon -- stop the sendmail daemon using control socket +# +# Parameters: +# control -- control socket name +# +# Returns: +# Error message or status message +# + +sub stop_daemon +{ + my $control = shift; + my $status; + + if (not defined $control) + { + return "The control socket is not configured so the daemon can not be stopped.\n"; + } + return &do_command($control, "SHUTDOWN"); +} + +########################################################################## +# +# &restart_daemon -- restart the sendmail daemon using control socket +# +# Parameters: +# control -- control socket name +# +# Returns: +# Error message or status message +# + +sub restart_daemon +{ + my $control = shift; + my $status; + + if (not defined $control) + { + return "The control socket is not configured so the daemon can not be restarted."; + } + return &do_command($control, "RESTART"); +} + +########################################################################## +# +# &memdump -- get memdump from the daemon using the control socket +# +# Parameters: +# control -- control socket name +# +# Returns: +# Error message or status message +# + +sub memdump +{ + my $control = shift; + my $status; + + if (not defined $control) + { + return "The control socket is not configured so the daemon can not be queried for memdump."; + } + return &do_command($control, "MEMDUMP"); +} + +########################################################################## +# +# &help -- get help from the daemon using the control socket +# +# Parameters: +# control -- control socket name +# +# Returns: +# Error message or status message +# + +sub help +{ + my $control = shift; + my $status; + + if (not defined $control) + { + return "The control socket is not configured so the daemon can not be queried for help."; + } + return &do_command($control, "HELP"); +} + +my $status = undef; +my $daemonStatus = undef; +my $opts = {}; + +getopts('f:', $opts) || die "Usage: $0 [-f /path/to/control/socket] command\n"; + +my $control = $opts->{f} || &get_controlname; +my $command = shift; + +if (not defined $control) +{ + die "No control socket available.\n"; +} +if (not defined $command) +{ + die "Usage: $0 [-f /path/to/control/socket] command\n"; +} +if ($command eq "status") +{ + $status = &do_command($control, "STATUS"); + if (not defined $status) + { + # Not responding on control channel, query via SMTP + if (&sendmail_running) + { + $daemonStatus = "Sendmail is running but not answering status queries."; + } + else + { + $daemonStatus = "Sendmail does not appear to be running."; + } + } + else + { + # Munge control channel output + ($daemonStatus, $status) = &munge_status($status); + } +} +elsif (lc($command) eq "shutdown") +{ + $status = &stop_daemon($control); +} +elsif (lc($command) eq "restart") +{ + $status = &restart_daemon($control); +} +elsif (lc($command) eq "start") +{ + $status = &start_daemon($control); +} +elsif (lc($command) eq "memdump") +{ + $status = &memdump($control); +} +elsif (lc($command) eq "help") +{ + $status = &help($control); +} +elsif (lc($command) eq "mstat") +{ + $status = &do_command($control, "mstat"); + if (not defined $status) + { + # Not responding on control channel, query via SMTP + if (&sendmail_running) + { + $daemonStatus = "Sendmail is running but not answering status queries."; + } + else + { + $daemonStatus = "Sendmail does not appear to be running."; + } + } +} +else +{ + die "Unrecognized command $command\n"; +} +if (defined $daemonStatus) +{ + print "Daemon Status: $daemonStatus\n"; +} +if (defined $status) +{ + print "$status\n"; +} +else +{ + die "No response\n"; +} diff --git a/contrib/socketmapClient.pl b/contrib/socketmapClient.pl new file mode 100755 index 000000000000..28fe603980ab --- /dev/null +++ b/contrib/socketmapClient.pl @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w +# +# Contributed by Bastiaan Bakker for SOCKETMAP +# $Id: socketmapClient.pl,v 1.1 2003/05/21 15:36:33 ca Exp $ + +use strict; +use IO::Socket; + +die "usage: $0 [ ...]" if (@ARGV < 3); + +my $connection = shift @ARGV; +my $mapname = shift @ARGV; + +my $sock; + +if ($connection =~ /tcp:(.+):([0-9]*)/) { + $sock = new IO::Socket::INET ( + PeerAddr => $1, + PeerPort => $2, + Proto => 'tcp', + ); +} elsif ($connection =~ /((unix)|(local)):(.+)/) { + $sock = new IO::Socket::UNIX ( + Type => SOCK_STREAM, + Peer => $4 + ); +} else { + die "unrecognized connection specification $connection"; +} + +die "Could not create socket: $!\n" unless $sock; + +while(my $key = shift @ARGV) { + my $request = "$mapname $key"; + netstringWrite($sock, $request); + $sock->flush(); + my $response = netstringRead($sock); + + print "$key => $response\n"; +} + +$sock->close(); + +sub netstringWrite { + my $sock = shift; + my $data = shift; + + print $sock length($data).':'.$data.','; +} + +sub netstringRead { + my $sock = shift; + my $saveSeparator = $/; + $/ = ':'; + my $dataLength = <$sock>; + die "cannot read netstring length" unless defined($dataLength); + chomp $dataLength; + my $data; + if ($sock->read($data, $dataLength) == $dataLength) { + ($sock->getc() eq ',') or die "data misses closing ,"; + } else { + die "received only ".length($data)." of $dataLength bytes"; + } + + $/ = $saveSeparator; + return $data; +} diff --git a/contrib/socketmapServer.pl b/contrib/socketmapServer.pl new file mode 100755 index 000000000000..153e9ef0abee --- /dev/null +++ b/contrib/socketmapServer.pl @@ -0,0 +1,98 @@ +#!/usr/bin/perl -w +# +# Contributed by Bastiaan Bakker for SOCKETMAP +# $Id: socketmapServer.pl,v 1.1 2003/05/21 15:36:33 ca Exp $ + +use strict; +use IO::Socket; + +die "usage: $0 " if (@ARGV < 1); +my $connection = shift @ARGV; +my $sock; + +if ($connection =~ /tcp:(.+):([0-9]*)/) { + $sock = new IO::Socket::INET ( + LocalAddr => $1, + LocalPort => $2, + Proto => 'tcp', + Listen => 32, + ReuseAddr => 1 + ); +} elsif ($connection =~ /((unix)|(local)):(.+)/) { + unlink($4); + $sock = new IO::Socket::UNIX ( + Type => SOCK_STREAM, + Local => $4, + Listen => 32 + ); +} else { + die "unrecognized connection specification $connection"; +} + +while(my $client = $sock->accept()) { + my $childpid = fork(); + if ($childpid) { + $client->close(); + } else { + die "can't fork $!" unless defined($childpid); + $sock->close(); + handleConnection($client); + $client->close(); + exit; + } +} + +$sock->close(); + +sub handleConnection { + my $client = shift; + $client->autoflush(1); + + while(!eof($client)) { + eval { + my $request = netstringRead($client); + my ($mapName, $key) = split(' ', $request); + my $value = mapLookup($mapName, $key); + my $result = (defined($value)) ? "OK $value" : "NOTFOUND"; + netstringWrite($client, $result); + }; + if ($@) { + print STDERR "$@\n"; + last; + } + } +} + +sub mapLookup { + my %mapping = ('bastiaan.bakker@example.com' => 'bastiaan', + 'wolter.eldering@example.com' => 'wolter@other.example.com'); + my $mapName = shift; + my $key = shift; + my $value = ($mapName eq "virtuser") ? $mapping{$key} : undef; + return $value; +} + +sub netstringWrite { + my $sock = shift; + my $data = shift; + + print $sock length($data).':'.$data.','; +} + +sub netstringRead { + my $sock = shift; + my $saveSeparator = $/; + $/ = ':'; + my $dataLength = <$sock>; + die "cannot read netstring length" unless defined($dataLength); + chomp $dataLength; + my $data; + if ($sock->read($data, $dataLength) == $dataLength) { + ($sock->getc() eq ',') or die "data misses closing ,"; + } else { + die "received only ".length($data)." of $dataLength bytes"; + } + + $/ = $saveSeparator; + return $data; +} -- cgit v1.2.3