]> git.sthu.org Git - pgp-tools.git/blob - caff/caff
Properly convert --with-colons uid strings
[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 # Copyright (c) 2005 Christoph Berg <cb@df7cb.de>
8 #
9 # All rights reserved.
10 #
11 # Redistribution and use in source and binary forms, with or without
12 # modification, are permitted provided that the following conditions
13 # are met:
14 # 1. Redistributions of source code must retain the above copyright
15 # notice, this list of conditions and the following disclaimer.
16 # 2. Redistributions in binary form must reproduce the above copyright
17 # notice, this list of conditions and the following disclaimer in the
18 # documentation and/or other materials provided with the distribution.
19 # 3. The name of the author may not be used to endorse or promote products
20 # derived from this software without specific prior written permission.
21 #
22 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
23 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
24 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
25 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
26 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
27 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
31 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33 =pod
34
35 =head1 NAME
36
37 caff -- CA - Fire and Forget
38
39 =head1 SYNOPSIS
40
41 =over
42
43 =item B<caff> [-eEmMRS] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
44
45 =back
46
47 =head1 DESCRIPTION
48
49 CA Fire and Forget is a script that helps you in keysigning. It takes a list
50 of keyids on the command line, fetches them from a keyserver and calls GnuPG so
51 that you can sign it. It then mails each key to all its email addresses - only
52 including the one UID that we send to in each mail, pruned from all but self
53 sigs and sigs done by you.
54
55 =head1 OPTIONS
56
57 =over
58
59 =item B<-e>, B<--export-old>
60
61 Export old signatures. Default is to ask the user for each old signature.
62
63 =item B<-E>, B<--no-export-old>
64
65 Do not export old signatures. Default is to ask the user for each old
66 signature.
67
68 =item B<-m>, B<--mail>
69
70 Send mail after signing. Default is to ask the user for each uid.
71
72 =item B<-M>, B<--no-mail>
73
74 Do not send mail after signing. Default is to ask the user for each uid.
75
76 =item B<-R>, B<--no-download>
77
78 Do not retrieve the key to be signed from a keyserver.
79
80 =item B<-S>, B<--no-sign>
81
82 Do not sign the keys.
83
84 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
85
86 Select the key that is used for signing, in case you have more than one key.
87
88 =back
89
90 =head1 FILES
91
92 =over
93
94 =item $HOME/.caffrc - configuration file
95
96 =back
97
98 =head1 CONFIGURATION FILE OPTIONS
99
100 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
101
102 Example:
103
104 $CONFIG{owner} = q{Peter Palfrader};
105 $CONFIG{email} = q{peter@palfrader.org};
106 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
107
108 =head2 Required basic settings
109
110 =over
111
112 =item B<owner> [string]
113
114 Your name. B<REQUIRED>.
115
116 =item B<email> [string]
117
118 Your email address, used in From: lines. B<REQUIRED>.
119
120 =item B<keyid> [list of keyids]
121
122 A list of your keys. This is used to determine which signatures to keep
123 in the pruning step. If you select a key using B<-u> it has to be in
124 this list. B<REQUIRED>.
125
126 =head2 General settings
127
128 =item B<caffhome> [string]
129
130 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
131
132 =head2 GnuPG settings
133
134 =item B<gpg> [string]
135
136 Path to the GnuPG binary. Default: B<gpg>.
137
138 =item B<gpg-sign> [string]
139
140 Path to the GnuPG binary which is used to sign keys. Default: what
141 B<gpg> is set to.
142
143 =item B<gpg-delsig> [string]
144
145 Path to the GnuPG binary which is used to split off signatures. This was
146 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
147 is set to.
148
149 =item B<secret-keyring> [string]
150
151 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
152
153 =item B<also-encrypt-to> [keyid]
154
155 An additional keyid to encrypt messages to. Default: none.
156
157 =item B<gpg-sign-args> [string]
158
159 Additional arguments to pass to gpg. Default: none.
160
161 =head2 Keyserver settings
162
163 =item B<keyserver> [string]
164
165 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
166
167 =item B<no-download> [boolean]
168
169 If true, then skip the step of fetching keys from the keyserver.
170 Default: B<0>.
171
172 =head2 Signing settings
173
174 =item B<no-sign> [boolean]
175
176 If true, then skip the signing step. Default: B<0>.
177
178 =item B<export-sig-age> [seconds]
179
180 Don't export UIDs by default, on which your latest signature is older
181 than this age. Default: B<24*60*60> (i.e. one day).
182
183 =head2 Mail settings
184
185 =item B<mail> [boolean]
186
187 Do not prompt for sending mail, just do it. Default: B<0>.
188
189 =item B<no-mail> [boolean]
190
191 Do not prompt for sending mail. The messages are still written to
192 $CONFIG{caffhome}/keys/. Default: B<0>.
193
194 =item B<mail-template> [string]
195
196 Email template which is used as the body text for the email sent out
197 instead of the default text if specified. The following perl variables
198 can be used in the template:
199
200 =over
201
202 =item B<{owner}> [string]
203
204 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
205
206 =item B<{key}> [string]
207
208 The keyid of the key you signed.
209
210 =item B<{@uids}> [array]
211
212 The UIDs for which signatures are included in the mail.
213
214 =back
215
216 =item B<bcc> [string]
217
218 Address to send blind carbon copies to when sending mail.
219 Default: none.
220
221 =back
222
223 =head1 AUTHORS
224
225 =over
226
227 =item Peter Palfrader <peter@palfrader.org>
228
229 =item Christoph Berg <cb@df7cb.de>
230
231 =back
232
233 =head1 WEBSITE
234
235 http://pgp-tools.alioth.debian.org/
236
237 =cut
238
239 use strict;
240 use IO::Handle;
241 use English;
242 use File::Path;
243 use File::Temp qw{tempdir};
244 use Text::Template;
245 use MIME::Entity;
246 use Fcntl;
247 use IO::Select;
248 use Getopt::Long;
249 use GnuPG::Interface;
250
251 my %CONFIG;
252 my $REVISION = '$Rev$';
253 my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
254 my $VERSION = "0.0.0.$REVISION_NUMER";
255
256 sub load_config() {
257 my $config = $ENV{'HOME'} . '/.caffrc';
258 -f $config or die "No file $config present. See caff(1).\n";
259 unless (scalar eval `cat $config`) {
260 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
261 };
262
263 $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
264 die ("owner is not defined.\n") unless defined $CONFIG{'owner'};
265 die ("email is not defined.\n") unless defined $CONFIG{'email'};
266 die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};
267 die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
268 for my $keyid (@{$CONFIG{'keyid'}}) {
269 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");
270 };
271 @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
272 $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
273 $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
274 $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
275 $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
276 $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
277 $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
278 $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
279 $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
280 $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
281 Hi,
282
283 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
284 {foreach $uid (@uids) {
285 $OUT .= "\t".$uid."\n";
286 };} of your key {$key} signed by me.
287
288 Note that I did not upload your key to any keyservers. If you want this
289 new signature to be available to others, please upload it yourself.
290 With GnuPG this can be done using
291 gpg --keyserver subkeys.pgp.net --send-key {$key}
292
293 If you have any questions, don't hesitate to ask.
294
295 Regards,
296 {$owner}
297 EOM
298 };
299
300 sub notice($) {
301 my ($line) = @_;
302 print "[NOTICE] $line\n";
303 };
304 sub info($) {
305 my ($line) = @_;
306 print "[INFO] $line\n";
307 };
308 sub debug($) {
309 my ($line) = @_;
310 #print "[DEBUG] $line\n";
311 };
312 sub trace($) {
313 my ($line) = @_;
314 #print "[trace] $line\n";
315 };
316 sub trace2($) {
317 my ($line) = @_;
318 #print "[trace2] $line\n";
319 };
320
321 sub make_gpg_fds() {
322 my %fds = (
323 stdin => IO::Handle->new(),
324 stdout => IO::Handle->new(),
325 stderr => IO::Handle->new(),
326 status => IO::Handle->new() );
327 my $handles = GnuPG::Handles->new( %fds );
328 return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles);
329 };
330
331 sub readwrite_gpg($$$$$%) {
332 my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_;
333
334 trace("Entering readwrite_gpg.");
335
336 my ($first_line, undef) = split /\n/, $in;
337 debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
338
339 local $INPUT_RECORD_SEPARATOR = undef;
340 my $sout = IO::Select->new();
341 my $sin = IO::Select->new();
342 my $offset = 0;
343
344 trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef').".");
345
346 $inputfd->blocking(0);
347 $stdoutfd->blocking(0);
348 $statusfd->blocking(0) if defined $statusfd;
349 $stderrfd->blocking(0);
350 $sout->add($stdoutfd);
351 $sout->add($stderrfd);
352 $sout->add($statusfd) if defined $statusfd;
353 $sin->add($inputfd);
354
355 my ($stdout, $stderr, $status) = ("", "", "");
356 my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
357 trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
358
359 my $readwrote_stuff_this_time = 0;
360 my $do_not_wait_on_select = 0;
361 my ($readyr, $readyw, $written);
362 while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
363 if (defined $exitwhenstatusmatches) {
364 if ($status =~ /$exitwhenstatusmatches/m) {
365 trace("readwrite_gpg found match on $exitwhenstatusmatches");
366 if ($readwrote_stuff_this_time) {
367 trace("read/write some more\n");
368 $do_not_wait_on_select = 1;
369 } else {
370 trace("that's it in our while loop.\n");
371 last;
372 }
373 };
374 };
375
376 $readwrote_stuff_this_time = 0;
377 trace("select waiting for ".($sout->count())." fds.");
378 ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1);
379 trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
380 for my $wfd (@$readyw) {
381 $readwrote_stuff_this_time = 1;
382 if (length($in) != $offset) {
383 trace("writing to $wfd.");
384 $written = $wfd->syswrite($in, length($in) - $offset, $offset);
385 $offset += $written;
386 };
387 if ($offset == length($in)) {
388 trace("writing to $wfd done.");
389 unless ($options{'nocloseinput'}) {
390 close $wfd;
391 trace("$wfd closed.");
392 };
393 $sin->remove($wfd);
394 $sin = undef;
395 }
396 }
397
398 next unless (defined(@$readyr)); # Wait some more.
399
400 for my $rfd (@$readyr) {
401 $readwrote_stuff_this_time = 1;
402 if ($rfd->eof) {
403 trace("reading from $rfd done.");
404 $sout->remove($rfd);
405 close($rfd);
406 next;
407 }
408 trace("reading from $rfd.");
409 if ($rfd == $stdoutfd) {
410 $stdout .= <$rfd>;
411 trace2("stdout is now $stdout\n================");
412 next;
413 }
414 if (defined $statusfd && $rfd == $statusfd) {
415 $status .= <$rfd>;
416 trace2("status is now $status\n================");
417 next;
418 }
419 if ($rfd == $stderrfd) {
420 $stderr .= <$rfd>;
421 trace2("stderr is now $stderr\n================");
422 next;
423 }
424 }
425 }
426 trace("readwrite_gpg done.");
427 return ($stdout, $stderr, $status);
428 };
429
430 sub ask($$;$$) {
431 my ($question, $default, $forceyes, $forceno) = @_;
432 return $default if $forceyes and $forceno;
433 return 1 if $forceyes;
434 return 0 if $forceno;
435 my $answer;
436 while (1) {
437 print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';
438 $answer = <STDIN>;
439 chomp $answer;
440 last if ((defined $answer) && (length $answer <= 1));
441 print "grrrrrr.\n";
442 sleep 1;
443 };
444 my $result = $default;
445 $result = 1 if $answer =~ /y/i;
446 $result = 0 if $answer =~ /n/i;
447 return $result;
448 };
449
450
451
452
453
454 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt';
455 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay';
456 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig';
457 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)';
458 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
459
460 load_config;
461 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
462
463 my $KEYSBASE = $CONFIG{'caffhome'}.'/keys';
464 my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
465
466 -d $KEYSBASE || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n");
467 -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n");
468
469 my $NOW = time;
470 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW);
471 my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
472
473
474 sub version($) {
475 my ($fd) = @_;
476 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
477 };
478
479 sub usage($$) {
480 my ($fd, $exitcode) = @_;
481 version($fd);
482 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
483 print $fd "Consult the manual page for more information.\n";
484 exit $exitcode;
485 };
486
487 ######
488 # export key $keyid from $gnupghome
489 ######
490 sub export_key($$) {
491 my ($gnupghome, $keyid) = @_;
492
493 my $gpg = GnuPG::Interface->new();
494 $gpg->call( $CONFIG{'gpg'} );
495 $gpg->options->hash_init(
496 'homedir' => $gnupghome,
497 'armor' => 1 );
498 $gpg->options->meta_interactive( 0 );
499 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
500 my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
501 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
502 waitpid $pid, 0;
503
504 return $stdout;
505 };
506
507 ######
508 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
509 ######
510 sub import_key($$) {
511 my ($gnupghome, $asciikey) = @_;
512
513 my $gpg = GnuPG::Interface->new();
514 $gpg->call( $CONFIG{'gpg'} );
515 $gpg->options->hash_init( 'homedir' => $gnupghome );
516 $gpg->options->meta_interactive( 0 );
517 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
518 my $pid = $gpg->import_keys(handles => $handles);
519 my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
520 waitpid $pid, 0;
521
522 if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
523 return undef;
524 };
525 return 1;
526 };
527
528
529 ######
530 # Send an email to $address. If $can_encrypt is true then the mail
531 # will be PGP/MIME encrypted to $longkeyid.
532 #
533 # $longkeyid, $uid, and @attached will be used in the email and the template.
534 ######
535 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
536 sub send_mail($$$@) {
537 my ($address, $can_encrypt, $key_id, @keys) = @_;
538
539 my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
540 or die "Error creating template: $Text::Template::ERROR";
541
542 my @uids;
543 for my $key (@keys) {
544 push @uids, $key->{'text'};
545 };
546 my $message = $template->fill_in(HASH => { key => $key_id,
547 uids => \@uids,
548 owner => $CONFIG{'owner'}})
549 or die "Error filling template in: $Text::Template::ERROR";
550
551 my $message_entity = MIME::Entity->build(
552 Type => "text/plain",
553 Charset => "utf-8",
554 Disposition => 'inline',
555 Data => $message);
556
557 my @key_entities;
558 for my $key (@keys) {
559 $message_entity->attach(
560 Type => "application/pgp-keys",
561 Disposition => 'attachment',
562 Encoding => "7bit",
563 Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',
564 Data => $key->{'key'},
565 Filename => "0x$key_id.".$key->{'serial'}.".asc");
566 };
567
568 if ($can_encrypt) {
569 my $message = $message_entity->stringify();
570
571 my $gpg = GnuPG::Interface->new();
572 $gpg->call( $CONFIG{'gpg'} );
573 $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
574 'extra_args' => '--always-trust',
575 'armor' => 1 );
576 $gpg->options->meta_interactive( 0 );
577 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
578 $gpg->options->push_recipients( $key_id );
579 $gpg->options->push_recipients( $CONFIG{'also-encrypt-to'} ) if defined $CONFIG{'also-encrypt-to'};
580 my $pid = $gpg->encrypt(handles => $handles);
581 my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd);
582 waitpid $pid, 0;
583 if ($stdout eq '') {
584 warn ("No data from gpg for list-key $key_id\n");
585 next;
586 };
587 $message = $stdout;
588
589 $message_entity = MIME::Entity->build(
590 Type => 'multipart/encrypted; protocol="application/pgp-encrypted"');
591
592 $message_entity->attach(
593 Type => "application/pgp-encrypted",
594 Disposition => 'attachment',
595 Encoding => "7bit",
596 Data => "Version: 1\n");
597
598 $message_entity->attach(
599 Type => "application/octet-stream",
600 Filename => 'msg.asc',
601 Disposition => 'inline',
602 Encoding => "7bit",
603 Data => $message);
604 };
605
606 $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
607 $message_entity->head->add("To", $address);
608 $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
609 $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
610 $message_entity->head->add("User-Agent", $USER_AGENT);
611 $message_entity->send();
612 $message_entity->stringify();
613 };
614
615 ######
616 # clean up a UID so that it can be used on the FS.
617 ######
618 sub sanitize_uid($) {
619 my ($uid) = @_;
620
621 my $good_uid = $uid;
622 $good_uid =~ tr#/:\\#_#;
623 trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
624 return $good_uid;
625 };
626
627 sub delete_signatures($$$$$$) {
628 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
629
630 my $signed_by_me = 0;
631
632 my ($stdout, $stderr, $status) =
633 readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
634
635 while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
636 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
637 my @sigline = grep { /^sig/ } (split /\n/, $stdout);
638 $stdout =~ s/\n/\\n/g;
639 notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
640 my $line = pop @sigline;
641 my $answer = "no";
642 if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
643 debug("[sigremoval] doing line $line.");
644 my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
645 if ($signer eq $longkeyid) {
646 debug("[sigremoval] selfsig ($signer).");
647 $answer = "no";
648 } elsif (grep { $signer eq $_ } @{$keyids}) {
649 debug("[sigremoval] signed by us ($signer).");
650 $answer = "no";
651 $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
652 } else {
653 debug("[sigremoval] not interested in that sig ($signer).");
654 $answer = "yes";
655 };
656 } else {
657 debug("[sigremoval] no sig line here, only got: ".$stdout);
658 };
659 ($stdout, $stderr, $status) =
660 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
661 };
662
663 return $signed_by_me;
664 };
665
666
667
668 my $USER;
669 my @KEYIDS;
670 my $params;
671
672 Getopt::Long::config('bundling');
673 if (!GetOptions (
674 '-h' => \$params->{'help'},
675 '--help' => \$params->{'help'},
676 '--version' => \$params->{'version'},
677 '-V' => \$params->{'version'},
678 '-u=s' => \$params->{'local-user'},
679 '--local-user=s' => \$params->{'local-user'},
680 '-e' => \$params->{'export-old'},
681 '--export-old' => \$params->{'export-old'},
682 '-E' => \$params->{'no-export-old'},
683 '--no-export-old' => \$params->{'no-export-old'},
684 '-m' => \$params->{'mail'},
685 '--mail' => \$params->{'mail'},
686 '-M' => \$params->{'no-mail'},
687 '--no-mail' => \$params->{'no-mail'},
688 '-R' => \$params->{'no-download'},
689 '--no-download' => \$params->{'no-download'},
690 '-S' => \$params->{'no-sign'},
691 '--no-sign' => \$params->{'no-sign'},
692 )) {
693 usage(\*STDERR, 1);
694 };
695 if ($params->{'help'}) {
696 usage(\*STDOUT, 0);
697 };
698 if ($params->{'version'}) {
699 version(\*STDOUT);
700 exit(0);
701 };
702 usage(\*STDERR, 1) unless scalar @ARGV >= 1;
703
704
705
706 if ($params->{'local-user'}) {
707 $USER = $params->{'local-user'};
708 $USER =~ s/^0x//i;
709 unless ($USER =~ /^([A-Z0-9]{8}|[A-Z0-9]{16}|[A-Z0-9]{40})$/i) {
710 print STDERR "-u $USER is not a keyid.\n";
711 usage(\*STDERR, 1);
712 };
713 $USER = uc($USER);
714 };
715
716 for my $keyid (@ARGV) {
717 $keyid =~ s/^0x//i;
718 unless ($keyid =~ /^([A-Z0-9]{8}|[A-Z0-9]{16}||[A-Z0-9]{40})$/i) {
719 print STDERR "$keyid is not a keyid.\n";
720 usage(\*STDERR, 1);
721 };
722 push @KEYIDS, uc($keyid);
723 };
724
725 $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
726 $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'};
727 $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'};
728 $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'};
729
730
731 #################
732 # import own keys
733 #################
734 my $gpg = GnuPG::Interface->new();
735 $gpg->call( $CONFIG{'gpg'} );
736 $gpg->options->hash_init(
737 'homedir' => $GNUPGHOME,
738 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
739 $gpg->options->meta_interactive( 0 );
740 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
741 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
742 my $pid = $gpg->list_public_keys(handles => $handles, command_args => $CONFIG{'keyid'});
743 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
744 waitpid $pid, 0;
745 if ($stdout eq '') {
746 warn ("No data from gpg for list-key\n");
747 next;
748 };
749 foreach my $keyid (@{$CONFIG{'keyid'}}) {
750 unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
751 info("Importing $keyid");
752 system "gpg --export $keyid | gpg --import --homedir $GNUPGHOME";
753 }
754 }
755
756 #############################
757 # receive keys from keyserver
758 #############################
759 my @keyids_ok;
760 if ($CONFIG{'no-download'}) {
761 @keyids_ok = @KEYIDS;
762 } else {
763 info ("fetching keys, this will take a while...");
764
765 my $gpg = GnuPG::Interface->new();
766 $gpg->call( $CONFIG{'gpg'} );
767 $gpg->options->hash_init(
768 'homedir' => $GNUPGHOME,
769 'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );
770 $gpg->options->meta_interactive( 0 );
771 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
772 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
773 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
774 waitpid $pid, 0;
775
776 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
777 # [GNUPG:] NODATA 1
778 # [GNUPG:] NODATA 1
779 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
780 my %local_keyids = map { $_ => 1 } @KEYIDS;
781 for my $line (split /\n/, $status) {
782 if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
783 my $imported_key = $1;
784 my $whole_fpr = $imported_key;
785 my $long_keyid = substr($imported_key, -16);
786 my $short_keyid = substr($imported_key, -8);
787 my $speced_key;
788 for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
789 $speced_key = $spec if $local_keyids{$spec};
790 };
791 unless ($speced_key) {
792 notice ("Imported unexpected key; got: $imported_key\n");
793 next;
794 };
795 debug ("Imported $imported_key for $speced_key");
796 delete $local_keyids{$speced_key};
797 unshift @keyids_ok, $imported_key;
798 } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
799 } else {
800 notice ("got unknown reply from gpg: $line");
801 }
802 };
803 if (scalar %local_keyids) {
804 notice ("Import failed for: ". (join ' ', keys %local_keyids).".");
805 exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
806 }
807 };
808
809 unless (@keyids_ok) {
810 notice ("No keys to sign found");
811 exit 0;
812 }
813
814 ###########
815 # sign keys
816 ###########
817 unless ($CONFIG{'no-sign'}) {
818 info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
819 for my $keyid (@keyids_ok) {
820 my @command;
821 push @command, $CONFIG{'gpg-sign'};
822 push @command, '--local-user', $USER if (defined $USER);
823 push @command, "--homedir=$GNUPGHOME";
824 push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
825 push @command, '--edit', $keyid;
826 push @command, 'sign';
827 push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
828 print join(' ', @command),"\n";
829 system (@command);
830 };
831 };
832
833 ##################
834 # export and prune
835 ##################
836 KEYS:
837 for my $keyid (@keyids_ok) {
838 # get key listing
839 #################
840 my $gpg = GnuPG::Interface->new();
841 $gpg->call( $CONFIG{'gpg'} );
842 $gpg->options->hash_init( 'homedir' => $GNUPGHOME );
843 $gpg->options->meta_interactive( 0 );
844 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
845 $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );
846 my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
847 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
848 waitpid $pid, 0;
849 if ($stdout eq '') {
850 warn ("No data from gpg for list-key $keyid\n");
851 next;
852 };
853 my @publine = grep { /^pub/ } (split /\n/, $stdout);
854 if (scalar @publine == 0) {
855 warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
856 next;
857 };
858 my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
859 if (scalar @publine > 0) {
860 warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n");
861 next;
862 };
863 unless (defined $longkeyid) {
864 warn ("Didn't find public keyid in --list-key of key $keyid.\n");
865 next;
866 };
867 unless (defined $flags) {
868 warn ("Didn't find flags in --list-key of key $keyid.\n");
869 next;
870 };
871 my $can_encrypt = $flags =~ /E/;
872
873 # export the key
874 ################
875 my $asciikey = export_key($GNUPGHOME, $keyid);
876 if ($asciikey eq '') {
877 warn ("No data from gpg for export $keyid\n");
878 next;
879 };
880
881 my @UIDS;
882 my $uid_number = 0;
883 while (1) {
884 my $this_uid_text = '';
885 $uid_number++;
886 debug("Doing key $keyid, uid $uid_number");
887 my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
888
889 # import into temporary gpghome
890 ###############################
891 my $result = import_key($tempdir, $asciikey);
892 unless ($result) {
893 warn ("Could not import $keyid into temporary gnupg.\n");
894 next;
895 };
896
897 # prune it
898 ##########
899 $gpg = GnuPG::Interface->new();
900 $gpg->call( $CONFIG{'gpg-delsig'} );
901 $gpg->options->hash_init(
902 'homedir' => $tempdir,
903 'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );
904 ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
905 $pid = $gpg->wrap_call(
906 commands => [ '--edit' ],
907 command_args => [ $keyid ],
908 handles => $handles );
909
910 debug("Starting edit session");
911 ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
912
913 # delete other uids
914 ###################
915 my $number_of_subkeys = 0;
916 my $i = 1;
917 my $have_one = 0;
918 my $is_uat = 0;
919 my $delete_some = 0;
920 debug("Parsing stdout output.");
921 for my $line (split /\n/, $stdout) {
922 debug("Checking line $line");
923 my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line;
924 if ($type eq 'sub') {
925 $number_of_subkeys++;
926 };
927 next unless ($type eq 'uid' || $type eq 'uat');
928 debug("line is interesting.");
929 if ($uid_number != $i) {
930 debug("mark for deletion.");
931 readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
932 $delete_some++;
933 } else {
934 debug("keep it.");
935 $have_one = 1;
936 $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
937 $is_uat = $type eq 'uat';
938 };
939 $i++;
940 };
941 debug("Parsing stdout output done.");
942 unless ($have_one) {
943 debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
944 info("key $keyid done.");
945 last;
946 };
947
948 my $prune_some_sigs_on_uid;
949 my $prune_all_sigs_on_uid;
950 if ($is_uat) {
951 debug("handling attribute userid of key $keyid.");
952 if ($uid_number == 1) {
953 debug(" attribute userid is #1, unmarking #2 for deletion.");
954 readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
955 $delete_some--;
956 $prune_some_sigs_on_uid = 1;
957 $prune_all_sigs_on_uid = 2;
958 } else {
959 debug("attribute userid is not #1, unmarking #1 for deletion.");
960 readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
961 $delete_some--;
962 $prune_some_sigs_on_uid = 2;
963 $prune_all_sigs_on_uid = 1;
964 };
965 } else {
966 $prune_some_sigs_on_uid = 1;
967 };
968
969 if ($delete_some) {
970 debug("need to delete $delete_some uids.");
971 readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
972 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
973 };
974
975 # delete subkeys
976 ################
977 if ($number_of_subkeys > 0) {
978 for (my $i=1; $i<=$number_of_subkeys; $i++) {
979 readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
980 };
981 readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1);
982 readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
983 };
984
985 # delete signatures
986 ###################
987 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
988 my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
989 readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
990 if (defined $prune_all_sigs_on_uid) {
991 readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
992 delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
993 readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
994 };
995
996
997 readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
998 waitpid $pid, 0;
999
1000 my $asciikey = export_key($tempdir, $keyid);
1001 if ($asciikey eq '') {
1002 warn ("No data from gpg for export $keyid\n");
1003 next;
1004 };
1005
1006 if ($signed_by_me) {
1007 if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1008 my $write = ask("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'});
1009 next unless $write;
1010 };
1011 my $keydir = "$KEYSBASE/$DATE_STRING";
1012 -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1013
1014 my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
1015 open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1016 print KEY $asciikey;
1017 close KEY;
1018
1019 push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat };
1020
1021 info("$longkeyid $uid_number $this_uid_text done.");
1022 } else {
1023 info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing.");
1024 };
1025 };
1026
1027 if (scalar @UIDS == 0) {
1028 info("found no signed uids for $keyid");
1029 } else {
1030 next if $CONFIG{'no-mail'}; # do not send mail
1031
1032 my @attached;
1033 for my $uid (@UIDS) {
1034 trace("UID: $uid->{'text'}\n");
1035 if ($uid->{'is_uat'}) {
1036 my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1037 push @attached, $uid if $attach;
1038 } elsif ($uid->{'text'} !~ /@/) {
1039 my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1040 push @attached, $uid if $attach;
1041 };
1042 };
1043
1044 notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1045 for my $uid (@UIDS) {
1046 if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1047 my $address = $uid->{'text'};
1048 $address =~ s/.*<(.*)>.*/$1/;
1049 if (ask("Send mail to '$address' for $uid->{'text'}?", 1, $CONFIG{'mail'})) {
1050 my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
1051
1052 my $keydir = "$KEYSBASE/$DATE_STRING";
1053 my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
1054 open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1055 print KEY $mail;
1056 close KEY;
1057 };
1058 };
1059 };
1060 };
1061
1062 };