rt/t/mail/crypt-gnupg.t

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