Merge from vendor branch LIBSTDC++:
[dragonfly.git] / contrib / sendmail / contrib / mmuegel
1 From: "Michael S. Muegel" <mmuegel@cssun6.corp.mot.com>
2 Message-Id: <199307280818.AA08111@cssun6.corp.mot.com>
3 Subject: Re: contributed software
4 To: eric@cs.berkeley.edu (Eric Allman)
5 Date: Wed, 28 Jul 1993 03:18:02 -0500 (CDT)
6 In-Reply-To: <199307221853.LAA04266@mastodon.CS.Berkeley.EDU> from "Eric Allman" at Jul 22, 93 11:53:47 am
7 X-Mailer: ELM [version 2.4 PL22]
8 Mime-Version: 1.0
9 Content-Type: text/plain; charset=US-ASCII
10 Content-Transfer-Encoding: 7bit
11 Content-Length: 69132     
12
13 OK. Here is a new shell archive.
14
15 Cheers,
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 ==============
46 if test -f 'README' -a X"$1" != X"-c"; then
47         echo 'x - skipping README (File already exists)'
48 else
49 echo 'x - extracting README (Text)'
50 sed 's/^X//' << 'SHAR_EOF' > 'README' &&
51 -------------------------------------------------------------------------------
52 Document Revision Control Information:
53 X   mmuegel
54 X   /usr/local/ustart/src/mail-tools/dist/foo/README,v
55 X   1.1 of 1993/07/28 08:12:53
56 -------------------------------------------------------------------------------
57 X
58 1. Introduction
59 ---------------
60 X
61 These tools may be of use to those sites using sendmail. Both are written in
62 Perl. Our site, Mot.COM, receives a ton of mail being a top-level domain
63 gateway. We have over 24 domains under us. Needless to say, we must have
64 a robust mail system or my head, and others, would be on the chopping block.
65 X
66 2. Description
67 --------------
68 X
69 The first tool, cqueue, checks the sendmail queue for problems. We use
70 it to flag problems with subdomain mail servers (and even our own servers
71 once in a while ;-). We run it via a cron job every hour during the day.
72 You may find this too frequent, however. 
73 X
74 The other program, postclip, is used to "filter" non-deliverable NDNs that
75 get sent to our Postmaster account now and then. This ensures privacy of
76 e-mail and helps avoid disk problems from huge NDNs. It is different than
77 a brute force "just keep the header" approach because it tries hard to keep
78 other parts of the message that look like non-delivery information.
79 X
80 Both have been used for some time at our site with no problems. Everything 
81 you need should be in this distribution: source, manual pages, and support 
82 libs. See the manual pages for a complete description of each tool.
83 X
84 3. Installation
85 ---------------
86 X
87 No fancy Makefile simply because these tools are all under a large
88 hierarchy at my site. Installation should be a snap, however. Install
89 the nroff(1) man(5) manual pages from the man subdirectory to the
90 appropriate directory on your system. This might be something like
91 /usr/local/man/man1.
92 X
93 Next, install all of the Perl libraries located in the lib subdirectory
94 to your Perl library area. /usr/local/lib/perl is a good bet. The person
95 who installed Perl at your site will be able to tell you for sure. 
96 X
97 Finally, you need to install the programs. Note that cqueue wants to
98 run setuid root by default. This is because the sendmail queue is normally
99 only readable by root or some special group. In order to let any user
100 run this suidperl is used. suidperl allows a Perl program to run with the
101 privileges of another user. 
102 X
103 You will have to edit both the cqueue and postclip programs to change
104 the #! line at the top of each. Just change the pathname to whatever is
105 appropriate on your system. Note that Larry Wall's fixin program from
106 the Camel book can also be used to do this. It is very handy. It changes
107 #! lines by looking at your PATH.
108 X
109 If you do not have suidperl on your system change the #! line in cqueue
110 to reference perl instead of suidperl.
111 X
112 You may also wish to change some constants in cqueue. $DEF_QUEUE should be
113 changed to your queue directory if it is not /usr/spool/mqueue. $DEF_TIME
114 could be changed easy enough also. It is the time spec for the time duration
115 after which a mail message will be reported on if the -a option has not been
116 specified. See the manual page for more information and the format of this
117 constant (same as the -t argument). Then again, neither of these has to
118 be changed. Command line options are there to override their default
119 values.
120 X
121 After you have edited the programs as necessary, all that remains is to
122 install them to some executable directory. Install postclip mode 555
123 and cqueue mode 4555 with owner root (if using suidperl) or mode 555
124 (if not using suidperl).
125 X
126 4. Gripes, Comments, Etc
127 ------------------------
128 X
129 If you start using either of these let me know. I have other mail tools I
130 will likely post in the future if these prove useful. Also, if you think
131 something is just plain dumb/wrong/stupid let me know!
132 X
133 Cheers,
134 -Mike
135 X
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 +----------------------------------------------------------------------------+
143 SHAR_EOF
144 chmod 0444 README ||
145 echo 'restore of README failed'
146 Wc_c="`wc -c < 'README'`"
147 test 4308 -eq "$Wc_c" ||
148         echo 'README: original size 4308, current size' "$Wc_c"
149 fi
150 # ============= libs/date.pl ==============
151 if test ! -d 'libs'; then
152     echo 'x - creating directory libs'
153     mkdir 'libs'
154 fi
155 if test -f 'libs/date.pl' -a X"$1" != X"-c"; then
156         echo 'x - skipping libs/date.pl (File already exists)'
157 else
158 echo 'x - extracting libs/date.pl (Text)'
159 sed '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 ;#
303 require 'timelocal.pl';
304 package date;
305 X
306 # Months of the year
307 @MoY = ('January',      'February',     'March',        'April',        'May',          'June',
308 X               'July',         'August',       'September','October',  'November', 'December');
309 X
310 # days of the week
311 @DoW = ('Sunday',       'Monday',       'Tuesday',      'Wednesday',
312 X               'Thursday',     'Friday',       'Saturday');
313 X
314 # CUSTOMIZE - defaults
315 $defaultTZ = 'CST';                                             # time zone (hack!)
316 $defaultFMT = '%a %h %e %T %z%Y';               # format (ala date(1))
317 X
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)
323 X
324 # Time zone info
325 $TZ;                                                                    # wkno needs this info too
326 X
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
333 X                 '%A', q|$rep = $DoW[$wday]|,                                          # full weekday name - Sunday to Saturday
334 X                 '%b', q|($rep = $MoY[$mon]) =~ s/^(...).*/\1/|,       # abbr. month name - Jan to Dec
335 X                 '%B', q|$rep = $MoY[$mon]|,                                           # full month name - January to December
336 X                 '%c', q|$rep = $locDTF; 1|,                                           # date/time in local format
337 X                 '%C', q|$rep = $locLDTF; 1|,                                          # date/time in local long format
338 X                 '%d', q|$rep = &date'pad($mday, 2, "0")|,                     # day of month - 01 to 31
339 X                 '%D', q|$rep = '%m/%d/%y'|,                                           # date as mm/dd/yy
340 X                 '%e', q|$rep = &date'pad($mday, 2, " ")|,                     # day of month (space padded) ` 1' to `31'
341 X                 '%E', q|$rep = &date'dsuf($mday)|,                            # day of month (w/suffix) `1st' to `31st'
342 X                 '%f', q|$rep = &date'pad($mon+1, 2, " ")|,            # month of year (space padded) ` 1' to `12'
343 X                 '%h', q|$rep = '%b'|,                                                         # abbr. month name (same as %b)
344 X                 '%H', q|$rep = &date'pad($hour, 2, "0")|,                     # hour - 00 to 23
345 X                 '%i', q|$rep = &date'ampmH($hour, " ")|,                      # hour (space padded ` 1' to `12'
346 X                 '%I', q|$rep = &date'ampmH($hour, "0")|,                      # hour - 01 to 12
347 X                 '%j', q|$rep = &date'pad($yday+1, 3, "0")|,           # Julian date 001 - 366
348 X                 '%k', q|$rep = &date'pad($hour, 2, " ")|,                     # hour (space padded) ` 0' to `23'
349 X                 '%l', q|$rep = '%b %d ' . &date'ls($year)|,           # ls(1) style date
350 X                 '%m', q|$rep = &date'pad($mon+1, 2, "0")|,            # month of year - 01 to 12
351 X                 '%M', q|$rep = &date'pad($min, 2, "0")|,                      # minute - 00 to 59
352 X                 '%n', q|$rep = "\n"|,                                                         # insert a newline
353 X                 '%p', q|$rep = &date'ampmD($hour)|,                           # insert `AM' or `PM'
354 X                 '%r', q|$rep = '%I:%M:%S %p'|,                                        # time in AM/PM notation
355 X                 '%R', q|$rep = '%H:%M'|,                                                      # time as HH:MM
356 X                 '%S', q|$rep = &date'pad($sec, 2, "0")|,                      # second - 00 to 59
357 X                 '%t', q|$rep = "\t"|,                                                         # insert a tab
358 X                 '%T', q|$rep = '%H:%M:%S'|,                                           # time as HH:MM:SS
359 X                 '%u', q|$rep = '%y%m%d%H%M.%S'|,                                      # daaate/time in date(1) required format
360 X                 '%U', q|$rep = &date'wkno($year, $yday, 0)|,          # week number (weeks start on Sun) - 00 to 53
361 X                 '%V', q|$rep = '%m%d%H%M%y'|,                                         # SysV touch(1) date-time format (mmddHHMMyy)
362 X                 '%w', q|$rep = $wday; 1|,                                                     # day of week - Sunday = 0
363 X                 '%W', q|$rep = &date'wkno($year, $yday, 1)|,          # week number (weeks start on Mon) - 00 to 53
364 X                 '%x', q|$rep = $locDF; 1|,                                            # date in local format
365 X                 '%X', q|$rep = $locTF; 1|,                                            # time in local format
366 X                 '%y', q|($rep = $year) =~ s/..(..)/\1/|,                      # last 2 digits of year - 00 to 99
367 X                 '%Y', q|$rep = "$year"; 1|,                                           # full year ~ 1700 to 2000 odd
368 X                 '%z', q|$rep = $TZ eq "" ? "" : "$TZ "|,                      # time zone from TZ env var (w/trail. space)
369 X                 '%Z', q|$rep = $TZ; 1|,                                                       # time zone from TZ env. var.
370 X                 '%%', q|$rep = '%'; $adv=1|,                                          # insert a `%'
371 X                 '%+', q|$rep = '+'|                                                           # insert a `+'
372 );
373 X       
374 sub main'date {
375 X       local($time, $format) = @_;
376 X       local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
377 X       local($pos, $tag, $rep, $adv) = (0, "", "", 0);
378 X
379 X       # default to date/ctime format or strip leading `+'...
380 X       if ($format eq "") {
381 X               $format = $defaultFMT;
382 X       } elsif ($format =~ /^\+/) {
383 X               $format = $';
384 X       }
385 X
386 X       # Use local time if can't find a TZ in the environment
387 X       $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ;
388 X       ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
389 X               &gettime ($TZ, $time);
390 X
391 X       # Hack to deal with 'PST8PDT' format of TZ
392 X       # Note that this can't deal with all the esoteric forms, but it
393 X       # does recognize the most common: [:]STDoff[DST[off][,rule]]
394 X       if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
395 X               $TZ = $isdst ? $4 : $1;
396 X       }
397 X
398 X       # watch out in 2070...
399 X       $year += ($year < 70) ? 2000 : 1900;
400 X
401 X       # now loop throught the supplied format looking for tags...
402 X       while (($pos = index ($format, '%')) != -1) {
403 X
404 X               # grab the format tag
405 X               $tag = substr($format, $pos, 2);
406 X               $adv = 0;                                                       # for `%%' processing
407 X
408 X               # do we have a replacement string?
409 X               if (defined $Tags{$tag}) {
410 X
411 X                       # trap dead evals...
412 X                       if (! eval $Tags{$tag}) {
413 X                               print STDERR "date.pl: internal error: eval for $tag failed: $@\n";
414 X                               return "";
415 X                       }
416 X               } else {
417 X                       $rep = "";
418 X               }
419 X                       
420 X               # do the substitution
421 X               substr ($format, $pos, 2) =~ s/$tag/$rep/;
422 X               $pos++ if ($adv);
423 X       }
424 X
425 X       $format;
426 }
427 X
428 # dsuf - add `st', `nd', `rd', `th' to a date (ie 1st, 22nd, 29th)
429 sub dsuf {
430 X       local ($mday) = @_;
431 X
432 X       return $mday . 'st' if ($mday =~ m/.*1$/);
433 X       return $mday . 'nd' if ($mday =~ m/.*2$/);
434 X       return $mday . 'rd' if ($mday =~ m/.*3$/);
435 X       return $mday . 'th';
436 }
437 X       
438 # weekno - figure out week number
439 sub wkno {
440 X       local ($year, $yday, $firstweekday) = @_;   
441 X       local ($jan1, @jan1, $wks);
442 X
443 X       # figure out the `time' value for January 1 of the given year
444 X       $jan1 = &maketime ($TZ, 0, 0, 0, 1, 0, $year-1900);
445 X
446 X       # figure out what day of the week January 1 was
447 X       @jan1= &gettime ($TZ, $jan1);
448 X       
449 X       # and calculate the week number
450 X       $wks = (($yday + ($jan1[6] - $firstweekday)) + 1)/ 7;
451 X       $wks += (($wks - int($wks) > 0.0) ? 1 : 0);
452 X
453 X       # supply zero padding
454 X       &pad (int($wks), 2, "0");
455 }
456 X
457 # ampmH - figure out am/pm (1 - 12) mode hour value, padded with $p (0 or ' ')
458 sub ampmH { local ($h, $p) = @_;  &pad($h>12 ? $h-12 : ($h ? $h : 12), 2, $p); }
459 X
460 # ampmD - figure out am/pm designator
461 sub ampmD { shift @_ >= 12 ? "PM" : "AM"; }
462 X
463 # gettime - get the time via {local,gmt}time
464 sub gettime { ((shift @_) eq 'GMT') ? gmtime(shift @_) : localtime(shift @_); }
465 X
466 # maketime - make a time via time{local,gmt}
467 sub maketime { ((shift @_) eq 'GMT') ? &main'timegm(@_) : &main'timelocal(@_); }
468 X
469 # ls - generate the time/year portion of an ls(1) style date
470 sub ls {
471 X       return ((&gettime ($TZ, time))[5] == @_[0]) ? "%R" : " %Y";
472 }
473 X
474 # pad - pad $in with leading $pad until lenght $len
475 sub pad {
476 X       local ($in, $len, $pad) = @_;
477 X       local ($out) = "$in";
478 X
479 X       $out = $pad . $out until (length ($out) == $len);
480 X       return $out;
481 }
482 X
483 1;
484 SHAR_EOF
485 chmod 0444 libs/date.pl ||
486 echo 'restore of libs/date.pl failed'
487 Wc_c="`wc -c < 'libs/date.pl'`"
488 test 12339 -eq "$Wc_c" ||
489         echo 'libs/date.pl: original size 12339, current size' "$Wc_c"
490 fi
491 # ============= libs/elapsed.pl ==============
492 if test -f 'libs/elapsed.pl' -a X"$1" != X"-c"; then
493         echo 'x - skipping libs/elapsed.pl (File already exists)'
494 else
495 echo 'x - extracting libs/elapsed.pl (Text)'
496 sed '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
507 X
508 package elapsed;
509 X
510 # Time field types
511 $DAYS           = 1;
512 $HOURS          = 2;
513 $MINUTES        = 3;
514 $SECONDS        = 4;
515 X
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",
533 X                  $HOURS, 60 * 60, ":", "%d",
534 X                  $MINUTES, 60, ":", "%02d",
535 X                  $SECONDS, 1, "", "%02d"
536 X                 );
537 X
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 ;###############################################################################
564 sub main'Seconds_To_Elapsed
565 {
566 X   local ($Seconds, $Collapse) = @_;
567 X   local ($Type, $Multiplier, @Multipliers, $Separator, $DHMS_Used, 
568 X          $Elapsed, @Mult_And_Seps, $Print_Field);
569 X
570 X   $Multiplier = 1;
571 X   @Mult_And_Seps = @MULT_AND_SEPS;
572 X
573 X   # Keep subtracting the number of seconds corresponding to a time field
574 X   # from the number of seconds passed to the function.
575 X   while (1)
576 X   {
577 X      ($Type, $Multiplier, $Separator, $Format) = splice (@Mult_And_Seps, 0, 4);
578 X      last if (! $Multiplier);
579 X      $Seconds -= $DHMS_Used * $Multiplier 
580 X         if ($DHMS_Used = int ($Seconds / $Multiplier));
581 X
582 X      # Figure out if we should print this field
583 X      if ($Type == $DAYS)
584 X      {
585 X        $Print_Field = $DHMS_Used;
586 X      }
587 X
588 X      elsif ($Collapse)
589 X      {
590 X        if ($Type == $HOURS)
591 X        {
592 X           $Print_Field = $DHMS_Used;
593 X        }
594 X        elsif ($Type == $MINUTES)
595 X        {
596 X           $Print_Field = $DHMS_Used || $Printed_Field {$HOURS};
597 X        }
598 X        else
599 X        {
600 X           $Format = ":%02d" 
601 X              if (! $Printed_Field {$MINUTES});
602 X           $Print_Field = 1;
603 X        };
604 X      }
605 X
606 X      else
607 X      {
608 X        $Print_Field = 1;
609 X      };
610 X
611 X      $Printed_Field {$Type} = $Print_Field;
612 X      $Elapsed .= sprintf ("$Format%s", $DHMS_Used, $Separator) 
613 X        if ($Print_Field);
614 X   };
615 X
616 X   return ($Elapsed);
617 };
618 X
619 1;
620 SHAR_EOF
621 chmod 0444 libs/elapsed.pl ||
622 echo 'restore of libs/elapsed.pl failed'
623 Wc_c="`wc -c < 'libs/elapsed.pl'`"
624 test 3198 -eq "$Wc_c" ||
625         echo 'libs/elapsed.pl: original size 3198, current size' "$Wc_c"
626 fi
627 # ============= libs/mail.pl ==============
628 if test -f 'libs/mail.pl' -a X"$1" != X"-c"; then
629         echo 'x - skipping libs/mail.pl (File already exists)'
630 else
631 echo 'x - extracting libs/mail.pl (Text)'
632 sed '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
642 X
643 package mail;
644 X
645 # Mailer statement to eval. $Users, $Subject, and $Verbose are substituted 
646 # via eval
647 $BIN_MAILER             = "/usr/ucb/mail \$Verbose -s '\$Subject' \$Users";
648 X
649 # Sendmail command to use when $Use_Sendmail is true.
650 $SENDMAIL               = '/usr/lib/sendmail $Verbose $Users';
651 X
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 ;###############################################################################
682 sub main'Send_Mail
683 {
684 X   local ($Users, $Subject, $Message, $Message_Is_File, $Verbose, 
685 X         $Use_Sendmail) = @_;
686 X   local ($BIN_MAILER_HANDLE, $Mailer_Command, $Header_Found, %Header_Map,
687 X         $Header_Extra, $Mailer);
688 X
689 X   # If the message is contained in a file read it in so we can have one
690 X   # consistent interface
691 X   if ($Message_Is_File)
692 X   {
693 X      undef $/;
694 X      $Message_Is_File = 0;
695 X      open (Message) || return (0, "error reading $Message: $!");
696 X      $Message = <Message>;
697 X      close (Message);
698 X   };
699 X
700 X   # If sendmail mode see if we need to add some headers
701 X   if ($Use_Sendmail)
702 X   {
703 X      # Determine if a header block is included in the message and what headers
704 X      # are there
705 X      foreach (split (/\n/, $Message))
706 X      {
707 X        last if ($_ eq "");
708 X        $Header_Found = $Header_Map {$1} = 1 if (/^([A-Z]\S*): /);
709 X      };
710 X
711 X      # Add some headers?
712 X      if (! $Header_Map {"To"})
713 X      {
714 X        $Header_Extra .= "To: " . join (", ", $Users) . "\n";
715 X      };
716 X      if (($Subject ne "") && (! $Header_Map {"Subject"}))
717 X      {
718 X        $Header_Extra .= "Subject: $Subject\n";
719 X      };
720 X
721 X      # Add the required blank line between header/body if there where no
722 X      # headers to begin with
723 X      if ($Header_Found)
724 X      {
725 X         $Message = "$Header_Extra$Message";
726 X      }
727 X      else
728 X      {
729 X        $Message = "$Header_Extra\n$Message";
730 X      };
731 X   };
732 X
733 X   # Get a string that is the mail command
734 X   $Verbose = ($Verbose) ? "-v" : "";
735 X   $Mailer = ($Use_Sendmail) ? $SENDMAIL : $BIN_MAILER;
736 X   eval "\$Mailer = \"$Mailer\"";
737 X   return (0, "error setting \$Mailer: $@") if ($@);
738 X
739 X   # need to catch SIGPIPE in case the $Mailer call fails
740 X   $SIG {'PIPE'} = "mail'Cleanup";
741 X
742 X   # Open mailer
743 X   return (0, "can not open mail program: $Mailer") if (! open (MAILER, "| $Mailer"));
744 X   
745 X   # Send off the mail!
746 X   print MAILER $Message;
747 X   close (MAILER);
748 X   return (0, "error running mail program: $Mailer") if ($?);
749 X   
750 X   # Everything must have went AOK
751 X   return (1);
752 };
753 X
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 ;###############################################################################
768 sub Cleanup
769 {
770 };
771 X
772 1;
773 SHAR_EOF
774 chmod 0444 libs/mail.pl ||
775 echo 'restore of libs/mail.pl failed'
776 Wc_c="`wc -c < 'libs/mail.pl'`"
777 test 4356 -eq "$Wc_c" ||
778         echo 'libs/mail.pl: original size 4356, current size' "$Wc_c"
779 fi
780 # ============= libs/mqueue.pl ==============
781 if test -f 'libs/mqueue.pl' -a X"$1" != X"-c"; then
782         echo 'x - skipping libs/mqueue.pl (File already exists)'
783 else
784 echo 'x - extracting libs/mqueue.pl (Text)'
785 sed '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
801 X
802 package mqueue;
803 X
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 ;###############################################################################
828 sub main'Get_Queue_IDs
829 {
830 X   local ($Queue, $Skip_Locked, *Missing_Control_IDs, 
831 X          *Missing_Data_IDs) = @_;
832 X   local (*QUEUE, @Files, %Lock_IDs, %Data_IDs, %Control_IDs, $_);
833 X
834 X   # Make sure that the * argument @arrays ar empty
835 X   @Missing_Control_IDs = @Missing_Data_IDs = ();
836 X
837 X   # Save each data, lock, and queue file in @Files
838 X   opendir (QUEUE, $Queue) || return (0, "error getting directory listing of $Queue");
839 X   @Files = grep (/^(df|lf|qf)/, readdir (QUEUE));
840 X   closedir (QUEUE);
841 X   
842 X   # Create indexed list of data and control files. IF $Skip_Locked is true
843 X   # then skip either if there is a lock file present.
844 X   if ($Skip_Locked)
845 X   {
846 X      grep ((s/^lf//) && ($Lock_IDs {$_} = 1), @Files);
847 X      grep ((s/^df//) && (! $Lock_IDs {$_}) && ($Data_IDs {$_} = 1), @Files);
848 X      grep ((s/^qf//) && (! $Lock_IDs {$_}) && ($Control_IDs {$_} = 1), @Files);
849 X   }
850 X   else
851 X   {
852 X      grep ((s/^df//) && ($Data_IDs {$_} = 1), @Files);
853 X      grep ((s/^qf//) && ($Control_IDs {$_} = 1), @Files);
854 X   };
855 X   
856 X   # Find missing control and data files and remove them from the lists of each
857 X   @Missing_Control_IDs = sort (grep ((! $Control_IDs {$_}) && (delete $Data_IDs {$_}), keys (%Data_IDs)));
858 X   @Missing_Data_IDs = sort (grep ((! $Data_IDs {$_} && (delete $Control_IDs {$_})), keys (%Control_IDs)));
859 X   
860 X   
861 X   # Return the IDs in an appartently random order
862 X   return (1, "", keys (%Control_IDs));
863 };
864 X
865 X
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 ;###############################################################################
913 sub main'Parse_Control_File
914 {
915 X   local ($Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time,
916 X          *Priority, *Status_Message, *Headers) = @_;
917 X   local (*Control, $_, $Not_Empty);
918 X
919 X   # Required variables and the associated control. If empty at the end of
920 X   # parsing we return a bad status.
921 X   @REQUIRED_INFO = ('$Creation_Time', 'T', '$Sender', 'S', '@Recipients', 'R',
922 X                    '$Priority', 'P');
923 X
924 X   # Open up the control file for read
925 X   $Control = "$Queue/qf$Queue_ID";
926 X   if (! open (Control)) 
927 X   {
928 X      return (-1) if ((-x $Queue) && (! -f "$Queue/qf$Queue_ID") &&
929 X       (! -f "$Queue/df$Queue_ID"));
930 X      return (0, "error opening $Control for read: $!");
931 X   };
932 X
933 X   # Reset the globbed variables just in case
934 X   $Sender = $Creation_Time = $Priority = $Status_Message = "";
935 X   @Recipients = @Errors_To = @Headers = ();
936 X
937 X   # Look for a few things in the control file
938 X   READ: while (<Control>)
939 X   {
940 X      $Not_Empty = 1;
941 X      chop;
942 X
943 X      PARSE:
944 X      {
945 X         if (/^T(\d+)$/)
946 X         {
947 X            $Creation_Time = $1;
948 X         }
949 X         elsif (/^S(<)?([^>]+)/)
950 X         {
951 X            $Sender = $2;
952 X         }
953 X         elsif (/^R(<)?([^>]+)/)
954 X         {
955 X            push (@Recipients, $2);
956 X         }
957 X         elsif (/^E(<)?([^>]+)/)
958 X         {
959 X            push (@Errors_To, $2);
960 X         }
961 X         elsif (/^M(.*)/)
962 X         {
963 X            $Status_Message = $1;
964 X         }
965 X         elsif (/^P(\d+)$/)
966 X         {
967 X            $Priority = $1;
968 X         }
969 X         elsif (/^H(.*)/)
970 X         {
971 X            $Header = $1;
972 X            while (<Control>)
973 X            {
974 X               chop;
975 X               last if (/^[A-Z]/);
976 X               $Header .= "\n$_";
977 X            };
978 X            push (@Headers, $Header);
979 X           redo PARSE if ($_);
980 X           last if (eof);
981 X         };
982 X      };
983 X   };
984 X
985 X   # If the file was empty scream bloody murder
986 X   return (0, "empty control file") if (! $Not_Empty);
987 X
988 X   # Yell if we could not find a required field
989 X   while (($Var, $Control) = splice (@REQUIRED_INFO, 0, 2))
990 X   {
991 X      eval "return (0, 'required control field $Control not found')
992 X              if (! $Var)";
993 X      return (0, "error checking \$Var: $@") if ($@);
994 X   };
995 X
996 X   # Everything went AOK
997 X   return (1);
998 };
999 X
1000 1;
1001 SHAR_EOF
1002 chmod 0444 libs/mqueue.pl ||
1003 echo 'restore of libs/mqueue.pl failed'
1004 Wc_c="`wc -c < 'libs/mqueue.pl'`"
1005 test 6908 -eq "$Wc_c" ||
1006         echo 'libs/mqueue.pl: original size 6908, current size' "$Wc_c"
1007 fi
1008 # ============= libs/newgetopts.pl ==============
1009 if test -f 'libs/newgetopts.pl' -a X"$1" != X"-c"; then
1010         echo 'x - skipping libs/newgetopts.pl (File already exists)'
1011 else
1012 echo 'x - extracting libs/newgetopts.pl (Text)'
1013 sed '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
1023 X
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 ;###############################################################################
1082 sub New_Getopts 
1083 {
1084 X    local($taint_argumentative, $Usage, $Pass_Invalid, *Switch_To_Order,
1085 X          *Split_ARGV) = @_;
1086 X    local(@args,$_,$first,$rest,$errs, @leftovers, @current_leftovers,
1087 X          %Switch_Found);
1088 X    local($[, $*, $Script_Name, $argumentative);
1089 X
1090 X    # Untaint the argument cluster so that we can use this with taintperl
1091 X    $taint_argumentative =~ /^(.*)$/;
1092 X    $argumentative = $1;
1093 X
1094 X    # Clear anything that might still be set from a previous New_Getopts
1095 X    # call.
1096 X    @Split_ARGV = ();
1097 X
1098 X    # Get the basename of the calling script
1099 X    ($Script_Name = $0) =~ s/.*\///;
1100 X    
1101 X    # Make Usage have a trailing \n
1102 X    $Usage .= "\n" if ($Usage !~ /\n$/);
1103 X
1104 X    @args = split( / */, $argumentative );
1105 X
1106 X    # Clear anything that might still be set from a previous New_Getopts call.
1107 X    foreach $first (@args)
1108 X    {
1109 X       next if ($first eq ":");
1110 X       delete $Switch_Found {$first};
1111 X       delete $Switch_To_Order {$first};
1112 X       eval "undef \@opt_$first; undef \$opt_$first;";
1113 X    };
1114 X
1115 X    while (@ARGV)
1116 X    {
1117 X        # Let usage through
1118 X        if (($ARGV[0] eq "-usage") && ($Usage ne "\n"))
1119 X        {
1120 X           print $Usage;
1121 X           exit (-1);
1122 X        }
1123 X
1124 X        elsif ($ARGV[0] eq "-version")
1125 X        {
1126 X           if ($VERSION)
1127 X           {
1128 X              print $VERSION;
1129 X              print "\n" if ($VERSION !~ /\n$/);
1130 X           }
1131 X           else
1132 X           {
1133 X              warn "${Script_Name}: no version information available, sorry\n";
1134 X           }
1135 X           exit (-1);
1136 X        }
1137 X
1138 X        elsif (($_ = $ARGV[0]) =~ /^-(.)(.*)/)
1139 X        {
1140 X           ($first,$rest) = ($1,$2);
1141 X           $pos = index($argumentative,$first);
1142 X
1143 X           $Switch_To_Order {$first} = join ($;, split (/$;/, $Switch_To_Order {$first}), ++$Order);
1144 X
1145 X           if($pos >= $[) 
1146 X           {
1147 X               if($args[$pos+1] eq ':') 
1148 X               {
1149 X                   shift(@ARGV);
1150 X                   if($rest eq '') 
1151 X                   {
1152 X                       $rest = shift(@ARGV);
1153 X                   }
1154 X
1155 X                   eval "\$opt_$first = \$rest;";
1156 X                   eval "push (\@opt_$first, \$rest);";
1157 X                   push (@Split_ARGV, $first, $rest);
1158 X               }
1159 X               else 
1160 X               {
1161 X                   eval "\$opt_$first = 1";
1162 X                   eval "push (\@opt_$first, '');";
1163 X                   push (@Split_ARGV, $first, "");
1164 X
1165 X                   if($rest eq '') 
1166 X                   {
1167 X                       shift(@ARGV);
1168 X                   }
1169 X                   else 
1170 X                   {
1171 X                       $ARGV[0] = "-$rest";
1172 X                   }
1173 X               }
1174 X           }
1175 X
1176 X           else 
1177 X           {
1178 X               # Save any other switches if $Pass_Valid
1179 X               if ($Pass_Invalid)
1180 X               {
1181 X                  push (@current_leftovers, $first);
1182 X               }
1183 X               else
1184 X               {
1185 X                  warn "${Script_Name}: unknown option: $first\n";
1186 X                  ++$errs;
1187 X               };
1188 X               if($rest ne '') 
1189 X               {
1190 X                   $ARGV[0] = "-$rest";
1191 X               }
1192 X               else 
1193 X               {
1194 X                   shift(@ARGV);
1195 X               }
1196 X           }
1197 X        }
1198 X
1199 X        else
1200 X        {
1201 X           push (@leftovers, shift (@ARGV));
1202 X        };
1203 X
1204 X        # Save any other switches if $Pass_Valid
1205 X        if ((@current_leftovers) && ($rest eq ''))
1206 X        {
1207 X           push (@leftovers, "-" . join ("", @current_leftovers));
1208 X           @current_leftovers = ();
1209 X        };
1210 X    };
1211 X
1212 X    # Automatically print Usage if a warning was given
1213 X    @ARGV = @leftovers;
1214 X    if ($errs != 0)
1215 X    {
1216 X       warn $Usage;
1217 X       return (0);
1218 X    }
1219 X    else
1220 X    {
1221 X       return (1);
1222 X    }
1223 X       
1224 }
1225 X
1226 1;
1227 SHAR_EOF
1228 chmod 0444 libs/newgetopts.pl ||
1229 echo 'restore of libs/newgetopts.pl failed'
1230 Wc_c="`wc -c < 'libs/newgetopts.pl'`"
1231 test 7024 -eq "$Wc_c" ||
1232         echo 'libs/newgetopts.pl: original size 7024, current size' "$Wc_c"
1233 fi
1234 # ============= libs/strings1.pl ==============
1235 if test -f 'libs/strings1.pl' -a X"$1" != X"-c"; then
1236         echo 'x - skipping libs/strings1.pl (File already exists)'
1237 else
1238 echo 'x - extracting libs/strings1.pl (Text)'
1239 sed '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
1253 X
1254 package strings1;
1255 X
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 ;###############################################################################
1269 sub main'Center
1270 {
1271 X   local ($_, $Columns) = @_;
1272 X   local ($*) = 1;
1273 X
1274 X   s@^(.*)$@" " x (($Columns - length ($1)) / 2) . $1@eg;
1275 X   s/^[\t ]*$//g;
1276 X   return ($_);
1277 };
1278 X
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 ;###############################################################################
1319 sub main'Format_Text_Block
1320 {
1321 X   local ($String, $Real_Offset, $Offset_Once, $Bullet_Indent, $Columns, 
1322 X      $Split_Expr, $Offset_Blank) = @_;
1323 X
1324 X   local ($New_Line, $Line, $Chars_Per_Line, $Space_Offset, $Buffer,
1325 X      $Next_New_Line, $Num_Lines, $Num_Offsets, $Offset);
1326 X   local ($*) = 0;
1327 X   local ($BLANK_TAG) = "__FORMAT_BLANK__";
1328 X   local ($Blank_Offset) = $Real_Offset if ($Offset_Blank);
1329 X
1330 X   # What should we split on?
1331 X   $Split_Expr = " \\t\\/\\-\\,\\." if (! $Split_Expr);
1332 X
1333 X   # Pre-process the string - convert blank lines to __FORMAT_BLANK__ sequence
1334 X   $String =~ s/\n\n/\n$BLANK_TAG\n/g;
1335 X   $String =~ s/^\n/$BLANK_TAG\n/g;
1336 X   $String =~ s/\n$/\n$BLANK_TAG/g;
1337 X
1338 X   # If bad $Columns/$Offset combo or no $Columns make a VERRRYYY wide $Column
1339 X   $Offset = $Real_Offset;
1340 X   $Chars_Per_Line = 16000 if (($Chars_Per_Line = $Columns - length ($Offset)) <= 0);
1341 X   $Space_Offset = " " x length ($Offset);
1342 X
1343 X   # Get a buffer
1344 X   foreach $Line (split ("\n", $String))
1345 X   {
1346 X      $Offset = $Real_Offset if ($Bullet_Indent);
1347 X
1348 X      # Find where to split the line
1349 X      if ($Line ne $BLANK_TAG)
1350 X      { 
1351 X         $New_Line = "";
1352 X         while ($Line =~ /^([$Split_Expr]*)([^$Split_Expr]+)/)
1353 X         {
1354 X            if (length ("$New_Line$&") >= $Chars_Per_Line)
1355 X            {
1356 X               $Next_New_Line = $+;
1357 X               $New_Line = "$Offset$New_Line$1";
1358 X               $Buffer .= "\n" if ($Num_Lines++);
1359 X               $Buffer .= $New_Line;
1360 X               $Offset = $Space_Offset if (($Offset) && ($Offset_Once));
1361 X               $New_Line = $Next_New_Line;
1362 X               ++$Num_Lines;
1363 X            }
1364 X            else
1365 X            {
1366 X               $New_Line .= $&;
1367 X            };
1368 X            $Line = $';
1369 X         };
1370 X
1371 X         $Buffer .= "\n" if ($Num_Lines++);
1372 X         $Buffer .= "$Offset$New_Line$Line";
1373 X         $Offset = $Space_Offset if (($Offset) && ($Offset_Once));
1374 X      }
1375 X
1376 X      else
1377 X      {
1378 X         $Buffer .= "\n$Blank_Offset";
1379 X      };
1380 X   };
1381 X
1382 X   return ($Buffer);
1383 X
1384 };
1385 X
1386 1;
1387 SHAR_EOF
1388 chmod 0444 libs/strings1.pl ||
1389 echo 'restore of libs/strings1.pl failed'
1390 Wc_c="`wc -c < 'libs/strings1.pl'`"
1391 test 4687 -eq "$Wc_c" ||
1392         echo 'libs/strings1.pl: original size 4687, current size' "$Wc_c"
1393 fi
1394 # ============= libs/timespec.pl ==============
1395 if test -f 'libs/timespec.pl' -a X"$1" != X"-c"; then
1396         echo 'x - skipping libs/timespec.pl (File already exists)'
1397 else
1398 echo 'x - extracting libs/timespec.pl (Text)'
1399 sed '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
1409 X
1410 package timespec;
1411 X
1412 %TIME_SPEC_TO_SECONDS   = ("s", 1,
1413 X                          "m", 60,
1414 X                          "h", 60 * 60,
1415 X                          "d", 60 * 60 * 24
1416 X                          );
1417 X
1418 $VALID_TIME_SPEC_EXPR   = "[" . join ("", keys (%TIME_SPEC_TO_SECONDS)) . "]";
1419 X
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 ;###############################################################################
1442 sub main'Time_Spec_To_Seconds
1443 {
1444 X   $Time_Spec = $_[0];
1445 X
1446 X   $Seconds = 0;
1447 X   while ($Time_Spec =~ /^(\d+)($VALID_TIME_SPEC_EXPR)/)
1448 X   {
1449 X      $Seconds += $1 * $TIME_SPEC_TO_SECONDS {$2};
1450 X      $Time_Spec = $';
1451 X   };
1452 X
1453 X   return (0, "error parsing time spec: $Time_Spec") if ($Time_Spec ne "");
1454 X   return (1, "", $Seconds);
1455 X
1456 };
1457 X
1458 X
1459 1;
1460 SHAR_EOF
1461 chmod 0444 libs/timespec.pl ||
1462 echo 'restore of libs/timespec.pl failed'
1463 Wc_c="`wc -c < 'libs/timespec.pl'`"
1464 test 1609 -eq "$Wc_c" ||
1465         echo 'libs/timespec.pl: original size 1609, current size' "$Wc_c"
1466 fi
1467 # ============= man/cqueue.1 ==============
1468 if test ! -d 'man'; then
1469     echo 'x - creating directory man'
1470     mkdir 'man'
1471 fi
1472 if test -f 'man/cqueue.1' -a X"$1" != X"-c"; then
1473         echo 'x - skipping man/cqueue.1 (File already exists)'
1474 else
1475 echo 'x - extracting man/cqueue.1 (Text)'
1476 sed '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
1493 Reports on problems in the sendmail queue. With no options this simply
1494 means listing messages that have been in the queue longer than a default
1495 period along with a summary of queue mail by host and status message.
1496 .SH OPTIONS
1497 .IP \fB-a\fR 14
1498 Report on all messages in the queue. This is equivalent to saying \fB-t\fR 0s.
1499 You 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
1508 Also report on bogus queue files. Those are files that
1509 have data files and no control files or vice versa.
1510 .IP \fB-d\fR
1511 Print a detailed report of mail messages that have been queued longer than
1512 the specified or default time. Information that is presented includes:
1513 .RS
1514 .RS
1515 .IB
1516 Sendmail queue identifier.
1517 .IB
1518 Date the message was first queued.
1519 .IB
1520 Sender of the message.
1521 .IB
1522 One or more recipients of the message.
1523 .IB
1524 An optional status of the message. This usually indicates why the message
1525 has not been delivered.
1526 .RE
1527 .RE
1528 .IP \fB-m\fR 14
1529 Mail off the results if any problems were found.
1530 Normaly results are printed to stdout. If this option
1531 is specified they are mailed to one or more users. Results
1532 are not printed to stdout in this case. Results are \fBonly\fR
1533 mailed if \*(mp found something wrong.
1534 .IP "\fB-q\fR \fIqueue-dir\fI"
1535 The sendmail mail queue directory. Default is \fB/usr/spool/mqueue\fR or
1536 some other site configured value.
1537 .IP "\fB-t\fR \fItime\fR"
1538 List 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
1548 The second portion of the above definition
1549 specifies seconds, minutes, hours, or
1550 days, respectfully. The first portion is the number of
1551 those units. There can be any number of such specifiers.
1552 As an example, 1h30m means 1 hour and 30 minutes.
1553 .sp 1
1554 The default is 2 hours.
1555 .RE
1556 .IP \fB-s\fR 14
1557 Print a summary of messages that have been queued longer than
1558 the specified or default time. Two separate types of summaries are printed.
1559 The first summarizes the queue messages by destination host. The host name
1560 is gleaned from the recipient addresses for each message.
1561 Thus the actual host names for this summary should be taken with a grain
1562 of salt since ruleset 0 has not been applied to the address the host was
1563 taken from nor were MX records consulted. It would be possible to add
1564 this; however, the execution time of the script would increase 
1565 dramatically. The second summary is by status message.
1566 .IP "\fB-u\fR \fIusers\fR"
1567 Specify list of users to send a mail report to other than
1568 the invoker. This option is only valid when \fB-m\fR has been
1569 specified. Multiple recipients may be separated by spaces.
1570 .IP "\fB-w\fR \fIwidth\fR"
1571 Specify the page width to which the output should tailored. \fIwidth\fR
1572 should be an integer representing some character position. The default is
1573 80 or some other site configured value. Output is folded neatly to match 
1574 \fIwidth\fR.
1575 .SH EXAMPLES
1576 .nf
1577 % \fBdate\fR
1578 Tue Jan 19 12:07:20 CST 1993
1579 X
1580 % \fBcqueue -t 21h45m -w 70\fR
1581 X
1582 Summary of messages in queue longer than 21:45:00 by destination 
1583 host:
1584 X
1585 X   Number of
1586 X   Messages    Destination Host
1587 X   ---------   ----------------
1588 X   2           cigseg.rtsg.mot.com
1589 X   1           mnesouth.corp.mot.com
1590 X   ---------
1591 X   3
1592 X
1593 Summary of messages in queue longer than 21:45:00 by status message:
1594 X
1595 X   Number of
1596 X   Messages    Status Message
1597 X   ---------   --------------
1598 X   1           Deferred: Connection refused by mnesouth.corp.mot.com
1599 X   2           Deferred: Host Name Lookup Failure
1600 X   ---------
1601 X   3
1602 X
1603 Detail of messages in queue longer than 21:45:00 sorted by creation 
1604 date:
1605 X
1606 X   ID:        AA20573
1607 X   Date:      02:09:27 PM 01/18/93
1608 X   Sender:    melrose-place-owner@ferkel.ucsb.edu
1609 X   Recipient: pbaker@cigseg.rtsg.mot.com
1610 X   Status:    Deferred: Host Name Lookup Failure
1611 X
1612 X   ID:        AA20757
1613 X   Date:      02:11:30 PM 01/18/93
1614 X   Sender:    90210-owner@ferkel.ucsb.edu
1615 X   Recipient: pbaker@cigseg.rtsg.mot.com
1616 X   Status:    Deferred: Host Name Lookup Failure
1617 X
1618 X   ID:        AA21110
1619 X   Date:      02:17:01 PM 01/18/93
1620 X   Sender:    rd_lap_wg@mdd.comm.mot.com
1621 X   Recipient: jim_mathis@mnesouth.corp.mot.com
1622 X   Status:    Deferred: Connection refused by mnesouth.corp.mot.com
1623 .fi
1624 .SH AUTHOR
1625 .nf
1626 Michael S. Muegel (mmuegel@mot.com)
1627 UNIX Applications Startup Group
1628 Corporate Information Office, Schaumburg, IL
1629 Motorola, Inc.
1630 .fi
1631 .SH COPYRIGHT NOTICE
1632 Copyright 1993, Motorola, Inc.
1633 .sp 1
1634 Permission to use, copy, modify and distribute without charge this
1635 software, documentation, etc. is granted, provided that this
1636 comment and the author's name is retained.  The author nor Motorola assume any
1637 responsibility 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
1643 SHAR_EOF
1644 chmod 0444 man/cqueue.1 ||
1645 echo 'restore of man/cqueue.1 failed'
1646 Wc_c="`wc -c < 'man/cqueue.1'`"
1647 test 5212 -eq "$Wc_c" ||
1648         echo 'man/cqueue.1: original size 5212, current size' "$Wc_c"
1649 fi
1650 # ============= man/postclip.1 ==============
1651 if test -f 'man/postclip.1' -a X"$1" != X"-c"; then
1652         echo 'x - skipping man/postclip.1 (File already exists)'
1653 else
1654 echo 'x - extracting man/postclip.1 (Text)'
1655 sed '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
1668 of 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.
1669 Hopefully only the original body of the message will be filtered. Only messages
1670 that have a subject that begins with 'Returned mail:' are filtered. This
1671 ensures 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)
1673 filtered. All of the original headers will remain intact.
1674 .sp 1 
1675 You can use this with any \fBsendmail\fR by modifying the Postmaster alias.
1676 If you use IDA \fBsendmail\fR you could add the following to <machine>.m4:
1677 .sp 1
1678 .RS
1679 define(POSTMASTERBOUNCE, mailer-errors)
1680 .RE
1681 .sp 1
1682 In the aliases file, add a line similar to the following:
1683 .sp 1
1684 .RS
1685 mailer-errors: "|/usr/local/bin/postclip postmaster"
1686 .RE
1687 .SH OPTIONS
1688 .IP \fB-v\fR
1689 Be verbose about delivery. Probably only useful when debugging \*(mp.
1690 .IP \fIto\fR
1691 A list of one or more e-mail ids to send the modified
1692 Postmaster messages to. If none are specified postmaster
1693 is used.
1694 .SH AUTHOR
1695 .nf
1696 Michael S. Muegel (mmuegel@mot.com)
1697 UNIX Applications Startup Group
1698 Corporate Information Office, Schaumburg, IL
1699 Motorola, Inc.
1700 .fi
1701 .SH CREDITS
1702 The original idea to filter Postmaster mail was taken from a script by 
1703 Christopher Davis <ckd@eff.org>.
1704 .SH COPYRIGHT NOTICE
1705 Copyright 1992, Motorola, Inc.
1706 .sp 1
1707 Permission to use, copy, modify and distribute without charge this
1708 software, documentation, etc. is granted, provided that this
1709 comment and the author's name is retained.  The author nor Motorola assume any
1710 responsibility for problems resulting from the use of this software.
1711 .SH SEE ALSO
1712 .nf
1713 \fBsendmail(8)\fR
1714 .fi
1715 SHAR_EOF
1716 chmod 0444 man/postclip.1 ||
1717 echo 'restore of man/postclip.1 failed'
1718 Wc_c="`wc -c < 'man/postclip.1'`"
1719 test 2078 -eq "$Wc_c" ||
1720         echo 'man/postclip.1: original size 2078, current size' "$Wc_c"
1721 fi
1722 # ============= src/cqueue ==============
1723 if test ! -d 'src'; then
1724     echo 'x - creating directory src'
1725     mkdir 'src'
1726 fi
1727 if test -f 'src/cqueue' -a X"$1" != X"-c"; then
1728         echo 'x - skipping src/cqueue (File already exists)'
1729 else
1730 echo 'x - extracting src/cqueue (Text)'
1731 sed 's/^X//' << 'SHAR_EOF' > 'src/cqueue' &&
1732 #!/usr/local/ustart/bin/suidperl
1733 X
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
1746 X
1747 # So that date.pl does not yell (Domain/OS version does a ``)
1748 $ENV{'PATH'}    = "";
1749 X
1750 # A better getopts routine
1751 require "newgetopts.pl";
1752 require "timespec.pl";
1753 require "mail.pl";
1754 require "date.pl";
1755 require "mqueue.pl";
1756 require "strings1.pl";
1757 require "elapsed.pl";
1758 X
1759 ($Script_Name = $0) =~ s/.*\///;
1760 X         
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";
1766 X
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 = '[^!@%]+';
1773 X
1774 # Let getopts parse for switches
1775 $Status = &New_Getopts ($SWITCHES, $USAGE);
1776 exit (0) if ($Status == -1);
1777 exit (1) if (! $Status);
1778 X
1779 # Check args 
1780 die "${Script_Name}: -u only valid with -m\n" if (($opt_u) && (! $opt_m));
1781 die "${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);
1783 X
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));
1790 X
1791 # Untaint the users to mail to
1792 $opt_u =~ /^(.*)$/;
1793 $Users = $1;
1794 X
1795 # Convert time option to seconds and seconds to elapsed form
1796 die "${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);
1799 X
1800 # Get the current time
1801 $Current_Time = time;
1802 $Current_Date = &date ($Current_Time, $DATE_FORMAT);
1803 X
1804 ($Status, $Msg, @Queue_IDs) = &Get_Queue_IDs ($opt_q, 1, @Missing_Control_IDs,
1805 X   @Missing_Data_IDs);
1806 die "$Script_Name: $Msg\n" if (! $Status);
1807 X
1808 # Yell about missing data/control files?
1809 if ($opt_b)
1810 {
1811 X
1812 X   $Report = "\nMessages missing control files:\n\n   " . 
1813 X             join ("\n   ", @Missing_Control_IDs) . 
1814 X             "\n" 
1815 X      if (@Missing_Control_IDs);
1816 X
1817 X   $Report .= "\nMessages missing data files:\n\n   " . 
1818 X              join ("\n   ", @Missing_Data_IDs) . 
1819 X              "\n"
1820 X      if (@Missing_Data_IDs);
1821 };
1822 X
1823 # See if any mail messages are older than $Seconds
1824 foreach $Queue_ID (@Queue_IDs)
1825 {
1826 X   # Get lots of info about this sendmail message via the control file
1827 X   ($Status, $Msg) = &Parse_Control_File ($opt_q, $Queue_ID, *Sender, 
1828 X      *Recipients, *Errors_To, *Creation_Time, *Priority, *Status_Message, 
1829 X      *Headers);
1830 X   next if ($Status == -1);
1831 X   if (! $Status)
1832 X   {
1833 X      warn "$Script_Name: $Queue_ID: $Msg\n";
1834 X      next;
1835 X   };
1836 X
1837 X   # Report on message if it is older than $Seconds
1838 X   if ($Current_Time - $Creation_Time >= $Seconds)
1839 X   {
1840 X      # Build summary by host information. Keep track of each host destination
1841 X      # encountered.
1842 X      if ($opt_s)
1843 X      {
1844 X         %Host_Map = ();
1845 X         foreach (@Recipients)
1846 X         {
1847 X           if ((/@($ADDR_PART_EXPR)$/) || (/($ADDR_PART_EXPR)!$ADDR_PART_EXPR$/))
1848 X            {
1849 X              ($Host = $1) =~ tr/A-Z/a-z/;
1850 X               $Host_Map {$Host} = 1;
1851 X           }
1852 X           else
1853 X           {
1854 X              warn "$Script_Name: could not find host part from $_; contact author\n";
1855 X           };
1856 X         };
1857 X
1858 X         # For each unique target host add to its stats
1859 X         grep ($Host_Queued {$_}++, keys (%Host_Map));
1860 X
1861 X         # Build summary by message information.
1862 X         $Message_Queued {$Status_Message}++ if ($Status_Message);
1863 X      };
1864 X
1865 X      # Build long report information for this creation time (there may be
1866 X      # more than one message created at the same time)
1867 X      if ($opt_d)
1868 X      {
1869 X         $Creation_Date = &date ($Creation_Time, $DATE_FORMAT);
1870 X         $Recipient_Info = &Format_Text_Block (join (", ", @Recipients), 
1871 X           "   Recipient: ", 1, 0, $opt_w, $SPLIT_EXPR);
1872 X         $Time_To_Report {$Creation_Time} .= <<"EOS";
1873 X
1874 X   ID:        $Queue_ID
1875 X   Date:      $Creation_Date
1876 X   Sender:    $Sender
1877 $Recipient_Info
1878 EOS
1879 X
1880 X         # Add the status message if available to long report
1881 X         if ($Status_Message)
1882 X         {
1883 X           $Time_To_Report {$Creation_Time} .= &Format_Text_Block ($Status_Message, 
1884 X              "   Status:    ", 1, 0, $opt_w, $SPLIT_EXPR) . "\n";
1885 X         };
1886 X      };
1887 X   };
1888 X
1889 };
1890 X
1891 # Add the summary report by target host?
1892 if ($opt_s)
1893 {
1894 X   foreach $Host (sort (keys (%Host_Queued)))
1895 X   {
1896 X      $Host_Report .= &Format_Text_Block ($Host, 
1897 X         sprintf ("   %-9d   ", $Host_Queued{$Host}), 1, 0, $opt_w,
1898 X         $SPLIT_EXPR) . "\n";
1899 X      $Num_Hosts += $Host_Queued{$Host};
1900 X   };
1901 X   if ($Host_Report)
1902 X   {
1903 X      chop ($Host_Report);
1904 X      $Report .= &Format_Text_Block("\nSummary of messages in queue$Time_Info by destination host:\n", "", 0, 0, $opt_w);
1905 X
1906 X      $Report .= <<"EOS";
1907 X
1908 X   Number of
1909 X   Messages    Destination Host
1910 X   ---------   ----------------
1911 $Host_Report
1912 X   ---------
1913 X   $Num_Hosts
1914 EOS
1915 X   };
1916 };
1917 X
1918 # Add the summary by message report?
1919 if ($opt_s)
1920 {
1921 X   foreach $Message (sort (keys (%Message_Queued)))
1922 X   {
1923 X      $Message_Report .= &Format_Text_Block ($Message, 
1924 X         sprintf ("   %-9d   ", $Message_Queued{$Message}), 1, 0, $opt_w, 
1925 X         $SPLIT_EXPR) . "\n";
1926 X      $Num_Messages += $Message_Queued{$Message};
1927 X   };
1928 X   if ($Message_Report)
1929 X   {
1930 X      chop ($Message_Report);
1931 X      $Report .= &Format_Text_Block ("\nSummary of messages in queue$Time_Info by status message:\n", "", 0, 0, $opt_w);
1932 X
1933 X      $Report .= <<"EOS";
1934 X
1935 X   Number of
1936 X   Messages    Status Message
1937 X   ---------   --------------
1938 $Message_Report
1939 X   ---------
1940 X   $Num_Messages
1941 EOS
1942 X   };
1943 };
1944 X
1945 # Add the detailed message reports?
1946 if ($opt_d)
1947 {
1948 X   foreach $Time (sort { $a <=> $b} (keys (%Time_To_Report)))
1949 X   {
1950 X      $Report .= &Format_Text_Block ("\nDetail of messages in queue$Time_Info sorted by creation date:\n","", 0, 0, $opt_w) if (! $Detailed_Header++);
1951 X      $Report .= $Time_To_Report {$Time};
1952 X   };
1953 };
1954 X
1955 # Now mail or print the report
1956 if ($Report)
1957 {
1958 X   $Report .= "\n";
1959 X   if ($opt_m)
1960 X   {
1961 X      ($Status, $Msg) = &Send_Mail ($Users, "sendmail queue report for $Current_Date", $Report, 0);
1962 X      die "${Script_Name}: $Msg" if (! $Status);
1963 X   }
1964 X
1965 X   else
1966 X   {
1967 X      print $Report;
1968 X   };
1969 X
1970 };
1971 X
1972 # I am outta here...
1973 exit (0);
1974 SHAR_EOF
1975 chmod 0555 src/cqueue ||
1976 echo 'restore of src/cqueue failed'
1977 Wc_c="`wc -c < 'src/cqueue'`"
1978 test 6647 -eq "$Wc_c" ||
1979         echo 'src/cqueue: original size 6647, current size' "$Wc_c"
1980 fi
1981 # ============= src/postclip ==============
1982 if test -f 'src/postclip' -a X"$1" != X"-c"; then
1983         echo 'x - skipping src/postclip (File already exists)'
1984 else
1985 echo 'x - extracting src/postclip (Text)'
1986 sed 's/^X//' << 'SHAR_EOF' > 'src/postclip' &&
1987 #!/usr/local/bin/perl
1988 X
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
2001 X
2002 # We use this to send off the mail
2003 require "newgetopts.pl";
2004 require "mail.pl";
2005 X
2006 # Get the basename of the script
2007 ($Script_Name = $0) =~ s/.*\///;
2008 X
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";
2013 X
2014 # Let getopts parse for switches
2015 $Status = &New_Getopts ($SWITCHES, $USAGE);
2016 exit (0) if ($Status == -1);
2017 exit (1) if (! $Status);
2018 X
2019 # Who should we send the modified mail to?
2020 @ARGV = ("postmaster") if (! @ARGV);
2021 $Users = join (" ", @ARGV);
2022 @ARGV = ();
2023 X
2024 # Suck in the original header and save a few interesting lines
2025 while (<>) 
2026 {
2027 X    $Buffer .= $_ if (! /^From /);
2028 X    $Subject = $1 if (/^Subject:\s+(.*)$/);
2029 X    $From = $1 if (/^From:\s+(.*)$/);
2030 X    last if (/^$/);
2031 };
2032 X
2033 # Do not filter the message unless it has a subject and the subject indicates
2034 # it is an NDN
2035 if ($Subject && ($Subject =~ /^returned mail/i))
2036 {
2037 X   # Slurp input by paragraph. Keep track of the last time we saw what
2038 X   # appeared to be NDN text. We keep this.
2039 X   $/ = "\n\n";
2040 X   $* = 1;
2041 X   while (<>)
2042 X   {
2043 X      push (@Paragraphs, $_);
2044 X      $Last_Error_Para = $#Paragraphs 
2045 X        if (/unsent message follows/i || /was not delivered because/);
2046 X   };
2047 X
2048 X   # Now save the NDN text into $Buffer
2049 X   $Buffer .= join ("", @Paragraphs [0..$Last_Error_Para]);
2050 }
2051 X
2052 else
2053 {
2054 X   undef $/;
2055 X   $Buffer .= <>;
2056 };
2057 X
2058 # Send off the (possibly) modified mail
2059 ($Status, $Msg) = &Send_Mail ($Users, "", $Buffer, 0, $opt_v, 1);
2060 die "$Script_Name: $Msg\n" if (! $Status);
2061 SHAR_EOF
2062 chmod 0555 src/postclip ||
2063 echo 'restore of src/postclip failed'
2064 Wc_c="`wc -c < 'src/postclip'`"
2065 test 1836 -eq "$Wc_c" ||
2066         echo 'src/postclip: original size 1836, current size' "$Wc_c"
2067 fi
2068 exit 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_