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: cameron@cs.unsw.oz.au
#Subject: Re: Mail Filter
Message-ID: <cameron-930218135036-1-01024@fuligin>
To: mbl@msen.com (Matthew B Landry)
Followup-To: comp.lang.perl
Sender: news@usage.csd.unsw.OZ.AU
Nntp-Posting-Host: fuligin.spectrum.cs.unsw.oz.au
Reply-To: cameron@cs.unsw.oz.au
Organization: CS&E Computing Facility, Uni Of NSW, Oz
References: <1lrvcgINN26n@nigel.msen.com>
Errors-To: cameron@cs.unsw.oz.au
Date: Thu, 18 Feb 1993 02:51:09 GMT
Return-Receipt-To: cameron@cs.unsw.oz.au
Lines: 1118

mbl@msen.com (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
	  cameron@cse.unsw.edu.au, 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 'neilb@cs.unsw.oz.au'
X    && $s eq 'I am on vacation at the moment.')
X	{ &legend("$from is on vacation");
X	  $files=1;
X	}
Xelsif ($to =~ /faces@Aus.Sun.COM/
X    || $cc =~ /faces@Aus.Sun.COM/)
X	{ $MAILBOX.='/faces';
X	}
Xelsif ($f eq 'funny-request-daemon@clarinet.com (rec.humor.funny autoreply)')
X	{ &legend("joke received by rec.humour.funny: $s");
X	  $filed=1;
X	}
Xelsif ($f eq 'postmaster@cs.unsw.oz.au' && $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 'archie@plaza.aarnet.edu.au'
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



.