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