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