Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Annotate
Revision Log

mmuegel @ 12554

Visit:

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
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_

Note: See TracBrowser for help on using the repository browser.

Context Navigation

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

Download in other formats: