rt/t/mail/gnupg-incoming.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use RT::Test tests => 39;
   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
  13 use File::Temp;
  14 use Cwd 'getcwd';
  15 use String::ShellQuote 'shell_quote';
  16 use IPC::Run3 'run3';
  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 # test for signed mail by other key
 210 $buf = '';
 211
 212 run3(
 213     shell_quote(
 214         qw(gpg --armor --sign),
 215         '--default-key' => 'rt@example.com',
 216         '--homedir'     => $homedir,
 217         '--passphrase'  => 'test',
 218     ),
 219     \"alright\r\n",
 220     \$buf,
 221     \*STDOUT
 222 );
 223
 224 $mail = RT::Test->open_mailgate_ok($baseurl);
 225 print $mail <<"EOF";
 226 From: recipient\@example.com
 227 To: general\@$RT::rtname
 228 Subject: signed message for queue
 229
 230 $buf
 231 EOF
 232 RT::Test->close_mailgate_ok($mail);
 233
 234 {
 235     my $tick = RT::Test->last_ticket;
 236     my $txn = $tick->Transactions->First;
 237     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 238     # XXX: in this case, which credential should we be using?
 239     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 240         'Test User <rt@example.com>',
 241         'recorded incoming mail signed by others'
 242     );
 243 }
 244
 245 # test for encrypted mail with key not associated to the queue
 246 $buf = '';
 247
 248 run3(
 249     shell_quote(
 250         qw(gpg --armor --encrypt),
 251         '--recipient'   => 'random@localhost',
 252         '--homedir'     => $homedir,
 253     ),
 254     \"should not be there either\r\n",
 255     \$buf,
 256     \*STDOUT
 257 );
 258
 259 $mail = RT::Test->open_mailgate_ok($baseurl);
 260 print $mail <<"EOF";
 261 From: recipient\@example.com
 262 To: general\@$RT::rtname
 263 Subject: encrypted message for queue
 264
 265 $buf
 266 EOF
 267 RT::Test->close_mailgate_ok($mail);
 268
 269 {
 270     my $tick = RT::Test->last_ticket;
 271     my $txn = $tick->Transactions->First;
 272     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 273
 274     TODO:
 275     {
 276         local $TODO = "this test requires keys associated with queues";
 277         unlike( $attach->Content, qr'should not be there either');
 278     }
 279 }
 280
 281 # test for badly encrypted mail
 282 {
 283 $buf = '';
 284
 285 run3(
 286     shell_quote(
 287         qw(gpg --armor --encrypt),
 288         '--recipient'   => 'rt@example.com',
 289         '--homedir'     => $homedir,
 290     ),
 291     \"really should not be there either\r\n",
 292     \$buf,
 293     \*STDOUT
 294 );
 295
 296 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 297
 298 RT::Test->fetch_caught_mails;
 299
 300 $mail = RT::Test->open_mailgate_ok($baseurl);
 301 print $mail <<"EOF";
 302 From: recipient\@example.com
 303 To: general\@$RT::rtname
 304 Subject: encrypted message for queue
 305
 306 $buf
 307 EOF
 308 RT::Test->close_mailgate_ok($mail);
 309 my @mail = RT::Test->fetch_caught_mails;
 310 is(@mail, 1, 'caught outgoing mail.');
 311 }
 312
 313 {
 314     my $tick = RT::Test->last_ticket;
 315     my $txn = $tick->Transactions->First;
 316     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 317     unlike( ($attach ? $attach->Content : ''), qr'really should not be there either');
 318 }
 319