]>
git.sthu.org Git - pgp-tools.git/blob - caff/caff
3 # caff -- CA - Fire and Forget
6 # Copyright (c) 2004, 2005 Peter Palfrader <peter@palfrader.org>
7 # Copyright (c) 2005 Christoph Berg <cb@df7cb.de>
11 # Redistribution and use in source and binary forms, with or without
12 # modification, are permitted provided that the following conditions
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.
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.
37 caff -- CA - Fire and Forget
43 =item B<caff> [-eEmMRS] [-u I<yourkeyid>] I<keyid> [I<keyid> ..]
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. The mailed key is encrypted with itself as a means
54 to verify that key belongs to the recipient.
60 =item B<-e>, B<--export-old>
62 Export old signatures. Default is to ask the user for each old signature.
64 =item B<-E>, B<--no-export-old>
66 Do not export old signatures. Default is to ask the user for each old
69 =item B<-m>, B<--mail>
71 Send mail after signing. Default is to ask the user for each uid.
73 =item B<-M>, B<--no-mail>
75 Do not send mail after signing. Default is to ask the user for each uid.
77 =item B<-R>, B<--no-download>
79 Do not retrieve the key to be signed from a keyserver.
81 =item B<-S>, B<--no-sign>
85 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
87 Select the key that is used for signing, in case you have more than one key.
89 =item B<--key-file> I<file>
91 Import keys from file. Can be supplied more than once.
99 =item $HOME/.caffrc - configuration file
101 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
103 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
105 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
107 useful options include use-agent, default-cert-level, etc.
111 =head1 CONFIGURATION FILE OPTIONS
113 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.
118 $CONFIG{owner} = q{Peter Palfrader};
119 $CONFIG{email} = q{peter@palfrader.org};
120 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
122 =head2 Required basic settings
126 =item B<owner> [string]
128 Your name. B<REQUIRED>.
130 =item B<email> [string]
132 Your email address, used in From: lines. B<REQUIRED>.
134 =item B<keyid> [list of keyids]
136 A list of your keys. This is used to determine which signatures to keep
137 in the pruning step. If you select a key using B<-u> it has to be in
138 this list. B<REQUIRED>.
140 =head2 General settings
142 =item B<caffhome> [string]
144 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
146 =head2 GnuPG settings
148 =item B<gpg> [string]
150 Path to the GnuPG binary. Default: B<gpg>.
152 =item B<gpg-sign> [string]
154 Path to the GnuPG binary which is used to sign keys. Default: what
157 =item B<gpg-delsig> [string]
159 Path to the GnuPG binary which is used to split off signatures. This was
160 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
163 =item B<secret-keyring> [string]
165 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
167 =item B<also-encrypt-to> [keyid]
169 An additional keyid to encrypt messages to. Default: none.
171 =item B<gpg-sign-args> [string]
173 Additional arguments to pass to gpg. Default: none.
175 =head2 Keyserver settings
177 =item B<keyserver> [string]
179 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
181 =item B<no-download> [boolean]
183 If true, then skip the step of fetching keys from the keyserver.
186 =item B<key-files> [list of files]
188 A list of files containing keys to be imported.
190 =head2 Signing settings
192 =item B<no-sign> [boolean]
194 If true, then skip the signing step. Default: B<0>.
196 =item B<ask-sign> [boolean]
198 If true, then pause before continuing to the signing step.
199 This is useful for offline signing. Default: B<0>.
201 =item B<export-sig-age> [seconds]
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).
208 =item B<mail> [boolean]
210 Do not prompt for sending mail, just do it. Default: B<0>.
212 =item B<no-mail> [boolean]
214 Do not prompt for sending mail. The messages are still written to
215 $CONFIG{caffhome}/keys/. Default: B<0>.
217 =item B<mail-template> [string]
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:
225 =item B<{owner}> [string]
227 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
229 =item B<{key}> [string]
231 The keyid of the key you signed.
233 =item B<{@uids}> [array]
235 The UIDs for which signatures are included in the mail.
239 =item B<reply-to> [string]
241 Add a Reply-To: header to messages sent. Default: none.
243 =item B<bcc> [string]
245 Address to send blind carbon copies to when sending mail.
254 =item Peter Palfrader <peter@palfrader.org>
256 =item Christoph Berg <cb@df7cb.de>
262 http://pgp-tools.alioth.debian.org/
266 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
274 use File
:: Temp
qw{ tempdir
};
280 use GnuPG
:: Interface
;
283 my $REVISION = ' $Rev $' ;
284 my ( $REVISION_NUMER ) = $REVISION =~ /(\d+)/ ;
285 my $VERSION = "0.0.0. $REVISION_NUMER " ;
291 print "[NOTICE] $line \n " ;
295 print "[INFO] $line \n " ;
299 #print "[DEBUG] $line\n";
303 #print "[trace] $line\n";
307 #print "[trace2] $line\n";
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 ;
316 my $hostname = `hostname -f` ;
318 my ( $Cgecos , $Cemail , $Ckeys ) = ( '' , '' , '' );
319 if ( defined $gecos ) {
322 my $gpg = GnuPG
:: Interface
-> new ();
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 );
333 warn ( "No data from gpg for list-key \n " ); # There should be at least 'tru:' everywhere.
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{ 0123456789 abcdef
89 abcdef76543210
};
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 ;
349 $gecos = 'Unknown Caff User' ;
350 $email = $ENV { 'LOGNAME' }. '@' . $hostname ;
351 @keys = qw{ 0123456789 abcdef
89 abcdef76543210
};
352 ( $Cgecos , $Cemail , $Ckeys ) = ( '#' , '#' , '#' );
356 # .caffrc -- vim:syntax=perl:
357 # This file is in perl(1) format - see caff(1) for details.
359 $Cgecos \ $CONFIG {'owner'} = ' $gecos ';
360 $Cemail \ $CONFIG {'email'} = ' $email ';
362 # you can get your long keyid from
363 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
365 # if you have a v4 key, it will simply be the last 16 digits of
369 # \ $CONFIG {'keyid'} = [ qw{FEDCBA9876543210} ];
370 # or, if you have more than one key:
371 # \ $CONFIG {'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
373 $Ckeys \ $CONFIG {'keyid'} = [ qw{ @keys } ];
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 ;
384 die ( " $PROGRAM_NAME : $purpose executable ' $fn ' not found. \n " ) unless - x
$fn ;
386 for my $p ( split ( ':' , $ENV { PATH
})) {
387 return if - x
" $p / $fn " ;
389 die ( " $PROGRAM_NAME : $purpose executable ' $fn ' not found on path. \n " ) unless - x
$fn ;
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 \n Please edit $config and run caff again. \n " ;
399 open F
, "> $config " or die " $config : $!" ;
404 unless ( scalar eval `cat $config ` ) {
405 die "Couldn't parse $config : $EVAL_ERROR \n " if $EVAL_ERROR ;
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 " );
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'};
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.
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`.
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 }
446 If you have any questions, don't hesitate to ask.
455 stdin
=> IO
:: Handle
-> new (),
456 stdout
=> IO
:: Handle
-> new (),
457 stderr
=> IO
:: Handle
-> new (),
458 status
=> IO
:: Handle
-> new () );
459 my $handles = GnuPG
:: Handles
-> new ( %fds );
460 return ( $fds { 'stdin' }, $fds { 'stdout' }, $fds { 'stderr' }, $fds { 'status' }, $handles );
463 sub readwrite_gpg
($$$$$%) {
464 my ( $in , $inputfd , $stdoutfd , $stderrfd , $statusfd , %options ) = @_ ;
466 trace
( "Entering readwrite_gpg." );
468 my ( $first_line , undef ) = split /\n/ , $in ;
469 debug
( "readwrite_gpg sends " .( defined $first_line ?
$first_line : "<nothing>" ));
471 local $INPUT_RECORD_SEPARATOR = undef ;
472 my $sout = IO
:: Select
-> new ();
473 my $sin = IO
:: Select
-> new ();
476 trace
( "input is $inputfd ; output is $stdoutfd ; err is $stderrfd ; status is " .( defined $statusfd ?
$statusfd : 'undef' ). "." );
478 $inputfd -> blocking ( 0 );
479 $stdoutfd -> blocking ( 0 );
480 $statusfd -> blocking ( 0 ) if defined $statusfd ;
481 $stderrfd -> blocking ( 0 );
482 $sout -> add ( $stdoutfd );
483 $sout -> add ( $stderrfd );
484 $sout -> add ( $statusfd ) if defined $statusfd ;
487 my ( $stdout , $stderr , $status ) = ( "" , "" , "" );
488 my $exitwhenstatusmatches = $options { 'exitwhenstatusmatches' };
489 trace
( "doing stuff until we find $exitwhenstatusmatches " ) if defined $exitwhenstatusmatches ;
491 my $readwrote_stuff_this_time = 0 ;
492 my $do_not_wait_on_select = 0 ;
493 my ( $readyr , $readyw , $written );
494 while ( $sout -> count () > 0 || ( defined ( $sin ) && ( $sin -> count () > 0 ))) {
495 if ( defined $exitwhenstatusmatches ) {
496 if ( $status =~ /$exitwhenstatusmatches/m ) {
497 trace
( "readwrite_gpg found match on $exitwhenstatusmatches " );
498 if ( $readwrote_stuff_this_time ) {
499 trace
( "read/write some more \n " );
500 $do_not_wait_on_select = 1 ;
502 trace
( "that's it in our while loop. \n " );
508 $readwrote_stuff_this_time = 0 ;
509 trace
( "select waiting for " .( $sout -> count ()). " fds." );
510 ( $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 ));
512 for my $wfd ( @
$readyw ) {
513 $readwrote_stuff_this_time = 1 ;
514 if ( length ( $in ) != $offset ) {
515 trace
( "writing to $wfd ." );
516 $written = $wfd -> syswrite ( $in , length ( $in ) - $offset , $offset );
519 if ( $offset == length ( $in )) {
520 trace
( "writing to $wfd done." );
521 unless ( $options { 'nocloseinput' }) {
523 trace
( " $wfd closed." );
530 next unless ( defined ( @
$readyr )); # Wait some more.
532 for my $rfd ( @
$readyr ) {
533 $readwrote_stuff_this_time = 1 ;
535 trace
( "reading from $rfd done." );
540 trace
( "reading from $rfd ." );
541 if ( $rfd == $stdoutfd ) {
543 trace2
( "stdout is now $stdout \n ================" );
546 if ( defined $statusfd && $rfd == $statusfd ) {
548 trace2
( "status is now $status \n ================" );
551 if ( $rfd == $stderrfd ) {
553 trace2
( "stderr is now $stderr \n ================" );
558 trace
( "readwrite_gpg done." );
559 return ( $stdout , $stderr , $status );
563 my ( $question , $default , $forceyes , $forceno ) = @_ ;
565 my $yn = $default ?
'[Y/n]' : '[y/N]' ;
567 print $question , ' ' , $yn , ' ' ;
568 if ( $forceyes && $forceno ) {
569 print " $default (from config/command line) \n " ;
573 print "YES (from config/command line) \n " ;
577 print "NO (from config/command line) \n " ;
582 if (! defined $answer ) {
583 $OUTPUT_AUTOFLUSH = 1 ;
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 " ;
591 last if (( length $answer == 0 ) || ( $answer =~ m/^[yYnN]$/ ) );
592 print "What about $yn is so hard to understand? \n Answer with either 'n' or 'y' or just press enter for the default. \n " ;
595 my $result = $default ;
596 $result = 1 if $answer =~ /y/i ;
597 $result = 0 if $answer =~ /n/i ;
605 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt' ;
606 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay' ;
607 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig' ;
608 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)' ;
609 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey' ;
612 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al." ;
614 my $KEYSBASE = $CONFIG { 'caffhome' }. '/keys' ;
615 my $GNUPGHOME = $CONFIG { 'caffhome' }. '/gnupghome' ;
617 - d
$KEYSBASE || mkpath
( $KEYSBASE , 0 , 0700 ) or die ( "Cannot create $KEYSBASE : $! \n " );
618 - d
$GNUPGHOME || mkpath
( $GNUPGHOME , 0 , 0700 ) or die ( "Cannot create $GNUPGHOME : $! \n " );
621 my ( $sec , $min , $hour , $mday , $mon , $year , $wday , $yday , $isdst ) = localtime ( $NOW );
622 my $DATE_STRING = sprintf ( " %04d - %02d - %02d " , $year + 1900 , $mon + 1 , $mday );
627 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al. \n " ;
631 my ( $fd , $exitcode ) = @_ ;
633 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...] \n " ;
634 print $fd "Consult the manual page for more information. \n " ;
639 # export key $keyid from $gnupghome
642 my ( $gnupghome , $keyid ) = @_ ;
644 my $gpg = GnuPG
:: Interface
-> new ();
645 $gpg -> call ( $CONFIG { 'gpg' } );
646 if ( defined $gnupghome ) {
647 $gpg -> options -> hash_init (
648 'homedir' => $gnupghome ,
649 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ],
652 $gpg -> options -> hash_init (
653 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ],
656 $gpg -> options -> meta_interactive ( 0 );
657 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
658 my $pid = $gpg -> export_keys ( handles
=> $handles , command_args
=> [ $keyid ]);
659 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
666 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
669 my ( $gnupghome , $asciikey ) = @_ ;
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 );
682 if ( $status !~ /^\[GNUPG:\] IMPORT_OK/m ) {
690 # Send an email to $address. If $can_encrypt is true then the mail
691 # will be PGP/MIME encrypted to $longkeyid.
693 # $longkeyid, $uid, and @attached will be used in the email and the template.
695 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
696 sub send_mail
($$$ @
) {
697 my ( $address , $can_encrypt , $key_id , @keys ) = @_ ;
699 my $template = Text
:: Template
-> new ( TYPE
=> 'STRING' , SOURCE
=> $CONFIG { 'mail-template' })
700 or die "Error creating template: $Text ::Template::ERROR" ;
703 for my $key ( @keys ) {
704 push @uids , $key ->{ 'text' };
706 my $message = $template -> fill_in ( HASH
=> { key
=> $key_id ,
708 owner
=> $CONFIG { 'owner' }})
709 or die "Error filling template in: $Text ::Template::ERROR" ;
711 my $message_entity = MIME
:: Entity
-> build (
712 Type
=> "text/plain" ,
714 Disposition
=> 'inline' ,
718 for my $key ( @keys ) {
719 $message_entity -> attach (
720 Type
=> "application/pgp-keys" ,
721 Disposition
=> 'attachment' ,
723 Description
=> "PGP Key 0x $key_id , uid " .( $key ->{ 'text' }). ' (' .( $key ->{ 'serial' }). '), signed by 0x' . $CONFIG { 'keyid' }[ 0 ],
724 Data
=> $key ->{ 'key' },
725 Filename
=> "0x $key_id ." . $key ->{ 'serial' }. ".signed-by-0x" . $CONFIG { 'keyid' }[ 0 ]. ".asc" );
729 my $message = $message_entity -> stringify ();
731 my $gpg = GnuPG
:: Interface
-> new ();
732 $gpg -> call ( $CONFIG { 'gpg' } );
733 $gpg -> options -> hash_init ( 'homedir' => $GNUPGHOME ,
734 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ],
736 $gpg -> options -> meta_interactive ( 0 );
737 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
738 $gpg -> options -> push_recipients ( $key_id );
739 $gpg -> options -> push_recipients ( $CONFIG { 'also-encrypt-to' } ) if defined $CONFIG { 'also-encrypt-to' };
740 my $pid = $gpg -> encrypt ( handles
=> $handles );
741 my ( $stdout , $stderr , $status ) = readwrite_gpg
( $message , $inputfd , $stdoutfd , $stderrfd , $statusfd );
744 warn ( "No data from gpg for list-key $key_id \n " );
749 $message_entity = MIME
:: Entity
-> build (
750 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"' ,
753 $message_entity -> attach (
754 Type
=> "application/pgp-encrypted" ,
755 Disposition
=> 'attachment' ,
757 Data
=> "Version: 1 \n " );
759 $message_entity -> attach (
760 Type
=> "application/octet-stream" ,
761 Filename
=> 'msg.asc' ,
762 Disposition
=> 'inline' ,
767 $message_entity -> head -> add ( "Subject" , "Your signed PGP key 0x $key_id " );
768 $message_entity -> head -> add ( "To" , $address );
769 $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 );
773 $message_entity -> send ();
774 $message_entity -> stringify ();
778 # clean up a UID so that it can be used on the FS.
780 sub sanitize_uid
($) {
784 $good_uid =~ tr
#/:\\#_#;
785 trace2
( "[sanitize_uid] changed UID from $uid to $good_uid . \n " ) if $good_uid ne $uid ;
789 sub delete_signatures
($$$$$$) {
790 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $longkeyid , $keyids ) = @_ ;
792 my $signed_by_me = 0 ;
794 my ( $stdout , $stderr , $status ) =
795 readwrite_gpg
( "delsig \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT , nocloseinput
=> 1 );
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 ;
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 )." );
810 } elsif ( grep { $signer eq $_ } @
{ $keyids }) {
811 debug
( "[sigremoval] signed by us ( $signer )." );
813 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created ;
815 debug
( "[sigremoval] not interested in that sig ( $signer )." );
819 debug
( "[sigremoval] no sig line here, only got: " . $stdout );
821 ( $stdout , $stderr , $status ) =
822 readwrite_gpg
( $answer . " \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT , nocloseinput
=> 1 );
825 return $signed_by_me ;
834 Getopt
:: Long
:: config
( 'bundling' );
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' },
858 if ( $params ->{ 'help' }) {
861 if ( $params ->{ 'version' }) {
865 usage
( \
* STDERR
, 1 ) unless scalar @ARGV >= 1 ;
869 if ( $params ->{ 'local-user' }) {
870 $USER = $params ->{ 'local-user' };
872 unless ( $USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i ) {
873 print STDERR
"-u $USER is not a keyid. \n " ;
879 for my $keyid ( @ARGV ) {
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." );
886 print STDERR
" $keyid is not a keyid. \n " ;
889 push @KEYIDS , uc ( $keyid );
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' };
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 );
915 warn ( "No data from gpg for list-key \n " ); # There should be at least 'tru:' everywhere.
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 " );
924 my $result = import_key
( $GNUPGHOME , $key );
926 warn ( "Could not import $keyid into caff's gnupghome. \n " );
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 " );
945 if ( $status !~ /^\[GNUPG:\] IMPORT_OK/m ) {
950 #############################
951 # receive keys from keyserver
952 #############################
954 if ( $CONFIG { 'no-download' }) {
955 @keyids_ok = @KEYIDS ;
957 info
( "fetching keys, this will take a while..." );
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 );
970 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
973 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
974 my %local_keyids = map { $_ => 1 } @KEYIDS ;
976 for my $line ( split /\n/ , $status ) {
977 if ( $line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/ ) {
978 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 );
983 for my $spec (( $whole_fpr , $long_keyid , $short_keyid )) {
984 $speced_key = $spec if $local_keyids { $spec };
986 unless ( $speced_key ) {
987 notice
( "Imported unexpected key; got: $imported_key \n " );
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." );
999 notice
( "got unknown reply from gpg: $line " );
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 );
1008 unless ( @keyids_ok ) {
1009 notice
( "No keys to sign found" );
1016 if ( $CONFIG { 'ask-sign' } && ! $CONFIG { 'no-sign' }) {
1017 $CONFIG { 'no-sign' } = ! ask
( "Continue with signing?" , 1 );
1020 unless ( $CONFIG { 'no-sign' }) {
1021 info
( "Sign the following keys according to your policy, then exit gpg with 'save' after signing each key" );
1022 for my $keyid ( @keyids_ok ) {
1024 push @command , $CONFIG { 'gpg-sign' };
1025 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 " ;
1042 for my $keyid ( @keyids_ok ) {
1045 my $gpg = GnuPG
:: Interface
-> new ();
1046 $gpg -> call ( $CONFIG { 'gpg' } );
1047 $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 );
1051 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
1052 my $pid = $gpg -> list_public_keys ( handles
=> $handles , command_args
=> [ $keyid ]);
1053 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
1055 if ( $stdout eq '' ) {
1056 warn ( "No data from gpg for list-key $keyid \n " );
1059 my @publine = grep { /^pub/ } ( split /\n/ , $stdout );
1060 if ( scalar @publine == 0 ) {
1061 warn ( "No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME ). \n " );
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 " );
1069 unless ( defined $longkeyid ) {
1070 warn ( "Didn't find public keyid in --list-key of key $keyid . \n " );
1073 unless ( defined $flags ) {
1074 warn ( "Didn't find flags in --list-key of key $keyid . \n " );
1077 my $can_encrypt = $flags =~ /E/ ;
1081 my $asciikey = export_key
( $GNUPGHOME , $keyid );
1082 if ( $asciikey eq '' ) {
1083 warn ( "No data from gpg for export $keyid \n " );
1090 my $this_uid_text = '' ;
1092 debug
( "Doing key $keyid , uid $uid_number " );
1093 my $tempdir = tempdir
( "caff- $keyid -XXXXX" , DIR
=> '/tmp/' , CLEANUP
=> 1 );
1095 # import into temporary gpghome
1096 ###############################
1097 my $result = import_key
( $tempdir , $asciikey );
1099 warn ( "Could not import $keyid into temporary gnupg. \n " );
1105 $gpg = GnuPG
:: Interface
-> new ();
1106 $gpg -> call ( $CONFIG { 'gpg-delsig' } );
1107 $gpg -> options -> hash_init (
1108 'homedir' => $tempdir ,
1109 '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
();
1111 $pid = $gpg -> wrap_call (
1112 commands
=> [ '--edit' ],
1113 command_args
=> [ $keyid ],
1114 handles
=> $handles );
1116 debug
( "Starting edit session" );
1117 ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1121 my $number_of_subkeys = 0 ;
1125 my $delete_some = 0 ;
1126 debug
( "Parsing stdout output." );
1127 for my $line ( split /\n/ , $stdout ) {
1128 debug
( "Checking line $line " );
1129 my ( $type , undef , undef , undef , undef , undef , undef , undef , undef , $uidtext ) = split /:/ , $line ;
1130 if ( $type eq 'sub' ) {
1131 $number_of_subkeys ++;
1133 next unless ( $type eq 'uid' || $type eq 'uat' );
1134 debug
( "line is interesting." );
1135 if ( $uid_number != $i ) {
1136 debug
( "mark for deletion." );
1137 readwrite_gpg
( " $i \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1142 $this_uid_text = ( $type eq 'uid' ) ?
$uidtext : '[attribute]' ;
1143 $is_uat = $type eq 'uat' ;
1147 debug
( "Parsing stdout output done." );
1148 unless ( $have_one ) {
1149 debug
( "Uid " .( $uid_number - 1 ). " was the last, there is no $uid_number ." );
1150 info
( "key $keyid done." );
1154 my $prune_some_sigs_on_uid ;
1155 my $prune_all_sigs_on_uid ;
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 );
1162 $prune_some_sigs_on_uid = 1 ;
1163 $prune_all_sigs_on_uid = 2 ;
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 );
1168 $prune_some_sigs_on_uid = 2 ;
1169 $prune_all_sigs_on_uid = 1 ;
1172 $prune_some_sigs_on_uid = 1 ;
1176 debug
( "need to delete $delete_some uids." );
1177 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 );
1183 if ( $number_of_subkeys > 0 ) {
1184 for ( my $i = 1 ; $i <= $number_of_subkeys ; $i ++) {
1185 readwrite_gpg
( "key $i \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1187 readwrite_gpg
( "delkey \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT , nocloseinput
=> 1 );
1188 readwrite_gpg
( "yes \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1193 readwrite_gpg
( " $prune_some_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # mark uid for delsig
1194 my $signed_by_me = delete_signatures
( $inputfd , $stdoutfd , $stderrfd , $statusfd , $longkeyid , $CONFIG { 'keyid' });
1195 readwrite_gpg
( " $prune_some_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # unmark uid from delsig
1196 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 delete_signatures
( $inputfd , $stdoutfd , $stderrfd , $statusfd , $longkeyid , []);
1199 readwrite_gpg
( " $prune_all_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # unmark uid from delsig
1203 readwrite_gpg
( "save \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd );
1206 my $asciikey = export_key
( $tempdir , $keyid );
1207 if ( $asciikey eq '' ) {
1208 warn ( "No data from gpg for export $keyid \n " );
1212 if ( $signed_by_me ) {
1213 if ( $NOW - $signed_by_me > $CONFIG { 'export-sig-age' } ) {
1214 my $write = ask
( "Signature on $this_uid_text is old. Export?" , 0 , $params ->{ 'export-old' }, $params ->{ 'no-export-old' });
1217 my $keydir = " $KEYSBASE / $DATE_STRING " ;
1218 - d
$keydir || mkpath
( $keydir , 0 , 0700 ) or die ( "Cannot create $keydir $! \n " );
1220 my $keyfile = " $keydir / $longkeyid .key. $uid_number ." . sanitize_uid
( $this_uid_text ). ".asc" ;
1221 open ( KEY
, "> $keyfile " ) or die ( "Cannot open $keyfile : $! \n " );
1222 print KEY
$asciikey ;
1225 push @UIDS , { text
=> $this_uid_text , key
=> $asciikey , serial
=> $uid_number , "is_uat" => $is_uat };
1227 info
( " $longkeyid $uid_number $this_uid_text done." );
1229 info
( " $longkeyid $uid_number $this_uid_text is not signed by me, not writing." );
1233 if ( scalar @UIDS == 0 ) {
1234 info
( "found no signed uids for $keyid " );
1236 next if $CONFIG { 'no-mail' }; # do not send mail
1239 for my $uid ( @UIDS ) {
1240 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 );
1246 push @attached , $uid if $attach ;
1250 notice
( "Key has no encryption capabilities, mail will be sent unencrypted" ) unless $can_encrypt ;
1251 for my $uid ( @UIDS ) {
1252 if (! $uid ->{ 'is_uat' } && ( $uid ->{ 'text' } =~ /@/ )) {
1253 my $address = $uid ->{ 'text' };
1254 $address =~ s/.*<(.*)>.*/$1/ ;
1255 if ( ask
( "Mail signature for $uid ->{'text'} to ' $address '?" , 1 , $CONFIG { 'mail' })) {
1256 my $mail = send_mail
( $address , $can_encrypt , $longkeyid , $uid , @attached );
1258 my $keydir = " $KEYSBASE / $DATE_STRING " ;
1259 my $mailfile = " $keydir / $longkeyid .mail." . $uid ->{ 'serial' }. "." . sanitize_uid
( $uid ->{ 'text' });
1260 open ( KEY
, "> $mailfile " ) or die ( "Cannot open $mailfile : $! \n " );