rt/t/mail/gnupg-incoming.t

   1 use strict;
   2 use warnings;
   3
   4 my $homedir;
   5 BEGIN {
   6     require RT::Test;
   7     $homedir =
   8       RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
   9         qw/data gnupg keyrings/ );
  10 }
  11
  12 use RT::Test::GnuPG
  13   tests         => 53,
  14   actual_server => 1,
  15   gnupg_options => {
  16     passphrase => 'rt-test',
  17     homedir    => $homedir,
  18   };
  19
  20 use String::ShellQuote 'shell_quote';
  21 use IPC::Run3 'run3';
  22 use MIME::Base64;
  23
  24 my ($baseurl, $m) = RT::Test->started_ok;
  25
  26 # configure key for General queue
  27 ok( $m->login, 'we did log in' );
  28 $m->get( $baseurl.'/Admin/Queues/');
  29 $m->follow_link_ok( {text => 'General'} );
  30 $m->submit_form( form_number => 3,
  31                  fields      => { CorrespondAddress => 'general@example.com' } );
  32 $m->content_like(qr/general\@example.com.* - never/, 'has key info.');
  33
  34 ok(my $user = RT::User->new(RT->SystemUser));
  35 ok($user->Load('root'), "Loaded user 'root'");
  36 $user->SetEmailAddress('recipient@example.com');
  37
  38 # test simple mail.  supposedly this should fail when
  39 # 1. the queue requires signature
  40 # 2. the from is not what the key is associated with
  41 my $mail = RT::Test->open_mailgate_ok($baseurl);
  42 print $mail <<EOF;
  43 From: recipient\@example.com
  44 To: general\@$RT::rtname
  45 Subject: This is a test of new ticket creation as root
  46
  47 Blah!
  48 Foob!
  49 EOF
  50 RT::Test->close_mailgate_ok($mail);
  51
  52 {
  53     my $tick = RT::Test->last_ticket;
  54     is( $tick->Subject,
  55         'This is a test of new ticket creation as root',
  56         "Created the ticket"
  57     );
  58     my $txn = $tick->Transactions->First;
  59     like(
  60         $txn->Attachments->First->Headers,
  61         qr/^X-RT-Incoming-Encryption: Not encrypted/m,
  62         'recorded incoming mail that is not encrypted'
  63     );
  64     like( $txn->Attachments->First->Content, qr/Blah/);
  65 }
  66
  67 # test for signed mail
  68 my $buf = '';
  69
  70 run3(
  71     shell_quote(
  72         qw(gpg --batch --no-tty --armor --sign),
  73         '--default-key' => 'recipient@example.com',
  74         '--homedir'     => $homedir,
  75         '--passphrase'  => 'recipient',
  76     ),
  77     \"fnord\r\n",
  78     \$buf,
  79     \*STDOUT
  80 );
  81
  82 $mail = RT::Test->open_mailgate_ok($baseurl);
  83 print $mail <<"EOF";
  84 From: recipient\@example.com
  85 To: general\@$RT::rtname
  86 Subject: signed message for queue
  87
  88 $buf
  89 EOF
  90 RT::Test->close_mailgate_ok($mail);
  91
  92 {
  93     my $tick = RT::Test->last_ticket;
  94     is( $tick->Subject, 'signed message for queue',
  95         "Created the ticket"
  96     );
  97
  98     my $txn = $tick->Transactions->First;
  99     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 100
 101     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 102         'Not encrypted',
 103         'recorded incoming mail that is encrypted'
 104     );
 105     # test for some kind of PGP-Signed-By: Header
 106     like( $attach->Content, qr/fnord/);
 107 }
 108
 109 # test for clear-signed mail
 110 $buf = '';
 111
 112 run3(
 113     shell_quote(
 114         qw(gpg --batch --no-tty --armor --sign --clearsign),
 115         '--default-key' => 'recipient@example.com',
 116         '--homedir'     => $homedir,
 117         '--passphrase'  => 'recipient',
 118     ),
 119     \"clearfnord\r\n",
 120     \$buf,
 121     \*STDOUT
 122 );
 123
 124 $mail = RT::Test->open_mailgate_ok($baseurl);
 125 print $mail <<"EOF";
 126 From: recipient\@example.com
 127 To: general\@$RT::rtname
 128 Subject: signed message for queue
 129
 130 $buf
 131 EOF
 132 RT::Test->close_mailgate_ok($mail);
 133
 134 {
 135     my $tick = RT::Test->last_ticket;
 136     is( $tick->Subject, 'signed message for queue',
 137         "Created the ticket"
 138     );
 139
 140     my $txn = $tick->Transactions->First;
 141     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 142     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 143         'Not encrypted',
 144         'recorded incoming mail that is encrypted'
 145     );
 146     # test for some kind of PGP-Signed-By: Header
 147     like( $attach->Content, qr/clearfnord/);
 148 }
 149
 150 # test for signed and encrypted mail
 151 $buf = '';
 152
 153 run3(
 154     shell_quote(
 155         qw(gpg --batch --no-tty --encrypt --armor --sign),
 156         '--recipient'   => 'general@example.com',
 157         '--default-key' => 'recipient@example.com',
 158         '--homedir'     => $homedir,
 159         '--passphrase'  => 'recipient',
 160     ),
 161     \"orzzzzzz\r\n",
 162     \$buf,
 163     \*STDOUT
 164 );
 165
 166 $mail = RT::Test->open_mailgate_ok($baseurl);
 167 print $mail <<"EOF";
 168 From: recipient\@example.com
 169 To: general\@$RT::rtname
 170 Subject: Encrypted message for queue
 171
 172 $buf
 173 EOF
 174 RT::Test->close_mailgate_ok($mail);
 175
 176 {
 177     my $tick = RT::Test->last_ticket;
 178     is( $tick->Subject, 'Encrypted message for queue',
 179         "Created the ticket"
 180     );
 181
 182     my $txn = $tick->Transactions->First;
 183     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 184
 185     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 186         'Success',
 187         'recorded incoming mail that is encrypted'
 188     );
 189     is( $msg->GetHeader('X-RT-Privacy'),
 190         'PGP',
 191         'recorded incoming mail that is encrypted'
 192     );
 193     like( $attach->Content, qr/orz/);
 194
 195     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 196     ok(index($orig->Content, $buf) != -1, 'found original msg');
 197 }
 198
 199
 200 # test that if it gets base64 transfer-encoded, we still get the content out
 201 $buf = encode_base64($buf);
 202 $mail = RT::Test->open_mailgate_ok($baseurl);
 203 print $mail <<"EOF";
 204 From: recipient\@example.com
 205 To: general\@$RT::rtname
 206 Content-transfer-encoding: base64
 207 Subject: Encrypted message for queue
 208
 209 $buf
 210 EOF
 211 RT::Test->close_mailgate_ok($mail);
 212
 213 {
 214     my $tick = RT::Test->last_ticket;
 215     is( $tick->Subject, 'Encrypted message for queue',
 216         "Created the ticket"
 217     );
 218
 219     my $txn = $tick->Transactions->First;
 220     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 221
 222     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 223         'Success',
 224         'recorded incoming mail that is encrypted'
 225     );
 226     is( $msg->GetHeader('X-RT-Privacy'),
 227         'PGP',
 228         'recorded incoming mail that is encrypted'
 229     );
 230     like( $attach->Content, qr/orz/);
 231
 232     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 233     ok(index($orig->Content, $buf) != -1, 'found original msg');
 234 }
 235
 236 # test for signed mail by other key
 237 $buf = '';
 238
 239 run3(
 240     shell_quote(
 241         qw(gpg --batch --no-tty --armor --sign),
 242         '--default-key' => 'rt@example.com',
 243         '--homedir'     => $homedir,
 244         '--passphrase'  => 'test',
 245     ),
 246     \"alright\r\n",
 247     \$buf,
 248     \*STDOUT
 249 );
 250
 251 $mail = RT::Test->open_mailgate_ok($baseurl);
 252 print $mail <<"EOF";
 253 From: recipient\@example.com
 254 To: general\@$RT::rtname
 255 Subject: signed message for queue
 256
 257 $buf
 258 EOF
 259 RT::Test->close_mailgate_ok($mail);
 260
 261 {
 262     my $tick = RT::Test->last_ticket;
 263     my $txn = $tick->Transactions->First;
 264     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 265     # XXX: in this case, which credential should we be using?
 266     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 267         'Test User <rt@example.com>',
 268         'recorded incoming mail signed by others'
 269     );
 270 }
 271
 272 # test for encrypted mail with key not associated to the queue
 273 $buf = '';
 274
 275 run3(
 276     shell_quote(
 277         qw(gpg --batch --no-tty --armor --encrypt),
 278         '--recipient'   => 'random@localhost',
 279         '--homedir'     => $homedir,
 280     ),
 281     \"should not be there either\r\n",
 282     \$buf,
 283     \*STDOUT
 284 );
 285
 286 $mail = RT::Test->open_mailgate_ok($baseurl);
 287 print $mail <<"EOF";
 288 From: recipient\@example.com
 289 To: general\@$RT::rtname
 290 Subject: encrypted message for queue
 291
 292 $buf
 293 EOF
 294 RT::Test->close_mailgate_ok($mail);
 295
 296 {
 297     my $tick = RT::Test->last_ticket;
 298     my $txn = $tick->Transactions->First;
 299     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 300
 301     TODO:
 302     {
 303         local $TODO = "this test requires keys associated with queues";
 304         unlike( $attach->Content, qr/should not be there either/);
 305     }
 306 }
 307
 308 # test for badly encrypted mail
 309 {
 310 $buf = '';
 311
 312 run3(
 313     shell_quote(
 314         qw(gpg --batch --no-tty --armor --encrypt),
 315         '--recipient'   => 'rt@example.com',
 316         '--homedir'     => $homedir,
 317     ),
 318     \"really should not be there either\r\n",
 319     \$buf,
 320     \*STDOUT
 321 );
 322
 323 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 324
 325 RT::Test->fetch_caught_mails;
 326
 327 $mail = RT::Test->open_mailgate_ok($baseurl);
 328 print $mail <<"EOF";
 329 From: recipient\@example.com
 330 To: general\@$RT::rtname
 331 Subject: encrypted message for queue
 332
 333 $buf
 334 EOF
 335 RT::Test->close_mailgate_ok($mail);
 336 my @mail = RT::Test->fetch_caught_mails;
 337 is(@mail, 1, 'caught outgoing mail.');
 338 }
 339
 340 {
 341     my $tick = RT::Test->last_ticket;
 342     my $txn = $tick->Transactions->First;
 343     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 344     unlike( ($attach ? $attach->Content : ''), qr/really should not be there either/);
 345 }
 346
 347
 348 # test that if it gets base64 transfer-encoded long mail then it doesn't hang
 349 {
 350     local $SIG{ALRM} = sub {
 351         ok 0, "timed out, web server is probably in deadlock";
 352         exit;
 353     };
 354     alarm 30;
 355     $buf = encode_base64('a'x(250*1024));
 356     $mail = RT::Test->open_mailgate_ok($baseurl);
 357     print $mail <<"EOF";
 358 From: recipient\@example.com
 359 To: general\@$RT::rtname
 360 Content-transfer-encoding: base64
 361 Subject: Long not encrypted message for queue
 362
 363 $buf
 364 EOF
 365     RT::Test->close_mailgate_ok($mail);
 366     alarm 0;
 367
 368     my $tick = RT::Test->last_ticket;
 369     is( $tick->Subject, 'Long not encrypted message for queue',
 370         "Created the ticket"
 371     );
 372     my $content = $tick->Transactions->First->Content;
 373     like $content, qr/a{1024,}/, 'content is not lost';
 374 }