]> git.sthu.org Git - pgp-tools.git/blob - caff/caff
Add pgp-clean - it's a useful tool, but really not finished
[pgp-tools.git] / caff / caff
1 #!/usr/bin/perl -w
2
3 # caff -- CA - Fire and Forget
4 # $Id$
5 #
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7 #
8 # All rights reserved.
9 #
10 # Redistribution and use in source and binary forms, with or without
11 # modification, are permitted provided that the following conditions
12 # are met:
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.
20 #
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.
31
32 =pod
33
34 =head1 NAME
35
36 caff -- CA - Fire and Forget
37
38 =head1 SYNOPSIS
39
40 =over
41
42 =item B<caff> [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
43
44 =back
45
46 =head1 DESCRIPTION
47
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.
53
54 =head1 OPTIONS
55
56 =over
57
58 =item B<-u> I<yourkeyid>
59
60 Select the key that is used for signing, in case you have more than one key.
61
62 =back
63
64 =head1 FILES
65
66 =over
67
68 =item $HOME/.caffrc - configuration file
69
70 =back
71
72 =head1 CONFIGURATION FILE OPTIONS
73
74 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
75
76 Example:
77
78 $CONFIG{'owner'} = 'Peter Palfrader';
79 $CONFIG{'email'} = 'peter@palfrader.org';
80
81 =head2 Valid keys
82
83 =over
84
85 =item B<caffhome> [string]
86
87 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
88
89 =item B<owner> [string]
90
91 Your name. B<REQUIRED>.
92
93 =item B<email> [string]
94
95 Your email address, used in From: lines. B<REQUIRED>.
96
97 =item B<keyid> [list of keyids]
98
99 A list of your keys. This is used to determine which signatures to keep
100 in the pruning step. If you select a key using B<-u> it has to be in
101 this list. B<REQUIRED>.
102
103 =item B<export-sig-age> [seconds]
104
105 Don't export UIDs by default, on which your latest signature is older
106 than this age. Default: B<24*60*60> (i.e. one day).
107
108 =item B<keyserver> [string]
109
110 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
111
112 =item B<gpg> [string]
113
114 Path to the GnuPG binary. Default: B<gpg>.
115
116 =item B<gpg-sign> [string]
117
118 Path to the GnuPG binary which is used to sign keys. Default: what
119 B<gpg> is set to.
120
121 =item B<gpg-delsig> [string]
122
123 Path to the GnuPG binary which is used to split off signatures. This is
124 needed while the upstream GnuPG is not fixed (there are 2 bugs in the
125 Debian Bug Tracking System). Default: what B<gpg> is set to.
126
127 =item B<secret-keyring> [string]
128
129 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
130
131 =item B<also-encrypt-to> [keyid]
132
133 An additional keyid to encrypt messages to. Default: none.
134
135 =item B<no-download> [boolean]
136
137 If true, then skip the step of fetching keys from the keyserver.
138 Default: B<0>.
139
140 =item B<no-sign> [boolean]
141
142 If true, then skip the signing step. Default: B<0>.
143
144 =back
145
146 =head1 AUTHOR
147
148 Peter Palfrader <peter@palfrader.org>
149
150 =cut
151
152 use strict;
153 use IO::Handle;
154 use English;
155 use File::Path;
156 use File::Temp qw{tempdir};
157 use MIME::Entity;
158 use Fcntl;
159 use IO::Select;
160 use GnuPG::Interface;
161
162 my %CONFIG;
163 my $REVISION = '$Rev$';
164 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
165 my $VERSION = "0.0.0.$REVISION_NUMER";
166
167 sub load_config() {
168 my $config = $ENV{'HOME'} . '/.caffrc';
169 -f $config or die "No file $config present. See caffrc(5).\n";
170 unless (scalar eval `cat $config`) {
171 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
172 };
173
174 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
175 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
176 die ("email is not defined.\n") unless defined $CONFIG{'email'};
177 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
178 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
179 for my $keyid (@{$CONFIG{'keyid'}}) {
180 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
181 };
182 @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
183 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
184 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
185 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
186 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
187 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
188 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
189 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
190 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
191 };
192
193 sub notice($) {
194 my ($line) = @_;
195 print "[NOTICE] $line\n";
196 };
197 sub info($) {
198 my ($line) = @_;
199 print "[INFO] $line\n";
200 };
201 sub debug($) {
202 my ($line) = @_;
203 #print "[DEBUG] $line\n";
204 };
205 sub trace($) {
206 my ($line) = @_;
207 #print "[trace] $line\n";
208 };
209 sub trace2($) {
210 my ($line) = @_;
211 #print "[trace2] $line\n";
212 };
213
214 sub make_gpg_fds() {
215 my %fds = (
216 stdin => IO::Handle->new(),
217 stdout => IO::Handle->new(),
218 stderr => IO::Handle->new(),
219 status => IO::Handle->new() );
220 my $handles = GnuPG::Handles->new( %fds );
221 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
222 };
223
224 sub readwrite_gpg($$$$$%) {
225 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
226
227 trace("Entering readwrite_gpg.");
228
229 my ($first_line, $dummy) = split /\n/, $in;
230 debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
231
232 local $INPUT_RECORD_SEPARATOR = undef;
233 my $sout = IO::Select->new();
234 my $sin = IO::Select->new();
235 my $offset = 0;
236
237 trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
238
239 $inputfd->blocking(0);
240 $stdoutfd->blocking(0);
241 $statusfd->blocking(0) if defined $statusfd;
242 $stderrfd->blocking(0);
243 $sout->add($stdoutfd);
244 $sout->add($stderrfd);
245 $sout->add($statusfd) if defined $statusfd;
246 $sin->add($inputfd);
247
248 my ($stdout, $stderr, $status) = ("", "", "");
249 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
250 trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
251
252 my $readwrote_stuff_this_time = 0;
253 my $do_not_wait_on_select = 0;
254 my ($readyr, $readyw, $written);
255 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
256 if (defined $exitwhenstatusmatches) {
257 if ($status =~ /$exitwhenstatusmatches/m) {
258 trace("readwrite_gpg found match on $exitwhenstatusmatches");
259 if ($readwrote_stuff_this_time) {
260 trace("read/write some more\n");
261 $do_not_wait_on_select = 1;
262 } else {
263 trace("that's it in our while loop.\n");
264 last;
265 }
266 };
267 };
268
269 $readwrote_stuff_this_time = 0;
270 trace("select waiting for ".($sout->count())." fds.");
271 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
272 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
273 for my $wfd (@$readyw) {
274 $readwrote_stuff_this_time = 1;
275 if (length($in) != $offset) {
276 trace("writing to $wfd.");
277 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
278 $offset += $written;
279 };
280 if ($offset == length($in)) {
281 trace("writing to $wfd done.");
282 unless ($options{'nocloseinput'}) {
283 close $wfd;
284 trace("$wfd closed.");
285 };
286 $sin->remove($wfd);
287 $sin = undef;
288 }
289 }
290
291 next unless (defined(@$readyr)); # Wait some more.
292
293 for my $rfd (@$readyr) {
294 $readwrote_stuff_this_time = 1;
295 if ($rfd->eof) {
296 trace("reading from $rfd done.");
297 $sout->remove($rfd);
298 close($rfd);
299 next;
300 }
301 trace("reading from $rfd.");
302 if ($rfd == $stdoutfd) {
303 $stdout .= <$rfd>;
304 trace2("stdout is now $stdout\n================");
305 next;
306 }
307 if (defined $statusfd && $rfd == $statusfd) {
308 $status .= <$rfd>;
309 trace2("status is now $status\n================");
310 next;
311 }
312 if ($rfd == $stderrfd) {
313 $stderr .= <$rfd>;
314 trace2("stderr is now $stderr\n================");
315 next;
316 }
317 }
318 }
319 trace("readwrite_gpg done.");
320 return ($stdout, $stderr, $status);
321 };
322
323 sub ask($$) {
324 my ($question, $default) = @_;
325 my $answer;
326 while (1) {
327 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
328 $answer = <STDIN>;
329 chomp $answer;
330 last if ((defined $answer) && (length $answer <= 1));
331 print "grrrrrr.\n";
332 sleep 1;
333 };
334 my $result = $default;
335 $result = 1 if $answer =~ /y/i;
336 $result = 0 if $answer =~ /n/i;
337 return $result;
338 };
339
340
341
342
343
344 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
345 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
346 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
347 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
348 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
349
350 load_config;
351 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader";
352
353 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
354 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
355
356 -d $KEYSBASE || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
357 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
358
359 my $NOW = time;
360 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
361 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
362
363
364 sub usage() {
365 print STDERR "caff $VERSION - (c) 2004, 2005 Peter Palfrader\n";
366 print STDERR "Usage: $PROGRAM_NAME [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
367 exit 1;
368 };
369
370 sub export_key($$) {
371 my ($gnupghome, $keyid) = @_;
372
373 my $gpg = GnuPG::Interface->new();
374 $gpg->call( $CONFIG{'gpg'} );
375 $gpg->options->hash_init(
376 'homedir' => $gnupghome,
377 'armor' => 1 );
378 $gpg->options->meta_interactive( 0 );
379 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
380 my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
381 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
382 waitpid $pid, 0;
383
384 return $stdout;
385 };
386
387 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
388 sub send_mail($$$@) {
389 my ($address, $can_encrypt, $key_id, @keys) = @_;
390
391 my $message = "Hi,\n\n";
392
393 $message .= 'please find attached the user id'.(scalar @keys >= 2 ? 's' : '')."\n";
394 for my $key (@keys) {
395 $message .= "\t".$key->{'text'}."\n";
396 };
397 $message .= qq{of your key $key_id signed by me.
398
399 Note that I did not upload your key to any keyservers. If you want this
400 new signature to be available to others, please upload it yourself.
401 With GnuPG this can be done using
402 gpg --keyserver subkeys.pgp.net --send-key $key_id
403
404 If you have any questions, don't hesitate to ask.
405
406 Regards,
407 $CONFIG{'owner'}
408 };
409 my $message_entity = MIME::Entity->build(
410 Type => "text/plain",
411 Charset => "utf-8",
412 Disposition => 'inline',
413 Data => $message);
414
415 my @key_entities;
416 for my $key (@keys) {
417 $message_entity->attach(
418 Type => "application/pgp-keys",
419 Disposition => 'attachment',
420 Encoding => "7bit",
421 Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
422 Data => $key->{'key'},
423 Filename => "0x$key_id.".$key->{'serial'}.".asc");
424 };
425
426 if ($can_encrypt) {
427 my $message = $message_entity->stringify();
428
429 my $gpg = GnuPG::Interface->new();
430 $gpg->call( $CONFIG{'gpg'} );
431 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
432 'extra_args' => '--always-trust',
433 'armor' => 1 );
434 $gpg->options->meta_interactive( 0 );
435 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
436 $gpg->options->push_recipients( $key_id );
437 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
438 my $pid = $gpg->encrypt(handles => $handles);
439 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
440 waitpid $pid, 0;
441 if ($stdout eq '') {
442 warn ("No data from gpg for list-key $key_id\n");
443 next;
444 };
445 $message = $stdout;
446
447 $message_entity = MIME::Entity->build(
448 Type => 'multipart/encrypted; protocol="application/pgp-encrypted"');
449
450 $message_entity->attach(
451 Type => "application/pgp-encrypted",
452 Disposition => 'attachment',
453 Encoding => "7bit",
454 Data => "Version: 1\n");
455
456 $message_entity->attach(
457 Type => "application/octet-stream",
458 Filename => 'msg.asc',
459 Disposition => 'inline',
460 Encoding => "7bit",
461 Data => $message);
462 };
463
464 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
465 $message_entity->head->add("To", $address);
466 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
467 $message_entity->head->add("User-Agent", $USER_AGENT);
468 $message_entity->send();
469 $message_entity->stringify();
470 };
471
472 sub sanitize_uid($) {
473 my ($uid) = @_;
474
475 my $good_uid = $uid;
476 $good_uid =~ tr#/:\\#_#;
477 trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
478 return $good_uid;
479 };
480
481 my $USER;
482 my @KEYIDS;
483
484 usage() unless scalar @ARGV >= 1;
485 if ($ARGV[0] eq '-u') {
486 usage() unless scalar @ARGV >= 3;
487 shift @ARGV;
488 $USER = shift @ARGV;
489 unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {
490 print STDERR "-u $USER is not a keyid.\n";
491 usage();
492 };
493 $USER = uc($USER);
494 };
495 for my $keyid (@ARGV) {
496 unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {
497 print STDERR "$keyid is not a keyid.\n";
498 usage();
499 };
500 push @KEYIDS, uc($keyid);
501 };
502
503
504
505 #############################
506 # receive keys from keyserver
507 #############################
508 my @keyids_ok;
509 my @keyids_failed;
510 if ($CONFIG{'no-download'}) {
511 @keyids_ok = @KEYIDS;
512 } else {
513 my $gpg = GnuPG::Interface->new();
514 $gpg->call( $CONFIG{'gpg'} );
515 $gpg->options->hash_init(
516 'homedir' => $GNUPGHOME,
517 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
518 $gpg->options->meta_interactive( 0 );
519 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
520
521 my @local_keyids = @KEYIDS;
522 for my $keyid (@local_keyids) {
523 info ("fetching $keyid...");
524 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ $keyid ]);
525 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
526 waitpid $pid, 0;
527
528 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
529 # [GNUPG:] NODATA 1
530 # [GNUPG:] NODATA 1
531 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
532 my $handled = 0;
533 for my $line (split /\n/, $status) {
534 if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {
535 push @keyids_ok, shift @KEYIDS;
536 $handled = 1;
537 last;
538 } elsif ($line =~ /^\[GNUPG:\] NODATA/) {
539 push @keyids_failed, shift @KEYIDS;
540 $handled = 1;
541 last;
542 };
543 };
544 unless ($handled) {
545 notice ("Huh, what's up with $keyid?");
546 push @keyids_failed, shift @KEYIDS;
547 };
548 };
549 die ("Still keys in \@KEYIDS. This should not happen.") if scalar @KEYIDS;
550 notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;
551 };
552
553 ###########
554 # sign keys
555 ###########
556 unless ($CONFIG{'no-sign'}) {
557 info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
558 for my $keyid (@keyids_ok) {
559 my @command;
560 push @command, $CONFIG{'gpg-sign'};
561 push @command, '--local-user', $USER if (defined $USER);
562 push @command, "--homedir=$GNUPGHOME";
563 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
564 push @command, '--edit', $keyid;
565 push @command, 'sign';
566 print join(' ', @command),"\n";
567 system (@command);
568 };
569 };
570
571 ##################
572 # export and prune
573 ##################
574 KEYS:
575 for my $keyid (@keyids_ok) {
576 # get key listing
577 #################
578 my $gpg = GnuPG::Interface->new();
579 $gpg->call( $CONFIG{'gpg'} );
580 $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
581 $gpg->options->meta_interactive( 0 );
582 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
583 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
584 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
585 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
586 waitpid $pid, 0;
587 if ($stdout eq '') {
588 warn ("No data from gpg for list-key $keyid\n");
589 next;
590 };
591 my $keyinfo = $stdout;
592 my @publine = grep { /^pub/ } (split /\n/, $stdout);
593 my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;
594 my $can_encrypt = $flags =~ /E/;
595 unless (defined $longkeyid) {
596 warn ("Didn't find public keyid in edit dialog of key $keyid.\n");
597 next;
598 };
599
600 # export the key
601 ################
602 my $asciikey = export_key($GNUPGHOME, $keyid);
603 if ($asciikey eq '') {
604 warn ("No data from gpg for export $keyid\n");
605 next;
606 };
607
608 my @UIDS;
609 my $uid_number = 0;
610 while (1) {
611 my $this_uid_text = '';
612 $uid_number++;
613 debug("Doing key $keyid, uid $uid_number");
614
615 # import into temporary gpghome
616 ###############################
617 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
618 my $gpg = GnuPG::Interface->new();
619 $gpg->call( $CONFIG{'gpg'} );
620 $gpg->options->hash_init( 'homedir' => $tempdir );
621 $gpg->options->meta_interactive( 0 );
622 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
623 my $pid = $gpg->import_keys(handles => $handles);
624 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
625 waitpid $pid, 0;
626
627 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
628 warn ("Could not import $keyid into temporary gnupg.\n");
629 next;
630 };
631
632 # prune it
633 ##########
634 $gpg = GnuPG::Interface->new();
635 $gpg->call( $CONFIG{'gpg-delsig'} );
636 $gpg->options->hash_init(
637 'homedir' => $tempdir,
638 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
639 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
640 $pid = $gpg->wrap_call(
641 commands => [ '--edit' ],
642 command_args => [ $keyid ],
643 handles => $handles );
644
645 debug("Starting edit session");
646 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
647
648 # delete other uids
649 ###################
650 my $number_of_subkeys = 0;
651 my $i = 1;
652 my $have_one = 0;
653 my $is_uat = 0;
654 my $delete_some = 0;
655 debug("Parsing stdout output.");
656 for my $line (split /\n/, $stdout) {
657 debug("Checking line $line");
658 my ($type, $dummy2, $dummy3, $dummy4, $dummy5, $dummy6, $dummy7, $dummy8, $dummy9, $uidtext) = split /:/, $line;
659 if ($type eq 'sub') {
660 $number_of_subkeys++;
661 };
662 next unless ($type eq 'uid' || $type eq 'uat');
663 debug("line is interesting.");
664 if ($uid_number != $i) {
665 debug("mark for deletion.");
666 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
667 $delete_some = 1;
668 } else {
669 debug("keep it.");
670 $have_one = 1;
671 $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute';
672 $is_uat = $type eq 'uat';
673 };
674 $i++;
675 };
676 debug("Parsing stdout output done.");
677 if ($is_uat) {
678 notice("Can't handle attribute userid of key $keyid.");
679 next;
680 };
681 unless ($have_one) {
682 debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
683 info("key $keyid done.");
684 last;
685 };
686 if ($delete_some) {
687 debug("need to delete a few uids.");
688 readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
689 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
690 };
691
692 # delete subkeys
693 ################
694 if ($number_of_subkeys > 0) {
695 for (my $i=1; $i<=$number_of_subkeys; $i++) {
696 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
697 };
698 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
699 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
700 };
701
702 # delete signatures
703 ###################
704 my $signed_by_me = 0;
705 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
706 ($stdout, $stderr, $status) =
707 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
708
709 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
710 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
711 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
712 $stdout =~ s/\n/\\n/g;
713 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
714 my $line = pop @sigline;
715 my $answer = "no";
716 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
717 debug("[sigremoval] doing line $line.");
718 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;
719 if ($signer eq $longkeyid) {
720 debug("[sigremoval] selfsig ($signer).");
721 $answer = "no";
722 } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) {
723 debug("[sigremoval] signed by us ($signer).");
724 $answer = "no";
725 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
726 } else {
727 debug("[sigremoval] not interested in that sig ($signer).");
728 $answer = "yes";
729 };
730 } else {
731 debug("[sigremoval] no sig line here, only got: ".$stdout);
732 };
733 ($stdout, $stderr, $status) =
734 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
735 };
736 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
737 waitpid $pid, 0;
738
739 my $asciikey = export_key($tempdir, $longkeyid);
740 if ($asciikey eq '') {
741 warn ("No data from gpg for export $longkeyid\n");
742 next;
743 };
744
745 if ($signed_by_me) {
746 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
747 my $write = ask("Signature on $this_uid_text is old. Export?", 0);
748 next unless $write;
749 };
750 my $keydir = "$KEYSBASE/$DATE_STRING";
751 -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
752
753 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
754 open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n");
755 print KEY $asciikey;
756 close KEY;
757
758 push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number };
759
760 info("$longkeyid $uid_number $this_uid_text done.");
761 } else {
762 info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
763 };
764 };
765
766 if (scalar @UIDS == 0) {
767 info("found no signed uids for $keyid");
768 } else {
769 my @attached ;
770 for my $uid (@UIDS) {
771 trace("UID: $uid->{'text'}\n");
772 unless ($uid->{'text'} =~ /@/) {
773 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
774 push @attached, $uid if $attach;
775 };
776 };
777
778 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
779 for my $uid (@UIDS) {
780 if ($uid->{'text'} =~ /@/) {
781 my $address = $uid->{'text'};
782 $address =~ s/.*<(.*)>.*/$1/;
783 my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1);
784 if ($send) {
785 my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
786
787 my $keydir = "$KEYSBASE/$DATE_STRING";
788 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
789 open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n");
790 print KEY $mail;
791 close KEY;
792 };
793 };
794 };
795 };
796
797 };
798
799
800
801
802 ###############################################################3
803 #### old fork gpg --edit
804 =cut
805 my ($stdin_read, $stdin_write);
806 my ($stdout_read, $stdout_write);
807 my ($stderr_read, $stderr_write);
808 my ($status_read, $status_write);
809 pipe $stdin_read, $stdin_write;
810 pipe $stdout_read, $stdout_write;
811 pipe $stderr_read, $stderr_write;
812 pipe $status_read, $status_write;
813
814 $pid = fork();
815 unless ($pid) { # child
816 close $stdin_write;
817 close $stdout_read;
818 close $stderr_read;
819 close $status_read;
820
821 my @call;
822 push @call, $CONFIG{'gpg-delsig'};
823 push @call, "--homedir=$tempdir";
824 push @call, '--with-colons';
825 push @call, '--fixed-list-mode';
826 push @call, '--command-fd=0';
827 push @call, "--status-fd=".fileno($status_write);
828 push @call, "--no-tty";
829 push @call, "--edit";
830 push @call, $keyid;
831
832 close STDIN;
833 close STDOUT;
834 close STDERR;
835 open (STDIN, "<&".fileno($stdin_read)) or die ("Cannot reopen stdin: $!\n");
836 open (STDOUT, ">&".fileno($stdout_write)) or die ("Cannot reopen stdout: $!\n");
837 open (STDERR, ">&".fileno($stderr_write)) or die ("Cannot reopen stderr: $!\n");
838
839 fcntl $status_write, F_SETFD, 0;
840
841 exec (@call);
842 exit;
843 };
844 close $stdin_read;
845 close $stdout_write;
846 close $stderr_write;
847 close $status_write;
848
849 $inputfd = $stdin_write;
850 $stdoutfd = $stdout_read;
851 $stderrfd = $stderr_read;
852 $statusfd = $status_read;
853 =cut