9 RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
10 qw/data gnupg keyrings/ );
13 use RT::Test::GnuPG tests => 96, gnupg_options => { homedir => $homedir };
16 use_ok('MIME::Entity');
18 diag 'only signing. correct passphrase';
20 my $entity = MIME::Entity->build(
21 From => 'rt@example.com',
25 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
26 ok( $entity, 'signed entity');
27 ok( !$res{'logger'}, "log is here as well" ) or diag $res{'logger'};
28 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
29 is( scalar @status, 2, 'two records: passphrase, signing');
30 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
31 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
32 is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
33 is( $status[1]->{'Status'}, 'DONE', 'done');
34 is( $status[1]->{'User'}->{'EmailAddress'}, 'rt@example.com', 'correct email');
36 ok( $entity->is_multipart, 'signed message is multipart' );
37 is( $entity->parts, 2, 'two parts' );
39 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
40 is( scalar @parts, 1, 'one protected part' );
41 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
42 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
43 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
45 my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
46 is scalar @res, 1, 'one operation';
47 @status = RT::Crypt::GnuPG::ParseStatus( $res[0]{'status'} );
48 is( scalar @status, 1, 'one record');
49 is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
50 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
51 is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
54 diag 'only signing. missing passphrase';
56 my $entity = MIME::Entity->build(
57 From => 'rt@example.com',
63 %res = RT::Crypt::GnuPG::SignEncrypt(
68 } qr/can't query passphrase in batch mode/;
69 ok( $res{'exit_code'}, "couldn't sign without passphrase");
70 ok( $res{'error'} || $res{'logger'}, "error is here" );
72 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
73 is( scalar @status, 1, 'one record');
74 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
75 is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase');
78 diag 'only signing. wrong passphrase';
80 my $entity = MIME::Entity->build(
81 From => 'rt@example.com',
88 %res = RT::Crypt::GnuPG::SignEncrypt(
91 Passphrase => 'wrong',
95 ok( $res{'exit_code'}, "couldn't sign with bad passphrase");
96 ok( $res{'error'} || $res{'logger'}, "error is here" );
98 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
99 is( scalar @status, 1, 'one record');
100 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
101 is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase');
104 diag 'encryption only';
106 my $entity = MIME::Entity->build(
107 From => 'rt@example.com',
108 To => 'rt@example.com',
112 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
113 ok( !$res{'exit_code'}, "successful encryption" );
114 ok( !$res{'logger'}, "no records in logger" );
116 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
117 is( scalar @status, 1, 'one record');
118 is( $status[0]->{'Operation'}, 'Encrypt', 'operation is correct');
119 is( $status[0]->{'Status'}, 'DONE', 'done');
121 ok($entity, 'get an encrypted part');
123 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
124 is( scalar @parts, 1, 'one protected part' );
125 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
126 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
127 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
130 diag 'encryption only, bad recipient';
132 my $entity = MIME::Entity->build(
133 From => 'rt@example.com',
134 To => 'keyless@example.com',
141 %res = RT::Crypt::GnuPG::SignEncrypt(
145 } qr/public key not found/;
147 ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients');
148 ok( $res{'logger'}, "errors are in logger" );
150 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
151 is( scalar @status, 1, 'one record');
152 is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient');
155 diag 'encryption and signing with combined method';
157 my $entity = MIME::Entity->build(
158 From => 'rt@example.com',
159 To => 'rt@example.com',
163 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Passphrase => 'test' );
164 ok( !$res{'exit_code'}, "successful encryption with signing" );
165 ok( !$res{'logger'}, "no records in logger" );
167 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
168 is( scalar @status, 3, 'three records: passphrase, sign and encrypt');
169 is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
170 is( $status[0]->{'Status'}, 'DONE', 'done');
171 is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
172 is( $status[1]->{'Status'}, 'DONE', 'done');
173 is( $status[2]->{'Operation'}, 'Encrypt', 'operation is correct');
174 is( $status[2]->{'Status'}, 'DONE', 'done');
176 ok($entity, 'get an encrypted and signed part');
178 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
179 is( scalar @parts, 1, 'one protected part' );
180 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
181 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
182 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
185 diag 'encryption and signing with cascading, sign on encrypted';
187 my $entity = MIME::Entity->build(
188 From => 'rt@example.com',
189 To => 'rt@example.com',
193 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
194 ok( !$res{'exit_code'}, 'successful encryption' );
195 ok( !$res{'logger'}, "no records in logger" );
196 %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
197 ok( !$res{'exit_code'}, 'successful signing' );
198 ok( !$res{'logger'}, "no records in logger" );
200 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
201 is( scalar @parts, 1, 'one protected part, top most' );
202 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
203 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
204 is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
207 diag 'find signed/encrypted part deep inside';
209 my $entity = MIME::Entity->build(
210 From => 'rt@example.com',
211 To => 'rt@example.com',
215 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
216 ok( !$res{'exit_code'}, "success" );
217 $entity->make_multipart( 'mixed', Force => 1 );
219 Type => 'text/plain',
220 Data => ['-'x76, 'this is mailing list'],
223 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
224 is( scalar @parts, 1, 'one protected part' );
225 is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
226 is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
227 is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" );
230 diag 'wrong signed/encrypted parts: no protocol';
232 my $entity = MIME::Entity->build(
233 From => 'rt@example.com',
234 To => 'rt@example.com',
239 my %res = RT::Crypt::GnuPG::SignEncrypt(
244 ok( !$res{'exit_code'}, 'success' );
245 $entity->head->mime_attr( 'Content-Type.protocol' => undef );
249 @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
250 } qr{Entity is 'multipart/encrypted', but has no protocol defined. Skipped};
252 is( scalar @parts, 0, 'no protected parts' );
255 diag 'wrong signed/encrypted parts: not enought parts';
257 my $entity = MIME::Entity->build(
258 From => 'rt@example.com',
259 To => 'rt@example.com',
264 my %res = RT::Crypt::GnuPG::SignEncrypt(
269 ok( !$res{'exit_code'}, 'success' );
270 $entity->parts([ $entity->parts(0) ]);
274 @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
275 } qr/Encrypted or signed entity must has two subparts. Skipped/;
276 is( scalar @parts, 0, 'no protected parts' );
279 diag 'wrong signed/encrypted parts: wrong proto';
281 my $entity = MIME::Entity->build(
282 From => 'rt@example.com',
283 To => 'rt@example.com',
287 my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
288 ok( !$res{'exit_code'}, 'success' );
289 $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
291 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
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::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
304 ok( !$res{'exit_code'}, 'success' );
305 $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
307 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
308 is( scalar @parts, 0, 'no protected parts' );
311 diag 'verify inline and in attachment signatures';
313 open( my $fh, '<', "$homedir/signed_old_style_with_attachment.eml" ) or die $!;
314 my $parser = new MIME::Parser;
315 my $entity = $parser->parse( $fh );
317 my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
318 is( scalar @parts, 2, 'two protected parts' );
319 is( $parts[1]->{'Type'}, 'signed', "have signed part" );
320 is( $parts[1]->{'Format'}, 'Inline', "inline format" );
321 is( $parts[1]->{'Data'}, $entity->parts(0), "it's first part" );
323 is( $parts[0]->{'Type'}, 'signed', "have signed part" );
324 is( $parts[0]->{'Format'}, 'Attachment', "attachment format" );
325 is( $parts[0]->{'Data'}, $entity->parts(1), "data in second part" );
326 is( $parts[0]->{'Signature'}, $entity->parts(2), "file's signature in third part" );
328 my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
329 my @status = RT::Crypt::GnuPG::ParseStatus( $res[0]->{'status'} );
330 is( scalar @status, 1, 'one record');
331 is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
332 is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
333 is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
335 $parser->filer->purge();