From 100f4f365fd126324a240a151ff287e837455dbc Mon Sep 17 00:00:00 2001 From: glass Date: Fri, 18 Jun 1993 20:41:58 +0000 Subject: [PATCH] baseline commit of sendmail release 8 version 8.1B (this is the sendmail stuff as it will appear in 4.4BSD) --- usr.sbin/sendmail/contrib/README | 10 + usr.sbin/sendmail/contrib/bitdomain.c | 409 +++++ usr.sbin/sendmail/contrib/expn.pl | 1239 +++++++++++++ usr.sbin/sendmail/contrib/mmuegel | 2073 ++++++++++++++++++++++ usr.sbin/sendmail/contrib/rcpt-streaming | 297 ++++ usr.sbin/sendmail/contrib/xla/README | 207 +++ usr.sbin/sendmail/contrib/xla/xla.c | 528 ++++++ 7 files changed, 4763 insertions(+) create mode 100644 usr.sbin/sendmail/contrib/README create mode 100644 usr.sbin/sendmail/contrib/bitdomain.c create mode 100644 usr.sbin/sendmail/contrib/expn.pl create mode 100644 usr.sbin/sendmail/contrib/mmuegel create mode 100644 usr.sbin/sendmail/contrib/rcpt-streaming create mode 100644 usr.sbin/sendmail/contrib/xla/README create mode 100644 usr.sbin/sendmail/contrib/xla/xla.c diff --git a/usr.sbin/sendmail/contrib/README b/usr.sbin/sendmail/contrib/README new file mode 100644 index 000000000000..dcf5c8fe7e0d --- /dev/null +++ b/usr.sbin/sendmail/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 me. + +Eric Allman, 26 May 1993 diff --git a/usr.sbin/sendmail/contrib/bitdomain.c b/usr.sbin/sendmail/contrib/bitdomain.c new file mode 100644 index 000000000000..4fad76175494 --- /dev/null +++ b/usr.sbin/sendmail/contrib/bitdomain.c @@ -0,0 +1,409 @@ +/* + * By John G. Myers, jgm+@cmu.edu + * Version 1.1 + * + * 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/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/bitdomain" and + * "FEATURE(bitdomain,`dbm -o /etc/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:")) != EOF) { + 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 || !index(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 || !index(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/usr.sbin/sendmail/contrib/expn.pl b/usr.sbin/sendmail/contrib/expn.pl new file mode 100644 index 000000000000..4012699cac2f --- /dev/null +++ b/usr.sbin/sendmail/contrib/expn.pl @@ -0,0 +1,1239 @@ +#!/usr/local/bin/perl +'di'; +'ig00'; +# THIS PROGRAM IS ITS OWN MANUAL PAGE. INSTALL IN man & bin. +# groff cannot handle the wrapman constructs, so if you use +# groff, you must cut the manual part out and install it +# separately. + +# hardcoded constants, should work fine for BSD-based systems +$AF_INET = 2; +$SOCK_STREAM = 1; +$sockaddr = 'S n a4 x8'; + +# system requirements: +# must have 'nslookup' and 'hostname' programs. + +# version 3.2, 5/5/93 + +# TODO: +# CERNVM.CERN.CH needs simple logins for the expn command. +# format with groff. +# less magic should apply to command-line addresses +# less magic should apply to local addresses + +# Checklist: (hard addresses) +# harry@hofmann.cs.Berkeley.EDU -> harry@tenet (.berkeley.edu) +# bks@cs.berkeley.edu -> shiva.CS (.berkeley.edu) +# 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 account 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; +$0 = "$av0 - running hostname"; +$ENV{'PATH'} .= ":/usr/etc" unless $ENV{'PATH'} =~ m,/usr/etc,; +chop($hostname = `hostname`); +select(STDERR); + +$usage = "Usage: $av0 [-1avwd] user[@host] [user2[host2] ...]"; +$0 = "$av0 - parsing args"; +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,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; + } +} + +$0 = "$av0 - building local socket"; +($name,$aliases,$proto) = getprotobyname('tcp'); +($name,$aliases,$port) = getservbyname($port,'tcp') + unless $port =~ /^\d+/; +($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); +$this = pack($sockaddr, $AF_INET, 0, $thisaddr); + +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"; + $that = pack($sockaddr, $AF_INET, $port, $thataddr); + socket(S, $AF_INET, $SOCK_STREAM, $proto) + || die "socket: $!"; + $0 = "$av0 - bind to $server"; + bind(S, $this) + || die "bind $hostname,0: $!"; + $0 = "$av0 - connect to $server"; + print "debug = $debug server = $server\n" if $debug > 8; + if (! connect(S, $that) || ($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; + } + select((select(S),$| = 1)[0]); # don't buffer output to S + + # read the greeting + $0 = "$av0 - talking to $server"; + while() { + print if $watch; + if (/^(\d+)([- ])/) { + if ($1 != 220) { + $0 = "$av0 - bad numeric responce from $server"; + &toss($2); + 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 responce 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; + } + } + + # if this causes problems, remove it + $0 = "$av0 - sending helo to $server"; + &ps("helo $hostname"); + while() { + print if $watch; + last if /^\d+ /; + } + + # 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 = (); + } + &ps("expn $u"); + $said_something = 0; + while($s = ) { + $said_something = 1; + + # make sure the server is talking the right language + if ($s =~ /^(\d+)([- ])/) { + if ($1 != 250 && $1 != 550) { + &toss($2); + &ps("vrfy $u"); + $s = ; + if ($s =~ /^(\d+)/) { + if ($1 != 250 && $1 != 550) { + &toss($2); + &giveup('',"$server: expn/vrfy not implemented",$u); + last USER; + } + } + } + } + + $s =~ s/[\n\r]//g; + $0 = "$av0 - parsing $server: $s"; + print "$s\n" if $watch; + if ($s =~ /^250([- ])(.+)/) { + ($done,$addr) = ($1,$2); + ($newhost, $newaddr, $newname) = &parse($addr,$server,$oldname); + 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 responces + # 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; + } + &giveup('',"$server: did not grok '$s'",$u); + last USER; + } + if (! $said_something) { + &giveup('',"$server: lost connection",$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)); + } + } + } + + $0 = "$av0 - sending 'quit' to $server"; + &ps("quit"); + while() { + print if $watch; + last if /^\d+ /; + } + close(S); +} + +$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); + + $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!!! 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 + # Nest 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; +} +# returns ($new_smtp_server,$new_address,$new_name) +# given a responce 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 parse +{ + local($newaddr,$context_host,$old_name,$parsing_args) = @_; + local(@names) = $old_name; + local($urx) = "[-A-Za-z_.0-9+]+"; + + # + # 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 + # + 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)); + } + if ($newaddr =~ /^(.+)\@($urx)$/) { + print "(\@)" if $debug; + return (&domainify($2,$context_host,$newaddr),$newaddr,&firstname(@names)); + } + if ($parsing_args) { + if ($newaddr =~ /^($urx)\!(.+)$/) { + return (&domainify($1,$context_host,$newaddr),$newaddr,&firstname(@names)); + } + if ($newaddr =~ /^($urx)$/) { + return ($context_host,$newaddr,&firstname(@names)); + } + print STDERR "Could not parse $newaddr\n"; + } + print "(?)" if $debug; + return(undef,$newaddr,&firstname(@names)); +} +# 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 failes, 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"; + open(T,">/tmp/expn$$") || 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}) { +# for $u (@users) { +# print "mx_secondary{$u *** $nserver} = ".$fallback{$cpref}."\n" +# if $debug; +# $mx_secondary{"$u *** $nserver"} = $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"; +} +# read the rest of the current smtp daemon's responce (and toss it away) +sub toss +{ + local($done) = @_; + print $s if $watch; + while(($done eq "-") && ($s = ) && ($s =~ /^\d+([- ])/)) { + print $s if $watch; + $done = $1; + } +} +# 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; +################### BEGIN PERL/TROFF TRANSITION +.00; + +'di \\ " finish diversion--previous line must be blank +.nr nl 0-1 \\ " fake up transition to first page again +.nr % 0 \\ " start at page 1 +'; __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 ] +.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 enviroment 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 to +.IR idiom.berkeley.ca.us . +.SH AUTHOR +.I David Muir Sharnoff\ \ \ \ diff --git a/usr.sbin/sendmail/contrib/mmuegel b/usr.sbin/sendmail/contrib/mmuegel new file mode 100644 index 000000000000..d462097ade1b --- /dev/null +++ b/usr.sbin/sendmail/contrib/mmuegel @@ -0,0 +1,2073 @@ +Return-Path: mmuegel@cssmp.corp.mot.com +Received: from hofmann.CS.Berkeley.EDU by auspex.Berkeley.EDU (ALPHA-6.30/6.9) id AA02096; Sun, 11 Apr 1993 19:50:02 -0700 +Received: from motgate.mot.com by hofmann.CS.Berkeley.EDU (ALPHA-6.35/6.16) id AA14977; Sun, 11 Apr 1993 19:49:57 -0700 +Received: from pobox.mot.com ([129.188.137.100]) by motgate.mot.com with SMTP (5.65c/IDA-1.4.4/MOT-2.13 for ) + id AA05603; Sun, 11 Apr 1993 21:49:54 -0500 +Received: from cssmp.corp.mot.com by pobox.mot.com with SMTP (5.65c/IDA-1.4.4/MOT-2.12 for ) + id AA08281; Sun, 11 Apr 1993 21:49:51 -0500 +Received: by cssmp.corp.mot.com (5.65c/IDA-1.4.4/MOT-2.12 for eric@cs.berkeley.edu) + id AA02812; Sun, 11 Apr 1993 21:49:48 -0500 +From: "Michael S. Muegel" +Message-Id: <199304120249.AA02812@cssmp.corp.mot.com> +Subject: Sendmail tools README +To: eric@cs.berkeley.edu (Eric Allman) +Date: Sun, 11 Apr 1993 21:49:48 -0500 (CDT) +Cc: costales@icsi.berkeley.edu (Bryan Costales) +X-Mailer: ELM [version 2.4 PL17] +Mime-Version: 1.0 +Content-Type: text/plain; charset=US-ASCII +Content-Transfer-Encoding: 7bit +Content-Length: 67910 + + +As promised, here is a new distribution with a decent README. + +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 04/12/1993 02:34 UTC by mmuegel@mot.com (Michael S. Muegel) +# Source directory /usr/var/rtmp/shar2336 +# +# existing files will NOT be overwritten unless -c is specified +# +# This shar contains: +# length mode name +# ------ ---------- ------------------------------------------ +# 4367 -r--r--r-- README +# 11619 -r--r--r-- libs/date.pl +# 3243 -r--r--r-- libs/elapsed.pl +# 4379 -r--r--r-- libs/mail.pl +# 6953 -r--r--r-- libs/mqueue.pl +# 7030 -r--r--r-- libs/newgetopts.pl +# 4718 -r--r--r-- libs/strings1.pl +# 1637 -r--r--r-- libs/timespec.pl +# 5229 -r--r--r-- man/cqueue.1 +# 2097 -r--r--r-- man/postclip.1 +# 6702 -r-xr-xr-x src/cqueue +# 1900 -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 $Author: mmuegel $ +X $Source: /usr/local/ustart/src/mail-tools/doc/RCS/README-cqueue-postclip,v $ +X $Revision: 1.2 $ of $Date: 1993/04/12 02:21:28 $ +------------------------------------------------------------------------------- +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 4367 -eq "$Wc_c" || + echo 'README: original size 4367, 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 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.3 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@gvc.com +;# +;# Modification History +;# Nmemonic Version Date Who +;# +;# NONE 1.0 02feb91 Terry McGonigal (tmcgonigal@gvc.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... +;# +;# SccsId = "%W% %E%" +;# +package date; +X +# Months of the year +@MoY = ('January', 'Febuary', '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($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($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 ($yday, $firstweekday) = @_; +X local ($jan1, @jan1, $wks); +X local ($now) = time; +X +X # figure out the `time' value for January 1 +X $jan1 = $now - ((&gettime ($TZ, $now))[7] * 86400); # 86400 sec/day +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 +# 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 11619 -eq "$Wc_c" || + echo 'libs/date.pl: original size 11619, 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 +;# $Author: mmuegel $ +;# $Source: /usr/local/ustart/src/perl-stuff/libs/local/RCS/elapsed.pl,v $ +;# $Revision: 1.2 $ of $Date: 1993/01/12 22:48:22 $ +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 3243 -eq "$Wc_c" || + echo 'libs/elapsed.pl: original size 3243, 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 +;# $Author: mmuegel $ +;# $Header: /usr/local/ustart/src/perl-stuff/libs/local/RCS/mail.pl,v 1.4 1993/01/06 19:45:58 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 4379 -eq "$Wc_c" || + echo 'libs/mail.pl: original size 4379, 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 +;# $Author: mmuegel $ +;# $Source: /usr/local/ustart/src/perl-stuff/libs/local/RCS/mqueue.pl,v $ +;# $Revision: 1.5 $ of $Date: 1993/03/18 16:25:05 $ +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 6953 -eq "$Wc_c" || + echo 'libs/mqueue.pl: original size 6953, 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) +;# +;# $Author: mmuegel $ +;# $Header: //fwans00/usr/local/lib/perl/RCS/newgetopts.pl,v 1.6 91/09/05 16:29:39 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 7030 -eq "$Wc_c" || + echo 'libs/newgetopts.pl: original size 7030, 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 +;# $Author: mmuegel $ +;# $Header: /usr/local/ustart/src/perl-stuff/libs/local/RCS/strings1.pl,v 1.9 1993/03/02 21:20:10 mmuegel Exp mmuegel $ +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 4718 -eq "$Wc_c" || + echo 'libs/strings1.pl: original size 4718, 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 +;# $Author: mmuegel $ +;# $Header: /usr/local/ustart/src/perl-stuff/libs/fwrdc/misc/RCS/timespec.pl,v 1.2 1992/06/10 04:14:05 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 1637 -eq "$Wc_c" || + echo 'libs/timespec.pl: original size 1637, 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 +\" +\" $Author: mmuegel $ +\" $Header: /usr/local/ustart/src/mail-tools/man/RCS/cqueue.1,v 1.2 1993/01/19 18:19: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 5229 -eq "$Wc_c" || + echo 'man/cqueue.1: original size 5229, 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 +\" +\" $Author: mmuegel $ +\" $Header: /usr/local/ustart/src/mail-tools/man/RCS/postclip.man,v 1.2 1993/01/06 22:18:39 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 2097 -eq "$Wc_c" || + echo 'man/postclip.1: original size 2097, 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 +# $Author: mmuegel $ +# $Header: /usr/local/ustart/src/mail-tools/src/RCS/cqueue,v 1.16 1993/01/21 20:57:31 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 \$Author: mmuegel $; \$Revision: 1.16 $ of \$Date: 1993/01/21 20:57:31 $"; +$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 6702 -eq "$Wc_c" || + echo 'src/cqueue: original size 6702, 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 +# $Source: /usr/local/ustart/src/mail-tools/src/RCS/postclip,v $ +# $Revision: 1.2 $ of $Date: 1993/01/06 22:24:37 $ +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 \$Author: mmuegel $; \$Revision: 1.2 $ of \$Date: 1993/01/06 22:24:37 $"; +$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 1900 -eq "$Wc_c" || + echo 'src/postclip: original size 1900, 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 | ++----------------------------------------------------------------------------+ diff --git a/usr.sbin/sendmail/contrib/rcpt-streaming b/usr.sbin/sendmail/contrib/rcpt-streaming new file mode 100644 index 000000000000..329a9782869c --- /dev/null +++ b/usr.sbin/sendmail/contrib/rcpt-streaming @@ -0,0 +1,297 @@ +(Message /home/auspex/a/staff/eric/.mh/inbox:2575) +From: John Gardiner Myers +Subject: contrib/rcpt-streaming +Date: Fri, 4 Jun 1993 13:54:06 -0400 (EDT) +To: sendmail@cs.berkeley.edu + +This patch implements "RCPT streaming" in sendmail version 6. This +patch is not an official part of sendmail. Please report all problems +with this patch to jgm+@cmu.edu. + +RCPT streming avoids network round trips by sending all RCPT commands +for a single SMTP transaction together. Sendmail then waits for all +the replies, matching them up with the apropriate addresses. + +Apply to the sendmail src directory (your line numbers may vary) and +compile with -DRCPTSTREAM + +diff -cr src.orig/deliver.c src/deliver.c +*** src.orig/deliver.c Thu May 27 14:38:22 1993 +--- src/deliver.c Fri Jun 4 13:50:02 1993 +*************** +*** 1325,1330 **** +--- 1325,1345 ---- + register int i; + + /* send the recipient list */ ++ #ifdef RCPTSTREAM ++ /*********************************************************************** ++ * ++ * RCPT streaming code by John G Myers, jgm+@cmu.edu ++ * This is not supported by the maintainer of sendmail. ++ * Report all bugs concerning RCPT streaming to jgm+@cmu.edu ++ * ++ *********************************************************************** ++ */ ++ for (to = tochain; to != NULL; to = to->q_tchain) ++ { ++ smtpstreammessage("RCPT To:<%s>", m, mci, ++ to->q_user); ++ } ++ #endif + tobuf[0] = '\0'; + for (to = tochain; to != NULL; to = to->q_tchain) + { +diff -cr src.orig/usersmtp.c src/usersmtp.c +*** src.orig/usersmtp.c Thu May 27 14:38:09 1993 +--- src/usersmtp.c Fri Jun 4 13:48:24 1993 +*************** +*** 44,49 **** +--- 44,61 ---- + + # include + # include ++ #ifdef RCPTSTREAM ++ /*********************************************************************** ++ * ++ * RCPT streaming code by John G Myers, jgm+@cmu.edu ++ * This is not supported by the maintainer of sendmail. ++ * Report all bugs concerning RCPT streaming to jgm+@cmu.edu ++ * ++ *********************************************************************** ++ */ ++ # include ++ # include ++ #endif + + # ifdef SMTP + +*************** +*** 62,67 **** +--- 74,87 ---- + char SmtpError[MAXLINE] = ""; /* save failure error messages */ + int SmtpPid; /* pid of mailer */ + ++ #ifdef RCPTSTREAM ++ char *SmtpStreamBuf; /* buffer for streaming output */ ++ int SmtpStreamBufSize = 0; /* allocated size of buffer */ ++ char *SmtpStreamStart; /* pointer to text not yet written */ ++ int SmtpStreamLen = 0; /* # chars not yet written */ ++ #endif ++ ++ + #ifdef __STDC__ + extern smtpmessage(char *f, MAILER *m, MCI *mci, ...); + #endif +*************** +*** 404,410 **** +--- 424,432 ---- + { + register int r; + ++ #ifndef RCPTSTREAM + smtpmessage("RCPT To:<%s>", m, mci, to->q_user); ++ #endif + + SmtpPhase = mci->mci_phase = "RCPT wait"; + setproctitle("%s %s: %s", e->e_id, CurHostName, mci->mci_phase); +*************** +*** 626,631 **** +--- 648,657 ---- + bool firstline = TRUE; + char junkbuf[MAXLINE]; + ++ #ifdef RCPTSTREAM ++ extern char MsgBuf[]; /* err.c */ ++ #endif ++ + if (mci->mci_out != NULL) + (void) fflush(mci->mci_out); + +*************** +*** 641,646 **** +--- 667,709 ---- + register char *p; + extern time_t curtime(); + ++ #ifdef RCPTSTREAM ++ if (SmtpStreamLen > 0) { ++ int outfd; ++ ++ outfd = fileno(mci->mci_out); ++ ++ nonblock(outfd, TRUE); ++ r = write(outfd, SmtpStreamStart, SmtpStreamLen); ++ nonblock(outfd, FALSE); ++ if (r == -1 && errno != EAGAIN ++ #ifdef EWOULDBLOCK ++ && errno != EWOULDBLOCK ++ #endif ++ ) { ++ ++ mci->mci_errno = errno; ++ message("451 streamreply: write error to %s", ++ mci->mci_host); ++ ++ /* if debugging, pause so we can see state */ ++ if (tTd(18, 100)) ++ pause(); ++ # ifdef LOG ++ if (LogLevel > 0) ++ syslog(LOG_INFO, "%s", &MsgBuf[4]); ++ # endif /* LOG */ ++ /* stop trying to write output */ ++ SmtpStreamLen = 0; ++ continue; ++ } ++ if (r > 0) { ++ SmtpStreamStart += r; ++ SmtpStreamLen -= r; ++ } ++ } ++ #endif /* RCPTSTREAM */ ++ + /* actually do the read */ + if (e->e_xfp != NULL) + (void) fflush(e->e_xfp); /* for debugging */ +*************** +*** 742,747 **** +--- 805,880 ---- + + return (r); + } ++ ++ #ifdef RCPTSTREAM ++ /* ++ ** SMTPSTREAMMESSAGE -- buffer message to be streamed to server ++ ** ++ ** Parameters: ++ ** f -- format ++ ** m -- the mailer to control formatting. ++ ** a, b, c -- parameters ++ ** ++ ** Returns: ++ ** none. ++ ** ++ ** Side Effects: ++ ** stores message in SmtpStreamBuf ++ */ ++ ++ /*VARARGS1*/ ++ #ifdef __STDC__ ++ smtpstreammessage(char *f, MAILER *m, MCI *mci, ...) ++ #else ++ smtpstreammessage(f, m, mci, va_alist) ++ char *f; ++ MAILER *m; ++ MCI *mci; ++ va_dcl ++ #endif ++ { ++ VA_LOCAL_DECL ++ int len; ++ ++ VA_START(mci); ++ (void) vsprintf(SmtpMsgBuffer, f, ap); ++ VA_END; ++ ++ if (tTd(18, 1) || Verbose) ++ nmessage(">>> %s", SmtpMsgBuffer); ++ ++ if (mci->mci_out == NULL) { ++ if (tTd(18, 1)) printf("smtpstreammessage: NULL mci_out\n"); ++ return; ++ } ++ ++ strcat(SmtpMsgBuffer, m == NULL ? "\r\n" : m->m_eol); ++ len = strlen(SmtpMsgBuffer); ++ ++ if (SmtpStreamLen == 0) { ++ if (SmtpStreamBufSize == 0) { ++ SmtpStreamBufSize = MAXLINE; ++ SmtpStreamBuf = xalloc(SmtpStreamBufSize); ++ } ++ SmtpStreamStart = SmtpStreamBuf; ++ } ++ ++ if (SmtpStreamBufSize - SmtpStreamLen < len + 1) { ++ int start = SmtpStreamStart - SmtpStreamBuf; ++ SmtpStreamBufSize += MAXLINE; ++ SmtpStreamBuf = realloc(SmtpStreamBuf, SmtpStreamBufSize); ++ if (!SmtpStreamBuf) { ++ syserr("Out of memory!!"); ++ abort(); ++ /* exit(EX_UNAVAILABLE); */ ++ } ++ SmtpStreamStart = SmtpStreamBuf + start; ++ } ++ ++ strcpy(SmtpStreamBuf + SmtpStreamLen, SmtpMsgBuffer); ++ SmtpStreamLen += len; ++ } ++ #endif /* RCPTSTREAM */ + /* + ** SMTPMESSAGE -- send message to server + ** +Only in src: usersmtp.c.orig +Only in src: usersmtp.c~ +Only in src: usersmtp.o +diff -cr src.orig/util.c src/util.c +*** src.orig/util.c Thu May 27 14:38:20 1993 +--- src/util.c Wed Jun 2 16:39:15 1993 +*************** +*** 955,960 **** +--- 955,1004 ---- + return (FALSE); + return (TRUE); + } ++ ++ #ifdef RCPTSTREAM ++ /*********************************************************************** ++ * ++ * RCPT streaming code by John G Myers, jgm+@cmu.edu ++ * This is not supported by the maintainer of sendmail. ++ * Report all bugs concerning RCPT streaming to jgm+@cmu.edu ++ * ++ *********************************************************************** ++ */ ++ ++ #include ++ ++ /* ++ ** NONBLOCK -- set or clear non-blocking mode on file descriptor ++ ** ++ ** Parameters: ++ ** fd -- the file descriptor ++ ** mode -- TRUE to set non-blocking mode ++ ** FALSE to clear non-blocking mode ++ ** ++ ** Returns: ++ ** none ++ ** ++ ** Side Effects: ++ ** modifies nonblocking status of fd ++ */ ++ ++ nonblock(fd, mode) ++ int fd; ++ bool mode; ++ { ++ int flags; ++ ++ flags = fcntl(fd, F_GETFL, 0); ++ if (mode) { ++ flags |= FNONBIO; ++ } ++ else { ++ flags &= ~FNONBIO; ++ } ++ fcntl(fd, F_SETFL, flags); ++ } ++ #endif + /* + ** STRCONTAINEDIN -- tell if one string is contained in another + ** +Only in src: util.c.orig +Only in src: util.o +Only in src: version.o diff --git a/usr.sbin/sendmail/contrib/xla/README b/usr.sbin/sendmail/contrib/xla/README new file mode 100644 index 000000000000..a72fd03c832b --- /dev/null +++ b/usr.sbin/sendmail/contrib/xla/README @@ -0,0 +1,207 @@ + XLA - Extended Load Average design for Sendmail R6 + -------------------------------------------------- + + Christophe Wolfhugel - Herve Schauer Consultants + wolf@grasp.insa-lyon.fr, wolf@hsc-sec.fr + + +WARNING: this extension is supplied as a contribution to Sendmail. +Should you have trouble, questions, please contact me directly, and +*not* the Sendmail development team. + + +ABSTRACT + +Sendmail currently furnishes a limitation mecanism which is based on +the system load average, when available. Experience has prooven that +this was not sufficiant for some particular situations, for example +if you have slow and/or overloaded links. This can easily cause both +system and network congestions with Sendmail having to handle a large +number of simultaneous sessions on the same overloaded link, causing +most of the SMTP sessions to timeout after a long time. The system +load average is also generally too slow to react when your system +gets a burst of incoming or outgoing SMTP sessions which on some +stations can easily cause system unavailabilities. + +The extended load average module has been designed in order to furnish +a way of limitation the load generated by Sendmail to both your +system and your network. This design can be used either alone or as +complementary to the system load average if your system supports it. + +Limitation is based on the number of incoming/outgoing SMTP sessions, +and remote hosts are classified in classes. The system administrator +will define a maximum number of incoming SMTP sessions as well as +a maximum total (incoming + outgoing) sessions for each class of +hosts. A class can be either an individual machine or a network. + +When the limit is reached for a given class, all incoming SMTP +connections will be politely refused. When the limit is reached for +all classes, the SMTP connections will be refused by the system +(which one could consider as less politely :)). +On outgoing mail, messages will be queued for delayed processing. + +The extended load average parameters are given in the Sendmail +configuration file, and when not present, Sendmail behaves the +usual way. + + +COMPILATION + +Copy the xla.c module in the src sub-directory, edit the Makefile +in order to define XLA (-DXLA). Also add the xla.[co] module name +in the list of files so that it gets compiled. + +Regenerate sendmail by removing all objects, or at least those +containing references to XLA (this list may vary, so use grep to +get the module list). This will generate a new sendmail executable +containing the xla code. + +Debugging level 59 has been assigned to this module and when used +it provides some output (sendmail -d59.x). Please check the source +code to see which levels are supported. + + +CONFIGURATION + +The extended average uses a new set of configuration lines in the +sendmail.cf file. All newly introduced line begin with the letter L +(capital L). + +Before detailling the syntax, first an example (this can be placed +at any section of the sendmail.cf file, note that the order is +important). Fields are separated by (one or more) tabs/spaces. + +# File name used to store the counters +L/etc/sendmail.la +# Classes definition +# Lname #queue #reject +L*.insa-lyon.fr 8 3 +L*.univ-lyon1.fr 6 4 +L* 15 16 + +The first line defines the working file which will be used in order +to have the occurences of Sendmail read and update the counters. The +format of this file is described in the "Design" section. +This line is mandatory and the specified file must be absolute (ie +begin with a slash). + +Then you can specify one or more classes. The last class (*) is also +mandatory and should be in last position as the first match will stop +the search and if there is no match the behavior of Sendmail is unknown. + +Each class has three fields separated by one or more tabs/spaces. + +L{mask} {queue_#} {refuse_#} + +The {mask} is a simple mask. It can be either an explicit host name +(like grasp.insa-lyon.fr) or a mask starting with "*." or just "*". +No other variants are allowed. + +Lgrasp.insa-lyon.fr will match exactely any session to/from this host. + +L*.insa-lyon.fr will match any session to/from any machine in the + insa-lyon.fr domain as well as from the machine + named "insa-lyon.fr" if it exists. + +L* will match any session, and thus should also be + last in the list to act as a catchup line. + +The {queue_#} is the maximum number of SMTP sessions in the given class +for both incoming and outgoing messages. The {refuse_#} indicates when +to refuse incoming messages for this class. The interaction between +those counters is somewhat subtle. It seems logical that a standard +configuration has {queue_#} >= {refuse_#}, and in fact in most +configurations they can be equal (that's why what I use in my environment). +Thus, this is not mandatory. If {queue_#} < {refuse_#} outgoing messages +will be lower priority than incoming messages and once a class gets loaded +the outgoing messages are blocked first. + +I use very low values in some situations, for example I have a customer +connected to the Internet via a 9600 bps line, they also have internal +users sending burst of messages (10, 20 small messages coming in just +one or two seconds). Both situations were unsupportable. The line is +too slow to handle many simultaneous connections and the mail server +does not have the ressources to handle such a heavy load (it's a 12 Megs +Sun 3 also doing Usenet news). + +I have defined following section in the configuration file, and experience +shows the benefits for everyone. Fake domain for the example: customer.fr. + +L/etc/sendmail.la +L*.customer.fr 8 8 +L* 3 3 + +This means that there might not be more than 8 simultaneous SMTP sessions +between the mail server and any other internal host. This is to protect +the station from heavy loads like users (or applications !) sending +several tenths of messages in just a few seconds). +No more than 3 SMTP sessions are authorized with any other host, this is +to save the load of the slow 9600 line to the Internet. + +Drawback is that is you have 3 * 2 Megs sessions established from/to the +outside, all your mail will be held until one slot gets available, on +a 9600 bps line just make your counts, il blocks your line during over +one hour. + + +DESIGN + +Sendmail will analyze the "L" lines in the configuration file during +startup (or read the initialized structure from the frozen file). +When started in daemon mode (and only there), any existing working file +will be cleared and a new one is created. Each class gets a record in +the sendmail.la work file. The size of this record is a short integer +(generally two bytes) and represents the count of active sessions in +the given class. Read/Write operations in this file are done in +one operation (as anyway the size is far below one disk sector). The +file is locked with Sendmail's lockfile() function priori to any +access. + +Handling incoming SMTP sessions. + +There is interaction is two points in the Sendmail source code. First +on the listen system call: if all slots in all classes are in use, +a listen(0) is done so that the system rejects any incoming SMTP session. +This avois to fork and then reject the connexion. + +If there are some free slots, nothing better than accepting the +connection, then forking can be done. The child process then checks if +the adequate class is full or not. If full, it rejects the connection +with a "421 Too many sessions" diagnostic to the sender (which should +then appear when the remote users do a mailq). If the treshold {reject_#} +is not reached, the connection is accepted and the counter is sendmail.la +is updated. + +Handling outgoing SMTP sessions. + +As soon as Sendmail needs to connect to a distant host, the adequate class +is checked against {queue_#} and if no slots are available, the message is +queued for further processing. + +Sendmail's connection caching. + +Sendmail-R6 introduces a new design: connection caching, ie several SMTP +sessions can be opened at the same time. This could cause some problems +when sending mail, as after having a few connections opened, all slots +could be in use and generate a partial delivery of the message. In +order to deal with this, xla.c uses following design "for a given +sendmail process, only the first connection in a given class is counted". +This can be done because sendmail does not do parralel message sending +on the different channels. + +End of connection. + +As soon as a connection is closed, the counters will be automatically +updated. + + + +Please look at the code to understand of all this works. Comments, +suggestions, questions welcome. + + + + Christophe Wolfhugel + Herve Schauer Consultants + Paris, France + May 23, 1993 diff --git a/usr.sbin/sendmail/contrib/xla/xla.c b/usr.sbin/sendmail/contrib/xla/xla.c new file mode 100644 index 000000000000..1b3c30847e0f --- /dev/null +++ b/usr.sbin/sendmail/contrib/xla/xla.c @@ -0,0 +1,528 @@ +/* + * (C) Copyright 1993, Herve Schauer Consultants + * + * This module written by Christophe.Wolfhugel@hsc-sec.fr + * is to be used under the same conditions and terms (and absence + * or warranties) than the other modules of the Sendmail package. + * + * ABSOLUTELY NO WARRANTY. USE AT YOUR OWN RISKS. + * + */ + + +#ifdef XLA + +#ifndef MAXLARULES +# define MAXLARULES 20 +#endif + +# include "sendmail.h" + +typedef struct { + short queue; /* # of connexions to have queueing */ + short reject; /* # of conn. to reject */ + short num; /* # of increments this process */ + char *mask; /* Mask (domain) */ + } XLARULE; + +char *XlaFname; /* Work file name */ +char XlaHostName[1024]; /* Temporary */ +int XlaNext; /* # of XlaRules */ +pid_t XlaPid; /* Pid updating the tables */ +XLARULE XlaRules[MAXLARULES]; /* The rules themselves */ +short XlaCtr[MAXLARULES]; /* Counter (for work file only) */ + +extern bool lockfile(); + +/* +** XLAMATCH -- Matches a fnmatch like expression. +** +** Parameters: +** mask -- mask to match the string too; +** name -- string. +** +** Mask can either be a plain string or a simplified fnmatch like mask: +** *.string or string.* +** No other alternatives are accepted. +** +** Returns: +** none. +** +** Side Effects: +** none. +*/ + +bool +XlaMatch(mask, name) + char *mask, *name; +{ + int l1, l2; + + l1 = strlen(mask); l2 = strlen(name); + if (l1 == 1 && mask[0] == '*') return(TRUE); + if (mask[0] == '*' && mask[1] == '.') { + if (l2 < (l1 - 2)) return(FALSE); + if (strcasecmp(&mask[2], name) == 0) return(TRUE); + if (strcasecmp(&mask[1], name + l2 - l1 + 1) == 0) return(TRUE); + return(FALSE); + } + if (l1 < 3) return(FALSE); + if (mask[l1 -1] == '*') { + if (l2 < l1 - 1) return(FALSE); + if (strncasecmp(mask, name, l1 - 1) == 0) return(TRUE); + return(FALSE); + } + if (strcasecmp(mask, name) == 0) return(TRUE); + return(FALSE); +} + +/* +** XLAZERO -- Zeroes the used variables +** +** Just initializes some variables, called once at sendmail +** startup. +** +** Parameters: +** none. +** +** Returns: +** none. +** +** Side Effects: +** none. +*/ + +xla_zero() +{ + if (tTd(59, 1)) { + printf("xla_zero\n"); + } + XlaFname = NULL; + XlaNext = 0; + XlaPid = 0; + memset(&XlaRules[0], 0, sizeof(XLARULE) * MAXLARULES); +} + + +/* +** XLAINIT -- initialized extended load average stuff +** +** This routine handles the L lines appearing in the configuration +** file. +** +** L/etc/sendmail.la indicates the working file +** Lmask #1 #2 Xtended LA to apply to mask +** #1 = Queueing # of connections +** #2 = Reject connections. +** +** Parameters: +** line -- the cf file line to parse. +** +** Returns: +** none. +** +** Side Effects: +** Builds several internal tables. +*/ + +xla_init(line) + char *line; +{ + char *s; + + if (tTd(59, 1)) { + printf("xla_init line: %s\n", line); + } + if (XlaFname == NULL && *line == '/') { /* Work file name */ + XlaFname = newstr(line); + if (tTd(59, 10)) + printf("xla_init: fname = %s\n", XlaFname); + return; + } + if (XlaNext == MAXLARULES) { + syserr("too many xla rules defined (%d max)", MAXLARULES); + return; + } + s = strtok(line, " \t"); + if (s == NULL) { + syserr("xla: line unparseable"); + return; + } + XlaRules[XlaNext].mask = newstr(s); + s = strtok(NULL, " \t"); + if (s == NULL) { + syserr("xla: line unparseable"); + return; + } + XlaRules[XlaNext].queue = atoi(s); + s = strtok(NULL, " \t"); + if (s == NULL) { + syserr("xla: line unparseable"); + return; + } + XlaRules[XlaNext].reject = atoi(s); + if (tTd(59, 10)) + printf("xla_init: rule #%d = %s q=%d r=%d\n", XlaNext, + XlaRules[XlaNext].mask, + XlaRules[XlaNext].queue, XlaRules[XlaNext].reject); + XlaNext++; +} + + +/* +** XLACREATEFILE -- Create the working file +** +** Tries to create the working file, called each time sendmail is +** invoked with the -bd option. +** +** Parameters: +** none. +** +** Returns: +** none. +** +** Side Effects: +** Creates the working file (sendmail.la) and zeroes it. +*/ + +xla_create_file() +{ + int fd, i; + + if (tTd(59, 1)) + printf("xla_create_file:\n"); + if (XlaFname == NULL) return; + fd = open(XlaFname, O_RDWR|O_CREAT, 0644); + if (fd == -1) { + XlaFname = NULL; + syserr("xla_create_file: open failed"); + return; + } + if (!lockfile(fd, XlaFname, LOCK_EX)) { + close(fd); + XlaFname = NULL; + syserr("xla_create_file: can't set lock"); + return; + } + if (ftruncate(fd, 0) == -1) { + close(fd); + XlaFname = NULL; + syserr("xla_create_file: can't truncate XlaFname"); + return; + } + if (write(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + XlaFname == NULL; + syserr("xla_create_file: can't write XlaFname"); + } + close(fd); +} + + +/* +** XLASMTPOK -- Checks if all slots are in use +** +** Check is there are still some slots available for an SMTP +** connection. +** +** Parameters: +** none. +** +** Returns: +** TRUE -- slots are available; +** FALSE -- no more slots. +** +** Side Effects: +** Reads a file, uses a lock and updates sendmail.la if a slot +** is free for use. +*/ + +bool +xla_smtp_ok() +{ + int fd, i; + + if (tTd(59, 1)) + printf("xla_smtp_ok:\n"); + if (XlaFname == NULL) return(TRUE); + fd = open(XlaFname, O_RDWR, 0644); + if (fd == -1) { + XlaFname = NULL; + syserr("xla_smtp_ok: open failed"); + return(TRUE); + } + if (!lockfile(fd, XlaFname, LOCK_EX)) { + close(fd); + XlaFname = NULL; + syserr("xla_smtp_ok: can't set lock"); + return(TRUE); + } + if (read(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + close(fd); + XlaFname = NULL; + syserr("xla_smtp_ok: can't read XlaFname"); + return(TRUE); + } + close(fd); + for (i = 0; i < XlaNext; i++) { + if (XlaCtr[i] < XlaRules[i].reject) + return(TRUE); + } + return(FALSE); +} + + +/* +** XLAHOSTOK -- Can we accept a connection from this host +** +** Check the quota for the indicated host +** +** Parameters: +** name -- host name or IP# (string) +** +** Returns: +** TRUE -- we can accept the connection; +** FALSE -- we must refuse the connection.1 +** +** Side Effects: +** Reads and writes a file, uses a lock and still updates +** sendmail.la is a slot gets assigned. +*/ + +bool +xla_host_ok(name) + char *name; +{ + int fd, i; + + if (tTd(59, 1)) + printf("xla_host_ok:\n"); + if (XlaFname == NULL) return(TRUE); + fd = open(XlaFname, O_RDWR, 0644); + if (fd == -1) { + XlaFname = NULL; + syserr("xla_host_ok: open failed"); + return(TRUE); + } + XlaPid = getpid(); + if (!lockfile(fd, XlaFname, LOCK_EX)) { + close(fd); + XlaFname = NULL; + syserr("xla_host_ok: can't set lock"); + return(TRUE); + } + if (read(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + close(fd); + XlaFname = NULL; + syserr("xla_smtp_ok: can't read XlaFname"); + return(TRUE); + } + strncpy(XlaHostName, name, sizeof(XlaHostName) -1); + XlaHostName[sizeof(XlaHostName) -1] = 0; + i = strlen(name) - 1; + if (i >= 0 && XlaHostName[i] == '.') XlaHostName[i] = 0; + for (i = 0; i < XlaNext; i++) { + if (XlaMatch(XlaRules[i].mask, XlaHostName)) { + if (XlaCtr[i] < XlaRules[i].reject) { + if (XlaRules[i].num++ == 0) { + XlaCtr[i]++; + lseek(fd, i*sizeof(XlaCtr[i]), SEEK_SET); + if (write(fd, &XlaCtr[i], sizeof(XlaCtr[i])) != sizeof(XlaCtr[i])) + XlaFname = NULL; + } + close(fd); + return(TRUE); + } + close(fd); + return(FALSE); + } + } + close(fd); + return(TRUE); +} + +/* +** XLANOQUEUEOK -- Can we sent this message to the remote host +** +** Check if we can send to the remote host +** +** Parameters: +** name -- host name or IP# (string) +** +** Returns: +** TRUE -- we can send the message to the remote site; +** FALSE -- we can't connect the remote host, queue. +** +** Side Effects: +** Reads and writes a file, uses a lock. +** And still updates the sendmail.la file. +*/ + +bool +xla_noqueue_ok(name) + char *name; +{ + int fd, i; + + if (tTd(59, 1)) + printf("xla_noqueue_ok:\n"); + if (XlaFname == NULL) return(TRUE); + fd = open(XlaFname, O_RDWR, 0644); + if (fd == -1) { + XlaFname = NULL; + syserr("xla_noqueue_ok: open failed"); + return(TRUE); + } + if (!lockfile(fd, XlaFname, LOCK_EX)) { + close(fd); + XlaFname = NULL; + syserr("xla_noqueue_ok: can't set lock"); + return(TRUE); + } + XlaPid = getpid(); + if (read(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + close(fd); + XlaFname = NULL; + syserr("xla_noqueue_ok: can't read XlaFname"); + return(TRUE); + } + strncpy(XlaHostName, name, sizeof(XlaHostName) -1); + XlaHostName[sizeof(XlaHostName) -1] = 0; + i = strlen(name) - 1; + if (i >= 0 && XlaHostName[i] == '.') XlaHostName[i] = 0; + for (i = 0; i < XlaNext; i++) { + if (XlaMatch(XlaRules[i].mask, XlaHostName)) { + if (XlaCtr[i] < XlaRules[i].queue) { + if (XlaRules[i].num++ == 0) { + XlaCtr[i]++; + lseek(fd, i*sizeof(XlaCtr[i]), SEEK_SET); + if (write(fd, &XlaCtr[i], sizeof(XlaCtr[i])) != sizeof(XlaCtr[i])) + XlaFname = NULL; + } + close(fd); + return(TRUE); + } + close(fd); + return(FALSE); + } + } + close(fd); + return(TRUE); +} + + +/* +** XLAHOSTEND -- Notice that a connection is terminated. +** +** Updates the counters to reflect the end of an SMTP session +** (in or outgoing). +** +** Parameters: +** name -- host name or IP# (string) +** +** Returns: +** none. +** +** Side Effects: +** Reads and writes a file, uses a lock. +** And still updates sendmail.la. +*/ + +xla_host_end(name) + char *name; +{ + int fd, i; + + if (tTd(59, 1)) + printf("xla_host_end:\n"); + if (XlaFname == NULL || XlaPid != getpid()) return; + fd = open(XlaFname, O_RDWR, 0644); + if (fd == -1) { + XlaFname = NULL; + syserr("xla_host_end: open failed"); + return; + } + if (!lockfile(fd, XlaFname, LOCK_EX)) { + close(fd); + XlaFname = NULL; + syserr("xla_host_end: can't set lock"); + return; + } + if (read(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + close(fd); + XlaFname = NULL; + syserr("xla_host_end: can't read XlaFname"); + return(TRUE); + } + strncpy(XlaHostName, name, sizeof(XlaHostName) -1); + XlaHostName[sizeof(XlaHostName) -1] = 0; + i = strlen(name) - 1; + if (i >= 0 && XlaHostName[i] == '.') XlaHostName[i] = 0; + for (i = 0; i < XlaNext; i++) { + if (XlaMatch(XlaRules[i].mask, XlaHostName)) { + if (XlaRules[i].num > 0 && XlaRules[i].num-- == 1) { + if (XlaCtr[i]) XlaCtr[i]--; + lseek(fd, i*sizeof(XlaCtr[i]), SEEK_SET); + if (write(fd, &XlaCtr[i], sizeof(XlaCtr[i])) + != sizeof(XlaCtr[i])) + XlaFname = NULL; + } + close(fd); + return; + } + } + close(fd); +} + +/* +** XLAALLEND -- Mark all connections as closed. +** +** Generally due to an emergency exit. +** +** Parameters: +** name -- host name or IP# (string) +** +** Returns: +** none. +** +** Side Effects: +** Reads and writes a file, uses a lock. +** And guess what: updates sendmail.la. +*/ + +xla_all_end() +{ + int fd, i; + + if (tTd(59, 1)) + printf("xla_all_end:\n"); + if (XlaFname == NULL || XlaPid != getpid()) return; + fd = open(XlaFname, O_RDWR, 0644); + if (fd == -1) { + XlaFname = NULL; + syserr("xla_all_end: open failed"); + return; + } + if (!lockfile(fd, XlaFname, LOCK_EX)) { + close(fd); + XlaFname = NULL; + syserr("xla_all_end: can't set lock"); + return; + } + if (read(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + close(fd); + XlaFname = NULL; + syserr("xla_all_end: can't read XlaFname"); + return(TRUE); + } + for (i = 0; i < XlaNext; i++) { + if (XlaCtr[i] > 0 && XlaRules[i].num > 0) { + XlaCtr[i]--; XlaRules[i].num = 0; + } + } + lseek(fd, 0, SEEK_SET); + if (write(fd, XlaCtr, sizeof(XlaCtr)) != sizeof(XlaCtr)) { + XlaFname = NULL; + } + close(fd); +} +#endif /* XLA */