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         '--no-permission-warning',
  77     ),
  78     \"fnord\r\n",
  79     \$buf,
  80     \*STDOUT
  81 );
  82
  83 $mail = RT::Test->open_mailgate_ok($baseurl);
  84 print $mail <<"EOF";
  85 From: recipient\@example.com
  86 To: general\@$RT::rtname
  87 Subject: signed message for queue
  88
  89 $buf
  90 EOF
  91 RT::Test->close_mailgate_ok($mail);
  92
  93 {
  94     my $tick = RT::Test->last_ticket;
  95     is( $tick->Subject, 'signed message for queue',
  96         "Created the ticket"
  97     );
  98
  99     my $txn = $tick->Transactions->First;
 100     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 101
 102     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 103         'Not encrypted',
 104         'recorded incoming mail that is encrypted'
 105     );
 106     # test for some kind of PGP-Signed-By: Header
 107     like( $attach->Content, qr/fnord/);
 108 }
 109
 110 # test for clear-signed mail
 111 $buf = '';
 112
 113 run3(
 114     shell_quote(
 115         qw(gpg --batch --no-tty --armor --sign --clearsign),
 116         '--default-key' => 'recipient@example.com',
 117         '--homedir'     => $homedir,
 118         '--passphrase'  => 'recipient',
 119         '--no-permission-warning',
 120     ),
 121     \"clearfnord\r\n",
 122     \$buf,
 123     \*STDOUT
 124 );
 125
 126 $mail = RT::Test->open_mailgate_ok($baseurl);
 127 print $mail <<"EOF";
 128 From: recipient\@example.com
 129 To: general\@$RT::rtname
 130 Subject: signed message for queue
 131
 132 $buf
 133 EOF
 134 RT::Test->close_mailgate_ok($mail);
 135
 136 {
 137     my $tick = RT::Test->last_ticket;
 138     is( $tick->Subject, 'signed message for queue',
 139         "Created the ticket"
 140     );
 141
 142     my $txn = $tick->Transactions->First;
 143     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 144     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 145         'Not encrypted',
 146         'recorded incoming mail that is encrypted'
 147     );
 148     # test for some kind of PGP-Signed-By: Header
 149     like( $attach->Content, qr/clearfnord/);
 150 }
 151
 152 # test for signed and encrypted mail
 153 $buf = '';
 154
 155 run3(
 156     shell_quote(
 157         qw(gpg --batch --no-tty --encrypt --armor --sign),
 158         '--recipient'   => 'general@example.com',
 159         '--default-key' => 'recipient@example.com',
 160         '--homedir'     => $homedir,
 161         '--passphrase'  => 'recipient',
 162         '--no-permission-warning',
 163     ),
 164     \"orzzzzzz\r\n",
 165     \$buf,
 166     \*STDOUT
 167 );
 168
 169 $mail = RT::Test->open_mailgate_ok($baseurl);
 170 print $mail <<"EOF";
 171 From: recipient\@example.com
 172 To: general\@$RT::rtname
 173 Subject: Encrypted message for queue
 174
 175 $buf
 176 EOF
 177 RT::Test->close_mailgate_ok($mail);
 178
 179 {
 180     my $tick = RT::Test->last_ticket;
 181     is( $tick->Subject, 'Encrypted message for queue',
 182         "Created the ticket"
 183     );
 184
 185     my $txn = $tick->Transactions->First;
 186     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 187
 188     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 189         'Success',
 190         'recorded incoming mail that is encrypted'
 191     );
 192     is( $msg->GetHeader('X-RT-Privacy'),
 193         'GnuPG',
 194         'recorded incoming mail that is encrypted'
 195     );
 196     like( $attach->Content, qr/orz/);
 197
 198     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 199     ok(index($orig->Content, $buf) != -1, 'found original msg');
 200 }
 201
 202
 203 # test that if it gets base64 transfer-encoded, we still get the content out
 204 $buf = encode_base64($buf);
 205 $mail = RT::Test->open_mailgate_ok($baseurl);
 206 print $mail <<"EOF";
 207 From: recipient\@example.com
 208 To: general\@$RT::rtname
 209 Content-transfer-encoding: base64
 210 Subject: Encrypted message for queue
 211
 212 $buf
 213 EOF
 214 RT::Test->close_mailgate_ok($mail);
 215
 216 {
 217     my $tick = RT::Test->last_ticket;
 218     is( $tick->Subject, 'Encrypted message for queue',
 219         "Created the ticket"
 220     );
 221
 222     my $txn = $tick->Transactions->First;
 223     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 224
 225     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 226         'Success',
 227         'recorded incoming mail that is encrypted'
 228     );
 229     is( $msg->GetHeader('X-RT-Privacy'),
 230         'GnuPG',
 231         'recorded incoming mail that is encrypted'
 232     );
 233     like( $attach->Content, qr/orz/);
 234
 235     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 236     ok(index($orig->Content, $buf) != -1, 'found original msg');
 237 }
 238
 239 # test for signed mail by other key
 240 $buf = '';
 241
 242 run3(
 243     shell_quote(
 244         qw(gpg --batch --no-tty --armor --sign),
 245         '--default-key' => 'rt@example.com',
 246         '--homedir'     => $homedir,
 247         '--passphrase'  => 'test',
 248         '--no-permission-warning',
 249     ),
 250     \"alright\r\n",
 251     \$buf,
 252     \*STDOUT
 253 );
 254
 255 $mail = RT::Test->open_mailgate_ok($baseurl);
 256 print $mail <<"EOF";
 257 From: recipient\@example.com
 258 To: general\@$RT::rtname
 259 Subject: signed message for queue
 260
 261 $buf
 262 EOF
 263 RT::Test->close_mailgate_ok($mail);
 264
 265 {
 266     my $tick = RT::Test->last_ticket;
 267     my $txn = $tick->Transactions->First;
 268     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 269     # XXX: in this case, which credential should we be using?
 270     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 271         'Test User <rt@example.com>',
 272         'recorded incoming mail signed by others'
 273     );
 274 }
 275
 276 # test for encrypted mail with key not associated to the queue
 277 $buf = '';
 278
 279 run3(
 280     shell_quote(
 281         qw(gpg --batch --no-tty --armor --encrypt),
 282         '--recipient'   => 'random@localhost',
 283         '--homedir'     => $homedir,
 284         '--no-permission-warning',
 285     ),
 286     \"should not be there either\r\n",
 287     \$buf,
 288     \*STDOUT
 289 );
 290
 291 $mail = RT::Test->open_mailgate_ok($baseurl);
 292 print $mail <<"EOF";
 293 From: recipient\@example.com
 294 To: general\@$RT::rtname
 295 Subject: encrypted message for queue
 296
 297 $buf
 298 EOF
 299 RT::Test->close_mailgate_ok($mail);
 300
 301 {
 302     my $tick = RT::Test->last_ticket;
 303     my $txn = $tick->Transactions->First;
 304     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 305
 306     TODO:
 307     {
 308         local $TODO = "this test requires keys associated with queues";
 309         unlike( $attach->Content, qr/should not be there either/);
 310     }
 311 }
 312
 313 # test for badly encrypted mail
 314 {
 315 $buf = '';
 316
 317 run3(
 318     shell_quote(
 319         qw(gpg --batch --no-tty --armor --encrypt),
 320         '--recipient'   => 'rt@example.com',
 321         '--homedir'     => $homedir,
 322         '--no-permission-warning',
 323     ),
 324     \"really should not be there either\r\n",
 325     \$buf,
 326     \*STDOUT
 327 );
 328
 329 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 330
 331 RT::Test->fetch_caught_mails;
 332
 333 $mail = RT::Test->open_mailgate_ok($baseurl);
 334 print $mail <<"EOF";
 335 From: recipient\@example.com
 336 To: general\@$RT::rtname
 337 Subject: encrypted message for queue
 338
 339 $buf
 340 EOF
 341 RT::Test->close_mailgate_ok($mail);
 342 my @mail = RT::Test->fetch_caught_mails;
 343 is(@mail, 1, 'caught outgoing mail.');
 344 }
 345
 346 {
 347     my $tick = RT::Test->last_ticket;
 348     my $txn = $tick->Transactions->First;
 349     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 350     unlike( ($attach ? $attach->Content : ''), qr/really should not be there either/);
 351 }
 352
 353
 354 # test that if it gets base64 transfer-encoded long mail then it doesn't hang
 355 {
 356     local $SIG{ALRM} = sub {
 357         ok 0, "timed out, web server is probably in deadlock";
 358         exit;
 359     };
 360     alarm 30;
 361     $buf = encode_base64('a'x(250*1024));
 362     $mail = RT::Test->open_mailgate_ok($baseurl);
 363     print $mail <<"EOF";
 364 From: recipient\@example.com
 365 To: general\@$RT::rtname
 366 Content-transfer-encoding: base64
 367 Subject: Long not encrypted message for queue
 368
 369 $buf
 370 EOF
 371     RT::Test->close_mailgate_ok($mail);
 372     alarm 0;
 373
 374     my $tick = RT::Test->last_ticket;
 375     is( $tick->Subject, 'Long not encrypted message for queue',
 376         "Created the ticket"
 377     );
 378     my $content = $tick->Transactions->First->Content;
 379     like $content, qr/a{1024,}/, 'content is not lost';
 380 }