4 use RT::Test tests => 94;
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');
12 use RT::Action::SendEmail;
14 eval 'use GnuPG::Interface; 1' or plan skip_all => 'GnuPG required.';
16 RT::Test->set_mail_catcher;
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',
24 'OR-__Requestors__-O',
25 'KO-__KeyOwnerName__-K',
26 'KR-__KeyRequestors__-K',
31 use File::Temp qw(tempdir);
32 my $homedir = tempdir( CLEANUP => 1 );
34 use_ok('RT::Crypt::GnuPG');
36 RT->Config->Set( 'GnuPG',
38 OutgoingMessagesFormat => 'RFC' );
40 RT->Config->Set( 'GnuPGOptions',
42 passphrase => 'recipient',
43 'no-permission-warning' => undef,
44 'trust-model' => 'always');
45 RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' );
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');
54 ok(my $user = RT::User->new($RT::SystemUser));
55 ok($user->Load('root'), "Loaded user 'root'");
56 $user->SetEmailAddress('recipient@example.com');
58 my $queue = RT::Test->load_or_create_queue(
60 CorrespondAddress => 'general@example.com',
62 ok $queue && $queue->id, 'loaded or created queue';
66 Principal => 'Everyone',
67 Right => ['CreateTicket', 'ShowTicket', 'SeeQueue', 'ModifyTicket'],
70 my ($baseurl, $m) = RT::Test->started_ok;
71 ok $m->login, 'logged in';
73 $m->get_ok("/Admin/Queues/Modify.html?id=$qid");
74 $m->form_with_fields('Sign', 'Encrypt');
75 $m->field(Encrypt => 1);
78 RT::Test->clean_caught_mails;
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");
87 is($m->status, 200, "request successful");
89 $m->get($baseurl); # ensure that the mail has been processed
91 my @mail = RT::Test->fetch_caught_mails;
92 ok(@mail, "got some mail");
94 $user->SetEmailAddress('general@example.com');
95 for my $mail (@mail) {
96 unlike $mail, qr/Some content/, "outgoing mail was encrypted";
98 my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
99 my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
100 my $body = strip_headers($mail);
103 Subject: RT mail sent back into RT
104 From: general\@example.com
105 To: recipient\@example.com
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");
116 my $tick = RT::Ticket->new( $RT::SystemUser );
118 ok ($tick->id, "loaded ticket #$id");
121 "RT mail sent back into RT",
125 my $txn = $tick->Transactions->First;
126 my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
128 is( $msg->GetHeader('X-RT-Privacy'),
130 "RT's outgoing mail has crypto"
132 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
134 "RT's outgoing mail looks encrypted"
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");
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);
147 RT::Test->clean_caught_mails;
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");
156 is($m->status, 200, "request successful");
158 $m->get($baseurl); # ensure that the mail has been processed
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";
166 my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
167 my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
168 my $body = strip_headers($mail);
171 Subject: More RT mail sent back into RT
172 From: general\@example.com
173 To: recipient\@example.com
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");
184 my $tick = RT::Ticket->new( $RT::SystemUser );
186 ok ($tick->id, "loaded ticket #$id");
189 "More RT mail sent back into RT",
193 my $txn = $tick->Transactions->First;
194 my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
196 is( $msg->GetHeader('X-RT-Privacy'),
198 "RT's outgoing mail has crypto"
200 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
202 "RT's outgoing mail looks unencrypted"
204 is( $msg->GetHeader('X-RT-Incoming-Signature'),
205 'general <general@example.com>',
206 "RT's outgoing mail looks signed"
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");
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);
219 RT::Test->clean_caught_mails;
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");
229 is($m->status, 200, "request successful");
231 $m->get($baseurl); # ensure that the mail has been processed
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";
238 my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
239 my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
240 my $body = strip_headers($mail);
243 Subject: Final RT mail sent back into RT
244 From: general\@example.com
245 To: recipient\@example.com
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");
256 my $tick = RT::Ticket->new( $RT::SystemUser );
258 ok ($tick->id, "loaded ticket #$id");
261 "Final RT mail sent back into RT",
265 my $txn = $tick->Transactions->First;
266 my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
268 is( $msg->GetHeader('X-RT-Privacy'),
270 "RT's outgoing mail has crypto"
272 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
274 "RT's outgoing mail looks encrypted"
276 is( $msg->GetHeader('X-RT-Incoming-Signature'),
277 'general <general@example.com>',
278 "RT's outgoing mail looks signed"
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");
285 RT::Test->clean_caught_mails;
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");
295 is($m->status, 200, "request successful");
297 $m->get($baseurl); # ensure that the mail has been processed
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";
304 my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
305 my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
306 my $body = strip_headers($mail);
309 Subject: Post-final! RT mail sent back into RT
310 From: general\@example.com
311 To: recipient\@example.com
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");
322 my $tick = RT::Ticket->new( $RT::SystemUser );
324 ok ($tick->id, "loaded ticket #$id");
327 "Post-final! RT mail sent back into RT",
331 my $txn = $tick->Transactions->First;
332 my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
334 is( $msg->GetHeader('X-RT-Privacy'),
336 "RT's outgoing mail has crypto"
338 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
340 "RT's outgoing mail looks unencrypted"
342 is( $msg->GetHeader('X-RT-Incoming-Signature'),
343 'general <general@example.com>',
344 "RT's outgoing mail looks signed"
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");
354 $mail =~ s/.*?\n\n//s;
358 # now test the OwnerNameKey and RequestorsKey fields
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');
364 my $tick = RT::Ticket->new( $RT::SystemUser );
365 $tick->Create(Subject => 'owner lacks pubkey', Queue => 'general',
367 ok(my $id = $tick->id, 'created ticket for owner-without-pubkey');
369 $tick = RT::Ticket->new( $RT::SystemUser );
370 $tick->Create(Subject => 'owner has pubkey', Queue => 'general',
372 ok($id = $tick->id, 'created ticket for owner-with-pubkey');
374 my $mail = << "MAIL";
375 Subject: Nokey requestor
376 From: nokey\@example.com
377 To: general\@example.com
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");
386 $tick = RT::Ticket->new( $RT::SystemUser );
388 ok ($tick->id, "loaded ticket #$id");
396 my $key1 = "EC1E81E7DC3DB42788FB0E4E9FA662C06DE22FC2";
397 my $key2 = "75E156271DCCF02DDD4A7A8CDF651FA0632C4F50";
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");
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");
411 $m->select("PreferredKey" => $key2);
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");
418 $m->get("$baseurl/Prefs/Other.html");
419 like($m->content, qr/Preferred key/, "preferred key option shows up in preference");
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");
426 # test that the new fields work
427 $m->get("$baseurl/Search/Simple.html?q=General");
428 my $content = $m->content;
429 $content =~ s/(/(/g;
430 $content =~ s/)/)/g;
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");
436 like($content, qr/OR-recipient\@example.com-O/, "original Requestors untouched");
437 like($content, qr/OR-nokey\@example.com-O/, "original Requestors untouched");
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");
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");