#!/usr/bin/perl -w

# $Id: ca-dosign 145 2004-04-26 21:22:59Z weasel $

# Copyright (c) 1998 Ian Jackson
#           (c) 2001, 2003, 2004 Peter Palfrader
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Privacy Guard; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA.


use strict;
use IO::Handle;
use English;
use File::Path;
use Cabot qw(%CONFIG $VERSION getkeydir makekeydir mkfds ask genrandstring readwritegpg);

$OUTPUT_AUTOFLUSH = 1; 

my $config = $ENV{'HOME'} . '/.cabotrc';
-f $config or die "No file $config present.  See ca-config(5).\n";
unless (scalar eval `cat $config`) {
        die "Couldn't parse $_: $@.\n" if $@;
};

sub send_mail($$$$;$) {
	my ($to, $subject, $body, $key, $not_really) = @_;

        my $boundary = "foo";
        $boundary = genrandstring(8)
         while (grep /$boundary/, $body.$key);
	
	my $msg = << "EOF";
Subject: $subject
To: $to
Bcc: $CONFIG{'BCCmail'}
From: $CONFIG{'bot'}
User-Agent: cabot $VERSION, (c) 1998 Ian Jackson, (c) 2001, 2003, 2004 Peter Palfrader
X-URL: http://www.palfrader.org/cabot/
Content-Type: multipart/mixed; boundary="$boundary"

--$boundary
Content-type: text/plain

$body

--$boundary
Content-type: application/pgp-keys

$key

--$boundary--
EOF
	unless (defined $not_really && $not_really) {
		open(MAIL, $CONFIG{'sendmail'}) || die ("Cannot execute sendmail: $!\n");
		print MAIL $msg;
		close(MAIL);
	}

	return $msg;
};


my @keyids;
if (scalar @ARGV) {
	@keyids = @ARGV;
} else {
	opendir(DIR, $CONFIG{'tosign'}) || die ("Cannot open $CONFIG{'tosign'}: $!\n");
	@keyids = grep { (! /^\./) && (! /^cabot-/) } readdir(DIR);
	close(DIR);
};

# First retrieve all keys
for my $keyid (@keyids) {
	for my $keyserver ( @{$CONFIG{'keyservers'}} ) {
		print "Getting key from $keyserver...\n";

		my $gpg = GnuPG::Interface->new();
		$gpg->options->hash_init( 'extra_args' => '--keyserver='.$keyserver );
		my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = mkfds();
		my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
		my ($stdout, $stderr, $status) = readwritegpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
		waitpid $pid, 0;

		($status =~ /NODATA/) and
			warn("Could not import $keyid\n"),
			next;
		print "done.\n";
	};
}

# Keys fetched, now do the signing.

for my $keyid (@keyids) {
	opendir(DIR, getkeydir('tosign', $keyid)) || die ("Cannot open ".getkeydir('tosign', $keyid)." $!\n");
	my @uids = grep { (! /^\./) && (! /^cabot-/) } readdir(DIR);
	close(DIR);

	my $sendkeyserver = 1;
	my %signuids;
        # If the user did not ask for the key to be sent to the keyserver
        # for at least one uid, then it is not scheduled for upload,
        # regardless of the other answers.
	for my $uid (@uids) {
		if ( ! -e getkeydir('tosign', $keyid, $uid).'/upload' ) {
			$sendkeyserver = 0;
		};
		$signuids{$uid} = 1;
	};

	#
	# Find UIDs and if the key is useable at all.
	# also check whether we already signed any of the UIDs.

	my $gpg = GnuPG::Interface->new();
	$gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
	my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = mkfds();
	my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
	my ($stdout, $stderr, $status) = readwritegpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
	waitpid $pid, 0;

	if (length($stdout) == 0) {
		print ("Warn: Key $keyid apparently not found\n");
		next;
	};

	my @alluids;
	for my $line (split /\n/, $stdout) {
		my ($type, $trust, $length, $algo, $longkeyid, $created, $expires,
		    $serial, $ownertrust, $uid, $sigclass, $caps, $issuer, $flag) = split /:/, $line;

		if ($type eq 'pub' && $trust eq 'r') {
			print ("Warn: Key $keyid is revoked! Skipping.\n");
			next KEYS;
		};
		#if ($type eq 'pub' && $caps !~ 'E') {
		#	print ("Note: Key $keyid has no encryption capabilities! This CA-Bot cannot handle this.\n");
		#	next KEYS;
		#};
		push @alluids, { uid => $uid,
		                 revoked => ($trust eq 'r'),
		                 email => ($uid =~ /@/) ? 1 : 0 } if ($type eq 'uid' || $type eq 'uat');
	};


	print <<"EOF";

-------------------------------------
KeyID: $keyid
Please check the fingerprint against your offline records and sign
the following userids:
EOF

	my @ARGS = ();
	my $i = 0;
	for my $uid (@alluids) {
		$i++;
		my $uidtxt = $uid->{'uid'};
		$uidtxt =~ s/[^A-Za-z0-9 +_@<>()'.-]/_/g;
		if (defined $signuids{$uidtxt} ) {
			print " YES  ". $uidtxt, "\n";
			push @ARGS, $i;
		} else {
			print " NO   ". $uidtxt, "\n";
		};
	};

	print "calling GnuPG\n";
	system('gpg', '--edit', $keyid, @ARGS, 'sign', 'save', 'quit');
	#system("gpg --sign-key $keyid");

	print "Continue? [Y/n] ";
	my $cont = <stdin>;
	exit if ($cont =~ /^n/i);
	unless ( -d $CONFIG{'done'} ) {
		mkpath($CONFIG{'done'}, 0, 0711) or die("Cannot mkdir ".$CONFIG{'done'}.": $!\n");
	};

	makekeydir('done', $keyid);
	for my $uid (@uids) {
		rename(getkeydir('tosign', $keyid, $uid), getkeydir('done', $keyid, $uid)) ||
			die("Cannot move ".getkeydir('tosign', $keyid, $uid)." to "
			    .getkeydir('done', $keyid, $uid).": $!\n");
	};
	#rmdir(getkeydir('tosign', $keyid)); # may fail
	
        my $keyservernote = << "EOF";
Since you requested that your key not be uploaded to the keyserver network
I didn't submit your key there. If you want your key and my signature uploaded
you must do it yourself.
EOF
	if ($sendkeyserver) {
		if (ask("User has requested key upload. Do so?", 1)){
                        open(UPLOAD, '>', 
                             (getkeydir('tosign', $keyid) . '/cabot-upload'));
                        close UPLOAD;
                        print "Scheduled key upload.\n";
                        $keyservernote = << "EOF";
Since you requested that your key be uploaded to the keyserver network
I did submit your key there.
EOF
                } else {
                $keyservernote = << "EOF";
Although you requested your key to be uploaded to the keyserver
network I didn't submit your key there for technical reasons. Please
do it yourself.
EOF
                };
	};

	my $send_mail = ask("Send mail?", 1);

	my $text = << "EOF";
My CA software advised me that the formalities had been completed
and that I should sign your key if I was happy that it matched
with my offline record of your fingerprint.

I'm pleased to say that this was the case, so here is your key
with my signature(s).

$keyservernote

Thanks
$CONFIG{'name'}

Key included as attachment.

EOF
	my $key;
	print "Exporting key...\n";
	$gpg = GnuPG::Interface->new();
	$gpg->options->hash_init( 'armor'        => 1 );
	($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = mkfds();
	$pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
	($stdout, $stderr, $status) = readwritegpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
	waitpid $pid, 0;
	print "gpg's stderr: $stderr\n" if $stderr ne '';
	print "gpg's status: $status\n" if $status ne '';
	print "done.\n";
	$key = $stdout;

	my $to = join ', ', @uids;
	my $mail = send_mail($to, "PGP/GPG key exchange", $text, $key, 1);
	open(REPORT, '>'.getkeydir('tosign', $keyid).'/cabot-final.mail') ||
		die("Cannot open ".getkeydir('done', $keyid)."/cabot-final.mail: $!\n");
        print REPORT $mail;
        close (REPORT);
        if ($send_mail) {
            rename(getkeydir('tosign', $keyid).'/cabot-final.mail',
                   getkeydir('tosign', $keyid).'/cabot-mail.tosend');
            print "Scheduled mail sending.\n";
        };
};

# Key signed, email prepared, now do the batch sending.
# $CONFIG{'tosign'}./KEYID/cabot-mail.tosend has the mail to send to the user,
# and $CONFIG{'tosign'}./KEYID/cabot-upload tells us if we need to upload the
# key.

for my $keyid (@keyids) {
    my $sent = 0;
    my $shouldsend = -e (getkeydir('tosign', $keyid) . "/cabot-upload");
    if ($shouldsend) {
        for my $keyserver ( @{$CONFIG{'keyservers'}} ) {
    	        print "Sending keys to $keyserver...\n";

	        my $gpg = GnuPG::Interface->new();
	        $gpg->options->hash_init( 'extra_args' => '--keyserver='.$keyserver );
	        my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = mkfds();
	        my $pid = $gpg->send_keys(handles => $handles, 
                                  command_args => [ $keyid ]);
	        my ($stdout, $stderr, $status) = readwritegpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
	        waitpid $pid, 0;
                my $uploaderr = ($status =~ /NODATA/);
                if ($uploaderr) {
                    warn("Could not export key\n");
                    next;
                };
                $sent = 1;
	        print "gpg's stdout: $stdout\n" if $stdout ne '';
	        print "gpg's stderr: $stderr\n" if $stderr ne '';
	        print "gpg's status: $status\n" if $status ne '';
	        print "done.\n";
        };
    };

    if ($shouldsend && $sent) {
        print "Marking the key $keyid as sent.\n"; 
        rename(getkeydir('tosign', $keyid) . "/cabot-upload", 
               getkeydir('done', $keyid) . "/cabot-uploaded") ||
            die("Cannot move ".  getkeydir('tosign', $keyid)."/cabot-upload to "
       	        .getkeydir('done', $keyid)."/cabot-uploaded: $!\n");
    };

    if ( -e (getkeydir('tosign', $keyid) . "/cabot-mail.tosend")) {
        open(MAIL, $CONFIG{'sendmail'}) || die ("Cannot execute sendmail: $!\n");
        open MSG, (getkeydir('tosign', $keyid) . "/cabot-mail.tosend");
        my @msg = <MSG>;
        close MSG;
        print MAIL @msg;
        close MAIL ;
        unless ( -d $CONFIG{'done'}) {
            mkpath($CONFIG{'done'}, 0, 0711) 
                or die("Cannot mkdir ".$CONFIG{'done'}.": $!\n");
         };
        rename(getkeydir('tosign', $keyid). "/cabot-mail.tosend",
               getkeydir('done', $keyid). "/cabot-mail.sent") ||
        die("Cannot move " . getkeydir('tosign', $keyid). "/cabot-mail.tosend to "
               . getkeydir('done', $keyid). "/cabot-mail.sent: $!\n");
    };
    # Remove empty directory.
    opendir(KEYDIR, getkeydir('tosign', $keyid));
    my $notempty = grep { ! /^\./ } readdir(KEYDIR);
    close KEYDIR;
    rmdir(getkeydir('tosign', $keyid)) unless $notempty;
};

__END__

=pod

=head1 NAME

ca-dosign - ask user to sign PGP keys before mailing them

=head1 SYNOPSIS

B<ca-dosign>

=head1 DESCRIPTION

B<ca-dosign> is typically run by a "normal" user, having access to a private
key.  (All other ca-bot scripts are typically run under the special cabot
account.)

B<ca-dosign> is an interactive program.  For every keyid in tosign/, it fetches
public keys from an OpenPGP keyserver.  It prints a list of uids, for which
cabot successfully handled ID verification.  It calls gpg(1) in interactive
mode, to allow the user to perform the signing.  It uploads the signed key
(after getting an acknowledgement from the user).  It sends an email to the key
ID, holding the ascii-armored signed public key (again, after an
acknowledgement).

Once completed, it moves all stuff in tosign/ to done/ .

B<ca-dosign> is one of the ca-bot scripts, see ca-bot(7) for more information.

=head1 SEE ALSO

ca-bot(7)

=head1 VERSION

$Id: ca-dosign 145 2004-04-26 21:22:59Z weasel $

=head1 AUTHORS

Ian Jackson and Peter Palfrader

=cut


