head	1.2;
access;
symbols
	RELENG_2_2_8_RELEASE:1.1.1.1.4.1
	RELENG_2_2_7_RELEASE:1.1.1.1.4.1
	RELENG_2_2_6_RELEASE:1.1.1.1.4.1
	v8_8_8:1.1.1.2
	SENDMAIL:1.1.1
	RELENG_2_2_5_RELEASE:1.1.1.1.4.1
	v8_8_7:1.1.1.2
	v8_8_6:1.1.1.2
	RELENG_2_2_2_RELEASE:1.1.1.1.4.1
	RELENG_2_2_1_RELEASE:1.1.1.1.4.1
	RELENG_2_2_0_RELEASE:1.1.1.1.4.1
	RELENG_2_1_7_RELEASE:1.1.1.1.2.1
	v8_8_5:1.1.1.2
	v8_8_4:1.1.1.2
	RELENG_2_1_6_1_RELEASE:1.1.1.1.2.1
	v8_8_3:1.1.1.2
	RELENG_2_1_6_RELEASE:1.1.1.1
	RELENG_2_2:1.1.1.1.0.4
	RELENG_2_2_BP:1.1.1.1
	v8_8_2:1.1.1.1
	v8_7_6:1.1.1.1
	RELENG_2_1_5_RELEASE:1.1.1.1
	RELENG_2_1_0:1.1.1.1.0.2
	v8_7_5:1.1.1.1
	v8_7_4:1.1.1.1
	v8_7_3:1.1.1.1
	v8_7_2:1.1.1.1
	ALLMAN:1.1.1;
locks; strict;
comment	@# @;


1.2
date	98.08.04.16.35.45;	author peter;	state dead;
branches;
next	1.1;

1.1
date	95.12.02.17.30.12;	author peter;	state Exp;
branches
	1.1.1.1;
next	;

1.1.1.1
date	95.12.02.17.30.12;	author peter;	state Exp;
branches
	1.1.1.1.2.1
	1.1.1.1.4.1;
next	1.1.1.2;

1.1.1.2
date	96.11.18.02.26.51;	author peter;	state Exp;
branches;
next	;

1.1.1.1.2.1
date	96.11.22.05.37.05;	author nate;	state Exp;
branches;
next	;

1.1.1.1.4.1
date	96.11.22.07.50.51;	author phk;	state Exp;
branches;
next	;


desc
@@


1.2
log
@Remove old sendmail (to the Attic)
@
text
@Message-Id: <199412081919.NAA23234@@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 Thu, 08 Dec 1994 06:08:33 PST.
References: <199412081408.GAA06210@@mastodon.CS.Berkeley.EDU> 
From: Tony Sanders <sanders@@bsdi.com>
Organization: Berkeley Software Design, Inc.
Date: Thu, 08 Dec 1994 13:19:39 -0600
Sender: sanders@@austin.BSDI.COM

Eric Allman writes:
> Nope, that's a new one, so far as I know.  Any interest in
> contributing it?  For small lists it seems overkill, but for
> large lists it could be a major win.

Sure, I will contribute it; after I sent you mail last night I went ahead
and finished up what I thought needed to be done.  I would like to get
some feedback from you on a few items, if you have time.

There are two programs, mailprio_mkdb and mailprio (source below).

mailprio_mkdb reads maillog files and creates a DB file of address vs.
delay.  I'm not too happy with how it does the averages right now but this
is just a quick hack.  However, it should at least order sites that take
days vs. those that deliver on the first pass through.  One thing that
would make this information a lot more accurate is if sendmail could log
a "transaction delay" (on failures also), as well as total delivery delay.
Perhaps, as an option, it could maintain the DB file itself?

mailprio then simply reads a list of addresses from stdin (the mailing
list), and tries to prioritize them according to the info the database.
It collects comment lines and other junk at the top of the file; all
mailprio does is reorder lines, the actual text of the file should
be unchanged to the extent that you can verify it with:
    sort sorted_list > checkit; sort mailing-list | diff - checkit
Users with no delay information are put next.  The prioritized list is last.
Of course, this function could also be built-into sendmail (eventually).

Putting "new account" info at the top with the current averaging function
probably adversly affects the prioritized list (at least in the short
term), but putting it at the bottom would not really give the new accounts
a fair chance.  I suspect this isn't that big of a problem.  I'm running
this here on a list with 461 accounts and about 10 messages per day so
I'll see how it goes.  I'll keep some stats on delay times and see what
happens.

Another thing that would help this situation, is if sendmail had the queue
ordered by site (but you already know this).  If you ever get to do per
site queuing you should consider "blocking" a queue for some short period
of time if a connection fails to that site [sendmail does this inside a
single process on a per account basis now right?]; this would allow multiple
sendmails to quickly skip over those sites for people like me that run:

    for i in 1 2 3 4 5 6 7 8 ; do daemon sendmail -q; done

to flush a queue that has gotten behind.  You could also do this inside
sendmail with a parallelism option (when it is time to run the queue, how
many processes to start).

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  mailprio mailprio_mkdb
# Wrapped by sanders@@austin.BSDI.COM on Fri Dec  9 18:07:02 1994
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'mailprio' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'mailprio'\"
else
echo shar: Extracting \"'mailprio'\" \(3093 characters\)
sed "s/^X//" >'mailprio' <<'END_OF_FILE'
X#!/usr/bin/perl
X#
X# mailprio -- setup mail priorities for a mailing list
X#
X# Sort mailing list by mailprio database:
X#     mailprio < mailing-list > sorted_list
X# Double check against orig:
X#     sort sorted_list > checkit; sort mailing-list | diff - checkit
X# If it checks out, install it.
X#
X# TODO:
X#     option to process mqueue files so we can reorder files in the queue!
X$usage = "Usage: mailprio [-p priodb]\n";
X$home = "/home/sanders/lists";
X$priodb = "$home/mailprio";
X
Xif ($main'ARGV[0] =~ /^-/) {
X	$args = shift;
X	if ($args =~ m/\?/) { print $usage; exit 0; }
X	if ($args =~ m/p/) {
X	    $priodb = shift || die $usage, "-p requires argument\n"; }
X}
X
X# In shell script, it goes something like this:
X#     old_mailprio > /tmp/a
X#     fgrep -f lists/inet-access /tmp/a | sed -e 's/^.......//' > /tmp/b
X#         ; /tmp/b contains list of known users, faster delivery first
X#     fgrep -v -f /tmp/b lists/inet-access > /tmp/c
X#         ; put all unknown stuff at the top of new list for now
X#     echo '# -----' >> /tmp/c
X#     cat /tmp/b >> /tmp/c
X
X# Setup %list and @@list
Xlocal($addr, $canon);
Xwhile ($addr = <STDIN>) {
X    chop $addr;
X    next if $addr =~ /^# ----- /;			# that's our line
X    push(@@list, $addr), next if $addr =~ /^\s*#/;	# save comments
X    $canon = &canonicalize((&simplify_address($addr))[0]);
X    unless (defined $canon) {
X	warn "no address found: $addr\n";
X	push(@@list, $addr);				# save it anyway
X	next;
X    }
X    if (defined $list{$canon}) {
X	warn "duplicate: ``$addr -> $canon''\n";
X	push(@@list, $addr);				# save it anyway
X	next;
X    }
X    $list{$canon} = $addr;
X}
X
Xlocal(*prio);
Xdbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n";
Xforeach $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}
Xdbmclose(%prio);
X
X# Put all the junk we found at the very top
X# (this might not always be a feature)
Xprint join("\n", @@list), "\n";
X
X# unprioritized users go next, slow accounts will get moved down quickly
Xprint '# ----- unprioritized users', "\n";
Xforeach $to (keys %list) { print $list{$to}, "\n"; }
X
X# finally, our prioritized list of users
Xprint '# ----- prioritized users', "\n";
Xforeach $to (sort { $userprio{$a} <=> $userprio{$b}; } keys %userprio) {
X    die "Opps! Something is seriously wrong with useracct: $to\n"
X	unless defined $useracct{$to};
X    print $useracct{$to}, "\n";
X}
X
Xexit(0);
X
X# REPL-LIB ---------------------------------------------------------------
X
Xsub 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}
X
X# @@addrs = simplify_address($addr);
Xsub 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}
END_OF_FILE
if test 3093 -ne `wc -c <'mailprio'`; then
    echo shar: \"'mailprio'\" unpacked with wrong size!
fi
chmod +x 'mailprio'
# end of 'mailprio'
fi
if test -f 'mailprio_mkdb' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'mailprio_mkdb'\"
else
echo shar: Extracting \"'mailprio_mkdb'\" \(3504 characters\)
sed "s/^X//" >'mailprio_mkdb' <<'END_OF_FILE'
X#!/usr/bin/perl
X#
X# mailprio_mkdb -- make mail priority database based on delay times
X#
X$usage = "Usage: mailprio_mkdb [-l maillog] [-p priodb]\n";
X$home = "/home/sanders/lists";
X$maillog = "/var/log/maillog";
X$priodb = "$home/mailprio";
X
Xif ($main'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}
X
Xlocal(*prio);
X# We'll merge with existing information if it's already there.
Xdbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n";
X&getlog_stats($maillog, *prio);
X# foreach $addr (sort { $prio{$a} <=> $prio{$b}; } keys %prio) {
X#     printf("%06d %s\n", $prio{$addr}, $addr); }
Xdbmclose(%prio);
Xexit(0);
X
Xsub 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	($delay) = (m/, delay=([^,]*), /);
X	$delay || next;
X	($h, $m, $s) = split(/:/, $delay);
X	$delay = ($h * 60 * 60) + ($m * 60) + $s;
X
X	# deleting everything after ", " seems safe enough, though
X	# it is possible that it was inside "..."'s and that we will
X	# miss some addresses because of it.  However, I'm not willing
X	# to do full parsing just for that case.  If this bothers you
X	# you could do something like: s/, (delay|ctladdr)=.*//;
X	# but you have to make sure you catch all the possible names.
X	$to = $_; $to =~ s/^.* to=//; $to =~ s/, .*//;
X	foreach $addr (&simplify_address($to)) {
X	    next unless $addr;
X	    $addr = &canonicalize($addr);
X	    # print $delay, " ", $addr, "\n";
X	    $stats{$addr} = $delay unless defined $stats{$addr};	# init
X
X	    # This average function moves the value around quite rapidly
X	    # which may or may not be a feature.
X	    #
X	    # This has at least one odd behavior because we currently only
X	    # use the delay information from maillog which is only logged
X	    # on actual delivery.  This works backwards from what we really
X	    # want to happen when a fast host goes down for a while and then
X	    # comes back up.
X	    #
X	    # I spoke with Eric and he suggested adding an xdelay statistic
X	    # for a per transaction delay which would help that situation
X	    # a lot.  What I believe you want in that cases something like:
X	    #   delay fast, xdelay fast: smokin', these hosts go first
X	    #   delay slow, xdelay fast: put host high on the list (back up?)
X	    #   delay fast, xdelay slow: host is down/having problems/slow
X	    #   delay slow, xdelay slow: poorly connected sites, very last
X	    # Of course, you have to reorder the distribution list fairly
X	    # often for that to help.  Come to think of it, you should
X	    # also reorder /var/spool/mqueue files also (if they aren't
X	    # locked of course).  Hmmm....
X	    $stats{$addr} = int(($stats{$addr} + $delay) / 2);
X	}
X    }
X    close(MAILLOG);
X}
X
X# REPL-LIB ---------------------------------------------------------------
X
Xsub 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}
X
X# @@addrs = simplify_address($addr);
Xsub 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}
END_OF_FILE
if test 3504 -ne `wc -c <'mailprio_mkdb'`; then
    echo shar: \"'mailprio_mkdb'\" unpacked with wrong size!
fi
chmod +x 'mailprio_mkdb'
# end of 'mailprio_mkdb'
fi
echo shar: End of shell archive.
exit 0
@


1.1
log
@Initial revision
@
text
@@


1.1.1.1
log
@Import Sendmail-8.7.2 as discussed on -current.

The conflict merge will happen shortly after.
@
text
@@


1.1.1.1.4.1
log
@YAMFC
@
text
@d1 6
a6 7
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>
d8 2
a9 2
Date: Thu, 31 Oct 1996 10:28:14 -0700
Sender: sanders@@austin.bsdi.com
d11 4
a14 2
Eric, please update contrib/mailprio in the sendmail distribution
to this version at your convenience.  Thanks.
d16 3
a18 2
I've also made this available in:
	ftp://ftp.earth.com/pub/postmaster/
d20 1
a20 1
mailprio_0_93.shar follows...
d22 50
a71 31
#!/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)'
d73 17
a89 76
  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    }
d91 6
a96 2
X    local(*list);
X    &process($source, *list);
d98 20
a117 5
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";
d119 4
a122 33
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;
d124 2
a125 4
}
X
sub output {
X    local($sink, *list) = @@_;
d127 9
a135 10
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        }
d137 2
a138 1
X    dbmclose(%prio);
d140 15
a154 14
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    }
d156 1
a156 9
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    }
d158 1
a158 2
X    print $sink ".\n" if $qflag;
}
d160 1
a160 8
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 {
d164 1
a164 1
}
d166 2
a167 2
# @@addrs = simplify_address($addr);
sub simplify_address {
d169 3
a171 3
X    1 while s/\([^\(\)]*\)//g;          # strip comments
X    1 while s/"[^"]*"//g;               # strip comments
X    split(/,/);                         # split into parts
d173 3
a175 3
X        1 while s/.*<(.*)>.*/\1/;
X        s/^\s+//;
X        s/\s+$//;
d178 4
a181 61
}
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"
d183 2
a184 109
# ============= 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"
d186 2
a187 3
# ============= mailprio_mkdb ==============
if test -f 'mailprio_mkdb' && test X"$1" != X"-c"; then
  echo 'x - skipping mailprio_mkdb (file already exists)'
d189 10
a198 38
  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";
d200 1
a200 1
while ($ARGV[0] =~ /^-/) {
d207 1
a207 3
}
X
$SIG{'PIPE'} = 'handle_pipe';
d209 8
a216 5
# will merge with existing information
dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n";
&getlog_stats($maillog, *prio);
dbmclose(%prio);
exit(0);
d218 1
a218 5
sub handle_pipe {
X    dbmclose(%prio);
}
X
sub getlog_stats {
d224 12
a235 31
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
d239 1
d241 21
a261 2
X	    # pseudo-average in the new delay (half-steps)
X	    # simple, moving average
d266 1
a266 1
}
d268 1
a268 1
# REPL-LIB ---------------------------------------------------------------
d270 1
a270 1
sub canonicalize {
d274 1
a274 1
}
d276 2
a277 2
# @@addrs = simplify_address($addr);
sub simplify_address {
d288 7
a294 8
}
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"
d296 1
@


1.1.1.1.2.1
log
@Merge-O-Matic.

Bring in the more secure 8.8.3 sources onto the soon to be dead stable
branch in order to have them be part of the 2.1.6a 'security update'.

Reviewed by:	Tom Samplonius <tom@@uniserve.com>
@
text
@d1 6
a6 7
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>
d8 2
a9 2
Date: Thu, 31 Oct 1996 10:28:14 -0700
Sender: sanders@@austin.bsdi.com
d11 4
a14 2
Eric, please update contrib/mailprio in the sendmail distribution
to this version at your convenience.  Thanks.
d16 3
a18 2
I've also made this available in:
	ftp://ftp.earth.com/pub/postmaster/
d20 1
a20 1
mailprio_0_93.shar follows...
d22 50
a71 31
#!/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)'
d73 17
a89 76
  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    }
d91 6
a96 2
X    local(*list);
X    &process($source, *list);
d98 20
a117 5
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";
d119 4
a122 33
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;
d124 2
a125 4
}
X
sub output {
X    local($sink, *list) = @@_;
d127 9
a135 10
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        }
d137 2
a138 1
X    dbmclose(%prio);
d140 15
a154 14
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    }
d156 1
a156 9
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    }
d158 1
a158 2
X    print $sink ".\n" if $qflag;
}
d160 1
a160 8
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 {
d164 1
a164 1
}
d166 2
a167 2
# @@addrs = simplify_address($addr);
sub simplify_address {
d169 3
a171 3
X    1 while s/\([^\(\)]*\)//g;          # strip comments
X    1 while s/"[^"]*"//g;               # strip comments
X    split(/,/);                         # split into parts
d173 3
a175 3
X        1 while s/.*<(.*)>.*/\1/;
X        s/^\s+//;
X        s/\s+$//;
d178 4
a181 61
}
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"
d183 2
a184 109
# ============= 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"
d186 2
a187 3
# ============= mailprio_mkdb ==============
if test -f 'mailprio_mkdb' && test X"$1" != X"-c"; then
  echo 'x - skipping mailprio_mkdb (file already exists)'
d189 10
a198 38
  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";
d200 1
a200 1
while ($ARGV[0] =~ /^-/) {
d207 1
a207 3
}
X
$SIG{'PIPE'} = 'handle_pipe';
d209 8
a216 5
# will merge with existing information
dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n";
&getlog_stats($maillog, *prio);
dbmclose(%prio);
exit(0);
d218 1
a218 5
sub handle_pipe {
X    dbmclose(%prio);
}
X
sub getlog_stats {
d224 12
a235 31
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
d239 1
d241 21
a261 2
X	    # pseudo-average in the new delay (half-steps)
X	    # simple, moving average
d266 1
a266 1
}
d268 1
a268 1
# REPL-LIB ---------------------------------------------------------------
d270 1
a270 1
sub canonicalize {
d274 1
a274 1
}
d276 2
a277 2
# @@addrs = simplify_address($addr);
sub simplify_address {
d288 7
a294 8
}
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"
d296 1
@


1.1.1.2
log
@Import sendmail-8.8.3 - this contains the official fix to replace the
previous workaround patch that I used.

Obtained from: Eric Allman <eric@@sendmail.org>
@
text
@d1 6
a6 7
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>
d8 2
a9 2
Date: Thu, 31 Oct 1996 10:28:14 -0700
Sender: sanders@@austin.bsdi.com
d11 4
a14 2
Eric, please update contrib/mailprio in the sendmail distribution
to this version at your convenience.  Thanks.
d16 3
a18 2
I've also made this available in:
	ftp://ftp.earth.com/pub/postmaster/
d20 1
a20 1
mailprio_0_93.shar follows...
d22 50
a71 31
#!/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)'
d73 17
a89 76
  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    }
d91 6
a96 2
X    local(*list);
X    &process($source, *list);
d98 20
a117 5
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";
d119 4
a122 33
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;
d124 2
a125 4
}
X
sub output {
X    local($sink, *list) = @@_;
d127 9
a135 10
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        }
d137 2
a138 1
X    dbmclose(%prio);
d140 15
a154 14
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    }
d156 1
a156 9
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    }
d158 1
a158 2
X    print $sink ".\n" if $qflag;
}
d160 1
a160 8
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 {
d164 1
a164 1
}
d166 2
a167 2
# @@addrs = simplify_address($addr);
sub simplify_address {
d169 3
a171 3
X    1 while s/\([^\(\)]*\)//g;          # strip comments
X    1 while s/"[^"]*"//g;               # strip comments
X    split(/,/);                         # split into parts
d173 3
a175 3
X        1 while s/.*<(.*)>.*/\1/;
X        s/^\s+//;
X        s/\s+$//;
d178 4
a181 61
}
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"
d183 2
a184 109
# ============= 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"
d186 2
a187 3
# ============= mailprio_mkdb ==============
if test -f 'mailprio_mkdb' && test X"$1" != X"-c"; then
  echo 'x - skipping mailprio_mkdb (file already exists)'
d189 10
a198 38
  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";
d200 1
a200 1
while ($ARGV[0] =~ /^-/) {
d207 1
a207 3
}
X
$SIG{'PIPE'} = 'handle_pipe';
d209 8
a216 5
# will merge with existing information
dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n";
&getlog_stats($maillog, *prio);
dbmclose(%prio);
exit(0);
d218 1
a218 5
sub handle_pipe {
X    dbmclose(%prio);
}
X
sub getlog_stats {
d224 12
a235 31
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
d239 1
d241 21
a261 2
X	    # pseudo-average in the new delay (half-steps)
X	    # simple, moving average
d266 1
a266 1
}
d268 1
a268 1
# REPL-LIB ---------------------------------------------------------------
d270 1
a270 1
sub canonicalize {
d274 1
a274 1
}
d276 2
a277 2
# @@addrs = simplify_address($addr);
sub simplify_address {
d288 7
a294 8
}
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"
d296 1
@
