6 use parent qw
/Exporter/;
7 our $VERSION = '0.001';
8 our @EXPORT_OK = qw
/import_pubkeys process_message/;
10 use Email
::Sender
::Simple qw
/sendmail/;
11 use File
::Share qw
/dist_file/;
12 use File
::Slurp qw
/read_file/;
13 use File
::Spec
::Functions qw
/rel2abs/;
23 sub debug
{ say STDERR
@_ if $ENV{EDWARDNG_DEBUG
} }
24 sub stringify
($) { join '', map {; '>', $_ } @
{$_[0]} }
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
},
36 my $parser = MIME
::Parser
->new;
37 $parser->decode_bodies($_[0] // 0);
38 $parser->output_to_core(1);
44 return first_part
($ent->parts(0)) if $ent->parts;
45 stringify
[$ent->bodyhandle->as_lines]
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};
62 push @keys, import_pubkeys
($_, $mg) for $ent->parts;
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;
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)
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;
92 message
=> stringify
$gpg->{last_message
});
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;
101 plaintext
=> stringify
$gpg->{plaintext
},
102 decrypted
=> $gpg->{decrypted
},
103 message
=> stringify
$gpg->{last_message
}) unless defined $keyid;
104 return signencrypt
=> (
107 plaintext
=> stringify
$gpg->{plaintext
},
108 decrypted
=> $gpg->{decrypted
},
109 message
=> stringify
$gpg->{last_message
});
112 debug
'This mail doesn\'t seem to be signed or encrypted';
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
},
123 'logfile=s' => \
$ENV{EDWARDNG_LOGFILE
},
124 'passphrase=s' => \
$ENV{EDWARDNG_PASSPHRASE
},
125 'tmpl-path=s' => \
$ENV{EDWARDNG_TMPL_PATH
},
126 'use-agent!' => \
$ENV{EDWARDNG_USE_AGENT
},
128 my $tmpl_path = $ENV{EDWARDNG_TMPL_PATH
} // 'en';
129 open STDERR
, '>>', $ENV{EDWARDNG_LOGFILE
} if $ENV{EDWARDNG_LOGFILE
};
131 my $in = mp
->parse(\
*STDIN
);
132 debug
'Received mail from ', $in->get('From');
133 my @keys = import_pubkeys
$in, mg
;
134 say 'Found keys: ', join ' ', @keys if @keys;
138 ($tmpl, %params) = process_message
$in
140 ($tmpl, %params) = (error
=> message
=> $_)
142 debug
"Result is $tmpl, GnuPG said:\n", $params{message
};
144 $params{plaintext
} = first_part
$params{decrypted
} if $params{decrypted
};
146 my $tt = Template
->new(INCLUDE_PATH
=> rel2abs
$tmpl_path, dist_file
'App-EdwardNG', 'tmpl');
147 my ($keys, $result) = ('', '');
148 $tt->process('keys', {keys => \
@keys}, \
$keys) if @keys;
149 $tt->process($tmpl, \
%params, \
$result);
150 my $email = MIME
::Entity
->build(
151 From
=> $ENV{EDWARDNG_FROM
},
152 To
=> $in->get('From'),
153 Subject
=> 'Re: ' . $in->get('Subject'),
154 Data
=> $keys.$result);
156 my $email_unencrypted = $email->dup;
157 my $mg = mg always_trust
=> 1;
158 my $encrypt_failed = $mg->mime_signencrypt($email, $in->get('From') =~ /<(.*)>/);
159 debug
'Could not encrypt message, sending unencrypted. GnuPG said:', "\n", stringify
$mg->{last_message
} if $encrypt_failed;
160 sendmail
$encrypt_failed ?
$email_unencrypted : $email
170 App::EdwardNG - GnuPG email sign/encrypt testing bot
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};
196 EdwardNG is a reimplementation of the Edward reply bot referenced in L<https://emailselfdefense.fsf.org/>.
202 =head2 B<import_keys>(I<$entity>, I<$gpg>)
204 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.
206 Returns a list of fingerprints of keys found.
208 =head2 B<process_message>(I<$message>)
210 Analyze a message, looking for PGP signatures and encryption. I<$message> can be:
214 =item A filehandle reference, e.g. C<\*STDIN>.
216 =item A reference to a scalar which holds the message contents.
218 =item A scalar which represents a path to a message.
220 =item A L<MIME::Entity> object created with decode_bodies(0)
224 The function returns a status followed by a hash. Possible results:
230 The message is neither signed nor encrypted.
232 =item sign_error, message => $message
234 The message is signed but the signature could not be verified. GnuPG output is $message.
236 =item sign, keyid => $keyid, email => $email, message => $message
238 The message is signed with key $keyid from $email. GnuPG output is $message.
240 =item encrypt_error, message => $message
242 The message is encrypted and unable to be decrypted. GnuPG output is $message.
244 =item encrypt, plaintext => $plaintext, decrypted => $decrypted, message => $message
246 The 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.
248 =item signencrypt, plaintext => $plaintext, decrypted => $decrypted, keyid => $keyid, email => $email, message => $message
250 The 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.
252 =item error, message => $message
254 There was an error while processing the message. The error can be found in $message.
260 This module is configured via the %ENV hash. See the L<edwardng(1)> manpage for more information.
268 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
270 =head1 COPYRIGHT AND LICENSE
272 Copyright (C) 2014 by Fundația Ceata
274 This library is free software; you can redistribute it and/or modify
275 it under the same terms as Perl itself, either Perl version 5.18.2 or,
276 at your option, any later version of Perl 5 you may have available.
This page took 0.03796 seconds and 4 git commands to generate.