rt/t/mail/crypt-gnupg.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use RT::Test nodata => 1, tests => 92;
   7 plan skip_all => 'GnuPG required.'
   8     unless eval 'use GnuPG::Interface; 1';
   9 plan skip_all => 'gpg executable is required.'
  10     unless RT::Test->find_executable('gpg');
  11
  12
  13 use File::Spec ();
  14 use Cwd;
  15
  16 my $homedir = RT::Test::get_abs_relocatable_dir(File::Spec->updir(),
  17     qw(data gnupg keyrings) );
  18
  19 mkdir $homedir;
  20
  21 use_ok('RT::Crypt::GnuPG');
  22 use_ok('MIME::Entity');
  23
  24 RT->Config->Set( 'GnuPG',
  25                  Enable => 1,
  26                  OutgoingMessagesFormat => 'RFC' );
  27
  28 RT->Config->Set( 'GnuPGOptions',
  29                  homedir => $homedir,
  30                  'no-permission-warning' => undef,
  31 );
  32
  33
  34 diag 'only signing. correct passphrase' if $ENV{'TEST_VERBOSE'};
  35 {
  36     my $entity = MIME::Entity->build(
  37         From    => 'rt@example.com',
  38         Subject => 'test',
  39         Data    => ['test'],
  40     );
  41     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
  42     ok( $entity, 'signed entity');
  43     ok( !$res{'logger'}, "log is here as well" ) or diag $res{'logger'};
  44     my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
  45     is( scalar @status, 2, 'two records: passphrase, signing');
  46     is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
  47     is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
  48     is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
  49     is( $status[1]->{'Status'}, 'DONE', 'done');
  50     is( $status[1]->{'User'}->{'EmailAddress'}, 'rt@example.com', 'correct email');
  51
  52     ok( $entity->is_multipart, 'signed message is multipart' );
  53     is( $entity->parts, 2, 'two parts' );
  54
  55     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
  56     is( scalar @parts, 1, 'one protected part' );
  57     is( $parts[0]->{'Type'}, 'signed', "have signed part" );
  58     is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
  59     is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
  60
  61     my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
  62     is scalar @res, 1, 'one operation';
  63     @status = RT::Crypt::GnuPG::ParseStatus( $res[0]{'status'} );
  64     is( scalar @status, 1, 'one record');
  65     is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
  66     is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
  67     is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
  68 }
  69
  70 diag 'only signing. missing passphrase' if $ENV{'TEST_VERBOSE'};
  71 {
  72     my $entity = MIME::Entity->build(
  73         From    => 'rt@example.com',
  74         Subject => 'test',
  75         Data    => ['test'],
  76     );
  77     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => '' );
  78     ok( $res{'exit_code'}, "couldn't sign without passphrase");
  79     ok( $res{'error'} || $res{'logger'}, "error is here" );
  80
  81     my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
  82     is( scalar @status, 1, 'one record');
  83     is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
  84     is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase');
  85 }
  86
  87 diag 'only signing. wrong passphrase' if $ENV{'TEST_VERBOSE'};
  88 {
  89     my $entity = MIME::Entity->build(
  90         From    => 'rt@example.com',
  91         Subject => 'test',
  92         Data    => ['test'],
  93     );
  94     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'wrong' );
  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' if $ENV{'TEST_VERBOSE'};
 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' if $ENV{'TEST_VERBOSE'};
 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     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 139     ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients');
 140     ok( $res{'logger'}, "errors are in logger" );
 141
 142     my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
 143     is( scalar @status, 1, 'one record');
 144     is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient');
 145 }
 146
 147 diag 'encryption and signing with combined method' if $ENV{'TEST_VERBOSE'};
 148 {
 149     my $entity = MIME::Entity->build(
 150         From    => 'rt@example.com',
 151         To      => 'rt@example.com',
 152         Subject => 'test',
 153         Data    => ['test'],
 154     );
 155     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Passphrase => 'test' );
 156     ok( !$res{'exit_code'}, "successful encryption with signing" );
 157     ok( !$res{'logger'}, "no records in logger" );
 158
 159     my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
 160     is( scalar @status, 3, 'three records: passphrase, sign and encrypt');
 161     is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct');
 162     is( $status[0]->{'Status'}, 'DONE', 'done');
 163     is( $status[1]->{'Operation'}, 'Sign', 'operation is correct');
 164     is( $status[1]->{'Status'}, 'DONE', 'done');
 165     is( $status[2]->{'Operation'}, 'Encrypt', 'operation is correct');
 166     is( $status[2]->{'Status'}, 'DONE', 'done');
 167
 168     ok($entity, 'get an encrypted and signed part');
 169
 170     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 171     is( scalar @parts, 1, 'one protected part' );
 172     is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
 173     is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
 174     is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
 175 }
 176
 177 diag 'encryption and signing with cascading, sign on encrypted' if $ENV{'TEST_VERBOSE'};
 178 {
 179     my $entity = MIME::Entity->build(
 180         From    => 'rt@example.com',
 181         To      => 'rt@example.com',
 182         Subject => 'test',
 183         Data    => ['test'],
 184     );
 185     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 186     ok( !$res{'exit_code'}, 'successful encryption' );
 187     ok( !$res{'logger'}, "no records in logger" );
 188     %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
 189     ok( !$res{'exit_code'}, 'successful signing' );
 190     ok( !$res{'logger'}, "no records in logger" );
 191
 192     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 193     is( scalar @parts, 1, 'one protected part, top most' );
 194     is( $parts[0]->{'Type'}, 'signed', "have signed part" );
 195     is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
 196     is( $parts[0]->{'Top'}, $entity, "it's the same entity" );
 197 }
 198
 199 diag 'find signed/encrypted part deep inside' if $ENV{'TEST_VERBOSE'};
 200 {
 201     my $entity = MIME::Entity->build(
 202         From    => 'rt@example.com',
 203         To      => 'rt@example.com',
 204         Subject => 'test',
 205         Data    => ['test'],
 206     );
 207     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 208     ok( !$res{'exit_code'}, "success" );
 209     $entity->make_multipart( 'mixed', Force => 1 );
 210     $entity->attach(
 211         Type => 'text/plain',
 212         Data => ['-'x76, 'this is mailing list'],
 213     );
 214
 215     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 216     is( scalar @parts, 1, 'one protected part' );
 217     is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" );
 218     is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" );
 219     is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" );
 220 }
 221
 222 diag 'wrong signed/encrypted parts: no protocol' if $ENV{'TEST_VERBOSE'};
 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::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 231     ok( !$res{'exit_code'}, 'success' );
 232     $entity->head->mime_attr( 'Content-Type.protocol' => undef );
 233
 234     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 235     is( scalar @parts, 0, 'no protected parts' );
 236 }
 237
 238 diag 'wrong signed/encrypted parts: not enought parts' if $ENV{'TEST_VERBOSE'};
 239 {
 240     my $entity = MIME::Entity->build(
 241         From    => 'rt@example.com',
 242         To      => 'rt@example.com',
 243         Subject => 'test',
 244         Data    => ['test'],
 245     );
 246     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 247     ok( !$res{'exit_code'}, 'success' );
 248     $entity->parts([ $entity->parts(0) ]);
 249
 250     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 251     is( scalar @parts, 0, 'no protected parts' );
 252 }
 253
 254 diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'};
 255 {
 256     my $entity = MIME::Entity->build(
 257         From    => 'rt@example.com',
 258         To      => 'rt@example.com',
 259         Subject => 'test',
 260         Data    => ['test'],
 261     );
 262     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 );
 263     ok( !$res{'exit_code'}, 'success' );
 264     $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
 265
 266     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 267     is( scalar @parts, 0, 'no protected parts' );
 268 }
 269
 270 diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'};
 271 {
 272     my $entity = MIME::Entity->build(
 273         From    => 'rt@example.com',
 274         To      => 'rt@example.com',
 275         Subject => 'test',
 276         Data    => ['test'],
 277     );
 278     my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' );
 279     ok( !$res{'exit_code'}, 'success' );
 280     $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' );
 281
 282     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 283     is( scalar @parts, 0, 'no protected parts' );
 284 }
 285
 286 diag 'verify inline and in attachment signatures' if $ENV{'TEST_VERBOSE'};
 287 {
 288     open( my $fh, '<', "$homedir/signed_old_style_with_attachment.eml" ) or die $!;
 289     my $parser = new MIME::Parser;
 290     my $entity = $parser->parse( $fh );
 291
 292     my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity );
 293     is( scalar @parts, 2, 'two protected parts' );
 294     is( $parts[1]->{'Type'}, 'signed', "have signed part" );
 295     is( $parts[1]->{'Format'}, 'Inline', "inline format" );
 296     is( $parts[1]->{'Data'}, $entity->parts(0), "it's first part" );
 297
 298     is( $parts[0]->{'Type'}, 'signed', "have signed part" );
 299     is( $parts[0]->{'Format'}, 'Attachment', "attachment format" );
 300     is( $parts[0]->{'Data'}, $entity->parts(1), "data in second part" );
 301     is( $parts[0]->{'Signature'}, $entity->parts(2), "file's signature in third part" );
 302
 303     my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity );
 304     my @status = RT::Crypt::GnuPG::ParseStatus( $res[0]->{'status'} );
 305     is( scalar @status, 1, 'one record');
 306     is( $status[0]->{'Operation'}, 'Verify', 'operation is correct');
 307     is( $status[0]->{'Status'}, 'DONE', 'good passphrase');
 308     is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value');
 309
 310     $parser->filer->purge();
 311 }
 312