Unpleasant GPG certification authority script

Ian Jackson ian at davenant.greenend.org.uk
Mon Apr 30 19:57:01 CEST 2001


Having built up over the past year or three an enormous pile of bits
of paper with people's GPG/PGP-prints, and having been putting off
actually doing all the admin and signing, I eventually decided that
some automation would be the right answer.

Some readers of this list have probably seen the results of that, as
my script has been engaging in some formalities with them.  Someone
asked if the script was available, and after initially saying `no I'm
still testing it' I decided that sending it out to people for review
and comment was better than just hoarding it, even if it is crap.

So here you go.  Attached is one main script `ca-process', which is a
700-odd-line Perl script, and some example config and glue.  There is
not really any documentation, so I'll write a bit about the script
here.

I did notice a couple of problems with GPG when writing the script.
Mainly, it's very hard to specify noninteractively which uids of a key
to sign, during a semiinteractive certification step.  In the end I
settled on making a separate keyring containing only the relevant key,
and using --edit-key noninteractively to remove the uids which
shouldn't be signed.  This was a bit difficult.  --yes doesn't work
properly with --edit-key --command-fd 0; saying deluid on stdin after
--command-fd 0 needs confirmation still, and you have to say `YES'
rather than just `yes' (!).  --edit-key yadayada uid 1 uid 2 deluid
doesn't seem to work at all.  --yes doesn't work properly for
--sign-key either.

In general, I would have liked it to be easier to use GPG
programmatically; perhaps I'm missing the documentation where I should
read how to do that, or perhaps I was just using a too-old version.
(Much of the initial work was done with GPG 1.0.1.)


The way it works
----------------

* You and the script together maintain a file called `status' which
records the state of the certification process for each key and uid.

* You type the key size and type, keyid, and fingerprint in to the
status file, together with the email addresses and some info about
which of your key(s) to sign with in case you have several.

* ca-process will try to get the key from the keyservers if you don't
already have it; if that doesn't work it will ask the keyholder (by
mailing the first uid to ask for the key).

* Once it has the key ca-process engages in a protocol with keyholders
to check that they can read email sent to the email addresses claimed
in the uids.  (It sends each email address a secret encrypted with the
relevant key, and expects to get the secret back in plaintext.  Only
the hash of the secret is stored in the status file.)

* When the email address reachability has been confirmed, ca-process
will invoke GPG in a suitable way for you to make the signature.  At
this point GPG will print out the fingerprint and uid again, so you
can once more check them against your offline records (the bit of
paper you collected from the key exchange, or whatever).  You have to
supply the passphrase as well, of course.

* ca-process will see whether you signed the key; if you did it will
mail it to the keyholder - and also to the keyservers, if that's where
it got it from.

* After signature, the relevant records from status will be removed
and left in the file `archive'.  ca-process also maintains a logfile
which contains transcripts of its runs.


Things you ought to know
------------------------

* ca-process operates in a `dry run' mode by default so you can see
roughly what it thinks it's going to do.  You have to give it `-y' to
actually send mails, update status, etc.

* ca-process needs an email address of its own, to receive messages
from keyholders and keyservers.  You have to somehow arrange for the
incoming mail to be put (one file per message) in a directory
specified in the config bit of the status file.


Known or potential problems
---------------------------

* You should probably use Emacs to edit the status file, and be sure
to save the file before running ca-process, or if you use another
editor, be sure to exit it while you run ca-process.  This is because
ca-process will edit the status file, and if you edit it too in a less
sophisticated editor it might not notice that the file had changed, so
you might lose changes to ca-process.

* ca-process likes to produce lots of random temporary files.  I just
use /tmp and don't bother with even including the pid in the
filenames, because the machine I use for my CA work is single-user and
mounts /tmp from ramfs (and has no swap).  Also, ca-process doesn't
bother cleaning up its temporary files when it finishes - it erases
them at startup instead (to avoid old files interfering with the new
run) - and those temp files contain sensitive stuff.  So you must
think carefully about where to put your tmp dir.

* There should be some limit on how long after a reachability check
mail is sent ca-process will accept the reply.  That feature is not
implemented yet.

* The whole software is rather ropey and is not up to the standard of
some of my better work.  I haven't done a thorough security review.

* The error handling in particular is rather dumb: if something goes
wrong you'll get a silly error message which may just refer to a line
number in ca-process.

* The text messages sent to keyholders are physically included in the
ca-process source.  Probably there should have been a separate file
for them or something.

* ca-process parses the output from gpg too much, and doesn't use
--with-colons enough.  It will almost certainly fail if you use
non-English messages, and may even fail with other versions of GPG
(I'm currently still on 1.0.4).

* The incoming email parsing is very simplistic.  This makes it hard
to attack, but easy to confuse.  If it gets confused it'll just
declare that it can't figure out the email.  You may have to fix
things up by hand, or just delete spurious incoming mails from its
queue.

* There is no mechanism included to clean out the `done' emails
directory, where ca-process puts the mails it thinks it has
processed.  Use a cron job or something.


-------------- next part --------------
#!/usr/bin/perl
# Goes through status and sends mails for each thing that needs doing

# FIXME: expire things

# ca-process et al are Copyright (C) 1998 Ian Jackson
#
# 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 POSIX;

$ca= $ENV{'CA'};
$ca= $ENV{'HOME'}.'/pgp/ca' unless length $ca;

open D, "> /dev/null" or die $!;

while ($_ = shift @ARGV) {
    last unless m/^-./;
    if (s/^-y/-/) {
	$go= 1;
    } elsif (s/^-d/-/) {
	open D, ">&STDERR" or die $!;
    } elsif ($_ ne '-') {
	die "option $_ ?";
    }
}

if (@ARGV) {
    @ARGV==1 or die;
    $ca= shift @ARGV;
}

chomp($date_now= `date +%Y-%m-%d`); $? and die $?;

load();
setup();
save_begin('chk');
delete_file("$ca/archive.new");

process_inmails();
doimport_keys();
process_keys();
acquire_keys_servers();

save_begin('new');

exit 0 unless $go;

merge_signatures_locally();
send_mails();
confirm_status();
confirm_inmails();
run_cmd("cp $ca/status $ca/archive $ca/deferred $c{'copiesdest'}/.");
run_cmd("cp $ca/copies/* $c{'copiesdest'}/.");
timed_log('finished');

open STDERR, ">&ORGERR" or die $!;
close STDOUT or die $!;
close LOG; $? and die $?;
exit 0;

sub timed_log ($) {
    run_cmd("date '+%Y-%m-%d %H:%M:%S %z (%Z) $_[0]'");
    print "\n" or die $!;
}

sub merge_signatures_locally () {
    if (stat "$td/to-merge") {
	run_cmd("$gpg --import $td/to-merge");
    } elsif ($! != &ENOENT) {
	die $!;
    }
} 

sub md5 ($) {
    open MI, "> $td/md5-in" or die $!;
    print MI $_[0] or die $!;
    close MI or die $!;
    $md5_out= `md5sum <$td/md5-in`; $? and die $?;
    chomp $md5_out; $md5_out =~ s/\s+$//;
    $md5_out =~ m/^[0-9a-f]{32}$/i or die "$md5_out ?";
    return uc $md5_out;
}

sub send_mails () {
    while ($mail_counter > 0) {
	$mfn= sprintf "%s/mailq%04d", $td, --$mail_counter;
	system "/usr/lib/sendmail -odq -oem -oi -t <$mfn"; $? and die $?;
    }
}

sub sign_key () {
    foreach $sb (map { s/^signer//; $_; } grep m/^signer\w+$/, keys %c) {
#print D "SK $sb\n";
	undef %emails_tosign;
	foreach $email (@ { $k->{' emails'} }) {
	    $e= $k->{$email};
#print D "SK $sb $email >y$sb|".$e->{"y$sb"}."<\n";
#print D "SK $sb $email >",join('|',keys %$e),"<\n";
	    next unless length $e->{"y$sb"};
	    $emails_tosign{$email}= 1;
	}
#print D "SK $sb >",join('|',keys %emails_tosign),"<\n";
	next unless %emails_tosign;
	delete_file("$td/them.pub");
	print "\nPreparing to sign ...\n" or die $!;
	run_cmd("$gpg -o $td/them.pub --export 0x$key");
	$ga= "--no-default-keyring --keyring $td/them.pub --command-fd 0";
	$ga.= " --no-greeting --edit-key 0x$key";
	$cmd= "$gpg $ga </dev/null 2>&1 |";
	print D "exec $cmd\n";
	open GP, "$cmd" or die $!;
	do { $_= <GP>; } while (m/^\n/);
	while (m/^gpg\:/) { $_= <GP>; }
	die ">$_ ?" unless m/^pub  /;
	@uidnos_todel= ();
	while ($_= <GP>, m/\S/) {
	    chomp; s/\s+$//;
	    next if m/^sub /;
	    die "$_ ?" unless m/^\((\d+)\)\s+(\S.*)$/;
	    $uidno= $1; $email= $2;
	    next if $emails_tosign{$email};
	    push @uidnos_todel, $uidno;
	}
	while (m/^\n/) { $_= <GP>; }
	die "$_ ?" if length $_;
	close GP; $? and die $?;
	if (@uidnos_todel) {
	    open NC, "> $td/edit-cmds" or die $!;
	    map { print NC "uid $_\n" or die $!; } @uidnos_todel;
	    print NC "deluid\nYES\nsave\n" or die $!;
	    close NC or die $!;
	    $cmd= "$gpg $ga <$td/edit-cmds >$td/edit-log 2>&1";
	    print D "system($cmd)\n";
	    system "$cmd";
	    $? and die "$? `cat $td/edit-log` ?";
	}
	$anysigned= 0;
	foreach $myself (split /\s+/, $c{"signer$sb"}) {
	    $myself =~ m/^[0-9a-f]+/i or die "$myself ?";
	    delete_file("$td/myself.pub");
	    delete_file("$td/myself.sec");
	    run_cmd("$gpg -o $td/myself.pub --export 0x$myself");
	    $_= `$gpg --with-colons --with-fingerprint $td/myself.pub`;
	    $? and die $?;
	    print D ">$_<\n";
	    m/^pub\:[^:]*\:\d+\:\d+\:([0-9A-F]{16})\:/m or die "$_ ?";
	    $myself_sec= $1;
	    print D ">$myself_sec<\n";
	    run_cmd("$gpg -o $td/myself.sec".
		    " --export-secret-keys 0x$myself_sec");
	    $ga= "--no-default-keyring --keyring $td/myself.pub".
		" --secret-keyring $td/myself.sec".
		    " --keyring $td/them.pub";
	    print D ">$_<\n";
	    run_cmd("$gpgi $ga --default-key $myself_sec --sign-key 0x$key");

	    $cmd= "$gpg --no-default-keyring --keyring $td/them.pub ".
		"--list-sig --with-colons";
	    $_= `$cmd`;
	    print D ">$cmd|$_<\n";
	    $? and die $?;
	    if (m/^sig\:[^:]*\:\d*\:\d*\:$myself_sec\:/m) {
		$anysigned= 1;
		print "  (Signed, thanks.)\n" or die $!;
	    } else {
		print "  (Not signed, very well.)\n" or die $!;
	    }
	}
	if ($anysigned) {
	    default_key_email();

            run_cmd("$gpg --no-default-keyring --keyring $td/to-merge".
		    " --quiet --import $td/them.pub");
	    $keyvalue= `$gpg $ga --armor --export 0x$key`; $? and die $?;

	    print "\n" or die $!;
            if ($rks= !!length $k->{$email}{'rks'}) {
		send_mail($from_bot.
			  "To: $c{'keyserver'}\n".
			  "Subject: ADD\n",
			  $keyvalue);
		print "  Submitting updated key to server.\n" or die $!;
	    }
	    send_encrypted_mail($key,
				$from_myself.
				"To: $email\n".
				"Subject: PGP/GPG key exchange\n",
 "My CA software advised me that the formalities had been completed\n".
 "and that I should sign your key if I was happy that it matched\n".
 "with my offline record of your fingerprint.\n".
 "\n".
 "I'm pleased to say that this was the case, so here is your key\n".
 "with my signature(s).\n\n".
 ($rks ?
  "Since the public keyservers already have your key, I have submitted\n".
  "the updated version (to $c{'keyserver'}).\n".
  "(Note though that this mail is being sent before I have confirmation\n".
  "from the keyserver that the update succeeded, so if you want to be\n".
  "really sure that the keyservers have the most up to date version\n".
  "of your key you must submit it yourself as well.)\n"
  :
  "Since I don't know that the public keyservers already have your key,\n".
  "I have not submitted your key there in case you didn't want that.  If\n".
  "you want your key and my signature uploaded you must do it yourself.\n"
  ). "\n".
 "Thanks\n".
 $c{'myname'}.
 "\n\n".
				$keyvalue);
	    print "  Returning updated key to keyholder.\n" or die $!;
	} else {
	    print "\n  (No changes, not mailing.)\n" or die $!;
	}
	foreach $email (%emails_tosign) {
	    $k->{$email}{'sig'}= $date_now;
	}
    }
}

sub delete_file ($) {
    unlink("$_[0]") || $!==&ENOENT or die "$_[0] $!";
}

sub run_cmd ($) {
    print D "run_cmd($_[0])\n";
    $!=0; system $_[0];  die "$_[0] $! $?" if $! || $?;
}

sub confirm_new_file ($) {
    delete_file("$ca/$_[0].old");
    link "$ca/$_[0]", "$ca/$_[0].old" or die $!;
    rename "$ca/$_[0].new", "$ca/$_[0]" or die $!;
}

sub confirm_status () {
    if (stat "$ca/archive.new") {
	confirm_new_file('archive');
    } elsif ($! != &ENOENT) {
	die $!;
    }
    confirm_new_file('status');
    run_cmd('sync');
}

sub process_inmails () {
    foreach $inmail (<$c{'mailin'}>) {
	print "$inmail\n" or die $!;
	open M,"< $inmail" or die $!;
	$!=0; undef $/; $msg=<M>; $/="\n";
	close M; $! and die $!;
	if (eval {
	    if ($msg =~
 m/^Subject\: Your command\, GET 0x([0-9A-F]{8})\, failed$/m
		     ) {
		$kid8= $1;
		printf " keyserver request failed %s\n", $kid8 or die $!;
		die "unknown key" unless exists $kid8s{$kid8};
		$key= $kid8s{$kid8};
		$k= $keys{$key};
		default_key_email();
		printf " %s %s %s\n %s\n", $k->{' bitstype'},
		    $kid8, $key, $email or die $!;
		$e= $k->{$email};
		die "unrequested key" unless exists $e->{'sks'};
		if (!exists $e->{'fks'}) {
		    $e->{'fks'}= $date_now;
		    print " noted\n\n" or die $!;
		} else {
		    print " noted - again!\n\n" or die $!;
		}
	    } elsif ($msg =~ m/^\-\-+BEGIN.*KEY/m) {
		$from_keyservers= $msg =~ m/^Subject\: Your command\, GET/m;
		while ($msg =~ m/^\-\-+BEGIN.*KEY/m) {
		    $_= $&.$';
		    m/^\-\-+END.*/m or die "missing END";
		    $keyfile= $`.$&;
		    $msg= $';
		    open K, "> $td/import.asc" or die $!;
		    print K $keyfile or die $!;
		    close K or die $!;
		    run_cmd("$gpg --dearmor <$td/import.asc >$td/import.pgp");
		    $ga= "--no-default-keyring --keyring $td/import.pgp";
		    run_cmd("$gpg $ga --fingerprint >$td/implist");
		    open KL, "$td/implist" or die $!;
		    $_=<KL>; m,^/, or die;
		    $_=<KL>; m/^\-\-/ or die;
		    $any=0;
		    while (<KL>) {
			chomp; s/\s+$//;
			next unless m/^pub /;
			m/^pub  (\d+[A-Za-z])\/([0-9A-F]{8})\s.*/
			    or die "$_ ?";
			$head= $_;
			$_= <KL>;
			m/^     Key fingerprint = ([0-9A-F ]+)$/ or
			    die "$keyhead\n$_ ?";
			$key= $1; $key =~ s/ //g;
			die "key $key not found\n$head\n ?" unless
			    exists $keys{$key};
			delete_file("$td/impexp");
			run_cmd("$gpg $ga -o $td/impexp --export 0x$key");
			run_cmd("$gpg $td/impexp");
			run_cmd("cat $td/impexp >>$td/all-imports");
			if ($from_keyservers) {
			    $k= $keys{$key};
			    default_key_email();
			    print D "RKS>$key|$email<\n";
			    $k->{$email}{'rks'}= $date_now;
			}
			$any=1;
		    }
		    die 'no keys' unless $any;
		    printf "  (keys from %s)\n\n",
		        ($from_keyservers ? 'server' : 'owner')
			    or die $!;
		}
	    } elsif ($msg =~ m/FiRyRKWK/) {
		print " reachability confirmations\n" or die $!;
		$any= 0;
		while ($msg =~ s/FiRyRKWK([0-9A-F]+)RBekzYbZ/ /) {
		    $rpass= $1;
		    $spw= md5($c{'versalt'}.$rpass);
		    printf " %s\n %s\n", $spw, $rpass or die $!;
		    die "unknown confirm hash" unless exists $spws{$spw};
		    ($key,$email) = @ { $spws{$spw} };
		    $k= $keys{$key};
		    $e= $k->{$email};
		    printf " %s %s %s\n %s\n", $k->{' bitstype'},
		        $k->{' kid8'}, $key, $email or die $!;
		    $e->{'spw'} =~ m/^\d{4}\-\d\d\-\d\d ([0-9A-F]+)$/ or
			die "$e->{'spw'} ?";
		    $1 eq $spw or die;
		    if (exists $e->{'rpw'}) {
			print " confirmed - again !\n\n" or die $!;
		    } else {
			print " confirmed\n\n" or die $!;
			$e->{'rpw'}= $date_now;
		    }
		    $any= 1;
		}
		die "none found!\n" unless $any;
	    } elsif ($msg =~ m/^Subject\: Your command\, ADD$/m) {
		die "no signatures added\n" unless
		    $msg =~ m/^\s*New signatures added\: \d+\s*$/m;
		print " ack of key upload\n\n" or die $!;
	    } else {
		die "unknown message";
	    }
	    1;
	}) {
	    push @mails_done, $inmail;
	} else {
	    print " !! $@\n" or die $!;
	}
    }
}

sub doimport_keys () {
    if (stat "$td/all-imports") {
	run_cmd("$gpg ". ($go ? '--import' : '')." $td/all-imports");
	print "\n" or die $!;
    } elsif ($! != &ENOENT) {
	die $!;
    }
}

sub confirm_inmails () {
    foreach $inmail (@mails_done) {
	$basename= $inmail;  $basename =~ s,^.*/,,;
	rename $inmail, $c{"maildone"}.'/'.$basename or die $!;
    }
}

sub randhex ($) {
    sysread(UR,$rand_data,$_[0]) == $_[0] or die $!;
    $rand_data= uc unpack 'h*',$rand_data;
}

sub send_encrypted_mail ($$$) { # recipientkey, header, ciphertext
    open E, "> $td/plain\n" or die $!;
    print E $_[2] or die $!;
    close E or die $!;
    $ciph= `$gpg --encrypt --armor --always-trust -r 0x$_[0] <$td/plain`;
    $? and die $?;
    send_mail($_[1],
	      $auto_preamble.
	      $ciph.
	      "\n");
}

sub proc_found_email () {
    printf " %s\n", $email  or die $!;
    delete $e->{'*NIK'};
    if (!grep m/^y/, keys %$e) {
	print "  (not checked)\n" or die $!;
	return;
    }
    if (!exists $e->{'spw'}) {
	$rpass= randhex(24);
	print "  (testing keyholder reachability)\n" or die $!;
	$k->{' todo'}= 'w';
	print D ">$rpass<\n";
	$e->{'spw'}= $date_now.' '.md5($c{'versalt'}.$rpass);
	send_encrypted_mail($key,
			    $from_bot.
			    "To: $email\n".
			    "Subject: PGP/GPG key exchange formalities\n",
 "This message is sent as part of my certification process.\n".
 "It is to verify that you, the keyholder of\n".
 " $k->{' bitstype'}/$k->{' kid8'} $key\n".
 "can read email sent to the associated address\n".
 " $email\n".
 "\n".
 "Please, now that you have decrypted this message,\n".
 "simply reply to the bot email address\n".
 " $c{'botmail'}\n".
 "quoting the magic string\n".
 " FiRyRKWK${rpass}RBekzYbZ\n".
 "in the body of your mail.\n".
 "\n".
 "If you asked me to certify more than one userid or email address\n".
 "on your key you should receive one of these messages for each\n".
 "address - in that case please send one reply per address, too.\n".
 "\n".
 "Please do NOT encrypt or MIME-encode the resulting mail; the bot\n".
 "does not have access to my key and does not run MIME software.\n".
 "\n".
 "Thanks,\n".
 $signoff
			    );
    } elsif (!exists $e->{'rpw'}) {
	print "  (awaiting confirmation of reachability)\n" or die $!;
	$k->{' todo'}= 'w';
    } elsif (!exists $e->{'sig'}) {
print D "$key>$k->{' todo'}<\n";
	print "  (awaiting signature)\n" or die $!;
	$k->{' todo'}= 's' unless $k->{' todo'} =~ m/w/;
print D "$key>$k->{' todo'}<\n";
    } else {
	print "  (signed)\n" or die $!;
	$k->{' todo'}= 'a' unless $k->{' todo'} =~ m/[ws]/;
    }
}

sub setup () {
    if ($go) {
	open ORGERR, ">&STDERR" or die $!;
	open LOG, "| tee -a $c{'log'}" or die $!;
	open STDOUT, ">&LOG" or die $!;
	open STDERR, ">&LOG" or die $!;
	$|=1;
    }

    $td= $c{'tmp'};
    length $td or die;
    run_cmd("rm -rf $td");
    mkdir $td, 0700;
    open UR, "< /dev/urandom" or die $!;
    
    $auto_preamble=
 "You are being sent this mail because we exchanged PGP/GPG key\n".
 "fingerprints at some point in the past.  This mail is semiautomatic,\n".
 "from my PGP/GPG CA management software; my apologies for the formality.\n".
 "If for some reason you need to talk to me rather than my bot, please\n".
 "mail me personally: $c{'myname'} <$c{'ownmail'}>.\n\n";
    $signoff= "CA software running on behalf of $c{'myname'}\n";
    $from_bot= "From: $c{'myname'} CA bot <$c{'botmail'}>\n";
    $from_myself= "From: $c{'myname'} <$c{'ownmail'}>\n";
    $gpgi= 'gpg --lock-never';
    $gpg= "$gpgi --batch";
    timed_log($go ? 'running' : 'running - TEST MODE (use -y for real run)');
}

sub acquire_keys_servers () {
    foreach $sk (keys %send_ks) {
	send_mail($from_bot.
		  "To: $c{'keyserver'}\n".
		  "Subject: GET 0x$sk\n",
		  "\n".
		  "-- \n");
    }
}

sub send_mail ($$) {
    $mfn= sprintf "%s/mailq%04d", $td, $mail_counter++;
    open M, ">$mfn" or die $!;
    print M $_[0],"Bcc: $c{'bccmyself'}\n\n",$_[1] or die $!;
    close M or die $!;
}

sub default_key_email () {
    ($email) = @ { $k->{' emails'} };
    length $email or die;
}

sub acquire_key () {
    default_key_email();
    printf " %s\n", $email or die;
    $e= $k->{$email};
    if (!exists $e->{'sks'}) {
	$send_ks{$k->{' kid8'}}= 1;
	$e->{'sks'}= $date_now;
	print "  Requesting from keyserver.\n" or die;
    } elsif (!exists $e->{'fks'}) {
	print "  (awaiting from keyserver)\n" or die;
    } elsif (!exists $e->{'skh'}) {
	send_mail($from_bot.
		  "To: $email\n".
		  "Subject: Send me your public key $k->{' kid8'}\n",
		  $auto_preamble.
 "I tried to get your public key from the keyservers, but there\n".
 "was some kind of problem (most likely they didn't have it).\n\n".
 "So, could you please provide your public key now so that I can\n".
 "continue with my certification procedure.  Just send me your key,\n".
 "ASCII armoured, in an email to the address above.\n\n".
 "The relevant key is $k->{' bitstype'}/$k->{' kid8'}, with fingerprint:\n".
 " $key.\n".
 "The email address I have for it is:\n".
 " $email\n\n".
 "I'll be in touch, thanks.\n".
 $signoff
		  );
	$e->{'skh'}= $date_now;
	print "  Requesting from keyholder.\n" or die;
    } else {
	print "  (awaiting from keyholder)\n" or die;
    }
}
	    
sub process_keys () {
    print D ">",join("|", at file),"<\n";
    for $fe (@file) {
	$key= $fe;
	next unless $key =~ s/^k //;
	$k= $keys{$key};
	printf "%s/%s %s\n", $k->{' bitstype'}, $k->{' kid8'}, $key  or die $!;
	$_= `$gpg --fingerprint 0x$key 2>&1`;
	if (!$? && m/^pub +(\d+[a-zA-Z])\/([0-9A-F]{8})[ \t]\d{4}\-\d\d\-\d\d[ \t](\S.*)/) {
	    $1 eq $k->{' bitstype'} or die "$key $1 $k->{' bitstype'}";
	    $2 eq $k->{' kid8'} or die "$key $2 $k->{' kid8'}";
	    @found_emails= ("uid $3");
	    m/^pub.*\npub/m and die;
	    m/^     Key fingerprint = ([0-9A-F ]+)\s*$/m or die "$_ ?";
	    $finger= $1; $finger =~ s/ //g;
	    $finger eq $key or die;
	    undef %emails;
	    foreach $email (@ { $k->{' emails'} }) { $emails{$email}= 1; }
print D ">",join('|',keys %emails),"<$headmail($_)\n";
	    @other_emails= ();
	    push @found_emails, split /\n/, $_;
print D ">",join('|', at found_emails)."\n";
	    foreach $email (@found_emails) {
		next unless $email =~ s/^uid\s+//;
		if (exists $emails{$email}) {
		    delete $emails{$email};
		    $e= $k->{$email};
		    proc_found_email();
		} else {
		    push @other_emails, $email;
		}
print D "$email>",join('|',keys %emails),"<\n";
	    }
	    foreach $email (keys %emails) {
		printf " %s\n  (not found)\n", $email  or die $!;
		$k->{$email}{'*NIK'}= $date_now;
	    }
	    if (keys %emails) {
		foreach $email (@other_emails) {
		    printf " %s\n  (added)\n", $email  or die $!;
		    push @ { $k->{' emails'} }, $email;
		    $k->{$email}{'fik'}= $date_now;
		}
	    }
print D "$key>$k->{' todo'}<\n";
	    if ($k->{' todo'} eq 's') {
		sign_key();
	    }
	    if ($k->{' todo'} eq 'a') {
		if (!stat "$ca/archive.new") {
		    $!==&ENOENT or die $!;
		    run_cmd("cp $ca/archive $ca/archive.new");
		}
		open Y, ">>$ca/archive.new" or die $!;
		print Y "# $date_now\n" or die $!;
		write_key_record();
		print Y "\n" or die $!;
		close Y or die $!;
		delete $todo{$key};
		delete $keys{$key};
		@file= grep { $_ ne "k $key" } @file;
		print "  Archiving.\n" or die $!;
	    }
	} elsif (m/^gpg: .* public key not found$/) {
	    acquire_key();
	} else {
	    die "$_ $? ?";
	}
	print "\n" or die $!;
    }
    print D ">",join("|", at file),"<\n";
}

sub write_key_record () {
    $k= $keys{$key};
    printf Y "%s %s %s\n", $k->{' bitstype'}, $k->{' kid8'}, $key
	or die $!;
    foreach $email (@ { $k->{' emails'} }) {
	next if $email =~ m/^ /;
	printf Y " %s\n", $email  or die $!;
	$e= $k->{$email};
	foreach $prop (sort keys %$e) {
	    printf Y "%s%s %s\n",
	    $prop =~ m/^\*/ ? '*' : '  ',
	    $prop, $e->{$prop}  or die $!;
	}
    }
}

sub save_begin ($) {
    open Y,"> $ca/status.$_[0]" or die $!;

    map { $todo{$_}= 1; } keys %keys;
    foreach $fe (@file) {
	$key= $fe;
	if ($key =~ s/^v //) {
	    printf Y "%s\n", $key  or die $!;
	} elsif ($key =~ s/^k //) {
	    exists $todo{$key} or die "$fe ?";
	    write_key_record();
	    delete $todo{$key};
	} else {
	    die "$fe ?";
	}
    }
    die if keys %todo;
    close Y or die $!;
}

sub load__outside () {
    undef $key;
    undef $email;
}

sub load () {
    open X,"< $ca/status" or die $!;
    $!=0;
    while (<X>) {
	chomp; s/\s+$//;
	if (m/^(\d+)([a-z]) ([0-9a-f]{8}) ([0-9a-f ]+)$/i) {
	    $bitstype= "$1$2"; $kid8= uc $3; $key= uc $4;
	    $key =~ s/ //g;
	    die if exists $keys{$key};
	    push @file, "k $key";
	    $keys{$key}{' bitstype'}= $bitstype;
	    $keys{$key}{' kid8'}= $kid8;
	    $kid8s{$kid8}= $key;
	    next;
	} elsif (m/^ (\S.*)/) {
	    $email= $1;
	    die unless length $key;
	    die if exists $keys{$key}{$email};
	    push @ { $keys{$key}{' emails'} }, $email;
	    $keys{$key}{$email}= { };
	    next;
	} elsif (m/^  (\w+) (\S.*)/ ||
		 m/^\*(\*\w+) (\S.*)/) {
	    die unless length $email;
	    die if exists $keys{$key}{$email}{$1};
	    $keys{$key}{$email}{$1}= $2;
	    if ($1 eq 'spw') {
		$spw= $2;
		$spw =~ s/^[0-9]{4}\-\d\d\-\d\d //;
print D "SPW $key,$email>$spw<\n";
		$spws{$spw}= [ $key, $email ];
	    }
	    next;
	} elsif (m/^c (\w+) (\S.*)/) {
	    load__outside();
	    $c{$1}= $2;
	} elsif (!m/\S/) {
	    load__outside();
	} elsif (!m/^\#/) {
	    die "$_ ?";
	}
	push @file, "v $_";
    }
    close X; die $! if $!;
}
-------------- next part --------------
# Lines:
# c VARIABLE VALUE		sets config var
# c signerSB			key fingerprint(s) to sign with
# BITSTYPE KID8 FINGER PRINT...	starts new key
#  NAME <EMAIL>			userid to sign
#   ySB YYYY-MM-DD		photo id checked for that id
#   sks YYYY-MM-DD		we sent a key request on that date to servers
#   fks YYYY-MM-DD		got server key request fail on that date
#   rks YYYY-MM-DD		the keyservers sent us the key
#   skh YYYY-MM-DD		we sent a key request on that date to holder
#   spw YYYY-MM-DD PW		we sent that pw on that date
#   rpw YYYY-MM-DD		we received our pw on that date
#   fik	YYYY-MM-DD		found in key and added for user's benefit
# **NIK YYYY-MM-DD		userid not found in copy of key we have
#				blank lines ignored between keys
# #				comments

c ownmail ian at chiark.greenend.org.uk
c bccmyself ian+pgp-ca-log at davenant.greenend.org.uk
c botmail ian+pgp-ca-bot at chiark.greenend.org.uk
c keyserver pgp-public-keys at keys.nl.pgp.net
c myname Ian Jackson
c tmp /tmp/ca-tmp
c mailin /u/ian/junk/ca/inmails/q*
c maildone /u/ian/junk/ca/done
c copiesdest /u/ian/junk/ca/copies
c log /u/ian/junk/ca/log
c secring /u/ian/.gnupg/secring.gpg
c versalt <insert random string of 40-odd hex digits here>
c signerph 8F2750EC0C5F2BE5A85460026DC3D476 5906F687BD03ACAD0D8E602EFCF37657
c signerkn 3A25A55B51CDCDCD47CCFAD774360E9F 5906F687BD03ACAD0D8E602EFCF37657

1024R 23f5addb 59 06 f6 87 bd 03 ac ad  0d 8e 60 2e fc f3 76 57
 Ian Jackson <ian at chiark.greenend.org.uk>
  ykn 2001-04-30
-------------- next part --------------
#!/bin/sh
set -e
#net r

cd /u/ian/junk/ca

if ssh davenant mv -v mail/PGP-CA-BOT/q\* mail/PGP-CA-BOT.dirxfer/.
then
	dirxfer -n -c 'ssh davenant dirxfer -d -n -a '\
'/u/ian/mail/PGP-CA-BOT.dirxfer /dev/nonexistent' \
		/dev/nonexistent /u/ian/junk/ca/inmails.dirxfer
	cd /u/ian/junk/ca/inmails.dirxfer
	rename 's,^,../inmails/q,' *
fi

ssh davenant gpg --quiet --import <copies/pubring.gpg

really runq


More information about the Gnupg-devel mailing list