rt/t/web/crypt-gnupg.t

   1 #!/usr/bin/perl -w
   2 use strict;
   3
   4 use RT::Test tests => 94;
   5
   6 plan skip_all => 'GnuPG required.'
   7     unless eval 'use GnuPG::Interface; 1';
   8 plan skip_all => 'gpg executable is required.'
   9     unless RT::Test->find_executable('gpg');
  10
  11 use MIME::Head;
  12
  13 use RT::Action::SendEmail;
  14
  15 eval 'use GnuPG::Interface; 1' or plan skip_all => 'GnuPG required.';
  16
  17 RT::Test->set_mail_catcher;
  18
  19 RT->Config->Set( CommentAddress => 'general@example.com');
  20 RT->Config->Set( CorrespondAddress => 'general@example.com');
  21 RT->Config->Set( DefaultSearchResultFormat => qq{
  22    '<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__id__</a></B>/TITLE:#',
  23    '<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a></B>/TITLE:Subject',
  24    'OO-__OwnerName__-O',
  25    'OR-__Requestors__-O',
  26    'KO-__KeyOwnerName__-K',
  27    'KR-__KeyRequestors__-K',
  28    Status});
  29
  30 use File::Spec ();
  31 use Cwd;
  32 use File::Temp qw(tempdir);
  33 my $homedir = tempdir( CLEANUP => 1 );
  34
  35 use_ok('RT::Crypt::GnuPG');
  36
  37 RT->Config->Set( 'GnuPG',
  38                  Enable => 1,
  39                  OutgoingMessagesFormat => 'RFC' );
  40
  41 RT->Config->Set( 'GnuPGOptions',
  42                  homedir => $homedir,
  43                  passphrase => 'recipient',
  44                  'no-permission-warning' => undef,
  45                  'trust-model' => 'always');
  46 RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' );
  47
  48 RT::Test->import_gnupg_key('recipient@example.com', 'public');
  49 RT::Test->import_gnupg_key('recipient@example.com', 'secret');
  50 RT::Test->import_gnupg_key('general@example.com', 'public');
  51 RT::Test->import_gnupg_key('general@example.com', 'secret');
  52 RT::Test->import_gnupg_key('general@example.com.2', 'public');
  53 RT::Test->import_gnupg_key('general@example.com.2', 'secret');
  54
  55 ok(my $user = RT::User->new($RT::SystemUser));
  56 ok($user->Load('root'), "Loaded user 'root'");
  57 $user->SetEmailAddress('recipient@example.com');
  58
  59 my $queue = RT::Test->load_or_create_queue(
  60     Name              => 'General',
  61     CorrespondAddress => 'general@example.com',
  62 );
  63 ok $queue && $queue->id, 'loaded or created queue';
  64 my $qid = $queue->id;
  65
  66 RT::Test->set_rights(
  67     Principal => 'Everyone',
  68     Right => ['CreateTicket', 'ShowTicket', 'SeeQueue', 'ModifyTicket'],
  69 );
  70
  71 my ($baseurl, $m) = RT::Test->started_ok;
  72 ok $m->login, 'logged in';
  73
  74 $m->get_ok("/Admin/Queues/Modify.html?id=$qid");
  75 $m->form_with_fields('Sign', 'Encrypt');
  76 $m->field(Encrypt => 1);
  77 $m->submit;
  78
  79 RT::Test->clean_caught_mails;
  80
  81 $m->goto_create_ticket( $queue );
  82 $m->form_name('TicketCreate');
  83 $m->field('Subject', 'Encryption test');
  84 $m->field('Content', 'Some content');
  85 ok($m->value('Encrypt', 2), "encrypt tick box is checked");
  86 ok(!$m->value('Sign', 2), "sign tick box is unchecked");
  87 $m->submit;
  88 is($m->status, 200, "request successful");
  89
  90 $m->get($baseurl); # ensure that the mail has been processed
  91
  92 my @mail = RT::Test->fetch_caught_mails;
  93 ok(@mail, "got some mail");
  94
  95 $user->SetEmailAddress('general@example.com');
  96 for my $mail (@mail) {
  97     unlike $mail, qr/Some content/, "outgoing mail was encrypted";
  98
  99     my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
 100     my $body = strip_headers($mail);
 101
 102     $mail = << "MAIL";
 103 Subject: RT mail sent back into RT
 104 From: general\@example.com
 105 To: recipient\@example.com
 106 $mime_version
 107 $content_type
 108
 109 $body
 110 MAIL
 111
 112     my ($status, $id) = RT::Test->send_via_mailgate($mail);
 113     is ($status >> 8, 0, "The mail gateway exited normally");
 114     ok ($id, "got id of a newly created ticket - $id");
 115
 116     my $tick = RT::Ticket->new( $RT::SystemUser );
 117     $tick->Load( $id );
 118     ok ($tick->id, "loaded ticket #$id");
 119
 120     is ($tick->Subject,
 121         "RT mail sent back into RT",
 122         "Correct subject"
 123     );
 124
 125     my $txn = $tick->Transactions->First;
 126     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 127
 128     is( $msg->GetHeader('X-RT-Privacy'),
 129         'PGP',
 130         "RT's outgoing mail has crypto"
 131     );
 132     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 133         'Success',
 134         "RT's outgoing mail looks encrypted"
 135     );
 136
 137     like($attachments[0]->Content, qr/Some content/, "RT's mail includes copy of ticket text");
 138     like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
 139 }
 140
 141 $m->get("$baseurl/Admin/Queues/Modify.html?id=$qid");
 142 $m->form_with_fields('Sign', 'Encrypt');
 143 $m->field(Encrypt => undef);
 144 $m->field(Sign => 1);
 145 $m->submit;
 146
 147 RT::Test->clean_caught_mails;
 148
 149 $m->goto_create_ticket( $queue );
 150 $m->form_name('TicketCreate');
 151 $m->field('Subject', 'Signing test');
 152 $m->field('Content', 'Some other content');
 153 ok(!$m->value('Encrypt', 2), "encrypt tick box is unchecked");
 154 ok($m->value('Sign', 2), "sign tick box is checked");
 155 $m->submit;
 156 is($m->status, 200, "request successful");
 157
 158 $m->get($baseurl); # ensure that the mail has been processed
 159
 160 @mail = RT::Test->fetch_caught_mails;
 161 ok(@mail, "got some mail");
 162 for my $mail (@mail) {
 163     like $mail, qr/Some other content/, "outgoing mail was not encrypted";
 164     like $mail, qr/-----BEGIN PGP SIGNATURE-----[\s\S]+-----END PGP SIGNATURE-----/, "data has some kind of signature";
 165
 166     my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
 167     my $body = strip_headers($mail);
 168
 169     $mail = << "MAIL";
 170 Subject: More RT mail sent back into RT
 171 From: general\@example.com
 172 To: recipient\@example.com
 173 $mime_version
 174 $content_type
 175
 176 $body
 177 MAIL
 178
 179     my ($status, $id) = RT::Test->send_via_mailgate($mail);
 180     is ($status >> 8, 0, "The mail gateway exited normally");
 181     ok ($id, "got id of a newly created ticket - $id");
 182
 183     my $tick = RT::Ticket->new( $RT::SystemUser );
 184     $tick->Load( $id );
 185     ok ($tick->id, "loaded ticket #$id");
 186
 187     is ($tick->Subject,
 188         "More RT mail sent back into RT",
 189         "Correct subject"
 190     );
 191
 192     my $txn = $tick->Transactions->First;
 193     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 194
 195     is( $msg->GetHeader('X-RT-Privacy'),
 196         'PGP',
 197         "RT's outgoing mail has crypto"
 198     );
 199     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 200         'Not encrypted',
 201         "RT's outgoing mail looks unencrypted"
 202     );
 203     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 204         'general <general@example.com>',
 205         "RT's outgoing mail looks signed"
 206     );
 207
 208     like($attachments[0]->Content, qr/Some other content/, "RT's mail includes copy of ticket text");
 209     like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
 210 }
 211
 212 $m->get("$baseurl/Admin/Queues/Modify.html?id=$qid");
 213 $m->form_with_fields('Sign', 'Encrypt');
 214 $m->field(Encrypt => 1);
 215 $m->field(Sign => 1);
 216 $m->submit;
 217
 218 RT::Test->clean_caught_mails;
 219
 220
 221 $m->goto_create_ticket( $queue );
 222 $m->form_name('TicketCreate');
 223 $m->field('Subject', 'Crypt+Sign test');
 224 $m->field('Content', 'Some final? content');
 225 ok($m->value('Encrypt', 2), "encrypt tick box is checked");
 226 ok($m->value('Sign', 2), "sign tick box is checked");
 227 $m->submit;
 228 is($m->status, 200, "request successful");
 229
 230 $m->get($baseurl); # ensure that the mail has been processed
 231
 232 @mail = RT::Test->fetch_caught_mails;
 233 ok(@mail, "got some mail");
 234 for my $mail (@mail) {
 235     unlike $mail, qr/Some other content/, "outgoing mail was encrypted";
 236
 237     my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
 238     my $body = strip_headers($mail);
 239
 240     $mail = << "MAIL";
 241 Subject: Final RT mail sent back into RT
 242 From: general\@example.com
 243 To: recipient\@example.com
 244 $mime_version
 245 $content_type
 246
 247 $body
 248 MAIL
 249
 250     my ($status, $id) = RT::Test->send_via_mailgate($mail);
 251     is ($status >> 8, 0, "The mail gateway exited normally");
 252     ok ($id, "got id of a newly created ticket - $id");
 253
 254     my $tick = RT::Ticket->new( $RT::SystemUser );
 255     $tick->Load( $id );
 256     ok ($tick->id, "loaded ticket #$id");
 257
 258     is ($tick->Subject,
 259         "Final RT mail sent back into RT",
 260         "Correct subject"
 261     );
 262
 263     my $txn = $tick->Transactions->First;
 264     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 265
 266     is( $msg->GetHeader('X-RT-Privacy'),
 267         'PGP',
 268         "RT's outgoing mail has crypto"
 269     );
 270     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 271         'Success',
 272         "RT's outgoing mail looks encrypted"
 273     );
 274     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 275         'general <general@example.com>',
 276         "RT's outgoing mail looks signed"
 277     );
 278
 279     like($attachments[0]->Content, qr/Some final\? content/, "RT's mail includes copy of ticket text");
 280     like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
 281 }
 282
 283 RT::Test->clean_caught_mails;
 284
 285 $m->goto_create_ticket( $queue );
 286 $m->form_name('TicketCreate');
 287 $m->field('Subject', 'Test crypt-off on encrypted queue');
 288 $m->field('Content', 'Thought you had me figured out didya');
 289 $m->field(Encrypt => undef, 2); # turn off encryption
 290 ok(!$m->value('Encrypt', 2), "encrypt tick box is now unchecked");
 291 ok($m->value('Sign', 2), "sign tick box is still checked");
 292 $m->submit;
 293 is($m->status, 200, "request successful");
 294
 295 $m->get($baseurl); # ensure that the mail has been processed
 296
 297 @mail = RT::Test->fetch_caught_mails;
 298 ok(@mail, "got some mail");
 299 for my $mail (@mail) {
 300     like $mail, qr/Thought you had me figured out didya/, "outgoing mail was unencrypted";
 301
 302     my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
 303     my $body = strip_headers($mail);
 304
 305     $mail = << "MAIL";
 306 Subject: Post-final! RT mail sent back into RT
 307 From: general\@example.com
 308 To: recipient\@example.com
 309 $mime_version
 310 $content_type
 311
 312 $body
 313 MAIL
 314
 315     my ($status, $id) = RT::Test->send_via_mailgate($mail);
 316     is ($status >> 8, 0, "The mail gateway exited normally");
 317     ok ($id, "got id of a newly created ticket - $id");
 318
 319     my $tick = RT::Ticket->new( $RT::SystemUser );
 320     $tick->Load( $id );
 321     ok ($tick->id, "loaded ticket #$id");
 322
 323     is ($tick->Subject,
 324         "Post-final! RT mail sent back into RT",
 325         "Correct subject"
 326     );
 327
 328     my $txn = $tick->Transactions->First;
 329     my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
 330
 331     is( $msg->GetHeader('X-RT-Privacy'),
 332         'PGP',
 333         "RT's outgoing mail has crypto"
 334     );
 335     is( $msg->GetHeader('X-RT-Incoming-Encryption'),
 336         'Not encrypted',
 337         "RT's outgoing mail looks unencrypted"
 338     );
 339     is( $msg->GetHeader('X-RT-Incoming-Signature'),
 340         'general <general@example.com>',
 341         "RT's outgoing mail looks signed"
 342     );
 343
 344     like($attachments[0]->Content, qr/Thought you had me figured out didya/, "RT's mail includes copy of ticket text");
 345     like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
 346 }
 347
 348 sub get_headers {
 349     my $mail = shift;
 350     open my $fh, "<", \$mail or die $!;
 351     my $head = MIME::Head->read($fh);
 352     return @{[
 353         map {
 354             my $hdr = "$_: " . $head->get($_);
 355             chomp $hdr;
 356             $hdr;
 357         }
 358         @_
 359     ]};
 360 }
 361
 362 sub strip_headers
 363 {
 364     my $mail = shift;
 365     $mail =~ s/.*?\n\n//s;
 366     return $mail;
 367 }
 368
 369 # now test the OwnerNameKey and RequestorsKey fields
 370
 371 my $nokey = RT::Test->load_or_create_user(Name => 'nokey', EmailAddress => 'nokey@example.com');
 372 $nokey->PrincipalObj->GrantRight(Right => 'CreateTicket');
 373 $nokey->PrincipalObj->GrantRight(Right => 'OwnTicket');
 374
 375 my $tick = RT::Ticket->new( $RT::SystemUser );
 376 $tick->Create(Subject => 'owner lacks pubkey', Queue => 'general',
 377               Owner => $nokey);
 378 ok(my $id = $tick->id, 'created ticket for owner-without-pubkey');
 379
 380 $tick = RT::Ticket->new( $RT::SystemUser );
 381 $tick->Create(Subject => 'owner has pubkey', Queue => 'general',
 382               Owner => 'root');
 383 ok($id = $tick->id, 'created ticket for owner-with-pubkey');
 384
 385 my $mail = << "MAIL";
 386 Subject: Nokey requestor
 387 From: nokey\@example.com
 388 To: general\@example.com
 389
 390 hello
 391 MAIL
 392
 393 ((my $status), $id) = RT::Test->send_via_mailgate($mail);
 394 is ($status >> 8, 0, "The mail gateway exited normally");
 395 ok ($id, "got id of a newly created ticket - $id");
 396
 397 $tick = RT::Ticket->new( $RT::SystemUser );
 398 $tick->Load( $id );
 399 ok ($tick->id, "loaded ticket #$id");
 400
 401 is ($tick->Subject,
 402     "Nokey requestor",
 403     "Correct subject"
 404 );
 405
 406 # test key selection
 407 my $key1 = "EC1E81E7DC3DB42788FB0E4E9FA662C06DE22FC2";
 408 my $key2 = "75E156271DCCF02DDD4A7A8CDF651FA0632C4F50";
 409
 410 ok($user = RT::User->new($RT::SystemUser));
 411 ok($user->Load('root'), "Loaded user 'root'");
 412 is($user->PreferredKey, $key1, "preferred key is set correctly");
 413 $m->get("$baseurl/Prefs/Other.html");
 414 like($m->content, qr/Preferred key/, "preferred key option shows up in preference");
 415
 416 # XXX: mech doesn't let us see the current value of the select, apparently
 417 like($m->content, qr/$key1/, "first key shows up in preferences");
 418 like($m->content, qr/$key2/, "second key shows up in preferences");
 419 like($m->content, qr/$key1.*?$key2/s, "first key shows up before the second");
 420
 421 $m->form_number(3);
 422 $m->select("PreferredKey" => $key2);
 423 $m->submit;
 424
 425 ok($user = RT::User->new($RT::SystemUser));
 426 ok($user->Load('root'), "Loaded user 'root'");
 427 is($user->PreferredKey, $key2, "preferred key is set correctly to the new value");
 428
 429 $m->get("$baseurl/Prefs/Other.html");
 430 like($m->content, qr/Preferred key/, "preferred key option shows up in preference");
 431
 432 # XXX: mech doesn't let us see the current value of the select, apparently
 433 like($m->content, qr/$key2/, "second key shows up in preferences");
 434 like($m->content, qr/$key1/, "first key shows up in preferences");
 435 like($m->content, qr/$key2.*?$key1/s, "second key (now preferred) shows up before the first");
 436
 437 # test that the new fields work
 438 $m->get("$baseurl/Search/Simple.html?q=General");
 439 my $content = $m->content;
 440 $content =~ s/&#40;/(/g;
 441 $content =~ s/&#41;/)/g;
 442
 443 like($content, qr/OO-Nobody-O/, "original OwnerName untouched");
 444 like($content, qr/OO-nokey-O/, "original OwnerName untouched");
 445 like($content, qr/OO-root-O/, "original OwnerName untouched");
 446
 447 like($content, qr/OR-recipient\@example.com-O/, "original Requestors untouched");
 448 like($content, qr/OR-nokey\@example.com-O/, "original Requestors untouched");
 449
 450 like($content, qr/KO-root-K/, "KeyOwnerName does not issue no-pubkey warning for recipient");
 451 like($content, qr/KO-nokey \(no pubkey!\)-K/, "KeyOwnerName issues no-pubkey warning for root");
 452 like($content, qr/KO-Nobody \(no pubkey!\)-K/, "KeyOwnerName issues no-pubkey warning for nobody");
 453
 454 like($content, qr/KR-recipient\@example.com-K/, "KeyRequestors does not issue no-pubkey warning for recipient\@example.com");
 455 like($content, qr/KR-general\@example.com-K/, "KeyRequestors does not issue no-pubkey warning for general\@example.com");
 456 like($content, qr/KR-nokey\@example.com \(no pubkey!\)-K/, "KeyRequestors DOES issue no-pubkey warning for nokey\@example.com");
 457