rt/t/mail/gnupg-incoming.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use RT::Test tests => 47;
   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
 247 # test for signed mail by other key
 248 $buf = '';
 249
 250 run3(
 251     shell_quote(
 252         qw(gpg --armor --sign),
 253         '--default-key' => 'rt@example.com',
 254         '--homedir'     => $homedir,
 255         '--passphrase'  => 'test',
 256     ),
 257     \"alright\r\n",
 258     \$buf,
 259     \*STDOUT
 260 );
 261
 262 $mail = RT::Test->open_mailgate_ok($baseurl);
 263 print $mail <<"EOF";
 264 From: recipient\@example.com
 265 To: general\@$RT::rtname
 266 Subject: signed message for queue
 267
 268 $buf
 269 EOF
 270 RT::Test->close_mailgate_ok($mail);
 271
 272 {
 273     my $tick = RT::Test->last_ticket;
 274     my $txn = $tick->Transactions->First;
 275     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 276     # XXX: in this case, which credential should we be using?
 277     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 278         'Test User <rt@example.com>',
 279         'recorded incoming mail signed by others'
 280     );
 281 }
 282
 283 # test for encrypted mail with key not associated to the queue
 284 $buf = '';
 285
 286 run3(
 287     shell_quote(
 288         qw(gpg --armor --encrypt),
 289         '--recipient'   => 'random@localhost',
 290         '--homedir'     => $homedir,
 291     ),
 292     \"should not be there either\r\n",
 293     \$buf,
 294     \*STDOUT
 295 );
 296
 297 $mail = RT::Test->open_mailgate_ok($baseurl);
 298 print $mail <<"EOF";
 299 From: recipient\@example.com
 300 To: general\@$RT::rtname
 301 Subject: encrypted message for queue
 302
 303 $buf
 304 EOF
 305 RT::Test->close_mailgate_ok($mail);
 306
 307 {
 308     my $tick = RT::Test->last_ticket;
 309     my $txn = $tick->Transactions->First;
 310     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 311
 312     TODO:
 313     {
 314         local $TODO = "this test requires keys associated with queues";
 315         unlike( $attach->Content, qr'should not be there either');
 316     }
 317 }
 318
 319 # test for badly encrypted mail
 320 {
 321 $buf = '';
 322
 323 run3(
 324     shell_quote(
 325         qw(gpg --armor --encrypt),
 326         '--recipient'   => 'rt@example.com',
 327         '--homedir'     => $homedir,
 328     ),
 329     \"really should not be there either\r\n",
 330     \$buf,
 331     \*STDOUT
 332 );
 333
 334 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 335
 336 RT::Test->fetch_caught_mails;
 337
 338 $mail = RT::Test->open_mailgate_ok($baseurl);
 339 print $mail <<"EOF";
 340 From: recipient\@example.com
 341 To: general\@$RT::rtname
 342 Subject: encrypted message for queue
 343
 344 $buf
 345 EOF
 346 RT::Test->close_mailgate_ok($mail);
 347 my @mail = RT::Test->fetch_caught_mails;
 348 is(@mail, 1, 'caught outgoing mail.');
 349 }
 350
 351 {
 352     my $tick = RT::Test->last_ticket;
 353     my $txn = $tick->Transactions->First;
 354     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 355     unlike( ($attach ? $attach->Content : ''), qr'really should not be there either');
 356 }
 357