]>
git.sthu.org Git - pgp-tools.git/blob - caff
052ef8b84314748974bab8fdc3006936f0657672
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.
59 =item B<-e>, B<--export-old>
61 Export old signatures. Default is to ask the user for each old signature.
63 =item B<-E>, B<--no-export-old>
65 Do not export old signatures. Default is to ask the user for each old
68 =item B<-m>, B<--mail>
70 Send mail after signing. Default is to ask the user for each uid.
72 =item B<-M>, B<--no-mail>
74 Do not send mail after signing. Default is to ask the user for each uid.
76 =item B<-R>, B<--no-download>
78 Do not retrieve the key to be signed from a keyserver.
80 =item B<-S>, B<--no-sign>
84 =item B<-u> I<yourkeyid>, B<--local-user> I<yourkeyid>
86 Select the key that is used for signing, in case you have more than one key.
88 =item B<--key-file> I<file>
90 Import keys from file. Can be supplied more than once.
98 =item $HOME/.caffrc - configuration file
100 =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys
102 =item $HOME/.caff/gnupghome/ - caff's working dir for gpg
104 =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration
106 useful options include use-agent, default-cert-level, etc.
110 =head1 CONFIGURATION FILE OPTIONS
112 The configuration file is a perl script that sets values in the hash B<%CONFIG>.
113 The file is generated when it does not exist.
117 $CONFIG{owner} = q{Peter Palfrader};
118 $CONFIG{email} = q{peter@palfrader.org};
119 $CONFIG{keyid} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ];
121 =head2 Required basic settings
125 =item B<owner> [string]
127 Your name. B<REQUIRED>.
129 =item B<email> [string]
131 Your email address, used in From: lines. B<REQUIRED>.
133 =item B<keyid> [list of keyids]
135 A list of your keys. This is used to determine which signatures to keep
136 in the pruning step. If you select a key using B<-u> it has to be in
137 this list. B<REQUIRED>.
139 =head2 General settings
141 =item B<caffhome> [string]
143 Base directory for the files caff stores. Default: B<$HOME/.caff/>.
145 =head2 GnuPG settings
147 =item B<gpg> [string]
149 Path to the GnuPG binary. Default: B<gpg>.
151 =item B<gpg-sign> [string]
153 Path to the GnuPG binary which is used to sign keys. Default: what
156 =item B<gpg-delsig> [string]
158 Path to the GnuPG binary which is used to split off signatures. This was
159 needed while the upstream GnuPG was not fixed. Default: what B<gpg>
162 =item B<secret-keyring> [string]
164 Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>.
166 =item B<also-encrypt-to> [keyid]
168 An additional keyid to encrypt messages to. Default: none.
170 =item B<gpg-sign-args> [string]
172 Additional arguments to pass to gpg. Default: none.
174 =head2 Keyserver settings
176 =item B<keyserver> [string]
178 Keyserver to download keys from. Default: B<subkeys.pgp.net>.
180 =item B<no-download> [boolean]
182 If true, then skip the step of fetching keys from the keyserver.
185 =item B<key-files> [list of files]
187 A list of files containing keys to be imported.
189 =head2 Signing settings
191 =item B<no-sign> [boolean]
193 If true, then skip the signing step. Default: B<0>.
195 =item B<ask-sign> [boolean]
197 If true, then pause before continuing to the signing step.
198 This is useful for offline signing. Default: B<0>.
200 =item B<export-sig-age> [seconds]
202 Don't export UIDs by default, on which your latest signature is older
203 than this age. Default: B<24*60*60> (i.e. one day).
207 =item B<mail> [boolean]
209 Do not prompt for sending mail, just do it. Default: B<0>.
211 =item B<no-mail> [boolean]
213 Do not prompt for sending mail. The messages are still written to
214 $CONFIG{caffhome}/keys/. Default: B<0>.
216 =item B<mail-template> [string]
218 Email template which is used as the body text for the email sent out
219 instead of the default text if specified. The following perl variables
220 can be used in the template:
224 =item B<{owner}> [string]
226 Your name as specified in the L<B<owner>|/item_owner__5bstring_5d> setting.
228 =item B<{key}> [string]
230 The keyid of the key you signed.
232 =item B<{@uids}> [array]
234 The UIDs for which signatures are included in the mail.
238 =item B<reply-to> [string]
240 Add a Reply-To: header to messages sent. Default: none.
242 =item B<bcc> [string]
244 Address to send blind carbon copies to when sending mail.
253 =item Peter Palfrader <peter@palfrader.org>
255 =item Christoph Berg <cb@df7cb.de>
261 http://pgp-tools.alioth.debian.org/
265 gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample.
273 use File
:: Temp
qw{ tempdir
};
279 use GnuPG
:: Interface
;
282 my $REVISION = ' $Rev $' ;
283 my ( $REVISION_NUMER ) = $REVISION =~ /(\d+)/ ;
284 my $VERSION = "0.0.0. $REVISION_NUMER " ;
290 print "[NOTICE] $line \n " ;
294 print "[INFO] $line \n " ;
298 #print "[DEBUG] $line\n";
302 #print "[trace] $line\n";
306 #print "[trace2] $line\n";
310 sub generate_config
() {
311 notice
( "Error: \ $LOGNAME is not set. \n " ) unless defined $ENV { 'LOGNAME' };
312 my $gecos = defined $ENV { 'LOGNAME' } ?
( getpwnam ( $ENV { LOGNAME
}))[ 6 ] : undef ;
315 my $hostname = `hostname -f` ;
317 my ( $Cgecos , $Cemail , $Ckeys ) = ( '' , '' , '' );
318 if ( defined $gecos ) {
321 my $gpg = GnuPG
:: Interface
-> new ();
323 $gpg -> options -> hash_init (
324 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
-- with
- colons
-- fixed
- list
- mode
} ] );
325 $gpg -> options -> meta_interactive ( 0 );
326 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
327 my $pid = $gpg -> list_public_keys ( handles
=> $handles , command_args
=> [ $gecos ]);
328 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
332 warn ( "No data from gpg for list-key \n " ); # There should be at least 'tru:' everywhere.
335 @keys = ( $stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg );
336 unless ( scalar @keys ) {
337 info
( "Error: No keys were found using \" gpg --list-public-keys ' $gecos ' \" ." );
338 @keys = qw{ 0123456789 abcdef
89 abcdef76543210
};
341 ( $email ) = ( $stdout =~ /^uid:.*<(.+?@.+?)>.*:/m );
342 unless ( defined $email ) {
343 info
( "Error: No email address was found using \" gpg --list-public-keys ' $gecos ' \" ." );
344 $email = $ENV { 'LOGNAME' }. '@' . $hostname ;
348 $gecos = 'Unknown Caff User' ;
349 $email = $ENV { 'LOGNAME' }. '@' . $hostname ;
350 @keys = qw{ 0123456789 abcdef
89 abcdef76543210
};
351 ( $Cgecos , $Cemail , $Ckeys ) = ( '#' , '#' , '#' );
355 # .caffrc -- vim:syntax=perl:
356 # This file is in perl(1) format - see caff(1) for details.
358 $Cgecos \ $CONFIG {'owner'} = ' $gecos ';
359 $Cemail \ $CONFIG {'email'} = ' $email ';
361 # you can get your long keyid from
362 # gpg --with-colons --list-key <yourkeyid|name|emailaddress..>
364 # if you have a v4 key, it will simply be the last 16 digits of
368 # \ $CONFIG {'keyid'} = [ qw{FEDCBA9876543210} ];
369 # or, if you have more than one key:
370 # \ $CONFIG {'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ];
372 $Ckeys \ $CONFIG {'keyid'} = [ qw{ @keys } ];
376 sub check_executable
($$) {
377 # (GnuPG::Interface gives lousy errors when the gpg binary isn't found,
378 # so we want to check manually.)
379 my ( $purpose , $fn ) = @_ ;
380 # Only check provided fnames with a slash in them.
381 return unless defined $fn ;
383 die ( " $PROGRAM_NAME : $purpose executable ' $fn ' not found. \n " ) unless - x
$fn ;
385 for my $p ( split ( ':' , $ENV { PATH
})) {
386 return if - x
" $p / $fn " ;
388 die ( " $PROGRAM_NAME : $purpose executable ' $fn ' not found on path. \n " ) unless - x
$fn ;
393 my $config = $ENV { 'HOME' } . '/.caffrc' ;
394 unless (- f
$config ) {
395 print "No configfile $config present, I will use this template: \n " ;
396 my $template = generate_config
();
397 print " $template \n Please edit $config and run caff again. \n " ;
398 open F
, "> $config " or die " $config : $!" ;
403 unless ( scalar eval `cat $config ` ) {
404 die "Couldn't parse $config : $EVAL_ERROR \n " if $EVAL_ERROR ;
407 $CONFIG { 'caffhome' }= $ENV { 'HOME' }. '/.caff' unless defined $CONFIG { 'caffhome' };
408 die ( " $PROGRAM_NAME : owner is not defined in $config . \n " ) unless defined $CONFIG { 'owner' };
409 die ( " $PROGRAM_NAME : email is not defined in $config . \n " ) unless defined $CONFIG { 'email' };
410 die ( " $PROGRAM_NAME : keyid is not defined in $config . \n " ) unless defined $CONFIG { 'keyid' };
411 die ( " $PROGRAM_NAME : keyid is not an array ref in $config . \n " ) unless ( ref $CONFIG { 'keyid' } eq 'ARRAY' );
412 for my $keyid ( @
{ $CONFIG { 'keyid' }}) {
413 $keyid =~ /^[A-F0-9]{16}$/i or die ( " $PROGRAM_NAME : key $keyid is not a long (16 digit) keyid in $config . \n " );
415 @
{ $CONFIG { 'keyid' }} = map { uc } @
{ $CONFIG { 'keyid' }};
416 $CONFIG { 'export-sig-age' }= 24 * 60 * 60 unless defined $CONFIG { 'export-sig-age' };
417 $CONFIG { 'keyserver' } = 'subkeys.pgp.net' unless defined $CONFIG { 'keyserver' };
418 $CONFIG { 'gpg' } = 'gpg' unless defined $CONFIG { 'gpg' };
419 $CONFIG { 'gpg-sign' } = $CONFIG { 'gpg' } unless defined $CONFIG { 'gpg-sign' };
420 $CONFIG { 'gpg-delsig' } = $CONFIG { 'gpg' } unless defined $CONFIG { 'gpg-delsig' };
421 check_executable
( "gpg" , $CONFIG { 'gpg' });
422 check_executable
( "gpg-sign" , $CONFIG { 'gpg-sign' });
423 check_executable
( "gpg-delsig" , $CONFIG { 'gpg-delsig' });
424 $CONFIG { 'secret-keyring' } = $ENV { 'HOME' }. '/.gnupg/secring.gpg' unless defined $CONFIG { 'secret-keyring' };
425 $CONFIG { 'no-download' } = 0 unless defined $CONFIG { 'no-download' };
426 $CONFIG { 'no-sign' } = 0 unless defined $CONFIG { 'no-sign' };
427 $CONFIG { 'key-files' } = () unless defined $CONFIG { 'key-files' };
428 $CONFIG { 'mail-template' } = <<'EOM' unless defined $CONFIG {'mail-template'};
431 please find attached the user id{(scalar @uids >= 2 ? 's' : '')}.
432 {foreach $uid ( @uids ) {
433 $OUT .= " \t ". $uid ." \n ";
434 };} of your key { $key } signed by me.
436 Note that I did not upload your key to any keyservers.
437 If you have multiple user ids, I sent the signature for each user id
438 separately to that user id's associated email address. You can import
439 the signatures by running each through `gpg --import`.
441 If you want this new signature to be available to others, please upload
442 it yourself. With GnuPG this can be done using
443 gpg --keyserver subkeys.pgp.net --send-key { $key }
445 If you have any questions, don't hesitate to ask.
454 stdin
=> IO
:: Handle
-> new (),
455 stdout
=> IO
:: Handle
-> new (),
456 stderr
=> IO
:: Handle
-> new (),
457 status
=> IO
:: Handle
-> new () );
458 my $handles = GnuPG
:: Handles
-> new ( %fds );
459 return ( $fds { 'stdin' }, $fds { 'stdout' }, $fds { 'stderr' }, $fds { 'status' }, $handles );
462 sub readwrite_gpg
($$$$$%) {
463 my ( $in , $inputfd , $stdoutfd , $stderrfd , $statusfd , %options ) = @_ ;
465 trace
( "Entering readwrite_gpg." );
467 my ( $first_line , undef ) = split /\n/ , $in ;
468 debug
( "readwrite_gpg sends " .( defined $first_line ?
$first_line : "<nothing>" ));
470 local $INPUT_RECORD_SEPARATOR = undef ;
471 my $sout = IO
:: Select
-> new ();
472 my $sin = IO
:: Select
-> new ();
475 trace
( "input is $inputfd ; output is $stdoutfd ; err is $stderrfd ; status is " .( defined $statusfd ?
$statusfd : 'undef' ). "." );
477 $inputfd -> blocking ( 0 );
478 $stdoutfd -> blocking ( 0 );
479 $statusfd -> blocking ( 0 ) if defined $statusfd ;
480 $stderrfd -> blocking ( 0 );
481 $sout -> add ( $stdoutfd );
482 $sout -> add ( $stderrfd );
483 $sout -> add ( $statusfd ) if defined $statusfd ;
486 my ( $stdout , $stderr , $status ) = ( "" , "" , "" );
487 my $exitwhenstatusmatches = $options { 'exitwhenstatusmatches' };
488 trace
( "doing stuff until we find $exitwhenstatusmatches " ) if defined $exitwhenstatusmatches ;
490 my $readwrote_stuff_this_time = 0 ;
491 my $do_not_wait_on_select = 0 ;
492 my ( $readyr , $readyw , $written );
493 while ( $sout -> count () > 0 || ( defined ( $sin ) && ( $sin -> count () > 0 ))) {
494 if ( defined $exitwhenstatusmatches ) {
495 if ( $status =~ /$exitwhenstatusmatches/m ) {
496 trace
( "readwrite_gpg found match on $exitwhenstatusmatches " );
497 if ( $readwrote_stuff_this_time ) {
498 trace
( "read/write some more \n " );
499 $do_not_wait_on_select = 1 ;
501 trace
( "that's it in our while loop. \n " );
507 $readwrote_stuff_this_time = 0 ;
508 trace
( "select waiting for " .( $sout -> count ()). " fds." );
509 ( $readyr , $readyw , undef ) = IO
:: Select
:: select ( $sout , $sin , undef , $do_not_wait_on_select ?
0 : 1 );
510 trace
( "ready: write: " .( defined $readyw ?
scalar @
$readyw : 0 ). "; read: " .( defined $readyr ?
scalar @
$readyr : 0 ));
511 for my $wfd ( @
$readyw ) {
512 $readwrote_stuff_this_time = 1 ;
513 if ( length ( $in ) != $offset ) {
514 trace
( "writing to $wfd ." );
515 $written = $wfd -> syswrite ( $in , length ( $in ) - $offset , $offset );
518 if ( $offset == length ( $in )) {
519 trace
( "writing to $wfd done." );
520 unless ( $options { 'nocloseinput' }) {
522 trace
( " $wfd closed." );
529 next unless ( defined ( @
$readyr )); # Wait some more.
531 for my $rfd ( @
$readyr ) {
532 $readwrote_stuff_this_time = 1 ;
534 trace
( "reading from $rfd done." );
539 trace
( "reading from $rfd ." );
540 if ( $rfd == $stdoutfd ) {
542 trace2
( "stdout is now $stdout \n ================" );
545 if ( defined $statusfd && $rfd == $statusfd ) {
547 trace2
( "status is now $status \n ================" );
550 if ( $rfd == $stderrfd ) {
552 trace2
( "stderr is now $stderr \n ================" );
557 trace
( "readwrite_gpg done." );
558 return ( $stdout , $stderr , $status );
562 my ( $question , $default , $forceyes , $forceno ) = @_ ;
564 my $yn = $default ?
'[Y/n]' : '[y/N]' ;
566 print $question , ' ' , $yn , ' ' ;
567 if ( $forceyes && $forceno ) {
568 print " $default (from config/command line) \n " ;
572 print "YES (from config/command line) \n " ;
576 print "NO (from config/command line) \n " ;
581 if (! defined $answer ) {
582 $OUTPUT_AUTOFLUSH = 1 ;
584 "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN, \n " .
585 "so you can't really use it with xargs. A patch against caff to read from \n " .
586 "the terminal would be appreciated. \n " .
587 "For now instead of cat keys | xargs caff do caff `cat keys` \n " ;
590 last if (( length $answer == 0 ) || ( $answer =~ m/^[yYnN]$/ ) );
591 print "What about $yn is so hard to understand? \n Answer with either 'n' or 'y' or just press enter for the default. \n " ;
594 my $result = $default ;
595 $result = 1 if $answer =~ /y/i ;
596 $result = 0 if $answer =~ /n/i ;
604 my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt' ;
605 my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay' ;
606 my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig' ;
607 my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)' ;
608 my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey' ;
611 my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al." ;
613 my $KEYSBASE = $CONFIG { 'caffhome' }. '/keys' ;
614 my $GNUPGHOME = $CONFIG { 'caffhome' }. '/gnupghome' ;
616 - d
$KEYSBASE || mkpath
( $KEYSBASE , 0 , 0700 ) or die ( "Cannot create $KEYSBASE : $! \n " );
617 - d
$GNUPGHOME || mkpath
( $GNUPGHOME , 0 , 0700 ) or die ( "Cannot create $GNUPGHOME : $! \n " );
620 my ( $sec , $min , $hour , $mday , $mon , $year , $wday , $yday , $isdst ) = localtime ( $NOW );
621 my $DATE_STRING = sprintf ( " %04d - %02d - %02d " , $year + 1900 , $mon + 1 , $mday );
626 print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al. \n " ;
630 my ( $fd , $exitcode ) = @_ ;
632 print $fd "Usage: $PROGRAM_NAME [-eEmMRS] [-u <yourkeyid>] <keyid> [<keyid> ...] \n " ;
633 print $fd "Consult the manual page for more information. \n " ;
638 # export key $keyid from $gnupghome
641 my ( $gnupghome , $keyid ) = @_ ;
643 my $gpg = GnuPG
:: Interface
-> new ();
644 $gpg -> call ( $CONFIG { 'gpg' } );
645 if ( defined $gnupghome ) {
646 $gpg -> options -> hash_init (
647 'homedir' => $gnupghome ,
648 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ],
651 $gpg -> options -> hash_init (
652 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ],
655 $gpg -> options -> meta_interactive ( 0 );
656 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
657 my $pid = $gpg -> export_keys ( handles
=> $handles , command_args
=> [ $keyid ]);
658 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
665 # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir
668 my ( $gnupghome , $asciikey ) = @_ ;
670 my $gpg = GnuPG
:: Interface
-> new ();
671 $gpg -> call ( $CONFIG { 'gpg' } );
672 $gpg -> options -> hash_init (
673 'homedir' => $gnupghome ,
674 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ] );
675 $gpg -> options -> meta_interactive ( 0 );
676 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
677 my $pid = $gpg -> import_keys ( handles
=> $handles );
678 my ( $stdout , $stderr , $status ) = readwrite_gpg
( $asciikey , $inputfd , $stdoutfd , $stderrfd , $statusfd );
681 if ( $status !~ /^\[GNUPG:\] IMPORT_OK/m ) {
689 # Send an email to $address. If $can_encrypt is true then the mail
690 # will be PGP/MIME encrypted to $longkeyid.
692 # $longkeyid, $uid, and @attached will be used in the email and the template.
694 #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached);
695 sub send_mail
($$$ @
) {
696 my ( $address , $can_encrypt , $key_id , @keys ) = @_ ;
698 my $template = Text
:: Template
-> new ( TYPE
=> 'STRING' , SOURCE
=> $CONFIG { 'mail-template' })
699 or die "Error creating template: $Text ::Template::ERROR" ;
702 for my $key ( @keys ) {
703 push @uids , $key ->{ 'text' };
705 my $message = $template -> fill_in ( HASH
=> { key
=> $key_id ,
707 owner
=> $CONFIG { 'owner' }})
708 or die "Error filling template in: $Text ::Template::ERROR" ;
710 my $message_entity = MIME
:: Entity
-> build (
711 Type
=> "text/plain" ,
713 Disposition
=> 'inline' ,
717 for my $key ( @keys ) {
718 $message_entity -> attach (
719 Type
=> "application/pgp-keys" ,
720 Disposition
=> 'attachment' ,
722 Description
=> "PGP Key 0x $key_id , uid " .( $key ->{ 'text' }). ' (' .( $key ->{ 'serial' }). '), signed by 0x' . $CONFIG { 'keyid' }[ 0 ],
723 Data
=> $key ->{ 'key' },
724 Filename
=> "0x $key_id ." . $key ->{ 'serial' }. ".signed-by-0x" . $CONFIG { 'keyid' }[ 0 ]. ".asc" );
728 my $message = $message_entity -> stringify ();
730 my $gpg = GnuPG
:: Interface
-> new ();
731 $gpg -> call ( $CONFIG { 'gpg' } );
732 $gpg -> options -> hash_init ( 'homedir' => $GNUPGHOME ,
733 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
} ],
735 $gpg -> options -> meta_interactive ( 0 );
736 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
737 $gpg -> options -> push_recipients ( $key_id );
738 $gpg -> options -> push_recipients ( $CONFIG { 'also-encrypt-to' } ) if defined $CONFIG { 'also-encrypt-to' };
739 my $pid = $gpg -> encrypt ( handles
=> $handles );
740 my ( $stdout , $stderr , $status ) = readwrite_gpg
( $message , $inputfd , $stdoutfd , $stderrfd , $statusfd );
743 warn ( "No data from gpg for list-key $key_id \n " );
748 $message_entity = MIME
:: Entity
-> build (
749 Type
=> 'multipart/encrypted; protocol="application/pgp-encrypted"' );
751 $message_entity -> attach (
752 Type
=> "application/pgp-encrypted" ,
753 Disposition
=> 'attachment' ,
755 Data
=> "Version: 1 \n " );
757 $message_entity -> attach (
758 Type
=> "application/octet-stream" ,
759 Filename
=> 'msg.asc' ,
760 Disposition
=> 'inline' ,
765 $message_entity -> head -> add ( "Subject" , "Your signed PGP key 0x $key_id " );
766 $message_entity -> head -> add ( "To" , $address );
767 $message_entity -> head -> add ( "From" , '"' . $CONFIG { 'owner' }. '" <' . $CONFIG { 'email' }. '>' );
768 $message_entity -> head -> add ( "Reply-To" , $CONFIG { 'reply-to' }) if defined $CONFIG { 'reply-to' };
769 $message_entity -> head -> add ( "Bcc" , $CONFIG { 'bcc' }) if defined $CONFIG { 'bcc' };
770 $message_entity -> head -> add ( "User-Agent" , $USER_AGENT );
771 $message_entity -> send ();
772 $message_entity -> stringify ();
776 # clean up a UID so that it can be used on the FS.
778 sub sanitize_uid
($) {
782 $good_uid =~ tr
#/:\\#_#;
783 trace2
( "[sanitize_uid] changed UID from $uid to $good_uid . \n " ) if $good_uid ne $uid ;
787 sub delete_signatures
($$$$$$) {
788 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $longkeyid , $keyids ) = @_ ;
790 my $signed_by_me = 0 ;
792 my ( $stdout , $stderr , $status ) =
793 readwrite_gpg
( "delsig \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_DELSIG_PROMPT , nocloseinput
=> 1 );
795 while ( $status =~ /$KEYEDIT_DELSIG_PROMPT/m ) {
796 # sig:?::17:EA2199412477CAF8:1058095214:::::13x:
797 my @sigline = grep { /^sig/ } ( split /\n/ , $stdout );
798 $stdout =~ s/\n/\\n/g ;
799 notice
( "[sigremoval] why are there " .( scalar @sigline ). " siglines in that part of the dialog!? got: $stdout " ) if scalar @sigline >= 2 ; # XXX
800 my $line = pop @sigline ;
802 if ( defined $line ) { # only if we found a sig here - we never remove revocation packets for instance
803 debug
( "[sigremoval] doing line $line ." );
804 my ( undef , undef , undef , undef , $signer , $created , undef , undef , undef ) = split /:/ , $line ;
805 if ( $signer eq $longkeyid ) {
806 debug
( "[sigremoval] selfsig ( $signer )." );
808 } elsif ( grep { $signer eq $_ } @
{ $keyids }) {
809 debug
( "[sigremoval] signed by us ( $signer )." );
811 $signed_by_me = $signed_by_me > $created ?
$signed_by_me : $created ;
813 debug
( "[sigremoval] not interested in that sig ( $signer )." );
817 debug
( "[sigremoval] no sig line here, only got: " . $stdout );
819 ( $stdout , $stderr , $status ) =
820 readwrite_gpg
( $answer . " \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT , nocloseinput
=> 1 );
823 return $signed_by_me ;
832 Getopt
:: Long
:: config
( 'bundling' );
834 '-h' => \
$params ->{ 'help' },
835 '--help' => \
$params ->{ 'help' },
836 '--version' => \
$params ->{ 'version' },
837 '-V' => \
$params ->{ 'version' },
838 '-u=s' => \
$params ->{ 'local-user' },
839 '--local-user=s' => \
$params ->{ 'local-user' },
840 '-e' => \
$params ->{ 'export-old' },
841 '--export-old' => \
$params ->{ 'export-old' },
842 '-E' => \
$params ->{ 'no-export-old' },
843 '--no-export-old' => \
$params ->{ 'no-export-old' },
844 '-m' => \
$params ->{ 'mail' },
845 '--mail' => \
$params ->{ 'mail' },
846 '-M' => \
$params ->{ 'no-mail' },
847 '--no-mail' => \
$params ->{ 'no-mail' },
848 '-R' => \
$params ->{ 'no-download' },
849 '--no-download' => \
$params ->{ 'no-download' },
850 '-S' => \
$params ->{ 'no-sign' },
851 '--no-sign' => \
$params ->{ 'no-sign' },
852 '--key-file=s@' => \
$params ->{ 'key-files' },
856 if ( $params ->{ 'help' }) {
859 if ( $params ->{ 'version' }) {
863 usage
( \
* STDERR
, 1 ) unless scalar @ARGV >= 1 ;
867 if ( $params ->{ 'local-user' }) {
868 $USER = $params ->{ 'local-user' };
870 unless ( $USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i ) {
871 print STDERR
"-u $USER is not a keyid. \n " ;
877 for my $keyid ( @ARGV ) {
879 unless ( $keyid =~ /^([A-F0-9]{8}|[A-F0-9]{16}||[A-F0-9]{40})$/i ) {
880 if ( $keyid =~ /^[A-F0-9]{32}$/ ) {
881 info
( "Ignoring v3 fingerprint $keyid . v3 keys are obsolete." );
884 print STDERR
" $keyid is not a keyid. \n " ;
887 push @KEYIDS , uc ( $keyid );
890 $CONFIG { 'no-download' } = $params ->{ 'no-download' } if defined $params ->{ 'no-download' };
891 $CONFIG { 'no-mail' } = $params ->{ 'no-mail' } if defined $params ->{ 'no-mail' };
892 $CONFIG { 'mail' } = $params ->{ 'mail' } if defined $params ->{ 'mail' };
893 $CONFIG { 'no-sign' } = $params ->{ 'no-sign' } if defined $params ->{ 'no-sign' };
894 push @
{ $CONFIG { 'key-files' }}, @
{ $params ->{ 'key-files' }} if defined $params ->{ 'key-files' };
900 for my $keyid ( @
{ $CONFIG { 'keyid' }}) {
901 my $gpg = GnuPG
:: Interface
-> new ();
902 $gpg -> call ( $CONFIG { 'gpg' } );
903 $gpg -> options -> hash_init (
904 'homedir' => $GNUPGHOME ,
905 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
-- with
- colons
-- fixed
- list
- mode
-- fast
- list
- mode
} ] );
906 $gpg -> options -> meta_interactive ( 0 );
907 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
908 my $pid = $gpg -> list_public_keys ( handles
=> $handles , command_args
=> $keyid );
909 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
913 warn ( "No data from gpg for list-key \n " ); # There should be at least 'tru:' everywhere.
915 unless ( $stdout =~ /^pub:(?:[^:]*:){3,3}$keyid:/m ) {
916 info
( "Key $keyid not found in caff's home. Getting it from your normal GnuPGHome." );
917 my $key = export_key
( undef , $keyid );
918 if (! defined $key || $key eq '' ) {
919 warn ( "Did not get key $keyid from your normal GnuPGHome \n " );
922 my $result = import_key
( $GNUPGHOME , $key );
924 warn ( "Could not import $keyid into caff's gnupghome. \n " );
930 ########################
931 # import keys from files
932 ########################
933 foreach my $keyfile ( @
{ $CONFIG { 'key-files' }}) {
934 my $gpg = GnuPG
:: Interface
-> new ();
935 $gpg -> call ( $CONFIG { 'gpg' } );
936 $gpg -> options -> hash_init ( 'homedir' => $GNUPGHOME );
937 $gpg -> options -> meta_interactive ( 0 );
938 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
939 my $pid = $gpg -> import_keys ( handles
=> $handles , command_args
=> $keyfile );
940 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
941 info
( "Importing keys from $keyfile " );
943 if ( $status !~ /^\[GNUPG:\] IMPORT_OK/m ) {
948 #############################
949 # receive keys from keyserver
950 #############################
952 if ( $CONFIG { 'no-download' }) {
953 @keyids_ok = @KEYIDS ;
955 info
( "fetching keys, this will take a while..." );
957 my $gpg = GnuPG
:: Interface
-> new ();
958 $gpg -> call ( $CONFIG { 'gpg' } );
959 $gpg -> options -> hash_init (
960 'homedir' => $GNUPGHOME ,
961 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
}, '--keyserver=' . $CONFIG { 'keyserver' } ] );
962 $gpg -> options -> meta_interactive ( 0 );
963 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
964 my $pid = $gpg -> recv_keys ( handles
=> $handles , command_args
=> [ @KEYIDS ]);
965 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
968 # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F
971 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039
972 my %local_keyids = map { $_ => 1 } @KEYIDS ;
974 for my $line ( split /\n/ , $status ) {
975 if ( $line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/ ) {
976 my $imported_key = $1 ;
977 my $whole_fpr = $imported_key ;
978 my $long_keyid = substr ( $imported_key , - 16 );
979 my $short_keyid = substr ( $imported_key , - 8 );
981 for my $spec (( $whole_fpr , $long_keyid , $short_keyid )) {
982 $speced_key = $spec if $local_keyids { $spec };
984 unless ( $speced_key ) {
985 notice
( "Imported unexpected key; got: $imported_key \n " );
988 debug
( "Imported $imported_key for $speced_key " );
989 delete $local_keyids { $speced_key };
990 unshift @keyids_ok , $imported_key ;
991 } elsif ( $line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) / ) {
992 } elsif ( $line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/ ) {
993 my $imported_key = $1 ;
994 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 notice
( "got unknown reply from gpg: $line " );
1000 if ( scalar %local_keyids ) {
1001 notice
( "Import failed for: " . ( join ' ' , keys %local_keyids ). "." . ( $had_v3_keys ?
" (Or maybe it's one of those ugly v3 keys?)" : "" ));
1002 exit 1 unless ask
( "Some keys could not be imported - continue anyway?" , 0 );
1006 unless ( @keyids_ok ) {
1007 notice
( "No keys to sign found" );
1014 if ( $CONFIG { 'ask-sign' } && ! $CONFIG { 'no-sign' }) {
1015 $CONFIG { 'no-sign' } = ! ask
( "Continue with signing?" , 1 );
1018 unless ( $CONFIG { 'no-sign' }) {
1019 info
( "Sign the following keys according to your policy, then exit gpg with 'save' after signing each key" );
1020 for my $keyid ( @keyids_ok ) {
1022 push @command , $CONFIG { 'gpg-sign' };
1023 push @command , '--local-user' , $USER if ( defined $USER );
1024 push @command , "--homedir= $GNUPGHOME " ;
1025 push @command , '--secret-keyring' , $CONFIG { 'secret-keyring' };
1026 push @command , '--no-auto-check-trustdb' ;
1027 push @command , '--trust-model=always' ;
1028 push @command , '--edit' , $keyid ;
1029 push @command , 'sign' ;
1030 push @command , split ' ' , $CONFIG { 'gpg-sign-args' } || "" ;
1031 print join ( ' ' , @command ), " \n " ;
1040 for my $keyid ( @keyids_ok ) {
1043 my $gpg = GnuPG
:: Interface
-> new ();
1044 $gpg -> call ( $CONFIG { 'gpg' } );
1045 $gpg -> options -> hash_init (
1046 'homedir' => $GNUPGHOME ,
1047 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
-- with
- colons
-- fixed
- list
- mode
} ] );
1048 $gpg -> options -> meta_interactive ( 0 );
1049 my ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
1050 my $pid = $gpg -> list_public_keys ( handles
=> $handles , command_args
=> [ $keyid ]);
1051 my ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd );
1053 if ( $stdout eq '' ) {
1054 warn ( "No data from gpg for list-key $keyid \n " );
1057 my @publine = grep { /^pub/ } ( split /\n/ , $stdout );
1058 if ( scalar @publine == 0 ) {
1059 warn ( "No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME ). \n " );
1062 my ( undef , undef , undef , undef , $longkeyid , undef , undef , undef , undef , undef , undef , $flags ) = split /:/ , pop @publine ;
1063 if ( scalar @publine > 0 ) {
1064 warn ( "More than one key matched $keyid . Try to specify the long keyid or fingerprint \n " );
1067 unless ( defined $longkeyid ) {
1068 warn ( "Didn't find public keyid in --list-key of key $keyid . \n " );
1071 unless ( defined $flags ) {
1072 warn ( "Didn't find flags in --list-key of key $keyid . \n " );
1075 my $can_encrypt = $flags =~ /E/ ;
1079 my $asciikey = export_key
( $GNUPGHOME , $keyid );
1080 if ( $asciikey eq '' ) {
1081 warn ( "No data from gpg for export $keyid \n " );
1088 my $this_uid_text = '' ;
1090 debug
( "Doing key $keyid , uid $uid_number " );
1091 my $tempdir = tempdir
( "caff- $keyid -XXXXX" , DIR
=> '/tmp/' , CLEANUP
=> 1 );
1093 # import into temporary gpghome
1094 ###############################
1095 my $result = import_key
( $tempdir , $asciikey );
1097 warn ( "Could not import $keyid into temporary gnupg. \n " );
1103 $gpg = GnuPG
:: Interface
-> new ();
1104 $gpg -> call ( $CONFIG { 'gpg-delsig' } );
1105 $gpg -> options -> hash_init (
1106 'homedir' => $tempdir ,
1107 'extra_args' => [ qw{ -- no - auto
- check
- trustdb
-- trust
- model
= always
-- with
- colons
-- fixed
- list
- mode
-- command
- fd
= 0 -- no - tty
} ] );
1108 ( $inputfd , $stdoutfd , $stderrfd , $statusfd , $handles ) = make_gpg_fds
();
1109 $pid = $gpg -> wrap_call (
1110 commands
=> [ '--edit' ],
1111 command_args
=> [ $keyid ],
1112 handles
=> $handles );
1114 debug
( "Starting edit session" );
1115 ( $stdout , $stderr , $status ) = readwrite_gpg
( '' , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1119 my $number_of_subkeys = 0 ;
1123 my $delete_some = 0 ;
1124 debug
( "Parsing stdout output." );
1125 for my $line ( split /\n/ , $stdout ) {
1126 debug
( "Checking line $line " );
1127 my ( $type , undef , undef , undef , undef , undef , undef , undef , undef , $uidtext ) = split /:/ , $line ;
1128 if ( $type eq 'sub' ) {
1129 $number_of_subkeys ++;
1131 next unless ( $type eq 'uid' || $type eq 'uat' );
1132 debug
( "line is interesting." );
1133 if ( $uid_number != $i ) {
1134 debug
( "mark for deletion." );
1135 readwrite_gpg
( " $i \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1140 $this_uid_text = ( $type eq 'uid' ) ?
$uidtext : '[attribute]' ;
1141 $is_uat = $type eq 'uat' ;
1145 debug
( "Parsing stdout output done." );
1146 unless ( $have_one ) {
1147 debug
( "Uid " .( $uid_number - 1 ). " was the last, there is no $uid_number ." );
1148 info
( "key $keyid done." );
1152 my $prune_some_sigs_on_uid ;
1153 my $prune_all_sigs_on_uid ;
1155 debug
( "handling attribute userid of key $keyid ." );
1156 if ( $uid_number == 1 ) {
1157 debug
( " attribute userid is #1, unmarking #2 for deletion." );
1158 readwrite_gpg
( "2 \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1160 $prune_some_sigs_on_uid = 1 ;
1161 $prune_all_sigs_on_uid = 2 ;
1163 debug
( "attribute userid is not #1, unmarking #1 for deletion." );
1164 readwrite_gpg
( "1 \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1166 $prune_some_sigs_on_uid = 2 ;
1167 $prune_all_sigs_on_uid = 1 ;
1170 $prune_some_sigs_on_uid = 1 ;
1174 debug
( "need to delete $delete_some uids." );
1175 readwrite_gpg
( "deluid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_DELUID_PROMPT , nocloseinput
=> 1 );
1176 readwrite_gpg
( "yes \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1181 if ( $number_of_subkeys > 0 ) {
1182 for ( my $i = 1 ; $i <= $number_of_subkeys ; $i ++) {
1183 readwrite_gpg
( "key $i \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1185 readwrite_gpg
( "delkey \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_DELSUBKEY_PROMPT , nocloseinput
=> 1 );
1186 readwrite_gpg
( "yes \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 );
1191 readwrite_gpg
( " $prune_some_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # mark uid for delsig
1192 my $signed_by_me = delete_signatures
( $inputfd , $stdoutfd , $stderrfd , $statusfd , $longkeyid , $CONFIG { 'keyid' });
1193 readwrite_gpg
( " $prune_some_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # unmark uid from delsig
1194 if ( defined $prune_all_sigs_on_uid ) {
1195 readwrite_gpg
( " $prune_all_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # mark uid for delsig
1196 delete_signatures
( $inputfd , $stdoutfd , $stderrfd , $statusfd , $longkeyid , []);
1197 readwrite_gpg
( " $prune_all_sigs_on_uid \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd , exitwhenstatusmatches
=> $KEYEDIT_PROMPT , nocloseinput
=> 1 ); # unmark uid from delsig
1201 readwrite_gpg
( "save \n " , $inputfd , $stdoutfd , $stderrfd , $statusfd );
1204 my $asciikey = export_key
( $tempdir , $keyid );
1205 if ( $asciikey eq '' ) {
1206 warn ( "No data from gpg for export $keyid \n " );
1210 if ( $signed_by_me ) {
1211 if ( $NOW - $signed_by_me > $CONFIG { 'export-sig-age' } ) {
1212 my $write = ask
( "Signature on $this_uid_text is old. Export?" , 0 , $params ->{ 'export-old' }, $params ->{ 'no-export-old' });
1215 my $keydir = " $KEYSBASE / $DATE_STRING " ;
1216 - d
$keydir || mkpath
( $keydir , 0 , 0700 ) or die ( "Cannot create $keydir $! \n " );
1218 my $keyfile = " $keydir / $longkeyid .key. $uid_number ." . sanitize_uid
( $this_uid_text ). ".asc" ;
1219 open ( KEY
, "> $keyfile " ) or die ( "Cannot open $keyfile : $! \n " );
1220 print KEY
$asciikey ;
1223 push @UIDS , { text
=> $this_uid_text , key
=> $asciikey , serial
=> $uid_number , "is_uat" => $is_uat };
1225 info
( " $longkeyid $uid_number $this_uid_text done." );
1227 info
( " $longkeyid $uid_number $this_uid_text is not signed by me, not writing." );
1231 if ( scalar @UIDS == 0 ) {
1232 info
( "found no signed uids for $keyid " );
1234 next if $CONFIG { 'no-mail' }; # do not send mail
1237 for my $uid ( @UIDS ) {
1238 trace
( "UID: $uid ->{'text'} \n " );
1239 if ( $uid ->{ 'is_uat' }) {
1240 my $attach = ask
( "UID $uid ->{'text'} is an attribute UID, attach it to every email sent?" , 1 );
1241 push @attached , $uid if $attach ;
1242 } elsif ( $uid ->{ 'text' } !~ /@/ ) {
1243 my $attach = ask
( "UID $uid ->{'text'} is no email address, attach it to every email sent?" , 1 );
1244 push @attached , $uid if $attach ;
1248 notice
( "Key has no encryption capabilities, mail will be sent unencrypted" ) unless $can_encrypt ;
1249 for my $uid ( @UIDS ) {
1250 if (! $uid ->{ 'is_uat' } && ( $uid ->{ 'text' } =~ /@/ )) {
1251 my $address = $uid ->{ 'text' };
1252 $address =~ s/.*<(.*)>.*/$1/ ;
1253 if ( ask
( "Mail signature for $uid ->{'text'} to ' $address '?" , 1 , $CONFIG { 'mail' })) {
1254 my $mail = send_mail
( $address , $can_encrypt , $longkeyid , $uid , @attached );
1256 my $keydir = " $KEYSBASE / $DATE_STRING " ;
1257 my $mailfile = " $keydir / $longkeyid .mail." . $uid ->{ 'serial' }. "." . sanitize_uid
( $uid ->{ 'text' });
1258 open ( KEY
, "> $mailfile " ) or die ( "Cannot open $mailfile : $! \n " );