Add pubkey importing support

diff --git a/MANIFEST b/MANIFEST
index 79df2cd63edee102698c598c001f8482dfb0b499..efd5329cbcf94a030dbb98692dee5b378b9a7bf1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5,6 +5,7 @@ Makefile.PL
 MANIFEST
 README
 t/App-EdwardNG.t
+t/data/contains-pubkey
 t/data/inline-encrypted
 t/data/inline-signed
 t/data/inline-signed-encrypted
@@ -17,6 +18,7 @@ t/keydir/trustdb.gpg
 share/tmpl/en/encrypt
 share/tmpl/en/encrypt_error
 share/tmpl/en/error
+share/tmpl/en/keys
 share/tmpl/en/plain
 share/tmpl/en/sign
 share/tmpl/en/sign_error

diff --git a/lib/App/EdwardNG.pm b/lib/App/EdwardNG.pm
index f6b54a4254cffe720246bd503447c89763f024ac..94a5a200c2ed29c51e7c9f4b74ed2a3a24faa0b6 100644 (file)
--- a/lib/App/EdwardNG.pm
+++ b/lib/App/EdwardNG.pm
@@ -5,12 +5,13 @@ use strict;
 use warnings;
 use parent qw/Exporter/;
 our $VERSION = '0.001';
-our @EXPORT = qw/process_message/;
+our @EXPORT_OK = qw/import_pubkeys process_message/;
 
 use Email::Sender::Simple qw/sendmail/;
 use File::Share qw/dist_file/;
 use File::Slurp qw/read_file/;
 use File::Spec::Functions qw/rel2abs/;
+use IO::Handle;
 use Getopt::Long;
 use MIME::Entity;
 use MIME::Parser;
@@ -31,18 +32,41 @@ sub mg {
                @_);
 }
 
+sub mp {
+       my $parser = MIME::Parser->new;
+       $parser->decode_bodies($_[0] // 0);
+       $parser->output_to_core(1);
+       $parser
+}
+
 sub first_part{
        my ($ent) = @_;
        return first_part ($ent->parts(0)) if $ent->parts;
        stringify [$ent->bodyhandle->as_lines]
 }
 
+sub import_pubkeys {
+       my ($ent, $mg) = @_;
+       my @keys;
+       if ($ent->mime_type eq 'application/pgp-keys') {
+               $ent = mp(1)->parse_data($ent->stringify);
+               my $gpg = GnuPG::Interface->new;
+               $mg->_set_options($gpg);
+               $gpg->options->quiet(1);
+               my ($input, $status) = (IO::Handle->new, IO::Handle->new);
+               my $pid = $gpg->import_keys(handles => GnuPG::Handles->new(stdin => $input, status => $status));
+               my $read = Mail::GnuPG::_communicate([$status], [$input], {$input => $ent->bodyhandle->as_string});
+               push @keys, map { /IMPORT_OK \d+ (\w+)/ } $read->{$status};
+               waitpid $pid, 0
+       }
+       push @keys, import_pubkeys ($_, $mg) for $ent->parts;
+       @keys
+}
+
 sub process_message {
        my ($in) = @_;
        my $msg;
-       my $parser = MIME::Parser->new;
-       $parser->decode_bodies(0);
-       $parser->output_to_core(1);
+       my $parser = mp;
 
        $msg =                      $in   if     ref $in eq 'MIME::Entity';
        $msg = $parser->parse      ($in)  if     ref $in eq 'IO';
@@ -104,11 +128,10 @@ sub run {
        my $tmpl_path = $ENV{EDWARDNG_TMPL_PATH} // 'en';
        open STDERR, '>>', $ENV{EDWARDNG_LOGFILE} if $ENV{EDWARDNG_LOGFILE};
 
-       my $parser = MIME::Parser->new;
-       $parser->decode_bodies(0);
-       $parser->output_to_core(1);
-       my $in = $parser->parse(\*STDIN);
+       my $in = mp->parse(\*STDIN);
        debug 'Received mail from ', $in->get('From');
+       my @keys = import_pubkeys $in, mg;
+       say 'Found keys: ', join ' ', @keys if @keys;
 
        my ($tmpl, %params);
        try {
@@ -121,13 +144,14 @@ sub run {
        $params{plaintext} = first_part $params{decrypted} if $params{decrypted};
 
        my $tt = Template->new(INCLUDE_PATH => rel2abs $tmpl_path, dist_file 'App-EdwardNG', 'tmpl');
-       my $data;
-       $tt->process($tmpl, \%params, \$data);
+       my ($keys, $result) = ('', '');
+       $tt->process('keys', {keys => \@keys}, \$keys) if @keys;
+       $tt->process($tmpl, \%params, \$result);
        my $email = MIME::Entity->build(
                From    => $ENV{EDWARDNG_FROM},
                To      => $in->get('From'),
                Subject => 'Re: ' . $in->get('Subject'),
-               Data    => $data);
+               Data    => $keys.$result);
 
        my $email_unencrypted = $email->dup;
        my $mg = mg always_trust => 1;
@@ -171,7 +195,19 @@ App::EdwardNG - GnuPG email sign/encrypt testing bot
 
 EdwardNG is a reimplementation of the Edward reply bot referenced in L<https://emailselfdefense.fsf.org/>.
 
-This module exports a single function, B<process_message>, which takes a single parameter representing the message. This parameter can be:
+=head1 EXPORTS
+
+None by default.
+
+=head2 B<import_keys>(I<$entity>, I<$gpg>)
+
+Scan a message for PGP public keys, and import them. I<$entity> is a L<MIME::Entity> to scan, I<$gpg> is a L<Mail::GnuPG> instance.
+
+Returns a list of fingerprints of keys found.
+
+=head2 B<process_message>(I<$message>)
+
+Analyze a message, looking for PGP signatures and encryption. I<$message> can be:
 
 =over
 
@@ -181,7 +217,7 @@ This module exports a single function, B<process_message>, which takes a single
 
 =item A scalar which represents a path to a message.
 
-=item A L<MIME::Entity> object
+=item A L<MIME::Entity> object created with decode_bodies(0)
 
 =back
 

diff --git a/share/tmpl/en/keys b/share/tmpl/en/keys
new file mode 100644 (file)
index 0000000..61a0ec5
--- /dev/null
+++ b/share/tmpl/en/keys
@@ -0,0 +1,4 @@
+Found and imported keys:
+[% FOREACH key = keys -%]
+[% key %]
+[% END %]

diff --git a/t/App-EdwardNG.t b/t/App-EdwardNG.t
index 4b4550eed576672e7135dfdc550e4eb78843cf3d..015e054d68898892171dda131067a2120a5c460a 100644 (file)
--- a/t/App-EdwardNG.t
+++ b/t/App-EdwardNG.t
@@ -5,16 +5,20 @@ use warnings;
 use constant KEYID => '34B22806';
 use constant EMAIL => 'EdwardNG (Key for testing EdwardNG) <edwardng@ieval.ro>';
 
-use Test::More tests => 19;
-BEGIN { use_ok('App::EdwardNG') };
+use Test::More tests => 20;
+BEGIN { use_ok('App::EdwardNG', qw/import_pubkeys process_message/) };
 $ENV{EDWARDNG_DEBUG} = $ENV{TEST_VERBOSE};
 $ENV{EDWARDNG_KEYDIR} = 't/keydir';
 
+my $contains_pubkey = App::EdwardNG::mp->parse_open('t/data/contains-pubkey');
+my @keys = import_pubkeys ($contains_pubkey, App::EdwardNG::mg);
+is $keys[0], 'DE12658069C2F09BF996CC855AAF79E969137654', 'import_pubkeys';
+
 my ($tmpl, %params);
 
 sub process {
        my ($name, $expected) = @_;
-       ($tmpl, %params) = App::EdwardNG::process_message("t/data/$name");
+       ($tmpl, %params) = process_message("t/data/$name");
        is $tmpl, $expected, "Result for $name is $expected" or diag "GnuPG said: $params{message}"
 }
 

diff --git a/t/data/contains-pubkey b/t/data/contains-pubkey
new file mode 100644 (file)
index 0000000..59680cc
--- /dev/null
+++ b/t/data/contains-pubkey
@@ -0,0 +1,77 @@
+From: Marius Gavrilescu <marius@ieval.ro>
+To: marius@ieval.ro
+Subject: Contains pubkey
+Date: Thu, 10 Jul 2014 00:17:20 +0300
+MIME-Version: 1.0
+Content-Type: multipart/mixed;
+ boundary="------------010501030105000001010800"
+
+This is a multi-part message in MIME format.
+--------------010501030105000001010800
+Content-Type: text/plain; charset=utf-8
+Content-Transfer-Encoding: 7bit
+
+This mail contains a public key.
+
+--------------010501030105000001010800
+Content-Type: application/pgp-keys;
+ name="0x69137654.asc"
+Content-Transfer-Encoding: 7bit
+Content-Disposition: attachment;
+ filename="0x69137654.asc"
+
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+Version: GnuPG v1
+
+mQINBFO4RfIBEADntcc2ZQ7np7/tQFUzD9UiOGfuHsQEbqiPHION/IyCGwFODt8R
+1VAOgHNDcFTRVjU42TSkJVq0mVXNWQWcNu4Ks+T57YdmYJawCoJoE2yA5QnhtP5K
+kqeJturB7qzz7gQikUuiIQavW9sevXhkW5x5YvHcApy2OeJaRrKb1wE6FyVesc6R
+VDPAYRuX0g2e/kmuJR/6pC9k81fDOmo55W82Wva8HoKrNUJm2gM+lZRjn+m+cgOz
+uvxIRg8OfuWhbEZ40IWeoW0Mn5mG8ntU14RzS69/LJpN8Bb1uAsbcw5vwgmJ3Mlw
++yyiYo5+5cOXVfl3EcIi5JY5gNoHfwJldxkw6uvc/nFMCVeMANlweW4QyDTZpevC
+fcDQucubVbF4FlGsx0dXIx1qFwAF6nB5NQzKL5F5onVphBCXrmp8Oziqx3vTA9Zy
+CAPZiIb99RaxWTSYO64j4oTXWu7FJwmZO9wipcMfFg3tP5oTjypzR37hjzqCJD/M
+U05iVTzeonQNNuvNEqwY696cjNhWJPUN42duqtJitFbXk5LC4xk5Gn/tzaY6uGu4
+tzdjZrhEfvaQFqSpVlhHFfsSvmdc5vTsYSDNRsJxdw8rBfrkjVaGeTkWNpKKe7K7
+vbNcAwOcJlBFeOWKcMUDs6nz/IUB7ODecT5uR0x8vFRclOsYYfbcRrBq8QARAQAB
+tENFZHdhcmRORyAoS2V5IHVzZWQgZm9yIHRlc3RpbmcgRWR3YXJkTkcpIDxlZHdh
+cmRuZ0BleGFtcGxlLmludmFsaWQ+iQI3BBMBCgAhBQJTuEXyAhsDBQsJCAcDBRUK
+CQgLBRYCAwEAAh4BAheAAAoJEFqveelpE3ZUTQ8QALEfuwmJ6NWawkqWq6oLRwCP
+dDZWsz1I3WiyKdj4siCyTR5J6dSUsapIQ6DJWPI9jOl+dTMIjFWlk5/EWD/YYonm
+LuzvTzJs/lWpwqBwNyqrd01EBYkNZhu7Q4rUn3u91z8Eu5UTeuMUqdXV4yJavGT/
+yGyanQsqaxpX69f7xaxysbma+YQj8Pf1FhjDd7OawcoLbdxPVGlu5HAPMkPQumGl
+Gl6eSxdwYR+cSa9k77qfTwrUCUBpZV+35xeUWo8YnFoU4Tz9fQsPTkZr7Y8oX1bO
+i6Uy8T6MivL28t+H6r4Ff10F5SAzrr5tkyZTceTtdTaqSnV7mV/nu5B8BDWZXpX8
+Ln4n6aOwGi5t7xWi1KhRFbDd4mXKvVqlWBsex/uGUmBI/2r3UEAL74osLPgQpcjG
+lbXGnFn7SVbn164i0P8jF6vxRWtaV1uyHvOhq7iIpeZ9+rKEd5ta3uA0JjAv4Uev
+3O7GU4sUqyicDzsr17y1RGWmfEHat6hv4qS55DzQlPNyTE0y3/NaGihkQeplv0ku
+50qkxFdAcTfFQFxOpxJz6iOnMmARFIKmJHbsAI2ZZwKeKkh3+g9TDFVeq1zi0M+W
+Ci0qJYIPn6MKxTA5sVYMNAE1zUlN5PNqXEa3ozxEyw559LCQ0hKjlFBEESuUDEVF
+ut++eZNY1Q9W69CxHPJ7uQINBFO4RfIBEACmHm5gRQgt6UGsfdQ5QiBGouZXzYuC
+8Fs4VEsMX8F8IWtQpWw3sTw4iTgzKHypmSlDsJ/G8BvOtcKuvz7vt9cv7P0WCNDO
+M5ydug3EFkK5wy50R5fwP6TIT5fSHxZheDWpkYb6UFTA+ReUqlwUmcmmX4VJ9c6s
+sp9DACznQVr+Ud1PMWB7urcSYZvX/rwSNTP8hwsE7AoUxSOVjHI3+0sGRWVRpkug
+0H68L10IdzXpd3v4/4ud39D81AHjMmEnSHdXvmlkEy0GVOPWxIDQkM/mOlvf1lPq
+kbHUMnEaJIkDogI7s5t+FDDCG0G1NVEspT1NqWu7wOAuraDeuph3mGgr6fAQgp5F
+6hbiAiWrqx1FR+xJFn9m5uFro/QINxneykKC8C2e25n9ifU9vex2tXMsWP4sAhad
+ZzJl0gMMC5aDF5kRQ2f+RceXp4CuuxWfriEYHb6LhQWgb8x8Ss3B45f+CmYqIb03
+MLFFOiapFFkZALtMztFjumf2CZJuVRFiwRpx1uiSPSGlfNYBhe7eYi6HqT6iyosN
+jLTrwHa8Hjo9R+od8L3qVoNTxVS8kkWuRVAEEwb2EkLG//ZDAvRjXv2mAFHqEiuy
+2XT7IB/vOeojsM6icGRqaajKmuQMDKN7SfmaCmvDQlYwCy3pjI9b/2Br66UGC2nO
+QL3HAY4n/C16QwARAQABiQIfBBgBCgAJBQJTuEXyAhsMAAoJEFqveelpE3ZU68AP
+/0GZZ9+M5FvBaSsrQ8mLIp9IOL3eC63I9dBSiDTbPrmu0sHSbB/aDtbeKYbVdYpg
+5UHBWBhJdB283FSRC/4+UHrdlYsNzCkJjQak9fQ4iraDBkXqAzccuwHjPUEDv16W
+9ofN2uyJoEG5yWRLIOzWCcKgVrFKdUotisnyx3aFuwxGZGv6BfzPHUa9R7cKYEtu
+k1olg7RQ74BwN6q11/nis3TONUZNJGIEWln7pNMJhk/JZ/SGAJc9EfRZr+15ssR3
+hRxO528idjiax11rfo/+Ka5d6PoH0Qst00Amj8lqj41ev9rWuCHeQoRu3FpdsEDP
+L1gD1JmAxZkIUeuiIpbYsvQjZ/VyjACBcAhupibKHO/2S7/smagVKGpn9AMnwde1
+sJODb/6IemcOpyJghHEAeYivLWZPUmEyQhGU7eL7jep0yFLrC5MlK8SAGdvq3bk8
+Jci2xbAzNofn7VW/2430i6ORoBFtYLZZfXb0/hoOou13PVS2crxN3fqVDqss/ish
+HUL7oHDZng7+ieWzK9qjdQsJefwHRHGNb4tylFmKgEBqX5GNCVTnIp0GdBsDMSnZ
+Esu1Rqdjq/1da+b83DkToNQ/65j29LYUsQxDqQu+brVZOrEuwizBTLnJvZKjNcad
+HidwvPyNVI4Tdq6WS3LaP62CB0Me1wYdnsHIjbWC0t2I
+=RZHG
+-----END PGP PUBLIC KEY BLOCK-----
+
+--------------010501030105000001010800--
+