1Received: 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) 2Received: 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) 3Message-Id: <199610311728.KAA19250@austin.bsdi.com> 4To: Eric Allman <eric@sendmail.org> 5cc: marc@xfree86.org 6Subject: Updated mailprio_0_93.shar 7From: Tony Sanders <sanders@earth.com> 8Organization: Berkeley Software Design, Inc. 9Date: Thu, 31 Oct 1996 10:28:14 -0700 10Sender: sanders@austin.bsdi.com 11 12Eric, please update contrib/mailprio in the sendmail distribution 13to this version at your convenience. Thanks. 14 15I've also made this available in: 16 ftp://ftp.earth.com/pub/postmaster/ 17 18mailprio_0_93.shar follows... 19 20#!/bin/sh 21# This is a shell archive (produced by GNU sharutils 4.1). 22# To extract the files from this archive, save it to some FILE, remove 23# everything before the `!/bin/sh' line above, then type `sh FILE'. 24# 25# Made on 1996-10-31 10:07 MST by <sanders@earth.com>. 26# 27# Existing files will *not* be overwritten unless `-c' is specified. 28# 29# This shar contains: 30# length mode name 31# ------ ---------- ------------------------------------------ 32# 8260 -rwxr-xr-x mailprio 33# 3402 -rw-r--r-- mailprio.README 34# 4182 -rwxr-xr-x mailprio_mkdb 35# 36touch -am 1231235999 $$.touch >/dev/null 2>&1 37if test ! -f 1231235999 && test -f $$.touch; then 38 shar_touch=touch 39else 40 shar_touch=: 41 echo 42 echo 'WARNING: not restoring timestamps. Consider getting and' 43 echo "installing GNU \`touch', distributed in GNU File Utilities..." 44 echo 45fi 46rm -f 1231235999 $$.touch 47# 48# ============= mailprio ============== 49if test -f 'mailprio' && test X"$1" != X"-c"; then 50 echo 'x - skipping mailprio (file already exists)' 51else 52 echo 'x - extracting mailprio (text)' 53 sed 's/^X//' << 'SHAR_EOF' > 'mailprio' && 54#!/usr/bin/perl 55# 56# mailprio,v 1.4 1996/10/31 17:03:52 sanders Exp 57# Version 0.93 -- Thu Oct 31 09:42:25 MST 1996 58# 59# mailprio -- setup mail priorities for a mailing list 60# 61# Copyright 1994, 1996, Tony Sanders <sanders@earth.com> 62# Rights are hereby granted to download, use, modify, sell, copy, and 63# redistribute this software so long as the original copyright notice 64# and this list of conditions remain intact and modified versions are 65# noted as such. 66# 67# I would also very much appreciate it if you could send me a copy of 68# any changes you make so I can possibly integrate them into my version. 69# 70# Options: 71# -p priority_database -- Specify database to use if not default 72# -q -- Process sendmail V8.8.X queue format files 73# 74# Sort mailing lists or sendmail queue files by mailprio database. 75# Files listed on the command line are locked and then sorted in place, in 76# the absence of any file arguments it will read STDIN and write STDOUT. 77# 78# Examples: 79# mailprio < mailing-list > sorted_list 80# mailprio mailing-list1 mailing-list2 mailing-list3 ... 81# mailprio -q /var/spool/mqueue/qf* 82# To double check results: 83# sort sorted_list > checkit; sort orig-mailing-list | diff - checkit 84# 85# To get the maximum value from a transaction delay based priority 86# function you need to reorder the distribution list (and the mail 87# queue files for that matter) fairly often; you could even have 88# your mailing list software reorder the list before each outgoing 89# message. 90# 91$usage = "Usage: mailprio [-p priodb] [-q] [mailinglists ...]\n"; 92$home = "/home/sanders/lists"; 93$priodb = "$home/mailprio"; 94$locking = "flock"; # "flock" or "fcntl" 95X 96# In shell, it would go more or less like this: 97# old_mailprio > /tmp/a 98# fgrep -f lists/inet-access /tmp/a | sed -e 's/^.......//' > /tmp/b 99# ; /tmp/b contains list of known users, faster delivery first 100# fgrep -v -f /tmp/b lists/inet-access > /tmp/c 101# ; put all unknown stuff at the top of new list for now 102# echo '# -----' >> /tmp/c 103# cat /tmp/b >> /tmp/c 104X 105$qflag = 0; 106while ($main'ARGV[0] =~ /^-/) { 107X $args = shift; 108X if ($args =~ m/\?/) { print $usage; exit 0; } 109X if ($args =~ m/q/) { $qflag = 1; } 110X if ($args =~ m/p/) { 111X $priodb = shift || die $usage, "-p requires argument\n"; } 112} 113X 114push(@main'ARGV, '-') if ($#ARGV < 0); 115while ($file = shift @ARGV) { 116X if ($file eq "-") { 117X $source = "main'STDIN"; 118X $sink = "main'STDOUT"; 119X } else { 120X $sink = $source = "FH"; 121X open($source, "+< $file") || do { warn "$file: $!\n"; next; }; 122X if (!defined &seize($source, &LOCK_EX | &LOCK_NB)) { 123X # couldn't get lock, just skip it 124X close($source); 125X next; 126X } 127X } 128X 129X local(*list); 130X &process($source, *list); 131X 132X # setup to write output 133X if ($file ne "-") { 134X # zero the file (FH is hardcoded because truncate requires it, sigh) 135X seek(FH, 0, 0) || die "$file: seek: $!\n"; 136X truncate(FH, 0) || die "$file: truncate: $!\n"; 137X } 138X 139X # do the dirty work 140X &output($sink, *list); 141X 142X close($sink) || warn "$file: $!\n"; # close clears the lock 143X close($source); 144} 145X 146sub process { 147X # Setup %list and @list 148X local($source, *list) = @_; 149X local($addr, $canon); 150X while ($addr = <$source>) { 151X chop $addr; 152X next if $addr =~ /^# ----- /; # that's our line 153X push(@list, $addr), next if $addr =~ /^\s*#/; # save comments 154X if ($qflag) { 155X next if $addr =~ m/^\./; 156X push(@list, $addr), next if !($addr =~ s/^(R[^:]*:)//); 157X $Rflags = $1; 158X } 159X $canon = &canonicalize((&simplify_address($addr))[0]); 160X unless (defined $canon) { 161X warn "$file: no address found: $addr\n"; 162X push(@list, ($qflag?$Rflags:'') . $addr); # save it as is 163X next; 164X } 165X if (defined $list{$canon}) { 166X warn "$file: duplicate: ``$addr -> $canon''\n"; 167X push(@list, ($qflag?$Rflags:'') . $addr); # save it as is 168X next; 169X } 170X $list{$canon} = $addr; 171X } 172} 173X 174sub output { 175X local($sink, *list) = @_; 176X 177X local($to, *prio, *userprio, *useracct); 178X dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n"; 179X foreach $to (keys %list) { 180X if (defined $prio{$to}) { 181X # add to list of found users (%userprio) and remove from %list 182X # so that we know what users were not yet prioritized 183X $userprio{$to} = $prio{$to}; # priority 184X $useracct{$to} = $list{$to}; # string 185X delete $list{$to}; 186X } 187X } 188X dbmclose(%prio); 189X 190X # Put all the junk we found at the very top 191X # (this might not always be a feature) 192X print $sink join("\n", @list), "\n" if int(@list); 193X 194X # prioritized list of users 195X if (int(keys %userprio)) { 196X print $sink '# ----- prioritized users', "\n" unless $qflag; 197X foreach $to (sort by_userprio keys %userprio) { 198X die "Opps! Something is seriously wrong with useracct: $to\n" 199X unless defined $useracct{$to}; 200X print $sink 'RFD:' if $qflag; 201X print $sink $useracct{$to}, "\n"; 202X } 203X } 204X 205X # unprioritized users go last, fast accounts will get moved up eventually 206X # XXX: should go before the "really slow" prioritized users? 207X if (int(keys %list)) { 208X print $sink '# ----- unprioritized users', "\n" unless $qflag; 209X foreach $to (keys %list) { 210X print $sink 'RFD:' if $qflag; 211X print $sink $list{$to}, "\n"; 212X } 213X } 214X 215X print $sink ".\n" if $qflag; 216} 217X 218sub by_userprio { 219X # sort first by priority, then by key. 220X $userprio{$a} <=> $userprio{$b} || $a cmp $b; 221} 222X 223# REPL-LIB --------------------------------------------------------------- 224X 225sub canonicalize { 226X local($addr) = @_; 227X # lowercase, strip leading/trailing whitespace 228X $addr =~ y/A-Z/a-z/; $addr =~ s/^\s+//; $addr =~ s/\s+$//; $addr; 229} 230X 231# @addrs = simplify_address($addr); 232sub simplify_address { 233X local($_) = shift; 234X 1 while s/\([^\(\)]*\)//g; # strip comments 235X 1 while s/"[^"]*"//g; # strip comments 236X split(/,/); # split into parts 237X foreach (@_) { 238X 1 while s/.*<(.*)>.*/\1/; 239X s/^\s+//; 240X s/\s+$//; 241X } 242X @_; 243} 244X 245### ---- ### 246# 247# Error codes 248# 249do 'errno.ph'; 250eval 'sub ENOENT {2;}' unless defined &ENOENT; 251eval 'sub EINTR {4;}' unless defined &EINTR; 252eval 'sub EINVAL {22;}' unless defined &EINVAL; 253X 254# 255# File locking 256# 257do 'sys/unistd.ph'; 258eval 'sub SEEK_SET {0;}' unless defined &SEEK_SET; 259X 260do 'sys/file.ph'; 261eval 'sub LOCK_SH {0x01;}' unless defined &LOCK_SH; 262eval 'sub LOCK_EX {0x02;}' unless defined &LOCK_EX; 263eval 'sub LOCK_NB {0x04;}' unless defined &LOCK_NB; 264eval 'sub LOCK_UN {0x08;}' unless defined &LOCK_UN; 265X 266do 'fcntl.ph'; 267eval 'sub F_GETFD {1;}' unless defined &F_GETFD; 268eval 'sub F_SETFD {2;}' unless defined &F_SETFD; 269eval 'sub F_GETFL {3;}' unless defined &F_GETFL; 270eval 'sub F_SETFL {4;}' unless defined &F_SETFL; 271eval 'sub O_NONBLOCK {0x0004;}' unless defined &O_NONBLOCK; 272eval 'sub F_SETLK {8;}' unless defined &F_SETLK; # nonblocking 273eval 'sub F_SETLKW {9;}' unless defined &F_SETLKW; # lockwait 274eval 'sub F_RDLCK {1;}' unless defined &F_RDLCK; 275eval 'sub F_UNLCK {2;}' unless defined &F_UNLCK; 276eval 'sub F_WRLCK {3;}' unless defined &F_WRLCK; 277$s_flock = "sslll"; # struct flock {type, whence, start, len, pid} 278X 279# return undef on failure 280sub seize { 281X local ($FH, $lock) = @_; 282X local ($ret); 283X if ($locking eq "flock") { 284X $ret = flock($FH, $lock); 285X return ($ret == 0 ? undef : 1); 286X } else { 287X local ($flock, $type) = 0; 288X if ($lock & &LOCK_SH) { $type = &F_RDLCK; } 289X elsif ($lock & &LOCK_EX) { $type = &F_WRLCK; } 290X elsif ($lock & &LOCK_UN) { $type = &F_UNLCK; } 291X else { $! = &EINVAL; return undef; } 292X $flock = pack($s_flock, $type, &SEEK_SET, 0, 0, 0); 293X $ret = fcntl($FH, ($lock & &LOCK_NB) ? &F_SETLK : &F_SETLKW, $flock); 294X return ($ret == -1 ? undef : 1); 295X } 296} 297SHAR_EOF 298 $shar_touch -am 1031100396 'mailprio' && 299 chmod 0755 'mailprio' || 300 echo 'restore of mailprio failed' 301 shar_count="`wc -c < 'mailprio'`" 302 test 8260 -eq "$shar_count" || 303 echo "mailprio: original size 8260, current size $shar_count" 304fi 305# ============= mailprio.README ============== 306if test -f 'mailprio.README' && test X"$1" != X"-c"; then 307 echo 'x - skipping mailprio.README (file already exists)' 308else 309 echo 'x - extracting mailprio.README (text)' 310 sed 's/^X//' << 'SHAR_EOF' > 'mailprio.README' && 311mailprio README 312X 313mailprio.README,v 1.2 1996/10/31 17:03:54 sanders Exp 314Version 0.93 -- Thu Oct 31 09:42:25 MST 1996 315X 316Copyright 1994, 1996, Tony Sanders <sanders@earth.com> 317Rights are hereby granted to download, use, modify, sell, copy, and 318redistribute this software so long as the original copyright notice 319and this list of conditions remain intact and modified versions are 320noted as such. 321X 322I would also very much appreciate it if you could send me a copy of 323any changes you make so I can possibly integrate them into my version. 324X 325The current version of this and other related mail tools are available in: 326X ftp://ftp.earth.com/pub/postmaster/ 327X 328Even with the new persistent host status in sendmail V8.8.X this 329function can still reduce the lag time distributing mail to a large 330group of people. It also makes it a little more likely that everyone 331will get mailing list mail in the order sent which can help reduce 332duplicate postings. Basically, the goal is to put slow hosts at 333the bottom of the list so that as many fast hosts are delivered 334as quickly as possible. 335X 336CONTENTS 337======== 338X 339X mailprio.README -- simple docs 340X mailprio -- the address sorter 341X mailprio_mkdb -- builds the database for the sorter 342X 343X 344CHANGES 345======= 346X Version 0.92 347X Initial public release. 348X 349X Version 0.93 350X Updated to make use of the (somewhat) new xdelay statistic. 351X Changed -q flag to support new sendmail queue file format (RFD:<addr>). 352X Fixed argument parsing bug. 353X Fixed bug with database getting "garbage" in it. 354X 355X 356CONFIGURATION 357============= 358X 359X You need to edit each script and ensure proper configuration. 360X 361X In mailprio check: #!perl path, $home, $priodb, $locking 362X 363X In mailprio_mkdb check: #!perl path, $home, $priodb, $maillog 364X 365X 366USAGE: mailprio 367=============== 368X 369X Usage: mailprio [-p priodb] [-q] [mailinglists ...] 370X -p priority_database -- Specify database to use if not default 371X -q -- Process sendmail queue format files 372X [USE WITH CAUTION] 373X 374X Sort mailing lists or sendmail V8 queue files by mailprio database. 375X Files listed on the command line are locked and then sorted in place, in 376X the absence of any file arguments it will read STDIN and write STDOUT. 377X 378X Examples: 379X mailprio < mailing-list > sorted_list 380X mailprio mailing-list1 mailing-list2 mailing-list3 ... 381X mailprio -q /var/spool/mqueue/qf* [not recommended] 382X To double check results: 383X sort sorted_list > checkit; sort orig-mailing-list | diff - checkit 384X 385X NOTE: 386X To get the maximum value from a transaction delay based priority 387X function you need to reorder the distribution list (and the mail 388X queue files for that matter) fairly often; you could even have 389X your mailing list software reorder the list before each outgoing 390X message. 391X 392X 393USAGE: mailprio_mkdb 394==================== 395X 396X Usage: mailprio_mkdb [-l maillog] [-p priodb] 397X -l maillog -- Specify maillog to process if not default 398X -p priority_database -- Specify database to use if not default 399X 400X Builds the mail priority database using information from the maillog. 401X 402X Run at least nightly before you rotate the maillog. If you are 403X going to run mailprio more often than that then you will need to 404X load the current maillog information before that will do any good 405X (and to keep from reloading the same information you will need 406X some kind of incremental maillog information to load from). 407SHAR_EOF 408 $shar_touch -am 1031100396 'mailprio.README' && 409 chmod 0644 'mailprio.README' || 410 echo 'restore of mailprio.README failed' 411 shar_count="`wc -c < 'mailprio.README'`" 412 test 3402 -eq "$shar_count" || 413 echo "mailprio.README: original size 3402, current size $shar_count" 414fi 415# ============= mailprio_mkdb ============== 416if test -f 'mailprio_mkdb' && test X"$1" != X"-c"; then 417 echo 'x - skipping mailprio_mkdb (file already exists)' 418else 419 echo 'x - extracting mailprio_mkdb (text)' 420 sed 's/^X//' << 'SHAR_EOF' > 'mailprio_mkdb' && 421#!/usr/bin/perl 422# 423# mailprio_mkdb,v 1.5 1996/10/31 17:03:53 sanders Exp 424# Version 0.93 -- Thu Oct 31 09:42:25 MST 1996 425# 426# mailprio_mkdb -- make mail priority database based on delay times 427# 428# Copyright 1994, 1996, Tony Sanders <sanders@earth.com> 429# Rights are hereby granted to download, use, modify, sell, copy, and 430# redistribute this software so long as the original copyright notice 431# and this list of conditions remain intact and modified versions are 432# noted as such. 433# 434# I would also very much appreciate it if you could send me a copy of 435# any changes you make so I can possibly integrate them into my version. 436# 437# The average function moves the value around quite rapidly (half-steps) 438# which may or may not be a feature. This version uses the new xdelay 439# statistic (new as of sendmail V8) which is per transaction. We also 440# weight the result based on the overall delay. 441# 442# Something that might be worth doing for systems that don't support 443# xdelay would be to compute an approximation of the transaction delay 444# by sorting by messages-id and delay then computing the difference 445# between adjacent delay values. 446# 447# To get the maximum value from a transaction delay based priority 448# function you need to reorder the distribution list (and the mail 449# queue files for that matter) fairly often; you could even have 450# your mailing list software reorder the list before each outgoing 451# message. 452X 453$usage = "Usage: mailprio_mkdb [-l maillog] [-p priodb]\n"; 454$home = "/home/sanders/lists"; 455$maillog = "/var/log/maillog"; 456$priodb = "$home/mailprio"; 457X 458while ($ARGV[0] =~ /^-/) { 459X $args = shift; 460X if ($args =~ m/\?/) { print $usage; exit 0; } 461X if ($args =~ m/l/) { 462X $maillog = shift || die $usage, "-l requires argument\n"; } 463X if ($args =~ m/p/) { 464X $priodb = shift || die $usage, "-p requires argument\n"; } 465} 466X 467$SIG{'PIPE'} = 'handle_pipe'; 468X 469# will merge with existing information 470dbmopen(%prio, $priodb, 0644) || die "$priodb: $!\n"; 471&getlog_stats($maillog, *prio); 472dbmclose(%prio); 473exit(0); 474X 475sub handle_pipe { 476X dbmclose(%prio); 477} 478X 479sub getlog_stats { 480X local($maillog, *stats) = @_; 481X local($to, $delay); 482X local($h, $m, $s); 483X open(MAILLOG, "< $maillog") || die "$maillog: $!\n"; 484X while (<MAILLOG>) { 485X next unless / to=/ && / stat=/; 486X next if / stat=queued/; 487X if (/ stat=sent/i) { 488X # read delay and xdelay and convert to seconds 489X ($delay) = (m/ delay=([^,]*),/); 490X next unless $delay; 491X ($h, $m, $s) = split(/:/, $delay); 492X $delay = ($h * 60 * 60) + ($m * 60) + $s; 493X 494X ($xdelay) = (m/ xdelay=([^,]*),/); 495X next unless $xdelay; 496X ($h, $m, $s) = split(/:/, $xdelay); 497X $xdelay = ($h * 60 * 60) + ($m * 60) + $s; 498X 499X # Now weight the delay factor by the transaction delay (xdelay). 500X $xdelay /= 300; # [0 - 1(@5 min)] 501X $xdelay += 0.5; # [0.5 - 1.5] 502X $xdelay = 1.5 if $xdelay > 1.5; # clamp 503X $delay *= $xdelay; # weight delay by xdelay 504X } 505X elsif (/, stat=/) { 506X # delivery failure of some sort (i.e. bad) 507X $delay = 432000; # force 5 days 508X } 509X $delay = 1000000 if $delay > 1000000; 510X 511X # filter the address(es); isn't perfect but is "good enough" 512X $to = $_; $to =~ s/^.* to=//; 513X 1 while $to =~ s/\([^\(\)]*\)//g; # strip comments 514X 1 while $to =~ s/"[^"]*"//g; # strip comments 515X $to =~ s/, .*//; # remove other stat info 516X foreach $addr (&simplify_address($to)) { 517X next unless $addr; 518X $addr = &canonicalize($addr); 519X $stats{$addr} = $delay unless defined $stats{$addr}; # init 520X # pseudo-average in the new delay (half-steps) 521X # simple, moving average 522X $stats{$addr} = int(($stats{$addr} + $delay) / 2); 523X } 524X } 525X close(MAILLOG); 526} 527X 528# REPL-LIB --------------------------------------------------------------- 529X 530sub canonicalize { 531X local($addr) = @_; 532X # lowercase, strip leading/trailing whitespace 533X $addr =~ y/A-Z/a-z/; $addr =~ s/^\s+//; $addr =~ s/\s+$//; $addr; 534} 535X 536# @addrs = simplify_address($addr); 537sub simplify_address { 538X local($_) = shift; 539X 1 while s/\([^\(\)]*\)//g; # strip comments 540X 1 while s/"[^"]*"//g; # strip comments 541X split(/,/); # split into parts 542X foreach (@_) { 543X 1 while s/.*<(.*)>.*/\1/; 544X s/^\s+//; 545X s/\s+$//; 546X } 547X @_; 548} 549SHAR_EOF 550 $shar_touch -am 1031100396 'mailprio_mkdb' && 551 chmod 0755 'mailprio_mkdb' || 552 echo 'restore of mailprio_mkdb failed' 553 shar_count="`wc -c < 'mailprio_mkdb'`" 554 test 4182 -eq "$shar_count" || 555 echo "mailprio_mkdb: original size 4182, current size $shar_count" 556fi 557exit 0 558