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