X-Git-Url: http://git.sthu.org/?a=blobdiff_plain;f=caff%2Fcaff;h=2fc095df8e093460da63584fc4a7bbccdd6179f1;hb=88e91c7dab59944a9463696712fbfee3602bf7fa;hp=302bf60c8dbcccd10696f39d8a59ced03b81dacd;hpb=7f34e1c8664e595f83414802a730988e4a07953e;p=pgp-tools.git diff --git a/caff/caff b/caff/caff index 302bf60..2fc095d 100755 --- a/caff/caff +++ b/caff/caff @@ -4,7 +4,7 @@ # $Id$ # # Copyright (c) 2004, 2005 Peter Palfrader -# Copyright (c) 2005 Christoph Berg +# Copyright (c) 2005, 2006 Christoph Berg # # All rights reserved. # @@ -50,7 +50,8 @@ 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. +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 @@ -97,11 +98,20 @@ Import keys from file. Can be supplied more than once. =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, 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: @@ -193,6 +203,10 @@ This is useful for offline signing. Default: B<0>. 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 [string] + +Select the key that is used for signing, in case you have more than one key. + =head2 Mail settings =item B [boolean] @@ -226,11 +240,32 @@ 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 @@ -247,6 +282,10 @@ Default: none. 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; @@ -266,20 +305,141 @@ my $REVISION = '$Rev$'; my ($REVISION_NUMER) = $REVISION =~ /(\d+)/; my $VERSION = "0.0.0.$REVISION_NUMER"; + + +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) = ('#','#','#'); + }; + + return < +# +# 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} ]; +EOT +}; + +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'; - -f $config or die "No file $config present. See caff(1).\n"; + 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 ("owner is not defined.\n") unless defined $CONFIG{'owner'}; - die ("email is not defined.\n") unless defined $CONFIG{'email'}; - die ("keyid is not defined.\n") unless defined $CONFIG{'keyid'}; - die ("keyid is not an array ref\n") unless (ref $CONFIG{'keyid'} eq 'ARRAY'); + 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 ("key $keyid is not a long (16 digit) keyid.\n"); + $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'}; @@ -287,10 +447,15 @@ sub load_config() { $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{'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'); $CONFIG{'mail-template'} = <<'EOM' unless defined $CONFIG{'mail-template'}; Hi, @@ -315,27 +480,6 @@ Regards, EOM }; -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 make_gpg_fds() { my %fds = ( stdin => IO::Handle->new(), @@ -448,8 +592,9 @@ sub readwrite_gpg($$$$$%) { sub ask($$;$$) { my ($question, $default, $forceyes, $forceno) = @_; my $answer; + my $yn = $default ? '[Y/n]' : '[y/N]'; while (1) { - print $question,' ',($default ? '[Y/n]' : '[y/N]'), ' '; + print $question,' ',$yn, ' '; if ($forceyes && $forceno) { print "$default (from config/command line)\n"; return $default; @@ -464,9 +609,17 @@ sub ask($$;$$) { }; $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 ((defined $answer) && (length $answer <= 1)); - print "grrrrrr.\n"; + 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; @@ -486,7 +639,7 @@ my $KEYEDIT_KEYEDIT_OR_DELSIG_PROMPT = '^\[GNUPG:\] (GET_BOOL keyedit.delsig|GET my $KEYEDIT_DELSUBKEY_PROMPT = '^\[GNUPG:\] GET_BOOL keyedit.remove.subkey'; load_config; -my $USER_AGENT = "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al."; +my $USER_AGENT = "caff $VERSION - http://pgp-tools.alioth.debian.org/"; my $KEYSBASE = $CONFIG{'caffhome'}.'/keys'; my $GNUPGHOME = $CONFIG{'caffhome'}.'/gnupghome'; @@ -501,7 +654,7 @@ my $DATE_STRING = sprintf("%04d-%02d-%02d", $year+1900, $mon+1, $mday); sub version($) { my ($fd) = @_; - print $fd "caff $VERSION - (c) 2004, 2005 Peter Palfrader et al.\n"; + print $fd "caff $VERSION - (c) 2004, 2005, 2006 Peter Palfrader et al.\n"; }; sub usage($$) { @@ -624,7 +777,8 @@ sub send_mail($$$@) { $message = $stdout; $message_entity = MIME::Entity->build( - Type => 'multipart/encrypted; protocol="application/pgp-encrypted"'); + Type => 'multipart/encrypted; protocol="application/pgp-encrypted"', + Encoding => '7bit'); $message_entity->attach( Type => "application/pgp-encrypted", @@ -643,9 +797,11 @@ sub send_mail($$$@) { $message_entity->head->add("Subject", "Your signed PGP key 0x$key_id"); $message_entity->head->add("To", $address); $message_entity->head->add("From", '"'.$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); - $message_entity->send(); + 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(); }; @@ -739,13 +895,18 @@ if ($params->{'version'}) { }; 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-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'}; +$CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'}; +$CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'}; +push @{$CONFIG{'key-files'}}, @{$params->{'key-files'}} if defined $params->{'key-files'}; - -if ($params->{'local-user'}) { - $USER = $params->{'local-user'}; +if ($CONFIG{'local-user'}) { + $USER = $CONFIG{'local-user'}; $USER =~ s/^0x//i; unless ($USER =~ /^([A-F0-9]{8}|[A-F0-9]{16}|[A-F0-9]{40})$/i) { - print STDERR "-u $USER is not a keyid.\n"; + print STDERR "Local-user $USER is not a keyid.\n"; usage(\*STDERR, 1); }; $USER = uc($USER); @@ -764,13 +925,6 @@ for my $keyid (@ARGV) { push @KEYIDS, uc($keyid); }; -$CONFIG{'no-download'} = $params->{'no-download'} if defined $params->{'no-download'}; -$CONFIG{'no-mail'} = $params->{'no-mail'} if defined $params->{'no-mail'}; -$CONFIG{'mail'} = $params->{'mail'} if defined $params->{'mail'}; -$CONFIG{'no-sign'} = $params->{'no-sign'} if defined $params->{'no-sign'}; -push @{$CONFIG{'key-files'}}, @{$params->{'key-files'}} if defined $params->{'key-files'}; - - ################# # import own keys ################# @@ -847,6 +1001,7 @@ if ($CONFIG{'no-download'}) { # [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; @@ -865,13 +1020,23 @@ if ($CONFIG{'no-download'}) { 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)."."); + 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 %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; } };