X-Git-Url: https://git.sthu.org/?a=blobdiff_plain;f=caff%2Fcaff;h=4bbab0aedfab23c84aaf4dbc4ed0ea9d84e31e3d;hb=7ba830ca9f320d4cfd115d350675078f15a2bbac;hp=80bbf98d332bd1a8fdbc216efd89782ba6f7f8d8;hpb=af8dc43fab3680949b67cf7d11aa93f763652522;p=pgp-tools.git diff --git a/caff/caff b/caff/caff index 80bbf98..4bbab0a 100755 --- a/caff/caff +++ b/caff/caff @@ -1,9 +1,9 @@ #!/usr/bin/perl -w -# caff -- CA - fire and forget +# caff -- CA - Fire and Forget # $Id$ # -# Copyright (c) 2004 Peter Palfrader +# Copyright (c) 2004, 2005 Peter Palfrader # # All rights reserved. # @@ -29,6 +29,139 @@ # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +=pod + +=head1 NAME + +caff -- CA - Fire and Forget + +=head1 SYNOPSIS + +=over + +=item B [-mMR] [-u I] I [I ..] + +=back + +=head1 DESCRIPTION + +CA Fire and Forget is a script that helps you in keysigning. It takes a list +of keyids on the command line, fetches them from a keyserver and calls GnuPG so +that you can sign it. It then mails each key to all its email addresses - only +including the one UID that we send to in each mail, pruned from all but self +sigs and sigs done by you. + +=head1 OPTIONS + +=over + +=item B<-m> B<-M> + +Send/do not send mail after signing. Default is to ask the user for each uid. + +=item B<-R> + +Do not retrieve the key to be signed from a keyserver. + +=item B<-u> I + +Select the key that is used for signing, in case you have more than one key. + +=back + +=head1 FILES + +=over + +=item $HOME/.caffrc - configuration file + +=back + +=head1 CONFIGURATION FILE OPTIONS + +The configuration file is a perl script that sets values in the hash B<%CONFIG>. + +Example: + + $CONFIG{owner} = q{Peter Palfrader}; + $CONFIG{email} = q{peter@palfrader.org}; + $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ]; + +=head2 Valid keys + +=over + +=item B [string] + +Base directory for the files caff stores. Default: B<$HOME/.caff/>. + +=item B [string] + +Your name. B. + +=item B [string] + +Your email address, used in From: lines. B. + +=item B [list of keyids] + +A list of your keys. This is used to determine which signatures to keep +in the pruning step. If you select a key using B<-u> it has to be in +this list. B. + +=item B [seconds] + +Don't export UIDs by default, on which your latest signature is older +than this age. Default: B<24*60*60> (i.e. one day). + +=item B [string] + +Keyserver to download keys from. Default: B. + +=item B [string] + +Path to the GnuPG binary. Default: B. + +=item B [string] + +Path to the GnuPG binary which is used to sign keys. Default: what +B is set to. + +=item B [string] + +Path to the GnuPG binary which is used to split off signatures. This was +needed while the upstream GnuPG was not fixed. Default: what B +is set to. + +=item B [string] + +Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>. + +=item B [keyid] + +An additional keyid to encrypt messages to. Default: none. + +=item B [boolean] + +If true, then skip the step of fetching keys from the keyserver. +Default: B<0>. + +=item B [boolean] + +If true, then skip the signing step. Default: B<0>. + +=back + +=head1 AUTHOR + +Peter Palfrader + +=head1 WEBSITE + +http://pgp-tools.alioth.debian.org/ + +=cut + use strict; use IO::Handle; use English; @@ -37,6 +170,7 @@ use File::Temp qw{tempdir}; use MIME::Entity; use Fcntl; use IO::Select; +use Getopt::Std; use GnuPG::Interface; my %CONFIG; @@ -46,12 +180,12 @@ my $VERSION = "0.0.0.$REVISION_NUMER"; sub load_config() { my $config = $ENV{'HOME'} . '/.caffrc'; - -f $config or die "No file $config present. See caffrc(5).\n"; + -f $config or die "No file $config present. See caff(1).\n"; unless (scalar eval `cat $config`) { die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR; }; - die ("caffhome is not defined.\n") unless defined $CONFIG{'caffhome'}; + $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'}; die ("owner is not defined.\n") unless defined $CONFIG{'owner'}; die ("email is not defined.\n") unless defined $CONFIG{'email'}; die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'}; @@ -66,6 +200,8 @@ sub load_config() { $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'}; $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'}; $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'}; + $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'}; + $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'}; }; sub notice($) { @@ -104,7 +240,7 @@ sub readwrite_gpg($$$$$%) { trace("Entering readwrite_gpg."); - my ($first_line, $dummy) = split /\n/, $in; + my ($first_line, undef) = split /\n/, $in; debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "")); local $INPUT_RECORD_SEPARATOR = undef; @@ -125,21 +261,31 @@ sub readwrite_gpg($$$$$%) { my ($stdout, $stderr, $status) = ("", "", ""); my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'}; - trace("doign stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches; + trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches; + my $readwrote_stuff_this_time = 0; + my $do_not_wait_on_select = 0; my ($readyr, $readyw, $written); while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) { if (defined $exitwhenstatusmatches) { if ($status =~ /$exitwhenstatusmatches/m) { trace("readwrite_gpg found match on $exitwhenstatusmatches"); - last; + if ($readwrote_stuff_this_time) { + trace("read/write some more\n"); + $do_not_wait_on_select = 1; + } else { + trace("that's it in our while loop.\n"); + last; + } }; }; + $readwrote_stuff_this_time = 0; trace("select waiting for ".($sout->count())." fds."); - ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, 1); + ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1); trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0)); for my $wfd (@$readyw) { + $readwrote_stuff_this_time = 1; if (length($in) != $offset) { trace("writing to $wfd."); $written = $wfd->syswrite($in, length($in) - $offset, $offset); @@ -159,6 +305,7 @@ sub readwrite_gpg($$$$$%) { next unless (defined(@$readyr)); # Wait some more. for my $rfd (@$readyr) { + $readwrote_stuff_this_time = 1; if ($rfd->eof) { trace("reading from $rfd done."); $sout->remove($rfd); @@ -215,7 +362,7 @@ my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey'; load_config; -my $USER_AGENT = "caff $VERSION - (c) 2004 Peter Palfrader"; +my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader"; my $KEYSBASE = $CONFIG{'caffhome'}.'/keys'; my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome'; @@ -229,8 +376,8 @@ my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday); sub usage() { - print STDERR "caff $VERSION - (c) 2004 Peter Palfrader\n"; - print STDERR "Usage: $PROGRAM_NAME [-u [ ...]\n"; + print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n"; + print STDERR "Usage: $PROGRAM_NAME [-mMR] [-u ] [ ...]\n"; exit 1; }; @@ -330,20 +477,31 @@ $CONFIG{'owner'} $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id"); $message_entity->head->add("To", $address); - $message_entity->head->add("From", $CONFIG{'owner'}.' <'.$CONFIG{'email'}.'>'); + $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>'); $message_entity->head->add("User-Agent", $USER_AGENT); $message_entity->send(); $message_entity->stringify(); }; +sub sanitize_uid($) { + my ($uid) = @_; + + my $good_uid = $uid; + $good_uid =~ tr#/:\\#_#; + trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid; + return $good_uid; +}; + my $USER; my @KEYIDS; +my %opt; + +getopts('mMRu:', \%opt); usage() unless scalar @ARGV >= 1; -if ($ARGV[0] eq '-u') { - usage() unless scalar @ARGV >= 3; - shift @ARGV; - $USER = shift @ARGV; +if ($opt{u}) { + $USER = $opt{u}; + $USER =~ s/^0x//i; unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) { print STDERR "-u $USER is not a keyid.\n"; usage(); @@ -351,7 +509,8 @@ if ($ARGV[0] eq '-u') { $USER = uc($USER); }; for my $keyid (@ARGV) { - unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) { + $keyid =~ s/^0x//i; + unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8}|[A-Za-z0-9]{32})?$/) { print STDERR "$keyid is not a keyid.\n"; usage(); }; @@ -359,49 +518,106 @@ for my $keyid (@ARGV) { }; + +################# +# import own keys +################# + my $gpg = GnuPG::Interface->new(); + $gpg->call( $CONFIG{'gpg'} ); + $gpg->options->hash_init( + 'homedir' => $GNUPGHOME, + 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} ); + $gpg->options->meta_interactive( 0 ); + my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); + $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] ); + my $pid = $gpg->list_public_keys(handles => $handles, command_args => $CONFIG{'keyid'}); + my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); + waitpid $pid, 0; + if ($stdout eq '') { + warn ("No data from gpg for list-key\n"); + next; + }; + foreach my $keyid (@{$CONFIG{'keyid'}}) { + unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) { + info("Importing $keyid"); + system "gpg --export $keyid | gpg --import --homedir $GNUPGHOME"; + } + } + ############################# # receive keys from keyserver ############################# -my $gpg = GnuPG::Interface->new(); -$gpg->call( $CONFIG{'gpg'} ); -$gpg->options->hash_init( - 'homedir' => $GNUPGHOME, - 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} ); -$gpg->options->meta_interactive( 0 ); -my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); -my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]); -my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); -waitpid $pid, 0; - my @keyids_ok; my @keyids_failed; +if ($CONFIG{'no-download'} or $opt{R}) { + @keyids_ok = @KEYIDS; +} else { + my $gpg = GnuPG::Interface->new(); + $gpg->call( $CONFIG{'gpg'} ); + $gpg->options->hash_init( + 'homedir' => $GNUPGHOME, + 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} ); + $gpg->options->meta_interactive( 0 ); + my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); + + my @local_keyids = @KEYIDS; + for my $keyid (@local_keyids) { + info ("fetching $keyid..."); + my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]); + my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); + waitpid $pid, 0; + # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F # [GNUPG:] NODATA 1 # [GNUPG:] NODATA 1 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039 -for my $line (split /\n/, $status) { - if ($line =~ /^\[GNUPG:\] IMPORT_OK/) { - push @keyids_ok, shift @KEYIDS; - } elsif ($line =~ /^\[GNUPG:\] NODATA/) { - push @keyids_failed, shift @KEYIDS; + my $handled = 0; + for my $line (split /\n/, $status) { + if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) { + my $imported_key = $1; + if ($keyid ne $imported_key && + $keyid ne substr($imported_key, -16) && + $keyid ne substr($imported_key, -8)) { + warn("Imported unexpected key. expected: $keyid; got: $imported_key.\n"); + next; + }; + push @keyids_ok, $keyid; + shift @KEYIDS; + $handled = 1; + last; + } elsif ($line =~ /^\[GNUPG:\] NODATA/) { + push @keyids_failed, $keyid; + shift @KEYIDS; + $handled = 1; + last; + }; + }; + unless ($handled) { + notice ("Huh, what's up with $keyid?"); + push @keyids_failed, $keyid; + shift @KEYIDS; + }; }; -} -die ("Still keys in \@KEYIDS. This should not happen.") if scalar @KEYIDS; -notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed; + die ("Still keys in \@KEYIDS. This should not happen.") if scalar @KEYIDS; + notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed; +}; ########### # sign keys ########### -info("Sign the following keys according to your policy..."); -for my $keyid (@keyids_ok) { - my @command; - push @command, $CONFIG{'gpg-sign'}; - push @command, '--local-user', $USER if (defined $USER); - push @command, "--homedir=$GNUPGHOME"; - push @command, '--secret-keyring', $CONFIG{'secret-keyring'}; - push @command, '--sign-key', $keyid; - print join(' ', @command),"\n"; - system (@command); +unless ($CONFIG{'no-sign'}) { + info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key"); + for my $keyid (@keyids_ok) { + my @command; + push @command, $CONFIG{'gpg-sign'}; + push @command, '--local-user', $USER if (defined $USER); + push @command, "--homedir=$GNUPGHOME"; + push @command, '--secret-keyring', $CONFIG{'secret-keyring'}; + push @command, '--edit', $keyid; + push @command, 'sign'; + print join(' ', @command),"\n"; + system (@command); + }; }; ################## @@ -411,27 +627,34 @@ KEYS: for my $keyid (@keyids_ok) { # get key listing ################# - $gpg = GnuPG::Interface->new(); + my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init( 'homedir' => $GNUPGHOME ); $gpg->options->meta_interactive( 0 ); - ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); + my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] ); - $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]); - ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); + my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]); + my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; if ($stdout eq '') { warn ("No data from gpg for list-key $keyid\n"); next; }; - my $keyinfo = $stdout; my @publine = grep { /^pub/ } (split /\n/, $stdout); - my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine; - my $can_encrypt = $flags =~ /E/; + my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine; + if (scalar @publine > 0) { + warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n"); + next; + }; unless (defined $longkeyid) { - warn ("Didn't find public keyid in edit dialog of key $keyid.\n"); + warn ("Didn't find public keyid in --list-key of key $keyid.\n"); + next; + }; + unless (defined $flags) { + warn ("Didn't find flags in --list-key of key $keyid.\n"); next; }; + my $can_encrypt = $flags =~ /E/; # export the key ################ @@ -446,7 +669,7 @@ for my $keyid (@keyids_ok) { while (1) { my $this_uid_text = ''; $uid_number++; - info("Doing key $keyid, uid $uid_number"); + debug("Doing key $keyid, uid $uid_number"); # import into temporary gpghome ############################### @@ -491,7 +714,7 @@ for my $keyid (@keyids_ok) { debug("Parsing stdout output."); for my $line (split /\n/, $stdout) { debug("Checking line $line"); - my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line; + my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line; if ($type eq 'sub') { $number_of_subkeys++; }; @@ -515,6 +738,7 @@ for my $keyid (@keyids_ok) { next; }; unless ($have_one) { + debug("Uid ".($uid_number-1)." was the last, there is no $uid_number."); info("key $keyid done."); last; }; @@ -544,18 +768,26 @@ for my $keyid (@keyids_ok) { while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) { # sig:?::17:EA2199412477CAF8:1058095214:::::13x: my @sigline = grep { /^sig/ } (split /\n/, $stdout); + $stdout =~ s/\n/\\n/g; + notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX my $line = pop @sigline; my $answer = "no"; if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance - my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line; + debug("[sigremoval] doing line $line."); + my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line; if ($signer eq $longkeyid) { + debug("[sigremoval] selfsig ($signer)."); $answer = "no"; } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) { + debug("[sigremoval] signed by us ($signer)."); $answer = "no"; $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created; } else { + debug("[sigremoval] not interested in that sig ($signer)."); $answer = "yes"; }; + } else { + debug("[sigremoval] no sig line here, only got: ".$stdout); }; ($stdout, $stderr, $status) = readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1); @@ -563,9 +795,9 @@ for my $keyid (@keyids_ok) { readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; - my $asciikey = export_key($tempdir, $longkeyid); + my $asciikey = export_key($tempdir, $keyid); if ($asciikey eq '') { - warn ("No data from gpg for export $longkeyid\n"); + warn ("No data from gpg for export $keyid\n"); next; }; @@ -577,7 +809,7 @@ for my $keyid (@keyids_ok) { my $keydir = "$KEYSBASE/$DATE_STRING"; -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n"); - my $keyfile = "$keydir/$longkeyid.key.$uid_number.$this_uid_text.asc"; + my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc"; open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n"); print KEY $asciikey; close KEY; @@ -593,11 +825,14 @@ for my $keyid (@keyids_ok) { if (scalar @UIDS == 0) { info("found no signed uids for $keyid"); } else { - my @attached ; + next if $opt{M}; # do not send mail + + my @attached; for my $uid (@UIDS) { + trace("UID: $uid->{'text'}\n"); unless ($uid->{'text'} =~ /@/) { my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1); - push @attached, $uid; + push @attached, $uid if $attach; }; }; @@ -606,12 +841,11 @@ for my $keyid (@keyids_ok) { if ($uid->{'text'} =~ /@/) { my $address = $uid->{'text'}; $address =~ s/.*<(.*)>.*/$1/; - my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1); - if ($send) { + if ($opt{m} or ask("Send mail to '$address' for $uid->{'text'}?", 1)) { my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached); my $keydir = "$KEYSBASE/$DATE_STRING"; - my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".$uid->{'text'}; + my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'}); open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n"); print KEY $mail; close KEY;