5 use RT::Test tests => 39;
7 plan skip_all => 'GnuPG required.'
8 unless eval 'use GnuPG::Interface; 1';
9 plan skip_all => 'gpg executable is required.'
10 unless RT::Test->find_executable('gpg');
15 use String::ShellQuote 'shell_quote';
18 my $homedir = RT::Test::get_abs_relocatable_dir(File::Spec->updir(),
19 qw(data gnupg keyrings));
21 # catch any outgoing emails
22 RT::Test->set_mail_catcher;
24 RT->Config->Set( 'GnuPG',
26 OutgoingMessagesFormat => 'RFC' );
28 RT->Config->Set( 'GnuPGOptions',
30 'no-permission-warning' => undef);
32 RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' );
34 my ($baseurl, $m) = RT::Test->started_ok;
36 # configure key for General queue
37 $m->get( $baseurl."?user=root;pass=password" );
38 $m->content_like(qr/Logout/, 'we did log in');
39 $m->get( $baseurl.'/Admin/Queues/');
40 $m->follow_link_ok( {text => 'General'} );
41 $m->submit_form( form_number => 3,
42 fields => { CorrespondAddress => 'general@example.com' } );
43 $m->content_like(qr/general\@example.com.* - never/, 'has key info.');
45 ok(my $user = RT::User->new($RT::SystemUser));
46 ok($user->Load('root'), "Loaded user 'root'");
47 $user->SetEmailAddress('recipient@example.com');
49 # test simple mail. supposedly this should fail when
50 # 1. the queue requires signature
51 # 2. the from is not what the key is associated with
52 my $mail = RT::Test->open_mailgate_ok($baseurl);
54 From: recipient\@example.com
55 To: general\@$RT::rtname
56 Subject: This is a test of new ticket creation as root
61 RT::Test->close_mailgate_ok($mail);
64 my $tick = RT::Test->last_ticket;
66 'This is a test of new ticket creation as root',
69 my $txn = $tick->Transactions->First;
71 $txn->Attachments->First->Headers,
72 qr/^X-RT-Incoming-Encryption: Not encrypted/m,
73 'recorded incoming mail that is not encrypted'
75 like( $txn->Attachments->First->Content, qr'Blah');
78 # test for signed mail
83 qw(gpg --armor --sign),
84 '--default-key' => 'recipient@example.com',
85 '--homedir' => $homedir,
86 '--passphrase' => 'recipient',
93 $mail = RT::Test->open_mailgate_ok($baseurl);
95 From: recipient\@example.com
96 To: general\@$RT::rtname
97 Subject: signed message for queue
101 RT::Test->close_mailgate_ok($mail);
104 my $tick = RT::Test->last_ticket;
105 is( $tick->Subject, 'signed message for queue',
109 my $txn = $tick->Transactions->First;
110 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
112 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
114 'recorded incoming mail that is encrypted'
116 # test for some kind of PGP-Signed-By: Header
117 like( $attach->Content, qr'fnord');
120 # test for clear-signed mail
125 qw(gpg --armor --sign --clearsign),
126 '--default-key' => 'recipient@example.com',
127 '--homedir' => $homedir,
128 '--passphrase' => 'recipient',
135 $mail = RT::Test->open_mailgate_ok($baseurl);
137 From: recipient\@example.com
138 To: general\@$RT::rtname
139 Subject: signed message for queue
143 RT::Test->close_mailgate_ok($mail);
146 my $tick = RT::Test->last_ticket;
147 is( $tick->Subject, 'signed message for queue',
151 my $txn = $tick->Transactions->First;
152 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
153 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
155 'recorded incoming mail that is encrypted'
157 # test for some kind of PGP-Signed-By: Header
158 like( $attach->Content, qr'clearfnord');
161 # test for signed and encrypted mail
166 qw(gpg --encrypt --armor --sign),
167 '--recipient' => 'general@example.com',
168 '--default-key' => 'recipient@example.com',
169 '--homedir' => $homedir,
170 '--passphrase' => 'recipient',
177 $mail = RT::Test->open_mailgate_ok($baseurl);
179 From: recipient\@example.com
180 To: general\@$RT::rtname
181 Subject: Encrypted message for queue
185 RT::Test->close_mailgate_ok($mail);
188 my $tick = RT::Test->last_ticket;
189 is( $tick->Subject, 'Encrypted message for queue',
193 my $txn = $tick->Transactions->First;
194 my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
196 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
198 'recorded incoming mail that is encrypted'
200 is( $msg->GetHeader('X-RT-Privacy'),
202 'recorded incoming mail that is encrypted'
204 like( $attach->Content, qr'orz');
206 is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
207 ok(index($orig->Content, $buf) != -1, 'found original msg');
210 # test for signed mail by other key
215 qw(gpg --armor --sign),
216 '--default-key' => 'rt@example.com',
217 '--homedir' => $homedir,
218 '--passphrase' => 'test',
225 $mail = RT::Test->open_mailgate_ok($baseurl);
227 From: recipient\@example.com
228 To: general\@$RT::rtname
229 Subject: signed message for queue
233 RT::Test->close_mailgate_ok($mail);
236 my $tick = RT::Test->last_ticket;
237 my $txn = $tick->Transactions->First;
238 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
239 # XXX: in this case, which credential should we be using?
240 is( $msg->GetHeader('X-RT-Incoming-Signature'),
241 'Test User <rt@example.com>',
242 'recorded incoming mail signed by others'
246 # test for encrypted mail with key not associated to the queue
251 qw(gpg --armor --encrypt),
252 '--recipient' => 'random@localhost',
253 '--homedir' => $homedir,
255 \"should not be there either\r\n",
260 $mail = RT::Test->open_mailgate_ok($baseurl);
262 From: recipient\@example.com
263 To: general\@$RT::rtname
264 Subject: encrypted message for queue
268 RT::Test->close_mailgate_ok($mail);
271 my $tick = RT::Test->last_ticket;
272 my $txn = $tick->Transactions->First;
273 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
277 local $TODO = "this test requires keys associated with queues";
278 unlike( $attach->Content, qr'should not be there either');
282 # test for badly encrypted mail
288 qw(gpg --armor --encrypt),
289 '--recipient' => 'rt@example.com',
290 '--homedir' => $homedir,
292 \"really should not be there either\r\n",
297 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
299 RT::Test->fetch_caught_mails;
301 $mail = RT::Test->open_mailgate_ok($baseurl);
303 From: recipient\@example.com
304 To: general\@$RT::rtname
305 Subject: encrypted message for queue
309 RT::Test->close_mailgate_ok($mail);
310 my @mail = RT::Test->fetch_caught_mails;
311 is(@mail, 1, 'caught outgoing mail.');
315 my $tick = RT::Test->last_ticket;
316 my $txn = $tick->Transactions->First;
317 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
318 unlike( ($attach ? $attach->Content : ''), qr'really should not be there either');