]>
iEval git - app-edwardng.git/blob - EdwardNG.pm
94a5a200c2ed29c51e7c9f4b74ed2a3a24faa0b6
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.066253 seconds and 3 git commands to generate.