news.utdallas.edu!wupost!darwin.sura.net!sgiblab!munnari.oz.au!metro!usage!news Mon Feb 22 07:54:35 CST 1993

news.utdallas.edu!wupost!darwin.sura.net!sgiblab!munnari.oz.au!metro!usage!news Mon Feb 22 07:54:35 CST 1993
Article: 1071 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1071
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!darwin.sura.net!sgiblab!munnari.oz.au!metro!usage!news
From: [email protected]
#Subject: Re: Mail Filter
Message-ID: <cameron-930218135036-1-01024@fuligin>
To: [email protected] (Matthew B Landry)
Followup-To: comp.lang.perl
Sender: [email protected]
Nntp-Posting-Host: fuligin.spectrum.cs.unsw.oz.au
Reply-To: [email protected]
Organization: CS&E Computing Facility, Uni Of NSW, Oz
References: <[email protected]>
Errors-To: [email protected]
Date: Thu, 18 Feb 1993 02:51:09 GMT
Return-Receipt-To: [email protected]
Lines: 1118

[email protected] (Matthew B Landry) writes:
| I'm looking for a program to sort email. Specifically, I want
| something that can take all the mail from two specific addresses (digests,
| actually), and save it into two corresponding files, leaving the rest of
| my mail in the system box.
| I could have the program run regularly from cron to scan the
| mailbox, so a .forward shouldn't be necessary.
| I'm posting this here because I've heard that perl would be best
| for this sort of thing. If there's anyone who has a program that can be
| adapted for this (or who can tell me how to build my own), I'd greatly
| appreciate it.

I use the filemail command appended below, which allows recurse rule based
filing. Filemail expects a single item on stdin, so I run the mail file through
splitmail (appended) to do the job.

Thus:
mv $MAIL /tmp/split$$ && \
splitmail -m maildir /tmp/split$$ && \
rm /tmp/split$$

I haven't used splitmail for a long time, so test it before use. I use filemail
all the time; I append the .file ruleset in my inbox so you can see how it's
used. [Types...] There are some library routines too, appended, take what you
need.
- Cameron Simpson
[email protected], DoD#743
--
I don't waste my money; I invest it in ventures with high negative returns.

#/bin/sh

sed 's/^X//' > filemail <<'EOF-/home/cs/spectrum/fuligin/1/cameron/bin/filemail'
X#!/usr/local/bin/perl
X#
X# Usage: filemail [-a announce] [mailbox] <email
X# -a announce Where to announce arrival, otherwise $CONSOLE,
X# otherwise /dev/console.
X# mailbox Specify mailbox, otherwise $MAILBOX,
X# otherwise $HOME/.incoming-mail.
X#
X
X($cmd=$0) =~ s:.*/::;
X
X$usage="Usage: $cmd [-a announce] [mailbox]\n";
X
Xrequire 'libcs.pl';
Xrequire 'cs/env/mail.pl';
Xrequire 'cs/rfc822.pl';
Xrequire 'errno.ph';
X
Xdefined($MAILBOX) || ($ENV{'MAILBOX'}=$MAILBOX="$HOME/.incoming-mail");
X
X$badopts=0;
Xwhile ($#ARGV >= $[ && $ARGV[$[] =~ /^-/)
X { $_=shift @ARGV;
X if ($_ eq '-a')
X { $ENV{'CONSOLE'}=$CONSOLE=shift @ARGV;
X }
X else
X { print STDERR "$cmd: bad option \"$_\"\n";
X $badopts=1;
X }
X }
X
Xif (defined($inbox=shift))
X { $ENV{'MAILBOX'}=$MAILBOX=$inbox;
X }
X
Xif ($#ARGV >= $[)
X { print STDERR "$cmd: extra arguments: @ARGV\n";
X $badopts=1;
X }
X
Xdie $usage if $badopts;
X
X# snarf stdin first up
X@INPUT=<STDIN>;
Xclose(STDIN);
X
Xdie "$cmd: no input!\n" if $#INPUT < 0;
X
Xopen(STDOUT,">>$CONSOLE") || die "can't open $CONSOLE: $!\n";
Xopen(STDERR,">&STDOUT") || die "can't dup STDOUT to STDERR\n";
X
Xundef $from_, $from, $From, $to, $subject, %hdrs;
X$INPUT[0] =~ s/^From\s/From_: /;
X
X@hdrs=(); undef %hdrs;
X@INPUT=&add822lines(@INPUT);
Xwhile ($#INPUT >= $[ && $INPUT[$#INPUT] eq "\n")
X { pop(@INPUT);
X }
X
X$subject=$hdrs{'subject'};
X$F_HAS_SUBJECT=length($subject);
X$from='';
X$from_='';
X
X$From=$hdrs{'from'};
X@From=&getaddrs($From);
Xwhile ($#From >= $[)
X { local($pre,$addr,$post);
X
X $pre=shift @From;
X $addr=shift @From;
X $post=shift @From;
X
X if ($addr =~ /^<([^>\s]*)>/)
X { $addr=$1;
X }
X
X next if $addr eq $USER || $addr eq $EMAIL;
X
X $from=$addr;
X last;
X }
X
X$to=$hdrs{'to'};
X$cc=$hdrs{'cc'};
X$newsgroups=$hdrs{'newsgroups'};
X
Xif (length($hdrs{'from-'}))
X { $from_=$hdrs{'from-'};
X }
X
Xif (!length($subject))
X { $subject='NO SUBJECT SUPPLIED BY SENDER';
X unshift(@hdrs,"Subject: $subject");
X $hdrs{'subject'}=$subject;
X }
X
X$legend=(length($from)
X ? "From: $From"
X : (length($from_) && ($from_ ne $USER && $from_ ne $EMAIL
X || !length($to))
X ? "From_ $from_"
X : (length($to)
X ? "To: $to"
X : (length($newsgroups)
X ? "Newsgroups: $newsgroups"
X : "No source or destination."
X )
X )
X )
X );
X
Xlength($subject) && ($legend.="; $subject");
Xlength($from) || ($from=$from_);
X
X($reply_to=$hdrs{'reply-to'}) =~ s/^\s+//; $reply_to =~ s/\s+$//;
Xlength($reply_to) || ($reply_to=$from);
X
X($errors_to=$hdrs{'errors-to'}) =~ s/^\s+//; $errors_to =~ s/\s+$//;
Xlength($errors_to) || ($errors_to=$reply_to);
X
X($sec,$min,$hr,$mday,$mon,$yr,$wday,@etc)=gmtime(time);
X
Xundef %FILED; # places we have already filed this item
X@MAILBOXES=($MAILBOX); # places to try filing this item
X@INNAMES=(''); # prefix for name
X@FILES=(); # originals, used for links
X$xit=0;
X
XMAILBOX:
X while (defined($MAILBOX=shift @MAILBOXES))
X { { local($filed,$oMAILBOX);
X
X $INNAME=shift @INNAMES;
X
X # loop until the item is filed or we lack a .file file
X
X # Code to file incoming mail.
X # When called we have
X # @INPUT All the lines in the mail item.
X # We are guarrenteed a From_ line as $INPUT[0].
X # %hdrs Bodies of header lines keyed by downcased names.
X # @hdrs Complete headers.
X # $legend "From: who; subject"
X # $MAILBOX The normal inbox directory.
X # $HOME Home directory.
X # $USER User name.
X # $subject, $s Subject field.
X # $from, $f From: or From_.
X # $reply_to Reply-To: or $from.
X # $errors_to Errors-To: or $reply_to.
X # $to To:
X # $cc CC:
X #
X # If this message was successfully filed then $filed will
X # be true at the end.
X #
X # It is possible to arrange that filemail files the mail
X # in another place by changing $MAILBOX. If you wish a specific
X # name for the filed item, set $INNAME; otherwise the
X # pick-a-number method used for ordinary mail will be used.
X #
X
X DOTFILE:
X while (-f "$MAILBOX/.file") # implies -d "$MAILBOX/."
X { $oMAILBOX=$MAILBOX;
X $filed=0;
X { local($s,$f,$to,$cc)
X =($hdrs{'subject'},$hdrs{'from'},$hdrs{'to'},$hdrs{'cc'});
X local($_)=$s;
X
X do "$MAILBOX/.file";
X warn $@ if $@;
X }
X
X next MAILBOX if $filed;
X last DOTFILE if $oMAILBOX eq $MAILBOX;
X }
X }
X
X # it should be a file or a directory
X if (! -f $MAILBOX && !&mkdir($MAILBOX))
X { &legend("can't make directory $MAILBOX");
X $xit=1;
X next MAILBOX;
X }
X
X if (-d $MAILBOX)
X { local($filed);
X
X $filed=&fileitem($MAILBOX,$INNAME);
X
X if (!defined($filed))
X { &legend("can't save in $MAILBOX/$INNAME\n");
X $xit=1;
X }
X }
X else
X { if (!open(MAILBOX,">>$MAILBOX"))
X { &legend("can't append to $MAILBOX: $!");
X if (!open(MAILBOX,">>$MAILBOX.$$"))
X { &legend("can't append to $MAILBOX.$$: $!");
X }
X }
X
X &writeitem(MAILBOX);
X close(MAILBOX);
X &legend(&shorten($MAILBOX)." $legend");
X }
X }
X
Xexit $xit;
X######################
X
X# On failure $! is useful.
Xsub mklink # (fname) -> ok
X { local($fname)=@_;
X
X for (@FILES)
X { if (link($_,$fname))
X { &legend(&shorten($_)." <-> ".&shorten($fname));
X return 1;
X }
X
X last if ($! != &EXDEV);
X }
X
X local($tmp);
X
X # stash @INPUT
X $tmp=&dirname($fname)."/.$cmd-$$";
X
X if (!open(TMP,">> $tmp\0"))
X { &legend("can't append to $tmp: $!");
X return 0;
X }
X
X &writeitem(TMP);
X close(TMP);
X
X if (link($tmp,$fname))
X { unlink($tmp) || &legend("unlink($tmp): $!");
X push(@FILES,$fname);
X &legend(&shorten($fname).": $legend");
X return 1;
X }
X
X return 0;
X }
X
Xsub writeitem # ($FILE)
X { local($FILE)=@_;
X
X for (@hdrs)
X { print $FILE $_, "\n";
X }
X
X print $FILE "\n";
X for (@INPUT)
X { print $FILE $_;
X }
X }
X
X# file an item in directory $MAILBOX, with prefix $INNAME.
X#
Xsub fileitem # ($MAILBOX,$INNAME) -> basename-of-filed-item
X { local($MAILBOX,$INNAME)=@_;
X local($filed);
X
X # attempt link to unadorned INNAME
X if (length($INNAME) && &mklink("$MAILBOX/$INNAME"))
X { return "$MAILBOX/$INNAME";
X }
X
X # not linked to simple name, try INNAME_n
X local($n)=1;
X
X # walk directory, picking $n > any already present
X if (!opendir(MAILBOX,$MAILBOX))
X { &legend("warning: can't opendir($MAILBOX): $!\n");
X return undef;
X }
X
X local(@dir)=readdir(MAILBOX);
X closedir(MAILBOX);
X
X local($ptn)=$INNAME;
X
X $ptn =~ s,\W,\\$&,g;
X eval
X ' for (grep(/^'.$ptn.'/,@dir))
X { s/^'.$ptn.'//;
X /^\d+$/ || next;
X
X if ($& >= $n)
X { $n=$&+1;
X }
X }
X ';
X
X local($ok)=1;
X
X while (!&mklink("$MAILBOX/$INNAME$n"))
X { $ok=0;
X last if $! != &EEXIST;
X $ok=1;
X $n++;
X }
X
X if ($ok)
X { return "$MAILBOX/$INNAME$n";
X }
X
X return undef;
X }
X
X# forward a mail item and say so
Xsub forw # (subj,who,@WHAT)
X { local($subj)=shift;
X local($who)=shift;
X
X $filed=&forward($who,@_);
X $filed && &legend("==> $who: $subj");
X }
X
Xsub forward
X { local($to,@INPUT)=@_;
X local($shifted,@fields,@bodies,%ndx);
X local($[)=1;
X local($_);
X local($i);
X
X die "$cmd: &forward($to): no input!\n" if $#INPUT < 1;
X
X $shifted=shift(@INPUT) if $INPUT[1] =~ '^From ';
X
X die "$cmd: &forward($to): short input!\n" if $#INPUT < 1;
X die "$cmd: &forward($to): malformed input\n" if $INPUT[1] =~ /^\s/;
X
X while (defined($_=shift(@INPUT)))
X { if (/^[ \t]/)
X { @bodies[$#bodies].=$_;
X }
X elsif (/^(\S*):[ \t]*/)
X { local($hdr)=$1;
X
X push(@fields,$hdr);
X push(@bodies,$');
X $hdr =~ tr/A-Z/a-z/;
X $ndx{$hdr}=$#fields;
X }
X else
X # not a header line
X { last;
X }
X }
X
X if (defined($_))
X { unshift(@INPUT,$_);
X }
X
X # tidy up Sender: line
X if (($i=$ndx{'sender'}) >= 1)
X { $fields[$i]="Original-".$fields[$i];
X delete $ndx{'sender'};
X $ndx{'original-sender'}=$i;
X }
X
X push(@fields,'Sender');
X push(@bodies,"$USER\n");
X $ndx{'sender'}=$#fields;
X
X # create Reply-To: if missing
X if (($i=$ndx{'reply-to'}) < 1
X && ($j=$ndx{'from'}) >= 1)
X { push(@fields,'Reply-To');
X push(@bodies,$bodies[$j]);
X $ndx{'reply-to'}=$#fields;
X }
X
X while (defined($_=pop(@fields)))
X { unshift(@INPUT,$_.': '.pop(@bodies));
X }
X
X unshift(@INPUT,$shifted) if defined($shifted);
X
X &sendmail($to,@INPUT);
X }
X
Xsub sendmail # ($to,@INPUT) -> success
X { local($to)=shift;
X
X if (open(SENDMAIL,"|sendmail -oi $to"))
X { if ($_[0] =~ /^From /)
X { shift;
X }
X
X for (@_)
X { print SENDMAIL $_;
X }
X
X close(SENDMAIL);
X return 1;
X }
X else
X { &legend("can't pipe to sendmail: $!");
X }
X
X 0;
X }
X
Xsub fileas # (inbox,inname) -> void
X { local($inbox,$inname)=@_;
X
X push(@MAILBOXES,"$inbox");
X push(@INNAMES,"$inname");
X }
X
Xsub shorten # (pathname) -> indicator
X { local($_)=@_;
X
X if (length($_) > length($HOME)
X && substr($_,$[,length($HOME)) eq $HOME)
X { $_=substr($_,$[+length($HOME));
X s,^/+,,;
X }
X
X s,^private/+,,;
X s,^etc/mail/+,+,;
X
X $_;
X }
X
Xsub legend # (message) -> void
X { local($_)=@_;
X
X if ($didlegend)
X { print " " x $didlegend;
X }
X else
X { local($str)=&datestr(time,1).": ";
X print $str;
X $didlegend=length($str);
X }
X
X s/\n+$//;
X printf("%.160s\n",$_);
X }
EOF-/home/cs/spectrum/fuligin/1/cameron/bin/filemail

sed 's/^X//' > splitmail <<'EOF-/home/cs/spectrum/fuligin/1/cameron/bin/splitmail'
X#!/usr/local/bin/perl
X#
X# Split up an ordinary mailbox (From_ separated).
X# Uses filemail to deposit the mail, so the .file refiler works.
X# - Cameron Simpson, February 1992
X#
X
X($cmd=$0) =~ s,.*/,,;
X$usage="Usage: $cmd [-m mailbox] [mailfiles...]
X -m mailbox Specify directory into which to place mail.
X";
X
X# option defaults
Xif (!defined($ENV{'MAILBOX'}))
X { $mailbox='.';
X }
Xelse
X{ $mailbox=$ENV{'MAILBOX'};
X}
X
X# option parsing
Xif ($#ARGV > 0 && $ARGV[0] eq '-m')
X { shift;
X $mailbox=shift;
X }
X
X# export to filemail
X$ENV{'MAILBOX'}=$mailbox;
X
X$xit=0;
Xif ($#ARGV < 0)
X { &splitmail('STDIN','stdin');
X }
Xelse
X{ for (@ARGV)
X { if (!open(IN,"< $_\0"))
X { print STDERR "$cmd: can't open $_: $!\n";
X $xit=1;
X next;
X }
X
X &splitmail('IN',$_);
X close(IN);
X }
X}
X
Xexit $xit;
X
Xsub splitmail # (STREAM,fname)
X { local($F,$f)=@_;
X local($hot);
X
X $hot=0; # is our pipe hot?
X while (<$F>)
X { if (/^From /o)
X { if ($hot)
X { close(PIPE); # Phew!
X }
X
X if (open(PIPE,"|filemail"))
X { $hot=1;
X }
X else
X { print STDERR "$cmd: can't pipe to filemail ($!)\n";
X $hot=0;
X $xit=1;
X }
X }
X
X if ($hot)
X { print PIPE $_;
X }
X else
X { print STDERR "$cmd: discarding: $_";
X $xit=1;
X }
X }
X
X if ($hot)
X { close(PIPE);
X }
X }
EOF-/home/cs/spectrum/fuligin/1/cameron/bin/splitmail

sed 's/^X//' > dotfile.inbox <<'EOF-/home/cs/spectrum/fuligin/1/cameron/etc/mail/inbox/.file'
X#!/usr/local/bin/perl
X
Xif (!$F_HAS_SUBJECT)
X { &legend("no subject, rejecting message from $f");
X if (!open(M,"| m -S -s 'your message has been rejected' '$errors_to'"))
X { &legend("can't pipe to m: $!");
X }
X else
X { print M <<'X'
XYour message has been rejected because you did not supply a subject line.
XThe rejected message is appended below in case you want to resend it.
XX
X;
X
X if (defined($SIGNATURE)
X && length($SIGNATURE)
X && open(S,"< $SIGNATURE\0"))
X { while (<S>) { print M $_; }
X close(S);
X }
X
X if (open(S,"sig |"))
X { while (<S>) { print M $_; }
X close(S);
X }
X
X print M "\n";
X for (@hdrs)
X { print M $_, "\n";
X }
X
X print M "\n", @INPUT;
X close(M);
X }
X }
X
Xif (/^ACSnet badhandler/)
X { &forw($_,'neilb',@INPUT); # Forward to NeilB.
X }
X# Stuff sent over ACSnet.
Xelsif (/^(Files|".*") from (\w+) at \S+$/)
X { &legend("$s for $to");
X if ($1 eq 'Files')
X { for (@INPUT)
X { next unless /^\s+Mode\s+Size\s+Modify time\s+Name/../^Please use/;
X next if /^Please use/ || /^\s*$/;
X print "\t\t$_";
X }
X }
X else
X { local($fname,$who)=($1,$2);
X
X $fname =~ s/"(.*)"/$1/;
X
X if ($fname eq "$who.acc")
X { system("cd \$HOME/admin/mkacc && getfile -Y '$fname' 2>&1");
X }
X }
X
X $filed=1;
X }
Xelsif ($from eq '[email protected]'
X && $s eq 'I am on vacation at the moment.')
X { &legend("$from is on vacation");
X $files=1;
X }
Xelsif ($to =~ /[email protected]/
X || $cc =~ /[email protected]/)
X { $MAILBOX.='/faces';
X }
Xelsif ($f eq '[email protected] (rec.humor.funny autoreply)')
X { &legend("joke received by rec.humour.funny: $s");
X $filed=1;
X }
Xelsif ($f eq '[email protected]' && $s eq 'Receipt for mail')
X { $filed=1; # swallow these
X }
Xelsif ($from =~ /^(\w+!)*(postmaster|(mailer-)?daemon|mailer-agent|uucp)@/i
X && ($s eq 'Returned mail: Return receipt'
X || $s eq 'Return receipt' || $s eq 'Return Receipt'
X || $s eq 'Delivery report: Return Receipt'
X )
X )
X { &legend("mail acknowledgement from $from");
X $filed=1;
X }
Xelsif (defined($hdrs{'x-msmail-mailclass'})
X && $hdrs{'x-msmail-mailclass'} eq 'IPM.Microsoft Mail.Read Receipt')
X { &legend("$from has read \"$hdrs{'x-msmail-entitled'}\"");
X $filed=1;
X }
Xelsif ($f eq '[email protected]'
X && $s =~ /^archie reply: /
X )
X { $MAILBOX="$ENV{'HOME'}/doc/archives/archie.au";
X }
EOF-/home/cs/spectrum/fuligin/1/cameron/etc/mail/inbox/.file

sed 's/^X//' > dotfile.prog <<'EOF-/usr/local/doc/misc/archives/archie.au/prog/.file'
X#!/usr/local/bin/perl
X#
X# Filing routine for my mail autofiler.
X# We expect output from archie's email `prog' query facility.
X#
X
Xif ($s =~ /^archie reply: prog\s+(.*\S)/)
X { $F="$MAILBOX/$1.Z";
X if (open(UNPROG,"| unprog | compress > '$F'\0"))
X { for (@INPUT)
X { print UNPROG $_;
X }
X
X close(UNPROG);
X $legend="saved as $F";
X $filed=1;
X }
X else
X { print STDERR "$cmd: can't pipe to unprog: $!\n";
X }
X }
EOF-/usr/local/doc/misc/archives/archie.au/prog/.file

sed 's/^X//' > libcs.pl <<'EOF-/home/cs/spectrum/fuligin/1/cameron/etc/pl/libcs.pl'
X#!/usr/local/bin/perl
X#
X# This will be an autoload library at some stage.
X#
X
X# numerical comparitor for sorts
Xsub ncmp
X { $a <=> $b;
X }
X
Xsub min { local($min)=shift;
X for (@_) { ($_ < $min) && ($min=$_); }
X $min;
X }
X
Xsub max { local($max)=shift;
X for (@_) { ($_ > $max) && ($max=$_); }
X $max;
X }
X
Xsub basename # (@pathnames) -> @basenames
X { local(@paths)=@_;
X
X for (@paths)
X { s,/+$,,;
X s,.*/,,;
X length || ($_='.');
X }
X
X return @paths;
X }
X
Xsub dirname # (@pathnames) -> @dirnames
X { local(@paths)=@_;
X local($pfx);
X
X for (@paths)
X { m,^(/?/?)/*,; $pfx=$1; $_=$'; # collect leading slashes
X s,/+$,,; # strip trailing slashes
X s,[^/]+$,,; # strip basename
X s,/+$,,; # strip trailing slashes again
X length($pfx) || ($pfx='./'); # no null paths
X $_=$pfx.$_; # prefix + tail
X }
X
X return @paths;
X }
X
Xsub eval # string -> result
X { print STDERR "eval($_[0])\n";
X eval $_[0];
X }
X
Xsub prt { print STDERR $_[0];
X 1;
X }
Xsub err { &prt($_[0]);
X 0;
X }
X
X# ensure a directory exists
Xsub mkdir # (dir) -> ok
X { local($dir)=@_;
X
X -d $dir
X || (&mkdir(&dirname($dir))
X && (-d $dir
X || mkdir($dir,0777)
X )
X )
X ;
X }
X
Xsub open # (handle,filename,mode) -> ok
X { local($handle,$file,$mode)=@_;
X
X &mkdir(&dirname($file)) && open($handle,"$mode$file");
X }
X
Xsub isatty
X { local($_)=$_[0];
X local($dev,$ino,$mode,@etc);
X
X if (/^\d+$/)
X { if (!open(_FD_ISATTY,"<&$_"))
X { print STDERR "isatty: can't open &$_ ($!)\n";
X return undef;
X }
X ($dev,$ino,$mode,@etc)=stat _FD_ISATTY;
X # no close since it may eat the fd
X }
X elsif (/^[A-Z_]+$/)
X { ($dev,$ino,$mode,@etc)=eval "stat $_";
X }
X else
X { ($dev,$ino,$mode,@etc)=stat($_);
X }
X
X return (defined($mode)
X ? (($mode&(&S_IFMT)) == &S_IFCHR)
X : undef);
X }
X
Xsub catpath # (dir,path) -> fullpath
X { local($_,$path)=@_;
X
X if (length == 0)
X { return $path;
X }
X elsif (length($path) == 0)
X { return $_;
X }
X else
X { return m,/$, ? "$_$path" : "$_/$path";
X }
X }
X
Xsub detab # (tabbed,tabsize) -> untabbed
X { local($line,$tabsize)=@_;
X local($_,$chunk);
X
X defined($tabsize) || ($tabsize=8);
X
X # Bug in regexps?
X # s/\t/' ' x ($tabsize-(length($`)%$tabsize))/eg;
X
X $_='';
X for $chunk (split(/\t/,$line))
X { $_.=$chunk;
X $_.=(' ' x ($tabsize-(length($_) % $tabsize)));
X }
X
X s/[ \t]+$//;
X
X return $_;
X }
X
X# safe rename - doesn't tromp target file if present
Xsub rename # (from,to) -> success
X { local($from,$to)=@_;
X local($ok);
X
X $ok=0;
X if (link($from,$to))
X { $ok=1;
X if (!unlink($from))
X { print STDERR "$cmd: unlink($from): $!, $from still linked to $to\n";
X }
X }
X elsif ($! == &EXDEV)
X # cross device link
X { if (lstat($to))
X { print STDERR "$cmd: $to exists\n";
X }
X else
X { if (!open(RENAME_FROM,"<$from"))
X { print STDERR "$cmd: can't open $from for read: $!\n";
X }
X else
X { if (!open(RENAME_TO,">$to"))
X { print STDERR "$cmd: can't open $to for write: $!\n";
X }
X else
X { while (<RENAME_FROM>)
X { print RENAME_TO;
X }
X
X close(RENAME_TO);
X
X if (unlink($from))
X { $ok=1;
X }
X else
X { print STDERR "$cmd: can't unlink $from ($!), unlinking $to\n";
X if (!unlink($to))
X { print STDERR "$cmd: can't unlink $to: $!\n\tboth $from and $to now exist\n";
X }
X }
X }
X
X close(RENAME_FROM);
X }
X }
X }
X else
X { print STDERR "$cmd: link($from,$to): $!\n";
X }
X
X return $ok;
X }
X
X# weekday names
X@wday_names=('sun','mon','tue','wed','thu','fri','sat');
X@Wday_names=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
X@Weekday_names=('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
X
X# month names
X@mon_names=('jan','feb','mar','apr','may','jun','jul','aug','sep','oct','nov','dec');
X@Mon_names=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
X@Month_names=('January','February','March','April','May','June','July','August','September','October','November','December');
X
Xsub datestr # (time,uselocaltime) -> "MMmonYY, hh:mm:ss"
X { local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
X =($_[1] ? localtime($_[0]) : gmtime($_[0]));
X
X sprintf("%02d%s%02d, %02d:%02d:%02d",
X $mday,$mon_names[$[+$mon],$year,$hour,$min,$sec);
X }
X
Xsub timestr # (time) -> "[[[days, ]hours, ]minutes, ]seconds"
X { local($time)=$_[0];
X local($str,$slop);
X
X $str="";
X if ($time >= 86400)
X { $slop=$time%86400;
X $time-=$slop;
X $str.=($time/86400)." days, ";
X $time=$slop;
X }
X
X if ($time >= 3600)
X { $slop=$time%3600;
X $time-=$slop;
X $str.=($time/3600)." hours, ";
X $time=$slop;
X }
X
X if ($time >= 60)
X { $slop=$time%60;
X $time-=$slop;
X $str.=($time/60)." minutes, ";
X $time=$slop;
X }
X
X $str.$time." seconds";
X }
X
X$_subopen_handler_number=0;
Xsub subopen # (open-name) -> handle
X { local($file)=@_;
X local($handle)='_SUBOPEN_HANDLE_'.$_subopen_handler_number++;
X
X if (open($handle,$file))
X { return $handle;
X }
X
X undef;
X }
X
Xrequire 'cs/env/misc.pl';
X
X1; # make require happy
EOF-/home/cs/spectrum/fuligin/1/cameron/etc/pl/libcs.pl

sed 's/^X//' > cs.env.mail.pl <<'EOF-/home/cs/spectrum/fuligin/1/cameron/etc/pl/cs/env/mail.pl'
Xrequire 'cs/env/misc.pl';
X
Xdefined($SITENAME) || ($ENV{'SITENAME'}=$SITENAME='cs.unsw.oz.au');
X$ENV{'ORGANIZATION'}=$ORGANIZATION='CS&E Computing Facility, Uni Of NSW, Oz';
X
Xdefined($MAILDIR) || ($ENV{'MAILDIR'}=$MAILDIR="$HOME/etc/mail");
Xdefined($MAILRC) || ($ENV{'MAILRC'}=$MAILRC="$MAILDIR/mailrc");
Xdefined($SIGNATURE) || ($ENV{'SIGNATURE'}=$SIGNATURE="$MAILDIR/signature");
Xdefined($OUTMAIL) || ($ENV{'OUTMAIL'}=$OUTMAIL="$MAILDIR/outmail");
Xdefined($DEADMAIL) || ($ENV{'DEADMAIL'}=$DEADMAIL="$MAILDIR/dead.letter");
Xdefined($PFX) || ($ENV{'PFX'}=$PFX='| ');
Xdefined($EMAIL) || ($ENV{'EMAIL'}=$EMAIL="$LUSER\@$SITENAME");
Xdefined($REPLY_TO) || ($ENV{'REPLY_TO'}=$REPLY_TO=$EMAIL);
X
X# for filemail
Xdefined($ANNOUNCE) || ($ENV{'ANNOUNCE'}=$ANNOUNCE=$CONSOLE);
X
X1; # for require
EOF-/home/cs/spectrum/fuligin/1/cameron/etc/pl/cs/env/mail.pl

sed 's/^X//' > cs.rfc822.pl <<'EOF-/home/cs/spectrum/fuligin/1/cameron/etc/pl/cs/rfc822.pl'
X@rfc822'mailhdrs=('to','cc','bcc','from','sender','reply-to','return-recipt-to',
X 'errors-to');
X@rfc822'newshdrs=('newsgroups','followup-to');
X$rfc822'mailptn=join('|',@mailhdrs);
X$rfc822'newsptn=join('|',@newshdrs);
X$rfc822'listfieldptn="$rfc822'mailptn|$rfc822'newsptn";
X
X# add a line to @hdrs and %hdrs
X# just adds to @hdrs until it gets "" or "\n" and then sets up %hdrs
X# field names matching $commaptn are concatenated with commas,
X# otherwise with "\n\t".
Xsub add822lines # @lines -> @remaining_lines
X { local($commaptn)=$rfc822'listfieldptn;
X local($_,$hdr);
X
X $hdr='';
X while (defined($_=shift))
X { s/\r?\n$//;
X last if !length;
X
X if (/^\s/)
X { $hdr.="\n$_";
X }
X else
X { length($hdr) && push(@hdrs,$hdr);
X $hdr=$_;
X }
X }
X
X length($hdr) && push(@hdrs,$hdr);
X
X if (defined)
X # parse headers
X { local($key,$field);
X
X undef %hdrs;
X for (@hdrs)
X { if (/^([^\s:]+):\s*/)
X { $key=$1;
X $field=$'; $field =~ s/^\s+//;
X $key =~ tr/_A-Z/-a-z/;
X if (defined($hdrs{$key}))
X { if ($key =~ /^$commaptn$/o)
X { $hdrs{$key}.=', ';
X }
X
X $hdrs{$key}.="\n\t";
X }
X
X $hdrs{$key}.=$field;
X }
X }
X }
X
X @_;
X }
X
X# parse an RFC822 address list returning a list of tuples
X# (leading command, address, trailing comment, ...)
Xsub getaddrs # (addrlist) -> @(precomment, addr, postcomment)
X { local($_)=@_;
X local(@parsed,$pre,$addr,$post);
X
X s/^\s+//;
X while (length)
X { if (/^,/)
X { $_=$';
X if (length($pre) && !length($addr))
X { $addr=$pre; $pre='';
X }
X
X if (length($pre) || length($addr) || length($post))
X { push(@parsed,$pre,$addr,$post);
X }
X
X $pre='';
X $addr='';
X $post='';
X }
X elsif (!length($addr) && /^[-\w_.]+@[-\w_.]+/)
X { $_=$';
X $addr=$&;
X }
X elsif (/^"([^"]|\\")*"/ || /^'([^']|\\')*'/)
X { $_=$';
X if (length($addr))
X { $post .= " $&";
X }
X else
X { $pre .= " $&";
X }
X }
X elsif (/^<[^>\s]*>/)
X { $_=$';
X if (length($addr))
X { $pre.=" $addr";
X }
X
X $addr=$&;
X }
X elsif (/^[^,\s]+/)
X { $_=$';
X if (length($addr))
X { $post.=" $&";
X }
X else
X { $pre.=" $&";
X }
X }
X else
X { print STDERR "trouble parsing, remaining address is \"$_\"\n";
X }
X
X s/^\s+//;
X }
X
X if (length($pre) && !length($addr))
X { $addr=$pre; $pre='';
X }
X
X if (length($pre) || length($addr) || length($post))
X { push(@parsed,$pre,$addr,$post);
X }
X
X for (@parsed)
X { s/^\s+//;
X }
X
X @parsed;
X }
X
Xsub msgid
X { local($sec,$min,$hour,$mday,$mon,$year,@etc)=localtime(time);
X
X $_msgid_count++;
X sprintf("<%s-%02d%02d%02d%02d%02d%02d-%d-%05d@%s>",
X $USER,
X $year,$mon+1,$mday,$hour,$min,$sec,
X $_msgid_count,
X $$,
X $HOSTNAME);
X }
X
X1; # for require
EOF-/home/cs/spectrum/fuligin/1/cameron/etc/pl/cs/rfc822.pl

exit 0