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