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 $m->get( $baseurl."?user=root;pass=password" );
  38 $m->content_like(qr/Logout/, 'we did log in');
  39 $m->get( $baseurl.'/Admin/Queues/');
  40 $m->follow_link_ok( {text => 'General'} );
  41 $m->submit_form( form_number => 3,
  42                  fields      => { CorrespondAddress => 'general@example.com' } );
  43 $m->content_like(qr/general\@example.com.* - never/, 'has key info.');
  44
  45 ok(my $user = RT::User->new($RT::SystemUser));
  46 ok($user->Load('root'), "Loaded user 'root'");
  47 $user->SetEmailAddress('recipient@example.com');
  48
  49 # test simple mail.  supposedly this should fail when
  50 # 1. the queue requires signature
  51 # 2. the from is not what the key is associated with
  52 my $mail = RT::Test->open_mailgate_ok($baseurl);
  53 print $mail <<EOF;
  54 From: recipient\@example.com
  55 To: general\@$RT::rtname
  56 Subject: This is a test of new ticket creation as root
  57
  58 Blah!
  59 Foob!
  60 EOF
  61 RT::Test->close_mailgate_ok($mail);
  62
  63 {
  64     my $tick = RT::Test->last_ticket;
  65     is( $tick->Subject,
  66         'This is a test of new ticket creation as root',
  67         "Created the ticket"
  68     );
  69     my $txn = $tick->Transactions->First;
  70     like(
  71         $txn->Attachments->First->Headers,
  72         qr/^X-RT-Incoming-Encryption: Not encrypted/m,
  73         'recorded incoming mail that is not encrypted'
  74     );
  75     like( $txn->Attachments->First->Content, qr'Blah');
  76 }
  77
  78 # test for signed mail
  79 my $buf = '';
  80
  81 run3(
  82     shell_quote(
  83         qw(gpg --armor --sign),
  84         '--default-key' => 'recipient@example.com',
  85         '--homedir'     => $homedir,
  86         '--passphrase'  => 'recipient',
  87     ),
  88     \"fnord\r\n",
  89     \$buf,
  90     \*STDOUT
  91 );
  92
  93 $mail = RT::Test->open_mailgate_ok($baseurl);
  94 print $mail <<"EOF";
  95 From: recipient\@example.com
  96 To: general\@$RT::rtname
  97 Subject: signed message for queue
  98
  99 $buf
 100 EOF
 101 RT::Test->close_mailgate_ok($mail);
 102
 103 {
 104     my $tick = RT::Test->last_ticket;
 105     is( $tick->Subject, 'signed message for queue',
 106         "Created the ticket"
 107     );
 108
 109     my $txn = $tick->Transactions->First;
 110     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 111
 112     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 113         'Not encrypted',
 114         'recorded incoming mail that is encrypted'
 115     );
 116     # test for some kind of PGP-Signed-By: Header
 117     like( $attach->Content, qr'fnord');
 118 }
 119
 120 # test for clear-signed mail
 121 $buf = '';
 122
 123 run3(
 124     shell_quote(
 125         qw(gpg --armor --sign --clearsign),
 126         '--default-key' => 'recipient@example.com',
 127         '--homedir'     => $homedir,
 128         '--passphrase'  => 'recipient',
 129     ),
 130     \"clearfnord\r\n",
 131     \$buf,
 132     \*STDOUT
 133 );
 134
 135 $mail = RT::Test->open_mailgate_ok($baseurl);
 136 print $mail <<"EOF";
 137 From: recipient\@example.com
 138 To: general\@$RT::rtname
 139 Subject: signed message for queue
 140
 141 $buf
 142 EOF
 143 RT::Test->close_mailgate_ok($mail);
 144
 145 {
 146     my $tick = RT::Test->last_ticket;
 147     is( $tick->Subject, 'signed message for queue',
 148         "Created the ticket"
 149     );
 150
 151     my $txn = $tick->Transactions->First;
 152     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 153     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 154         'Not encrypted',
 155         'recorded incoming mail that is encrypted'
 156     );
 157     # test for some kind of PGP-Signed-By: Header
 158     like( $attach->Content, qr'clearfnord');
 159 }
 160
 161 # test for signed and encrypted mail
 162 $buf = '';
 163
 164 run3(
 165     shell_quote(
 166         qw(gpg --encrypt --armor --sign),
 167         '--recipient'   => 'general@example.com',
 168         '--default-key' => 'recipient@example.com',
 169         '--homedir'     => $homedir,
 170         '--passphrase'  => 'recipient',
 171     ),
 172     \"orzzzzzz\r\n",
 173     \$buf,
 174     \*STDOUT
 175 );
 176
 177 $mail = RT::Test->open_mailgate_ok($baseurl);
 178 print $mail <<"EOF";
 179 From: recipient\@example.com
 180 To: general\@$RT::rtname
 181 Subject: Encrypted message for queue
 182
 183 $buf
 184 EOF
 185 RT::Test->close_mailgate_ok($mail);
 186
 187 {
 188     my $tick = RT::Test->last_ticket;
 189     is( $tick->Subject, 'Encrypted message for queue',
 190         "Created the ticket"
 191     );
 192
 193     my $txn = $tick->Transactions->First;
 194     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 195
 196     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 197         'Success',
 198         'recorded incoming mail that is encrypted'
 199     );
 200     is( $msg->GetHeader('X-RT-Privacy'),
 201         'PGP',
 202         'recorded incoming mail that is encrypted'
 203     );
 204     like( $attach->Content, qr'orz');
 205
 206     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 207     ok(index($orig->Content, $buf) != -1, 'found original msg');
 208 }
 209
 210 # test for signed mail by other key
 211 $buf = '';
 212
 213 run3(
 214     shell_quote(
 215         qw(gpg --armor --sign),
 216         '--default-key' => 'rt@example.com',
 217         '--homedir'     => $homedir,
 218         '--passphrase'  => 'test',
 219     ),
 220     \"alright\r\n",
 221     \$buf,
 222     \*STDOUT
 223 );
 224
 225 $mail = RT::Test->open_mailgate_ok($baseurl);
 226 print $mail <<"EOF";
 227 From: recipient\@example.com
 228 To: general\@$RT::rtname
 229 Subject: signed message for queue
 230
 231 $buf
 232 EOF
 233 RT::Test->close_mailgate_ok($mail);
 234
 235 {
 236     my $tick = RT::Test->last_ticket;
 237     my $txn = $tick->Transactions->First;
 238     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 239     # XXX: in this case, which credential should we be using?
 240     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 241         'Test User <rt@example.com>',
 242         'recorded incoming mail signed by others'
 243     );
 244 }
 245
 246 # test for encrypted mail with key not associated to the queue
 247 $buf = '';
 248
 249 run3(
 250     shell_quote(
 251         qw(gpg --armor --encrypt),
 252         '--recipient'   => 'random@localhost',
 253         '--homedir'     => $homedir,
 254     ),
 255     \"should not be there either\r\n",
 256     \$buf,
 257     \*STDOUT
 258 );
 259
 260 $mail = RT::Test->open_mailgate_ok($baseurl);
 261 print $mail <<"EOF";
 262 From: recipient\@example.com
 263 To: general\@$RT::rtname
 264 Subject: encrypted message for queue
 265
 266 $buf
 267 EOF
 268 RT::Test->close_mailgate_ok($mail);
 269
 270 {
 271     my $tick = RT::Test->last_ticket;
 272     my $txn = $tick->Transactions->First;
 273     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 274
 275     TODO:
 276     {
 277         local $TODO = "this test requires keys associated with queues";
 278         unlike( $attach->Content, qr'should not be there either');
 279     }
 280 }
 281
 282 # test for badly encrypted mail
 283 {
 284 $buf = '';
 285
 286 run3(
 287     shell_quote(
 288         qw(gpg --armor --encrypt),
 289         '--recipient'   => 'rt@example.com',
 290         '--homedir'     => $homedir,
 291     ),
 292     \"really should not be there either\r\n",
 293     \$buf,
 294     \*STDOUT
 295 );
 296
 297 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 298
 299 RT::Test->fetch_caught_mails;
 300
 301 $mail = RT::Test->open_mailgate_ok($baseurl);
 302 print $mail <<"EOF";
 303 From: recipient\@example.com
 304 To: general\@$RT::rtname
 305 Subject: encrypted message for queue
 306
 307 $buf
 308 EOF
 309 RT::Test->close_mailgate_ok($mail);
 310 my @mail = RT::Test->fetch_caught_mails;
 311 is(@mail, 1, 'caught outgoing mail.');
 312 }
 313
 314 {
 315     my $tick = RT::Test->last_ticket;
 316     my $txn = $tick->Transactions->First;
 317     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 318     unlike( ($attach ? $attach->Content : ''), qr'really should not be there either');
 319 }
 320