10 RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
11 qw/data gnupg keyrings/ );
14 use RT::Test::GnuPG tests => 96, gnupg_options => { homedir => $homedir };
17 use_ok('MIME::Entity');
19 diag 'only signing. correct passphrase';
21 my $entity = MIME::Entity->build(
22 From => 'rt@example.com',
26 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
27 ok( $entity, 'signed entity');
28 ok( !$res{'logger'}, "log is here as well" ) or diag $res{'logger'};
29 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
30 is( scalar @status, 2, 'two records: passphrase, signing');
31 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
32 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
33 is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
34 is( $status[1]->{'Status'}, 'DONE', 'done');
35 is( $status[1]->{'User'}->{'EmailAddress'}, 'rt@example.com', 'correct email');
37 ok( $entity->is_multipart, 'signed message is multipart' );
38 is( $entity->parts, 2, 'two parts' );
40 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
41 is( scalar @parts, 1, 'one protected part' );
42 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
43 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
44 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
46 my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
47 is scalar @res, 1, 'one operation';
48 @status = RT::Crypt::GnuPG::ParseStatus( $res[0]{'status'} );
49 is( scalar @status, 1, 'one record');
50 is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
51 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
52 is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
55 diag 'only signing. missing passphrase';
57 my $entity = MIME::Entity->build(
58 From => 'rt@example.com',
64 %res = RT::Crypt::GnuPG::SignEncrypt(
69 } qr/can't query passphrase in batch mode/;
70 ok( $res{'exit_code'}, "couldn't sign without passphrase");
71 ok( $res{'error'} || $res{'logger'}, "error is here" );
73 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
74 is( scalar @status, 1, 'one record');
75 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
76 is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase');
79 diag 'only signing. wrong passphrase';
81 my $entity = MIME::Entity->build(
82 From => 'rt@example.com',
89 %res = RT::Crypt::GnuPG::SignEncrypt(
92 Passphrase => 'wrong',
96 ok( $res{'exit_code'}, "couldn't sign with bad passphrase");
97 ok( $res{'error'} || $res{'logger'}, "error is here" );
99 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
100 is( scalar @status, 1, 'one record');
101 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
102 is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase');
105 diag 'encryption only';
107 my $entity = MIME::Entity->build(
108 From => 'rt@example.com',
109 To => 'rt@example.com',
113 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
114 ok( !$res{'exit_code'}, "successful encryption" );
115 ok( !$res{'logger'}, "no records in logger" );
117 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
118 is( scalar @status, 1, 'one record');
119 is( $status[0]->{'Operation'}, 'Encrypt', 'operation is correct');
120 is( $status[0]->{'Status'}, 'DONE', 'done');
122 ok($entity, 'get an encrypted part');
124 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
125 is( scalar @parts, 1, 'one protected part' );
126 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
127 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
128 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
131 diag 'encryption only, bad recipient';
133 my $entity = MIME::Entity->build(
134 From => 'rt@example.com',
135 To => 'keyless@example.com',
142 %res = RT::Crypt::GnuPG::SignEncrypt(
146 } qr/public key not found/;
148 ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients');
149 ok( $res{'logger'}, "errors are in logger" );
151 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
152 is( scalar @status, 1, 'one record');
153 is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient');
156 diag 'encryption and signing with combined method';
158 my $entity = MIME::Entity->build(
159 From => 'rt@example.com',
160 To => 'rt@example.com',
164 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Passphrase => 'test' );
165 ok( !$res{'exit_code'}, "successful encryption with signing" );
166 ok( !$res{'logger'}, "no records in logger" );
168 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
169 is( scalar @status, 3, 'three records: passphrase, sign and encrypt');
170 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
171 is( $status[0]->{'Status'}, 'DONE', 'done');
172 is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
173 is( $status[1]->{'Status'}, 'DONE', 'done');
174 is( $status[2]->{'Operation'}, 'Encrypt', 'operation is correct');
175 is( $status[2]->{'Status'}, 'DONE', 'done');
177 ok($entity, 'get an encrypted and signed part');
179 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
180 is( scalar @parts, 1, 'one protected part' );
181 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
182 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
183 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
186 diag 'encryption and signing with cascading, sign on encrypted';
188 my $entity = MIME::Entity->build(
189 From => 'rt@example.com',
190 To => 'rt@example.com',
194 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
195 ok( !$res{'exit_code'}, 'successful encryption' );
196 ok( !$res{'logger'}, "no records in logger" );
197 %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
198 ok( !$res{'exit_code'}, 'successful signing' );
199 ok( !$res{'logger'}, "no records in logger" );
201 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
202 is( scalar @parts, 1, 'one protected part, top most' );
203 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
204 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
205 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
208 diag 'find signed/encrypted part deep inside';
210 my $entity = MIME::Entity->build(
211 From => 'rt@example.com',
212 To => 'rt@example.com',
216 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
217 ok( !$res{'exit_code'}, "success" );
218 $entity->make_multipart( 'mixed', Force => 1 );
220 Type => 'text/plain',
221 Data => ['-'x76, 'this is mailing list'],
224 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
225 is( scalar @parts, 1, 'one protected part' );
226 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
227 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
228 is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" );
231 diag 'wrong signed/encrypted parts: no protocol';
233 my $entity = MIME::Entity->build(
234 From => 'rt@example.com',
235 To => 'rt@example.com',
240 my %res = RT::Crypt::GnuPG::SignEncrypt(
245 ok( !$res{'exit_code'}, 'success' );
246 $entity->head->mime_attr( 'Content-Type.protocol' => undef );
250 @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
251 } qr{Entity is 'multipart/encrypted', but has no protocol defined. Skipped};
253 is( scalar @parts, 0, 'no protected parts' );
256 diag 'wrong signed/encrypted parts: not enought parts';
258 my $entity = MIME::Entity->build(
259 From => 'rt@example.com',
260 To => 'rt@example.com',
265 my %res = RT::Crypt::GnuPG::SignEncrypt(
270 ok( !$res{'exit_code'}, 'success' );
271 $entity->parts([ $entity->parts(0) ]);
275 @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
276 } qr/Encrypted or signed entity must has two subparts. Skipped/;
277 is( scalar @parts, 0, 'no protected parts' );
280 diag 'wrong signed/encrypted parts: wrong proto';
282 my $entity = MIME::Entity->build(
283 From => 'rt@example.com',
284 To => 'rt@example.com',
288 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
289 ok( !$res{'exit_code'}, 'success' );
290 $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
292 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
293 is( scalar @parts, 0, 'no protected parts' );
296 diag 'wrong signed/encrypted parts: wrong proto';
298 my $entity = MIME::Entity->build(
299 From => 'rt@example.com',
300 To => 'rt@example.com',
304 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
305 ok( !$res{'exit_code'}, 'success' );
306 $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
308 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
309 is( scalar @parts, 0, 'no protected parts' );
312 diag 'verify inline and in attachment signatures';
314 open( my $fh, '<', "$homedir/signed_old_style_with_attachment.eml" ) or die $!;
315 my $parser = new MIME::Parser;
316 my $entity = $parser->parse( $fh );
318 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
319 is( scalar @parts, 2, 'two protected parts' );
320 is( $parts[1]->{'Type'}, 'signed', "have signed part" );
321 is( $parts[1]->{'Format'}, 'Inline', "inline format" );
322 is( $parts[1]->{'Data'}, $entity->parts(0), "it's first part" );
324 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
325 is( $parts[0]->{'Format'}, 'Attachment', "attachment format" );
326 is( $parts[0]->{'Data'}, $entity->parts(1), "data in second part" );
327 is( $parts[0]->{'Signature'}, $entity->parts(2), "file's signature in third part" );
329 my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
330 my @status = RT::Crypt::GnuPG::ParseStatus( $res[0]->{'status'} );
331 is( scalar @status, 1, 'one record');
332 is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
333 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
334 is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
336 $parser->filer->purge();