5 use RT::Test tests => 51;
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');
14 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 ok( $m->login, 'we did log in' );
38 $m->get( $baseurl.'/Admin/Queues/');
39 $m->follow_link_ok( {text => 'General'} );
40 $m->submit_form( form_number => 3,
41 fields => { CorrespondAddress => 'general@example.com' } );
42 $m->content_like(qr/general\@example.com.* - never/, 'has key info.');
44 ok(my $user = RT::User->new($RT::SystemUser));
45 ok($user->Load('root'), "Loaded user 'root'");
46 $user->SetEmailAddress('recipient@example.com');
48 # test simple mail. supposedly this should fail when
49 # 1. the queue requires signature
50 # 2. the from is not what the key is associated with
51 my $mail = RT::Test->open_mailgate_ok($baseurl);
53 From: recipient\@example.com
54 To: general\@$RT::rtname
55 Subject: This is a test of new ticket creation as root
60 RT::Test->close_mailgate_ok($mail);
63 my $tick = RT::Test->last_ticket;
65 'This is a test of new ticket creation as root',
68 my $txn = $tick->Transactions->First;
70 $txn->Attachments->First->Headers,
71 qr/^X-RT-Incoming-Encryption: Not encrypted/m,
72 'recorded incoming mail that is not encrypted'
74 like( $txn->Attachments->First->Content, qr'Blah');
77 # test for signed mail
82 qw(gpg --armor --sign),
83 '--default-key' => 'recipient@example.com',
84 '--homedir' => $homedir,
85 '--passphrase' => 'recipient',
92 $mail = RT::Test->open_mailgate_ok($baseurl);
94 From: recipient\@example.com
95 To: general\@$RT::rtname
96 Subject: signed message for queue
100 RT::Test->close_mailgate_ok($mail);
103 my $tick = RT::Test->last_ticket;
104 is( $tick->Subject, 'signed message for queue',
108 my $txn = $tick->Transactions->First;
109 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
111 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
113 'recorded incoming mail that is encrypted'
115 # test for some kind of PGP-Signed-By: Header
116 like( $attach->Content, qr'fnord');
119 # test for clear-signed mail
124 qw(gpg --armor --sign --clearsign),
125 '--default-key' => 'recipient@example.com',
126 '--homedir' => $homedir,
127 '--passphrase' => 'recipient',
134 $mail = RT::Test->open_mailgate_ok($baseurl);
136 From: recipient\@example.com
137 To: general\@$RT::rtname
138 Subject: signed message for queue
142 RT::Test->close_mailgate_ok($mail);
145 my $tick = RT::Test->last_ticket;
146 is( $tick->Subject, 'signed message for queue',
150 my $txn = $tick->Transactions->First;
151 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
152 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
154 'recorded incoming mail that is encrypted'
156 # test for some kind of PGP-Signed-By: Header
157 like( $attach->Content, qr'clearfnord');
160 # test for signed and encrypted mail
165 qw(gpg --encrypt --armor --sign),
166 '--recipient' => 'general@example.com',
167 '--default-key' => 'recipient@example.com',
168 '--homedir' => $homedir,
169 '--passphrase' => 'recipient',
176 $mail = RT::Test->open_mailgate_ok($baseurl);
178 From: recipient\@example.com
179 To: general\@$RT::rtname
180 Subject: Encrypted message for queue
184 RT::Test->close_mailgate_ok($mail);
187 my $tick = RT::Test->last_ticket;
188 is( $tick->Subject, 'Encrypted message for queue',
192 my $txn = $tick->Transactions->First;
193 my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
195 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
197 'recorded incoming mail that is encrypted'
199 is( $msg->GetHeader('X-RT-Privacy'),
201 'recorded incoming mail that is encrypted'
203 like( $attach->Content, qr'orz');
205 is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
206 ok(index($orig->Content, $buf) != -1, 'found original msg');
210 # test that if it gets base64 transfer-encoded, we still get the content out
211 $buf = encode_base64($buf);
212 $mail = RT::Test->open_mailgate_ok($baseurl);
214 From: recipient\@example.com
215 To: general\@$RT::rtname
216 Content-transfer-encoding: base64
217 Subject: Encrypted message for queue
221 RT::Test->close_mailgate_ok($mail);
224 my $tick = RT::Test->last_ticket;
225 is( $tick->Subject, 'Encrypted message for queue',
229 my $txn = $tick->Transactions->First;
230 my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
232 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
234 'recorded incoming mail that is encrypted'
236 is( $msg->GetHeader('X-RT-Privacy'),
238 'recorded incoming mail that is encrypted'
240 like( $attach->Content, qr/orz/);
242 is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
243 ok(index($orig->Content, $buf) != -1, 'found original msg');
246 # test for signed mail by other key
251 qw(gpg --armor --sign),
252 '--default-key' => 'rt@example.com',
253 '--homedir' => $homedir,
254 '--passphrase' => 'test',
261 $mail = RT::Test->open_mailgate_ok($baseurl);
263 From: recipient\@example.com
264 To: general\@$RT::rtname
265 Subject: signed message for queue
269 RT::Test->close_mailgate_ok($mail);
272 my $tick = RT::Test->last_ticket;
273 my $txn = $tick->Transactions->First;
274 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
275 # XXX: in this case, which credential should we be using?
276 is( $msg->GetHeader('X-RT-Incoming-Signature'),
277 'Test User <rt@example.com>',
278 'recorded incoming mail signed by others'
282 # test for encrypted mail with key not associated to the queue
287 qw(gpg --armor --encrypt),
288 '--recipient' => 'random@localhost',
289 '--homedir' => $homedir,
291 \"should not be there either\r\n",
296 $mail = RT::Test->open_mailgate_ok($baseurl);
298 From: recipient\@example.com
299 To: general\@$RT::rtname
300 Subject: encrypted message for queue
304 RT::Test->close_mailgate_ok($mail);
307 my $tick = RT::Test->last_ticket;
308 my $txn = $tick->Transactions->First;
309 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
313 local $TODO = "this test requires keys associated with queues";
314 unlike( $attach->Content, qr'should not be there either');
318 # test for badly encrypted mail
324 qw(gpg --armor --encrypt),
325 '--recipient' => 'rt@example.com',
326 '--homedir' => $homedir,
328 \"really should not be there either\r\n",
333 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
335 RT::Test->fetch_caught_mails;
337 $mail = RT::Test->open_mailgate_ok($baseurl);
339 From: recipient\@example.com
340 To: general\@$RT::rtname
341 Subject: encrypted message for queue
345 RT::Test->close_mailgate_ok($mail);
346 my @mail = RT::Test->fetch_caught_mails;
347 is(@mail, 1, 'caught outgoing mail.');
351 my $tick = RT::Test->last_ticket;
352 my $txn = $tick->Transactions->First;
353 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
354 unlike( ($attach ? $attach->Content : ''), qr'really should not be there either');
358 # test that if it gets base64 transfer-encoded long mail then it doesn't hang
360 local $SIG{ALRM} = sub {
361 ok 0, "timed out, web server is probably in deadlock";
365 $buf = encode_base64('a'x(250*1024));
366 $mail = RT::Test->open_mailgate_ok($baseurl);
368 From: recipient\@example.com
369 To: general\@$RT::rtname
370 Content-transfer-encoding: base64
371 Subject: Long not encrypted message for queue
375 RT::Test->close_mailgate_ok($mail);
378 my $tick = RT::Test->last_ticket;
379 is( $tick->Subject, 'Long not encrypted message for queue',
382 my $content = $tick->Transactions->First->Content;
383 like $content, qr/a{1024,}/, 'content is not lost';