--- /usr/local/bin/caff 2009-07-25 14:03:04.000000000 +0200 +++ caff-hack.pl 2009-07-25 16:56:15.000000000 +0200 @@ -1,7 +1,7 @@ #!/usr/bin/perl -w # caff -- CA - Fire and Forget -# $Id: caff 386 2008-06-14 15:48:25Z thijs $ +# $Id: caff-hack.pl,v 1.4 2009/07/25 14:48:38 fk Exp fk $ # # Copyright (c) 2004, 2005, 2006 Peter Palfrader # Copyright (c) 2005, 2006 Christoph Berg @@ -51,7 +51,7 @@ 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. +to verify that it belongs to the recipient. =head1 OPTIONS @@ -284,6 +284,24 @@ Setting this option is strongly discouraged. Fix your local MTA instead. Default: none. +Mutual exclusive with B. + +=item B [string] + +Command line to pass the signed key to a MUA in +the same way a browser would do it. +This could for example be + + $CONFIG{'mailto-cmd'} = "claws-mail --compose 'mailto:%a?subject=%S&bcc=%b&body=%B'"; + +Supported placeholders are %a (email adress), %S (subject), +%b (bcc address) and %B (signed key). Be sure to put any text +that contains placeholders in single quotes. + +If this options is used, the template and most options that +would affect mail handling are ignored. +Default: none. +Mutual exclusive with B. =back @@ -319,6 +337,7 @@ use IO::Select; use Getopt::Long; use GnuPG::Interface; +use strict; my %CONFIG; my $REVISION = '$Rev: 386 $'; @@ -488,6 +507,8 @@ $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'}; + die "$PROGRAM_NAME: Mutual exclusive config options mailer-send and mailto-cmd used at the same time.\n" + if (defined $CONFIG{'mailer-send'} and defined $CONFIG{'mailto-cmd'}); $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'}) { @@ -733,6 +754,15 @@ return 1; }; +sub send_mail($$$@) { + my ($address, $can_encrypt, $key_id, @keys) = @_; + + if (defined $CONFIG{'mailto-cmd'}) { + send_mailto($address, $CONFIG{'mailto-cmd'}, $key_id, @keys); + } else { + send_mime_mail($address, $can_encrypt, $key_id, @keys); + } +} ###### # Send an email to $address. If $can_encrypt is true then the mail @@ -740,8 +770,8 @@ # # $longkeyid, $uid, and @attached will be used in the email and the template. ###### -#send_mail($address, $can_encrypt, $longkeyid, $uid, @attached); -sub send_mail($$$@) { +#send_mime_mail($address, $can_encrypt, $longkeyid, $uid, @attached); +sub send_mime_mail($$$@) { my ($address, $can_encrypt, $key_id, @keys) = @_; my $template = Text::Template->new(TYPE => 'STRING', SOURCE => $CONFIG{'mail-template'}) @@ -839,6 +869,62 @@ }; ###### +# Call the user's MUA like browsers do. +# +# $longkeyid, $uid, and @attached will be used in the email, +# the key is passed as mail body and the template is ignored. +###### +#send_mailto($address, $mailto_cmd, $longkeyid, $uid, @attached); +sub send_mailto($$$@) { + my ($address, $mailto_cmd, $key_id, @keys) = @_; + + my @uids; + for my $key (@keys) { + push @uids, $key->{'text'}; + }; + + my $body = ''; + my @key_entities; + for my $key (@keys) { + $body .= $key->{'key'} . "\n"; + }; + + my $subject = 'Your PGP key 0x' . $key_id . ' signed by 0x' . $CONFIG{'keyid'}[0]; + my $bcc = defined $CONFIG{'bcc'} ? $CONFIG{'bcc'} : ''; + + my %place_holders = ( + '%a' => $address, + '%b' => $bcc, + '%S' => $subject, + '%B' => $body + ); + + # Replace place holders + foreach my $place_holder (keys %place_holders) { + + my $replacement = $place_holders{$place_holder}; + my $allowed_characters = '-=\dA-Za-z~{}:.\/();\s,+@"_%\?&*^'; + + unless ($place_holder =~ /^[$allowed_characters]*$/) { + die "Forbidden characters in $place_holder"; + } + + $replacement =~ s@[\n\s]*$@@; + + # Excape new lines and spaces + $replacement =~ s@\n@%0D%0A@g; + $replacement =~ s@ @%20@g; + + $mailto_cmd =~ s@$place_holder@$replacement@g; + } + + my $output = `$mailto_cmd`; + + die "Composing mail with $mailto_cmd failed: $output\n" if ($?); +}; + + +###### # clean up a UID so that it can be used on the FS. ###### sub sanitize_uid($) {