Re: mu-mh questions

#! /bin/sh
# Simple script to show PGP encrypted MIME parts.
# Usage (from .mh_profile):
#   mhn-show-application/octet-stream: mhshow %F

type=`file -b ${1:?}`
case $type in
"PGP message")
	temp=/tmp/mhshow.$$
	trap "rm -f $temp" TERM QUIT
	if gpg --decrypt $1 > $temp; then
	    mhn -show -file $temp || less -c $temp
	fi
	rm $temp
	;;
*)
	od -c $1 | less
	;;
esac

#! /usr/bin/perl
use strict;
use warnings;
use Getopt::Long qw(:config gnu_getopt no_ignore_case require_order);
use File::Temp qw(tempfile);
use File::Copy;
use File::Basename;
use Cwd qw(abs_path);
use Pod::Man;
use Pod::Usage;

=head1 NAME

mhgpg - wrapper for verifying, signing, and encrypting messages using GPG

=head1 SYNOPSIS

B<mhgpg>
[B<-ves>]
[B<--verify>]
[B<--encrypt>]
[B<--sign>]
[B<--> I<GPGOPT>...]
I<FILE>    

B<edit mhgpg>
[B<-ves>]
[B<--verify>]
[B<--encrypt>]
[B<--sign>]
[B<--> I<GPGOPT>...]

=head1 DESCRIPTION

Verifies, signs, or encrypting messages from B<MH> using B<GPG>.   The script
is normally invoked from the B<whatnow> prompt as B<edit mhgpg I<OPTIONS>>.

I<OPTIONS> select operation mode.  If the B<--> marker is present, all arguments
that follow it will be passed to the B<gpg> command line.  Another way to pass
additional options to B<gpg> is by specifying them in the B<gpg-options> entry
in F<~/.mh_profile>.  If both methods are used, options from B<gpg-options>
precede those from the command line.

=head1 OPTIONS

=over 4

=item B<-v>, B<--verify>

Verify the GPG signature.  This is the default.

=item B<-s>, B<--sign>    

Sign the message.  The key to sign with can be specified in the B<gpg-user>
profile entry.

=item B<-e>, B<--encrypt>

Encrypt the message.  Can be used together with B<--sign>.    

=back

=head1 AUTHOR

Sergey Poznyakoff <[email protected]>    
    
=cut    

my @gpg = ( 'gpg' );

my $verify;
my $sign;
my $encrypt;

my $input;
my $inputdir;

my %profile;

my @tempfiles;
END {
    unlink @tempfiles if @tempfiles;
}


sub readprofile {
    my $name = $ENV{MH} || "$ENV{HOME}/.mh_profile";
    return undef unless -f $name;
    open(my $fd, '<', $name) or die "can't open profile $name: $!";
    my $line;
    while (<$fd>) {
	chomp;
	if (s/^\s+/ /) {
	    $line .= $_;
        } else {
	    if (defined($line) && $line !~ /^#/ && $line !~ /^$/) {
		my ($kw, $val) = split /:/, $line, 2;
		if (defined($kw) && defined($val)) {
		    $profile{$kw} = $val;
		}
	    }
	    $line = $_;
	}
    }
    if (defined($line) && $line !~ /^#/ && $line !~ /^$/) {
	my ($kw, $val) = split /:/, $line, 2;
	if (defined($kw) && defined($val)) {
	    $profile{$kw} = $val;
	}
    }
    close($fd);
}

sub split_message_parts {
    my $file = shift;
    open(my $fd, '<', $file)
	or die "can't open $file: $!";
    # Split message on header and body parts
    my @headers;
    my $body;
    while (<$fd>) {
	chomp;
	if (/^(-+)?$/) {
	    local $/ = undef;
	    $body = <$fd>;
	    last;
	}
	push @headers, $_;
    }
    close $fd;

    return \@headers unless wantarray;
    
    die "malformed input"
	unless $body;
    return ( \@headers, $body );
}

sub getkeys {
    my ($opt, $input) = @_;
    my $fd;

    open($fd, '-|', "whom $input")
	or die "whom failed";
    my @recp;
    while (<$fd>) {
	chomp;
	s/^\s+//;
	if (/^-- Network Recipients --$/) {
	    push @recp, 1;
	} elsif (/^-- .* --$/) {
	    last;
	} elsif (@recp)	{
	    if (s/^(.+?)\s+at\s+(.+)$/$1\@$2/) {
		push @recp, $_;
	    }
	}
    }
    close $fd;
    
    shift @recp;

    die "no recipients in message"
	unless @recp;

    open($fd, '-|', 'gpg', '--list-keys', '--with-colons', @recp)
	or die "can't list keys";
    while (<$fd>) {
	chomp;
	if (/^pub:/) {
	    my @a = split /:/;
	    print "signing for $a[9]\n";
	    push @gpg, $opt, $a[4]
	}
    }
    close $fd;
}

sub gpg_verify {
    open(STDIN, '<', $input);
    exec(@gpg, '--verify');
}

sub replace_input {
    my $msgfile = shift;
    
    my $backup = $inputdir . '/' . ',' . basename($input);
    unlink $backup if -e $backup;
    rename $input, $backup
	or die "can't rename $input to $backup: $!";
    rename $msgfile, $input
	or die "can't rename $msgfile to $input: $!";
}

sub gpg_sign {
    my $fd;

    push @gpg, '--clearsign';
    
    my ($href, $body) = split_message_parts($input);
    
    ($fd, my $bodyfile) = tempfile('mhgpgXXXXXX',
				   SUFFIX => '.bod',
				   DIR => $inputdir,
				   UNLINK => 1);
    print $fd $body;
    close $fd;

    my $outfile = $bodyfile . '.out';
    push @tempfiles, $outfile;
    
    system(@gpg, '--output', $outfile, $bodyfile);
    if ($? == -1) {
	die "failed to run gpg: $!";
    } elsif ($? & 127) {
	die "gpg died with signal ".($? & 127);
    } else {
	my $code = $? >> 8;
	if ($code) {
	    die "fatal error";
	}
    }
    
    ($fd, my $msgfile) = tempfile('mhgpgXXXXXX',
				  SUFFIX => '.msg',
				  UNLINK => 1,
				  DIR => $inputdir);
    select((select($fd), $|=1)[0]);
    print $fd join("\n", @$href);
    print $fd "\n\n";
    copy($outfile, $fd);
    close($fd);

    replace_input($msgfile);
}

sub gpg_encrypt {
    push @gpg, '--armor';
    getkeys('-r', $input);

    my ($href, $body) = split_message_parts($input);
    
    my $ascfd = tempfile();
    $^F = 255;
    my $pid = fork;
    if ($pid == 0) {
	open(STDOUT, '<&', $ascfd) or die "can't redirect STDOUT";
	open(my $fd, '|-', @gpg) or die "gpg failed";
	print $fd $body;
	close $fd;
	exit !!$?
    }
    my $ret = wait;
    exit(1) if $ret != $pid or $?;
    
    my $bdry = sprintf("%08u-%08u=:%u", int(rand(0xffffffff)),
		       time, $$);
    
    my ($fd, $msgfile) = tempfile('mhgpgXXXXXX',
				  SUFFIX => '.msg',
				  DIR => $inputdir,
				  UNLINK => 1);
    select((select($fd), $|=1)[0]);
    foreach my $h (@$href) {
	print $fd "$h\n";
    }
    print $fd "Mime-Version: 1.0\n";
    print $fd "Content-Type: multipart/encrypted; protocol=\"application/pgp-encrypted\"; boundary=\"$bdry\"\n";
    print $fd "\n";

    print $fd <<EOT
--$bdry
Content-Type: application/pgp-encrypted
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment

Version: 1

EOT
;
    print $fd <<EOT
--$bdry
Content-Type: application/octet-stream
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment; filename="msg.asc"

EOT
;
    seek $ascfd, 0, 0;
    copy($ascfd, $fd);

    print $fd "\n";
    print $fd "--$bdry--\n";

    close($fd);

    replace_input($msgfile);
}

GetOptions("sign|s" => \$sign,
	   "encrypt|e" => \$encrypt,
	   "verify|v" => \$verify,
	   "help|?" => sub {
	       pod2usage(-exitstatus => 0, -verbose => 2);
	   }	   
    ) or exit(1);

pod2usage(-exitstatus => 1, -verbose => 0, -output => \*STDERR)
    if (($sign||$encrypt) && $verify);

$verify = 1
    unless ($sign||$encrypt);

pod2usage(-exitstatus => 1, -verbose => 0, -output => \*STDERR)
    unless @ARGV == 1;

$input = abs_path(pop(@ARGV));
$inputdir = dirname($input);

readprofile;

push @gpg, $profile{'gpg-options'} if exists($profile{'gpg-options'});
push @gpg, @ARGV;

if ($verify) {
    gpg_verify;
} else {
    if ($encrypt) {
	push @gpg, '--encrypt';
	gpg_encrypt
    } elsif ($sign) {
	push @gpg, '-u', $profile{'gpg-user'} if exists($profile{'gpg-user'});
	if ($encrypt) {
	    push @gpg, '--sign', '--encrypt';
	    gpg_encrypt
	} else {
	    gpg_sign;
	}
    }
}