mailprio

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

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 <[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.
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 <[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.
#
# 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