[comp.mail.mh] Automatically Fcc'ing the message's recipient

tchrist@convexe.uucp (Tom Christiansen) (12/14/89)

I recall someone once asking whether they could make all their outgoing
mail get automatically Fcc'd to the folder of the name of the recipient.
Here's a way to do it for all outgoing mail (like repl, comp, ...).  The
way it works is this:  you install THIS as your postproc and put an entry
in your mh_profile like this:

postproc: post-fcc

Now anyone in the To, Cc, or Bcc list (or Resent-foo) will get a copy
in the folder by their login name.  MH will make these hardlinks, so
it's no more costly (very nearly the truth) than the single +outbox
copy you may be used to.

Put the following script somewhere in your path, call it "post-fcc", and
make it executable.  It assumes that the real post is in
/usr/local/mh/lib/post, so you'd better make sure it is or alter the path
on the exec.  It groks addresses filled with @'s and !'s and %'s.  If
you're used to mailing 'jimbo' as your private alias for 'orosz', you'd
better make a symlink such that jimbo->orosz, because this happens before
aliasing.

This is a perl script.  I run perl 3.0p6, mh 6.6, and it works for me.

--tom


#!/usr/bin/perl

$file = $ARGV[$#ARGV];
$tmp = "$file.$$";

open (file, "<$file") || die "can't read $file: $!";
open (tmp, ">$tmp")   || die "can't write $tmp: $!";

select(tmp);

while (<file>) {
    last if /^-*$/;
    if (/^((resent-)?(to|b?cc)):\s*(.+)/i) {
	$header = $1;
	do parse($4);
    } elsif (/^\s+(.*)/ && $header) {
	do parse($1);
    } else {
	$header = '';
    } 
    print;
} 

print "Fcc: ",  join(', ', @fccs), "\n" if $#fccs >= 0;
print "\n";
print while <file>;

close file;
close tmp;
rename($tmp,$file);

exec '/usr/local/mh/lib/post', @ARGV;

sub parse {
     local($_) = @_;

     for (split(/\s*,\s*/)) {
	s/.*<([^>]+)>.*/$1/;
	s/@.*//;
	s/.*!//;
	s/\(.*\)//;
	s/\s//g;
	push(@fccs,'+'.$_) unless $seen{$_}++;
     } 
} 

    Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
    Convex Computer Corporation                            tchrist@convex.COM
		 "EMACS belongs in <sys/errno.h>: Editor too big!"

tchrist@convex.COM (Tom Christiansen) (12/15/89)

Yarg!  Due to the undocumented '-idanno N' trailing args to post, 
this didn't work on annotated messages.  This seems to fix it.  
I've spiffed up the error messages, moved the pat to post to 
the top so you can get at it easily, and made the thing background
itself for speed.

--tom

#!/usr/bin/perl

exit if fork;

@newargv = ( '/usr/local/mh/lib/post', @ARGV );

if ( $ARGV[$#ARGV - 1] eq '-idanno' ) {
    $file = $ARGV[$#ARGV - 2];
} else {
    $file = $ARGV[$#ARGV];
}


$tmp = "$file.$$";

open (file, "<$file") || die "can't read $file, argv was $0 @ARGV: $!";

open (tmp, ">$tmp")  || die "can't write $tmp, argv was $0 @ARGV: $!";

select(tmp);


while (<file>) {
    last if /^-*$/;
    if (/^((resent-)?(to|b?cc)):\s*(.+)/i) {
	$header = $1;
	do parse($4);
    } elsif (/^\s+(.*)/ && $header) {
	do parse($1);
    } else {
	$header = '';
    } 
    print;
} 

print "Fcc: ",  join(', ', @fccs), "\n" if $#fccs >= 0;
print "\n";
print while <file>;

close file;
close tmp;
rename($tmp,$file);

exec @newargv;

sub parse {
     local($_) = @_;

     for (split(/\s*,\s*/)) {
	s/.*<([^>]+)>.*/$1/;
	s/@.*//;
	s/.*!//;
	s/\(.*\)//;
	s/\s//g;
	push(@fccs,'+'.$_) unless $seen{$_}++;
     } 
} 

    Tom Christiansen                       {uunet,uiucdcs,sun}!convex!tchrist 
    Convex Computer Corporation                            tchrist@convex.COM
		 "EMACS belongs in <sys/errno.h>: Editor too big!"