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         => 49,
  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 use MIME::Base64;
  24
  25 my ($baseurl, $m) = RT::Test->started_ok;
  26
  27 # configure key for General queue
  28 ok( $m->login, 'we did log in' );
  29 $m->get( $baseurl.'/Admin/Queues/');
  30 $m->follow_link_ok( {text => 'General'} );
  31 $m->submit_form( form_number => 3,
  32                  fields      => { CorrespondAddress => 'general@example.com' } );
  33 $m->content_like(qr/general\@example.com.* - never/, 'has key info.');
  34
  35 ok(my $user = RT::User->new(RT->SystemUser));
  36 ok($user->Load('root'), "Loaded user 'root'");
  37 $user->SetEmailAddress('recipient@example.com');
  38
  39 # test simple mail.  supposedly this should fail when
  40 # 1. the queue requires signature
  41 # 2. the from is not what the key is associated with
  42 my $mail = RT::Test->open_mailgate_ok($baseurl);
  43 print $mail <<EOF;
  44 From: recipient\@example.com
  45 To: general\@$RT::rtname
  46 Subject: This is a test of new ticket creation as root
  47
  48 Blah!
  49 Foob!
  50 EOF
  51 RT::Test->close_mailgate_ok($mail);
  52
  53 {
  54     my $tick = RT::Test->last_ticket;
  55     is( $tick->Subject,
  56         'This is a test of new ticket creation as root',
  57         "Created the ticket"
  58     );
  59     my $txn = $tick->Transactions->First;
  60     like(
  61         $txn->Attachments->First->Headers,
  62         qr/^X-RT-Incoming-Encryption: Not encrypted/m,
  63         'recorded incoming mail that is not encrypted'
  64     );
  65     like( $txn->Attachments->First->Content, qr/Blah/);
  66 }
  67
  68 # test for signed mail
  69 my $buf = '';
  70
  71 run3(
  72     shell_quote(
  73         qw(gpg --batch --no-tty --armor --sign),
  74         '--default-key' => 'recipient@example.com',
  75         '--homedir'     => $homedir,
  76         '--passphrase'  => 'recipient',
  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     ),
 120     \"clearfnord\r\n",
 121     \$buf,
 122     \*STDOUT
 123 );
 124
 125 $mail = RT::Test->open_mailgate_ok($baseurl);
 126 print $mail <<"EOF";
 127 From: recipient\@example.com
 128 To: general\@$RT::rtname
 129 Subject: signed message for queue
 130
 131 $buf
 132 EOF
 133 RT::Test->close_mailgate_ok($mail);
 134
 135 {
 136     my $tick = RT::Test->last_ticket;
 137     is( $tick->Subject, 'signed message for queue',
 138         "Created the ticket"
 139     );
 140
 141     my $txn = $tick->Transactions->First;
 142     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 143     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 144         'Not encrypted',
 145         'recorded incoming mail that is encrypted'
 146     );
 147     # test for some kind of PGP-Signed-By: Header
 148     like( $attach->Content, qr/clearfnord/);
 149 }
 150
 151 # test for signed and encrypted mail
 152 $buf = '';
 153
 154 run3(
 155     shell_quote(
 156         qw(gpg --batch --no-tty --encrypt --armor --sign),
 157         '--recipient'   => 'general@example.com',
 158         '--default-key' => 'recipient@example.com',
 159         '--homedir'     => $homedir,
 160         '--passphrase'  => 'recipient',
 161     ),
 162     \"orzzzzzz\r\n",
 163     \$buf,
 164     \*STDOUT
 165 );
 166
 167 $mail = RT::Test->open_mailgate_ok($baseurl);
 168 print $mail <<"EOF";
 169 From: recipient\@example.com
 170 To: general\@$RT::rtname
 171 Subject: Encrypted message for queue
 172
 173 $buf
 174 EOF
 175 RT::Test->close_mailgate_ok($mail);
 176
 177 {
 178     my $tick = RT::Test->last_ticket;
 179     is( $tick->Subject, 'Encrypted message for queue',
 180         "Created the ticket"
 181     );
 182
 183     my $txn = $tick->Transactions->First;
 184     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 185
 186     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 187         'Success',
 188         'recorded incoming mail that is encrypted'
 189     );
 190     is( $msg->GetHeader('X-RT-Privacy'),
 191         'PGP',
 192         'recorded incoming mail that is encrypted'
 193     );
 194     like( $attach->Content, qr/orz/);
 195
 196     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 197     ok(index($orig->Content, $buf) != -1, 'found original msg');
 198 }
 199
 200
 201 # test that if it gets base64 transfer-encoded, we still get the content out
 202 $buf = encode_base64($buf);
 203 $mail = RT::Test->open_mailgate_ok($baseurl);
 204 print $mail <<"EOF";
 205 From: recipient\@example.com
 206 To: general\@$RT::rtname
 207 Content-transfer-encoding: base64
 208 Subject: Encrypted message for queue
 209
 210 $buf
 211 EOF
 212 RT::Test->close_mailgate_ok($mail);
 213
 214 {
 215     my $tick = RT::Test->last_ticket;
 216     is( $tick->Subject, 'Encrypted message for queue',
 217         "Created the ticket"
 218     );
 219
 220     my $txn = $tick->Transactions->First;
 221     my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
 222
 223     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 224         'Success',
 225         'recorded incoming mail that is encrypted'
 226     );
 227     is( $msg->GetHeader('X-RT-Privacy'),
 228         'PGP',
 229         'recorded incoming mail that is encrypted'
 230     );
 231     like( $attach->Content, qr/orz/);
 232
 233     is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
 234     ok(index($orig->Content, $buf) != -1, 'found original msg');
 235 }
 236
 237
 238 # test for signed mail by other key
 239 $buf = '';
 240
 241 run3(
 242     shell_quote(
 243         qw(gpg --batch --no-tty --armor --sign),
 244         '--default-key' => 'rt@example.com',
 245         '--homedir'     => $homedir,
 246         '--passphrase'  => 'test',
 247     ),
 248     \"alright\r\n",
 249     \$buf,
 250     \*STDOUT
 251 );
 252
 253 $mail = RT::Test->open_mailgate_ok($baseurl);
 254 print $mail <<"EOF";
 255 From: recipient\@example.com
 256 To: general\@$RT::rtname
 257 Subject: signed message for queue
 258
 259 $buf
 260 EOF
 261 RT::Test->close_mailgate_ok($mail);
 262
 263 {
 264     my $tick = RT::Test->last_ticket;
 265     my $txn = $tick->Transactions->First;
 266     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 267     # XXX: in this case, which credential should we be using?
 268     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 269         'Test User <rt@example.com>',
 270         'recorded incoming mail signed by others'
 271     );
 272 }
 273
 274 # test for encrypted mail with key not associated to the queue
 275 $buf = '';
 276
 277 run3(
 278     shell_quote(
 279         qw(gpg --batch --no-tty --armor --encrypt),
 280         '--recipient'   => 'random@localhost',
 281         '--homedir'     => $homedir,
 282     ),
 283     \"should not be there either\r\n",
 284     \$buf,
 285     \*STDOUT
 286 );
 287
 288 $mail = RT::Test->open_mailgate_ok($baseurl);
 289 print $mail <<"EOF";
 290 From: recipient\@example.com
 291 To: general\@$RT::rtname
 292 Subject: encrypted message for queue
 293
 294 $buf
 295 EOF
 296 RT::Test->close_mailgate_ok($mail);
 297
 298 {
 299     my $tick = RT::Test->last_ticket;
 300     my $txn = $tick->Transactions->First;
 301     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 302
 303     TODO:
 304     {
 305         local $TODO = "this test requires keys associated with queues";
 306         unlike( $attach->Content, qr/should not be there either/);
 307     }
 308 }
 309
 310 # test for badly encrypted mail
 311 {
 312 $buf = '';
 313
 314 run3(
 315     shell_quote(
 316         qw(gpg --batch --no-tty --armor --encrypt),
 317         '--recipient'   => 'rt@example.com',
 318         '--homedir'     => $homedir,
 319     ),
 320     \"really should not be there either\r\n",
 321     \$buf,
 322     \*STDOUT
 323 );
 324
 325 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
 326
 327 RT::Test->fetch_caught_mails;
 328
 329 $mail = RT::Test->open_mailgate_ok($baseurl);
 330 print $mail <<"EOF";
 331 From: recipient\@example.com
 332 To: general\@$RT::rtname
 333 Subject: encrypted message for queue
 334
 335 $buf
 336 EOF
 337 RT::Test->close_mailgate_ok($mail);
 338 my @mail = RT::Test->fetch_caught_mails;
 339 is(@mail, 1, 'caught outgoing mail.');
 340 }
 341
 342 {
 343     my $tick = RT::Test->last_ticket;
 344     my $txn = $tick->Transactions->First;
 345     my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
 346     unlike( ($attach ? $attach->Content : ''), qr/really should not be there either/);
 347 }
 348