#!/usr/local/bin/perl
#
# This script takes advantage of the "rn" and "trn" 
# save to pipe ("s |" or just "|") option at the article
# level. "fnews" allows editing the article.
#
# Written by Bob DeBula
# Tue Spe 18 07:56:30 EDT 1990
#
# Rewritten in PERL and modified to pickup the
# article subject & make that the mail subject
# with a "FNEWS" prefix. Also, added the -c 
# (confirmation) option.
# Thu Oct 15 15:45:56 EDT 1992
#
# Modified by Rob Funk April 27 1995
# -made intro to message less stilted
# -recognize NAME environment variable
# -commented out `clear's because they're annoying
#
# Modified by Rob Funk December 1 1996
# -add X-Original-Newsgroups header
# -change default editor to vi
#
# Modified by Rob Funk April 7 1997
# -don't include From: header -- let sendmail take care of that
#
# Modified by Rob Funk May 14 1998
# -use mutt aliases from .muttrc and files sourced by it
#
# Modified by Rob Funk July 10 1998
# -add -m option for MIME-forwarding with message/news type
#
# Recommended .rnmac (without the `#'):
#^F %(%m=[pa]?|fnews -c %"Forward to: "\n:^F)

# Get options

require "getopts.pl";
$usage = "Usage: $0 [-c] [-d] [-e] [-r] [-m]\n";
&Getopts('cedrm') || die $usage;
$pto = join(',', @ARGV);
@article = (<STDIN>);
close(STDIN); open(STDIN, "/dev/tty");
if ( $pto !~ /^\S+/ ) {
    &clear($opt_r);
    print "Whom would you like to forward the news article to\n";
    print "\(separate e-mail addresses with commas if more than one\)\?\n";
    print "\nEnter address(es): ";
    chop($pto = <STDIN>);
}
$pto =~ tr/A-Z/a-z/;
@to = split(/,/, $pto);
$subject = (grep(/^Subject:\s+.*$/, @article))[0];
$subject = ( $subject =~ /^Subject:\s+(.*)$/ ) ? "FNEWS -> $1" : "FNEWS -> Forwarded news article";
$newsgroups = ((grep(/^Newsgroups:\s+.*$/, @article))[0] || (grep(/^X-Mailing-List:\s+.*$/, @article))[0]);
$newsgroups = ($newsgroups =~ /^(Newsgroups|X-Mailing-List):\s+(.*)$/) ? "$2" : "(none)";
chop($host = ( -x "/usr/ucb/hostname" ) ? `/usr/ucb/hostname` : `/bin/hostname`);
($userid,$name,$HOME) = (getpwuid($<))[0,6,7];
# get rid of extraneous stuff in gecos
$name =~ s/,.*$//;

# Let the user choose their name
$name = $ENV{'NAME'} if (defined($ENV{'NAME'}));

#$from = $userid."@".scalar((gethostbyname($host))[0])." ($name)";
#$from =~ s/^($userid\@)$host\.(magnus\..*)$/$1$2/;

# Set editor based on environment. Default to vi if not set
#
$EDITOR = ( defined($ENV{'EDITOR'} )) ? $ENV{'EDITOR'} : "/bin/vi";

#
# Resolve aliases
#

if ( $opt_d ) { 
	print "userid = $userid, name = $name, home = $HOME\n";
	print "\nPress enter to continue: ";
	<STDIN>;
}
	
###

foreach $tto (@to) {
    &muttalias(\%define);
    &elmalias(\%define);
    $tto = &mailrcalias($tto);
    $tto = &mmalias($tto);
    if ( $opt_d ) {
	print "In @to loop pre assoc array, tto = $tto\n";
	print "\nPress enter to continue: ";
	<STDIN>;
    }
    $tto = $define{$tto} if ( defined $define{$tto} );
    $tto =~ tr/A-Z/a-z/;
    if ( $opt_d ) {
	print "In @to loop post xlate, tto = $tto\n";
	print "\nPress enter to continue: ";
	<STDIN>;
    }
}

if ( $opt_d ) {
        print "\@to array:\n", @to;
        print "\nPress enter to continue: ";
        <STDIN>;
}
$to = join(',', @to);
if ( $opt_d ) {
	print "To: $to\n";
        print "\nPress enter to continue: ";
        <STDIN>;
}
if (defined($opt_m)) {
    $boundary=sprintf("%0x%0x%s%0x%0x",$$,time,($0=~m,.*?/?([^/]+)$,),$$,time);
    push(@article,
	 ("\n",
	  "--$boundary--\n",
	  "\n"));
    unshift(@article,
	    ("--$boundary\n",
	     "Content-Type: message/news\n",
	     "\n"));
}
unshift(@article,
	("I thought you might be interested in this.\n\n--- $name\n",
	 "\n"));
if (defined($opt_m)) {
    unshift(@article,
	    ("--$boundary\n",
	     "Content-Type: text/plain; charset=US-ASCII\n",
	     "Content-Transfer-Encoding: 7bit\n",
	     "\n"));
}
unshift(@article,"\n"); # separate headers and body
if (defined($opt_m)) {
    unshift(@article,
	    ("Mime-Version: 1.0\n",
	     "Content-Type: multipart/mixed; boundary=\"$boundary\"\n"));
}
unshift(@article,
	("To: $to\n",
	 #"From: $from\n",
	 "Subject: $subject\n",
	 "X-Original-Newsgroups: $newsgroups\n",
	 "X-Delivered-By-The-Graces-Of: The fnews mail script\n"));

#
# Edit the posting if "-e" option specified
#
CONFIRM: while (defined($opt_e) || defined($opt_c)) {
    if ( defined $opt_e ) {
	$fname = "/tmp/fnews_tmp$$";
	open(FNEWS_OUT, ">$fname") || die "Could not open fnews tmp file\n";
	print FNEWS_OUT @article;
	close FNEWS_OUT;
	system("$EDITOR $fname");
	open(FNEWS_OUT, $fname) || die "Could not open fnews tmp file\n";
	@article = ();
	@article = (<FNEWS_OUT>);
	close FNEWS_OUT;
	unlink( $fname );
	undef $opt_e;
    }
    $confirm = "x";
# next line seems to be emitting an extra `|'..... why?
    while ( (defined $opt_c) && ($confirm !~ /f|e|c|\s+/ )) {
	&clear($opt_r);
	print "\nForward(f), edit(e), or cancel(c) (default is forward)? ";
	$confirm = <STDIN>;
	&clear($opt_r);
	exit 0 if ( $confirm =~ /^c/ );
	if ( $confirm =~ /^e/i ) {
	    $opt_e = 1;
	    next CONFIRM;
	}
    }
    undef $opt_c;
}

#
# Now send the message to the intended recipient(s) using sendmail
#

&clear($opt_r);
print "\nForwarding news article via e-mail.....\n";
open(MAIL, "|/usr/lib/sendmail -t -oi $to") || die "Cannot use sendmail to forward msg\n";
print MAIL @article;
close MAIL;
&clear($opt_r);
#close DEBUG if ( $opt_d );
exit 0;

####

sub muttalias {
#
#	build mutt alias table (if any mutt aliases)
#
#	does not currently handle aliases referencing other aliases,
#	but does chase files that are sourced
    local(*define,$file,$input) = @_; # using recursion described in Camel book
    local($cmd,$rest,$next,$synon,$address,$_);
    $file = "$HOME/.muttrc" unless $file;
    $input++; # string increment
    if ( -e $file ) {
	open($input,$file) or return 0; # fail silently if unsuccessful
	while(<$input>) {
	    chop;
	    next if (/^\s*\#/);
	    next if (/^\s*$/);
	    while (/\\$/) {
		# trailing backslash, get next line
		$next = <$input>;
		break if (! defined($next));
		chop($next);
		$_ .= $next;
	    }
	    ($cmd, $rest) = /^(\w)+\s*([^\#]*)/; # keep comments out of $rest
	    $_ = $rest; # we're messing with $_ from now on

	    s/\s*$//; # delete trailing whitespace
	    if ($cmd eq "alias") {
		# grab alias from $rest
		($synon,$address) = /(\w+|\"[^\"]*\")\s+(.*)/;
		$synon =~ tr/A-Z/a-z/;
		$address =~ tr/A-Z/a-z/;
		next if ( $synon eq $address );
		$define{$synon} = $address;
	    } elsif ($cmd eq "source") {
		# try again with different file
		s/^\"//; s/\"$//; # remove any quotes
		s.^~/.$HOME/.; # change ~ to $HOME
		# now assume $_ is file to read
		&muttalias(\%define,$_,$input);
	    }
	}
    } else {
	# file doesn't exist
	return;
    }
    close $input;
}

sub elmalias {
#
#	build elm alias table (if any elm aliases)
#
    local(*define,$file) = @_;
    $file = "$HOME/.elm/aliases.text" unless $file;
    local($synon,$address,@alias,$stop,$ak,$key,$_);

    if ( -e $file ) {
	open(ELM,$file);
	while(<ELM>) {
	    chop($_);
	    ($synon, $address) = /^(.+)\s+\=\s+.*\s*\=\s+(.*)$/;
	    $synon =~ tr/A-Z/a-z/;
	    next if ( $synon eq $address );
	    @alias = split(/[, ]/,$synon);
	    $address =~ s/,\s+/,/g;
	    $address =~ s/[\r\n\t\f]//g;
	    $address =~ s/\s+/,/g;
	    $address =~ tr/A-Z/a-z/;
	    foreach (@alias) {
		$define{$_} = $address if (( $_ !~ /^\s+$/ ) && ( $_ ne "" ));
	    }
	}
	$stop = 1;
	while ( $stop > 0 ) {
	    $stop = 0;
	    foreach $ak (keys %define) {
		$define{$ak} =~ s/[\r\n\t\f]//; 
		if (( $define{$ak} =~ s/\s+/,/g ) || ( $define{$ak} =~ /^.*\,.*/ )) {
		    @address = split(',',$define{$ak});
		    foreach (@address) {
			next if (( $_ =~ /^\s+$/ ) || ( $_ eq "" ));
			if ( $define{$_} ) {
			    $_ = $define{$_};
			    $stop = 1;
			}
		    }
		    $define{$ak} = join(',',@address);
		}
		else {
		    $address = $define{$ak};
		    if ( $define{$address} ) {
			$define{$ak} = $define{$address};
			$stop = 1;
		    }
		}
	    }
	}
	if ( $opt_d ) {
	    #open(DEBUG, "|/usr/local/bin/less") || die "No less found\n";
	    foreach $key (sort(keys %define)) {
		print "key = \*\*$key**, Element = **$define{$key}**\n";
	    }
	    print "\nPress enter to continue: ";
	    <STDIN>;
	}
    }
}

sub mailrcalias {
#
#	Resolve mailx/Mail/mail .mailrc aliases
#
    local($tto) = @_;
    local(%mrcalias,$mrc,$_);
    open(MAILRC, "$HOME/.mailrc") || $mrc == 1;
    if ( !defined $mrc ) {
	while(<MAILRC>) {
	    $mrcalias{$2} = $3 if ( $_ =~ /^a(lias)?\s+(\S+)\s*(.*)\s*$/i );
	    $tto = $mrcalias{$tto} if ( defined $mrcalias{$tto} );
	}
    }
    return $tto;
}

sub mmalias {
#
#	Resolve MM aliases (if any)
#
    local($tto) = @_;
    local($mmi,$mmalias,$mmlist,@boing,@MMLIST);

    open(MMINIT, "$HOME/.mminit") || $mmi == 1;
    if ( !defined $mmi ) {
	while(<MMINIT>) {
	    if ( /^define\s+$tto\s+.*$/ ) {
		($mmalias, $mmlist) = /^define\s+(\S+)\s+(.*)/;
		if ( $mmlist =~ /^.*@@(.*)$/ ) {
		    @boing = split('/', $1);
		    if ( $boing[0] eq "~" ) {
			$boing[0] = "$HOME";
		    } elsif ( (substr($boing[0], 0, 1) ) eq "~" ) {
			$boing[0] = (getpwnam(substr($boing[0],1)))[7];
		    } else {
			$boing[0] = "/$boing[0]";
		    }
		    open(ATLIST, join('/', @boing)) || next;
		    @MMLIST = ();
		    while(push(@MMLIST, split(/[ ,\t\s\n]+/, <ATLIST>))) {};
		    $mmlist = join(',',@MMLIST);
		} else {
		    $mmlist = join(',', split(/[ ,\t\s\n]+/, $mmlist));
		}
		$tto = $mmlist;
	    }
	}
    }
    return $tto;
}

sub clear {
    local($opt) = @_;
    if ($opt) {
	if ( -x "/usr/ucb/clear" ) {
	    system("/usr/ucb/clear");
	} else {
	    system("/bin/clear");
	}
    }
}