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 => 100, gnupg_options => { homedir => $homedir };
  14 use Test::Warn;
  15
  16 use_ok('RT::Crypt');
  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->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'}
  31     );
  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');
  38
  39     ok( $entity->is_multipart, 'signed message is multipart' );
  40     is( $entity->parts, 2, 'two parts' );
  41
  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" );
  47
  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'}
  52     );
  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');
  57 }
  58
  59 diag 'only signing. missing passphrase';
  60 {
  61     my $entity = MIME::Entity->build(
  62         From    => 'rt@example.com',
  63         Subject => 'test',
  64         Data    => ['test'],
  65     );
  66     my %res;
  67     warning_like {
  68         %res = RT::Crypt->SignEncrypt(
  69             Entity     => $entity,
  70             Encrypt    => 0,
  71             Passphrase => ''
  72         );
  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" );
  76
  77     my @status = RT::Crypt->ParseStatus(
  78         Protocol => $res{'Protocol'}, Status => $res{'status'}
  79     );
  80     is( scalar @status, 1, 'one record');
  81     is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
  82     is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase');
  83 }
  84
  85 diag 'only signing. wrong passphrase';
  86 {
  87     my $entity = MIME::Entity->build(
  88         From    => 'rt@example.com',
  89         Subject => 'test',
  90         Data    => ['test'],
  91     );
  92
  93     my %res;
  94     warning_like {
  95         %res = RT::Crypt->SignEncrypt(
  96             Entity     => $entity,
  97             Encrypt    => 0,
  98             Passphrase => 'wrong',
  99         );
 100     } qr/bad passphrase/;
 101
 102     ok( $res{'exit_code'}, "couldn't sign with bad passphrase");
 103     ok( $res{'error'} || $res{'logger'}, "error is here" );
 104
 105     my @status = RT::Crypt->ParseStatus(
 106         Protocol => $res{'Protocol'}, Status => $res{'status'}
 107     );
 108     is( scalar @status, 1, 'one record');
 109     is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
 110     is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase');
 111 }
 112
 113 diag 'encryption only';
 114 {
 115     my $entity = MIME::Entity->build(
 116         From    => 'rt@example.com',
 117         To      => 'rt@example.com',
 118         Subject => 'test',
 119         Data    => ['test'],
 120     );
 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" );
 124
 125     my @status = RT::Crypt->ParseStatus(
 126         Protocol => $res{'Protocol'}, Status => $res{'status'}
 127     );
 128     is( scalar @status, 1, 'one record');
 129     is( $status[0]->{'Operation'}, 'Encrypt', 'operation is correct');
 130     is( $status[0]->{'Status'}, 'DONE', 'done');
 131
 132     ok($entity, 'get an encrypted part');
 133
 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" );
 139 }
 140
 141 diag 'encryption only, bad recipient';
 142 {
 143     my $entity = MIME::Entity->build(
 144         From    => 'rt@example.com',
 145         To      => 'keyless@example.com',
 146         Subject => 'test',
 147         Data    => ['test'],
 148     );
 149
 150     my %res;
 151     warning_like {
 152         %res = RT::Crypt->SignEncrypt(
 153             Entity => $entity,
 154             Sign   => 0,
 155         );
 156     } qr/public key not found/;
 157
 158     ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients');
 159     ok( $res{'logger'}, "errors are in logger" );
 160
 161     my @status = RT::Crypt->ParseStatus(
 162         Protocol => $res{'Protocol'}, Status => $res{'status'}
 163     );
 164     is( scalar @status, 1, 'one record');
 165     is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient');
 166 }
 167
 168 diag 'encryption and signing with combined method';
 169 {
 170     my $entity = MIME::Entity->build(
 171         From    => 'rt@example.com',
 172         To      => 'rt@example.com',
 173         Subject => 'test',
 174         Data    => ['test'],
 175     );
 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" );
 179
 180     my @status = RT::Crypt->ParseStatus(
 181         Protocol => $res{'Protocol'}, Status => $res{'status'}
 182     );
 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');
 190
 191     ok($entity, 'get an encrypted and signed part');
 192
 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" );
 198 }
 199
 200 diag 'encryption and signing with cascading, sign on encrypted';
 201 {
 202     my $entity = MIME::Entity->build(
 203         From    => 'rt@example.com',
 204         To      => 'rt@example.com',
 205         Subject => 'test',
 206         Data    => ['test'],
 207     );
 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" );
 214
 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" );
 220 }
 221
 222 diag 'find signed/encrypted part deep inside';
 223 {
 224     my $entity = MIME::Entity->build(
 225         From    => 'rt@example.com',
 226         To      => 'rt@example.com',
 227         Subject => 'test',
 228         Data    => ['test'],
 229     );
 230     my %res = RT::Crypt->SignEncrypt( Entity => $entity, Sign => 0 );
 231     ok( !$res{'exit_code'}, "success" );
 232     $entity->make_multipart( 'mixed', Force => 1 );
 233     $entity->attach(
 234         Type => 'text/plain',
 235         Data => ['-'x76, 'this is mailing list'],
 236     );
 237
 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" );
 243 }
 244
 245 diag 'wrong signed/encrypted parts: no protocol';
 246 {
 247     my $entity = MIME::Entity->build(
 248         From    => 'rt@example.com',
 249         To      => 'rt@example.com',
 250         Subject => 'test',
 251         Data    => ['test'],
 252     );
 253
 254     my %res = RT::Crypt->SignEncrypt(
 255         Entity => $entity,
 256         Sign   => 0,
 257     );
 258
 259     ok( !$res{'exit_code'}, 'success' );
 260     $entity->head->mime_attr( 'Content-Type.protocol' => undef );
 261
 262     my @parts;
 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" );
 269 }
 270
 271 diag 'wrong signed/encrypted parts: not enought parts';
 272 {
 273     my $entity = MIME::Entity->build(
 274         From    => 'rt@example.com',
 275         To      => 'rt@example.com',
 276         Subject => 'test',
 277         Data    => ['test'],
 278     );
 279
 280     my %res = RT::Crypt->SignEncrypt(
 281         Entity => $entity,
 282         Sign   => 0,
 283     );
 284
 285     ok( !$res{'exit_code'}, 'success' );
 286     $entity->parts([ $entity->parts(0) ]);
 287
 288     my @parts;
 289     warning_like {
 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' );
 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->SignEncrypt( Entity => $entity, Sign => 0 );
 304     ok( !$res{'exit_code'}, 'success' );
 305     $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
 306
 307     my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
 308     is( scalar @parts, 0, 'no protected parts' );
 309 }
 310
 311 diag 'wrong signed/encrypted parts: wrong proto';
 312 {
 313     my $entity = MIME::Entity->build(
 314         From    => 'rt@example.com',
 315         To      => 'rt@example.com',
 316         Subject => 'test',
 317         Data    => ['test'],
 318     );
 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' );
 322
 323     my @parts = RT::Crypt->FindProtectedParts( Entity => $entity );
 324     is( scalar @parts, 0, 'no protected parts' );
 325 }
 326
 327 diag 'verify inline and in attachment signatures';
 328 {
 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 );
 332
 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" );
 338
 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" );
 343
 344     my @res = RT::Crypt->VerifyDecrypt( Entity => $entity );
 345     my @status = RT::Crypt->ParseStatus(
 346         Protocol => $res[0]{'Protocol'}, Status => $res[0]{'status'}
 347     );
 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');
 352
 353     $parser->filer->purge();
 354 }
 355