3 # caff -- CA - Fire and Forget
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
13 # 1. Redistributions of source code must retain the above copyright
14 # notice, this list of conditions and the following disclaimer.
15 # 2. Redistributions in binary form must reproduce the above copyright
16 # notice, this list of conditions and the following disclaimer in the
17 # documentation and/or other materials provided with the distribution.
18 # 3. The name of the author may not be used to endorse or promote products
19 # derived from this software without specific prior written permission.
21 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
22 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
23 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
24 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
25 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
26 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
30 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36 caff -- CA - Fire and Forget
42 =item B<caff> [-mMR] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
48 CA Fire and Forget is a script that helps you in keysigning. It takes a list
49 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
50 that you can sign it. It then mails each key to all its email addresses - only
51 including the one UID that we send to in each mail, pruned from all but self
52 sigs and sigs done by you.
60 Send/do not send mail after signing. Default is to ask the user for each uid.
64 Do not retrieve the key to be signed from a keyserver.
66 =item B<-u> I<yourkeyid>
68 Select the key that is used for signing, in case you have more than one key.
76 =item $HOME/.caffrc - configuration file
80 =head1 CONFIGURATION FILE OPTIONS
82 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
86 $CONFIG{owner} = q{Peter Palfrader};
87 $CONFIG{email} = q{peter@palfrader.org};
88 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
94 =item B<caffhome> [string]
96 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
98 =item B<owner> [string]
100 Your name. B<REQUIRED>.
102 =item B<email> [string]
104 Your email address, used in From: lines. B<REQUIRED>.
106 =item B<keyid> [list of keyids]
108 A list of your keys. This is used to determine which signatures to keep
109 in the pruning step. If you select a key using B<-u> it has to be in
110 this list. B<REQUIRED>.
112 =item B<export-sig-age> [seconds]
114 Don't export UIDs by default, on which your latest signature is older
115 than this age. Default: B<24*60*60> (i.e. one day).
117 =item B<keyserver> [string]
119 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
121 =item B<gpg> [string]
123 Path to the GnuPG binary. Default: B<gpg>.
125 =item B<gpg-sign> [string]
127 Path to the GnuPG binary which is used to sign keys. Default: what
130 =item B<gpg-delsig> [string]
132 Path to the GnuPG binary which is used to split off signatures. This was
133 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
136 =item B<secret-keyring> [string]
138 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
140 =item B<also-encrypt-to> [keyid]
142 An additional keyid to encrypt messages to. Default: none.
144 =item B<no-download> [boolean]
146 If true, then skip the step of fetching keys from the keyserver.
149 =item B<no-sign> [boolean]
151 If true, then skip the signing step. Default: B<0>.
157 Peter Palfrader <peter@palfrader.org>
161 http://pgp-tools.alioth.debian.org/
169 use File
::Temp
qw{tempdir
};
174 use GnuPG
::Interface
;
177 my $REVISION = '$Rev$';
178 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
179 my $VERSION = "0.0.0.$REVISION_NUMER";
182 my $config = $ENV{'HOME'} . '/.caffrc';
183 -f
$config or die "No file $config present. See caff(1).\n";
184 unless (scalar eval `cat $config`) {
185 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
188 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
189 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
190 die ("email is not defined.\n") unless defined $CONFIG{'email'};
191 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
192 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
193 for my $keyid (@
{$CONFIG{'keyid'}}) {
194 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
196 @
{$CONFIG{'keyid'}} = map { uc } @
{$CONFIG{'keyid'}};
197 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
198 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
199 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
200 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
201 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
202 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
203 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
204 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
209 print "[NOTICE] $line\n";
213 print "[INFO] $line\n";
217 #print "[DEBUG] $line\n";
221 #print "[trace] $line\n";
225 #print "[trace2] $line\n";
230 stdin
=> IO
::Handle
->new(),
231 stdout
=> IO
::Handle
->new(),
232 stderr
=> IO
::Handle
->new(),
233 status
=> IO
::Handle
->new() );
234 my $handles = GnuPG
::Handles
->new( %fds );
235 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
238 sub readwrite_gpg
($$$$$%) {
239 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
241 trace
("Entering readwrite_gpg.");
243 my ($first_line, undef) = split /\n/, $in;
244 debug
("readwrite_gpg sends ".(defined $first_line ?
$first_line : "<nothing>"));
246 local $INPUT_RECORD_SEPARATOR = undef;
247 my $sout = IO
::Select
->new();
248 my $sin = IO
::Select
->new();
251 trace
("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ?
$statusfd : 'undef').".");
253 $inputfd->blocking(0);
254 $stdoutfd->blocking(0);
255 $statusfd->blocking(0) if defined $statusfd;
256 $stderrfd->blocking(0);
257 $sout->add($stdoutfd);
258 $sout->add($stderrfd);
259 $sout->add($statusfd) if defined $statusfd;
262 my ($stdout, $stderr, $status) = ("", "", "");
263 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
264 trace
("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
266 my $readwrote_stuff_this_time = 0;
267 my $do_not_wait_on_select = 0;
268 my ($readyr, $readyw, $written);
269 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
270 if (defined $exitwhenstatusmatches) {
271 if ($status =~ /$exitwhenstatusmatches/m) {
272 trace
("readwrite_gpg found match on $exitwhenstatusmatches");
273 if ($readwrote_stuff_this_time) {
274 trace
("read/write some more\n");
275 $do_not_wait_on_select = 1;
277 trace
("that's it in our while loop.\n");
283 $readwrote_stuff_this_time = 0;
284 trace
("select waiting for ".($sout->count())." fds.");
285 ($readyr, $readyw, undef) = IO
::Select
::select($sout, $sin, undef, $do_not_wait_on_select ?
0 : 1);
286 trace
("ready: write: ".(defined $readyw ?
scalar @
$readyw : 0 )."; read: ".(defined $readyr ?
scalar @
$readyr : 0));
287 for my $wfd (@
$readyw) {
288 $readwrote_stuff_this_time = 1;
289 if (length($in) != $offset) {
290 trace
("writing to $wfd.");
291 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
294 if ($offset == length($in)) {
295 trace
("writing to $wfd done.");
296 unless ($options{'nocloseinput'}) {
298 trace
("$wfd closed.");
305 next unless (defined(@
$readyr)); # Wait some more.
307 for my $rfd (@
$readyr) {
308 $readwrote_stuff_this_time = 1;
310 trace
("reading from $rfd done.");
315 trace
("reading from $rfd.");
316 if ($rfd == $stdoutfd) {
318 trace2
("stdout is now $stdout\n================");
321 if (defined $statusfd && $rfd == $statusfd) {
323 trace2
("status is now $status\n================");
326 if ($rfd == $stderrfd) {
328 trace2
("stderr is now $stderr\n================");
333 trace
("readwrite_gpg done.");
334 return ($stdout, $stderr, $status);
338 my ($question, $default) = @_;
341 print $question,' ',($default ?
'[Y/n]' : '[y/N]'), ' ';
344 last if ((defined $answer) && (length $answer <= 1));
348 my $result = $default;
349 $result = 1 if $answer =~ /y/i;
350 $result = 0 if $answer =~ /n/i;
358 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
359 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
360 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
361 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
362 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
365 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader";
367 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
368 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
370 -d
$KEYSBASE || mkpath
($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
371 -d
$GNUPGHOME || mkpath
($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
374 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
375 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
379 print STDERR
"caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
380 print STDERR
"Usage: $PROGRAM_NAME [-mMR] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
385 my ($gnupghome, $keyid) = @_;
387 my $gpg = GnuPG
::Interface
->new();
388 $gpg->call( $CONFIG{'gpg'} );
389 $gpg->options->hash_init(
390 'homedir' => $gnupghome,
392 $gpg->options->meta_interactive( 0 );
393 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds
();
394 my $pid = $gpg->export_keys(handles
=> $handles, command_args
=> [ $keyid ]);
395 my ($stdout, $stderr, $status) = readwrite_gpg
('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
401 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
402 sub send_mail
($$$@
) {
403 my ($address, $can_encrypt, $key_id, @keys) = @_;
405 my $message = "Hi,\n\n";
407 $message .= 'please find attached the user id'.(scalar @keys >= 2 ?
's' : '')."\n";
408 for my $key (@keys) {
409 $message .= "\t".$key->{'text'}."\n";
411 $message .= qq{of your key
$key_id signed by me
.
413 Note that I did
not upload your key to any keyservers
. If you want this
414 new signature to be available to others
, please upload it yourself
.
415 With GnuPG this can be done using
416 gpg
--keyserver subkeys
.pgp
.net
--send-key
$key_id
418 If you have any questions
, don
't hesitate to ask.
423 my $message_entity = MIME::Entity->build(
424 Type => "text/plain",
426 Disposition => 'inline
',
430 for my $key (@keys) {
431 $message_entity->attach(
432 Type => "application/pgp-keys",
433 Disposition => 'attachment
',
435 Description => "PGP Key 0x$key_id, uid ".($key->{'text
'}).' ('.($key->{'serial
'}).')',
436 Data => $key->{'key
'},
437 Filename => "0x$key_id.".$key->{'serial
'}.".asc");
441 my $message = $message_entity->stringify();
443 my $gpg = GnuPG::Interface->new();
444 $gpg->call( $CONFIG{'gpg
'} );
445 $gpg->options->hash_init( 'homedir
' => $GNUPGHOME,
446 'extra_args
' => '--always
-trust
',
448 $gpg->options->meta_interactive( 0 );
449 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
450 $gpg->options->push_recipients( $key_id );
451 $gpg->options->push_recipients( $CONFIG{'also
-encrypt
-to
'} ) if defined $CONFIG{'also
-encrypt
-to
'};
452 my $pid = $gpg->encrypt(handles => $handles);
453 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
456 warn ("No data from gpg for list-key $key_id\n");
461 $message_entity = MIME::Entity->build(
462 Type => 'multipart
/encrypted; protocol="application/pgp-encrypted
"');
464 $message_entity->attach(
465 Type => "application
/pgp
-encrypted
",
466 Disposition => 'attachment',
468 Data => "Version
: 1\n");
470 $message_entity->attach(
471 Type => "application
/octet
-stream
",
472 Filename => 'msg.asc',
473 Disposition => 'inline',
478 $message_entity->head->add("Subject
", "Your signed PGP key
0x
$key_id");
479 $message_entity->head->add("To
", $address);
480 $message_entity->head->add("From
", '"'.$CONFIG{'owner
'}.'" <'.$CONFIG{'email'}.'>');
481 $message_entity->head->add("User
-Agent
", $USER_AGENT);
482 $message_entity->send();
483 $message_entity->stringify();
486 sub sanitize_uid($) {
490 $good_uid =~ tr#/:\\#_#;
491 trace2("[sanitize_uid
] changed UID from
$uid to
$good_uid.\n") if $good_uid ne $uid;
499 getopts('mMRu:', \%opt);
501 usage() unless scalar @ARGV >= 1;
505 unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
506 print STDERR "-u
$USER is
not a keyid
.\n";
511 for my $keyid (@ARGV) {
513 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
514 print STDERR "$keyid is
not a keyid
.\n";
517 push @KEYIDS, uc($keyid);
525 my $gpg = GnuPG::Interface->new();
526 $gpg->call( $CONFIG{'gpg'} );
527 $gpg->options->hash_init(
528 'homedir' => $GNUPGHOME,
529 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
530 $gpg->options->meta_interactive( 0 );
531 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
532 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
533 my $pid = $gpg->list_public_keys(handles => $handles, command_args => $CONFIG{'keyid'});
534 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
537 warn ("No data from gpg
for list
-key
\n");
540 foreach my $keyid (@{$CONFIG{'keyid'}}) {
541 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
542 info("Importing
$keyid");
543 system "gpg
--export
$keyid | gpg
--import
--homedir
$GNUPGHOME";
547 #############################
548 # receive keys from keyserver
549 #############################
552 if ($CONFIG{'no-download'} or $opt{R}) {
553 @keyids_ok = @KEYIDS;
555 my $gpg = GnuPG::Interface->new();
556 $gpg->call( $CONFIG{'gpg'} );
557 $gpg->options->hash_init(
558 'homedir' => $GNUPGHOME,
559 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
560 $gpg->options->meta_interactive( 0 );
561 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
563 my @local_keyids = @KEYIDS;
564 for my $keyid (@local_keyids) {
565 info ("fetching
$keyid...");
566 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
567 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
570 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
573 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
575 for my $line (split /\n/, $status) {
576 if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {
577 push @keyids_ok, shift @KEYIDS;
580 } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
581 push @keyids_failed, shift @KEYIDS;
587 notice ("Huh
, what
's up with $keyid?");
588 push @keyids_failed, shift @KEYIDS;
591 die ("Still keys in \@KEYIDS. This should not happen.") if scalar @KEYIDS;
592 notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
598 unless ($CONFIG{'no-sign
'}) {
599 info("Sign the following keys according to your policy, then exit gpg with 'save
' after signing each key");
600 for my $keyid (@keyids_ok) {
602 push @command, $CONFIG{'gpg
-sign
'};
603 push @command, '--local-user
', $USER if (defined $USER);
604 push @command, "--homedir=$GNUPGHOME";
605 push @command, '--secret
-keyring
', $CONFIG{'secret
-keyring
'};
606 push @command, '--edit
', $keyid;
607 push @command, 'sign
';
608 print join(' ', @command),"\n";
617 for my $keyid (@keyids_ok) {
620 my $gpg = GnuPG::Interface->new();
621 $gpg->call( $CONFIG{'gpg
'} );
622 $gpg->options->hash_init( 'homedir
' => $GNUPGHOME );
623 $gpg->options->meta_interactive( 0 );
624 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
625 $gpg->options->hash_init( 'extra_args
' => [ '--with
-colons
', '--fixed
-list
-mode
' ] );
626 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
627 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
630 warn ("No data from gpg for list-key $keyid\n");
633 my $keyinfo = $stdout;
634 my @publine = grep { /^pub/ } (split /\n/, $stdout);
635 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
636 my $can_encrypt = $flags =~ /E/;
637 unless (defined $longkeyid) {
638 warn ("Didn't find public keyid
in edit dialog of key
$keyid.\n");
644 my $asciikey = export_key($GNUPGHOME, $keyid);
645 if ($asciikey eq '') {
646 warn ("No data from gpg
for export
$keyid\n");
653 my $this_uid_text = '';
655 debug("Doing key
$keyid, uid
$uid_number");
657 # import into temporary gpghome
658 ###############################
659 my $tempdir = tempdir( "caff
-$keyid-XXXXX
", DIR => '/tmp/', CLEANUP => 1);
660 my $gpg = GnuPG::Interface->new();
661 $gpg->call( $CONFIG{'gpg'} );
662 $gpg->options->hash_init( 'homedir' => $tempdir );
663 $gpg->options->meta_interactive( 0 );
664 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
665 my $pid = $gpg->import_keys(handles => $handles);
666 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
669 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
670 warn ("Could
not import
$keyid into temporary gnupg
.\n");
676 $gpg = GnuPG::Interface->new();
677 $gpg->call( $CONFIG{'gpg-delsig'} );
678 $gpg->options->hash_init(
679 'homedir' => $tempdir,
680 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
681 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
682 $pid = $gpg->wrap_call(
683 commands => [ '--edit' ],
684 command_args => [ $keyid ],
685 handles => $handles );
687 debug("Starting edit session
");
688 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
692 my $number_of_subkeys = 0;
697 debug("Parsing stdout output
.");
698 for my $line (split /\n/, $stdout) {
699 debug("Checking line
$line");
700 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
701 if ($type eq 'sub') {
702 $number_of_subkeys++;
704 next unless ($type eq 'uid' || $type eq 'uat');
705 debug("line is interesting
.");
706 if ($uid_number != $i) {
707 debug("mark
for deletion
.");
708 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
713 $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute';
714 $is_uat = $type eq 'uat';
718 debug("Parsing stdout output done
.");
720 notice("Can
't handle attribute userid of key $keyid.");
724 debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
725 info("key $keyid done.");
729 debug("need to delete a few uids.");
730 readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
731 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
736 if ($number_of_subkeys > 0) {
737 for (my $i=1; $i<=$number_of_subkeys; $i++) {
738 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
740 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
741 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
746 my $signed_by_me = 0;
747 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
748 ($stdout, $stderr, $status) =
749 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
751 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
752 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
753 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
754 $stdout =~ s/\n/\\n/g;
755 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
756 my $line = pop @sigline;
758 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
759 debug("[sigremoval] doing line $line.");
760 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
761 if ($signer eq $longkeyid) {
762 debug("[sigremoval] selfsig ($signer).");
764 } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid
'}}) {
765 debug("[sigremoval] signed by us ($signer).");
767 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
769 debug("[sigremoval] not interested in that sig ($signer).");
773 debug("[sigremoval] no sig line here, only got: ".$stdout);
775 ($stdout, $stderr, $status) =
776 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
778 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
781 my $asciikey = export_key($tempdir, $longkeyid);
782 if ($asciikey eq '') {
783 warn ("No data from gpg for export $longkeyid\n");
788 if ($NOW - $signed_by_me > $CONFIG{'export
-sig
-age
'} ) {
789 my $write = ask("Signature on $this_uid_text is old. Export?", 0);
792 my $keydir = "$KEYSBASE/$DATE_STRING";
793 -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
795 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
796 open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n");
800 push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number };
802 info("$longkeyid $uid_number $this_uid_text done.");
804 info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
808 if (scalar @UIDS == 0) {
809 info("found no signed uids for $keyid");
811 next if $opt{M}; # do not send mail
814 for my $uid (@UIDS) {
815 trace("UID: $uid->{'text
'}\n");
816 unless ($uid->{'text
'} =~ /@/) {
817 my $attach = ask("UID $uid->{'text
'} is no email address, attach it to every email sent?", 1);
818 push @attached, $uid if $attach;
822 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
823 for my $uid (@UIDS) {
824 if ($uid->{'text
'} =~ /@/) {
825 my $address = $uid->{'text
'};
826 $address =~ s/.*<(.*)>.*/$1/;
827 if ($opt{m} or ask("Send mail to '$address' for $uid->{'text
'}?", 1)) {
828 my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
830 my $keydir = "$KEYSBASE/$DATE_STRING";
831 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial
'}.".".sanitize_uid($uid->{'text
'});
832 open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n");
845 ###############################################################3
846 #### old fork gpg --edit
848 my ($stdin_read, $stdin_write);
849 my ($stdout_read, $stdout_write);
850 my ($stderr_read, $stderr_write);
851 my ($status_read, $status_write);
852 pipe $stdin_read, $stdin_write;
853 pipe $stdout_read, $stdout_write;
854 pipe $stderr_read, $stderr_write;
855 pipe $status_read, $status_write;
858 unless ($pid) { # child
865 push @call, $CONFIG{'gpg
-delsig
'};
866 push @call, "--homedir=$tempdir";
867 push @call, '--with
-colons
';
868 push @call, '--fixed
-list
-mode
';
869 push @call, '--command
-fd
=0';
870 push @call, "--status-fd=".fileno($status_write);
871 push @call, "--no-tty";
872 push @call, "--edit";
878 open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin: $!\n");
879 open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout: $!\n");
880 open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr: $!\n");
882 fcntl $status_write, F_SETFD, 0;
892 $inputfd = $stdin_write;
893 $stdoutfd = $stdout_read;
894 $stderrfd = $stderr_read;
895 $statusfd = $status_read;