From: Marius Gavrilescu Date: Wed, 9 Jul 2014 21:22:47 +0000 (+0300) Subject: Add pubkey importing support X-Git-Url: http://git.ieval.ro/?p=app-edwardng.git;a=commitdiff_plain;h=2f363992eb7c1ca18e787bce8729d6cc2167da76 Add pubkey importing support --- diff --git a/MANIFEST b/MANIFEST index 79df2cd..efd5329 100644 --- 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 f6b54a4..94a5a20 100644 --- 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. -This module exports a single function, B, which takes a single parameter representing the message. This parameter can be: +=head1 EXPORTS + +None by default. + +=head2 B(I<$entity>, I<$gpg>) + +Scan a message for PGP public keys, and import them. I<$entity> is a L to scan, I<$gpg> is a L instance. + +Returns a list of fingerprints of keys found. + +=head2 B(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, which takes a single =item A scalar which represents a path to a message. -=item A L object +=item A L object created with decode_bodies(0) =back diff --git a/share/tmpl/en/keys b/share/tmpl/en/keys new file mode 100644 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 4b4550e..015e054 100644 --- 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) '; -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 index 0000000..59680cc --- /dev/null +++ b/t/data/contains-pubkey @@ -0,0 +1,77 @@ +From: Marius Gavrilescu +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-- +