mailprio

< linux网络编程工具>>配套源码

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 <[e-mail]>; 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: <[e-mail]>
To: Eric Allman <[e-mail]>
cc: [e-mail]
Subject: Updated mailprio_0_93.shar
From: Tony Sanders <[e-mail]>
Organization: Berkeley Software Design, Inc.
Date: Thu, 31 Oct 1996 10:28:14 -0700
Sender: [e-mail]

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 <[e-mail]>.
#
# 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 <[e-mail]>
# 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