rt/t/web/crypt-gnupg.t

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