mmuegel

早期freebsd实现

From: "Michael S. Muegel" <[e-mail]>
Message-Id: <[e-mail]>
Subject: Re: contributed software
To: [e-mail] (Eric Allman)
Date: Wed, 28 Jul 1993 03:18:02 -0500 (CDT)
In-Reply-To: <[e-mail]> from "Eric Allman" at Jul 22, 93 11:53:47 am
X-Mailer: ELM [version 2.4 PL22]
Mime-Version: 1.0
Content-Type: text/plain; charset=US-ASCII
Content-Transfer-Encoding: 7bit
Content-Length: 69132     

OK. Here is a new shell archive.

Cheers,
-Mike

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 07/28/1993 08:13 UTC by [e-mail] (Michael S. Muegel)
# Source directory /home/ustart/NeXT/src/mail-tools/dist/foo
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   4308 -r--r--r-- README
#  12339 -r--r--r-- libs/date.pl
#   3198 -r--r--r-- libs/elapsed.pl
#   4356 -r--r--r-- libs/mail.pl
#   6908 -r--r--r-- libs/mqueue.pl
#   7024 -r--r--r-- libs/newgetopts.pl
#   4687 -r--r--r-- libs/strings1.pl
#   1609 -r--r--r-- libs/timespec.pl
#   5212 -r--r--r-- man/cqueue.1
#   2078 -r--r--r-- man/postclip.1
#   6647 -r-xr-xr-x src/cqueue
#   1836 -r-xr-xr-x src/postclip
#
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
	echo 'x - skipping README (File already exists)'
else
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
-------------------------------------------------------------------------------
Document Revision Control Information:
X   mmuegel
X   /usr/local/ustart/src/mail-tools/dist/foo/README,v
X   1.1 of 1993/07/28 08:12:53
-------------------------------------------------------------------------------
X
1. Introduction
---------------
X
These tools may be of use to those sites using sendmail. Both are written in
Perl. Our site, Mot.COM, receives a ton of mail being a top-level domain
gateway. We have over 24 domains under us. Needless to say, we must have
a robust mail system or my head, and others, would be on the chopping block.
X
2. Description
--------------
X
The first tool, cqueue, checks the sendmail queue for problems. We use
it to flag problems with subdomain mail servers (and even our own servers
once in a while ;-). We run it via a cron job every hour during the day.
You may find this too frequent, however. 
X
The other program, postclip, is used to "filter" non-deliverable NDNs that
get sent to our Postmaster account now and then. This ensures privacy of
e-mail and helps avoid disk problems from huge NDNs. It is different than
a brute force "just keep the header" approach because it tries hard to keep
other parts of the message that look like non-delivery information.
X
Both have been used for some time at our site with no problems. Everything 
you need should be in this distribution: source, manual pages, and support 
libs. See the manual pages for a complete description of each tool.
X
3. Installation
---------------
X
No fancy Makefile simply because these tools are all under a large
hierarchy at my site. Installation should be a snap, however. Install
the nroff(1) man(5) manual pages from the man subdirectory to the
appropriate directory on your system. This might be something like
/usr/local/man/man1.
X
Next, install all of the Perl libraries located in the lib subdirectory
to your Perl library area. /usr/local/lib/perl is a good bet. The person
who installed Perl at your site will be able to tell you for sure. 
X
Finally, you need to install the programs. Note that cqueue wants to
run setuid root by default. This is because the sendmail queue is normally
only readable by root or some special group. In order to let any user
run this suidperl is used. suidperl allows a Perl program to run with the
privileges of another user. 
X
You will have to edit both the cqueue and postclip programs to change
the #! line at the top of each. Just change the pathname to whatever is
appropriate on your system. Note that Larry Wall's fixin program from
the Camel book can also be used to do this. It is very handy. It changes
#! lines by looking at your PATH.
X
If you do not have suidperl on your system change the #! line in cqueue
to reference perl instead of suidperl.
X
You may also wish to change some constants in cqueue. $DEF_QUEUE should be
changed to your queue directory if it is not /usr/spool/mqueue. $DEF_TIME
could be changed easy enough also. It is the time spec for the time duration
after which a mail message will be reported on if the -a option has not been
specified. See the manual page for more information and the format of this
constant (same as the -t argument). Then again, neither of these has to
be changed. Command line options are there to override their default
values.
X
After you have edited the programs as necessary, all that remains is to
install them to some executable directory. Install postclip mode 555
and cqueue mode 4555 with owner root (if using suidperl) or mode 555
(if not using suidperl).
X
4. Gripes, Comments, Etc
------------------------
X
If you start using either of these let me know. I have other mail tools I
will likely post in the future if these prove useful. Also, if you think
something is just plain dumb/wrong/stupid let me know!
X
Cheers,
-Mike
X
--
+----------------------------------------------------------------------------+
| Michael S. Muegel                    | Internet E-Mail:    [e-mail] |
| UNIX Applications Startup Group      | Moto Dist E-Mail:   X10090          |
| Corporate Information Office         | Voice:              [phone]  |
| Motorola                             | Fax:                [phone]  |
+----------------------------------------------------------------------------+
SHAR_EOF
chmod 0444 README ||
echo 'restore of README failed'
Wc_c="`wc -c < 'README'`"
test 4308 -eq "$Wc_c" ||
	echo 'README: original size 4308, current size' "$Wc_c"
fi
# ============= libs/date.pl ==============
if test ! -d 'libs'; then
    echo 'x - creating directory libs'
    mkdir 'libs'
fi
if test -f 'libs/date.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping libs/date.pl (File already exists)'
else
echo 'x - extracting libs/date.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'libs/date.pl' &&
;#
;# Name
;#	date.pl - Perl emulation of (the output side of) date(1)
;#
;# Synopsis
;#	require "date.pl";
;#	$Date = &date(time);
;#	$Date = &date(time, $format);
;#
;# Description
;#	This package implements the output formatting functions of date(1) in
;#	Perl.  The format options are based on those supported by Ultrix 4.0
;#	plus a couple of additions from SunOS 4.1.1 and elsewhere:
;#
;#		%a		abbreviated weekday name - Sun to Sat
;#		%A		full weekday name - Sunday to Saturday
;#		%b		abbreviated month name - Jan to Dec
;#		%B		full month name - January to December
;#		%c		date and time in local format [+]
;#		%C		date and time in long local format [+]
;#		%d		day of month - 01 to 31
;#		%D		date as mm/dd/yy
;#		%e		day of month (space padded) - ` 1' to `31'
;#		%E		day of month (with suffix: 1st, 2nd, 3rd...)
;#		%f		month of year (space padded) - ` 1' to `12'
;#		%h		abbreviated month name - Jan to Dec
;#		%H		hour - 00 to 23
;#		%i		hour (space padded) - ` 1' to `12'
;#		%I		hour - 01 to 12
;#		%j		day of the year (Julian date) - 001 to 366
;#		%k		hour (space padded) - ` 0' to `23'
;#		%l		date in ls(1) format
;#		%m		month of year - 01 to 12
;#		%M		minute - 00 to 59
;#		%n		insert a newline character
;#		%p		ante-meridiem or post-meridiem indicator (AM or PM)
;#		%r		time in AM/PM notation
;#		%R		time as HH:MM
;#		%S		second - 00 to 59
;#		%t		insert a tab character
;#		%T		time as HH:MM:SS
;#		%u		date/time in date(1) required format
;#		%U		week number, Sunday as first day of week - 00 to 53
;#		%V		date-time in SysV touch format (mmddHHMMyy)
;#		%w		day of week - 0 (Sunday) to 6
;#		%W		week number, Monday as first day of week - 00 to 53
;#		%x		date in local format [+]
;#		%X		time in local format [+]
;#		%y		last 2 digits of year - 00 to 99
;#		%Y		all 4 digits of year ~ 1700 to 2000 odd ?
;#		%z		time zone from TZ environment variable w/ a trailing space
;#		%Z		time zone from TZ environment variable
;#		%%		insert a `%' character
;#		%+		insert a `+' character
;#
;#	[+]:  These may need adjustment to fit local conventions, see below.
;#
;#	For the sake of compatibility, a leading `+' in the format
;#	specificaiton is removed if present.
;#
;# Remarks
;#	This is version 3.4 of date.pl
;#
;#	An extension of `ctime.pl' by Waldemar Kebsch ([e-mail]),
;#	as modified by Marion Hakanson ([e-mail]).
;#
;#  Unlike date(1), unknown format tags are silently replaced by "".
;#
;#  defaultTZ is a blatant hack, but I wanted to be able to get date(1)
;#	like behaviour by default and there does'nt seem to be an easy (read
;#	portable) way to get the local TZ name back...
;#
;#	For a cheap date, try...
;#
;#		#!/usr/local/bin/perl
;#		require "date.pl";
;#		exit print (&date(time, shift @ARGV) . "\n") ? 0 : 1;
;#
;#	This package is redistributable under the same terms as apply to
;#	the Perl 4.0 release.  See the COPYING file in your Perl kit for
;#	more information.
;#
;#	Please send any bug reports or comments to [e-mail]
;#
;# Modification History
;#	Nmemonic	Version	Date		Who
;#
;#	NONE		1.0		02feb91		Terry McGonigal ([e-mail])
;#		Created from ctime.pl
;#
;#	NONE		2.0		07feb91		tmcgonigal
;#		Added some of Marion Hakanson ([e-mail])'s ctime.pl
;#		TZ handling changes.
;#
;#	NONE		2.1		09feb91		tmcgonigal
;#		Corrected week number calculations.
;#
;#	NONE		2.2		21oct91		tmcgonigal
;#		Added ls(1) date format, `%l'.
;#
;#	NONE		2.3		06nov91		tmcgonigal
;#		Added SysV touch(1) date-time format, `%V' (pretty thin as
;#		mnemonics go, I know, but `t' and `T' were both gone already!)
;#
;#	NONE		2.4		05jan92		tmcgonigal
;#		Corrected slight (cosmetic) problem with %V replacment string
;#
;#	NONE		3.0		09jul92		tmcgonigal
;#		Fixed a couple of problems with &ls as pointed out by
;#		Thomas Richter ([e-mail]), thanks Thomas!
;#		Also added a couple of SunOS 4.1.1 strftime-ish formats, %i and %k
;#		for space padded hours (` 1' to `12' and ` 0' to `23' respectivly),
;#		and %C for locale long date/time format.  Changed &ampmH to take a
;#		pad char parameter to make to evaled code for %i and %k simpler. 
;#		Added %E for suffixed day-of-month (ie 1st, 3rd, 4th etc).
;#
;#	NONE		3.1		16jul92		tmcgonigal
;#		Added `%u' format to generate date/time in date(1) required
;#		format (ie '%y%m%d%H%M.%S').
;#
;#	NONE		3.2		23jan93		tmcgonigal
;#		Added `%f' format to generate space padded month numbers, added
;#		`%E' to the header comments, it seems to have been left out (and
;#		I'm sure I wanted to use it at some point in the past...).
;#
;#	NONE		3.3		03feb93		tmcgonigal
;#		Corrected some problems with AM/PM handling pointed out by
;#		Michael S. Muegel ([e-mail]).  Thanks Michael, I hope
;#		this is the behaviour you were looking for, it seems more
;#		correct to me...
;#
;#	NONE		3.4		26jul93		tmcgonigal
;#		Incorporated some fixes provided by DaviD W. Sanderson
;#		([e-mail]): February was spelled incorrectly and
;#		&wkno() was always using the current year while calculating
;#		week numbers, regardless of year implied by the time value
;#		passed to &date().  DaviD also contributed an improved &date()
;#		test script, thanks DaviD, I appreciate the effort.  Finally,
;#		changed my mailling address from @gvc.com to @gallium.com
;#		to reflect, well, my new address!
;#
;# SccsId = "%W% %E%"
;#
require 'timelocal.pl';
package date;
X
# Months of the year
@MoY = ('January',	'February',	'March',	'April',	'May',		'June',
X		'July',		'August',	'September','October',	'November', 'December');
X
# days of the week
@DoW = ('Sunday',	'Monday',	'Tuesday',	'Wednesday',
X		'Thursday',	'Friday',	'Saturday');
X
# CUSTOMIZE - defaults
$defaultTZ = 'CST';						# time zone (hack!)
$defaultFMT = '%a %h %e %T %z%Y';		# format (ala date(1))
X
# CUSTOMIZE - `local' formats
$locTF = '%T';							# time (as HH:MM:SS)
$locDF = '%D';							# date (as mm/dd/yy)
$locDTF = '%a %b %d %T %Y';				# date/time (as dow mon dd HH:MM:SS yyyy)
$locLDTF = '%i:%M:%S %p %A %B %E %Y';	# long date/time (as HH:MM:SS a/p day month dom yyyy)
X
# Time zone info
$TZ;									# wkno needs this info too
X
# define the known format tags as associative keys with their associated
# replacement strings as values.  Each replacement string should be
# an eval-able expresion assigning a value to $rep.  These expressions are
# eval-ed, then the value of $rep is substituted into the supplied
# format (if any).
%Tags = ( '%a', q|($rep = $DoW[$wday])=~ s/^(...).*/\1/|,	# abbr. weekday name - Sun to Sat
X		  '%A', q|$rep = $DoW[$wday]|,						# full weekday name - Sunday to Saturday
X		  '%b', q|($rep = $MoY[$mon]) =~ s/^(...).*/\1/|,	# abbr. month name - Jan to Dec
X		  '%B', q|$rep = $MoY[$mon]|,						# full month name - January to December
X		  '%c', q|$rep = $locDTF; 1|,						# date/time in local format
X		  '%C', q|$rep = $locLDTF; 1|,						# date/time in local long format
X		  '%d',	q|$rep = &date'pad($mday, 2, "0")|,			# day of month - 01 to 31
X		  '%D',	q|$rep = '%m/%d/%y'|,						# date as mm/dd/yy
X		  '%e', q|$rep = &date'pad($mday, 2, " ")|,			# day of month (space padded) ` 1' to `31'
X		  '%E', q|$rep = &date'dsuf($mday)|,				# day of month (w/suffix) `1st' to `31st'
X		  '%f', q|$rep = &date'pad($mon+1, 2, " ")|,		# month of year (space padded) ` 1' to `12'
X		  '%h', q|$rep = '%b'|,								# abbr. month name (same as %b)
X		  '%H',	q|$rep = &date'pad($hour, 2, "0")|,			# hour - 00 to 23
X		  '%i', q|$rep = &date'ampmH($hour, " ")|,			# hour (space padded ` 1' to `12'
X		  '%I', q|$rep = &date'ampmH($hour, "0")|,			# hour - 01 to 12
X		  '%j', q|$rep = &date'pad($yday+1, 3, "0")|,		# Julian date 001 - 366
X		  '%k', q|$rep = &date'pad($hour, 2, " ")|,			# hour (space padded) ` 0' to `23'
X		  '%l', q|$rep = '%b %d ' . &date'ls($year)|,		# ls(1) style date
X		  '%m',	q|$rep = &date'pad($mon+1, 2, "0")|,		# month of year - 01 to 12
X		  '%M', q|$rep = &date'pad($min, 2, "0")|,			# minute - 00 to 59
X		  '%n',	q|$rep = "\n"|,								# insert a newline
X		  '%p', q|$rep = &date'ampmD($hour)|,				# insert `AM' or `PM'
X		  '%r', q|$rep = '%I:%M:%S %p'|,					# time in AM/PM notation
X		  '%R', q|$rep = '%H:%M'|,							# time as HH:MM
X		  '%S', q|$rep = &date'pad($sec, 2, "0")|,			# second - 00 to 59
X		  '%t',	q|$rep = "\t"|,								# insert a tab
X		  '%T',	q|$rep = '%H:%M:%S'|,						# time as HH:MM:SS
X		  '%u', q|$rep = '%y%m%d%H%M.%S'|,					# daaate/time in date(1) required format
X		  '%U',	q|$rep = &date'wkno($year, $yday, 0)|,		# week number (weeks start on Sun) - 00 to 53
X		  '%V', q|$rep = '%m%d%H%M%y'|,						# SysV touch(1) date-time format (mmddHHMMyy)
X		  '%w', q|$rep = $wday; 1|,							# day of week - Sunday = 0
X		  '%W', q|$rep = &date'wkno($year, $yday, 1)|,		# week number (weeks start on Mon) - 00 to 53
X		  '%x', q|$rep = $locDF; 1|,						# date in local format
X		  '%X', q|$rep = $locTF; 1|,						# time in local format
X		  '%y', q|($rep = $year) =~ s/..(..)/\1/|,			# last 2 digits of year - 00 to 99
X		  '%Y', q|$rep = "$year"; 1|,						# full year ~ 1700 to 2000 odd
X		  '%z', q|$rep = $TZ eq "" ? "" : "$TZ "|,			# time zone from TZ env var (w/trail. space)
X		  '%Z', q|$rep = $TZ; 1|,							# time zone from TZ env. var.
X		  '%%', q|$rep = '%'; $adv=1|,						# insert a `%'
X		  '%+', q|$rep = '+'|								# insert a `+'
);
X	
sub main'date {
X	local($time, $format) = @_;
X	local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
X	local($pos, $tag, $rep, $adv) = (0, "", "", 0);
X
X	# default to date/ctime format or strip leading `+'...
X	if ($format eq "") {
X		$format = $defaultFMT;
X	} elsif ($format =~ /^\+/) {
X		$format = $';
X	}
X
X	# Use local time if can't find a TZ in the environment
X	$TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ;
X	($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
X		&gettime ($TZ, $time);
X
X	# Hack to deal with 'PST8PDT' format of TZ
X	# Note that this can't deal with all the esoteric forms, but it
X	# does recognize the most common: [:]STDoff[DST[off][,rule]]