开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > Email客户端 > 查看源码
mmuegel
资源名称：sendmail.8.10.0.Beta10.tar.Z　[点击查看]
上传用户：xu_441
上传日期：2007-01-04
资源大小：1640k
文件大小：67k
源码类别：

Email客户端

开发平台：

Unix_Linux

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     
  13. OK. Here is a new shell archive.
  15. Cheers,
  16. -Mike
  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: $Subjectn";
  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_Extran$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, sorryn";
  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: $firstn";
  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/nn/n$BLANK_TAGn/g;
  1335. X   $String =~ s/^n/$BLANK_TAGn/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 fBcqueuefR
  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-abdmsfR ] [ fB-qfR fIqueue-dirfI ] [ fB-tfR fItimefR ] 
  1491. [ fB-ufR fIusersfR ] [ fB-wfR fIwidthfR ]
  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-afR 14
  1498. Report on all messages in the queue. This is equivalent to saying fB-tfR 0s.
  1499. You may like this command so much that you use it as a replacement for
  1500. fBmqueuefR. For example:
  1501. .sp 1
  1502. .RS
  1503. .RS
  1504. fBalias mqueue cqueue -afR
  1505. .RE
  1506. .RE
  1507. .IP fB-bfR 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-dfR
  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-mfR 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 fBonlyfR
  1533. mailed if *(mp found something wrong.
  1534. .IP "fB-qfR fIqueue-dirfI"
  1535. The sendmail mail queue directory. Default is fB/usr/spool/mqueuefR or
  1536. some other site configured value.
  1537. .IP "fB-tfR fItimefR"
  1538. List messages that have been in the queue longer than
  1539. fItimefR. 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-sfR 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-ufR fIusersfR"
  1567. Specify list of users to send a mail report to other than
  1568. the invoker. This option is only valid when fB-mfR has been
  1569. specified. Multiple recipients may be separated by spaces.
  1570. .IP "fB-wfR fIwidthfR"
  1571. Specify the page width to which the output should tailored. fIwidthfR
  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. fIwidthfR.
  1575. .SH EXAMPLES
  1576. .nf
  1577. % fBdatefR
  1578. Tue Jan 19 12:07:20 CST 1993
  1579. X
  1580. % fBcqueue -t 21h45m -w 70fR
  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 GuidefR.
  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 fBpostclipfR
  1662. .SH NAME
  1663. *(mp - send only the headers to Postmaster
  1664. .SH SYNOPSIS
  1665. *(mp [ fB-vfR ] [ fItofR ... ]
  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. fBsendmailfR 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 fBsendmailfR by modifying the Postmaster alias.
  1676. If you use IDA fBsendmailfR 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-vfR
  1689. Be verbose about delivery. Probably only useful when debugging *(mp.
  1690. .IP fItofR
  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 -mn" if (($opt_u) && (! $opt_m));
  1781. die "${Script_Name}: -a not valid with -t optionn" 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}: $Msgn" 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: $Msgn" 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:nn   " . 
  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:nn   " . 
  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: $Msgn";
  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 authorn";
  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   $/ = "nn";
  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: $Msgn" 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
  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. +----------------------------------------------------------------------------+
  2078.       "I'm disturbed, I'm depressed, I'm inadequate -- I've got it all!"
  2079.   -- George from _Seinfeld_