#!/usr/bin/perl
#
# medit[.{compp,dist,forw,forwp,repl,replm,replp}]
#
# AUTHOR:
#   Dan Harkless                                                    <opensource@
#   http://harkless.org/dan/software/                              harkless.org>
# 
# COPYRIGHT:
#   This file is Copyright (C) 2009 by Dan Harkless, and is released under the
#   GNU General Public License <http://www.gnu.org/copyleft/gpl.html>.
#
# DESCRIPTION:
#   It's great how MH/nmh allows you to use your favorite editor for composing
#   your emails, but it's a bit tiresome to have to use editor movement commands
#   to fill out the header fields, since those movements are always the same.
#   Enter Jim Hester <hester@icse.uci.edu>'s 1986 C program 'medit'.  If you put
#   "Editor: medit" in your .mh_profile, medit would prompt you interactively
#   for the header fields and then fire up your favorite editor to edit the
#   actual body.
#
#   When I left UCI I missed the functionality of this program (don't know if
#   the source is available anywhere) and wrote a simple csh script to emulate
#   it.  It evolved (later becoming a Perl script) and I added "automagic"
#   features, where fields are filled in for you.  For instance, when doing a
#   repl, your From: address is filled out based on what To: or Cc: address was
#   used to send the mail to you (great if you have lots of different POP
#   mailboxes or incoming mail aliases that you like to keep separate).  When
#   you do a forw, the Subject: is the original one with "FORW:" prepended.  One
#   thing that's nice about the new breed of graphical email programs is that
#   aliases tend to be translated as you type them.  With MH/nmh, you have to
#   wait until send-time to see whether the alias translated as you expected.
#   medit addresses this issue by running all the address fields through 'ali'
#   before handing the draft over to your editor.
#
#   medit also encrypts/decrypts PGP mails when called as medit.compp,
#   medit.forwp, or medit.replp.  It is called this way from the separate compp,
#   forwp, and replp scripts I have available on my website.  Unfortunately
#   forwp cannot yet decrypt a mail before forwarding and encrypting it.
#
#   Similarly, if medit is invoked as medit.replm (as from my 'replm' script),
#   it'll do MIME decoding of the text/plain part (the results are undefined if
#   there are multiple) of the email being replied to.  Note that this will only
#   work as expected if your replcomps contains an attribution line ending with
#   a colon.  (Hopefully nmh will soon get the ability to natively MIME-decode
#   when replying and make medit.replm obsolete.)  Be sure to include the
#   following line in your .mh_profile:
#
#       medit.replm-next: medit.repl
#       
#   or else when you do 'edit' at the whatnow prompt to make further edits to a
#   reply before sending, your draft will be wiped out by a freshly decoded and
#   quoted copy of the email being replied to.  (TBD: Lines like that may be
#   desirable for medit.replp et al. as well -- haven't used those in a while
#   but will test when I have time.)
#
# ENVIRONMENT: 
#   Your editor is $MEDIT_EDITOR, if set, else $EDITOR, else emacs (sorry, not a
#   vi fan).  Any addresses you receive email at should be in your
#   Alternate-Mailboxes: specification in your .mh_profile.  If you reply to a
#   mail that doesn't contain one of those addresses on the To: or Cc: lines,
#   $MEDIT_FROM is used, if set; else no explicit From: line is used.  Your real
#   name is $MEDIT_NAME, if set, else your passwd entry.
#
# INSTALLATION:
#   Install medit somewhere in your path and make symbolic links to it called
#   medit.compp, medit.dist, medit.forw, medit.forwp, medit.repl, medit.replm, 
#   and medit.replp.  You should then put the following lines in your
#   .mh_profile:
#
#       Alternate-Mailboxes: <all email addresses you receive mail at>
#       Editor: medit
#       dist: -editor medit.dist
#       forw: -editor medit.forw
#       repl: -editor medit.repl
#       
#   Note that these -editor entries get overridden by the compp, forwp, and
#   replp scripts to use the appropriate PGP-aware versions of medit, and by
#   replm to use the MIME-decoded reply version.
#
# DATE        MODIFICATION
# ==========  ==================================================================
# 2009-04-27  Added note to the documentation about needing to use a "-next:"
#             line in the .mh_profile for 'edit' at whatnow to work for replm.
# 2009-04-17  Added new medit.replm personality to force MIME-decoding of 
#             replies (with code adapted from Oliver Kiddle and Paul Fox).
# 2008-09-02  "use English qw(-no_match_vars)": avoid regex performance penalty.
# 2006-04-17  Variables that may contain regexp metacharacters need to be
#             surrounded by \Q and \E when appearing in regexps.
# 2001-04-18  When deriving From: on replies, use case-insensitive matching.
# 2000-02-22  When called during a forw and we run `show` to get the current 
#             message's Subject, we need to use -noshowproc so if the mail has
#             MIME contents we won't display it (especially bad if the viewer
#             uses tty, like lynx does, as forw will just appear to hang).
# 1999-04-15  Bourne shell on Solaris doesn't like unquoted '^' characters.
# 1999-04-02  Need to work around truncation bug on PGP 5.0i w/ SunOS 5.[56] sh.
# 1998-05-22  ali fails w/ extra spaces.  Delete them when splitting @aliases.
# 1998-03-05  Change mmmyy to contents of $mmmyy in dereferenced aliases too.
# 1998-03-03  Put ali argument in single quotes to protect special characters.
# 1998-02-27  Encrypt outgoing PGP mails for medit.{compp,forwp,replp}.
# 1998-02-23  Support Apparently-To: and Resent-{Cc,From,To}: fields.
# 1998-02-20  Check for your address on To:/Cc: continuation lines as well.
# 1998-02-20  Converted to Perl.
# 1998-02-11  Deference aliases with ali before they get to MH/nmh.
# 1998-02-05  Added medit.replp for replying to PGP mails.
# 1997-01-27  When repl'ing, sign From: address based on To: or Cc:.
# 1997-01-15  medit.forw: "Subject: FORW: <original subject>".
# 1995-10-02  Original csh script (emulates UCI's Jim Hester's 1986 C program).


## Modules used ################################################################
use English qw(-no_match_vars);  # allow use of names like @ARG rather than @_
use File::Basename;              # for basename()
use FileHandle;                  # for autoflush()
use Sys::Hostname;               # for hostname()


## Prototypes ##################################################################
sub email_address($);
sub error($);
sub exit_medit($);
sub signal_abort($);


## Subroutines #################################################################
sub email_address($) {
    # Also appears in my email_address script -- should really be in a module.
    $ARG = shift;
    if (/<([^ >]+)>/) {
	# "Dan Harkless <dan@wave.eng.uci.edu>" style.
	return $1;
    }
    elsif (/\(.*\) *([^ ]+)/) {
	# "(Dan Harkless) dan@wave.eng.uci.edu" style.
	return $1;
    }
    elsif (/([^ ]+) *\(.*\)/) {
	# "dan@wave.eng.uci.edu (Dan Harkless)" style.
	return $1;
    }
    elsif (/ *([^ ]+) */) {
	# Possible whitespace around bare address.
	return $1;
    }
    else {
	# Empty address.
	return $ARG;
    }
}

sub error($) {
    print STDERR shift;
    exit_medit(1);
}

sub exit_medit($) {
    unlink $pgp_tmpfile_name, $tmpfile_name;
    exit shift;
}

sub signal_abort($) {
    unlink $draftfile_name;  # MH/nmh doesn't catch the signal and delete draft
    my $received_signal = shift;
    error "\n$progname: Received $received_signal signal.  Aborting.\n";
}


## Main ########################################################################

# First, do only stuff that's necessary before the possible call to 'show'.

$progname = basename($PROGRAM_NAME);

if (scalar(@ARGV) != 1) {
    if (scalar(@ARGV) == 0) {
	print "$progname: Draft message file not specified.\n";
    }
    else {
	print "$progname: Called with multiple arguments: '@ARGV'.\n";
    }
    error("Usage: $progname <draft_file>\n");
}
else {
    $draftfile_name = $ARGV[0];
}

@passwd_entry = getpwuid($REAL_USER_ID);
chomp($mh_dir = `mhparam path`);
$tmpfile_name = $passwd_entry[7] . "/" . $mh_dir . "/medit-" . hostname . "-" 
                . $PROCESS_ID;
$pgp_tmpfile_name = $tmpfile_name . "-pgp";

# signal_abort() removes temp files when we get these terminating signals:
$SIG{HUP}  = \&signal_abort;
$SIG{INT}  = \&signal_abort;
$SIG{QUIT} = \&signal_abort;
$SIG{TERM} = \&signal_abort;

# Now do any necessary 'show's:

if ($progname eq "medit.forw" or $progname eq "medit.forwp") {
    # For forw the subject is "FORW: <original subject>", so we need to get
    # it. 
    $forw_original_subject=`show -noshowproc | egrep '^Subject:' | head -1`;
}
elsif ($progname eq "medit.replm") {
    # If this is a reply (TBD: need to make a forw version of this also) to a
    # MIME-encoded email, only quote the text/plain part (the results are
    # undefined if there are multiple -- 'mhshow -type text/plain -part 1'
    # doesn't work like you might expect based on the man page), and force MIME
    # decoding (until such time as nmh gets smarter about replying to MIME
    # emails).  Note that this depends on your replcomps containing an
    # attribution line that ends with a colon (not followed by whitespace).
    # TBD: Reimplement this natively in Perl rather than using system & sed?
    system("(sed -n -e '1,/:\$/p' $draftfile_name; echo '> '; "
	   . " mhshow -type text/plain -form mhl.null -nopause"
	   . " | sed -e '1d' -e 's/^/> /') > $draftfile_name.medit_temp;"
	   . " mv $draftfile_name.medit_temp $draftfile_name");
}
elsif ($progname eq "medit.replp") {
    # If we're replying to a PGP message, do this show now before the
    # current message is changed in another window.
    system("show -showproc mhl -form mhl.body"
	   . " | pgpv -f > $pgp_tmpfile_name");
}

# Now we can do non-time-critical stuff...

@time_numbers = localtime(time);
$mmmyy = (qw(jan feb mar apr may jun jul aug sep oct nov dec))
	 [$time_numbers[4]] . $time_numbers[5];

$OUTPUT_AUTOFLUSH = 1;  # for stdout

if ($ENV{MEDIT_EDITOR}) {
    $EDITOR = $ENV{MEDIT_EDITOR};
}
elsif ($ENV{EDITOR}) {
    $EDITOR = $ENV{EDITOR};
}
else {
    $EDITOR = "emacs";
}

if ($progname =~ /^medit\.repl/) {
    # This is a repl.  No draft fields for medit to fill out except for From:,
    # which we determine by seeing which address was used to deliver this mail
    # to you (good when you have multiple POP email boxes).  If mail got to you
    # via a Bcc: or you forgot to put one of your addressed in your
    # Alternate-Mailboxes entry, a warning will be printed that a default From:
    # is being used ($MEDIT_FROM, if available).
    @my_email_addresses = split /[, \n\t]+/, `mhparam Alternate-Mailboxes`;

    foreach $address (@my_email_addresses) {
	# Change MH's glob-style patterns to proper regular expressions.
	$address =~ s<\*><.*>g;
    }

    if (-e $ENV{editalt}) {
	$replied_to_msg_name = $ENV{editalt};
    }
    elsif (-e "@") {
	$replied_to_msg_name = $ENV{editalt};
    }
    else {
	error("$progname: \$editalt not set and @ doesn't exist!\n");
    }

    my $replied_to_msg = new FileHandle "$replied_to_msg_name";
    LINE: while (<$replied_to_msg>) {
	if (/^$/) {
	    last LINE;  # end of header
	}
	elsif (/^(Apparently-To|Cc|To):/i) {
	    foreach $address (@my_email_addresses) {
		if (/\Q$address\E/i) {
		    $from_address = $address;
		    last LINE;
		}
	    }
	    while (<$replied_to_msg>) {
		if (/^[ \t]/) {
		    # Continuation of Apparently-To:, Cc:, or To: line.
		    foreach $address (@my_email_addresses) {
			if (/\Q$address\E/i) {
			    $from_address = $address;
			    last LINE;
			}
		    }
		}
		else {
		    redo LINE;  # don't input another line and lose this one
		}
	    }
	}
    }
    undef $replied_to_msg;  # close it

    if ($ENV{MEDIT_NAME}) {
	$real_name = $ENV{MEDIT_NAME};  # in case you don't like passwd entry
    }
    else {
	$real_name = $passwd_entry[6];
    }

    if (! $from_address) {
	print "$progname: Didn't see any Alternate-Mailboxes on the To: or" .
	      " Cc: lines.\n";
 	if ($ENV{MEDIT_FROM}) {
	    # If $MEDIT_FROM is set -- use it as a default.  Change "mmmyy" to
	    # the current month and year as a part of an anti-SPAM strategy.
 	    ($from_address = $ENV{MEDIT_FROM}) =~ s<mmmyy><$mmmyy>;
	    print "$progname: Using $real_name <$from_address>.\n";
 	}
	else {
	    print "$progname: Using MTA default.\n";
	}
    }

    if ($from_address) {
	# If $from_address is set, we need to stick a From: line at the top.
	$from_address =~ s<\.\*><>g;  # edit out the regexp patterns
	my $tmpfile = new FileHandle ">$tmpfile_name";
	$tmpfile->autoflush;  # make sure file written before $EDITOR call
	$tmpfile->print("From: $real_name <$from_address>\n");
	my $draftfile = new FileHandle $draftfile_name;
	$tmpfile->print($ARG) while (<$draftfile>);
	undef $draftfile;  # close before rename
	undef $tmpfile;    # close before rename
	rename $tmpfile_name, $draftfile_name;
    }

    if ($progname eq "medit.replp") {
	# Append the separately-decoded PGP message being replied to to the
	# draft and prepend "> " on each line.
	my $decoded_pgp_msg = new FileHandle $pgp_tmpfile_name;
	my $draftfile = new FileHandle ">>$draftfile_name";
	$draftfile->print("> $ARG") while (<$decoded_pgp_msg>);
    }

    system("$EDITOR $draftfile_name");
}
else {
    # Non-repl -- there will be fields to fill in -- prompt the user for them.
    my $draftfile = new FileHandle $draftfile_name;
    my $tmpfile = new FileHandle ">$tmpfile_name";
    $tmpfile->autoflush;  # make sure file written before $EDITOR call
    while (<$draftfile>) {
	if (/^-/ or /^$/) {
	    # End of the header.  Append the rest of the draft to the temp file.
	    print $tmpfile $ARG;
	    print $tmpfile $ARG while (<$draftfile>);
	}
	elsif (/:$/) {
	    # This is a header field that needs to be filled in.
	    if (/^Subject:/i and ($progname eq "medit.forw" or
				  $progname eq "medit.forwp")) {
		# For forws, subject == "FORW: <original subject>".
		$forw_original_subject =~ s/Subject:/Subject: FORW:/g;
		print $tmpfile "$forw_original_subject";
	    }
	    else {
		# Prompt the user for the header value.
		chomp;
		print;
		print " ";
		chomp($user_input = <STDIN>);
		if ($user_input) {
		    if (/^(Bcc|Cc|From|Resent-cc|Resent-From|Resent-To|To):/i) {
			# Dereference mail aliases.
			my $dereferenced_aliases;
			@aliases = split /,[ \t]*/, $user_input;
			for ($i = 0; $i < @aliases; $i++) {
			    ($dereferenced_alias = `ali '$aliases[$i]'`)
			      =~ s<mmmyy><$mmmyy>g; # part of anti-SPAM strategy
			    chomp($dereferenced_aliases .= $dereferenced_alias);
			    if ($i == @aliases - 1) {
				$dereferenced_aliases .= "\n";
			    }
			    else {
				$dereferenced_aliases .= ", ";
			    }
			}
			print $tmpfile "$ARG $dereferenced_aliases";
		    }
		    else {
			# Non-address line.
			print $tmpfile "$ARG $user_input\n";
		    }
		}
	    }
	}
	else {
	    # Field is already filled in.
	    print $tmpfile $ARG;
	}
    }
    undef $draftfile;  # close before rename
    undef $tmpfile;    # close before rename
    rename $tmpfile_name, $draftfile_name;

    if ($progname ne "medit.dist") {
	# Nothing to edit for dists...
	system("$EDITOR $draftfile_name");
    }
}

if ($progname eq "medit.compp" or $progname eq "medit.forwp" or 
    $progname eq "medit.replp") {
    my $recipients;
    my $draftfile = new FileHandle $draftfile_name;
    my $pgp_tmpfile = new FileHandle ">$pgp_tmpfile_name";
    $pgp_tmpfile->autoflush;  # make sure file written before pgpe call
    my $tmpfile = new FileHandle ">$tmpfile_name";
    $tmpfile->autoflush;      # make sure file written before pgpe call

    while (<$draftfile>) {
	print $tmpfile $ARG;
	if (/^$/) {
	    # End of the header.  Send the rest of the draft to $pgp_tmpfile.
	    print $pgp_tmpfile $ARG while (<$draftfile>);
	}
	elsif (/^(Bcc|Cc|Resent-To|To):/i) {
	    s/^.+://g;  # delete initial header field
	    s/\'[^\']*\'//g;  # delete text in single quotes: may contain commas
	    s/\"[^\"]*\"//g;  # delete text in double quotes: may contain commas
	    @full_addresses = split /[,\n]/;
	    for ($i = 0; $i < @full_addresses; $i++) {
		$recipients .= " -r " . email_address $full_addresses[$i];
	    }
	}
    }
    undef $draftfile;  # close before pgpe call
    undef $tmpfile;    # close before pgpe call

    # The unnecessary-looking "| cat" in the command below is necessary because
    # of a bug that causes pgpe 5.0i to truncate instead of appending when
    # running under sh or csh (but not ksh or tcsh) on Solaris 2.5 or 2.6.
    system("pgpe $recipients -afst < $pgp_tmpfile_name | cat >> $tmpfile_name");
    rename $tmpfile_name, $draftfile_name;
}    

exit_medit 0;