-#!/usr/bin/perl -w
use strict;
+use warnings;
-use RT::Test tests => 94;
-
-plan skip_all => 'GnuPG required.'
- unless eval 'use GnuPG::Interface; 1';
-plan skip_all => 'gpg executable is required.'
- unless RT::Test->find_executable('gpg');
-
+use RT::Test::GnuPG
+ tests => undef,
+ gnupg_options => {
+ passphrase => 'recipient',
+ 'trust-model' => 'always',
+};
+use Test::Warn;
+use MIME::Head;
use RT::Action::SendEmail;
-eval 'use GnuPG::Interface; 1' or plan skip_all => 'GnuPG required.';
-
-RT::Test->set_mail_catcher;
-
RT->Config->Set( CommentAddress => 'general@example.com');
RT->Config->Set( CorrespondAddress => 'general@example.com');
RT->Config->Set( DefaultSearchResultFormat => qq{
'<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__id__</a></B>/TITLE:#',
'<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a></B>/TITLE:Subject',
- 'OO-__OwnerName__-O',
+ 'OO-__Owner__-O',
'OR-__Requestors__-O',
- 'KO-__KeyOwnerName__-K',
+ 'KO-__KeyOwner__-K',
'KR-__KeyRequestors__-K',
Status});
-use File::Spec ();
-use Cwd;
-use File::Temp qw(tempdir);
-my $homedir = tempdir( CLEANUP => 1 );
-
-use_ok('RT::Crypt::GnuPG');
-
-RT->Config->Set( 'GnuPG',
- Enable => 1,
- OutgoingMessagesFormat => 'RFC' );
-
-RT->Config->Set( 'GnuPGOptions',
- homedir => $homedir,
- passphrase => 'recipient',
- 'no-permission-warning' => undef,
- 'trust-model' => 'always');
-RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' );
RT::Test->import_gnupg_key('recipient@example.com', 'public');
RT::Test->import_gnupg_key('recipient@example.com', 'secret');
RT::Test->import_gnupg_key('general@example.com.2', 'public');
RT::Test->import_gnupg_key('general@example.com.2', 'secret');
-ok(my $user = RT::User->new($RT::SystemUser));
+ok(my $user = RT::User->new(RT->SystemUser));
ok($user->Load('root'), "Loaded user 'root'");
$user->SetEmailAddress('recipient@example.com');
ok $queue && $queue->id, 'loaded or created queue';
my $qid = $queue->id;
-RT::Test->set_rights(
- Principal => 'Everyone',
- Right => ['CreateTicket', 'ShowTicket', 'SeeQueue', 'ModifyTicket'],
-);
-
my ($baseurl, $m) = RT::Test->started_ok;
ok $m->login, 'logged in';
$m->goto_create_ticket( $queue );
$m->form_name('TicketCreate');
+$m->field('Requestors', 'recipient@example.com');
$m->field('Subject', 'Encryption test');
$m->field('Content', 'Some content');
ok($m->value('Encrypt', 2), "encrypt tick box is checked");
for my $mail (@mail) {
unlike $mail, qr/Some content/, "outgoing mail was encrypted";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
is ($status >> 8, 0, "The mail gateway exited normally");
ok ($id, "got id of a newly created ticket - $id");
- my $tick = RT::Ticket->new( $RT::SystemUser );
+ my $tick = RT::Ticket->new( RT->SystemUser );
$tick->Load( $id );
ok ($tick->id, "loaded ticket #$id");
my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
is( $msg->GetHeader('X-RT-Privacy'),
- 'PGP',
+ 'GnuPG',
"RT's outgoing mail has crypto"
);
is( $msg->GetHeader('X-RT-Incoming-Encryption'),
$m->goto_create_ticket( $queue );
$m->form_name('TicketCreate');
+$m->field('Requestors', 'recipient@example.com');
$m->field('Subject', 'Signing test');
$m->field('Content', 'Some other content');
ok(!$m->value('Encrypt', 2), "encrypt tick box is unchecked");
like $mail, qr/Some other content/, "outgoing mail was not encrypted";
like $mail, qr/-----BEGIN PGP SIGNATURE-----[\s\S]+-----END PGP SIGNATURE-----/, "data has some kind of signature";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
is ($status >> 8, 0, "The mail gateway exited normally");
ok ($id, "got id of a newly created ticket - $id");
- my $tick = RT::Ticket->new( $RT::SystemUser );
+ my $tick = RT::Ticket->new( RT->SystemUser );
$tick->Load( $id );
ok ($tick->id, "loaded ticket #$id");
my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
is( $msg->GetHeader('X-RT-Privacy'),
- 'PGP',
+ 'GnuPG',
"RT's outgoing mail has crypto"
);
is( $msg->GetHeader('X-RT-Incoming-Encryption'),
$m->goto_create_ticket( $queue );
$m->form_name('TicketCreate');
+$m->field('Requestors', 'recipient@example.com');
$m->field('Subject', 'Crypt+Sign test');
$m->field('Content', 'Some final? content');
ok($m->value('Encrypt', 2), "encrypt tick box is checked");
for my $mail (@mail) {
unlike $mail, qr/Some other content/, "outgoing mail was encrypted";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
is ($status >> 8, 0, "The mail gateway exited normally");
ok ($id, "got id of a newly created ticket - $id");
- my $tick = RT::Ticket->new( $RT::SystemUser );
+ my $tick = RT::Ticket->new( RT->SystemUser );
$tick->Load( $id );
ok ($tick->id, "loaded ticket #$id");
my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
is( $msg->GetHeader('X-RT-Privacy'),
- 'PGP',
+ 'GnuPG',
"RT's outgoing mail has crypto"
);
is( $msg->GetHeader('X-RT-Incoming-Encryption'),
$m->goto_create_ticket( $queue );
$m->form_name('TicketCreate');
+$m->field('Requestors', 'recipient@example.com');
$m->field('Subject', 'Test crypt-off on encrypted queue');
$m->field('Content', 'Thought you had me figured out didya');
$m->field(Encrypt => undef, 2); # turn off encryption
for my $mail (@mail) {
like $mail, qr/Thought you had me figured out didya/, "outgoing mail was unencrypted";
- my ($content_type) = $mail =~ /^(Content-Type: .*)/m;
- my ($mime_version) = $mail =~ /^(MIME-Version: .*)/m;
+ my ($content_type, $mime_version) = get_headers($mail, "Content-Type", "MIME-Version");
my $body = strip_headers($mail);
$mail = << "MAIL";
is ($status >> 8, 0, "The mail gateway exited normally");
ok ($id, "got id of a newly created ticket - $id");
- my $tick = RT::Ticket->new( $RT::SystemUser );
+ my $tick = RT::Ticket->new( RT->SystemUser );
$tick->Load( $id );
ok ($tick->id, "loaded ticket #$id");
my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef};
is( $msg->GetHeader('X-RT-Privacy'),
- 'PGP',
+ 'GnuPG',
"RT's outgoing mail has crypto"
);
is( $msg->GetHeader('X-RT-Incoming-Encryption'),
like($attachments[0]->Content, qr/$RT::rtname/, "RT's mail includes this instance's name");
}
+sub get_headers {
+ my $mail = shift;
+ open my $fh, "<", \$mail or die $!;
+ my $head = MIME::Head->read($fh);
+ return @{[
+ map {
+ my $hdr = "$_: " . $head->get($_);
+ chomp $hdr;
+ $hdr;
+ }
+ @_
+ ]};
+}
+
sub strip_headers
{
my $mail = shift;
$nokey->PrincipalObj->GrantRight(Right => 'CreateTicket');
$nokey->PrincipalObj->GrantRight(Right => 'OwnTicket');
-my $tick = RT::Ticket->new( $RT::SystemUser );
-$tick->Create(Subject => 'owner lacks pubkey', Queue => 'general',
- Owner => $nokey);
+my $tick = RT::Ticket->new( RT->SystemUser );
+warning_like {
+ $tick->Create(Subject => 'owner lacks pubkey', Queue => 'general',
+ Owner => $nokey);
+} [
+ qr/nokey\@example.com: skipped: public key not found/,
+ qr/Recipient 'nokey\@example.com' is unusable/,
+];
ok(my $id = $tick->id, 'created ticket for owner-without-pubkey');
-$tick = RT::Ticket->new( $RT::SystemUser );
+$tick = RT::Ticket->new( RT->SystemUser );
$tick->Create(Subject => 'owner has pubkey', Queue => 'general',
Owner => 'root');
ok($id = $tick->id, 'created ticket for owner-with-pubkey');
hello
MAIL
-((my $status), $id) = RT::Test->send_via_mailgate($mail);
+my $status;
+warning_like {
+ ($status, $id) = RT::Test->send_via_mailgate($mail);
+} [
+ qr/nokey\@example.com: skipped: public key not found/,
+ qr/Recipient 'nokey\@example.com' is unusable/,
+];
+
is ($status >> 8, 0, "The mail gateway exited normally");
ok ($id, "got id of a newly created ticket - $id");
-$tick = RT::Ticket->new( $RT::SystemUser );
+$tick = RT::Ticket->new( RT->SystemUser );
$tick->Load( $id );
ok ($tick->id, "loaded ticket #$id");
my $key1 = "EC1E81E7DC3DB42788FB0E4E9FA662C06DE22FC2";
my $key2 = "75E156271DCCF02DDD4A7A8CDF651FA0632C4F50";
-ok($user = RT::User->new($RT::SystemUser));
+ok($user = RT::User->new(RT->SystemUser));
ok($user->Load('root'), "Loaded user 'root'");
is($user->PreferredKey, $key1, "preferred key is set correctly");
$m->get("$baseurl/Prefs/Other.html");
like($m->content, qr/$key2/, "second key shows up in preferences");
like($m->content, qr/$key1.*?$key2/s, "first key shows up before the second");
-$m->form_number(3);
+$m->form_name('ModifyPreferences');
$m->select("PreferredKey" => $key2);
$m->submit;
-ok($user = RT::User->new($RT::SystemUser));
+ok($user = RT::User->new(RT->SystemUser));
ok($user->Load('root'), "Loaded user 'root'");
is($user->PreferredKey, $key2, "preferred key is set correctly to the new value");
like($m->content, qr/$key1/, "first key shows up in preferences");
like($m->content, qr/$key2.*?$key1/s, "second key (now preferred) shows up before the first");
+$m->no_warnings_ok;
+
# test that the new fields work
$m->get("$baseurl/Search/Simple.html?q=General");
my $content = $m->content;
$content =~ s/(/(/g;
$content =~ s/)/)/g;
-
-like($content, qr/OO-Nobody-O/, "original OwnerName untouched");
-like($content, qr/OO-nokey-O/, "original OwnerName untouched");
-like($content, qr/OO-root-O/, "original OwnerName untouched");
-
-like($content, qr/OR-recipient\@example.com-O/, "original Requestors untouched");
-like($content, qr/OR-nokey\@example.com-O/, "original Requestors untouched");
-
-like($content, qr/KO-root-K/, "KeyOwnerName does not issue no-pubkey warning for recipient");
-like($content, qr/KO-nokey \(no pubkey!\)-K/, "KeyOwnerName issues no-pubkey warning for root");
-like($content, qr/KO-Nobody \(no pubkey!\)-K/, "KeyOwnerName issues no-pubkey warning for nobody");
-
-like($content, qr/KR-recipient\@example.com-K/, "KeyRequestors does not issue no-pubkey warning for recipient\@example.com");
-like($content, qr/KR-general\@example.com-K/, "KeyRequestors does not issue no-pubkey warning for general\@example.com");
-like($content, qr/KR-nokey\@example.com \(no pubkey!\)-K/, "KeyRequestors DOES issue no-pubkey warning for nokey\@example.com");
-
+$content =~ s/<(a|span)\b[^>]+>//g;
+$content =~ s/<\/(a|span)>//g;
+$content =~ s/</</g;
+$content =~ s/>/>/g;
+
+like($content, qr/OO-Nobody in particular-O/,
+ "original Owner untouched");
+like($content, qr/OO-nokey-O/,
+ "original Owner untouched");
+like($content, qr/OO-root \(Enoch Root\)-O/,
+ "original Owner untouched");
+like($content, qr/OR-<recipient\@example\.com>-O/,
+ "original Requestors untouched");
+like($content, qr/OR-nokey-O/,
+ "original Requestors untouched");
+
+like($content, qr/KO-Nobody in particular \(no pubkey!\)-K/,
+ "KeyOwner issues no-pubkey warning for nobody");
+like($content, qr/KO-nokey \(no pubkey!\)-K/,
+ "KeyOwner issues no-pubkey warning for root");
+like($content, qr/KO-root \(Enoch Root\)-K/,
+ "KeyOwner does not issue no-pubkey warning for recipient");
+like($content, qr/KR-<recipient\@example\.com>-K/,
+ "KeyRequestors does not issue no-pubkey warning for recipient\@example.com");
+like($content, qr/KR-nokey \(no pubkey!\)-K/,
+ "KeyRequestors DOES issue no-pubkey warning for nokey\@example.com");
+
+$m->next_warning_like(qr/public key not found/);
+$m->next_warning_like(qr/public key not found/);
+$m->no_leftover_warnings_ok;
+
+undef $m;
+done_testing;