X-Git-Url: http://git.sthu.org/?a=blobdiff_plain;f=caff%2Fcaff;h=026f3daa8e1bf86ea265a27615a42fc663ae080b;hb=020199a513f4280ff6f0e5f91861e2d0da99ccb2;hp=73aacd55e37ea27e2297f4ad89cf5ca2a711605d;hpb=867fc0dc05487e335fc76970534447e0d417ec2f;p=pgp-tools.git diff --git a/caff/caff b/caff/caff index 73aacd5..026f3da 100755 --- a/caff/caff +++ b/caff/caff @@ -3,7 +3,8 @@ # caff -- CA - Fire and Forget # $Id$ # -# Copyright (c) 2004 Peter Palfrader +# Copyright (c) 2004, 2005 Peter Palfrader +# Copyright (c) 2005 Christoph Berg # # All rights reserved. # @@ -39,7 +40,7 @@ caff -- CA - Fire and Forget =over -=item B [-u I] I [I ..] +=item B [-eEmMRS] [-u I] I [I ..] =back @@ -55,7 +56,32 @@ sigs and sigs done by you. =over -=item B<-u> I +=item B<-e>, B<--export-old> + +Export old signatures. Default is to ask the user for each old signature. + +=item B<-E>, B<--no-export-old> + +Do not export old signatures. Default is to ask the user for each old +signature. + +=item B<-m>, B<--mail> + +Send mail after signing. Default is to ask the user for each uid. + +=item B<-M>, B<--no-mail> + +Do not send mail after signing. Default is to ask the user for each uid. + +=item B<-R>, B<--no-download> + +Do not retrieve the key to be signed from a keyserver. + +=item B<-S>, B<--no-sign> + +Do not sign the keys. + +=item B<-u> I, B<--local-user> I Select the key that is used for signing, in case you have more than one key. @@ -75,17 +101,14 @@ The configuration file is a perl script that sets values in the hash B<%CONFIG>. Example: - $CONFIG{'owner'} = 'Peter Palfrader'; - $CONFIG{'email'} = 'peter@palfrader.org'; + $CONFIG{owner} = q{Peter Palfrader}; + $CONFIG{email} = q{peter@palfrader.org}; + $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ]; -=head2 Valid keys +=head2 Required basic settings =over -=item B [string] - -Base directory for the files caff stores. Default: B<$HOME/.caff/>. - =item B [string] Your name. B. @@ -100,14 +123,13 @@ 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] +=head2 General settings -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] -=item B [string] +Base directory for the files caff stores. Default: B<$HOME/.caff/>. -Keyserver to download keys from. Default: B. +=head2 GnuPG settings =item B [string] @@ -120,9 +142,9 @@ B is set to. =item B [string] -Path to the GnuPG binary which is used to split off signatures. This is -needed while the upstream GnuPG is not fixed (there are 2 bugs in the -Debian Bug Tracking System). Default: what B is set to. +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] @@ -132,20 +154,85 @@ Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>. An additional keyid to encrypt messages to. Default: none. +=item B [string] + +Additional arguments to pass to gpg. Default: none. + +=head2 Keyserver settings + +=item B [string] + +Keyserver to download keys from. Default: B. + =item B [boolean] If true, then skip the step of fetching keys from the keyserver. Default: B<0>. +=head2 Signing settings + =item B [boolean] If true, then skip the signing step. Default: B<0>. +=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). + +=head2 Mail settings + +=item B [boolean] + +Do not prompt for sending mail, just do it. Default: B<0>. + +=item B [boolean] + +Do not prompt for sending mail. The messages are still written to +$CONFIG{caffhome}/keys/. Default: B<0>. + +=item B [string] + +Email template which is used as the body text for the email sent out +instead of the default text if specified. The following perl variables +can be used in the template: + +=over + +=item B<{owner}> [string] + +Your name as specified in the L|/item_owner__5bstring_5d> setting. + +=item B<{key}> [string] + +The keyid of the key you signed. + +=item B<{@uids}> [array] + +The UIDs for which signatures are included in the mail. + +=back + +=item B [string] + +Address to send blind carbon copies to when sending mail. +Default: none. + =back -=head1 AUTHOR +=head1 AUTHORS + +=over + +=item Peter Palfrader + +=item Christoph Berg -Peter Palfrader +=back + +=head1 WEBSITE + +http://pgp-tools.alioth.debian.org/ =cut @@ -154,9 +241,11 @@ use IO::Handle; use English; use File::Path; use File::Temp qw{tempdir}; +use Text::Template; use MIME::Entity; use Fcntl; use IO::Select; +use Getopt::Long; use GnuPG::Interface; my %CONFIG; @@ -166,7 +255,7 @@ 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; }; @@ -188,6 +277,28 @@ sub load_config() { $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'}; + $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'}; +Hi, + +please find attached the user id{(scalar @uids >= 2 ? 's' : '')}. +{foreach $uid (@uids) { + $OUT .= "\t".$uid."\n"; +};} of your key {$key} signed by me. + +Note that I did not upload your key to any keyservers. +If you have multiple user ids, I sent the signature for each user id +separately to that user id's associated email address. You can import +the signatures by running each through `gpg --import`. + +If you want this new signature to be available to others, please upload +it yourself. With GnuPG this can be done using + gpg --keyserver subkeys.pgp.net --send-key {$key} + +If you have any questions, don't hesitate to ask. + +Regards, +{$owner} +EOM }; sub notice($) { @@ -226,7 +337,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; @@ -247,21 +358,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); @@ -281,6 +402,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); @@ -309,8 +431,11 @@ sub readwrite_gpg($$$$$%) { return ($stdout, $stderr, $status); }; -sub ask($$) { - my ($question, $default) = @_; +sub ask($$;$$) { + my ($question, $default, $forceyes, $forceno) = @_; + return $default if $forceyes and $forceno; + return 1 if $forceyes; + return 0 if $forceno; my $answer; while (1) { print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' '; @@ -337,7 +462,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 et al."; my $KEYSBASE = $CONFIG{'caffhome'}.'/keys'; my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome'; @@ -350,12 +475,22 @@ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW); 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"; - exit 1; +sub version($) { + my ($fd) = @_; + print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n"; }; +sub usage($$) { + my ($fd, $exitcode) = @_; + version($fd); + print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u ] [ ...]\n"; + print $fd "Consult the manual page for more information.\n"; + exit $exitcode; +}; + +###### +# export key $keyid from $gnupghome +###### sub export_key($$) { my ($gnupghome, $keyid) = @_; @@ -373,28 +508,50 @@ sub export_key($$) { return $stdout; }; +###### +# import a key from the scalar $asciikey into a gpg homedirectory in $tempdir +###### +sub import_key($$) { + my ($gnupghome, $asciikey) = @_; + + my $gpg = GnuPG::Interface->new(); + $gpg->call( $CONFIG{'gpg'} ); + $gpg->options->hash_init( 'homedir' => $gnupghome ); + $gpg->options->meta_interactive( 0 ); + my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); + my $pid = $gpg->import_keys(handles => $handles); + my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd); + waitpid $pid, 0; + + if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) { + return undef; + }; + return 1; +}; + + +###### +# Send an email to $address. If $can_encrypt is true then the mail +# will be PGP/MIME encrypted to $longkeyid. +# +# $longkeyid, $uid, and @attached will be used in the email and the template. +###### #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached); sub send_mail($$$@) { my ($address, $can_encrypt, $key_id, @keys) = @_; - my $message = "Hi,\n\n"; + my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'}) + or die "Error creating template: $Text::Template::ERROR"; - $message .= 'please find attached the user id'.(scalar @keys >= 2 ? 's' : '')."\n"; + my @uids; for my $key (@keys) { - $message .= "\t".$key->{'text'}."\n"; + push @uids, $key->{'text'}; }; - $message .= qq{of your key $key_id signed by me. - -Note that I did not upload your key to any keyservers. If you want this -new signature to be available to others, please upload it yourself. -With GnuPG this can be done using - gpg --keyserver subkeys.pgp.net --send-key $key_id - -If you have any questions, don't hesitate to ask. + my $message = $template->fill_in(HASH => { key => $key_id, + uids => \@uids, + owner => $CONFIG{'owner'}}) + or die "Error filling template in: $Text::Template::ERROR"; -Regards, -$CONFIG{'owner'} -}; my $message_entity = MIME::Entity->build( Type => "text/plain", Charset => "utf-8", @@ -452,12 +609,16 @@ $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("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'}; $message_entity->head->add("User-Agent", $USER_AGENT); $message_entity->send(); $message_entity->stringify(); }; +###### +# clean up a UID so that it can be used on the FS. +###### sub sanitize_uid($) { my ($uid) = @_; @@ -467,38 +628,144 @@ sub sanitize_uid($) { return $good_uid; }; +sub delete_signatures($$$$$$) { + my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_; + + my $signed_by_me = 0; + + my ($stdout, $stderr, $status) = + readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1); + + 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 + 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 $_ } @{$keyids}) { + 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); + }; + + return $signed_by_me; +}; + + + my $USER; my @KEYIDS; +my $params; + +Getopt::Long::config('bundling'); +if (!GetOptions ( + '-h' => \$params->{'help'}, + '--help' => \$params->{'help'}, + '--version' => \$params->{'version'}, + '-V' => \$params->{'version'}, + '-u=s' => \$params->{'local-user'}, + '--local-user=s' => \$params->{'local-user'}, + '-e' => \$params->{'export-old'}, + '--export-old' => \$params->{'export-old'}, + '-E' => \$params->{'no-export-old'}, + '--no-export-old' => \$params->{'no-export-old'}, + '-m' => \$params->{'mail'}, + '--mail' => \$params->{'mail'}, + '-M' => \$params->{'no-mail'}, + '--no-mail' => \$params->{'no-mail'}, + '-R' => \$params->{'no-download'}, + '--no-download' => \$params->{'no-download'}, + '-S' => \$params->{'no-sign'}, + '--no-sign' => \$params->{'no-sign'}, + )) { + usage(\*STDERR, 1); +}; +if ($params->{'help'}) { + usage(\*STDOUT, 0); +}; +if ($params->{'version'}) { + version(\*STDOUT); + exit(0); +}; +usage(\*STDERR, 1) unless scalar @ARGV >= 1; -usage() unless scalar @ARGV >= 1; -if ($ARGV[0] eq '-u') { - usage() unless scalar @ARGV >= 3; - shift @ARGV; - $USER = shift @ARGV; - unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) { + + +if ($params->{'local-user'}) { + $USER = $params->{'local-user'}; + $USER =~ s/^0x//i; + unless ($USER =~ /^([A-Z0-9]{8}|[A-Z0-9]{16}|[A-Z0-9]{40})$/i) { print STDERR "-u $USER is not a keyid.\n"; - usage(); + usage(\*STDERR, 1); }; $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-Z0-9]{8}|[A-Z0-9]{16}||[A-Z0-9]{40})$/i) { print STDERR "$keyid is not a keyid.\n"; - usage(); + usage(\*STDERR, 1); }; push @KEYIDS, uc($keyid); }; +$CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'}; +$CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'}; +$CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'}; +$CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'}; +################# +# 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 @keyids_ok; -my @keyids_failed; if ($CONFIG{'no-download'}) { @keyids_ok = @KEYIDS; } else { + info ("fetching keys, this will take a while..."); + my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init( @@ -506,7 +773,6 @@ if ($CONFIG{'no-download'}) { '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; @@ -515,29 +781,54 @@ if ($CONFIG{'no-download'}) { # [GNUPG:] NODATA 1 # [GNUPG:] NODATA 1 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039 + my %local_keyids = map { $_ => 1 } @KEYIDS; 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; - }; + if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) { + my $imported_key = $1; + my $whole_fpr = $imported_key; + my $long_keyid = substr($imported_key, -16); + my $short_keyid = substr($imported_key, -8); + my $speced_key; + for my $spec (($whole_fpr, $long_keyid, $short_keyid)) { + $speced_key = $spec if $local_keyids{$spec}; + }; + unless ($speced_key) { + notice ("Imported unexpected key; got: $imported_key\n"); + next; + }; + debug ("Imported $imported_key for $speced_key"); + delete $local_keyids{$speced_key}; + unshift @keyids_ok, $imported_key; + } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) { + } else { + notice ("got unknown reply from gpg: $line"); + } + }; + if (scalar %local_keyids) { + notice ("Import failed for: ". (join ' ', keys %local_keyids)."."); + exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0); } - die ("Still keys in \@KEYIDS. This should not happen.") if scalar @KEYIDS; - notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed; }; +unless (@keyids_ok) { + notice ("No keys to sign found"); + exit 0; +} + ########### # sign keys ########### unless ($CONFIG{'no-sign'}) { - info("Sign the following keys according to your policy..."); + 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, '--sign-key', $keyid; + push @command, '--edit', $keyid; + push @command, 'sign'; + push @command, split ' ', $CONFIG{'gpg-sign-args'} || ""; print join(' ', @command),"\n"; system (@command); }; @@ -563,14 +854,25 @@ for my $keyid (@keyids_ok) { 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/; + if (scalar @publine == 0) { + warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n"); + next; + }; + 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 ################ @@ -585,21 +887,13 @@ 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"); + my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1); # import into temporary gpghome ############################### - my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1); - my $gpg = GnuPG::Interface->new(); - $gpg->call( $CONFIG{'gpg'} ); - $gpg->options->hash_init( 'homedir' => $tempdir ); - $gpg->options->meta_interactive( 0 ); - my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); - my $pid = $gpg->import_keys(handles => $handles); - my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd); - waitpid $pid, 0; - - if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) { + my $result = import_key($tempdir, $asciikey); + unless ($result) { warn ("Could not import $keyid into temporary gnupg.\n"); next; }; @@ -630,7 +924,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++; }; @@ -639,27 +933,45 @@ for my $keyid (@keyids_ok) { if ($uid_number != $i) { debug("mark for deletion."); readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); - $delete_some = 1; + $delete_some++; } else { debug("keep it."); $have_one = 1; - $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute'; + $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]'; $is_uat = $type eq 'uat'; }; $i++; }; debug("Parsing stdout output done."); - if ($is_uat) { - notice("Can't handle attribute userid of key $keyid."); - next; - }; unless ($have_one) { - info("Uid ".($uid_number-1)." was the last, there is no $uid_number."); + debug("Uid ".($uid_number-1)." was the last, there is no $uid_number."); info("key $keyid done."); last; }; + + my $prune_some_sigs_on_uid; + my $prune_all_sigs_on_uid; + if ($is_uat) { + debug("handling attribute userid of key $keyid."); + if ($uid_number == 1) { + debug(" attribute userid is #1, unmarking #2 for deletion."); + readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); + $delete_some--; + $prune_some_sigs_on_uid = 1; + $prune_all_sigs_on_uid = 2; + } else { + debug("attribute userid is not #1, unmarking #1 for deletion."); + readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); + $delete_some--; + $prune_some_sigs_on_uid = 2; + $prune_all_sigs_on_uid = 1; + }; + } else { + $prune_some_sigs_on_uid = 1; + }; + if ($delete_some) { - debug("need to delete a few uids."); + debug("need to delete $delete_some uids."); readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1); readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); }; @@ -676,61 +988,39 @@ for my $keyid (@keyids_ok) { # delete signatures ################### - my $signed_by_me = 0; - readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); - ($stdout, $stderr, $status) = - readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1); - - 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 - debug("[sigremoval] doing line $line."); - my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = 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); + readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig + my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'}); + readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig + if (defined $prune_all_sigs_on_uid) { + readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig + delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []); + readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig }; + + 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; }; if ($signed_by_me) { if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) { - my $write = ask("Signature on $this_uid_text is old. Export?", 0); + my $write = ask("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'}); next unless $write; }; my $keydir = "$KEYSBASE/$DATE_STRING"; -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n"); my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc"; - open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n"); + open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n"); print KEY $asciikey; close KEY; - push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number }; + push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat }; info("$longkeyid $uid_number $this_uid_text done."); } else { @@ -741,10 +1031,15 @@ for my $keyid (@keyids_ok) { if (scalar @UIDS == 0) { info("found no signed uids for $keyid"); } else { - my @attached ; + next if $CONFIG{'no-mail'}; # do not send mail + + my @attached; for my $uid (@UIDS) { trace("UID: $uid->{'text'}\n"); - unless ($uid->{'text'} =~ /@/) { + if ($uid->{'is_uat'}) { + my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1); + push @attached, $uid if $attach; + } elsif ($uid->{'text'} !~ /@/) { my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1); push @attached, $uid if $attach; }; @@ -752,16 +1047,15 @@ for my $keyid (@keyids_ok) { notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt; for my $uid (@UIDS) { - if ($uid->{'text'} =~ /@/) { + if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) { my $address = $uid->{'text'}; $address =~ s/.*<(.*)>.*/$1/; - my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1); - if ($send) { + if (ask("Send mail to '$address' for $uid->{'text'}?", 1, $CONFIG{'mail'})) { my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached); my $keydir = "$KEYSBASE/$DATE_STRING"; my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'}); - open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n"); + open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n"); print KEY $mail; close KEY; }; @@ -770,59 +1064,3 @@ for my $keyid (@keyids_ok) { }; }; - - - - -###############################################################3 -#### old fork gpg --edit -=cut - my ($stdin_read, $stdin_write); - my ($stdout_read, $stdout_write); - my ($stderr_read, $stderr_write); - my ($status_read, $status_write); - pipe $stdin_read, $stdin_write; - pipe $stdout_read, $stdout_write; - pipe $stderr_read, $stderr_write; - pipe $status_read, $status_write; - - $pid = fork(); - unless ($pid) { # child - close $stdin_write; - close $stdout_read; - close $stderr_read; - close $status_read; - - my @call; - push @call, $CONFIG{'gpg-delsig'}; - push @call, "--homedir=$tempdir"; - push @call, '--with-colons'; - push @call, '--fixed-list-mode'; - push @call, '--command-fd=0'; - push @call, "--status-fd=".fileno($status_write); - push @call, "--no-tty"; - push @call, "--edit"; - push @call, $keyid; - - close STDIN; - close STDOUT; - close STDERR; - open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin: $!\n"); - open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout: $!\n"); - open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr: $!\n"); - - fcntl $status_write, F_SETFD, 0; - - exec (@call); - exit; - }; - close $stdin_read; - close $stdout_write; - close $stderr_write; - close $status_write; - - $inputfd = $stdin_write; - $stdoutfd = $stdout_read; - $stderrfd = $stderr_read; - $statusfd = $status_read; -=cut