rt/t/web/crypt-gnupg.t

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