#!/usr/bin/perl -w # caff -- CA - Fire and Forget # $Id$ # # Copyright (c) 2004, 2005, 2006 Peter Palfrader # Copyright (c) 2005, 2006 Christoph Berg # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions # are met: # 1. Redistributions of source code must retain the above copyright # notice, this list of conditions and the following disclaimer. # 2. Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # 3. The name of the author may not be used to endorse or promote products # derived from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =pod =head1 NAME caff -- CA - Fire and Forget =head1 SYNOPSIS =over =item B [-eERS] [-m I] [-u I] I [I ..] =back =head1 DESCRIPTION CA Fire and Forget is a script that helps you in keysigning. It takes a list of keyids on the command line, fetches them from a keyserver and calls GnuPG so that you can sign it. It then mails each key to all its email addresses - only including the one UID that we send to in each mail, pruned from all but self sigs and sigs done by you. The mailed key is encrypted with itself as a means to verify that key belongs to the recipient. =head1 OPTIONS =over =item B<-e>, B<--export-old> Export old signatures. Default is to ask the user for each old signature. =item B<-E>, B<--no-export-old> Do not export old signatures. Default is to ask the user for each old signature. =item B<-m>, B<--mail> I Whether to send mail after signing. Default is to ask, for each uid, with a default value of yes. =item B<-R>, B<--no-download> Do not retrieve the key to be signed from a keyserver. =item B<-S>, B<--no-sign> Do not sign the keys. =item B<-u> I, B<--local-user> I Select the key that is used for signing, in case you have more than one key. To sign with multiple keys at once, separate multiple keyids by comma. This option requires the key(s) to be defined through the keyid variable in the configuration file. =item B<--key-file> I Import keys from file. Can be supplied more than once. =back =head1 FILES =over =item $HOME/.caffrc - configuration file =item $HOME/.caff/keys/yyyy-mm-dd/ - processed keys =item $HOME/.caff/gnupghome/ - caff's working dir for gpg =item $HOME/.caff/gnupghome/gpg.conf - gpg configuration useful options include use-agent, keyserver-options, default-cert-level, etc. =back =head1 CONFIGURATION FILE OPTIONS The configuration file is a perl script that sets values in the hash B<%CONFIG>. The file is generated when it does not exist. Example: $CONFIG{'owner'} = q{Peter Palfrader}; $CONFIG{'email'} = q{peter@palfrader.org}; $CONFIG{'keyid'} = [ qw{DE7AAF6E94C09C7F 62AF4031C82E0039} ]; =head2 Required basic settings =over =item B [string] Your name. B. =item B [string] Your email address, used in From: lines. B. =item B [list of keyids] A list of your keys. This is used to determine which signatures to keep in the pruning step. If you select a key using B<-u> it has to be in this list. B. =back =head2 General settings =over =item B [string] Base directory for the files caff stores. Default: B<$HOME/.caff/>. =back =head2 GnuPG settings =over =item B [string] Path to the GnuPG binary. Default: B. =item B [string] Path to the GnuPG binary which is used to sign keys. Default: what B is set to. =item B [string] Path to the GnuPG binary which is used to split off signatures. This was needed while the upstream GnuPG was not fixed. Default: what B is set to. =item B [string] Path to your secret keyring. Default: B<$HOME/.gnupg/secring.gpg>. =item B [keyid, or list of keyids] Additional keyids to encrypt messages to. Default: none. =item B [string] Additional commands to pass to gpg after the "sign" command. Default: none. =back =head2 Keyserver settings =over =item B [string] Keyserver to download keys from. Default: B. =item B [boolean] If true, then skip the step of fetching keys from the keyserver. Default: B<0>. =item B [list of files] A list of files containing keys to be imported. =back =head2 Signing settings =over =item B [boolean] If true, then skip the signing step. Default: B<0>. =item B [boolean] If true, then pause before continuing to the signing step. This is useful for offline signing. Default: B<0>. =item B [seconds] Don't export UIDs by default, on which your latest signature is older than this age. Default: B<24*60*60> (i.e. one day). =item B [keyid, or list of keyids] Select the key that is used for signing, in case you have more than one key. With multiple keyids, sign with each key in turn. =back =head2 Mail settings =over =item B [boolean] Whether to send mails. This is a quad-option, with which you can set the behaviour: yes always sends, no never sends; ask-yes and ask-no asks, for each uid, with according defaults for the question. Default: B. In any case, the messages are also written to $CONFIG{'caffhome'}/keys/ =item B [string] Email template which is used as the body text for the email sent out instead of the default text if specified. The following perl variables can be used in the template: =over =item B<{owner}> [string] Your name as specified in the L|/item_owner__5bstring_5d> setting. =item B<{key}> [string] The keyid of the key you signed. =item B<{@uids}> [array] The UIDs for which signatures are included in the mail. =back =item B [string] Add a Reply-To: header to messages sent. Default: none. =item B [string] Address to send blind carbon copies to when sending mail. Default: none. =item B [array] Parameters to pass to Mail::Mailer. This could for example be $CONFIG{'mailer-send'} = [ 'smtp', Server => 'mail.server', Auth => ['user', 'pass'] ]; to use the perl SMTP client or $CONFIG{'mailer-send'} = [ 'sendmail', '-o8' ]; to pass arguments to the sendmail program. For more information run C<< perldoc Mail::Mailer >>. Setting this option is strongly discouraged. Fix your local MTA instead. Default: none. =back =head1 AUTHORS =over =item Peter Palfrader =item Christoph Berg =back =head1 WEBSITE http://pgp-tools.alioth.debian.org/ =head1 SEE ALSO gpg(1), pgp-clean(1), /usr/share/doc/signing-party/caff/caffrc.sample. =cut use strict; use IO::Handle; use English; use File::Path; use File::Temp qw{tempdir}; use Text::Template; use MIME::Entity; use Encode; use Fcntl; use IO::Select; use Getopt::Long; use GnuPG::Interface; my %CONFIG; my $REVISION = '$Rev$'; my ($REVISION_NUMER) = $REVISION =~ /(\d+)/; my $VERSION = "0.0.0.$REVISION_NUMER"; ## # Display an error message on STDERR and then exit. # # @param $exitcode exit code status to use to end the program # @param $line error message to display on STDERR # sub myerror($$) { my ($exitcode, $line) = @_; print "[ERROR] $line\n"; exit $exitcode; }; sub mywarn($) { my ($line) = @_; print "[WARN] $line\n"; }; sub notice($) { my ($line) = @_; print "[NOTICE] $line\n"; }; sub info($) { my ($line) = @_; print "[INFO] $line\n"; }; sub debug($) { my ($line) = @_; #print "[DEBUG] $line\n"; }; sub trace($) { my ($line) = @_; #print "[trace] $line\n"; }; sub trace2($) { my ($line) = @_; #print "[trace2] $line\n"; }; sub generate_config() { notice("Error: \$LOGNAME is not set.\n") unless defined $ENV{'LOGNAME'}; my $gecos = defined $ENV{'LOGNAME'} ? (getpwnam($ENV{LOGNAME}))[6] : undef; my $email; my @keys; # BSD does not have hostname -f, so we try without -f first my $hostname = `hostname`; $hostname = `hostname -f` unless $hostname =~ /\./; chomp $hostname; my ($Cgecos,$Cemail,$Ckeys) = ('','',''); if (defined $gecos) { $gecos =~ s/,.*//; my $gpg = GnuPG::Interface->new(); $gpg->call( 'gpg' ); $gpg->options->hash_init( 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] ); $gpg->options->meta_interactive( 0 ); my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $gecos ]); my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; if ($stdout eq '') { warn ("No data from gpg for list-key\n"); # There should be at least 'tru:' everywhere. }; @keys = ($stdout =~ /^pub:[^r:]*:(?:[^:]*:){2,2}([^:]+):/mg); unless (scalar @keys) { info("Error: No keys were found using \"gpg --list-public-keys '$gecos'\"."); @keys = qw{0123456789abcdef 89abcdef76543210}; $Ckeys = '#'; } ($email) = ($stdout =~ /^uid:.*<(.+?@.+?)>.*:/m); unless (defined $email) { info("Error: No email address was found using \"gpg --list-public-keys '$gecos'\"."); $email = $ENV{'LOGNAME'}.'@'.$hostname; $Cemail = '#'; } } else { $gecos = 'Unknown Caff User'; $email = $ENV{'LOGNAME'}.'@'.$hostname; @keys = qw{0123456789abcdef 89abcdef76543210}; ($Cgecos,$Cemail,$Ckeys) = ('#','#','#'); }; my $template = < # # If you have a v4 key, it will simply be the last 16 digits of # your fingerprint. # # Example: # \$CONFIG{'keyid'} = [ qw{FEDCBA9876543210} ]; # or, if you have more than one key: # \$CONFIG{'keyid'} = [ qw{0123456789ABCDEF 89ABCDEF76543210} ]; $Ckeys\$CONFIG{'keyid'} = [ qw{@keys} ]; # Select this/these keys to sign with #\$CONFIG{'local-user'} = [ qw{@keys} ]; # Additionally encrypt messages for these keyids #\$CONFIG{'also-encrypt-to'} = [ qw{@keys} ]; # Mail template to use for the encrypted part #\$CONFIG{'mail-template'} = << 'EOM'; EOT $template .= "#$_" foreach ; $template .= "#EOM\n"; return $template; }; sub check_executable($$) { # (GnuPG::Interface gives lousy errors when the gpg binary isn't found, # so we want to check manually.) my ($purpose, $fn) = @_; # Only check provided fnames with a slash in them. return unless defined $fn; if ($fn =~ m!/!) { die ("$PROGRAM_NAME: $purpose executable '$fn' not found.\n") unless -x $fn; } else { for my $p (split(':', $ENV{PATH})) { return if -x "$p/$fn"; }; die ("$PROGRAM_NAME: $purpose executable '$fn' not found on path.\n") unless -x $fn; }; }; sub load_config() { my $config = $ENV{'HOME'} . '/.caffrc'; unless (-f $config) { print "No configfile $config present, I will use this template:\n"; my $template = generate_config(); print "$template\nPlease edit $config and run caff again.\n"; open F, ">$config" or die "$config: $!"; print F $template; close F; exit(1); } unless (scalar eval `cat $config`) { die "Couldn't parse $config: $EVAL_ERROR\n" if $EVAL_ERROR; }; $CONFIG{'caffhome'}=$ENV{'HOME'}.'/.caff' unless defined $CONFIG{'caffhome'}; die ("$PROGRAM_NAME: owner is not defined in $config.\n") unless defined $CONFIG{'owner'}; die ("$PROGRAM_NAME: email is not defined in $config.\n") unless defined $CONFIG{'email'}; die ("$PROGRAM_NAME: keyid is not defined in $config.\n") unless defined $CONFIG{'keyid'}; die ("$PROGRAM_NAME: keyid is not an array ref in $config.\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY'); for my $keyid (@{$CONFIG{'keyid'}}) { $keyid =~ /^[A-F0-9]{16}$/i or die ("$PROGRAM_NAME: key $keyid is not a long (16 digit) keyid in $config.\n"); }; @{$CONFIG{'keyid'}} = map { uc } @{$CONFIG{'keyid'}}; $CONFIG{'export-sig-age'}= 24*60*60 unless defined $CONFIG{'export-sig-age'}; $CONFIG{'keyserver'} = 'pool.sks-keyservers.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'}; check_executable("gpg", $CONFIG{'gpg'}); check_executable("gpg-sign", $CONFIG{'gpg-sign'}); check_executable("gpg-delsig", $CONFIG{'gpg-delsig'}); $CONFIG{'secret-keyring'} = ($ENV{'GNUPGHOME'} || "$ENV{'HOME'}/.gnupg") . '/secring.gpg' unless defined $CONFIG{'secret-keyring'}; $CONFIG{'no-download'} = 0 unless defined $CONFIG{'no-download'}; $CONFIG{'no-sign'} = 0 unless defined $CONFIG{'no-sign'}; $CONFIG{'key-files'} = () unless defined $CONFIG{'key-files'}; $CONFIG{'mailer-send'} = [] unless defined $CONFIG{'mailer-send'}; die ("$PROGRAM_NAME: mailer-send is not an array ref in $config.\n") unless (ref $CONFIG{'mailer-send'} eq 'ARRAY'); unless (defined $CONFIG{'mail-template'}) { $CONFIG{'mail-template'} .= $_ foreach ; } if ((defined $CONFIG{'also-encrypt-to'}) && ! (ref($CONFIG{'also-encrypt-to'}) eq 'ARRAY')) { $CONFIG{'also-encrypt-to'} = [ $CONFIG{'also-encrypt-to'} ]; }; }; sub make_gpg_fds() { my %fds = ( stdin => IO::Handle->new(), stdout => IO::Handle->new(), stderr => IO::Handle->new(), status => IO::Handle->new() ); my $handles = GnuPG::Handles->new( %fds ); return ($fds{'stdin'}, $fds{'stdout'}, $fds{'stderr'}, $fds{'status'}, $handles); }; sub readwrite_gpg($$$$$%) { my ($in, $inputfd, $stdoutfd, $stderrfd, $statusfd, %options) = @_; trace("Entering readwrite_gpg."); my ($first_line, undef) = split /\n/, $in; debug("readwrite_gpg sends ".(defined $first_line ? $first_line : "")); local $INPUT_RECORD_SEPARATOR = undef; my $sout = IO::Select->new(); my $sin = IO::Select->new(); my $offset = 0; trace("input is $inputfd; output is $stdoutfd; err is $stderrfd; status is ".(defined $statusfd ? $statusfd : 'undef')."."); $inputfd->blocking(0); $stdoutfd->blocking(0); $statusfd->blocking(0) if defined $statusfd; $stderrfd->blocking(0); $sout->add($stdoutfd); $sout->add($stderrfd); $sout->add($statusfd) if defined $statusfd; $sin->add($inputfd); my ($stdout, $stderr, $status) = ("", "", ""); my $exitwhenstatusmatches = $options{'exitwhenstatusmatches'}; trace("doing stuff until we find $exitwhenstatusmatches") if defined $exitwhenstatusmatches; my $readwrote_stuff_this_time = 0; my $do_not_wait_on_select = 0; my ($readyr, $readyw, $written); while ($sout->count() > 0 || (defined($sin) && ($sin->count() > 0))) { if (defined $exitwhenstatusmatches) { if ($status =~ /$exitwhenstatusmatches/m) { trace("readwrite_gpg found match on $exitwhenstatusmatches"); if ($readwrote_stuff_this_time) { trace("read/write some more\n"); $do_not_wait_on_select = 1; } else { trace("that's it in our while loop.\n"); last; } }; }; $readwrote_stuff_this_time = 0; trace("select waiting for ".($sout->count())." fds."); ($readyr, $readyw, undef) = IO::Select::select($sout, $sin, undef, $do_not_wait_on_select ? 0 : 1); trace("ready: write: ".(defined $readyw ? scalar @$readyw : 0 )."; read: ".(defined $readyr ? scalar @$readyr : 0)); for my $wfd (@$readyw) { $readwrote_stuff_this_time = 1; if (length($in) != $offset) { trace("writing to $wfd."); $written = $wfd->syswrite($in, length($in) - $offset, $offset); $offset += $written; }; if ($offset == length($in)) { trace("writing to $wfd done."); unless ($options{'nocloseinput'}) { close $wfd; trace("$wfd closed."); }; $sin->remove($wfd); $sin = undef; } } next unless (defined(@$readyr)); # Wait some more. for my $rfd (@$readyr) { $readwrote_stuff_this_time = 1; if ($rfd->eof) { trace("reading from $rfd done."); $sout->remove($rfd); close($rfd); next; } trace("reading from $rfd."); if ($rfd == $stdoutfd) { $stdout .= <$rfd>; trace2("stdout is now $stdout\n================"); next; } if (defined $statusfd && $rfd == $statusfd) { $status .= <$rfd>; trace2("status is now $status\n================"); next; } if ($rfd == $stderrfd) { $stderr .= <$rfd>; trace2("stderr is now $stderr\n================"); next; } } } trace("readwrite_gpg done."); return ($stdout, $stderr, $status); }; sub ask($$;$$) { my ($question, $default, $forceyes, $forceno) = @_; my $answer; my $yn = $default ? '[Y/n]' : '[y/N]'; while (1) { print $question,' ',$yn, ' '; if ($forceyes && $forceno) { print "$default (from config/command line)\n"; return $default; }; if ($forceyes) { print "YES (from config/command line)\n"; return 1; }; if ($forceno) { print "NO (from config/command line)\n"; return 0; }; $answer = ; if (!defined $answer) { $OUTPUT_AUTOFLUSH = 1; die "\n\n". "End of STDIN reached. Are you using xargs? Caff wants to read from STDIN,\n". "so you can't really use it with xargs. A patch against caff to read from\n". "the terminal would be appreciated.\n". "For now instead of cat keys | xargs caff do caff `cat keys`\n"; }; chomp $answer; last if ((length $answer == 0) || ($answer =~ m/^[yYnN]$/) ); print "What about $yn is so hard to understand?\nAnswer with either 'n' or 'y' or just press enter for the default.\n"; sleep 1; }; my $result = $default; $result = 1 if $answer =~ /y/i; $result = 0 if $answer =~ /n/i; return $result; }; my $KEYEDIT_PROMPT = '^\[GNUPG:\] GET_LINE keyedit.prompt'; my $KEYEDIT_DELUID_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.uid.okay'; my $KEYEDIT_DELSIG_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.delsig'; my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET_LINE keyedit.prompt)'; my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey'; load_config; my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/"; my $KEYSBASE = $CONFIG{'caffhome'}.'/keys'; my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome'; -d $KEYSBASE || mkpath($KEYSBASE , 0, 0700) or die ("Cannot create $KEYSBASE: $!\n"); -d $GNUPGHOME || mkpath($GNUPGHOME, 0, 0700) or die ("Cannot create $GNUPGHOME: $!\n"); my $NOW = time; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($NOW); my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday); sub version($) { my ($fd) = @_; print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n"; }; sub usage($$) { my ($fd, $exitcode) = @_; version($fd); print $fd "Usage: $PROGRAM_NAME [-eERS] [-m ] [-u ] [ ...]\n"; print $fd "Consult the manual page for more information.\n"; exit $exitcode; }; ###### # export key $keyid from $gnupghome ###### sub export_key($$) { my ($gnupghome, $keyid) = @_; my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); if (defined $gnupghome) { $gpg->options->hash_init( 'homedir' => $gnupghome, 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ], 'armor' => 1 ); } else { $gpg->options->hash_init( 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ], 'armor' => 1 ); }; $gpg->options->meta_interactive( 0 ); my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); my $pid = $gpg->export_keys(handles => $handles, command_args => [ $keyid ]); my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; return $stdout; }; ###### # import a key from the scalar $asciikey into a gpg homedirectory in $tempdir ###### sub import_key($$) { my ($gnupghome, $asciikey) = @_; my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init( 'homedir' => $gnupghome, 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ] ); $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) { return undef; }; return 1; }; ###### # Send an email to $address. If $can_encrypt is true then the mail # will be PGP/MIME encrypted to $longkeyid. # # $longkeyid, $uid, and @attached will be used in the email and the template. ###### #send_mail($address, $can_encrypt, $longkeyid, $uid, @attached); sub send_mail($$$@) { my ($address, $can_encrypt, $key_id, @keys) = @_; my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'}) or die "Error creating template: $Text::Template::ERROR"; my @uids; for my $key (@keys) { push @uids, $key->{'text'}; }; my $message = $template->fill_in(HASH => { key => $key_id, uids => \@uids, owner => $CONFIG{'owner'}}) or die "Error filling template in: $Text::Template::ERROR"; my $message_entity = MIME::Entity->build( Type => "text/plain", Charset => "utf-8", Disposition => 'inline', Data => $message); my @key_entities; for my $key (@keys) { $message_entity->attach( Type => "application/pgp-keys", Disposition => 'attachment', Encoding => "7bit", Description => "PGP Key 0x$key_id, uid ".($key->{'text'}).' ('.($key->{'serial'}).'), signed by 0x'.$CONFIG{'keyid'}[0], Data => $key->{'key'}, Filename => "0x$key_id.".$key->{'serial'}.".signed-by-0x".$CONFIG{'keyid'}[0].".asc"); }; if ($can_encrypt) { my $message = $message_entity->stringify(); my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init( 'homedir' => $GNUPGHOME, 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always } ], 'armor' => 1 ); $gpg->options->meta_interactive( 0 ); my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); $gpg->options->push_recipients( $key_id ); if (defined $CONFIG{'also-encrypt-to'}) { $gpg->options->push_recipients($_) foreach @{$CONFIG{'also-encrypt-to'}}; } my $pid = $gpg->encrypt(handles => $handles); my ($stdout, $stderr, $status) = readwrite_gpg($message, $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; if ($stdout eq '') { if (($status =~ /^\[GNUPG:\] INV_RECP ([0-9]+) ([0-9A-F]+)/m) and (defined $CONFIG{'also-encrypt-to'})) { my $reason = $1; my $keyid = $2; if (grep { $_ eq $keyid } @{$CONFIG{'also-encrypt-to'}}) { warn("Could not encrypt to $keyid, specified in CONFIG{'also-encrypt-to'}.\n". "Try to update the key using gpg --homedir=$GNUPGHOME --import \n". "or try the following if you are slightly more daring:\n". " gpg --export $keyid | gpg --homedir=$GNUPGHOME --import\n"); return; }; }; warn ("No data from gpg for encrypting mail. STDERR was:\n$stderr\nstatus output was:\n$status\n"); return; }; $message = $stdout; $message_entity = MIME::Entity->build( Type => 'multipart/encrypted; protocol="application/pgp-encrypted"', Encoding => '7bit'); $message_entity->attach( Type => "application/pgp-encrypted", Filename => "signedkey.msg", Disposition => 'attachment', Encoding => "7bit", Data => "Version: 1\n"); $message_entity->attach( Type => "application/octet-stream", Filename => 'msg.asc', Disposition => 'inline', Encoding => "7bit", Data => $message); }; $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id"); $message_entity->head->add("To", $address); $message_entity->head->add("From", '"'.Encode::encode('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>'); $message_entity->head->add("Sender", '"'.Encode::encode('MIME-Q', $CONFIG{'owner'}).'" <'.$CONFIG{'email'}.'>'); $message_entity->head->add("Reply-To", $CONFIG{'reply-to'}) if defined $CONFIG{'reply-to'}; $message_entity->head->add("Bcc", $CONFIG{'bcc'}) if defined $CONFIG{'bcc'}; $message_entity->head->add("User-Agent", $USER_AGENT); mywarn("You have set arguments to pass to Mail::Mailer. Better fix your MTA. (Also, Mail::Mailer's error reporting is non existant, so it won't tell you when it doesn't work.)") if (scalar @{$CONFIG{'mailer-send'}} > 0); $message_entity->send(@{$CONFIG{'mailer-send'}}); $message_entity->stringify(); }; ###### # clean up a UID so that it can be used on the FS. ###### sub sanitize_uid($) { my ($uid) = @_; my $good_uid = $uid; $good_uid =~ tr#/:\\#_#; trace2("[sanitize_uid] changed UID from $uid to $good_uid.\n") if $good_uid ne $uid; return $good_uid; }; sub delete_signatures($$$$$$) { my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $keyids) =@_; my $signed_by_me = 0; my ($stdout, $stderr, $status) = readwrite_gpg("delsig\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSIG_PROMPT, nocloseinput => 1); while($status =~ /$KEYEDIT_DELSIG_PROMPT/m) { # sig:?::17:EA2199412477CAF8:1058095214:::::13x: my @sigline = grep { /^sig/ } (split /\n/, $stdout); $stdout =~ s/\n/\\n/g; notice("[sigremoval] why are there ".(scalar @sigline)." siglines in that part of the dialog!? got: $stdout") if scalar @sigline >= 2; # XXX my $line = pop @sigline; my $answer = "no"; if (defined $line) { # only if we found a sig here - we never remove revocation packets for instance debug("[sigremoval] doing line $line."); my (undef, undef, undef, undef, $signer, $created, undef, undef, undef) = split /:/, $line; if ($signer eq $longkeyid) { debug("[sigremoval] selfsig ($signer)."); $answer = "no"; } elsif (grep { $signer eq $_ } @{$keyids}) { debug("[sigremoval] signed by us ($signer)."); $answer = "no"; $signed_by_me = $signed_by_me > $created ? $signed_by_me : $created; } else { debug("[sigremoval] not interested in that sig ($signer)."); $answer = "yes"; }; } else { debug("[sigremoval] no sig line here, only got: ".$stdout); }; ($stdout, $stderr, $status) = readwrite_gpg($answer."\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT, nocloseinput => 1); }; return $signed_by_me; }; ## # Check the local user keys. # # This function checks if the keyids defined through the --local-user # command line option or set in .caffrc are valid and known to be one of the # keyids listed in ./caffrc. The last check ensure we have those keyids # available in the caff's gnupghome directory. # # @return an array containing the local user keys\n # (undef) if no key has been specified # sub get_local_user_keys() { my @local_user = (); my @key_list; # No user-defined key id has been specified by the user, no need for # further checks if (!$CONFIG{'local-user'}) { return (undef); } # Parse the list of keys if (ref($CONFIG{'local-user'})) { @key_list = @{$CONFIG{'local-user'}}; } else { @key_list = split /\s*,\s*/, $CONFIG{'local-user'}; } # Check every key defined by the user... for my $user_key (@key_list) { $user_key =~ s/^0x//i; $user_key = uc($user_key); unless ($user_key =~ m/^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/) { mywarn "Local-user $user_key is not a valid keyid."; next; } unless (grep (/$user_key$/, @{$CONFIG{'keyid'}})) { mywarn "Local-user $user_key is not defined as one of your keyid in ./caffrc (it will not be used)."; next; } push (@local_user, $user_key); } # If no local-user key are valid, there is no need to go further unless (defined $local_user[0]) { myerror (1, "None of the local-user keys seem to be known as a keyid listed in ./caffrc."); } return @local_user; } ################### # argument handling ################### my @KEYIDS; my $params; Getopt::Long::config('bundling'); if (!GetOptions ( '-h' => \$params->{'help'}, '--help' => \$params->{'help'}, '--version' => \$params->{'version'}, '-V' => \$params->{'version'}, '-u=s' => \$params->{'local-user'}, '--local-user=s' => \$params->{'local-user'}, '-e' => \$params->{'export-old'}, '--export-old' => \$params->{'export-old'}, '-E' => \$params->{'no-export-old'}, '--no-export-old' => \$params->{'no-export-old'}, '-m:s' => \$params->{'mail'}, '--mail:s' => \$params->{'mail'}, '-M' => \$params->{'no-mail'}, '--no-mail' => \$params->{'no-mail'}, '-R' => \$params->{'no-download'}, '--no-download' => \$params->{'no-download'}, '-S' => \$params->{'no-sign'}, '--no-sign' => \$params->{'no-sign'}, '--key-file=s@' => \$params->{'key-files'}, )) { usage(\*STDERR, 1); }; if ($params->{'help'}) { usage(\*STDOUT, 0); }; if ($params->{'version'}) { version(\*STDOUT); exit(0); }; usage(\*STDERR, 1) unless scalar @ARGV >= 1; $CONFIG{'local-user'} = $params->{'local-user'} if defined $params->{'local-user'}; $CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'}; $CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'}; $CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'}; $CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'}; # If old 'no-mail' parameter, or if the 'mail' parameter is set to 'no' if ( defined $CONFIG{'no-mail'} || ( defined $CONFIG{'mail'} && $CONFIG{'mail'} eq 'no' ) ) { $CONFIG{'mail'} = 'no'; } elsif ( !defined $CONFIG{'mail'} ) { $CONFIG{'mail'} = 'ask-yes'; } push @{$CONFIG{'key-files'}}, @{$params->{'key-files'}} if defined $params->{'key-files'}; for my $keyid (map { split /\n/ } @ARGV) { # caff "`cat txt`" is a single argument $keyid =~ s/^0x//i; $keyid =~ s/ //g; # gpg --fingerprint includes spaces if ($keyid =~ /^[A-F0-9]{32}$/i) { info("Ignoring v3 fingerprint $keyid. v3 keys are obsolete."); next; }; if ($keyid !~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) { print STDERR "$keyid is not a keyid.\n"; usage(\*STDERR, 1); }; push @KEYIDS, uc($keyid); }; ################# # import own keys ################# for my $keyid (@{$CONFIG{'keyid'}}) { info("Importing key $keyid from your normal GnuPGHome."); my $key = export_key(undef, $keyid); if (!defined $key || $key eq '') { warn ("Did not get key $keyid from your normal GnuPGHome\n"); next; }; my $result = import_key($GNUPGHOME, $key); unless ($result) { warn ("Could not import $keyid into caff's gnupghome.\n"); next; }; } ######################## # import keys from files ######################## foreach my $keyfile (@{$CONFIG{'key-files'}}) { my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init('homedir' => $GNUPGHOME); $gpg->options->meta_interactive( 0 ); my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); my $pid = $gpg->import_keys(handles => $handles, command_args => $keyfile); my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); info ("Importing keys from $keyfile"); waitpid $pid, 0; if ($status !~ /^\[GNUPG:\] IMPORT_OK/m) { warn $stderr; } } ############################# # receive keys from keyserver ############################# my @keyids_ok; if ($CONFIG{'no-download'}) { @keyids_ok = @KEYIDS; } else { info ("fetching keys, this will take a while..."); my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init( 'homedir' => $GNUPGHOME, 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always }, '--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; # [GNUPG:] IMPORT_OK 0 5B00C96D5D54AEE1206BAF84DE7AAF6E94C09C7F # [GNUPG:] NODATA 1 # [GNUPG:] NODATA 1 # [GNUPG:] IMPORT_OK 0 25FC1614B8F87B52FF2F99B962AF4031C82E0039 my %local_keyids = map { $_ => 1 } @KEYIDS; my $had_v3_keys = 0; for my $line (split /\n/, $status) { if ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{40})/) { my $imported_key = $1; my $whole_fpr = $imported_key; my $long_keyid = substr($imported_key, -16); my $short_keyid = substr($imported_key, -8); my $speced_key; for my $spec (($whole_fpr, $long_keyid, $short_keyid)) { $speced_key = $spec if $local_keyids{$spec}; }; unless ($speced_key) { notice ("Imported unexpected key; got: $imported_key\n"); next; }; debug ("Imported $imported_key for $speced_key"); delete $local_keyids{$speced_key}; unshift @keyids_ok, $imported_key; } elsif ($line =~ /^\[GNUPG:\] (NODATA|IMPORT_RES|IMPORTED) /) { } elsif ($line =~ /^\[GNUPG:\] IMPORT_OK \d+ ([0-9A-F]{32})/) { my $imported_key = $1; 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."); $had_v3_keys = 1; } else { notice ("got unknown reply from gpg: $line"); } }; if (scalar %local_keyids) { notice ("Import failed for: ". (join ' ', keys %local_keyids)."." . ($had_v3_keys ? " (Or maybe it's one of those ugly v3 keys?)" : "")); exit 1 unless ask ("Some keys could not be imported - continue anyway?", 0); if (scalar keys %local_keyids == 1) { mywarn("Assuming ". (join ' ', keys %local_keyids)." is a fine keyid."); } else { mywarn("Assuming ". (join ' ', keys %local_keyids)." are fine keyids."); }; push @keyids_ok, keys %local_keyids; } }; unless (@keyids_ok) { notice ("No keys to sign found"); exit 0; } ########### # sign keys ########### if ($CONFIG{'ask-sign'} && ! $CONFIG{'no-sign'}) { $CONFIG{'no-sign'} = ! ask("Continue with signing?", 1); } unless ($CONFIG{'no-sign'}) { my @local_user = &get_local_user_keys(); info("Sign the following keys according to your policy, then exit gpg with 'save' after signing each key"); for my $keyid (@keyids_ok) { foreach my $local_user (@local_user) { my @command; push @command, $CONFIG{'gpg-sign'}; push @command, '--local-user', $local_user if (defined $local_user); push @command, "--homedir=$GNUPGHOME"; push @command, '--secret-keyring', $CONFIG{'secret-keyring'}; push @command, '--no-auto-check-trustdb'; push @command, '--trust-model=always'; push @command, '--edit', $keyid; push @command, 'sign'; push @command, split ' ', $CONFIG{'gpg-sign-args'} || ""; print join(' ', @command),"\n"; system (@command); }; }; }; ################## # export and prune ################## KEYS: for my $keyid (@keyids_ok) { # get key listing ################# my $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg'} ); $gpg->options->hash_init( 'homedir' => $GNUPGHOME, 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode } ] ); $gpg->options->meta_interactive( 0 ); my ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); my $pid = $gpg->list_public_keys(handles => $handles, command_args => [ $keyid ]); my ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; if ($stdout eq '') { warn ("No data from gpg for list-key $keyid\n"); next; }; my @publine = grep { /^pub/ } (split /\n/, $stdout); if (scalar @publine == 0) { warn ("No public keys found with list-key $keyid (note that caff uses its own keyring in $GNUPGHOME).\n"); next; }; my (undef, undef, undef, undef, $longkeyid, undef, undef, undef, undef, undef, undef, $flags) = split /:/, pop @publine; if (scalar @publine > 0) { warn ("More than one key matched $keyid. Try to specify the long keyid or fingerprint\n"); next; }; unless (defined $longkeyid) { warn ("Didn't find public keyid in --list-key of key $keyid.\n"); next; }; unless (defined $flags) { warn ("Didn't find flags in --list-key of key $keyid.\n"); next; }; my $can_encrypt = $flags =~ /E/; # export the key ################ my $asciikey = export_key($GNUPGHOME, $keyid); if ($asciikey eq '') { warn ("No data from gpg for export $keyid\n"); next; }; my @UIDS; my $uid_number = 0; while (1) { my $this_uid_text = ''; $uid_number++; debug("Doing key $keyid, uid $uid_number"); my $tempdir = tempdir( "caff-$keyid-XXXXX", DIR => '/tmp/', CLEANUP => 1); # import into temporary gpghome ############################### my $result = import_key($tempdir, $asciikey); unless ($result) { warn ("Could not import $keyid into temporary gnupg.\n"); next; }; # prune it ########## $gpg = GnuPG::Interface->new(); $gpg->call( $CONFIG{'gpg-delsig'} ); $gpg->options->hash_init( 'homedir' => $tempdir, 'extra_args' => [ qw{ --no-auto-check-trustdb --trust-model=always --with-colons --fixed-list-mode --command-fd=0 --no-tty } ] ); ($inputfd, $stdoutfd, $stderrfd, $statusfd, $handles) = make_gpg_fds(); $pid = $gpg->wrap_call( commands => [ '--edit' ], command_args => [ $keyid ], handles => $handles ); debug("Starting edit session"); ($stdout, $stderr, $status) = readwrite_gpg('', $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # delete other uids ################### my $number_of_subkeys = 0; my $i = 1; my $have_one = 0; my $is_uat = 0; my $delete_some = 0; debug("Parsing stdout output."); for my $line (split /\n/, $stdout) { debug("Checking line $line"); my ($type, undef, undef, undef, undef, undef, undef, undef, undef, $uidtext) = split /:/, $line; if ($type eq 'sub') { $number_of_subkeys++; }; next unless ($type eq 'uid' || $type eq 'uat'); debug("line is interesting."); if ($uid_number != $i) { debug("mark for deletion."); readwrite_gpg("$i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); $delete_some++; } else { debug("keep it."); $have_one = 1; $this_uid_text = ($type eq 'uid') ? $uidtext : '[attribute]'; $is_uat = $type eq 'uat'; }; $i++; }; debug("Parsing stdout output done."); unless ($have_one) { debug("Uid ".($uid_number-1)." was the last, there is no $uid_number."); info("key $keyid done."); last; }; my $prune_some_sigs_on_uid; my $prune_all_sigs_on_uid; if ($is_uat) { debug("handling attribute userid of key $keyid."); if ($uid_number == 1) { debug(" attribute userid is #1, unmarking #2 for deletion."); readwrite_gpg("2\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); $delete_some--; $prune_some_sigs_on_uid = 1; $prune_all_sigs_on_uid = 2; } else { debug("attribute userid is not #1, unmarking #1 for deletion."); readwrite_gpg("1\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); $delete_some--; $prune_some_sigs_on_uid = 2; $prune_all_sigs_on_uid = 1; }; } else { $prune_some_sigs_on_uid = 1; }; if ($delete_some) { debug("need to delete $delete_some uids."); readwrite_gpg("deluid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELUID_PROMPT, nocloseinput => 1); readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); }; # delete subkeys ################ if ($number_of_subkeys > 0) { for (my $i=1; $i<=$number_of_subkeys; $i++) { readwrite_gpg("key $i\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); }; readwrite_gpg("delkey\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_DELSUBKEY_PROMPT, nocloseinput => 1); readwrite_gpg("yes\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); }; # delete signatures ################### readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig my $signed_by_me = delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, $CONFIG{'keyid'}); readwrite_gpg("$prune_some_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig if (defined $prune_all_sigs_on_uid) { readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # mark uid for delsig delete_signatures($inputfd, $stdoutfd, $stderrfd, $statusfd, $longkeyid, []); readwrite_gpg("$prune_all_sigs_on_uid\n", $inputfd, $stdoutfd, $stderrfd, $statusfd, exitwhenstatusmatches => $KEYEDIT_PROMPT, nocloseinput => 1); # unmark uid from delsig }; readwrite_gpg("save\n", $inputfd, $stdoutfd, $stderrfd, $statusfd); waitpid $pid, 0; my $asciikey = export_key($tempdir, $keyid); if ($asciikey eq '') { warn ("No data from gpg for export $keyid\n"); next; }; if ($signed_by_me) { if ($NOW - $signed_by_me > $CONFIG{'export-sig-age'} ) { my $write = ask("Signature on $this_uid_text is old. Export?", 0, $params->{'export-old'}, $params->{'no-export-old'}); next unless $write; }; my $keydir = "$KEYSBASE/$DATE_STRING"; -d $keydir || mkpath($keydir , 0, 0700) or die ("Cannot create $keydir $!\n"); my $keyfile = "$keydir/$longkeyid.key.$uid_number.".sanitize_uid($this_uid_text).".asc"; open (KEY, ">$keyfile") or die ("Cannot open $keyfile: $!\n"); print KEY $asciikey; close KEY; push @UIDS, { text => $this_uid_text, key => $asciikey, serial => $uid_number, "is_uat" => $is_uat }; info("$longkeyid $uid_number $this_uid_text done."); } else { info("$longkeyid $uid_number $this_uid_text is not signed by me, not writing."); }; }; if (scalar @UIDS == 0) { info("found no signed uids for $keyid"); } else { next if ($CONFIG{'mail'} eq 'no'); # do not send mail my @attached; for my $uid (@UIDS) { trace("UID: $uid->{'text'}\n"); if ($uid->{'is_uat'}) { my $attach = ask("UID $uid->{'text'} is an attribute UID, attach it to every email sent?", 1); push @attached, $uid if $attach; } elsif ($uid->{'text'} !~ /@/) { my $attach = ask("UID $uid->{'text'} is no email address, attach it to every email sent?", 1); push @attached, $uid if $attach; }; }; notice("Key has no encryption capabilities, mail will be sent unencrypted") unless $can_encrypt; for my $uid (@UIDS) { if (!$uid->{'is_uat'} && ($uid->{'text'} =~ /@/)) { my $address = $uid->{'text'}; $address =~ s/.*<(.*)>.*/$1/; if (ask("Mail signature for $uid->{'text'} to '$address'?", $CONFIG{'mail'} ne 'ask-no', $CONFIG{'mail'} eq 'yes')) { my $mail = send_mail($address, $can_encrypt, $longkeyid, $uid, @attached); if (defined $mail) { my $keydir = "$KEYSBASE/$DATE_STRING"; my $mailfile = "$keydir/$longkeyid.mail.".$uid->{'serial'}.".".sanitize_uid($uid->{'text'}); open (KEY, ">$mailfile") or die ("Cannot open $mailfile: $!\n"); print KEY $mail; close KEY; } else { warn "Generating mail failed.\n"; }; }; }; }; }; }; ########################### # the default mail template ########################### __DATA__ Hi, please find attached the user id{(scalar @uids >= 2 ? 's' : '')} {foreach $uid (@uids) { $OUT .= "\t".$uid."\n"; };}of your key {$key} signed by me. If you have multiple user ids, I sent the signature for each user id separately to that user id's associated email address. You can import the signatures by running each through `gpg --import`. Note that I did not upload your key to any keyservers. If you want this new signature to be available to others, please upload it yourself. With GnuPG this can be done using gpg --keyserver pool.sks-keyservers.net --send-key {$key} If you have any questions, don't hesitate to ask. Regards, {$owner}