9 RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
10 qw/data gnupg keyrings/ );
13 use RT::Test::GnuPG tests => 100, 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->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->ParseStatus(
30 Protocol => $res{'Protocol'}, Status => $res{'status'}
32 is( scalar @status, 2, 'two records: passphrase, signing');
33 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
34 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
35 is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
36 is( $status[1]->{'Status'}, 'DONE', 'done');
37 is( $status[1]->{'User'}->{'EmailAddress'}, 'rt@example.com', 'correct email');
39 ok( $entity->is_multipart, 'signed message is multipart' );
40 is( $entity->parts, 2, 'two parts' );
42 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
43 is( scalar @parts, 1, 'one protected part' );
44 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
45 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
46 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
48 my @res = RT::Crypt->VerifyDecrypt( Entity => $entity );
49 is scalar @res, 1, 'one operation';
50 @status = RT::Crypt->ParseStatus(
51 Protocol => $res[0]{'Protocol'}, Status => $res[0]{'status'}
53 is( scalar @status, 1, 'one record');
54 is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
55 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
56 is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
59 diag 'only signing. missing passphrase';
61 my $entity = MIME::Entity->build(
62 From => 'rt@example.com',
68 %res = RT::Crypt->SignEncrypt(
73 } qr/can't query passphrase in batch mode/;
74 ok( $res{'exit_code'}, "couldn't sign without passphrase");
75 ok( $res{'error'} || $res{'logger'}, "error is here" );
77 my @status = RT::Crypt->ParseStatus(
78 Protocol => $res{'Protocol'}, Status => $res{'status'}
80 is( scalar @status, 1, 'one record');
81 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
82 is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase');
85 diag 'only signing. wrong passphrase';
87 my $entity = MIME::Entity->build(
88 From => 'rt@example.com',
95 %res = RT::Crypt->SignEncrypt(
98 Passphrase => 'wrong',
100 } qr/bad passphrase/;
102 ok( $res{'exit_code'}, "couldn't sign with bad passphrase");
103 ok( $res{'error'} || $res{'logger'}, "error is here" );
105 my @status = RT::Crypt->ParseStatus(
106 Protocol => $res{'Protocol'}, Status => $res{'status'}
108 is( scalar @status, 1, 'one record');
109 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
110 is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase');
113 diag 'encryption only';
115 my $entity = MIME::Entity->build(
116 From => 'rt@example.com',
117 To => 'rt@example.com',
121 my %res = RT::Crypt->SignEncrypt( Entity => $entity, Sign => 0 );
122 ok( !$res{'exit_code'}, "successful encryption" );
123 ok( !$res{'logger'}, "no records in logger" );
125 my @status = RT::Crypt->ParseStatus(
126 Protocol => $res{'Protocol'}, Status => $res{'status'}
128 is( scalar @status, 1, 'one record');
129 is( $status[0]->{'Operation'}, 'Encrypt', 'operation is correct');
130 is( $status[0]->{'Status'}, 'DONE', 'done');
132 ok($entity, 'get an encrypted part');
134 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
135 is( scalar @parts, 1, 'one protected part' );
136 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
137 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
138 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
141 diag 'encryption only, bad recipient';
143 my $entity = MIME::Entity->build(
144 From => 'rt@example.com',
145 To => 'keyless@example.com',
152 %res = RT::Crypt->SignEncrypt(
156 } qr/public key not found/;
158 ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients');
159 ok( $res{'logger'}, "errors are in logger" );
161 my @status = RT::Crypt->ParseStatus(
162 Protocol => $res{'Protocol'}, Status => $res{'status'}
164 is( scalar @status, 1, 'one record');
165 is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient');
168 diag 'encryption and signing with combined method';
170 my $entity = MIME::Entity->build(
171 From => 'rt@example.com',
172 To => 'rt@example.com',
176 my %res = RT::Crypt->SignEncrypt( Entity => $entity, Passphrase => 'test' );
177 ok( !$res{'exit_code'}, "successful encryption with signing" );
178 ok( !$res{'logger'}, "no records in logger" );
180 my @status = RT::Crypt->ParseStatus(
181 Protocol => $res{'Protocol'}, Status => $res{'status'}
183 is( scalar @status, 3, 'three records: passphrase, sign and encrypt');
184 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
185 is( $status[0]->{'Status'}, 'DONE', 'done');
186 is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
187 is( $status[1]->{'Status'}, 'DONE', 'done');
188 is( $status[2]->{'Operation'}, 'Encrypt', 'operation is correct');
189 is( $status[2]->{'Status'}, 'DONE', 'done');
191 ok($entity, 'get an encrypted and signed part');
193 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
194 is( scalar @parts, 1, 'one protected part' );
195 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
196 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
197 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
200 diag 'encryption and signing with cascading, sign on encrypted';
202 my $entity = MIME::Entity->build(
203 From => 'rt@example.com',
204 To => 'rt@example.com',
208 my %res = RT::Crypt->SignEncrypt( Entity => $entity, Sign => 0 );
209 ok( !$res{'exit_code'}, 'successful encryption' );
210 ok( !$res{'logger'}, "no records in logger" );
211 %res = RT::Crypt->SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
212 ok( !$res{'exit_code'}, 'successful signing' );
213 ok( !$res{'logger'}, "no records in logger" );
215 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
216 is( scalar @parts, 1, 'one protected part, top most' );
217 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
218 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
219 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
222 diag 'find signed/encrypted part deep inside';
224 my $entity = MIME::Entity->build(
225 From => 'rt@example.com',
226 To => 'rt@example.com',
230 my %res = RT::Crypt->SignEncrypt( Entity => $entity, Sign => 0 );
231 ok( !$res{'exit_code'}, "success" );
232 $entity->make_multipart( 'mixed', Force => 1 );
234 Type => 'text/plain',
235 Data => ['-'x76, 'this is mailing list'],
238 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
239 is( scalar @parts, 1, 'one protected part' );
240 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
241 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
242 is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" );
245 diag 'wrong signed/encrypted parts: no protocol';
247 my $entity = MIME::Entity->build(
248 From => 'rt@example.com',
249 To => 'rt@example.com',
254 my %res = RT::Crypt->SignEncrypt(
259 ok( !$res{'exit_code'}, 'success' );
260 $entity->head->mime_attr( 'Content-Type.protocol' => undef );
263 warning_like { @parts = RT::Crypt->FindProtectedParts( Entity => $entity ) }
264 qr{Entity is 'multipart/encrypted', but has no protocol defined. Checking for PGP part};
265 is( scalar @parts, 1, 'one protected part' );
266 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
267 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
268 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
271 diag 'wrong signed/encrypted parts: not enought parts';
273 my $entity = MIME::Entity->build(
274 From => 'rt@example.com',
275 To => 'rt@example.com',
280 my %res = RT::Crypt->SignEncrypt(
285 ok( !$res{'exit_code'}, 'success' );
286 $entity->parts([ $entity->parts(0) ]);
290 @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
291 } qr/Encrypted or signed entity must has two subparts. Skipped/;
292 is( scalar @parts, 0, 'no protected parts' );
295 diag 'wrong signed/encrypted parts: wrong proto';
297 my $entity = MIME::Entity->build(
298 From => 'rt@example.com',
299 To => 'rt@example.com',
303 my %res = RT::Crypt->SignEncrypt( Entity => $entity, Sign => 0 );
304 ok( !$res{'exit_code'}, 'success' );
305 $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
307 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
308 is( scalar @parts, 0, 'no protected parts' );
311 diag 'wrong signed/encrypted parts: wrong proto';
313 my $entity = MIME::Entity->build(
314 From => 'rt@example.com',
315 To => 'rt@example.com',
319 my %res = RT::Crypt->SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
320 ok( !$res{'exit_code'}, 'success' );
321 $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
323 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
324 is( scalar @parts, 0, 'no protected parts' );
327 diag 'verify inline and in attachment signatures';
329 open( my $fh, '<', "$homedir/signed_old_style_with_attachment.eml" ) or die $!;
330 my $parser = new MIME::Parser;
331 my $entity = $parser->parse( $fh );
333 my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
334 is( scalar @parts, 2, 'two protected parts' );
335 is( $parts[1]->{'Type'}, 'signed', "have signed part" );
336 is( $parts[1]->{'Format'}, 'Inline', "inline format" );
337 is( $parts[1]->{'Data'}, $entity->parts(0), "it's first part" );
339 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
340 is( $parts[0]->{'Format'}, 'Attachment', "attachment format" );
341 is( $parts[0]->{'Data'}, $entity->parts(1), "data in second part" );
342 is( $parts[0]->{'Signature'}, $entity->parts(2), "file's signature in third part" );
344 my @res = RT::Crypt->VerifyDecrypt( Entity => $entity );
345 my @status = RT::Crypt->ParseStatus(
346 Protocol => $res[0]{'Protocol'}, Status => $res[0]{'status'}
348 is( scalar @status, 1, 'one record');
349 is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
350 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
351 is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
353 $parser->filer->purge();