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