/[pgp-tools]/trunk/caff/caff
ViewVC logotype

Diff of /trunk/caff/caff

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 9 by weasel, Tue Jun 29 13:02:34 2004 UTC revision 260 by myon, Wed Feb 15 09:59:09 2006 UTC
# Line 3  Line 3 
3  # caff  --  CA - Fire and Forget  # caff  --  CA - Fire and Forget
4  # $Id$  # $Id$
5  #  #
6  # Copyright (c) 2004 Peter Palfrader <peter@palfrader.org>  # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7    # Copyright (c) 2005 Christoph Berg <cb@df7cb.de>
8  #  #
9  # All rights reserved.  # All rights reserved.
10  #  #
# Line 39  caff -- CA - Fire and Forget Line 40  caff -- CA - Fire and Forget
40    
41  =over  =over
42    
43  =item B<caff> [-u I<yourkeyid>] I<keyid> [I<keyid> ..]  =item B<caff> [-eEmMRS] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
44    
45  =back  =back
46    
# Line 49  CA Fire and Forget is a script that help Line 50  CA Fire and Forget is a script that help
50  of keyids on the command line, fetches them from a keyserver and calls GnuPG so  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  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  including the one UID that we send to in each mail, pruned from all but self
53  sigs and sigs done by you.  sigs and sigs done by you.  The mailed key is encrypted with itself as a means
54    to verify that key belongs to the recipient.
55    
56  =head1 OPTIONS  =head1 OPTIONS
57    
58  =over  =over
59    
60  =item B<-u> I<yourkeyid>  =item B<-e>, B<--export-old>
61    
62    Export old signatures. Default is to ask the user for each old signature.
63    
64    =item B<-E>, B<--no-export-old>
65    
66    Do not export old signatures. Default is to ask the user for each old
67    signature.
68    
69    =item B<-m>, B<--mail>
70    
71    Send mail after signing. Default is to ask the user for each uid.
72    
73    =item B<-M>, B<--no-mail>
74    
75    Do not send mail after signing. Default is to ask the user for each uid.
76    
77    =item B<-R>, B<--no-download>
78    
79    Do not retrieve the key to be signed from a keyserver.
80    
81    =item B<-S>, B<--no-sign>
82    
83    Do not sign the keys.
84    
85    =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
86    
87  Select the key that is used for signing, in case you have more than one key.  Select the key that is used for signing, in case you have more than one key.
88    
89    =item B<--key-file> I<file>
90    
91    Import keys from file. Can be supplied more than once.
92    
93  =back  =back
94    
95  =head1 FILES  =head1 FILES
# Line 67  Select the key that is used for signing, Line 98  Select the key that is used for signing,
98    
99  =item $HOME/.caffrc  -  configuration file  =item $HOME/.caffrc  -  configuration file
100    
101    =item $HOME/.caff/keys/yyyy-mm-dd/  -  processed keys
102    
103    =item $HOME/.caff/gnupghome/  -  caff's working dir for gpg
104    
105    =item $HOME/.caff/gnupghome/gpg.conf  -  gpg configuration
106    
107    useful options include use-agent, default-cert-level, etc.
108    
109  =back  =back
110    
111  =head1 CONFIGURATION FILE OPTIONS  =head1 CONFIGURATION FILE OPTIONS
112    
113  The configuration file is a perl script that sets values in the hash B<%CONFIG>.  The configuration file is a perl script that sets values in the hash B<%CONFIG>.
114    The file is generated when it does not exist.
115    
116  Example:  Example:
117    
118          $CONFIG{'owner'}       = 'Peter Palfrader';          $CONFIG{owner} = q{Peter Palfrader};
119          $CONFIG{'email'}       = 'peter@palfrader.org';          $CONFIG{email} = q{peter@palfrader.org};
120            $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
121    
122  =head2 Valid keys  =head2 Required basic settings
123    
124  =over  =over
125    
 =item B<caffhome> [string]  
   
 Base directory for the files caff stores.  Default: B<$HOME/.caff/>.  
   
126  =item B<owner> [string]  =item B<owner> [string]
127    
128  Your name.  B<REQUIRED>.  Your name.  B<REQUIRED>.
# Line 100  A list of your keys.  This is used to de Line 137  A list of your keys.  This is used to de
137  in the pruning step.  If you select a key using B<-u> it has to be in  in the pruning step.  If you select a key using B<-u> it has to be in
138  this list.  B<REQUIRED>.  this list.  B<REQUIRED>.
139    
140  =item B<export-sig-age> [seconds]  =head2 General settings
141    
142  Don't export UIDs by default, on which your latest signature is older  =item B<caffhome> [string]
 than this age.  Default: B<24*60*60> (i.e. one day).  
143    
144  =item B<keyserver> [string]  Base directory for the files caff stores.  Default: B<$HOME/.caff/>.
145    
146  Keyserver to download keys from.  Default: B<subkeys.pgp.net>.  =head2 GnuPG settings
147    
148  =item B<gpg> [string]  =item B<gpg> [string]
149    
# Line 118  Path to the GnuPG binary.  Default: B<gp Line 154  Path to the GnuPG binary.  Default: B<gp
154  Path to the GnuPG binary which is used to sign keys.  Default: what  Path to the GnuPG binary which is used to sign keys.  Default: what
155  B<gpg> is set to.  B<gpg> is set to.
156    
157  =item B<gpg-sdelsig> [string]  =item B<gpg-delsig> [string]
158    
159  Path to the GnuPG binary which is used to split off signatures.  This is  Path to the GnuPG binary which is used to split off signatures.  This was
160  needed while the upstream GnuPG is not fixed  (there are 2 bugs in the  needed while the upstream GnuPG was not fixed.  Default: what B<gpg>
161  Debian Bug Tracking System).  Default: what B<gpg> is set to.  is set to.
162    
163  =item B<secret-keyring> [string]  =item B<secret-keyring> [string]
164    
165  Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.  Path to your secret keyring.  Default: B<$HOME/.gnupg/secring.gpg>.
166    
167    =item B<also-encrypt-to> [keyid]
168    
169    An additional keyid to encrypt messages to. Default: none.
170    
171    =item B<gpg-sign-args> [string]
172    
173    Additional arguments to pass to gpg.  Default: none.
174    
175    =head2 Keyserver settings
176    
177    =item B<keyserver> [string]
178    
179    Keyserver to download keys from.  Default: B<subkeys.pgp.net>.
180    
181    =item B<no-download> [boolean]
182    
183    If true, then skip the step of fetching keys from the keyserver.
184    Default: B<0>.
185    
186    =item B<key-files> [list of files]
187    
188    A list of files containing keys to be imported.
189    
190    =head2 Signing settings
191    
192    =item B<no-sign> [boolean]
193    
194    If true, then skip the signing step. Default: B<0>.
195    
196    =item B<ask-sign> [boolean]
197    
198    If true, then pause before continuing to the signing step.
199    This is useful for offline signing. Default: B<0>.
200    
201    =item B<export-sig-age> [seconds]
202    
203    Don't export UIDs by default, on which your latest signature is older
204    than this age.  Default: B<24*60*60> (i.e. one day).
205    
206    =head2 Mail settings
207    
208    =item B<mail> [boolean]
209    
210    Do not prompt for sending mail, just do it. Default: B<0>.
211    
212    =item B<no-mail> [boolean]
213    
214    Do not prompt for sending mail. The messages are still written to
215    $CONFIG{caffhome}/keys/. Default: B<0>.
216    
217    =item B<mail-template> [string]
218    
219    Email template which is used as the body text for the email sent out
220    instead of the default text if specified. The following perl variables
221    can be used in the template:
222    
223    =over
224    
225    =item B<{owner}> [string]
226    
227    Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
228    
229    =item B<{key}> [string]
230    
231    The keyid of the key you signed.
232    
233    =item B<{@uids}> [array]
234    
235    The UIDs for which signatures are included in the mail.
236    
237  =back  =back
238    
239  =head1 AUTHOR  =item B<reply-to> [string]
240    
241    Add a Reply-To: header to messages sent. Default: none.
242    
243    =item B<bcc> [string]
244    
245    Address to send blind carbon copies to when sending mail.
246    Default: none.
247    
248  Peter Palfrader <peter@palfrader.org>  =back
249    
250    =head1 AUTHORS
251    
252    =over
253    
254    =item Peter Palfrader <peter@palfrader.org>
255    
256    =item Christoph Berg <cb@df7cb.de>
257    
258    =back
259    
260    =head1 WEBSITE
261    
262    http://pgp-tools.alioth.debian.org/
263    
264    =head1 SEE ALSO
265    
266    gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
267    
268  =cut  =cut
269    
# Line 141  use IO::Handle; Line 272  use IO::Handle;
272  use English;  use English;
273  use File::Path;  use File::Path;
274  use File::Temp qw{tempdir};  use File::Temp qw{tempdir};
275    use Text::Template;
276  use MIME::Entity;  use MIME::Entity;
277  use Fcntl;  use Fcntl;
278  use IO::Select;  use IO::Select;
279    use Getopt::Long;
280  use GnuPG::Interface;  use GnuPG::Interface;
281    
282  my %CONFIG;  my %CONFIG;
# Line 151  my $REVISION = '$Rev$'; Line 284  my $REVISION = '$Rev$';
284  my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;  my ($REVISION_NUMER) = $REVISION =~ /(\d+)/;
285  my $VERSION = "0.0.0.$REVISION_NUMER";  my $VERSION = "0.0.0.$REVISION_NUMER";
286    
 sub load_config() {  
         my $config = $ENV{'HOME'} . '/.caffrc';  
         -f $config or die "No file $config present.  See caffrc(5).\n";  
         unless (scalar eval `cat $config`) {  
                 die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;  
         };  
287    
         $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};  
         die ("owner is not defined.\n") unless defined $CONFIG{'owner'};  
         die ("email is not defined.\n") unless defined $CONFIG{'email'};  
         die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'};  
         die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');  
         for my $keyid (@{$CONFIG{'keyid'}}) {  
                 $keyid =~ /^[A-Fa-z0-9]{16}$/ or die ("key $keyid is not a long (16 digit) keyid.\n");  
         };  
         @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};  
         $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};  
         $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};  
         $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};  
         $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};  
         $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};  
         $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};  
 };  
288    
289  sub notice($) {  sub notice($) {
290          my ($line) = @_;          my ($line) = @_;
# Line 196  sub trace2($) { Line 307  sub trace2($) {
307          #print "[trace2] $line\n";          #print "[trace2] $line\n";
308  };  };
309    
310    
311    sub generate_config() {
312            notice("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'};
313            my $gecos = defined $ENV{'LOGNAME'} ? (getpwnam($ENV{LOGNAME}))[6] : undef;
314            my $email;
315            my @keys;
316            my $hostname = `hostname -f`;
317            chomp $hostname;
318            my ($Cgecos,$Cemail,$Ckeys) = ('','','');
319            if (defined $gecos) {
320                    $gecos =~ s/,.*//;
321    
322                    my $gpg = GnuPG::Interface->new();
323                    $gpg->call( 'gpg' );
324                    $gpg->options->hash_init(
325                            'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
326                    $gpg->options->meta_interactive( 0 );
327                    my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
328                    my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $gecos ]);
329                    my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
330                    waitpid $pid, 0;
331    
332                    if ($stdout eq '') {
333                            warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
334                    };
335    
336                    @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg);
337                    unless (scalar @keys) {
338                            info("Error: No keys were found using \"gpg --list-public-keys '$gecos'\".");
339                            @keys = qw{0123456789abcdef 89abcdef76543210};
340                            $Ckeys = '#';
341                    }
342                    ($email) =  ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m);
343                    unless (defined $email) {
344                            info("Error: No email address was found using \"gpg --list-public-keys '$gecos'\".");
345                            $email = $ENV{'LOGNAME'}.'@'.$hostname;
346                            $Cemail = '#';
347                    }
348            } else {
349                    $gecos = 'Unknown Caff User';
350                    $email = $ENV{'LOGNAME'}.'@'.$hostname;
351                    @keys = qw{0123456789abcdef 89abcdef76543210};
352                    ($Cgecos,$Cemail,$Ckeys) = ('#','#','#');
353            };
354    
355            return <<EOT;
356    # .caffrc -- vim:syntax=perl:
357    # This file is in perl(1) format - see caff(1) for details.
358    
359    $Cgecos\$CONFIG{'owner'}       = '$gecos';
360    $Cemail\$CONFIG{'email'}       = '$email';
361    
362    # you can get your long keyid from
363    #   gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
364    #
365    # if you have a v4 key, it will simply be the last 16 digits of
366    # your fingerprint.
367    #
368    # Example:
369    #   \$CONFIG{'keyid'}       = [ qw{FEDCBA9876543210} ];
370    #  or, if you have more than one key:
371    #   \$CONFIG{'keyid'}       = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
372    
373    $Ckeys\$CONFIG{'keyid'}       = [ qw{@keys} ];
374    EOT
375    };
376    
377    sub check_executable($$) {
378            # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
379            # so we want to check manually.)
380            my ($purpose, $fn) = @_;
381            # Only check provided fnames with a slash in them.
382            return unless defined $fn;
383            if ($fn =~ m!/!) {
384                    die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x $fn;
385            } else {
386                    for my $p (split(':', $ENV{PATH})) {
387                            return if -x "$p/$fn";
388                    };
389                    die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x $fn;
390            };
391    };
392    
393    sub load_config() {
394            my $config = $ENV{'HOME'} . '/.caffrc';
395            unless (-f $config) {
396                    print "No configfile $config present, I will use this template:\n";
397                    my $template = generate_config();
398                    print "$template\nPlease edit $config and run caff again.\n";
399                    open F, ">$config" or die "$config: $!";
400                    print F $template;
401                    close F;
402                    exit(1);
403            }
404            unless (scalar eval `cat $config`) {
405                    die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR;
406            };
407    
408            $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'};
409            die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'};
410            die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'};
411            die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'};
412            die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY');
413            for my $keyid (@{$CONFIG{'keyid'}}) {
414                    $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n");
415            };
416            @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}};
417            $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'};
418            $CONFIG{'keyserver'} = 'subkeys.pgp.net' unless defined $CONFIG{'keyserver'};
419            $CONFIG{'gpg'} = 'gpg' unless defined $CONFIG{'gpg'};
420            $CONFIG{'gpg-sign'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-sign'};
421            $CONFIG{'gpg-delsig'} = $CONFIG{'gpg'} unless defined $CONFIG{'gpg-delsig'};
422            check_executable("gpg", $CONFIG{'gpg'});
423            check_executable("gpg-sign", $CONFIG{'gpg-sign'});
424            check_executable("gpg-delsig", $CONFIG{'gpg-delsig'});
425            $CONFIG{'secret-keyring'} = $ENV{'HOME'}.'/.gnupg/secring.gpg' unless defined $CONFIG{'secret-keyring'};
426            $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'};
427            $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'};
428            $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'};
429            $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'};
430    Hi,
431    
432    please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
433    {foreach $uid (@uids) {
434        $OUT .= "\t".$uid."\n";
435    };} of your key {$key} signed by me.
436    
437    Note that I did not upload your key to any keyservers.
438    If you have multiple user ids, I sent the signature for each user id
439    separately to that user id's associated email address. You can import
440    the signatures by running each through `gpg --import`.
441    
442    If you want this new signature to be available to others, please upload
443    it yourself. With GnuPG this can be done using
444            gpg --keyserver subkeys.pgp.net --send-key {$key}
445    
446    If you have any questions, don't hesitate to ask.
447    
448    Regards,
449    {$owner}
450    EOM
451    };
452    
453  sub make_gpg_fds() {  sub make_gpg_fds() {
454          my %fds = (          my %fds = (
455                  stdin => IO::Handle->new(),                  stdin => IO::Handle->new(),
# Line 211  sub readwrite_gpg($$$$$%) { Line 465  sub readwrite_gpg($$$$$%) {
465    
466          trace("Entering readwrite_gpg.");          trace("Entering readwrite_gpg.");
467    
468          my ($first_line, $dummy) = split /\n/, $in;          my ($first_line, undef) = split /\n/, $in;
469          debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));          debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "<nothing>"));
470    
471          local $INPUT_RECORD_SEPARATOR = undef;          local $INPUT_RECORD_SEPARATOR = undef;
# Line 232  sub readwrite_gpg($$$$$%) { Line 486  sub readwrite_gpg($$$$$%) {
486    
487          my ($stdout, $stderr, $status) = ("", "", "");          my ($stdout, $stderr, $status) = ("", "", "");
488          my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};          my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'};
489          trace("doign stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;          trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches;
490    
491            my $readwrote_stuff_this_time = 0;
492            my $do_not_wait_on_select = 0;
493          my ($readyr, $readyw, $written);          my ($readyr, $readyw, $written);
494          while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {          while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) {
495                  if (defined $exitwhenstatusmatches) {                  if (defined $exitwhenstatusmatches) {
496                          if ($status =~ /$exitwhenstatusmatches/m) {                          if ($status =~ /$exitwhenstatusmatches/m) {
497                                  trace("readwrite_gpg found match on $exitwhenstatusmatches");                                  trace("readwrite_gpg found match on $exitwhenstatusmatches");
498                                  last;                                  if ($readwrote_stuff_this_time) {
499                                            trace("read/write some more\n");
500                                            $do_not_wait_on_select = 1;
501                                    } else {
502                                            trace("that's it in our while loop.\n");
503                                            last;
504                                    }
505                          };                          };
506                  };                  };
507    
508                    $readwrote_stuff_this_time = 0;
509                  trace("select waiting for ".($sout->count())." fds.");                  trace("select waiting for ".($sout->count())." fds.");
510                  ($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);
511                  trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));                  trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0));
512                  for my $wfd (@$readyw) {                  for my $wfd (@$readyw) {
513                            $readwrote_stuff_this_time = 1;
514                          if (length($in) != $offset) {                          if (length($in) != $offset) {
515                                  trace("writing to $wfd.");                                  trace("writing to $wfd.");
516                                  $written = $wfd->syswrite($in, length($in) - $offset, $offset);                                  $written = $wfd->syswrite($in, length($in) - $offset, $offset);
# Line 266  sub readwrite_gpg($$$$$%) { Line 530  sub readwrite_gpg($$$$$%) {
530                  next unless (defined(@$readyr)); # Wait some more.                  next unless (defined(@$readyr)); # Wait some more.
531    
532                  for my $rfd (@$readyr) {                  for my $rfd (@$readyr) {
533                            $readwrote_stuff_this_time = 1;
534                          if ($rfd->eof) {                          if ($rfd->eof) {
535                                  trace("reading from $rfd done.");                                  trace("reading from $rfd done.");
536                                  $sout->remove($rfd);                                  $sout->remove($rfd);
# Line 294  sub readwrite_gpg($$$$$%) { Line 559  sub readwrite_gpg($$$$$%) {
559          return ($stdout, $stderr, $status);          return ($stdout, $stderr, $status);
560  };  };
561    
562  sub ask($$) {  sub ask($$;$$) {
563          my ($question, $default) = @_;          my ($question, $default, $forceyes, $forceno) = @_;
564          my $answer;          my $answer;
565            my $yn = $default ? '[Y/n]' : '[y/N]';
566          while (1) {          while (1) {
567                  print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' ';                  print $question,' ',$yn, ' ';
568                    if ($forceyes && $forceno) {
569                            print "$default (from config/command line)\n";
570                            return $default;
571                    };
572                    if ($forceyes) {
573                            print "YES (from config/command line)\n";
574                            return 1;
575                    };
576                    if ($forceno) {
577                            print "NO (from config/command line)\n";
578                            return 0;
579                    };
580    
581                  $answer = <STDIN>;                  $answer = <STDIN>;
582                    if (!defined $answer) {
583                            $OUTPUT_AUTOFLUSH = 1;
584                            die "\n\n".
585                                "End of STDIN reached.  Are you using xargs?  Caff wants to read from STDIN,\n".
586                                "so you can't really use it with xargs.  A patch against caff to read from\n".
587                                "the terminal would be appreciated.\n".
588                                "For now instead of   cat keys | xargs caff  do  caff `cat keys`\n";
589                    };
590                  chomp $answer;                  chomp $answer;
591                  last if ((defined $answer) && (length $answer <= 1));                  last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) );
592                  print "grrrrrr.\n";                  print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n";
593                  sleep 1;                  sleep 1;
594          };          };
595          my $result = $default;          my $result = $default;
# Line 322  my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = ' Line 609  my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '
609  my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';  my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey';
610    
611  load_config;  load_config;
612  my $USER_AGENT = "caff $VERSION - (c) 2004 Peter Palfrader";  my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.";
613    
614  my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';  my $KEYSBASE =  $CONFIG{'caffhome'}.'/keys';
615  my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';  my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome';
# Line 335  my  ($sec,$min,$hour,$mday,$mon,$year,$w Line 622  my  ($sec,$min,$hour,$mday,$mon,$year,$w
622  my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);  my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday);
623    
624    
625  sub usage() {  sub version($) {
626          print STDERR "caff $VERSION - (c) 2004 Peter Palfrader\n";          my ($fd) = @_;
627          print STDERR "Usage: $PROGRAM_NAME [-u <yourkeyid] <keyid> [<keyid> ...]\n";          print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n";
628          exit 1;  };
629    
630    sub usage($$) {
631            my ($fd, $exitcode) = @_;
632            version($fd);
633            print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...]\n";
634            print $fd "Consult the manual page for more information.\n";
635            exit $exitcode;
636  };  };
637    
638    ######
639    # export key $keyid from $gnupghome
640    ######
641  sub export_key($$) {  sub export_key($$) {
642          my ($gnupghome, $keyid) = @_;          my ($gnupghome, $keyid) = @_;
643    
644          my $gpg = GnuPG::Interface->new();          my $gpg = GnuPG::Interface->new();
645          $gpg->call( $CONFIG{'gpg'} );          $gpg->call( $CONFIG{'gpg'} );
646          $gpg->options->hash_init(          if (defined $gnupghome) {
647                  'homedir' => $gnupghome,                  $gpg->options->hash_init(
648                  'armor' => 1 );                          'homedir' => $gnupghome,
649                            'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
650                            'armor' => 1 );
651            } else {
652                    $gpg->options->hash_init(
653                            'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
654                            'armor' => 1 );
655            };
656          $gpg->options->meta_interactive( 0 );          $gpg->options->meta_interactive( 0 );
657          my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();          my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
658          my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);          my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]);
# Line 358  sub export_key($$) { Line 662  sub export_key($$) {
662          return $stdout;          return $stdout;
663  };  };
664    
665    ######
666    # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
667    ######
668    sub import_key($$) {
669            my ($gnupghome, $asciikey) = @_;
670    
671            my $gpg = GnuPG::Interface->new();
672            $gpg->call( $CONFIG{'gpg'} );
673            $gpg->options->hash_init(
674                    'homedir' => $gnupghome,
675                    'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ] );
676            $gpg->options->meta_interactive( 0 );
677            my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
678            my $pid = $gpg->import_keys(handles => $handles);
679            my ($stdout, $stderr, $status) = readwrite_gpg($asciikey, $inputfd, $stdoutfd, $stderrfd, $statusfd);
680            waitpid $pid, 0;
681    
682            if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
683                    return undef;
684            };
685            return 1;
686    };
687    
688    
689    ######
690    # Send an email to $address.  If $can_encrypt is true then the mail
691    # will be PGP/MIME encrypted to $longkeyid.
692    #
693    # $longkeyid, $uid, and @attached will be used in the email and the template.
694    ######
695  #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);  #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
696  sub send_mail($$$@) {  sub send_mail($$$@) {
697          my ($address, $can_encrypt, $key_id, @keys) = @_;          my ($address, $can_encrypt, $key_id, @keys) = @_;
698    
699          my $message = "Hi,\n\n";          my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'})
700                or die "Error creating template: $Text::Template::ERROR";
701    
702          $message .= 'please find attached the user id'.(scalar @keys >= 2 ? 's' : '')."\n";          my @uids;
703          for my $key (@keys) {          for my $key (@keys) {
704                  $message .= "\t".$key->{'text'}."\n";              push @uids, $key->{'text'};
705          };          };
706          $message .= qq{of your key $key_id signed by me.          my $message = $template->fill_in(HASH => { key => $key_id,
707                                                       uids => \@uids,
708  Note that I did not upload your key to any keyservers. If you want this                                                     owner => $CONFIG{'owner'}})
709  new signature to be available to others, please upload it yourself.              or die "Error filling template in: $Text::Template::ERROR";
 With GnuPG this can be done using  
         gpg --keyserver subkeys.pgp.net --send-key $key_id  
710    
 If you have any questions, don't hesitate to ask.  
   
 Regards,  
 $CONFIG{'owner'}  
 };  
711          my $message_entity = MIME::Entity->build(          my $message_entity = MIME::Entity->build(
712                  Type        => "text/plain",                  Type        => "text/plain",
713                  Charset     => "utf-8",                  Charset     => "utf-8",
# Line 392  $CONFIG{'owner'} Line 720  $CONFIG{'owner'}
720                          Type        => "application/pgp-keys",                          Type        => "application/pgp-keys",
721                          Disposition => 'attachment',                          Disposition => 'attachment',
722                          Encoding    => "7bit",                          Encoding    => "7bit",
723                          Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).')',                          Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0],
724                          Data        => $key->{'key'},                          Data        => $key->{'key'},
725                          Filename    => "0x$key_id.".$key->{'serial'}.".asc");                          Filename    => "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc");
726          };          };
727    
728          if ($can_encrypt) {          if ($can_encrypt) {
# Line 403  $CONFIG{'owner'} Line 731  $CONFIG{'owner'}
731                  my $gpg = GnuPG::Interface->new();                  my $gpg = GnuPG::Interface->new();
732                  $gpg->call( $CONFIG{'gpg'} );                  $gpg->call( $CONFIG{'gpg'} );
733                  $gpg->options->hash_init( 'homedir' => $GNUPGHOME,                  $gpg->options->hash_init( 'homedir' => $GNUPGHOME,
734                          'extra_args' => '--always-trust',                          'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ],
735                          'armor' => 1 );                          'armor' => 1 );
736                  $gpg->options->meta_interactive( 0 );                  $gpg->options->meta_interactive( 0 );
737                  my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();                  my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
# Line 419  $CONFIG{'owner'} Line 747  $CONFIG{'owner'}
747                  $message = $stdout;                  $message = $stdout;
748    
749                  $message_entity = MIME::Entity->build(                  $message_entity = MIME::Entity->build(
750                          Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"');                          Type        => 'multipart/encrypted; protocol="application/pgp-encrypted"',
751                            Encoding    => '7bit');
752    
753                  $message_entity->attach(                  $message_entity->attach(
754                          Type        => "application/pgp-encrypted",                          Type        => "application/pgp-encrypted",
# Line 437  $CONFIG{'owner'} Line 766  $CONFIG{'owner'}
766    
767          $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");          $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id");
768          $message_entity->head->add("To", $address);          $message_entity->head->add("To", $address);
769          $message_entity->head->add("From", $CONFIG{'owner'}.' <'.$CONFIG{'email'}.'>');          $message_entity->head->add("From", '"'.$CONFIG{'owner'}.'" <'.$CONFIG{'email'}.'>');
770            $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'};
771            $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'};
772          $message_entity->head->add("User-Agent", $USER_AGENT);          $message_entity->head->add("User-Agent", $USER_AGENT);
773          $message_entity->send();          $message_entity->send();
774          $message_entity->stringify();          $message_entity->stringify();
775  };  };
776    
777    ######
778    # clean up a UID so that it can be used on the FS.
779    ######
780    sub sanitize_uid($) {
781            my ($uid) = @_;
782    
783            my $good_uid = $uid;
784            $good_uid =~ tr#/:\\#_#;
785            trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid;
786            return $good_uid;
787    };
788    
789    sub delete_signatures($$$$$$) {
790            my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_;
791    
792            my $signed_by_me = 0;
793    
794            my ($stdout, $stderr, $status) =
795                    readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);
796    
797            while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {
798                    # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
799                    my @sigline = grep { /^sig/ } (split /\n/, $stdout);
800                    $stdout =~ s/\n/\\n/g;
801                    notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX
802                    my $line = pop @sigline;
803                    my $answer = "no";
804                    if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance
805                            debug("[sigremoval] doing line $line.");
806                            my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line;
807                            if ($signer eq $longkeyid) {
808                                    debug("[sigremoval] selfsig ($signer).");
809                                    $answer = "no";
810                            } elsif (grep { $signer eq $_ } @{$keyids}) {
811                                    debug("[sigremoval] signed by us ($signer).");
812                                    $answer = "no";
813                                    $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;
814                            } else {
815                                    debug("[sigremoval] not interested in that sig ($signer).");
816                                    $answer = "yes";
817                            };
818                    } else {
819                            debug("[sigremoval] no sig line here, only got: ".$stdout);
820                    };
821                    ($stdout, $stderr, $status) =
822                            readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);
823            };
824    
825            return $signed_by_me;
826    };
827    
828    
829    
830  my $USER;  my $USER;
831  my @KEYIDS;  my @KEYIDS;
832    my $params;
833    
834    Getopt::Long::config('bundling');
835    if (!GetOptions (
836            '-h'              =>  \$params->{'help'},
837            '--help'          =>  \$params->{'help'},
838            '--version'       =>  \$params->{'version'},
839            '-V'              =>  \$params->{'version'},
840            '-u=s'            =>  \$params->{'local-user'},
841            '--local-user=s'  =>  \$params->{'local-user'},
842            '-e'              =>  \$params->{'export-old'},
843            '--export-old'    =>  \$params->{'export-old'},
844            '-E'              =>  \$params->{'no-export-old'},
845            '--no-export-old' =>  \$params->{'no-export-old'},
846            '-m'              =>  \$params->{'mail'},
847            '--mail'          =>  \$params->{'mail'},
848            '-M'              =>  \$params->{'no-mail'},
849            '--no-mail'       =>  \$params->{'no-mail'},
850            '-R'              =>  \$params->{'no-download'},
851            '--no-download'   =>  \$params->{'no-download'},
852            '-S'              =>  \$params->{'no-sign'},
853            '--no-sign'       =>  \$params->{'no-sign'},
854            '--key-file=s@'   =>  \$params->{'key-files'},
855            )) {
856            usage(\*STDERR, 1);
857    };
858    if ($params->{'help'}) {
859            usage(\*STDOUT, 0);
860    };
861    if ($params->{'version'}) {
862            version(\*STDOUT);
863            exit(0);
864    };
865    usage(\*STDERR, 1) unless scalar @ARGV >= 1;
866    
867    
868  usage() unless scalar @ARGV >= 1;  
869  if ($ARGV[0] eq '-u') {  if ($params->{'local-user'}) {
870          usage() unless scalar @ARGV >= 3;          $USER = $params->{'local-user'};
871          shift @ARGV;          $USER =~ s/^0x//i;
872          $USER = shift @ARGV;          unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) {
         unless ($USER =~ /^[A-Za-z0-9]{8,8}([A-Za-z0-9]{8})?$/) {  
873                  print STDERR "-u $USER is not a keyid.\n";                  print STDERR "-u $USER is not a keyid.\n";
874                  usage();                  usage(\*STDERR, 1);
875          };          };
876          $USER = uc($USER);          $USER = uc($USER);
877  };  };
878    
879  for my $keyid (@ARGV) {  for my $keyid (@ARGV) {
880          unless ($keyid =~ /^[A-Za-z0-9]{8}([A-Za-z0-9]{8})?$/) {          $keyid =~ s/^0x//i;
881            unless ($keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i) {
882                    if ($keyid =~ /^[A-F0-9]{32}$/) {
883                            info("Ignoring v3 fingerprint $keyid.  v3 keys are obsolete.");
884                            next;
885                    };
886                  print STDERR "$keyid is not a keyid.\n";                  print STDERR "$keyid is not a keyid.\n";
887                  usage();                  usage(\*STDERR, 1);
888          };          };
889          push @KEYIDS, uc($keyid);          push @KEYIDS, uc($keyid);
890  };  };
891    
892    $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'};
893    $CONFIG{'no-mail'}     = $params->{'no-mail'}     if defined $params->{'no-mail'};
894    $CONFIG{'mail'}        = $params->{'mail'}        if defined $params->{'mail'};
895    $CONFIG{'no-sign'}     = $params->{'no-sign'}     if defined $params->{'no-sign'};
896    push @{$CONFIG{'key-files'}}, @{$params->{'key-files'}} if defined $params->{'key-files'};
897    
898    
899    #################
900    # import own keys
901    #################
902    for my $keyid (@{$CONFIG{'keyid'}}) {
903            my $gpg = GnuPG::Interface->new();
904            $gpg->call( $CONFIG{'gpg'} );
905            $gpg->options->hash_init(
906                    'homedir' => $GNUPGHOME,
907                    'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --fast-list-mode } ] );
908            $gpg->options->meta_interactive( 0 );
909            my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
910            my $pid = $gpg->list_public_keys(handles => $handles, command_args => $keyid);
911            my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
912            waitpid $pid, 0;
913    
914            if ($stdout eq '') {
915                    warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere.
916            };
917            unless ($stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m) {
918                    info("Key $keyid not found in caff's home.  Getting it from your normal GnuPGHome.");
919                    my $key = export_key(undef, $keyid);
920                    if (!defined $key || $key eq '') {
921                            warn ("Did not get key $keyid from your normal GnuPGHome\n");
922                            next;
923                    };
924                    my $result = import_key($GNUPGHOME, $key);
925                    unless ($result) {
926                            warn ("Could not import $keyid into caff's gnupghome.\n");
927                            next;
928                    };
929            }
930    }
931    
932    ########################
933    # import keys from files
934    ########################
935    foreach my $keyfile (@{$CONFIG{'key-files'}}) {
936        my $gpg = GnuPG::Interface->new();
937        $gpg->call( $CONFIG{'gpg'} );
938        $gpg->options->hash_init('homedir' => $GNUPGHOME);
939        $gpg->options->meta_interactive( 0 );
940        my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
941        my $pid = $gpg->import_keys(handles => $handles, command_args => $keyfile);
942        my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
943        info ("Importing keys from $keyfile");
944        waitpid $pid, 0;
945        if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) {
946            warn $stderr;
947        }
948    }
949    
950  #############################  #############################
951  # receive keys from keyserver  # receive keys from keyserver
952  #############################  #############################
 my $gpg = GnuPG::Interface->new();  
 $gpg->call( $CONFIG{'gpg'} );  
 $gpg->options->hash_init(  
         'homedir' => $GNUPGHOME,  
         'extra_args' => '--keyserver='.$CONFIG{'keyserver'} );  
 $gpg->options->meta_interactive( 0 );  
 my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();  
 my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);  
 my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);  
 waitpid $pid, 0;  
   
953  my @keyids_ok;  my @keyids_ok;
954  my @keyids_failed;  if ($CONFIG{'no-download'}) {
955            @keyids_ok = @KEYIDS;
956    } else {
957            info ("fetching keys, this will take a while...");
958    
959            my $gpg = GnuPG::Interface->new();
960            $gpg->call( $CONFIG{'gpg'} );
961            $gpg->options->hash_init(
962                    'homedir' => $GNUPGHOME,
963                    'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--keyserver='.$CONFIG{'keyserver'} ] );
964            $gpg->options->meta_interactive( 0 );
965            my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
966            my $pid = $gpg->recv_keys(handles => $handles, command_args => [ @KEYIDS ]);
967            my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
968            waitpid $pid, 0;
969    
970  # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F  # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
971  # [GNUPG:] NODATA 1  # [GNUPG:] NODATA 1
972  # [GNUPG:] NODATA 1  # [GNUPG:] NODATA 1
973  # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039  # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
974  for my $line (split /\n/, $status) {          my %local_keyids = map { $_ => 1 } @KEYIDS;
975          if ($line =~ /^\[GNUPG:\] IMPORT_OK/) {          my $had_v3_keys = 0;
976                  push @keyids_ok, shift @KEYIDS;          for my $line (split /\n/, $status) {
977          } elsif ($line =~ /^\[GNUPG:\] NODATA/) {                  if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) {
978                  push @keyids_failed, shift @KEYIDS;                          my $imported_key = $1;
979                            my $whole_fpr = $imported_key;
980                            my $long_keyid = substr($imported_key, -16);
981                            my $short_keyid = substr($imported_key, -8);
982                            my $speced_key;
983                            for my $spec (($whole_fpr, $long_keyid, $short_keyid)) {
984                                    $speced_key = $spec if $local_keyids{$spec};
985                            };
986                            unless ($speced_key) {
987                                notice ("Imported unexpected key; got: $imported_key\n");
988                                next;
989                            };
990                            debug ("Imported $imported_key for $speced_key");
991                            delete $local_keyids{$speced_key};
992                            unshift @keyids_ok, $imported_key;
993                    } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) {
994                    } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) {
995                            my $imported_key = $1;
996                            notice ("Imported key $1 is a version 3 key.  Version 3 keys are obsolete, should not be used, and are not and will not be properly supported.");
997                            $had_v3_keys = 1;
998                    } else {
999                            notice ("got unknown reply from gpg: $line");
1000                    }
1001          };          };
1002            if (scalar %local_keyids) {
1003                    notice ("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ? " (Or maybe it's one of those ugly v3 keys?)" :  ""));
1004                    exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0);
1005            }
1006    };
1007    
1008    unless (@keyids_ok) {
1009            notice ("No keys to sign found");
1010            exit 0;
1011  }  }
 die ("Still keys in \@KEYIDS.  This should not happen.") if scalar @KEYIDS;  
 notice ("Import failed for: ". (join ' ', @keyids_failed).".") if scalar @keyids_failed;  
1012    
1013  ###########  ###########
1014  # sign keys  # sign keys
1015  ###########  ###########
1016  info("Sign the following keys according to your policy...");  if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) {
1017  for my $keyid (@keyids_ok) {          $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1);
1018          my @command;  }
1019          push @command, $CONFIG{'gpg-sign'};  
1020          push @command, '--local-user', $USER if (defined $USER);  unless ($CONFIG{'no-sign'}) {
1021          push @command, "--homedir=$GNUPGHOME";          info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key");
1022          push @command, '--secret-keyring', $CONFIG{'secret-keyring'};          for my $keyid (@keyids_ok) {
1023          push @command, '--sign-key', $keyid;                  my @command;
1024          print join(' ', @command),"\n";                  push @command, $CONFIG{'gpg-sign'};
1025          system (@command);                  push @command, '--local-user', $USER if (defined $USER);
1026                    push @command, "--homedir=$GNUPGHOME";
1027                    push @command, '--secret-keyring', $CONFIG{'secret-keyring'};
1028                    push @command, '--no-auto-check-trustdb';
1029                    push @command, '--trust-model=always';
1030                    push @command, '--edit', $keyid;
1031                    push @command, 'sign';
1032                    push @command, split ' ', $CONFIG{'gpg-sign-args'} || "";
1033                    print join(' ', @command),"\n";
1034                    system (@command);
1035            };
1036  };  };
1037    
1038  ##################  ##################
# Line 518  KEYS: Line 1042  KEYS:
1042  for my $keyid (@keyids_ok) {  for my $keyid (@keyids_ok) {
1043          # get key listing          # get key listing
1044          #################          #################
1045          $gpg = GnuPG::Interface->new();          my $gpg = GnuPG::Interface->new();
1046          $gpg->call( $CONFIG{'gpg'} );          $gpg->call( $CONFIG{'gpg'} );
1047          $gpg->options->hash_init( 'homedir' => $GNUPGHOME );          $gpg->options->hash_init(
1048                    'homedir' => $GNUPGHOME,
1049                    'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] );
1050          $gpg->options->meta_interactive( 0 );          $gpg->options->meta_interactive( 0 );
1051          ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();          my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
1052          $gpg->options->hash_init( 'extra_args' => [ '--with-colons', '--fixed-list-mode' ] );          my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);
1053          $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]);          my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);
         ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd);  
1054          waitpid $pid, 0;          waitpid $pid, 0;
1055          if ($stdout eq '') {          if ($stdout eq '') {
1056                  warn ("No data from gpg for list-key $keyid\n");                  warn ("No data from gpg for list-key $keyid\n");
1057                  next;                  next;
1058          };          };
         my $keyinfo = $stdout;  
1059          my @publine = grep { /^pub/ } (split /\n/, $stdout);          my @publine = grep { /^pub/ } (split /\n/, $stdout);
1060          my ($dummy1, $dummy2, $dummy3, $dummy4, $longkeyid, $dummy6, $dummy7, $dummy8, $dummy9, $dummy10, $dummy11, $flags) = split /:/, pop @publine;          if (scalar @publine == 0) {
1061          my $can_encrypt = $flags =~ /E/;                  warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n");
1062                    next;
1063            };
1064            my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine;
1065            if (scalar @publine > 0) {
1066                    warn ("More than one key matched $keyid.  Try to specify the long keyid or fingerprint\n");
1067                    next;
1068            };
1069          unless (defined $longkeyid) {          unless (defined $longkeyid) {
1070                  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");
1071                    next;
1072            };
1073            unless (defined $flags) {
1074                    warn ("Didn't find flags in --list-key of key $keyid.\n");
1075                  next;                  next;
1076          };          };
1077            my $can_encrypt = $flags =~ /E/;
1078    
1079          # export the key          # export the key
1080          ################          ################
# Line 553  for my $keyid (@keyids_ok) { Line 1089  for my $keyid (@keyids_ok) {
1089          while (1) {          while (1) {
1090                  my $this_uid_text = '';                  my $this_uid_text = '';
1091                  $uid_number++;                  $uid_number++;
1092                  info("Doing key $keyid, uid $uid_number");                  debug("Doing key $keyid, uid $uid_number");
1093                    my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);
1094    
1095                  # import into temporary gpghome                  # import into temporary gpghome
1096                  ###############################                  ###############################
1097                  my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1);                  my $result = import_key($tempdir, $asciikey);
1098                  my $gpg = GnuPG::Interface->new();                  unless ($result) {
                 $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) {  
1099                          warn ("Could not import $keyid into temporary gnupg.\n");                          warn ("Could not import $keyid into temporary gnupg.\n");
1100                          next;                          next;
1101                  };                  };
# Line 578  for my $keyid (@keyids_ok) { Line 1106  for my $keyid (@keyids_ok) {
1106                  $gpg->call( $CONFIG{'gpg-delsig'} );                  $gpg->call( $CONFIG{'gpg-delsig'} );
1107                  $gpg->options->hash_init(                  $gpg->options->hash_init(
1108                          'homedir' => $tempdir,                          'homedir' => $tempdir,
1109                          'extra_args' => [ '--with-colons', '--fixed-list-mode', '--command-fd=0', '--no-tty' ] );                          'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] );
1110                  ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();                  ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds();
1111                  $pid = $gpg->wrap_call(                  $pid = $gpg->wrap_call(
1112                          commands     => [ '--edit' ],                          commands     => [ '--edit' ],
# Line 598  for my $keyid (@keyids_ok) { Line 1126  for my $keyid (@keyids_ok) {
1126                  debug("Parsing stdout output.");                  debug("Parsing stdout output.");
1127                  for my $line (split /\n/, $stdout) {                  for my $line (split /\n/, $stdout) {
1128                          debug("Checking line $line");                          debug("Checking line $line");
1129                          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;
1130                          if ($type eq 'sub') {                          if ($type eq 'sub') {
1131                                  $number_of_subkeys++;                                  $number_of_subkeys++;
1132                          };                          };
# Line 607  for my $keyid (@keyids_ok) { Line 1135  for my $keyid (@keyids_ok) {
1135                          if ($uid_number != $i) {                          if ($uid_number != $i) {
1136                                  debug("mark for deletion.");                                  debug("mark for deletion.");
1137                                  readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);                                  readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1138                                  $delete_some = 1;                                  $delete_some++;
1139                          } else {                          } else {
1140                                  debug("keep it.");                                  debug("keep it.");
1141                                  $have_one = 1;                                  $have_one = 1;
1142                                  $this_uid_text = ($type eq 'uid') ? $uidtext : 'attribute';                                  $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]';
1143                                  $is_uat = $type eq 'uat';                                  $is_uat = $type eq 'uat';
1144                          };                          };
1145                          $i++;                          $i++;
1146                  };                  };
1147                  debug("Parsing stdout output done.");                  debug("Parsing stdout output done.");
                 if ($is_uat) {  
                         notice("Can't handle attribute userid of key $keyid.");  
                         next;  
                 };  
1148                  unless ($have_one) {                  unless ($have_one) {
1149                            debug("Uid ".($uid_number-1)." was the last, there is no $uid_number.");
1150                          info("key $keyid done.");                          info("key $keyid done.");
1151                          last;                          last;
1152                  };                  };
1153    
1154                    my $prune_some_sigs_on_uid;
1155                    my $prune_all_sigs_on_uid;
1156                    if ($is_uat) {
1157                            debug("handling attribute userid of key $keyid.");
1158                            if ($uid_number == 1) {
1159                                    debug(" attribute userid is #1, unmarking #2 for deletion.");
1160                                    readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1161                                    $delete_some--;
1162                                    $prune_some_sigs_on_uid = 1;
1163                                    $prune_all_sigs_on_uid = 2;
1164                            } else {
1165                                    debug("attribute userid is not #1, unmarking #1 for deletion.");
1166                                    readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1167                                    $delete_some--;
1168                                    $prune_some_sigs_on_uid = 2;
1169                                    $prune_all_sigs_on_uid = 1;
1170                            };
1171                    } else {
1172                            $prune_some_sigs_on_uid = 1;
1173                    };
1174    
1175                  if ($delete_some) {                  if ($delete_some) {
1176                          debug("need to delete a few uids.");                          debug("need to delete $delete_some uids.");
1177                          readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);                          readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1);
1178                          readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);                          readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);
1179                  };                  };
# Line 643  for my $keyid (@keyids_ok) { Line 1190  for my $keyid (@keyids_ok) {
1190    
1191                  # delete signatures                  # delete signatures
1192                  ###################                  ###################
1193                  my $signed_by_me = 0;                  readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1194                  readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1);                  my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'});
1195                  ($stdout, $stderr, $status) =                  readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
1196                          readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1);                  if (defined $prune_all_sigs_on_uid) {
1197                            readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig
1198                  while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) {                          delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []);
1199                          # sig:?::17:EA2199412477CAF8:1058095214:::::13x:                          readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig
                         my @sigline = grep { /^sig/ } (split /\n/, $stdout);  
                         my $line = pop @sigline;  
                         my $answer = "no";  
                         if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance  
                                 my ($dummy1, $dummy2, $dummy3, $dummy4, $signer, $created, $dummy7, $dummy8, $dummy9) = split /:/, $line;  
                                 if ($signer eq $longkeyid) {  
                                         $answer = "no";  
                                 } elsif (grep { $signer eq $_ } @{$CONFIG{'keyid'}}) {  
                                         $answer = "no";  
                                         $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created;  
                                 } else {  
                                         $answer = "yes";  
                                 };  
                         };  
                         ($stdout, $stderr, $status) =  
                                 readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1);  
1200                  };                  };
1201    
1202    
1203                  readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);                  readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd);
1204                  waitpid $pid, 0;                  waitpid $pid, 0;
1205    
1206                  my $asciikey = export_key($tempdir, $longkeyid);                  my $asciikey = export_key($tempdir, $keyid);
1207                  if ($asciikey eq '') {                  if ($asciikey eq '') {
1208                          warn ("No data from gpg for export $longkeyid\n");                          warn ("No data from gpg for export $keyid\n");
1209                          next;                          next;
1210                  };                  };
1211    
1212                  if ($signed_by_me) {                  if ($signed_by_me) {
1213                          if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {                          if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) {
1214                                  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'});
1215                                  next unless $write;                                  next unless $write;
1216                          };                          };
1217                          my $keydir = "$KEYSBASE/$DATE_STRING";                          my $keydir = "$KEYSBASE/$DATE_STRING";
1218                          -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");                          -d $keydir  || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n");
1219    
1220                          my $keyfile = "$keydir/$longkeyid.key.$uid_number.$this_uid_text.asc";                          my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc";
1221                          open (KEY, ">$keyfile") or die ("Cannot open $keyfile\n");                          open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n");
1222                          print KEY $asciikey;                          print KEY $asciikey;
1223                          close KEY;                          close KEY;
1224    
1225                          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 };
1226    
1227                          info("$longkeyid $uid_number $this_uid_text done.");                          info("$longkeyid $uid_number $this_uid_text done.");
1228                  } else {                  } else {
# Line 700  for my $keyid (@keyids_ok) { Line 1233  for my $keyid (@keyids_ok) {
1233          if (scalar @UIDS == 0) {          if (scalar @UIDS == 0) {
1234                  info("found no signed uids for $keyid");                  info("found no signed uids for $keyid");
1235          } else {          } else {
1236                  my @attached ;                  next if $CONFIG{'no-mail'}; # do not send mail
1237    
1238                    my @attached;
1239                  for my $uid (@UIDS) {                  for my $uid (@UIDS) {
1240                          unless ($uid->{'text'} =~ /@/) {                          trace("UID: $uid->{'text'}\n");
1241                            if ($uid->{'is_uat'}) {
1242                                    my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1);
1243                                    push @attached, $uid if $attach;
1244                            } elsif ($uid->{'text'} !~ /@/) {
1245                                  my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);                                  my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1);
1246                                  push @attached, $uid;                                  push @attached, $uid if $attach;
1247                          };                          };
1248                  };                  };
1249    
1250                  notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;                  notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt;
1251                  for my $uid (@UIDS) {                  for my $uid (@UIDS) {
1252                          if ($uid->{'text'} =~ /@/) {                          if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) {
1253                                  my $address = $uid->{'text'};                                  my $address = $uid->{'text'};
1254                                  $address =~ s/.*<(.*)>.*/$1/;                                  $address =~ s/.*<(.*)>.*/$1/;
1255                                  my $send = ask("Send mail to '$address' for $uid->{'text'}?", 1);                                  if (ask("Mail signature for $uid->{'text'} to '$address'?", 1, $CONFIG{'mail'})) {
                                 if ($send) {  
1256                                          my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);                                          my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
1257    
1258                                          my $keydir = "$KEYSBASE/$DATE_STRING";                                          my $keydir = "$KEYSBASE/$DATE_STRING";
1259                                          my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".$uid->{'text'};                                          my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'});
1260                                          open (KEY, ">$mailfile") or die ("Cannot open $mailfile\n");                                          open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n");
1261                                          print KEY $mail;                                          print KEY $mail;
1262                                          close KEY;                                          close KEY;
1263                                  };                                  };
# Line 728  for my $keyid (@keyids_ok) { Line 1266  for my $keyid (@keyids_ok) {
1266          };          };
1267    
1268  };  };
   
   
   
   
 ###############################################################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  
Legend:
Removed from v.9  
changed lines
  Added in v.260
  ViewVC Help
Powered by ViewVC 1.1.5