]> iEval git - app-edwardng.git/blame - lib/App/EdwardNG.pm
Add pubkey importing support
[app-edwardng.git] / lib / App / EdwardNG.pm
CommitLineData
2f9e679a
MG
1package App::EdwardNG;
2
3use 5.014000;
4use strict;
5use warnings;
6use parent qw/Exporter/;
7our $VERSION = '0.001';
2f363992 8our @EXPORT_OK = qw/import_pubkeys process_message/;
2f9e679a
MG
9
10use Email::Sender::Simple qw/sendmail/;
8dd68edb 11use File::Share qw/dist_file/;
2f9e679a 12use File::Slurp qw/read_file/;
b2664811 13use File::Spec::Functions qw/rel2abs/;
2f363992 14use IO::Handle;
2f9e679a
MG
15use Getopt::Long;
16use MIME::Entity;
17use MIME::Parser;
18use Mail::GnuPG;
19use PerlX::Maybe;
20use Template;
21use Try::Tiny;
22
23sub debug { say STDERR @_ if $ENV{EDWARDNG_DEBUG} }
24sub stringify ($) { join '', map {; '>', $_ } @{$_[0]} }
25sub mg {
26 Mail::GnuPG->new(
27 key => $ENV{EDWARDNG_KEY},
28 maybe always_trust => $ENV{EDWARDNG_ALWAYS_TRUST},
29 maybe keydir => $ENV{EDWARDNG_KEYDIR},
30 maybe passphrase => $ENV{EDWARDNG_PASSPHRASE},
31 maybe use_agent => $ENV{EDWARDNG_USE_AGENT},
32 @_);
33}
34
2f363992
MG
35sub mp {
36 my $parser = MIME::Parser->new;
37 $parser->decode_bodies($_[0] // 0);
38 $parser->output_to_core(1);
39 $parser
40}
41
2f9e679a
MG
42sub first_part{
43 my ($ent) = @_;
d03d611f 44 return first_part ($ent->parts(0)) if $ent->parts;
3da0c458 45 stringify [$ent->bodyhandle->as_lines]
2f9e679a
MG
46}
47
2f363992
MG
48sub import_pubkeys {
49 my ($ent, $mg) = @_;
50 my @keys;
51 if ($ent->mime_type eq 'application/pgp-keys') {
52 $ent = mp(1)->parse_data($ent->stringify);
53 my $gpg = GnuPG::Interface->new;
54 $mg->_set_options($gpg);
55 $gpg->options->quiet(1);
56 my ($input, $status) = (IO::Handle->new, IO::Handle->new);
57 my $pid = $gpg->import_keys(handles => GnuPG::Handles->new(stdin => $input, status => $status));
58 my $read = Mail::GnuPG::_communicate([$status], [$input], {$input => $ent->bodyhandle->as_string});
59 push @keys, map { /IMPORT_OK \d+ (\w+)/ } $read->{$status};
60 waitpid $pid, 0
61 }
62 push @keys, import_pubkeys ($_, $mg) for $ent->parts;
63 @keys
64}
65
2f9e679a 66sub process_message {
4224c4ce
MG
67 my ($in) = @_;
68 my $msg;
2f363992 69 my $parser = mp;
2f9e679a 70
4224c4ce
MG
71 $msg = $in if ref $in eq 'MIME::Entity';
72 $msg = $parser->parse ($in) if ref $in eq 'IO';
73 $msg = $parser->parse_data ($in) if ref $in eq 'SCALAR';
74 $msg = $parser->parse_open ($in) unless ref $in;
75 die "Don't know how to parse $in" unless $msg;
2f9e679a
MG
76
77 if ($msg->mime_type ne 'multipart/signed' && $msg->mime_type ne 'multipart/encrypted') {
78 # PGP/Inline requires decoding
79 $parser->decode_bodies(1);
80 $msg = $parser->parse_data($msg->stringify)
81 }
82
83 my $gpg = mg;
84 if ($gpg->is_signed($msg)) {
85 debug 'This mail looks signed';
86 my ($code, $keyid, $email) = $gpg->verify($msg);
87 return sign_error => (
88 message => stringify $gpg->{last_message}) if $code;
89 return sign => (
90 keyid => $keyid,
91 email => $email,
92 message => stringify $gpg->{last_message});
93 }
94
95 if ($gpg->is_encrypted($msg)) {
96 debug 'This mail looks encrypted';
97 my ($code, $keyid, $email) = $gpg->decrypt($msg);
98 return encrypt_error => (
99 message => stringify $gpg->{last_message}) if $code;
100 return encrypt => (
101 plaintext => stringify $gpg->{plaintext},
102 decrypted => $gpg->{decrypted},
103 message => stringify $gpg->{last_message}) unless defined $keyid;
104 return signencrypt => (
105 keyid => $keyid,
106 email => $email,
107 plaintext => stringify $gpg->{plaintext},
108 decrypted => $gpg->{decrypted},
109 message => stringify $gpg->{last_message});
110 }
111
112 debug 'This mail doesn\'t seem to be signed or encrypted';
113 return 'plain'
114}
115
116sub run {
117 GetOptions(
118 'always-trust!' => \$ENV{EDWARDNG_ALWAYS_TRUST},
119 'debug!' => \$ENV{EDWARDNG_DEBUG},
120 'from=s' => \$ENV{EDWARDNG_FROM},
121 'key=s' => \$ENV{EDWARDNG_KEY},
122 'keydir=s' => \$ENV{EDWARDNG_KEYDIR},
8cf8d328 123 'logfile=s' => \$ENV{EDWARDNG_LOGFILE},
2f9e679a 124 'passphrase=s' => \$ENV{EDWARDNG_PASSPHRASE},
b2664811 125 'tmpl-path=s' => \$ENV{EDWARDNG_TMPL_PATH},
2f9e679a
MG
126 'use-agent!' => \$ENV{EDWARDNG_USE_AGENT},
127 );
b2664811 128 my $tmpl_path = $ENV{EDWARDNG_TMPL_PATH} // 'en';
8cf8d328 129 open STDERR, '>>', $ENV{EDWARDNG_LOGFILE} if $ENV{EDWARDNG_LOGFILE};
2f9e679a 130
2f363992 131 my $in = mp->parse(\*STDIN);
2044b38a 132 debug 'Received mail from ', $in->get('From');
2f363992
MG
133 my @keys = import_pubkeys $in, mg;
134 say 'Found keys: ', join ' ', @keys if @keys;
2f9e679a
MG
135
136 my ($tmpl, %params);
137 try {
138 ($tmpl, %params) = process_message $in
139 } catch {
140 ($tmpl, %params) = (error => message => $_)
141 };
2044b38a 142 debug "Result is $tmpl, GnuPG said:\n", $params{message};
2f9e679a
MG
143
144 $params{plaintext} = first_part $params{decrypted} if $params{decrypted};
145
8dd68edb 146 my $tt = Template->new(INCLUDE_PATH => rel2abs $tmpl_path, dist_file 'App-EdwardNG', 'tmpl');
2f363992
MG
147 my ($keys, $result) = ('', '');
148 $tt->process('keys', {keys => \@keys}, \$keys) if @keys;
149 $tt->process($tmpl, \%params, \$result);
2f9e679a
MG
150 my $email = MIME::Entity->build(
151 From => $ENV{EDWARDNG_FROM},
152 To => $in->get('From'),
c3455a5b 153 Subject => 'Re: ' . $in->get('Subject'),
2f363992 154 Data => $keys.$result);
2f9e679a 155
70f9c37d 156 my $email_unencrypted = $email->dup;
2f9e679a 157 my $mg = mg always_trust => 1;
70f9c37d 158 my $encrypt_failed = $mg->mime_signencrypt($email, $in->get('From') =~ /<(.*)>/);
2044b38a 159 debug 'Could not encrypt message, sending unencrypted. GnuPG said:', "\n", stringify $mg->{last_message} if $encrypt_failed;
70f9c37d 160 sendmail $encrypt_failed ? $email_unencrypted : $email
2f9e679a
MG
161}
162
1631;
164__END__
165
166=encoding utf-8
167
168=head1 NAME
169
170App::EdwardNG - GnuPG email sign/encrypt testing bot
171
172=head1 SYNOPSIS
173
174 use App::EdwardNG;
175 my ($status, %params) = process_message '/path/to/message';
176 if ($status eq 'signencrypt') {
177 say 'This message is encrypted and signed with key ', $params{keyid}, ' from ', $params{email};
178 say 'Its contents are: ', $params{plaintext};
179 } elsif ($status eq 'encrypt') {
180 say 'This message is encrypted but not signed';
181 say 'Its contents are: ', $params{plaintext};
182 } elsif ($status eq 'encrypt_error') {
183 say 'This message is encrypted but I was unable to decrypt it. GnuPG output: ', $params{message};
184 } elsif ($status eq 'sign') {
185 say 'This message is signed with key ', $params{keyid}, ' from ', $params{email};
186 } elsif ($status eq 'sign_error') {
187 say 'This message is signed but I was unable to verify the signature. GnuPG output: ', $params{message};
188 } elsif ($status eq 'plain') {
189 say 'This message is neither signed nor encrypted';
190 } elsif ($status eq 'error') {
191 say 'There was an error processing the message: ', $params{message};
192 }
193
194=head1 DESCRIPTION
195
196EdwardNG is a reimplementation of the Edward reply bot referenced in L<https://emailselfdefense.fsf.org/>.
197
2f363992
MG
198=head1 EXPORTS
199
200None by default.
201
202=head2 B<import_keys>(I<$entity>, I<$gpg>)
203
204Scan 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.
205
206Returns a list of fingerprints of keys found.
207
208=head2 B<process_message>(I<$message>)
209
210Analyze a message, looking for PGP signatures and encryption. I<$message> can be:
2f9e679a
MG
211
212=over
213
214=item A filehandle reference, e.g. C<\*STDIN>.
215
216=item A reference to a scalar which holds the message contents.
217
218=item A scalar which represents a path to a message.
219
2f363992 220=item A L<MIME::Entity> object created with decode_bodies(0)
2f9e679a
MG
221
222=back
223
224The function returns a status followed by a hash. Possible results:
225
226=over
227
228=item plain
229
230The message is neither signed nor encrypted.
231
232=item sign_error, message => $message
233
234The message is signed but the signature could not be verified. GnuPG output is $message.
235
236=item sign, keyid => $keyid, email => $email, message => $message
237
238The message is signed with key $keyid from $email. GnuPG output is $message.
239
240=item encrypt_error, message => $message
241
242The message is encrypted and unable to be decrypted. GnuPG output is $message.
243
244=item encrypt, plaintext => $plaintext, decrypted => $decrypted, message => $message
245
246The message is encrypted and unsigned. $plaintext is the decrypted message as plain text, while $decrypted is a MIME::Entity representing the decrypted message. GnuPG output is $message.
247
248=item signencrypt, plaintext => $plaintext, decrypted => $decrypted, keyid => $keyid, email => $email, message => $message
249
250The message is encrypted and signed with key $keyid from $email. $plaintext is the decrypted message as plain text, while $decrypted is a MIME::Entity representing the decrypted message. GnuPG output is $message.
251
252=item error, message => $message
253
254There was an error while processing the message. The error can be found in $message.
255
256=back
257
258=head1 ENVIRONMENT
259
260This module is configured via the %ENV hash. See the L<edwardng(1)> manpage for more information.
261
262=head1 SEE ALSO
263
264L<edwardng(1)>
265
266=head1 AUTHOR
267
268Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
269
270=head1 COPYRIGHT AND LICENSE
271
1f08c352 272Copyright (C) 2014 by Fundația Ceata
2f9e679a
MG
273
274This library is free software; you can redistribute it and/or modify
275it under the same terms as Perl itself, either Perl version 5.18.2 or,
276at your option, any later version of Perl 5 you may have available.
277
278
279=cut
This page took 0.047286 seconds and 4 git commands to generate.