rt/t/mail/crypt-gnupg.t

   1
   2 use strict;
   3 use warnings;
   4
   5 my $homedir;
   6 BEGIN {
   7     require RT::Test;
   8     $homedir =
   9       RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
  10         qw/data gnupg keyrings/ );
  11 }
  12
  13 use RT::Test::GnuPG tests => 96, gnupg_options => { homedir => $homedir };
  14 use Test::Warn;
  15
  16 use_ok('MIME::Entity');
  17
  18 diag 'only signing. correct passphrase';
  19 {
  20     my $entity = MIME::Entity->build(
  21         From    => 'rt@example.com',
  22         Subject => 'test',
  23         Data    => ['test'],
  24     );
  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');
  35
  36     ok( $entity->is_multipart, 'signed message is multipart' );
  37     is( $entity->parts, 2, 'two parts' );
  38
  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" );
  44
  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');
  52 }
  53
  54 diag 'only signing. missing passphrase';
  55 {
  56     my $entity = MIME::Entity->build(
  57         From    => 'rt@example.com',
  58         Subject => 'test',
  59         Data    => ['test'],
  60     );
  61     my %res;
  62     warning_like {
  63         %res = RT::Crypt::GnuPG::SignEncrypt(
  64             Entity     => $entity,
  65             Encrypt    => 0,
  66             Passphrase => ''
  67         );
  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" );
  71
  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');
  76 }
  77
  78 diag 'only signing. wrong passphrase';
  79 {
  80     my $entity = MIME::Entity->build(
  81         From    => 'rt@example.com',
  82         Subject => 'test',
  83         Data    => ['test'],
  84     );
  85
  86     my %res;
  87     warning_like {
  88         %res = RT::Crypt::GnuPG::SignEncrypt(
  89             Entity     => $entity,
  90             Encrypt    => 0,
  91             Passphrase => 'wrong',
  92         );
  93     } qr/bad passphrase/;
  94
  95     ok( $res{'exit_code'}, "couldn't sign with bad passphrase");
  96     ok( $res{'error'} || $res{'logger'}, "error is here" );
  97
  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');
 102 }
 103
 104 diag 'encryption only';
 105 {
 106     my $entity = MIME::Entity->build(
 107         From    => 'rt@example.com',
 108         To      => 'rt@example.com',
 109         Subject => 'test',
 110         Data    => ['test'],
 111     );
 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" );
 115
 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');
 120
 121     ok($entity, 'get an encrypted part');
 122
 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" );
 128 }
 129
 130 diag 'encryption only, bad recipient';
 131 {
 132     my $entity = MIME::Entity->build(
 133         From    => 'rt@example.com',
 134         To      => 'keyless@example.com',
 135         Subject => 'test',
 136         Data    => ['test'],
 137     );
 138
 139     my %res;
 140     warning_like {
 141         %res = RT::Crypt::GnuPG::SignEncrypt(
 142             Entity => $entity,
 143             Sign   => 0,
 144         );
 145     } qr/public key not found/;
 146
 147     ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients');
 148     ok( $res{'logger'}, "errors are in logger" );
 149
 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');
 153 }
 154
 155 diag 'encryption and signing with combined method';
 156 {
 157     my $entity = MIME::Entity->build(
 158         From    => 'rt@example.com',
 159         To      => 'rt@example.com',
 160         Subject => 'test',
 161         Data    => ['test'],
 162     );
 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" );
 166
 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');
 175
 176     ok($entity, 'get an encrypted and signed part');
 177
 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" );
 183 }
 184
 185 diag 'encryption and signing with cascading, sign on encrypted';
 186 {
 187     my $entity = MIME::Entity->build(
 188         From    => 'rt@example.com',
 189         To      => 'rt@example.com',
 190         Subject => 'test',
 191         Data    => ['test'],
 192     );
 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" );
 199
 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" );
 205 }
 206
 207 diag 'find signed/encrypted part deep inside';
 208 {
 209     my $entity = MIME::Entity->build(
 210         From    => 'rt@example.com',
 211         To      => 'rt@example.com',
 212         Subject => 'test',
 213         Data    => ['test'],
 214     );
 215     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 216     ok( !$res{'exit_code'}, "success" );
 217     $entity->make_multipart( 'mixed', Force => 1 );
 218     $entity->attach(
 219         Type => 'text/plain',
 220         Data => ['-'x76, 'this is mailing list'],
 221     );
 222
 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" );
 228 }
 229
 230 diag 'wrong signed/encrypted parts: no protocol';
 231 {
 232     my $entity = MIME::Entity->build(
 233         From    => 'rt@example.com',
 234         To      => 'rt@example.com',
 235         Subject => 'test',
 236         Data    => ['test'],
 237     );
 238
 239     my %res = RT::Crypt::GnuPG::SignEncrypt(
 240         Entity => $entity,
 241         Sign   => 0,
 242     );
 243
 244     ok( !$res{'exit_code'}, 'success' );
 245     $entity->head->mime_attr( 'Content-Type.protocol' => undef );
 246
 247     my @parts;
 248     warning_like {
 249         @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 250     } qr{Entity is 'multipart/encrypted', but has no protocol defined. Skipped};
 251
 252     is( scalar @parts, 0, 'no protected parts' );
 253 }
 254
 255 diag 'wrong signed/encrypted parts: not enought parts';
 256 {
 257     my $entity = MIME::Entity->build(
 258         From    => 'rt@example.com',
 259         To      => 'rt@example.com',
 260         Subject => 'test',
 261         Data    => ['test'],
 262     );
 263
 264     my %res = RT::Crypt::GnuPG::SignEncrypt(
 265         Entity => $entity,
 266         Sign   => 0,
 267     );
 268
 269     ok( !$res{'exit_code'}, 'success' );
 270     $entity->parts([ $entity->parts(0) ]);
 271
 272     my @parts;
 273     warning_like {
 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' );
 277 }
 278
 279 diag 'wrong signed/encrypted parts: wrong proto';
 280 {
 281     my $entity = MIME::Entity->build(
 282         From    => 'rt@example.com',
 283         To      => 'rt@example.com',
 284         Subject => 'test',
 285         Data    => ['test'],
 286     );
 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' );
 290
 291     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 292     is( scalar @parts, 0, 'no protected parts' );
 293 }
 294
 295 diag 'wrong signed/encrypted parts: wrong proto';
 296 {
 297     my $entity = MIME::Entity->build(
 298         From    => 'rt@example.com',
 299         To      => 'rt@example.com',
 300         Subject => 'test',
 301         Data    => ['test'],
 302     );
 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' );
 306
 307     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 308     is( scalar @parts, 0, 'no protected parts' );
 309 }
 310
 311 diag 'verify inline and in attachment signatures';
 312 {
 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 );
 316
 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" );
 322
 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" );
 327
 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');
 334
 335     $parser->filer->purge();
 336 }
 337