#!/usr/bin/perl
# <pre>
# filter for pine 3.93 and newer for de/encoding pgp mails
# This uses a feature in Pine, the _DATAFILE_, a file which is 
# created by pine for storing information by filters between
# two runs.
# use this with something like the following in your .pinerc:
# display-filters=_LEADING("-----BEGIN PGP")_ /path/to/papp
#                  -key _PREPENDKEY_ -passfile _DATAFILE_
# sending-filters=/path/to/papp -key _PREPENDKEY_ 
#                 -metoo -encode -passfile  _DATAFILE_ _RECIPIENTS_
# And DONT Forget to have a look at the source!
# This script requires Perl5 (and, of course, PGP :-) and will not work 
# on non-UNIX systems. (It is known to work with SunOS4 and Linux).

# History:
#
# $Id: papp,v 1.24 1997/09/18 17:31:17 gator Exp $
#
# 21.03.96 Roland Rosenfeld <roland@spinnaker.rhein.de> 
# 23.03.96 $TMPFILE moved to $PGPPATH.
# 17.05.96 total rewrite in perl; many new features
# 27.08.96 corrected code for adding new keys
# 19.11.96 ask whether to run pgp before running it
# 25.11.96 some compatibility fixes
# x-mas '96 Aldo Valente: Added option "-passfile <file>"
#             to make it cooperative with my script, which is able 
#             to "remember" a given passphrase. This option reads 
#             the cleartext passphrase from <file>  (yuck!)
#             You can always get Rolands Original
#             at http://www.rhein.de/~roland/
#             aldo@rhein.de; http://www.rhein.de/~aldo/
# feb '97 Aldo: moving my bash-script to /dev/null and merging
#           functionality into Rolands perlscript, which was
#           a display-filter before.
#           So the new features are sending of pgpified mails
#           and the option to "remember" a passphrase.
#           changed the Name from pgpdecode to papp (Pine And PgP)
# Mar '97 Aldo:BUGFIX: Ronald.Wahl@Informatik.TU-Chemnitz.DE 
#           told me that PAPP would not work if the recipients List
#           contains a '-'. PAPP thinks of such mailaddresses as an 
#           (unrecognized) option ans complains. Stupid me. Fixed.
# May '97 Peter Daum <gator@cs.tu-berlin.de> Another rewrite:
#            Some Bug fixes. Security enhancements 
#            (Passphrase passed via pipe instead of commandline, 
#            encrypt datafile containing passphrase, option "-key" to 
#            signal use of session key, no more temporary files...)
#            Misc new features (lots of options to control behavior,
#            all options can be set in an rcfile instead of having to
#            answer questions at runtime, ...)
# Sep '97 PASZTOR Miklos <pasztor@sztaki.hu> in sub encode: 
#            only ask for recipients when actually encrypting

use strict;			# (be pedantic :-)

umask 077; # actually, no files are created anyway, but just in case ...

use vars ( # global variables:
	  '%opt',	 # global/command line options
	  '%hlp',	 # and descriptions of their usage
	  '$encode', '$dump_cfg',
	  '$passfile', '$recipients', '$session_key',

	  '$passphrase', # pgp "passphrase" to unlock RSA key
	  '$have_pass',  # set if valid passphrase is stored in datafile
	  '$tmp_key',    # key for encrypting the passphrase between calls

	  '$yes', '$zaphod', '$pgp', '$stty', '$rcfile'
	  );

# paths to external programs (change these to suit your locations):
$pgp="/usr/bin/pgp";           # guess what ... ;-)
$stty="/bin/stty";	       # where to find a stty, which supports -cbreak
			       # on SunOS 4, you need /usr/5bin/stty
# other "constants":
$yes="y|j";			# confirmatative user input
$zaphod='zaphod beeblebrox for president'; # taken from pgpdoc2.txt
$rcfile=".pgp4pinerc";		# name of configuration file

$hlp{dont_ask}='0: never run pgp; 1: ask; 2: just do it...';
$opt{dont_ask}=1;
$hlp{auto_decode}='1: decode messages without asking';
$opt{auto_decode}=0;
$hlp{auto_add_keys}='1: add keys to keyring without asking';
$opt{auto_add_keys}=0;
$hlp{auto_store_passphrase}='1: store passphrase without asking';
$opt{auto_store_passphrase}=0;
$hlp{always_encrypt}='1: always encrypt without asking';
$opt{always_encrypt}=0;
$hlp{always_sign}='1: always sign without asking';
$opt{always_sign}=0;
$hlp{override_recipients}='1: explicitly ask for recipients';
$opt{override_recipients}=1;
$hlp{encrypt_to_self}='1: implicitly add sender to list of recipients';
$opt{encrypt_to_self}=1;
$opt{pgp_verbosity}=0;
$hlp{pgp_verbosity}='0: only important stuff reported; 2: lots of noise..';

sub err_exit {
    # it seems like "die" in some cases returns an exit status of 0
    # thus causing errors to stay unnoticed; as a quick fix, all 
    # calls to die have been replaced by calls to this function.
    warn @_; exit (1);
}

sub usage {
    err_exit "USAGE: $0 [-metoo] [-dontask] [encode] [-passfile <file>] [-key] [recipients]
 
OPTIONS:  -metoo           Enables +EncryptToSelf=on
          -conf            print currently active global options (in a format 
                           suitable for a fresh $rcfile)
          -key             First line of message contains session key
          -dontask         Default is ask every time if You want to use PGP
          -encode          Default is encoding of mail from STDIN
          -passfile <file> <file> is normally the _DATAFILE_
                           simply, don't use this Option, if you don't want it...
          Everything else is taken as a list of recipients

";
}

sub dump_cfg {
    print "# sample configuration file for $0\n"; 
    print "# redirect to $rcfile in your home directory and edit there.\n\n";
    print "# ('dont_ask' is just for compatibility; leave it set to '1'\n";
    print "# and use 'auto_decode' and 'auto_add_keys' instead.)\n\n";
    for (sort keys(%opt)) {
	printf "%-22s= %s # %s\n", $_, $opt{$_},$hlp{$_}; 
    }
    exit 0;
}

sub stty  {
# Beware! Setting tty modes is system dependent; used modes are:
# cbreak: read char without pressing RETURN
# -echo: turn off echoing.
# You might have to adjust these to work with your OS.

    my ($what, $state)=@_;
    $state= ($state eq "off") ? "-" : "";
    system("$stty ${state}$what < /dev/tty > /dev/tty")
	&& err_exit("$stty failed: $?");
}

sub filter_cmd  {
# usage: filter_cmd "cmd", \@out, \@err, @rest
# execute "cmd" with @rest as input, return exit status
# @out contains cmd's stdout, @err its stderr channel

    my $cmd=shift; my $out=shift; my $err=shift;
    my ($pid, $res);
    local ($?, $^F=10);

    pipe(CHILD_IN,PARENT_OUT); pipe(PARENT_IN,CHILD_OUT);
    pipe(ERR_READI,ERR_WRITE); pipe(ERR_READ,ERR_WRITEI);

    if (($pid = fork) < 0) { err_exit "cant't fork: $!"; }

    elsif (!$pid) { # child
        close(PARENT_IN); close(PARENT_OUT); close(ERR_READ);

	# another child: (poor man's "tee" :-)
	if (($pid = fork) < 0) { err_exit "cant't fork: $!"; }
	elsif (!$pid) {
	    close(CHILD_IN); close(CHILD_OUT); close (ERR_WRITE);
	    open(TTY,">/dev/tty") || err_exit "can't open /dev/tty: $!";
	
	    while (<ERR_READI>) {
		print TTY; print ERR_WRITEI;
	    }
	    exit(0);
	}

	close(ERR_WRITEI); close(ERR_READI);
	open(STDIN,"<&CHILD_IN")  || err_exit "Can't redirect stdin: $!";
	open(STDOUT,">&CHILD_OUT") || err_exit "Can't redirect stdout: $!";
	open(STDERR,">&ERR_WRITE") || err_exit "Can't redirect stderr: $!";
        exec $cmd;
        err_exit "can't exec $cmd: $!";
    }
    
    # parent:
    close(CHILD_IN); close(CHILD_OUT); close (ERR_WRITE);
    close(ERR_READI); close(ERR_WRITEI);

    print PARENT_OUT @_;
    close PARENT_OUT;

    @$out=<PARENT_IN>;
    @$err=<ERR_READ>;
    close PARENT_IN;

    waitpid($pid,0);
    return $?;
}

sub pgp_strerror {
# map pgp exit codes to error messages
# (taken from ver 2.6.3i; hopefully valid in other versions, too)

    my $sig= ($_[0] & 255); my $ret= ($_[0] >> 8);
    my $msg= " ($ret) (Unknown exit code)";

    my %msg = (
        1  => "INVALID_FILE_ERROR",
        2  => "FILE_NOT_FOUND_ERROR",
        3  => "UNKNOWN_FILE_ERROR",
        4  => "NO_BATCH	",
        5  => "BAD_ARG_ERROR",
        6  => "INTERRUPT",
        7  => "OUT_OF_MEM",
        10 => "KEYGEN_ERROR",	       # Keyring errors: Base value = 10
        11 => "NONEXIST_KEY_ERROR",
        12 => "KEYRING_ADD_ERROR",
        13 => "KEYRING_EXTRACT_ERROR",
        14 => "KEYRING_EDIT_ERROR",
        15 => "KEYRING_VIEW_ERROR",
        16 => "KEYRING_REMOVE_ERROR",
        17 => "KEYRING_CHECK_ERROR",
        18 => "KEY_SIGNATURE_ERROR",
	19 => "KEYSIG_REMOVE_ERROR",
	20 => "SIGNATURE_ERROR",       # Encode errors: Base value = 20
        21 => "RSA_ENCR_ERROR",
        22 => "ENCR_ERROR",
        23 => "COMPRESS_ERROR",
        30 => "SIGNATURE_CHECK_ERROR", # Decode errors: Base value = 30
        31 => "RSA_DECR_ERROR",
        32 => "DECR_ERROR",
        33 => "DECOMPRESS_ERROR");

    $msg = qq/ ($ret) "$msg{$ret}"/ if exists($msg{$ret});
    $msg .= " (Killed by signal $sig)" if $sig;
    return $msg;
}

sub run_pgp {
    my ($status);
    if ($status= filter_cmd @_) {
	warn "@{$_[2]}", "\n" if (@{$_[2]});
	warn "syserror: $!\n" if ($!);
	err_exit "$0: pgp failed: ", pgp_strerror($status);
    }
}

sub swallow_key {
    my $oldenv;

    $oldenv=$ENV{'PGPPASSFD'}; # bug in pgp 2.63: if PGPPASSFD is set,
    delete $ENV{'PGPPASSFD'}; # pgp is looking in "/tmp/pgptemp.$00" ?!
    run_pgp "$pgp -kaf +verbose=$opt{pgp_verbosity}", @_;
    $ENV{'PGPPASSFD'}=$oldenv;
}

sub ask_if {
    # this is a comfortable way to ask random Yes or No questions
    my $key;

    print STDERR $_[0];
    stty "cbreak" => "on";
    open (TTY, "</dev/tty") || err_exit("can't open /dev/tty: $!");
    $key=getc(TTY);
    close TTY;
    stty "cbreak" => "off";
    print STDERR "\n";
    return ($key =~ /$yes/i);
}

sub index_of {
    # usage: index_of $STRING \@ARRAY
    # returns 1 + index of first element in @ARRAY matching $STRING
    my $search_str = $_[0];
    my @a=@{$_[1]}; my $i;

    for ($i=0; $i <= $#a; $i++) {
	return (1+$i) if ($a[$i] =~ /$search_str/)
    }
    return 0;
}

sub decode {
    # reads message from stdin, 
    # (recursively) runs pgp on "interesting" portions

    my $pgp_msg_start = "^-----BEGIN PGP( SIGNED)? MESSAGE-----\$";
    my $pgp_msg_end   = "^-----END PGP (MESSAGE|SIGNATURE)-----\$";
    my $pgp_key_start = "^-----BEGIN PGP PUBLIC KEY BLOCK-----\$";
    my $pgp_key_end   = "^-----END PGP PUBLIC KEY BLOCK-----\$";
    my ($start_idx, $end_idx, @err, @out);
    
    if (!$opt{dont_ask} 
	or !$opt{auto_decode}
	and !ask_if ('Message signed or encrypted; run PGP? [N/y] '))
    {
	print while (<>);	# nop; just echo message
	return;
    }
    
    my @msg=<STDIN>;		# swallow whole message
    
    while (index_of("^-----BEGIN PGP", \@msg)) {

	if ($start_idx=index_of($pgp_msg_start,\@msg)) {
	    # found pgp message : try to decrypt it
	    unless ($end_idx=index_of($pgp_msg_end,\@msg)) {
		print "| Unterminated PGP message!, please check:";
		print @msg;
		err_exit "$0: can't decode unterminated message";
	    } 
	    
	    @out=@err=();
	    my $passwd= $have_pass ? "$passphrase\n" : "";
	    run_pgp"$pgp +verbose=$opt{pgp_verbosity}"
		,\@out, \@err, $passwd, @msg[($start_idx-1)..($end_idx -1)];
	    substr($msg[$start_idx-1], 0, 0) = "| ";
	    ($msg[$end_idx-1] = $msg[$start_idx-1]) =~ s/BEGIN/END/;
	    splice(@msg,$start_idx, ($end_idx - $start_idx-1), @out);
	    substr($msg[$start_idx-1], 0, 0) = join("| ", "", @err);
	};
	
	if ($start_idx=index_of($pgp_key_start,\@msg)) {
	    # found a public key: run pgp on it
	    unless ($end_idx=index_of($pgp_key_end,\@msg)) {
		print "| Unterminated PGP public key!, please check:";
		print @msg;
		err_exit "$0: can't process unterminated key";
	    } 
	    
	    @out=@err=();
	    swallow_key \@out, \@err, @msg[($start_idx-1) .. ($end_idx -1)] 
		if ($opt{auto_add_keys} 
		    or ask_if("Public key found. Add to keyring? [N/y] "));
	    substr($msg[$start_idx-1], 0, 0) = 
		join("| ", "", @err, @out,"\n| ");
	    substr($msg[$end_idx-1], 0, 0) = "| ";
	}
    }
   print @msg;
}

sub encode {
    # read message from stdin and feed it to pgp for encryption

    my $pgp_cmd='fat';
    my $encrypt_for;
    my $pgp_opts="+clearsig=on +verbose=$opt{pgp_verbosity}";

    ($opt{always_encrypt} || ask_if("Encrypt message? [N/y] "))  and $pgp_cmd .='e';
    ($opt{always_sign} || ask_if("Sign message? [N/y] "))  and $pgp_cmd .='s';
    $opt{encrypt_to_self} and $pgp_opts .= ' +EncryptToSelf=on';
    if ($opt{override_recipients} && $pgp_cmd =~ /e/) {
	print STDERR "recipient(s): [$recipients]\n",
	"Press [RETURN] to confirm or enter the real recipients;\n",
	"Be careful: if you screw up, your mail will be unreadable!\n> ";
	open(TTY,"</dev/tty") || err_exit "can't open /dev/tty: $!";
	chomp($encrypt_for=<TTY>);
	close TTY;
	$recipients= $encrypt_for if ($encrypt_for);
    }

    open(PGP,"| $pgp -$pgp_cmd $pgp_opts $recipients") 
	|| err_exit("Can't execute pgp: $!");
    print PGP "$passphrase\n" if ($have_pass);
    print PGP while (<>);
    close PGP;
    $? && err_exit "Encoding failed!", pgp_strerror($?);
} 

sub check_pass {
    # usage: check_pass $pass
    # check, whether $pass is a valid pgp passphrase for current user

    (!$_[0] || ($_[0] eq "")) && return 0;
    open(PGP,"| $pgp -saft +batchmode  >/dev/null 2>&1")
	|| err_exit("Can't execute pgp: $!");
    print PGP "$_[0]\nxyz\n";
    close PGP;
    return (!$?);
}

sub read_pass {
    # usage: read_pass $passfile
    # try to retrieve pgp passphrase from the given file
    # (which is assumed to be encrypted using $tmp_key)

    my $passfile = shift;
    my @s=stat($passfile);
    my (@err,@out, @encrypted);

    # passphrase given in environment? (extremely insecure!)
    return 1 if  check_pass("$ENV{'PGPPASS'}");

    # Some paranoia checks
    if (! -f _) { 
	warn "file $passfile is not a regular file!\n";
	return 2;
    }
    if (600  != sprintf "%lo", $s[2]  & 07777) {
	warn "file $passfile has invalid permissions\n";
	return 3;
    }
    if (! -o _) {
	warn "file $passfile is not owned by you!\n";
	return 4;
    }
    if($s[3] != 1) {
	warn "there are multiple links to file $passfile!\n";
	return 5;
    }

    # construct temporary password; 
    # use "stat" output, in case no session key was given:
    local $"="";
    $tmp_key="@s[0..5]$tmp_key";
    
    # We may only ask for a phrase, if nothing is in this file
    if (!$s[7]) { return 0; }

    open(ENCRYPTED,"<$passfile") || err_exit("Can't open $passfile");
    @encrypted=<ENCRYPTED>;
    close ENCRYPTED;

    run_pgp "$pgp -f", \@out, \@err, "$tmp_key\n", @encrypted;
    $passphrase=@out[0];

    # if this occur, we already asked for the phrase
    return 6 if $passphrase eq $zaphod;
    $have_pass=1;
    return 7 unless $passphrase eq '';
}

sub get_pass {
    # Only once per run, we ask to save a passphrase
    $passphrase=$zaphod;
    
    if ($opt{auto_store_passphrase}
	or ask_if('Store your passphrase for current session? [N/y] ')) {
	print STDERR "Enter passphrase, [RETURN] when done\n",
	"(Cursor will not move) ...> ";

	do {
	    stty "echo" => "off";
	    open(TTY,"</dev/tty") || err_exit "can't open /dev/tty: $!";
	    chomp ($passphrase = <TTY>);
	    stty "echo" => "on";
	    print STDERR "\n";

	    if (check_pass("$passphrase")) { $have_pass=1; } 
	    else {
		print STDERR "Wrong passphrase! Try again >";
		$passphrase=$zaphod; 
	    }
	} until ($have_pass);
    }

    open(PASS,"| $pgp -cf >$passfile") || err_exit("Can't execute pgp: $!");
    print PASS "$tmp_key\n";
    print PASS "$passphrase\n";
    close PASS;
}

sub get_args {
    my $arg;
    while ($arg = shift(@ARGV)) {
	if ($arg =~ /^-metoo$/i)    { $opt{encrypt_to_self}=1;next;}
	if ($arg =~ /^-conf$/i)     { $dump_cfg='true'; next; }
	if ($arg =~ /^-key$/i)      { $session_key='true'; next; }
	if ($arg =~ /^-dontask$/i)  { 
	    $opt{dont_ask}=2; 
	    $opt{auto_add_keys}=$opt{auto_decode}=1; 
	    next; 
	}
	if ($arg =~ /^-passfile$/i) { $passfile=shift(@ARGV); next;}
	if ($arg =~ /^-encode$/)    { $encode='true';next;}
	if (($arg =~ /^--?h(elp)?$/) or ($arg =~ /^-\?$/)) {usage}
	$recipients .= " $arg";
    }
}

sub get_rc_options {
    my $home;
    
    unless ($home = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7]) {
	warn "Who the heck are you?!\n";
	return;
    }
    if (-r "$home/$rcfile") {
	my $line=0;
	open(RC, "$home/$rcfile");
      LINE:
	while (<RC>) {
	    $line++;
	    if (/^\s*$/) { next LINE } # empty: ignore
	    if (/^\s*(?:;|\#)/) { next LINE };
	    if (/^\s*(\w+)\s*=\s*(\w+)\s*(?:(?:\#|;).*)?$/i) 
	    {
		my ($option, $value) = (lc($1), $2);
		unless (defined $opt{$option}) {
		    warn "unknown option '$option': file "
			,"$home/$rcfile line $line!\n";
		    next LINE;
		}
		if ($option =~ /^(dont_ask|pgp_verbosity)$/) {
		    if ($value =~ /^(0|1|2)$/) 
		    { $opt{$option}= $value; }
		    else {
			warn "illegal value '$value': file "
			    ,"$home/$rcfile line $line!\n";
		    }
		    next LINE;
		}
		if ($value =~ /^(1|on|true)|(0|off|false)$/i)
		{ $opt{$option}= $1 ? 1 : 0; }
		else {
		    warn "illegal value '$value': file "
			,"$home/$rcfile line $line!\n";
		}
		next LINE;
	    }
	    warn "ignoring garbage in $home/$rcfile line $line!\n";
	}
    }
}

# Main ;-)
{
    get_args;
    get_rc_options;
    dump_cfg if $dump_cfg;
    $ENV{'PGPPASSFD'}=0;
    chomp($tmp_key=<STDIN>) if $session_key; # get session key
    read_pass($passfile) or get_pass if $passfile;
    delete $ENV{'PGPPASSFD'} if (!$have_pass);
    
    if ($encode) {encode;}
    else {decode;}  
}