contrib/sendmail-8.13.4/contrib/mailprio

   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