rt/t/mail/gnupg-incoming.t

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