source: trunk/third/sendmail/contrib/mmuegel @ 12554

Revision 12554, 67.2 KB checked in by danw, 26 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r12553, which included commits to RCS files with non-trunk default branches.
Line 
1From: "Michael S. Muegel" <mmuegel@cssun6.corp.mot.com>
2Message-Id: <199307280818.AA08111@cssun6.corp.mot.com>
3Subject: Re: contributed software
4To: eric@cs.berkeley.edu (Eric Allman)
5Date: Wed, 28 Jul 1993 03:18:02 -0500 (CDT)
6In-Reply-To: <199307221853.LAA04266@mastodon.CS.Berkeley.EDU> from "Eric Allman" at Jul 22, 93 11:53:47 am
7X-Mailer: ELM [version 2.4 PL22]
8Mime-Version: 1.0
9Content-Type: text/plain; charset=US-ASCII
10Content-Transfer-Encoding: 7bit
11Content-Length: 69132     
12
13OK. Here is a new shell archive.
14
15Cheers,
16-Mike
17
18---- Cut Here and feed the following to sh ----
19#!/bin/sh
20# This is a shell archive (produced by shar 3.49)
21# To extract the files from this archive, save it to a file, remove
22# everything above the "!/bin/sh" line above, and type "sh file_name".
23#
24# made 07/28/1993 08:13 UTC by mmuegel@mot.com (Michael S. Muegel)
25# Source directory /home/ustart/NeXT/src/mail-tools/dist/foo
26#
27# existing files will NOT be overwritten unless -c is specified
28#
29# This shar contains:
30# length  mode       name
31# ------ ---------- ------------------------------------------
32#   4308 -r--r--r-- README
33#  12339 -r--r--r-- libs/date.pl
34#   3198 -r--r--r-- libs/elapsed.pl
35#   4356 -r--r--r-- libs/mail.pl
36#   6908 -r--r--r-- libs/mqueue.pl
37#   7024 -r--r--r-- libs/newgetopts.pl
38#   4687 -r--r--r-- libs/strings1.pl
39#   1609 -r--r--r-- libs/timespec.pl
40#   5212 -r--r--r-- man/cqueue.1
41#   2078 -r--r--r-- man/postclip.1
42#   6647 -r-xr-xr-x src/cqueue
43#   1836 -r-xr-xr-x src/postclip
44#
45# ============= README ==============
46if test -f 'README' -a X"$1" != X"-c"; then
47        echo 'x - skipping README (File already exists)'
48else
49echo 'x - extracting README (Text)'
50sed 's/^X//' << 'SHAR_EOF' > 'README' &&
51-------------------------------------------------------------------------------
52Document Revision Control Information:
53X   mmuegel
54X   /usr/local/ustart/src/mail-tools/dist/foo/README,v
55X   1.1 of 1993/07/28 08:12:53
56-------------------------------------------------------------------------------
57X
581. Introduction
59---------------
60X
61These tools may be of use to those sites using sendmail. Both are written in
62Perl. Our site, Mot.COM, receives a ton of mail being a top-level domain
63gateway. We have over 24 domains under us. Needless to say, we must have
64a robust mail system or my head, and others, would be on the chopping block.
65X
662. Description
67--------------
68X
69The first tool, cqueue, checks the sendmail queue for problems. We use
70it to flag problems with subdomain mail servers (and even our own servers
71once in a while ;-). We run it via a cron job every hour during the day.
72You may find this too frequent, however.
73X
74The other program, postclip, is used to "filter" non-deliverable NDNs that
75get sent to our Postmaster account now and then. This ensures privacy of
76e-mail and helps avoid disk problems from huge NDNs. It is different than
77a brute force "just keep the header" approach because it tries hard to keep
78other parts of the message that look like non-delivery information.
79X
80Both have been used for some time at our site with no problems. Everything
81you need should be in this distribution: source, manual pages, and support
82libs. See the manual pages for a complete description of each tool.
83X
843. Installation
85---------------
86X
87No fancy Makefile simply because these tools are all under a large
88hierarchy at my site. Installation should be a snap, however. Install
89the nroff(1) man(5) manual pages from the man subdirectory to the
90appropriate directory on your system. This might be something like
91/usr/local/man/man1.
92X
93Next, install all of the Perl libraries located in the lib subdirectory
94to your Perl library area. /usr/local/lib/perl is a good bet. The person
95who installed Perl at your site will be able to tell you for sure.
96X
97Finally, you need to install the programs. Note that cqueue wants to
98run setuid root by default. This is because the sendmail queue is normally
99only readable by root or some special group. In order to let any user
100run this suidperl is used. suidperl allows a Perl program to run with the
101privileges of another user.
102X
103You will have to edit both the cqueue and postclip programs to change
104the #! line at the top of each. Just change the pathname to whatever is
105appropriate on your system. Note that Larry Wall's fixin program from
106the Camel book can also be used to do this. It is very handy. It changes
107#! lines by looking at your PATH.
108X
109If you do not have suidperl on your system change the #! line in cqueue
110to reference perl instead of suidperl.
111X
112You may also wish to change some constants in cqueue. $DEF_QUEUE should be
113changed to your queue directory if it is not /usr/spool/mqueue. $DEF_TIME
114could be changed easy enough also. It is the time spec for the time duration
115after which a mail message will be reported on if the -a option has not been
116specified. See the manual page for more information and the format of this
117constant (same as the -t argument). Then again, neither of these has to
118be changed. Command line options are there to override their default
119values.
120X
121After you have edited the programs as necessary, all that remains is to
122install them to some executable directory. Install postclip mode 555
123and cqueue mode 4555 with owner root (if using suidperl) or mode 555
124(if not using suidperl).
125X
1264. Gripes, Comments, Etc
127------------------------
128X
129If you start using either of these let me know. I have other mail tools I
130will likely post in the future if these prove useful. Also, if you think
131something is just plain dumb/wrong/stupid let me know!
132X
133Cheers,
134-Mike
135X
136--
137+----------------------------------------------------------------------------+
138| Michael S. Muegel                    | Internet E-Mail:    mmuegel@mot.com |
139| UNIX Applications Startup Group      | Moto Dist E-Mail:   X10090          |
140| Corporate Information Office         | Voice:              (708) 576-0507  |
141| Motorola                             | Fax:                (708) 576-4153  |
142+----------------------------------------------------------------------------+
143SHAR_EOF
144chmod 0444 README ||
145echo 'restore of README failed'
146Wc_c="`wc -c < 'README'`"
147test 4308 -eq "$Wc_c" ||
148        echo 'README: original size 4308, current size' "$Wc_c"
149fi
150# ============= libs/date.pl ==============
151if test ! -d 'libs'; then
152    echo 'x - creating directory libs'
153    mkdir 'libs'
154fi
155if test -f 'libs/date.pl' -a X"$1" != X"-c"; then
156        echo 'x - skipping libs/date.pl (File already exists)'
157else
158echo 'x - extracting libs/date.pl (Text)'
159sed 's/^X//' << 'SHAR_EOF' > 'libs/date.pl' &&
160;#
161;# Name
162;#      date.pl - Perl emulation of (the output side of) date(1)
163;#
164;# Synopsis
165;#      require "date.pl";
166;#      $Date = &date(time);
167;#      $Date = &date(time, $format);
168;#
169;# Description
170;#      This package implements the output formatting functions of date(1) in
171;#      Perl.  The format options are based on those supported by Ultrix 4.0
172;#      plus a couple of additions from SunOS 4.1.1 and elsewhere:
173;#
174;#              %a              abbreviated weekday name - Sun to Sat
175;#              %A              full weekday name - Sunday to Saturday
176;#              %b              abbreviated month name - Jan to Dec
177;#              %B              full month name - January to December
178;#              %c              date and time in local format [+]
179;#              %C              date and time in long local format [+]
180;#              %d              day of month - 01 to 31
181;#              %D              date as mm/dd/yy
182;#              %e              day of month (space padded) - ` 1' to `31'
183;#              %E              day of month (with suffix: 1st, 2nd, 3rd...)
184;#              %f              month of year (space padded) - ` 1' to `12'
185;#              %h              abbreviated month name - Jan to Dec
186;#              %H              hour - 00 to 23
187;#              %i              hour (space padded) - ` 1' to `12'
188;#              %I              hour - 01 to 12
189;#              %j              day of the year (Julian date) - 001 to 366
190;#              %k              hour (space padded) - ` 0' to `23'
191;#              %l              date in ls(1) format
192;#              %m              month of year - 01 to 12
193;#              %M              minute - 00 to 59
194;#              %n              insert a newline character
195;#              %p              ante-meridiem or post-meridiem indicator (AM or PM)
196;#              %r              time in AM/PM notation
197;#              %R              time as HH:MM
198;#              %S              second - 00 to 59
199;#              %t              insert a tab character
200;#              %T              time as HH:MM:SS
201;#              %u              date/time in date(1) required format
202;#              %U              week number, Sunday as first day of week - 00 to 53
203;#              %V              date-time in SysV touch format (mmddHHMMyy)
204;#              %w              day of week - 0 (Sunday) to 6
205;#              %W              week number, Monday as first day of week - 00 to 53
206;#              %x              date in local format [+]
207;#              %X              time in local format [+]
208;#              %y              last 2 digits of year - 00 to 99
209;#              %Y              all 4 digits of year ~ 1700 to 2000 odd ?
210;#              %z              time zone from TZ environment variable w/ a trailing space
211;#              %Z              time zone from TZ environment variable
212;#              %%              insert a `%' character
213;#              %+              insert a `+' character
214;#
215;#      [+]:  These may need adjustment to fit local conventions, see below.
216;#
217;#      For the sake of compatibility, a leading `+' in the format
218;#      specificaiton is removed if present.
219;#
220;# Remarks
221;#      This is version 3.4 of date.pl
222;#
223;#      An extension of `ctime.pl' by Waldemar Kebsch (kebsch.pad@nixpbe.UUCP),
224;#      as modified by Marion Hakanson (hakanson@ogicse.ogi.edu).
225;#
226;#  Unlike date(1), unknown format tags are silently replaced by "".
227;#
228;#  defaultTZ is a blatant hack, but I wanted to be able to get date(1)
229;#      like behaviour by default and there does'nt seem to be an easy (read
230;#      portable) way to get the local TZ name back...
231;#
232;#      For a cheap date, try...
233;#
234;#              #!/usr/local/bin/perl
235;#              require "date.pl";
236;#              exit print (&date(time, shift @ARGV) . "\n") ? 0 : 1;
237;#
238;#      This package is redistributable under the same terms as apply to
239;#      the Perl 4.0 release.  See the COPYING file in your Perl kit for
240;#      more information.
241;#
242;#      Please send any bug reports or comments to tmcgonigal@gallium.com
243;#
244;# Modification History
245;#      Nmemonic        Version Date            Who
246;#
247;#      NONE            1.0             02feb91         Terry McGonigal (tmcgonigal@gallium.com)
248;#              Created from ctime.pl
249;#
250;#      NONE            2.0             07feb91         tmcgonigal
251;#              Added some of Marion Hakanson (hakanson@ogicse.ogi.edu)'s ctime.pl
252;#              TZ handling changes.
253;#
254;#      NONE            2.1             09feb91         tmcgonigal
255;#              Corrected week number calculations.
256;#
257;#      NONE            2.2             21oct91         tmcgonigal
258;#              Added ls(1) date format, `%l'.
259;#
260;#      NONE            2.3             06nov91         tmcgonigal
261;#              Added SysV touch(1) date-time format, `%V' (pretty thin as
262;#              mnemonics go, I know, but `t' and `T' were both gone already!)
263;#
264;#      NONE            2.4             05jan92         tmcgonigal
265;#              Corrected slight (cosmetic) problem with %V replacment string
266;#
267;#      NONE            3.0             09jul92         tmcgonigal
268;#              Fixed a couple of problems with &ls as pointed out by
269;#              Thomas Richter (richter@ki1.chemie.fu-berlin.de), thanks Thomas!
270;#              Also added a couple of SunOS 4.1.1 strftime-ish formats, %i and %k
271;#              for space padded hours (` 1' to `12' and ` 0' to `23' respectivly),
272;#              and %C for locale long date/time format.  Changed &ampmH to take a
273;#              pad char parameter to make to evaled code for %i and %k simpler.
274;#              Added %E for suffixed day-of-month (ie 1st, 3rd, 4th etc).
275;#
276;#      NONE            3.1             16jul92         tmcgonigal
277;#              Added `%u' format to generate date/time in date(1) required
278;#              format (ie '%y%m%d%H%M.%S').
279;#
280;#      NONE            3.2             23jan93         tmcgonigal
281;#              Added `%f' format to generate space padded month numbers, added
282;#              `%E' to the header comments, it seems to have been left out (and
283;#              I'm sure I wanted to use it at some point in the past...).
284;#
285;#      NONE            3.3             03feb93         tmcgonigal
286;#              Corrected some problems with AM/PM handling pointed out by
287;#              Michael S. Muegel (mmuegel@mot.com).  Thanks Michael, I hope
288;#              this is the behaviour you were looking for, it seems more
289;#              correct to me...
290;#
291;#      NONE            3.4             26jul93         tmcgonigal
292;#              Incorporated some fixes provided by DaviD W. Sanderson
293;#              (dws@ssec.wisc.edu): February was spelled incorrectly and
294;#              &wkno() was always using the current year while calculating
295;#              week numbers, regardless of year implied by the time value
296;#              passed to &date().  DaviD also contributed an improved &date()
297;#              test script, thanks DaviD, I appreciate the effort.  Finally,
298;#              changed my mailling address from @gvc.com to @gallium.com
299;#              to reflect, well, my new address!
300;#
301;# SccsId = "%W% %E%"
302;#
303require 'timelocal.pl';
304package date;
305X
306# Months of the year
307@MoY = ('January',      'February',     'March',        'April',        'May',          'June',
308X               'July',         'August',       'September','October',  'November', 'December');
309X
310# days of the week
311@DoW = ('Sunday',       'Monday',       'Tuesday',      'Wednesday',
312X               'Thursday',     'Friday',       'Saturday');
313X
314# CUSTOMIZE - defaults
315$defaultTZ = 'CST';                                             # time zone (hack!)
316$defaultFMT = '%a %h %e %T %z%Y';               # format (ala date(1))
317X
318# CUSTOMIZE - `local' formats
319$locTF = '%T';                                                  # time (as HH:MM:SS)
320$locDF = '%D';                                                  # date (as mm/dd/yy)
321$locDTF = '%a %b %d %T %Y';                             # date/time (as dow mon dd HH:MM:SS yyyy)
322$locLDTF = '%i:%M:%S %p %A %B %E %Y';   # long date/time (as HH:MM:SS a/p day month dom yyyy)
323X
324# Time zone info
325$TZ;                                                                    # wkno needs this info too
326X
327# define the known format tags as associative keys with their associated
328# replacement strings as values.  Each replacement string should be
329# an eval-able expresion assigning a value to $rep.  These expressions are
330# eval-ed, then the value of $rep is substituted into the supplied
331# format (if any).
332%Tags = ( '%a', q|($rep = $DoW[$wday])=~ s/^(...).*/\1/|,       # abbr. weekday name - Sun to Sat
333X                 '%A', q|$rep = $DoW[$wday]|,                                          # full weekday name - Sunday to Saturday
334X                 '%b', q|($rep = $MoY[$mon]) =~ s/^(...).*/\1/|,       # abbr. month name - Jan to Dec
335X                 '%B', q|$rep = $MoY[$mon]|,                                           # full month name - January to December
336X                 '%c', q|$rep = $locDTF; 1|,                                           # date/time in local format
337X                 '%C', q|$rep = $locLDTF; 1|,                                          # date/time in local long format
338X                 '%d', q|$rep = &date'pad($mday, 2, "0")|,                     # day of month - 01 to 31
339X                 '%D', q|$rep = '%m/%d/%y'|,                                           # date as mm/dd/yy
340X                 '%e', q|$rep = &date'pad($mday, 2, " ")|,                     # day of month (space padded) ` 1' to `31'
341X                 '%E', q|$rep = &date'dsuf($mday)|,                            # day of month (w/suffix) `1st' to `31st'
342X                 '%f', q|$rep = &date'pad($mon+1, 2, " ")|,            # month of year (space padded) ` 1' to `12'
343X                 '%h', q|$rep = '%b'|,                                                         # abbr. month name (same as %b)
344X                 '%H', q|$rep = &date'pad($hour, 2, "0")|,                     # hour - 00 to 23
345X                 '%i', q|$rep = &date'ampmH($hour, " ")|,                      # hour (space padded ` 1' to `12'
346X                 '%I', q|$rep = &date'ampmH($hour, "0")|,                      # hour - 01 to 12
347X                 '%j', q|$rep = &date'pad($yday+1, 3, "0")|,           # Julian date 001 - 366
348X                 '%k', q|$rep = &date'pad($hour, 2, " ")|,                     # hour (space padded) ` 0' to `23'
349X                 '%l', q|$rep = '%b %d ' . &date'ls($year)|,           # ls(1) style date
350X                 '%m', q|$rep = &date'pad($mon+1, 2, "0")|,            # month of year - 01 to 12
351X                 '%M', q|$rep = &date'pad($min, 2, "0")|,                      # minute - 00 to 59
352X                 '%n', q|$rep = "\n"|,                                                         # insert a newline
353X                 '%p', q|$rep = &date'ampmD($hour)|,                           # insert `AM' or `PM'
354X                 '%r', q|$rep = '%I:%M:%S %p'|,                                        # time in AM/PM notation
355X                 '%R', q|$rep = '%H:%M'|,                                                      # time as HH:MM
356X                 '%S', q|$rep = &date'pad($sec, 2, "0")|,                      # second - 00 to 59
357X                 '%t', q|$rep = "\t"|,                                                         # insert a tab
358X                 '%T', q|$rep = '%H:%M:%S'|,                                           # time as HH:MM:SS
359X                 '%u', q|$rep = '%y%m%d%H%M.%S'|,                                      # daaate/time in date(1) required format
360X                 '%U', q|$rep = &date'wkno($year, $yday, 0)|,          # week number (weeks start on Sun) - 00 to 53
361X                 '%V', q|$rep = '%m%d%H%M%y'|,                                         # SysV touch(1) date-time format (mmddHHMMyy)
362X                 '%w', q|$rep = $wday; 1|,                                                     # day of week - Sunday = 0
363X                 '%W', q|$rep = &date'wkno($year, $yday, 1)|,          # week number (weeks start on Mon) - 00 to 53
364X                 '%x', q|$rep = $locDF; 1|,                                            # date in local format
365X                 '%X', q|$rep = $locTF; 1|,                                            # time in local format
366X                 '%y', q|($rep = $year) =~ s/..(..)/\1/|,                      # last 2 digits of year - 00 to 99
367X                 '%Y', q|$rep = "$year"; 1|,                                           # full year ~ 1700 to 2000 odd
368X                 '%z', q|$rep = $TZ eq "" ? "" : "$TZ "|,                      # time zone from TZ env var (w/trail. space)
369X                 '%Z', q|$rep = $TZ; 1|,                                                       # time zone from TZ env. var.
370X                 '%%', q|$rep = '%'; $adv=1|,                                          # insert a `%'
371X                 '%+', q|$rep = '+'|                                                           # insert a `+'
372);
373X       
374sub main'date {
375X       local($time, $format) = @_;
376X       local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
377X       local($pos, $tag, $rep, $adv) = (0, "", "", 0);
378X
379X       # default to date/ctime format or strip leading `+'...
380X       if ($format eq "") {
381X               $format = $defaultFMT;
382X       } elsif ($format =~ /^\+/) {
383X               $format = $';
384X       }
385X
386X       # Use local time if can't find a TZ in the environment
387X       $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ;
388X       ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
389X               &gettime ($TZ, $time);
390X
391X       # Hack to deal with 'PST8PDT' format of TZ
392X       # Note that this can't deal with all the esoteric forms, but it
393X       # does recognize the most common: [:]STDoff[DST[off][,rule]]
394X       if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
395X               $TZ = $isdst ? $4 : $1;
396X       }
397X
398X       # watch out in 2070...
399X       $year += ($year < 70) ? 2000 : 1900;
400X
401X       # now loop throught the supplied format looking for tags...
402X       while (($pos = index ($format, '%')) != -1) {
403X
404X               # grab the format tag
405X               $tag = substr($format, $pos, 2);
406X               $adv = 0;                                                       # for `%%' processing
407X
408X               # do we have a replacement string?
409X               if (defined $Tags{$tag}) {
410X
411X                       # trap dead evals...
412X                       if (! eval $Tags{$tag}) {
413X                               print STDERR "date.pl: internal error: eval for $tag failed: $@\n";
414X                               return "";
415X                       }
416X               } else {
417X                       $rep = "";
418X               }
419X                       
420X               # do the substitution
421X               substr ($format, $pos, 2) =~ s/$tag/$rep/;
422X               $pos++ if ($adv);
423X       }
424X
425X       $format;
426}
427X
428# dsuf - add `st', `nd', `rd', `th' to a date (ie 1st, 22nd, 29th)
429sub dsuf {
430X       local ($mday) = @_;
431X
432X       return $mday . 'st' if ($mday =~ m/.*1$/);
433X       return $mday . 'nd' if ($mday =~ m/.*2$/);
434X       return $mday . 'rd' if ($mday =~ m/.*3$/);
435X       return $mday . 'th';
436}
437X       
438# weekno - figure out week number
439sub wkno {
440X       local ($year, $yday, $firstweekday) = @_;   
441X       local ($jan1, @jan1, $wks);
442X
443X       # figure out the `time' value for January 1 of the given year
444X       $jan1 = &maketime ($TZ, 0, 0, 0, 1, 0, $year-1900);
445X
446X       # figure out what day of the week January 1 was
447X       @jan1= &gettime ($TZ, $jan1);
448X       
449X       # and calculate the week number
450X       $wks = (($yday + ($jan1[6] - $firstweekday)) + 1)/ 7;
451X       $wks += (($wks - int($wks) > 0.0) ? 1 : 0);
452X
453X       # supply zero padding
454X       &pad (int($wks), 2, "0");
455}
456X
457# ampmH - figure out am/pm (1 - 12) mode hour value, padded with $p (0 or ' ')
458sub ampmH { local ($h, $p) = @_;  &pad($h>12 ? $h-12 : ($h ? $h : 12), 2, $p); }
459X
460# ampmD - figure out am/pm designator
461sub ampmD { shift @_ >= 12 ? "PM" : "AM"; }
462X
463# gettime - get the time via {local,gmt}time
464sub gettime { ((shift @_) eq 'GMT') ? gmtime(shift @_) : localtime(shift @_); }
465X
466# maketime - make a time via time{local,gmt}
467sub maketime { ((shift @_) eq 'GMT') ? &main'timegm(@_) : &main'timelocal(@_); }
468X
469# ls - generate the time/year portion of an ls(1) style date
470sub ls {
471X       return ((&gettime ($TZ, time))[5] == @_[0]) ? "%R" : " %Y";
472}
473X
474# pad - pad $in with leading $pad until lenght $len
475sub pad {
476X       local ($in, $len, $pad) = @_;
477X       local ($out) = "$in";
478X
479X       $out = $pad . $out until (length ($out) == $len);
480X       return $out;
481}
482X
4831;
484SHAR_EOF
485chmod 0444 libs/date.pl ||
486echo 'restore of libs/date.pl failed'
487Wc_c="`wc -c < 'libs/date.pl'`"
488test 12339 -eq "$Wc_c" ||
489        echo 'libs/date.pl: original size 12339, current size' "$Wc_c"
490fi
491# ============= libs/elapsed.pl ==============
492if test -f 'libs/elapsed.pl' -a X"$1" != X"-c"; then
493        echo 'x - skipping libs/elapsed.pl (File already exists)'
494else
495echo 'x - extracting libs/elapsed.pl (Text)'
496sed 's/^X//' << 'SHAR_EOF' > 'libs/elapsed.pl' &&
497;# NAME
498;#    elapsed.pl - convert seconds to elapsed time format
499;#
500;# AUTHOR
501;#    Michael S. Muegel <mmuegel@mot.com>
502;#
503;# RCS INFORMATION
504;#    mmuegel
505;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/elapsed.pl,v
506;#    1.1 of 1993/07/28 08:07:19
507X
508package elapsed;
509X
510# Time field types
511$DAYS           = 1;
512$HOURS          = 2;
513$MINUTES        = 3;
514$SECONDS        = 4;
515X
516# The array contains four records each with four fields. The fields are,
517# in order:
518#
519#    Type               Specifies what kind of time field this is. Once of
520#                       $DAYS, $HOURS, $MINUTES, or $SECONDS.
521#
522#    Multiplier         Specifies what time field this is via the minimum
523#                       number of seconds this time field may specify. For
524#                       example, the minutes field would be non-zero
525#                       when there are 60 or more seconds.
526#                       
527#    Separator          How to separate this time field from the next
528#                       *greater* field.
529#
530#    Format             sprintf() format specifier on how to print this
531#                       time field.
532@MULT_AND_SEPS = ($DAYS, 60 * 60 * 24, "+", "%d",
533X                  $HOURS, 60 * 60, ":", "%d",
534X                  $MINUTES, 60, ":", "%02d",
535X                  $SECONDS, 1, "", "%02d"
536X                 );
537X
538;###############################################################################
539;# Seconds_To_Elapsed
540;#
541;# Coverts a seconds count to form [d+]h:mm:ss. If $Collapse
542;# is true then the result is compacted somewhat. The string returned
543;# will be of the form [d+][[h:]mm]:ss.
544;#
545;# Arguments:
546;#    $Seconds, $Collapse
547;#
548;# Examples:
549;#    &Seconds_To_Elapsed (0, 0)        -> 0:00:00
550;#    &Seconds_To_Elapsed (0, 1)        -> :00
551;#
552;#    &Seconds_To_Elapsed (119, 0)      -> 0:01:59
553;#    &Seconds_To_Elapsed (119, 1)      -> 01:59
554;#
555;#    &Seconds_To_Elapsed (3601, 0)     -> 1:00:01
556;#    &Seconds_To_Elapsed (3601, 1)     -> 1:00:01
557;#
558;#    &Seconds_To_Elapsed (86401, 0)    -> 1+0:00:01
559;#    &Seconds_To_Elapsed (86401, 1)    -> 1+:01
560;#
561;# Returns:
562;#    $Elapsed
563;###############################################################################
564sub main'Seconds_To_Elapsed
565{
566X   local ($Seconds, $Collapse) = @_;
567X   local ($Type, $Multiplier, @Multipliers, $Separator, $DHMS_Used,
568X          $Elapsed, @Mult_And_Seps, $Print_Field);
569X
570X   $Multiplier = 1;
571X   @Mult_And_Seps = @MULT_AND_SEPS;
572X
573X   # Keep subtracting the number of seconds corresponding to a time field
574X   # from the number of seconds passed to the function.
575X   while (1)
576X   {
577X      ($Type, $Multiplier, $Separator, $Format) = splice (@Mult_And_Seps, 0, 4);
578X      last if (! $Multiplier);
579X      $Seconds -= $DHMS_Used * $Multiplier
580X         if ($DHMS_Used = int ($Seconds / $Multiplier));
581X
582X      # Figure out if we should print this field
583X      if ($Type == $DAYS)
584X      {
585X        $Print_Field = $DHMS_Used;
586X      }
587X
588X      elsif ($Collapse)
589X      {
590X        if ($Type == $HOURS)
591X        {
592X           $Print_Field = $DHMS_Used;
593X        }
594X        elsif ($Type == $MINUTES)
595X        {
596X           $Print_Field = $DHMS_Used || $Printed_Field {$HOURS};
597X        }
598X        else
599X        {
600X           $Format = ":%02d"
601X              if (! $Printed_Field {$MINUTES});
602X           $Print_Field = 1;
603X        };
604X      }
605X
606X      else
607X      {
608X        $Print_Field = 1;
609X      };
610X
611X      $Printed_Field {$Type} = $Print_Field;
612X      $Elapsed .= sprintf ("$Format%s", $DHMS_Used, $Separator)
613X        if ($Print_Field);
614X   };
615X
616X   return ($Elapsed);
617};
618X
6191;
620SHAR_EOF
621chmod 0444 libs/elapsed.pl ||
622echo 'restore of libs/elapsed.pl failed'
623Wc_c="`wc -c < 'libs/elapsed.pl'`"
624test 3198 -eq "$Wc_c" ||
625        echo 'libs/elapsed.pl: original size 3198, current size' "$Wc_c"
626fi
627# ============= libs/mail.pl ==============
628if test -f 'libs/mail.pl' -a X"$1" != X"-c"; then
629        echo 'x - skipping libs/mail.pl (File already exists)'
630else
631echo 'x - extracting libs/mail.pl (Text)'
632sed 's/^X//' << 'SHAR_EOF' > 'libs/mail.pl' &&
633;# NAME
634;#    mail.pl - perl function(s) to handle mail processing
635;#
636;# AUTHOR
637;#    Michael S. Muegel (mmuegel@mot.com)
638;#
639;# RCS INFORMATION
640;#    mmuegel
641;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/mail.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp
642X
643package mail;
644X
645# Mailer statement to eval. $Users, $Subject, and $Verbose are substituted
646# via eval
647$BIN_MAILER             = "/usr/ucb/mail \$Verbose -s '\$Subject' \$Users";
648X
649# Sendmail command to use when $Use_Sendmail is true.
650$SENDMAIL               = '/usr/lib/sendmail $Verbose $Users';
651X
652;###############################################################################
653;# Send_Mail
654;#
655;# Sends $Message to $Users with a subject of $Subject. If $Message_Is_File
656;# is true then $Message is assumed to be a filename pointing to the mail
657;# message. This is a new option and thus the backwards-compatible hack.
658;# $Users should be a space separated list of mail-ids.
659;#
660;# If everything went OK $Status will be 1 and $Error_Msg can be ignored;
661;# otherwise, $Status will be 0 and $Error_Msg will contain an error message.
662;#
663;# If $Use_Sendmail is 1 then sendmail is used to send the message. Normally
664;# a mailer such as Mail is used. By specifiying this you can include
665;# headers in addition to text in either $Message or $Message_Is_File.
666;# If either $Message or $Message_Is_File contain a Subject: header then
667;# $Subject is ignored; otherwise, a Subject: header is automatically created.
668;# Similar to the Subject: header, if a To: header does not exist one
669;# is automatically created from the $Users argument. The mail is still
670;# sent, however, to the recipients listed in $Users. This is keeping with
671;# normal sendmail usage (header vs. envelope).
672;#
673;# In both bin mailer and sendmail modes $Verbose will turn on verbose mode
674;# (normally just sendmail verbose mode output).
675;#
676;# Arguments:
677;#    $Users, $Subject, $Message, $Message_Is_File, $Verbose, $Use_Sendmail
678;#
679;# Returns:
680;#    $Status, $Error_Msg
681;###############################################################################
682sub main'Send_Mail
683{
684X   local ($Users, $Subject, $Message, $Message_Is_File, $Verbose,
685X         $Use_Sendmail) = @_;
686X   local ($BIN_MAILER_HANDLE, $Mailer_Command, $Header_Found, %Header_Map,
687X         $Header_Extra, $Mailer);
688X
689X   # If the message is contained in a file read it in so we can have one
690X   # consistent interface
691X   if ($Message_Is_File)
692X   {
693X      undef $/;
694X      $Message_Is_File = 0;
695X      open (Message) || return (0, "error reading $Message: $!");
696X      $Message = <Message>;
697X      close (Message);
698X   };
699X
700X   # If sendmail mode see if we need to add some headers
701X   if ($Use_Sendmail)
702X   {
703X      # Determine if a header block is included in the message and what headers
704X      # are there
705X      foreach (split (/\n/, $Message))
706X      {
707X        last if ($_ eq "");
708X        $Header_Found = $Header_Map {$1} = 1 if (/^([A-Z]\S*): /);
709X      };
710X
711X      # Add some headers?
712X      if (! $Header_Map {"To"})
713X      {
714X        $Header_Extra .= "To: " . join (", ", $Users) . "\n";
715X      };
716X      if (($Subject ne "") && (! $Header_Map {"Subject"}))
717X      {
718X        $Header_Extra .= "Subject: $Subject\n";
719X      };
720X
721X      # Add the required blank line between header/body if there where no
722X      # headers to begin with
723X      if ($Header_Found)
724X      {
725X         $Message = "$Header_Extra$Message";
726X      }
727X      else
728X      {
729X        $Message = "$Header_Extra\n$Message";
730X      };
731X   };
732X
733X   # Get a string that is the mail command
734X   $Verbose = ($Verbose) ? "-v" : "";
735X   $Mailer = ($Use_Sendmail) ? $SENDMAIL : $BIN_MAILER;
736X   eval "\$Mailer = \"$Mailer\"";
737X   return (0, "error setting \$Mailer: $@") if ($@);
738X
739X   # need to catch SIGPIPE in case the $Mailer call fails
740X   $SIG {'PIPE'} = "mail'Cleanup";
741X
742X   # Open mailer
743X   return (0, "can not open mail program: $Mailer") if (! open (MAILER, "| $Mailer"));
744X   
745X   # Send off the mail!
746X   print MAILER $Message;
747X   close (MAILER);
748X   return (0, "error running mail program: $Mailer") if ($?);
749X   
750X   # Everything must have went AOK
751X   return (1);
752};
753X
754;###############################################################################
755;# Cleanup
756;#
757;# Simply here so we can catch SIGPIPE and not exit.
758;#
759;# Globals:
760;#    None
761;#
762;# Arguments:
763;#    None
764;#
765;# Returns:
766;#    Nothing exciting
767;###############################################################################
768sub Cleanup
769{
770};
771X
7721;
773SHAR_EOF
774chmod 0444 libs/mail.pl ||
775echo 'restore of libs/mail.pl failed'
776Wc_c="`wc -c < 'libs/mail.pl'`"
777test 4356 -eq "$Wc_c" ||
778        echo 'libs/mail.pl: original size 4356, current size' "$Wc_c"
779fi
780# ============= libs/mqueue.pl ==============
781if test -f 'libs/mqueue.pl' -a X"$1" != X"-c"; then
782        echo 'x - skipping libs/mqueue.pl (File already exists)'
783else
784echo 'x - extracting libs/mqueue.pl (Text)'
785sed 's/^X//' << 'SHAR_EOF' > 'libs/mqueue.pl' &&
786;# NAME
787;#    mqueue.pl - functions to work with the sendmail queue
788;#
789;# DESCRIPTION
790;#    Both Get_Queue_IDs and Parse_Control_File are available to get
791;#    information about the sendmail queue. The cqueue program is a good
792;#    example of how these functions work.
793;#
794;# AUTHOR
795;#    Michael S. Muegel (mmuegel@mot.com) 
796;#
797;# RCS INFORMATION
798;#    mmuegel
799;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/mqueue.pl,v
800;#    1.1 of 1993/07/28 08:07:19
801X
802package mqueue;
803X
804;###############################################################################
805;# Get_Queue_IDs
806;#
807;# Will figure out the queue IDs in $Queue that have both control and data
808;# files. They are returned in @Valid_IDs. Those IDs that have a
809;# control file and no data file are saved to the array globbed by
810;# *Missing_Control_IDs. Likewise, those IDs that have a data file and no
811;# control file are saved to the array globbed by *Missing_Data_IDs.
812;#
813;# If $Skip_Locked is true they a message that has a lock file is skipped
814;# and will not show up in any of the arrays.
815;#
816;# If everything went AOK then $Status is 1; otherwise, $Status is 0 and
817;# $Msg tells what went wrong.
818;#
819;# Globals:
820;#    None
821;#
822;# Arguments:
823;#    $Queue, $Skip_Locked, *Missing_Control_IDs, *Missing_Data_IDs
824;#
825;# Returns:
826;#    $Status, $Msg, @Valid_IDs
827;###############################################################################
828sub main'Get_Queue_IDs
829{
830X   local ($Queue, $Skip_Locked, *Missing_Control_IDs,
831X          *Missing_Data_IDs) = @_;
832X   local (*QUEUE, @Files, %Lock_IDs, %Data_IDs, %Control_IDs, $_);
833X
834X   # Make sure that the * argument @arrays ar empty
835X   @Missing_Control_IDs = @Missing_Data_IDs = ();
836X
837X   # Save each data, lock, and queue file in @Files
838X   opendir (QUEUE, $Queue) || return (0, "error getting directory listing of $Queue");
839X   @Files = grep (/^(df|lf|qf)/, readdir (QUEUE));
840X   closedir (QUEUE);
841X   
842X   # Create indexed list of data and control files. IF $Skip_Locked is true
843X   # then skip either if there is a lock file present.
844X   if ($Skip_Locked)
845X   {
846X      grep ((s/^lf//) && ($Lock_IDs {$_} = 1), @Files);
847X      grep ((s/^df//) && (! $Lock_IDs {$_}) && ($Data_IDs {$_} = 1), @Files);
848X      grep ((s/^qf//) && (! $Lock_IDs {$_}) && ($Control_IDs {$_} = 1), @Files);
849X   }
850X   else
851X   {
852X      grep ((s/^df//) && ($Data_IDs {$_} = 1), @Files);
853X      grep ((s/^qf//) && ($Control_IDs {$_} = 1), @Files);
854X   };
855X   
856X   # Find missing control and data files and remove them from the lists of each
857X   @Missing_Control_IDs = sort (grep ((! $Control_IDs {$_}) && (delete $Data_IDs {$_}), keys (%Data_IDs)));
858X   @Missing_Data_IDs = sort (grep ((! $Data_IDs {$_} && (delete $Control_IDs {$_})), keys (%Control_IDs)));
859X   
860X   
861X   # Return the IDs in an appartently random order
862X   return (1, "", keys (%Control_IDs));
863};
864X
865X
866;###############################################################################
867;# Parse_Control_File
868;#
869;# Will pase a sendmail queue control file for useful information. See the
870;# Sendmail Installtion and Operation Guide (SMM:07) for a complete
871;# explanation of each field.
872;#
873;# The following globbed variables are set (or cleared) by this function:
874;#
875;#    $Sender           The sender's address.
876;#
877;#    @Recipients       One or more addresses for the recipient of the mail.
878;#
879;#    @Errors_To        One or more addresses for addresses to which mail
880;#                      delivery errors should be sent.
881;#
882;#    $Creation_Time    The job creation time in time(3) format. That is,
883;#                      seconds since 00:00:00 GMT 1/1/70.
884;#
885;#    $Priority         An integer representing the current message priority.
886;#                      This is used to order the queue. Higher numbers mean
887;#                      lower priorities.
888;#
889;#    $Status_Message   The status of the mail message. It can contain any
890;#                      text.
891;#
892;#    @Headers          Message headers unparsed but in their original order.
893;#                      Headers that span multiple lines are not mucked with,
894;#                      embedded \ns will be evident.
895;#
896;# In all e-mail addresses bounding <> pairs are stripped.
897;#
898;# If everything went AOK then $Status is 1. If the message with queue ID
899;# $Queue_ID just does not exist anymore -1 is returned. This is very
900;# possible and should be allowed for. Otherwise, $Status is 0 and $Msg
901;# tells what went wrong.
902;#
903;# Globals:
904;#    None
905;#
906;# Arguments:
907;#    $Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time,
908;#    *Priority, *Status_Message, *Headers
909;#
910;# Returns:
911;#    $Status, $Msg
912;###############################################################################
913sub main'Parse_Control_File
914{
915X   local ($Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time,
916X          *Priority, *Status_Message, *Headers) = @_;
917X   local (*Control, $_, $Not_Empty);
918X
919X   # Required variables and the associated control. If empty at the end of
920X   # parsing we return a bad status.
921X   @REQUIRED_INFO = ('$Creation_Time', 'T', '$Sender', 'S', '@Recipients', 'R',
922X                    '$Priority', 'P');
923X
924X   # Open up the control file for read
925X   $Control = "$Queue/qf$Queue_ID";
926X   if (! open (Control))
927X   {
928X      return (-1) if ((-x $Queue) && (! -f "$Queue/qf$Queue_ID") &&
929X       (! -f "$Queue/df$Queue_ID"));
930X      return (0, "error opening $Control for read: $!");
931X   };
932X
933X   # Reset the globbed variables just in case
934X   $Sender = $Creation_Time = $Priority = $Status_Message = "";
935X   @Recipients = @Errors_To = @Headers = ();
936X
937X   # Look for a few things in the control file
938X   READ: while (<Control>)
939X   {
940X      $Not_Empty = 1;
941X      chop;
942X
943X      PARSE:
944X      {
945X         if (/^T(\d+)$/)
946X         {
947X            $Creation_Time = $1;
948X         }
949X         elsif (/^S(<)?([^>]+)/)
950X         {
951X            $Sender = $2;
952X         }
953X         elsif (/^R(<)?([^>]+)/)
954X         {
955X            push (@Recipients, $2);
956X         }
957X         elsif (/^E(<)?([^>]+)/)
958X         {
959X            push (@Errors_To, $2);
960X         }
961X         elsif (/^M(.*)/)
962X         {
963X            $Status_Message = $1;
964X         }
965X         elsif (/^P(\d+)$/)
966X         {
967X            $Priority = $1;
968X         }
969X         elsif (/^H(.*)/)
970X         {
971X            $Header = $1;
972X            while (<Control>)
973X            {
974X               chop;
975X               last if (/^[A-Z]/);
976X               $Header .= "\n$_";
977X            };
978X            push (@Headers, $Header);
979X           redo PARSE if ($_);
980X           last if (eof);
981X         };
982X      };
983X   };
984X
985X   # If the file was empty scream bloody murder
986X   return (0, "empty control file") if (! $Not_Empty);
987X
988X   # Yell if we could not find a required field
989X   while (($Var, $Control) = splice (@REQUIRED_INFO, 0, 2))
990X   {
991X      eval "return (0, 'required control field $Control not found')
992X              if (! $Var)";
993X      return (0, "error checking \$Var: $@") if ($@);
994X   };
995X
996X   # Everything went AOK
997X   return (1);
998};
999X
10001;
1001SHAR_EOF
1002chmod 0444 libs/mqueue.pl ||
1003echo 'restore of libs/mqueue.pl failed'
1004Wc_c="`wc -c < 'libs/mqueue.pl'`"
1005test 6908 -eq "$Wc_c" ||
1006        echo 'libs/mqueue.pl: original size 6908, current size' "$Wc_c"
1007fi
1008# ============= libs/newgetopts.pl ==============
1009if test -f 'libs/newgetopts.pl' -a X"$1" != X"-c"; then
1010        echo 'x - skipping libs/newgetopts.pl (File already exists)'
1011else
1012echo 'x - extracting libs/newgetopts.pl (Text)'
1013sed 's/^X//' << 'SHAR_EOF' > 'libs/newgetopts.pl' &&
1014;# NAME
1015;#    newgetopts.pl - a better newgetopt (which is a better getopts which is
1016;#                    a better getopt ;-)
1017;#
1018;# AUTHOR
1019;#    Mike Muegel (mmuegel@mot.com)
1020;#
1021;# mmuegel
1022;# /usr/local/ustart/src/mail-tools/dist/foo/libs/newgetopts.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp
1023X
1024;###############################################################################
1025;# New_Getopts
1026;#
1027;# Does not care about order of switches, options, and arguments like
1028;# getopts.pl. Thus all non-switches/options will be kept in ARGV even if they
1029;# are not at the end. If $Pass_Invalid is set all unkown options will be
1030;# passed back to the caller by keeping them in @ARGV. This is useful when
1031;# parsing a command line for your script while ignoring options that you
1032;# may pass to another script. If this is set New_Getopts tries to maintain
1033;# the switch clustering on the unkown switches.
1034;#
1035;# Accepts the special argument -usage to print the Usage string. Also accepts
1036;# the special option -version which prints the contents of the string
1037;# $VERSION. $VERSION may or may not have an embeded \n in it. If -usage
1038;# or -version are specified a status of -1 is returned. Note that the usage
1039;# option is only accepted if the usage string is not null.
1040;#
1041;# $Switches is just like the formal arguemnt of getopts.pl. $Usage is a usage
1042;# string with or without a trailing \n. *Switch_To_Order is an optional
1043;# pointer to the name of an associative array which will contain a mapping of
1044;# switch names to the order in which (if at all) the argument was entered.
1045;#
1046;# For example, if @ARGV contains -v, -x, test:
1047;#
1048;#    $Switch_To_Order {"v"} = 1;
1049;#    $Switch_To_Order {"x"} = 2;
1050;#
1051;# Note that in the case of multiple occurances of an option $Switch_To_Order
1052;# will store each occurance of the argument via a string that emulates
1053;# an array. This is done by using join ($;, ...). You can retrieve the
1054;# array by using split (/$;/, ...).
1055;#
1056;# *Split_ARGV is an optional pointer to an array which will conatin the
1057;# original switches along with their values. For the example used above
1058;# Split_ARGV would contain:
1059;#
1060;#   @Split_ARGV = ("v", "", "x", "test");
1061;#
1062;# Another exciting ;-) feature that newgetopts has. Along with creating the
1063;# normal $opt_ scalars for the last value of an argument the list @opt_ is
1064;# created. It is an array which contains all the values of arguments to the
1065;# basename of the variable. They are stored in the order which they occured
1066;# on the command line starting with $[. Note that blank arguments are stored
1067;# as "". Along with providing support for multiple options on the command
1068;# line this also provides a method of counting the number of times an option
1069;# was specified via $#opt_.
1070;#
1071;# Automatically resets all $opt_, @opt_, %Switch_To_Order, and @Split_ARGV
1072;# variables so that New_Getopts may be called more than once from within
1073;# the same program. Thus, if $opt_v is set upon entry to New_Getopts and
1074;# -v is not in @ARGV $opt_v will not be set upon exit.
1075;#
1076;# Arguments:
1077;#    $Switches, $Usage, $Pass_Invalid, *Switch_To_Order, *Split_ARGV
1078;#
1079;# Returns:
1080;#    -1, 0, or 1 depending on status (printed Usage/Version, OK, not OK)
1081;###############################################################################
1082sub New_Getopts
1083{
1084X    local($taint_argumentative, $Usage, $Pass_Invalid, *Switch_To_Order,
1085X          *Split_ARGV) = @_;
1086X    local(@args,$_,$first,$rest,$errs, @leftovers, @current_leftovers,
1087X          %Switch_Found);
1088X    local($[, $*, $Script_Name, $argumentative);
1089X
1090X    # Untaint the argument cluster so that we can use this with taintperl
1091X    $taint_argumentative =~ /^(.*)$/;
1092X    $argumentative = $1;
1093X
1094X    # Clear anything that might still be set from a previous New_Getopts
1095X    # call.
1096X    @Split_ARGV = ();
1097X
1098X    # Get the basename of the calling script
1099X    ($Script_Name = $0) =~ s/.*\///;
1100X   
1101X    # Make Usage have a trailing \n
1102X    $Usage .= "\n" if ($Usage !~ /\n$/);
1103X
1104X    @args = split( / */, $argumentative );
1105X
1106X    # Clear anything that might still be set from a previous New_Getopts call.
1107X    foreach $first (@args)
1108X    {
1109X       next if ($first eq ":");
1110X       delete $Switch_Found {$first};
1111X       delete $Switch_To_Order {$first};
1112X       eval "undef \@opt_$first; undef \$opt_$first;";
1113X    };
1114X
1115X    while (@ARGV)
1116X    {
1117X        # Let usage through
1118X        if (($ARGV[0] eq "-usage") && ($Usage ne "\n"))
1119X        {
1120X           print $Usage;
1121X           exit (-1);
1122X        }
1123X
1124X        elsif ($ARGV[0] eq "-version")
1125X        {
1126X           if ($VERSION)
1127X           {
1128X              print $VERSION;
1129X              print "\n" if ($VERSION !~ /\n$/);
1130X           }
1131X           else
1132X           {
1133X              warn "${Script_Name}: no version information available, sorry\n";
1134X           }
1135X           exit (-1);
1136X        }
1137X
1138X        elsif (($_ = $ARGV[0]) =~ /^-(.)(.*)/)
1139X        {
1140X           ($first,$rest) = ($1,$2);
1141X           $pos = index($argumentative,$first);
1142X
1143X           $Switch_To_Order {$first} = join ($;, split (/$;/, $Switch_To_Order {$first}), ++$Order);
1144X
1145X           if($pos >= $[)
1146X           {
1147X               if($args[$pos+1] eq ':')
1148X               {
1149X                   shift(@ARGV);
1150X                   if($rest eq '')
1151X                   {
1152X                       $rest = shift(@ARGV);
1153X                   }
1154X
1155X                   eval "\$opt_$first = \$rest;";
1156X                   eval "push (\@opt_$first, \$rest);";
1157X                   push (@Split_ARGV, $first, $rest);
1158X               }
1159X               else
1160X               {
1161X                   eval "\$opt_$first = 1";
1162X                   eval "push (\@opt_$first, '');";
1163X                   push (@Split_ARGV, $first, "");
1164X
1165X                   if($rest eq '')
1166X                   {
1167X                       shift(@ARGV);
1168X                   }
1169X                   else
1170X                   {
1171X                       $ARGV[0] = "-$rest";
1172X                   }
1173X               }
1174X           }
1175X
1176X           else
1177X           {
1178X               # Save any other switches if $Pass_Valid
1179X               if ($Pass_Invalid)
1180X               {
1181X                  push (@current_leftovers, $first);
1182X               }
1183X               else
1184X               {
1185X                  warn "${Script_Name}: unknown option: $first\n";
1186X                  ++$errs;
1187X               };
1188X               if($rest ne '')
1189X               {
1190X                   $ARGV[0] = "-$rest";
1191X               }
1192X               else
1193X               {
1194X                   shift(@ARGV);
1195X               }
1196X           }
1197X        }
1198X
1199X        else
1200X        {
1201X           push (@leftovers, shift (@ARGV));
1202X        };
1203X
1204X        # Save any other switches if $Pass_Valid
1205X        if ((@current_leftovers) && ($rest eq ''))
1206X        {
1207X           push (@leftovers, "-" . join ("", @current_leftovers));
1208X           @current_leftovers = ();
1209X        };
1210X    };
1211X
1212X    # Automatically print Usage if a warning was given
1213X    @ARGV = @leftovers;
1214X    if ($errs != 0)
1215X    {
1216X       warn $Usage;
1217X       return (0);
1218X    }
1219X    else
1220X    {
1221X       return (1);
1222X    }
1223X       
1224}
1225X
12261;
1227SHAR_EOF
1228chmod 0444 libs/newgetopts.pl ||
1229echo 'restore of libs/newgetopts.pl failed'
1230Wc_c="`wc -c < 'libs/newgetopts.pl'`"
1231test 7024 -eq "$Wc_c" ||
1232        echo 'libs/newgetopts.pl: original size 7024, current size' "$Wc_c"
1233fi
1234# ============= libs/strings1.pl ==============
1235if test -f 'libs/strings1.pl' -a X"$1" != X"-c"; then
1236        echo 'x - skipping libs/strings1.pl (File already exists)'
1237else
1238echo 'x - extracting libs/strings1.pl (Text)'
1239sed 's/^X//' << 'SHAR_EOF' > 'libs/strings1.pl' &&
1240;# NAME
1241;#    strings1.pl - FUN with strings #1
1242;#
1243;# NOTES
1244;#    I wrote Format_Text_Block when I just started programming Perl so
1245;#    it is probably not very Perlish code. Center is more like it :-).
1246;#
1247;# AUTHOR
1248;#    Michael S. Muegel (mmuegel@mot.com)
1249;#
1250;# RCS INFORMATION
1251;#    mmuegel
1252;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/strings1.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp
1253X
1254package strings1;
1255X
1256;###############################################################################;# Center
1257;#
1258;# Center $Text assuming the output should be $Columns wide. $Text can span
1259;# multiple lines, of course :-). Lines within $Text that contain only
1260;# whitespace are not centered and are instead collapsed. This may save time
1261;# when printing them later.
1262;#
1263;# Arguments:
1264;#    $Text, $Columns
1265;#
1266;# Returns:
1267;#    $Centered_Text
1268;###############################################################################
1269sub main'Center
1270{
1271X   local ($_, $Columns) = @_;
1272X   local ($*) = 1;
1273X
1274X   s@^(.*)$@" " x (($Columns - length ($1)) / 2) . $1@eg;
1275X   s/^[\t ]*$//g;
1276X   return ($_);
1277};
1278X
1279;###############################################################################
1280;# Format_Text_Block
1281;#
1282;# Formats a text string to be printed to the display or other similar device.
1283;# Text in $String will be fomratted such that the following hold:
1284;#
1285;#    + $String contains the (possibly) multi-line text to print. It is
1286;#      automatically word-wrapped to fit in $Columns.
1287;#
1288;#    + \n'd are maintained and are not folded.
1289;#
1290;#    + $Offset is pre-pended before each separate line of text.
1291;#
1292;#    + If $Offset_Once is $TRUE $Offset will only appear on the first line.
1293;#      All other lines will be indented to match the amount of whitespace of
1294;#      $Offset.
1295;#
1296;#    + If $Bullet_Indent is $TRUE $Offset will only be applied to the begining
1297;#      of lines as they occured in the original $String. Lines that are created
1298;#      by this routine will always be indented by blank spaces.
1299;#
1300;#    + If $Columns is 0 no word-wrap is done. This might be useful to still
1301;#      to offset each line in a buffer.
1302;#
1303;#    + If $Split_Expr is supplied the string is split on it. If not supplied
1304;#      the string is split on " \t\/\-\,\." by default.
1305;#
1306;#    + If $Offset_Blank is $TRUE then empty lines will have $Offset pre-pended
1307;#      to them. Otherwise, they will still empty.
1308;#
1309;# This is a realy workhorse routine that I use in many places because of its
1310;# veratility.
1311;#
1312;# Arguments:
1313;#    $String, $Offset, $Offset_Once, $Bullet_Indent, $Columns, $Split_Expr,
1314;#    $Offset_Blank
1315;#
1316;# Returns:
1317;#    $Buffer
1318;###############################################################################
1319sub main'Format_Text_Block
1320{
1321X   local ($String, $Real_Offset, $Offset_Once, $Bullet_Indent, $Columns,
1322X      $Split_Expr, $Offset_Blank) = @_;
1323X
1324X   local ($New_Line, $Line, $Chars_Per_Line, $Space_Offset, $Buffer,
1325X      $Next_New_Line, $Num_Lines, $Num_Offsets, $Offset);
1326X   local ($*) = 0;
1327X   local ($BLANK_TAG) = "__FORMAT_BLANK__";
1328X   local ($Blank_Offset) = $Real_Offset if ($Offset_Blank);
1329X
1330X   # What should we split on?
1331X   $Split_Expr = " \\t\\/\\-\\,\\." if (! $Split_Expr);
1332X
1333X   # Pre-process the string - convert blank lines to __FORMAT_BLANK__ sequence
1334X   $String =~ s/\n\n/\n$BLANK_TAG\n/g;
1335X   $String =~ s/^\n/$BLANK_TAG\n/g;
1336X   $String =~ s/\n$/\n$BLANK_TAG/g;
1337X
1338X   # If bad $Columns/$Offset combo or no $Columns make a VERRRYYY wide $Column
1339X   $Offset = $Real_Offset;
1340X   $Chars_Per_Line = 16000 if (($Chars_Per_Line = $Columns - length ($Offset)) <= 0);
1341X   $Space_Offset = " " x length ($Offset);
1342X
1343X   # Get a buffer
1344X   foreach $Line (split ("\n", $String))
1345X   {
1346X      $Offset = $Real_Offset if ($Bullet_Indent);
1347X
1348X      # Find where to split the line
1349X      if ($Line ne $BLANK_TAG)
1350X      {
1351X         $New_Line = "";
1352X         while ($Line =~ /^([$Split_Expr]*)([^$Split_Expr]+)/)
1353X         {
1354X            if (length ("$New_Line$&") >= $Chars_Per_Line)
1355X            {
1356X               $Next_New_Line = $+;
1357X               $New_Line = "$Offset$New_Line$1";
1358X               $Buffer .= "\n" if ($Num_Lines++);
1359X               $Buffer .= $New_Line;
1360X               $Offset = $Space_Offset if (($Offset) && ($Offset_Once));
1361X               $New_Line = $Next_New_Line;
1362X               ++$Num_Lines;
1363X            }
1364X            else
1365X            {
1366X               $New_Line .= $&;
1367X            };
1368X            $Line = $';
1369X         };
1370X
1371X         $Buffer .= "\n" if ($Num_Lines++);
1372X         $Buffer .= "$Offset$New_Line$Line";
1373X         $Offset = $Space_Offset if (($Offset) && ($Offset_Once));
1374X      }
1375X
1376X      else
1377X      {
1378X         $Buffer .= "\n$Blank_Offset";
1379X      };
1380X   };
1381X
1382X   return ($Buffer);
1383X
1384};
1385X
13861;
1387SHAR_EOF
1388chmod 0444 libs/strings1.pl ||
1389echo 'restore of libs/strings1.pl failed'
1390Wc_c="`wc -c < 'libs/strings1.pl'`"
1391test 4687 -eq "$Wc_c" ||
1392        echo 'libs/strings1.pl: original size 4687, current size' "$Wc_c"
1393fi
1394# ============= libs/timespec.pl ==============
1395if test -f 'libs/timespec.pl' -a X"$1" != X"-c"; then
1396        echo 'x - skipping libs/timespec.pl (File already exists)'
1397else
1398echo 'x - extracting libs/timespec.pl (Text)'
1399sed 's/^X//' << 'SHAR_EOF' > 'libs/timespec.pl' &&
1400;# NAME
1401;#    timespec.pl - convert a pre-defined time specifyer to seconds
1402;#
1403;# AUTHOR
1404;#    Michael S. Muegel (mmuegel@mot.com)
1405;#
1406;# RCS INFORMATION
1407;#    mmuegel
1408;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/timespec.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp
1409X
1410package timespec;
1411X
1412%TIME_SPEC_TO_SECONDS   = ("s", 1,
1413X                          "m", 60,
1414X                          "h", 60 * 60,
1415X                          "d", 60 * 60 * 24
1416X                          );
1417X
1418$VALID_TIME_SPEC_EXPR   = "[" . join ("", keys (%TIME_SPEC_TO_SECONDS)) . "]";
1419X
1420;###############################################################################
1421;# Time_Spec_To_Seconds
1422;#
1423;# Converts a string of the form:
1424;#
1425;#    (<number>(s|m|h|d))+
1426;#
1427;# to seconds. The second part of the time spec specifies seconds, minutes,
1428;# hours, or days, respectfully. The first part is the number of those untis.
1429;# There can be any number of such specifiers. As an example, 1h30m means 1
1430;# hour and 30 minutes.
1431;#
1432;# If the parsing went OK then $Status is 1, $Msg is undefined, and $Seconds
1433;# is $Time_Spec converted to seconds. If something went wrong then $Status
1434;# is 0 and $Msg explains what went wrong.
1435;#
1436;# Arguments:
1437;#    $Time_Spec
1438;#
1439;# Returns:
1440;#    $Status, $Msg, $Seconds
1441;###############################################################################
1442sub main'Time_Spec_To_Seconds
1443{
1444X   $Time_Spec = $_[0];
1445X
1446X   $Seconds = 0;
1447X   while ($Time_Spec =~ /^(\d+)($VALID_TIME_SPEC_EXPR)/)
1448X   {
1449X      $Seconds += $1 * $TIME_SPEC_TO_SECONDS {$2};
1450X      $Time_Spec = $';
1451X   };
1452X
1453X   return (0, "error parsing time spec: $Time_Spec") if ($Time_Spec ne "");
1454X   return (1, "", $Seconds);
1455X
1456};
1457X
1458X
14591;
1460SHAR_EOF
1461chmod 0444 libs/timespec.pl ||
1462echo 'restore of libs/timespec.pl failed'
1463Wc_c="`wc -c < 'libs/timespec.pl'`"
1464test 1609 -eq "$Wc_c" ||
1465        echo 'libs/timespec.pl: original size 1609, current size' "$Wc_c"
1466fi
1467# ============= man/cqueue.1 ==============
1468if test ! -d 'man'; then
1469    echo 'x - creating directory man'
1470    mkdir 'man'
1471fi
1472if test -f 'man/cqueue.1' -a X"$1" != X"-c"; then
1473        echo 'x - skipping man/cqueue.1 (File already exists)'
1474else
1475echo 'x - extracting man/cqueue.1 (Text)'
1476sed 's/^X//' << 'SHAR_EOF' > 'man/cqueue.1' &&
1477.TH CQUEUE 1L
1478\"
1479\" mmuegel
1480\" /usr/local/ustart/src/mail-tools/dist/foo/man/cqueue.1,v 1.1 1993/07/28 08:08:25 mmuegel Exp
1481\"
1482.ds mp \fBcqueue\fR
1483.de IB
1484.IP \(bu 2
1485..
1486.SH NAME
1487\*(mp - check sendmail queue for problems
1488.SH SYNOPSIS
1489.IP \*(mp 7
1490[ \fB-abdms\fR ] [ \fB-q\fR \fIqueue-dir\fI ] [ \fB-t\fR \fItime\fR ]
1491[ \fB-u\fR \fIusers\fR ] [ \fB-w\fR \fIwidth\fR ]
1492.SH DESCRIPTION
1493Reports on problems in the sendmail queue. With no options this simply
1494means listing messages that have been in the queue longer than a default
1495period along with a summary of queue mail by host and status message.
1496.SH OPTIONS
1497.IP \fB-a\fR 14
1498Report on all messages in the queue. This is equivalent to saying \fB-t\fR 0s.
1499You may like this command so much that you use it as a replacement for
1500\fBmqueue\fR. For example:
1501.sp 1
1502.RS
1503.RS
1504\fBalias mqueue cqueue -a\fR
1505.RE
1506.RE
1507.IP \fB-b\fR 14
1508Also report on bogus queue files. Those are files that
1509have data files and no control files or vice versa.
1510.IP \fB-d\fR
1511Print a detailed report of mail messages that have been queued longer than
1512the specified or default time. Information that is presented includes:
1513.RS
1514.RS
1515.IB
1516Sendmail queue identifier.
1517.IB
1518Date the message was first queued.
1519.IB
1520Sender of the message.
1521.IB
1522One or more recipients of the message.
1523.IB
1524An optional status of the message. This usually indicates why the message
1525has not been delivered.
1526.RE
1527.RE
1528.IP \fB-m\fR 14
1529Mail off the results if any problems were found.
1530Normaly results are printed to stdout. If this option
1531is specified they are mailed to one or more users. Results
1532are not printed to stdout in this case. Results are \fBonly\fR
1533mailed if \*(mp found something wrong.
1534.IP "\fB-q\fR \fIqueue-dir\fI"
1535The sendmail mail queue directory. Default is \fB/usr/spool/mqueue\fR or
1536some other site configured value.
1537.IP "\fB-t\fR \fItime\fR"
1538List messages that have been in the queue longer than
1539\fItime\fR. Time should of the form:
1540.sp 1
1541.RS
1542.RS
1543(<number>(s|m|h|d))+
1544.sp 1
1545.RE
1546.RE
1547.RS 14
1548The second portion of the above definition
1549specifies seconds, minutes, hours, or
1550days, respectfully. The first portion is the number of
1551those units. There can be any number of such specifiers.
1552As an example, 1h30m means 1 hour and 30 minutes.
1553.sp 1
1554The default is 2 hours.
1555.RE
1556.IP \fB-s\fR 14
1557Print a summary of messages that have been queued longer than
1558the specified or default time. Two separate types of summaries are printed.
1559The first summarizes the queue messages by destination host. The host name
1560is gleaned from the recipient addresses for each message.
1561Thus the actual host names for this summary should be taken with a grain
1562of salt since ruleset 0 has not been applied to the address the host was
1563taken from nor were MX records consulted. It would be possible to add
1564this; however, the execution time of the script would increase
1565dramatically. The second summary is by status message.
1566.IP "\fB-u\fR \fIusers\fR"
1567Specify list of users to send a mail report to other than
1568the invoker. This option is only valid when \fB-m\fR has been
1569specified. Multiple recipients may be separated by spaces.
1570.IP "\fB-w\fR \fIwidth\fR"
1571Specify the page width to which the output should tailored. \fIwidth\fR
1572should be an integer representing some character position. The default is
157380 or some other site configured value. Output is folded neatly to match
1574\fIwidth\fR.
1575.SH EXAMPLES
1576.nf
1577% \fBdate\fR
1578Tue Jan 19 12:07:20 CST 1993
1579X
1580% \fBcqueue -t 21h45m -w 70\fR
1581X
1582Summary of messages in queue longer than 21:45:00 by destination
1583host:
1584X
1585X   Number of
1586X   Messages    Destination Host
1587X   ---------   ----------------
1588X   2           cigseg.rtsg.mot.com
1589X   1           mnesouth.corp.mot.com
1590X   ---------
1591X   3
1592X
1593Summary of messages in queue longer than 21:45:00 by status message:
1594X
1595X   Number of
1596X   Messages    Status Message
1597X   ---------   --------------
1598X   1           Deferred: Connection refused by mnesouth.corp.mot.com
1599X   2           Deferred: Host Name Lookup Failure
1600X   ---------
1601X   3
1602X
1603Detail of messages in queue longer than 21:45:00 sorted by creation
1604date:
1605X
1606X   ID:        AA20573
1607X   Date:      02:09:27 PM 01/18/93
1608X   Sender:    melrose-place-owner@ferkel.ucsb.edu
1609X   Recipient: pbaker@cigseg.rtsg.mot.com
1610X   Status:    Deferred: Host Name Lookup Failure
1611X
1612X   ID:        AA20757
1613X   Date:      02:11:30 PM 01/18/93
1614X   Sender:    90210-owner@ferkel.ucsb.edu
1615X   Recipient: pbaker@cigseg.rtsg.mot.com
1616X   Status:    Deferred: Host Name Lookup Failure
1617X
1618X   ID:        AA21110
1619X   Date:      02:17:01 PM 01/18/93
1620X   Sender:    rd_lap_wg@mdd.comm.mot.com
1621X   Recipient: jim_mathis@mnesouth.corp.mot.com
1622X   Status:    Deferred: Connection refused by mnesouth.corp.mot.com
1623.fi
1624.SH AUTHOR
1625.nf
1626Michael S. Muegel (mmuegel@mot.com)
1627UNIX Applications Startup Group
1628Corporate Information Office, Schaumburg, IL
1629Motorola, Inc.
1630.fi
1631.SH COPYRIGHT NOTICE
1632Copyright 1993, Motorola, Inc.
1633.sp 1
1634Permission to use, copy, modify and distribute without charge this
1635software, documentation, etc. is granted, provided that this
1636comment and the author's name is retained.  The author nor Motorola assume any
1637responsibility for problems resulting from the use of this software.
1638.SH SEE ALSO
1639.nf
1640\fBsendmail(8)\fR
1641\fISendmail Installation and Operation Guide\fR.
1642.fi
1643SHAR_EOF
1644chmod 0444 man/cqueue.1 ||
1645echo 'restore of man/cqueue.1 failed'
1646Wc_c="`wc -c < 'man/cqueue.1'`"
1647test 5212 -eq "$Wc_c" ||
1648        echo 'man/cqueue.1: original size 5212, current size' "$Wc_c"
1649fi
1650# ============= man/postclip.1 ==============
1651if test -f 'man/postclip.1' -a X"$1" != X"-c"; then
1652        echo 'x - skipping man/postclip.1 (File already exists)'
1653else
1654echo 'x - extracting man/postclip.1 (Text)'
1655sed 's/^X//' << 'SHAR_EOF' > 'man/postclip.1' &&
1656.TH POSTCLIP 1L
1657\"
1658\" mmuegel
1659\" /usr/local/ustart/src/mail-tools/dist/foo/man/postclip.1,v 1.1 1993/07/28 08:08:25 mmuegel Exp
1660\"
1661.ds mp \fBpostclip\fR
1662.SH NAME
1663\*(mp - send only the headers to Postmaster
1664.SH SYNOPSIS
1665\*(mp [ \fB-v\fR ] [ \fIto\fR ... ]
1666.SH DESCRIPTION
1667\*(mp  will forward non-delivery reports to a postmaster after deleting the body
1668of the message. This keeps bounced mail private and helps to avoid disk space problems. \*(mp tries its best to keep as much of the header trail as possible.
1669Hopefully only the original body of the message will be filtered. Only messages
1670that have a subject that begins with 'Returned mail:' are filtered. This
1671ensures that other mail is not accidently mucked with. Finally, note that
1672\fBsendmail\fR is used to deliver the message after it has been (possibly)
1673filtered. All of the original headers will remain intact.
1674.sp 1
1675You can use this with any \fBsendmail\fR by modifying the Postmaster alias.
1676If you use IDA \fBsendmail\fR you could add the following to <machine>.m4:
1677.sp 1
1678.RS
1679define(POSTMASTERBOUNCE, mailer-errors)
1680.RE
1681.sp 1
1682In the aliases file, add a line similar to the following:
1683.sp 1
1684.RS
1685mailer-errors: "|/usr/local/bin/postclip postmaster"
1686.RE
1687.SH OPTIONS
1688.IP \fB-v\fR
1689Be verbose about delivery. Probably only useful when debugging \*(mp.
1690.IP \fIto\fR
1691A list of one or more e-mail ids to send the modified
1692Postmaster messages to. If none are specified postmaster
1693is used.
1694.SH AUTHOR
1695.nf
1696Michael S. Muegel (mmuegel@mot.com)
1697UNIX Applications Startup Group
1698Corporate Information Office, Schaumburg, IL
1699Motorola, Inc.
1700.fi
1701.SH CREDITS
1702The original idea to filter Postmaster mail was taken from a script by
1703Christopher Davis <ckd@eff.org>.
1704.SH COPYRIGHT NOTICE
1705Copyright 1992, Motorola, Inc.
1706.sp 1
1707Permission to use, copy, modify and distribute without charge this
1708software, documentation, etc. is granted, provided that this
1709comment and the author's name is retained.  The author nor Motorola assume any
1710responsibility for problems resulting from the use of this software.
1711.SH SEE ALSO
1712.nf
1713\fBsendmail(8)\fR
1714.fi
1715SHAR_EOF
1716chmod 0444 man/postclip.1 ||
1717echo 'restore of man/postclip.1 failed'
1718Wc_c="`wc -c < 'man/postclip.1'`"
1719test 2078 -eq "$Wc_c" ||
1720        echo 'man/postclip.1: original size 2078, current size' "$Wc_c"
1721fi
1722# ============= src/cqueue ==============
1723if test ! -d 'src'; then
1724    echo 'x - creating directory src'
1725    mkdir 'src'
1726fi
1727if test -f 'src/cqueue' -a X"$1" != X"-c"; then
1728        echo 'x - skipping src/cqueue (File already exists)'
1729else
1730echo 'x - extracting src/cqueue (Text)'
1731sed 's/^X//' << 'SHAR_EOF' > 'src/cqueue' &&
1732#!/usr/local/ustart/bin/suidperl
1733X
1734# NAME
1735#    cqueue - check sendmail queue for problems
1736#
1737# SYNOPSIS
1738#    Type cqueue -usage
1739#
1740# AUTHOR
1741#    Michael S. Muegel <mmuegel@mot.com>
1742#
1743# RCS INFORMATION
1744#    mmuegel
1745#    /usr/local/ustart/src/mail-tools/dist/foo/src/cqueue,v 1.1 1993/07/28 08:09:02 mmuegel Exp
1746X
1747# So that date.pl does not yell (Domain/OS version does a ``)
1748$ENV{'PATH'}    = "";
1749X
1750# A better getopts routine
1751require "newgetopts.pl";
1752require "timespec.pl";
1753require "mail.pl";
1754require "date.pl";
1755require "mqueue.pl";
1756require "strings1.pl";
1757require "elapsed.pl";
1758X
1759($Script_Name = $0) =~ s/.*\///;
1760X         
1761# Some defaults you may want to change
1762$DEF_TIME       = "2h";
1763$DEF_QUEUE      = "/usr/spool/mqueue";
1764$DEF_COLUMNS    = 80;
1765$DATE_FORMAT    = "%r %D";
1766X
1767# Constants that probably should not be changed
1768$USAGE          = "Usage: $Script_Name [ -abdms ] [ -q queue-dir ] [ -t time ] [ -u user ] [ -w width ]\n";
1769$VERSION        = "${Script_Name} by mmuegel; 1.1 of 1993/07/28 08:09:02";
1770$SWITCHES       = "abdmst:u:q:w:";
1771$SPLIT_EXPR     = '\s,\.@!%:';
1772$ADDR_PART_EXPR = '[^!@%]+';
1773X
1774# Let getopts parse for switches
1775$Status = &New_Getopts ($SWITCHES, $USAGE);
1776exit (0) if ($Status == -1);
1777exit (1) if (! $Status);
1778X
1779# Check args
1780die "${Script_Name}: -u only valid with -m\n" if (($opt_u) && (! $opt_m));
1781die "${Script_Name}: -a not valid with -t option\n" if ($opt_a && $opt_t);
1782$opt_u = getlogin || (getpwuid ($<))[0] || $ENV{"USER"} || die "${Script_Name}: can not determine who you are!\n" if (! $opt_u);
1783X
1784# Set defaults
1785$opt_t = "0s" if ($opt_a);
1786$opt_t = $DEF_TIME if ($opt_t eq "");
1787$opt_w = $DEF_COLUMNS if ($opt_w eq "");
1788$opt_q = $DEF_QUEUE if ($opt_q eq "");
1789$opt_s = $opt_d = 1 if (! ($opt_s || $opt_d));
1790X
1791# Untaint the users to mail to
1792$opt_u =~ /^(.*)$/;
1793$Users = $1;
1794X
1795# Convert time option to seconds and seconds to elapsed form
1796die "${Script_Name}: $Msg\n" if (! (($Status, $Msg, $Seconds) = &Time_Spec_To_Seconds ($opt_t))[0]);
1797$Elapsed = &Seconds_To_Elapsed ($Seconds, 1);
1798$Time_Info = " longer than $Elapsed" if ($Seconds);
1799X
1800# Get the current time
1801$Current_Time = time;
1802$Current_Date = &date ($Current_Time, $DATE_FORMAT);
1803X
1804($Status, $Msg, @Queue_IDs) = &Get_Queue_IDs ($opt_q, 1, @Missing_Control_IDs,
1805X   @Missing_Data_IDs);
1806die "$Script_Name: $Msg\n" if (! $Status);
1807X
1808# Yell about missing data/control files?
1809if ($opt_b)
1810{
1811X
1812X   $Report = "\nMessages missing control files:\n\n   " .
1813X             join ("\n   ", @Missing_Control_IDs) .
1814X             "\n"
1815X      if (@Missing_Control_IDs);
1816X
1817X   $Report .= "\nMessages missing data files:\n\n   " .
1818X              join ("\n   ", @Missing_Data_IDs) .
1819X              "\n"
1820X      if (@Missing_Data_IDs);
1821};
1822X
1823# See if any mail messages are older than $Seconds
1824foreach $Queue_ID (@Queue_IDs)
1825{
1826X   # Get lots of info about this sendmail message via the control file
1827X   ($Status, $Msg) = &Parse_Control_File ($opt_q, $Queue_ID, *Sender,
1828X      *Recipients, *Errors_To, *Creation_Time, *Priority, *Status_Message,
1829X      *Headers);
1830X   next if ($Status == -1);
1831X   if (! $Status)
1832X   {
1833X      warn "$Script_Name: $Queue_ID: $Msg\n";
1834X      next;
1835X   };
1836X
1837X   # Report on message if it is older than $Seconds
1838X   if ($Current_Time - $Creation_Time >= $Seconds)
1839X   {
1840X      # Build summary by host information. Keep track of each host destination
1841X      # encountered.
1842X      if ($opt_s)
1843X      {
1844X         %Host_Map = ();
1845X         foreach (@Recipients)
1846X         {
1847X           if ((/@($ADDR_PART_EXPR)$/) || (/($ADDR_PART_EXPR)!$ADDR_PART_EXPR$/))
1848X            {
1849X              ($Host = $1) =~ tr/A-Z/a-z/;
1850X               $Host_Map {$Host} = 1;
1851X           }
1852X           else
1853X           {
1854X              warn "$Script_Name: could not find host part from $_; contact author\n";
1855X           };
1856X         };
1857X
1858X         # For each unique target host add to its stats
1859X         grep ($Host_Queued {$_}++, keys (%Host_Map));
1860X
1861X         # Build summary by message information.
1862X         $Message_Queued {$Status_Message}++ if ($Status_Message);
1863X      };
1864X
1865X      # Build long report information for this creation time (there may be
1866X      # more than one message created at the same time)
1867X      if ($opt_d)
1868X      {
1869X         $Creation_Date = &date ($Creation_Time, $DATE_FORMAT);
1870X         $Recipient_Info = &Format_Text_Block (join (", ", @Recipients),
1871X           "   Recipient: ", 1, 0, $opt_w, $SPLIT_EXPR);
1872X         $Time_To_Report {$Creation_Time} .= <<"EOS";
1873X
1874X   ID:        $Queue_ID
1875X   Date:      $Creation_Date
1876X   Sender:    $Sender
1877$Recipient_Info
1878EOS
1879X
1880X         # Add the status message if available to long report
1881X         if ($Status_Message)
1882X         {
1883X           $Time_To_Report {$Creation_Time} .= &Format_Text_Block ($Status_Message,
1884X              "   Status:    ", 1, 0, $opt_w, $SPLIT_EXPR) . "\n";
1885X         };
1886X      };
1887X   };
1888X
1889};
1890X
1891# Add the summary report by target host?
1892if ($opt_s)
1893{
1894X   foreach $Host (sort (keys (%Host_Queued)))
1895X   {
1896X      $Host_Report .= &Format_Text_Block ($Host,
1897X         sprintf ("   %-9d   ", $Host_Queued{$Host}), 1, 0, $opt_w,
1898X         $SPLIT_EXPR) . "\n";
1899X      $Num_Hosts += $Host_Queued{$Host};
1900X   };
1901X   if ($Host_Report)
1902X   {
1903X      chop ($Host_Report);
1904X      $Report .= &Format_Text_Block("\nSummary of messages in queue$Time_Info by destination host:\n", "", 0, 0, $opt_w);
1905X
1906X      $Report .= <<"EOS";
1907X
1908X   Number of
1909X   Messages    Destination Host
1910X   ---------   ----------------
1911$Host_Report
1912X   ---------
1913X   $Num_Hosts
1914EOS
1915X   };
1916};
1917X
1918# Add the summary by message report?
1919if ($opt_s)
1920{
1921X   foreach $Message (sort (keys (%Message_Queued)))
1922X   {
1923X      $Message_Report .= &Format_Text_Block ($Message,
1924X         sprintf ("   %-9d   ", $Message_Queued{$Message}), 1, 0, $opt_w,
1925X         $SPLIT_EXPR) . "\n";
1926X      $Num_Messages += $Message_Queued{$Message};
1927X   };
1928X   if ($Message_Report)
1929X   {
1930X      chop ($Message_Report);
1931X      $Report .= &Format_Text_Block ("\nSummary of messages in queue$Time_Info by status message:\n", "", 0, 0, $opt_w);
1932X
1933X      $Report .= <<"EOS";
1934X
1935X   Number of
1936X   Messages    Status Message
1937X   ---------   --------------
1938$Message_Report
1939X   ---------
1940X   $Num_Messages
1941EOS
1942X   };
1943};
1944X
1945# Add the detailed message reports?
1946if ($opt_d)
1947{
1948X   foreach $Time (sort { $a <=> $b} (keys (%Time_To_Report)))
1949X   {
1950X      $Report .= &Format_Text_Block ("\nDetail of messages in queue$Time_Info sorted by creation date:\n","", 0, 0, $opt_w) if (! $Detailed_Header++);
1951X      $Report .= $Time_To_Report {$Time};
1952X   };
1953};
1954X
1955# Now mail or print the report
1956if ($Report)
1957{
1958X   $Report .= "\n";
1959X   if ($opt_m)
1960X   {
1961X      ($Status, $Msg) = &Send_Mail ($Users, "sendmail queue report for $Current_Date", $Report, 0);
1962X      die "${Script_Name}: $Msg" if (! $Status);
1963X   }
1964X
1965X   else
1966X   {
1967X      print $Report;
1968X   };
1969X
1970};
1971X
1972# I am outta here...
1973exit (0);
1974SHAR_EOF
1975chmod 0555 src/cqueue ||
1976echo 'restore of src/cqueue failed'
1977Wc_c="`wc -c < 'src/cqueue'`"
1978test 6647 -eq "$Wc_c" ||
1979        echo 'src/cqueue: original size 6647, current size' "$Wc_c"
1980fi
1981# ============= src/postclip ==============
1982if test -f 'src/postclip' -a X"$1" != X"-c"; then
1983        echo 'x - skipping src/postclip (File already exists)'
1984else
1985echo 'x - extracting src/postclip (Text)'
1986sed 's/^X//' << 'SHAR_EOF' > 'src/postclip' &&
1987#!/usr/local/bin/perl
1988X
1989# NAME
1990#    postclip - send only the headers to Postmaster
1991#
1992# SYNOPSIS
1993#    postclip [ -v ] [ to ... ]
1994#
1995# AUTHOR
1996#    Michael S. Muegel <mmuegel@mot.com>
1997#
1998# RCS INFORMATION
1999#    /usr/local/ustart/src/mail-tools/dist/foo/src/postclip,v
2000#    1.1 of 1993/07/28 08:09:02
2001X
2002# We use this to send off the mail
2003require "newgetopts.pl";
2004require "mail.pl";
2005X
2006# Get the basename of the script
2007($Script_Name = $0) =~ s/.*\///;
2008X
2009# Some famous constants
2010$USAGE          = "Usage: $Script_Name [ -v ] [ to ... ]\n";
2011$VERSION        = "${Script_Name} by mmuegel; 1.1 of 1993/07/28 08:09:02";
2012$SWITCHES       = "v";
2013X
2014# Let getopts parse for switches
2015$Status = &New_Getopts ($SWITCHES, $USAGE);
2016exit (0) if ($Status == -1);
2017exit (1) if (! $Status);
2018X
2019# Who should we send the modified mail to?
2020@ARGV = ("postmaster") if (! @ARGV);
2021$Users = join (" ", @ARGV);
2022@ARGV = ();
2023X
2024# Suck in the original header and save a few interesting lines
2025while (<>)
2026{
2027X    $Buffer .= $_ if (! /^From /);
2028X    $Subject = $1 if (/^Subject:\s+(.*)$/);
2029X    $From = $1 if (/^From:\s+(.*)$/);
2030X    last if (/^$/);
2031};
2032X
2033# Do not filter the message unless it has a subject and the subject indicates
2034# it is an NDN
2035if ($Subject && ($Subject =~ /^returned mail/i))
2036{
2037X   # Slurp input by paragraph. Keep track of the last time we saw what
2038X   # appeared to be NDN text. We keep this.
2039X   $/ = "\n\n";
2040X   $* = 1;
2041X   while (<>)
2042X   {
2043X      push (@Paragraphs, $_);
2044X      $Last_Error_Para = $#Paragraphs
2045X        if (/unsent message follows/i || /was not delivered because/);
2046X   };
2047X
2048X   # Now save the NDN text into $Buffer
2049X   $Buffer .= join ("", @Paragraphs [0..$Last_Error_Para]);
2050}
2051X
2052else
2053{
2054X   undef $/;
2055X   $Buffer .= <>;
2056};
2057X
2058# Send off the (possibly) modified mail
2059($Status, $Msg) = &Send_Mail ($Users, "", $Buffer, 0, $opt_v, 1);
2060die "$Script_Name: $Msg\n" if (! $Status);
2061SHAR_EOF
2062chmod 0555 src/postclip ||
2063echo 'restore of src/postclip failed'
2064Wc_c="`wc -c < 'src/postclip'`"
2065test 1836 -eq "$Wc_c" ||
2066        echo 'src/postclip: original size 1836, current size' "$Wc_c"
2067fi
2068exit 0
2069
2070--
2071+----------------------------------------------------------------------------+
2072| Michael S. Muegel                    | Internet E-Mail:    mmuegel@mot.com |
2073| UNIX Applications Startup Group      | Moto Dist E-Mail:   X10090          |
2074| Corporate Information Office         | Voice:              (708) 576-0507  |
2075| Motorola                             | Fax:                (708) 576-4153  |
2076+----------------------------------------------------------------------------+
2077
2078      "I'm disturbed, I'm depressed, I'm inadequate -- I've got it all!"
2079          -- George from _Seinfeld_
Note: See TracBrowser for help on using the repository browser.