rt/t/mail/gnupg-incoming.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 my $homedir;
   6 BEGIN {
   7     require RT::Test;
   8     $homedir =
   9       RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
  10         qw/data gnupg keyrings/ );
  11 }
  12
  13 use RT::Test::GnuPG
  14   tests         => 41,
  15   actual_server => 1,
  16   gnupg_options => {
  17     passphrase => 'rt-test',
  18     homedir    => $homedir,
  19   };
  20
  21 use String::ShellQuote 'shell_quote';
  22 use IPC::Run3 'run3';
  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     ),
  77     \"fnord\r\n",
  78     \$buf,
  79     \*STDOUT
  80 );
  81
  82 $mail = RT::Test->open_mailgate_ok($baseurl);
  83 print $mail <<"EOF";
  84 From: recipient\@example.com
  85 To: general\@$RT::rtname
  86 Subject: signed message for queue
  87
  88 $buf
  89 EOF
  90 RT::Test->close_mailgate_ok($mail);
  91
  92 {
  93     my $tick = RT::Test->last_ticket;
  94     is( $tick->Subject, 'signed message for queue',
  95         "Created the ticket"
  96     );
  97
  98     my $txn = $tick->Transactions->First;
  99     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 100
 101     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 102         'Not encrypted',
 103         'recorded incoming mail that is encrypted'
 104     );
 105     # test for some kind of PGP-Signed-By: Header
 106     like( $attach->Content, qr/fnord/);
 107 }
 108
 109 # test for clear-signed mail
 110 $buf = '';
 111
 112 run3(
 113     shell_quote(
 114         qw(gpg --batch --no-tty --armor --sign --clearsign),
 115         '--default-key' => 'recipient@example.com',
 116         '--homedir'     => $homedir,
 117         '--passphrase'  => 'recipient',
 118     ),
 119     \"clearfnord\r\n",
 120     \$buf,
 121     \*STDOUT
 122 );
 123
 124 $mail = RT::Test->open_mailgate_ok($baseurl);
 125 print $mail <<"EOF";
 126 From: recipient\@example.com
 127 To: general\@$RT::rtname
 128 Subject: signed message for queue
 129
 130 $buf
 131 EOF
 132 RT::Test->close_mailgate_ok($mail);
 133
 134 {
 135     my $tick = RT::Test->last_ticket;
 136     is( $tick->Subject, 'signed message for queue',
 137         "Created the ticket"
 138     );
 139
 140     my $txn = $tick->Transactions->First;
 141     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 142     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 143         'Not encrypted',
 144         'recorded incoming mail that is encrypted'
 145     );
 146     # test for some kind of PGP-Signed-By: Header
 147     like( $attach->Content, qr/clearfnord/);
 148 }
 149
 150 # test for signed and encrypted mail
 151 $buf = '';
 152
 153 run3(
 154     shell_quote(
 155         qw(gpg --batch --no-tty --encrypt --armor --sign),
 156         '--recipient'   => 'general@example.com',
 157         '--default-key' => 'recipient@example.com',
 158         '--homedir'     => $homedir,
 159         '--passphrase'  => 'recipient',
 160     ),
 161     \"orzzzzzz\r\n",
 162     \$buf,
 163     \*STDOUT
 164 );
 165
 166 $mail = RT::Test->open_mailgate_ok($baseurl);
 167 print $mail <<"EOF";
 168 From: recipient\@example.com
 169 To: general\@$RT::rtname
 170 Subject: Encrypted message for queue
 171
 172 $buf
 173 EOF
 174 RT::Test->close_mailgate_ok($mail);
 175
 176 {
 177     my $tick = RT::Test->last_ticket;
 178     is( $tick->Subject, 'Encrypted message for queue',
 179         "Created the ticket"
 180     );
 181
 182     my $txn = $tick->Transactions->First;
 183     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 184
 185     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 186         'Success',
 187         'recorded incoming mail that is encrypted'
 188     );
 189     is( $msg->GetHeader('X-RT-Privacy'),
 190         'PGP',
 191         'recorded incoming mail that is encrypted'
 192     );
 193     like( $attach->Content, qr/orz/);
 194
 195     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 196     ok(index($orig->Content, $buf) != -1, 'found original msg');
 197 }
 198
 199 # test for signed mail by other key
 200 $buf = '';
 201
 202 run3(
 203     shell_quote(
 204         qw(gpg --batch --no-tty --armor --sign),
 205         '--default-key' => 'rt@example.com',
 206         '--homedir'     => $homedir,
 207         '--passphrase'  => 'test',
 208     ),
 209     \"alright\r\n",
 210     \$buf,
 211     \*STDOUT
 212 );
 213
 214 $mail = RT::Test->open_mailgate_ok($baseurl);
 215 print $mail <<"EOF";
 216 From: recipient\@example.com
 217 To: general\@$RT::rtname
 218 Subject: signed message for queue
 219
 220 $buf
 221 EOF
 222 RT::Test->close_mailgate_ok($mail);
 223
 224 {
 225     my $tick = RT::Test->last_ticket;
 226     my $txn = $tick->Transactions->First;
 227     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 228     # XXX: in this case, which credential should we be using?
 229     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 230         'Test User <rt@example.com>',
 231         'recorded incoming mail signed by others'
 232     );
 233 }
 234
 235 # test for encrypted mail with key not associated to the queue
 236 $buf = '';
 237
 238 run3(
 239     shell_quote(
 240         qw(gpg --batch --no-tty --armor --encrypt),
 241         '--recipient'   => 'random@localhost',
 242         '--homedir'     => $homedir,
 243     ),
 244     \"should not be there either\r\n",
 245     \$buf,
 246     \*STDOUT
 247 );
 248
 249 $mail = RT::Test->open_mailgate_ok($baseurl);
 250 print $mail <<"EOF";
 251 From: recipient\@example.com
 252 To: general\@$RT::rtname
 253 Subject: encrypted message for queue
 254
 255 $buf
 256 EOF
 257 RT::Test->close_mailgate_ok($mail);
 258
 259 {
 260     my $tick = RT::Test->last_ticket;
 261     my $txn = $tick->Transactions->First;
 262     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 263
 264     TODO:
 265     {
 266         local $TODO = "this test requires keys associated with queues";
 267         unlike( $attach->Content, qr/should not be there either/);
 268     }
 269 }
 270
 271 # test for badly encrypted mail
 272 {
 273 $buf = '';
 274
 275 run3(
 276     shell_quote(
 277         qw(gpg --batch --no-tty --armor --encrypt),
 278         '--recipient'   => 'rt@example.com',
 279         '--homedir'     => $homedir,
 280     ),
 281     \"really should not be there either\r\n",
 282     \$buf,
 283     \*STDOUT
 284 );
 285
 286 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 287
 288 RT::Test->fetch_caught_mails;
 289
 290 $mail = RT::Test->open_mailgate_ok($baseurl);
 291 print $mail <<"EOF";
 292 From: recipient\@example.com
 293 To: general\@$RT::rtname
 294 Subject: encrypted message for queue
 295
 296 $buf
 297 EOF
 298 RT::Test->close_mailgate_ok($mail);
 299 my @mail = RT::Test->fetch_caught_mails;
 300 is(@mail, 1, 'caught outgoing mail.');
 301 }
 302
 303 {
 304     my $tick = RT::Test->last_ticket;
 305     my $txn = $tick->Transactions->First;
 306     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 307     unlike( ($attach ? $attach->Content : ''), qr/really should not be there either/);
 308 }
 309