8 RT::Test::get_abs_relocatable_dir( File::Spec->updir(),
9 qw/data gnupg keyrings/ );
16 passphrase => 'rt-test',
20 use String::ShellQuote 'shell_quote';
24 my ($baseurl, $m) = RT::Test->started_ok;
26 # configure key for General queue
27 ok( $m->login, 'we did log in' );
28 $m->get( $baseurl.'/Admin/Queues/');
29 $m->follow_link_ok( {text => 'General'} );
30 $m->submit_form( form_number => 3,
31 fields => { CorrespondAddress => 'general@example.com' } );
32 $m->content_like(qr/general\@example.com.* - never/, 'has key info.');
34 ok(my $user = RT::User->new(RT->SystemUser));
35 ok($user->Load('root'), "Loaded user 'root'");
36 $user->SetEmailAddress('recipient@example.com');
38 # test simple mail. supposedly this should fail when
39 # 1. the queue requires signature
40 # 2. the from is not what the key is associated with
41 my $mail = RT::Test->open_mailgate_ok($baseurl);
43 From: recipient\@example.com
44 To: general\@$RT::rtname
45 Subject: This is a test of new ticket creation as root
50 RT::Test->close_mailgate_ok($mail);
53 my $tick = RT::Test->last_ticket;
55 'This is a test of new ticket creation as root',
58 my $txn = $tick->Transactions->First;
60 $txn->Attachments->First->Headers,
61 qr/^X-RT-Incoming-Encryption: Not encrypted/m,
62 'recorded incoming mail that is not encrypted'
64 like( $txn->Attachments->First->Content, qr/Blah/);
67 # test for signed mail
72 qw(gpg --batch --no-tty --armor --sign),
73 '--default-key' => 'recipient@example.com',
74 '--homedir' => $homedir,
75 '--passphrase' => 'recipient',
82 $mail = RT::Test->open_mailgate_ok($baseurl);
84 From: recipient\@example.com
85 To: general\@$RT::rtname
86 Subject: signed message for queue
90 RT::Test->close_mailgate_ok($mail);
93 my $tick = RT::Test->last_ticket;
94 is( $tick->Subject, 'signed message for queue',
98 my $txn = $tick->Transactions->First;
99 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
101 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
103 'recorded incoming mail that is encrypted'
105 # test for some kind of PGP-Signed-By: Header
106 like( $attach->Content, qr/fnord/);
109 # test for clear-signed mail
114 qw(gpg --batch --no-tty --armor --sign --clearsign),
115 '--default-key' => 'recipient@example.com',
116 '--homedir' => $homedir,
117 '--passphrase' => 'recipient',
124 $mail = RT::Test->open_mailgate_ok($baseurl);
126 From: recipient\@example.com
127 To: general\@$RT::rtname
128 Subject: signed message for queue
132 RT::Test->close_mailgate_ok($mail);
135 my $tick = RT::Test->last_ticket;
136 is( $tick->Subject, 'signed message for queue',
140 my $txn = $tick->Transactions->First;
141 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
142 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
144 'recorded incoming mail that is encrypted'
146 # test for some kind of PGP-Signed-By: Header
147 like( $attach->Content, qr/clearfnord/);
150 # test for signed and encrypted mail
155 qw(gpg --batch --no-tty --encrypt --armor --sign),
156 '--recipient' => 'general@example.com',
157 '--default-key' => 'recipient@example.com',
158 '--homedir' => $homedir,
159 '--passphrase' => 'recipient',
166 $mail = RT::Test->open_mailgate_ok($baseurl);
168 From: recipient\@example.com
169 To: general\@$RT::rtname
170 Subject: Encrypted message for queue
174 RT::Test->close_mailgate_ok($mail);
177 my $tick = RT::Test->last_ticket;
178 is( $tick->Subject, 'Encrypted message for queue',
182 my $txn = $tick->Transactions->First;
183 my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
185 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
187 'recorded incoming mail that is encrypted'
189 is( $msg->GetHeader('X-RT-Privacy'),
191 'recorded incoming mail that is encrypted'
193 like( $attach->Content, qr/orz/);
195 is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
196 ok(index($orig->Content, $buf) != -1, 'found original msg');
200 # test that if it gets base64 transfer-encoded, we still get the content out
201 $buf = encode_base64($buf);
202 $mail = RT::Test->open_mailgate_ok($baseurl);
204 From: recipient\@example.com
205 To: general\@$RT::rtname
206 Content-transfer-encoding: base64
207 Subject: Encrypted message for queue
211 RT::Test->close_mailgate_ok($mail);
214 my $tick = RT::Test->last_ticket;
215 is( $tick->Subject, 'Encrypted message for queue',
219 my $txn = $tick->Transactions->First;
220 my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef};
222 is( $msg->GetHeader('X-RT-Incoming-Encryption'),
224 'recorded incoming mail that is encrypted'
226 is( $msg->GetHeader('X-RT-Privacy'),
228 'recorded incoming mail that is encrypted'
230 like( $attach->Content, qr/orz/);
232 is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message');
233 ok(index($orig->Content, $buf) != -1, 'found original msg');
236 # test for signed mail by other key
241 qw(gpg --batch --no-tty --armor --sign),
242 '--default-key' => 'rt@example.com',
243 '--homedir' => $homedir,
244 '--passphrase' => 'test',
251 $mail = RT::Test->open_mailgate_ok($baseurl);
253 From: recipient\@example.com
254 To: general\@$RT::rtname
255 Subject: signed message for queue
259 RT::Test->close_mailgate_ok($mail);
262 my $tick = RT::Test->last_ticket;
263 my $txn = $tick->Transactions->First;
264 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
265 # XXX: in this case, which credential should we be using?
266 is( $msg->GetHeader('X-RT-Incoming-Signature'),
267 'Test User <rt@example.com>',
268 'recorded incoming mail signed by others'
272 # test for encrypted mail with key not associated to the queue
277 qw(gpg --batch --no-tty --armor --encrypt),
278 '--recipient' => 'random@localhost',
279 '--homedir' => $homedir,
281 \"should not be there either\r\n",
286 $mail = RT::Test->open_mailgate_ok($baseurl);
288 From: recipient\@example.com
289 To: general\@$RT::rtname
290 Subject: encrypted message for queue
294 RT::Test->close_mailgate_ok($mail);
297 my $tick = RT::Test->last_ticket;
298 my $txn = $tick->Transactions->First;
299 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
303 local $TODO = "this test requires keys associated with queues";
304 unlike( $attach->Content, qr/should not be there either/);
308 # test for badly encrypted mail
314 qw(gpg --batch --no-tty --armor --encrypt),
315 '--recipient' => 'rt@example.com',
316 '--homedir' => $homedir,
318 \"really should not be there either\r\n",
323 $buf =~ s/PGP MESSAGE/SCREWED UP/g;
325 RT::Test->fetch_caught_mails;
327 $mail = RT::Test->open_mailgate_ok($baseurl);
329 From: recipient\@example.com
330 To: general\@$RT::rtname
331 Subject: encrypted message for queue
335 RT::Test->close_mailgate_ok($mail);
336 my @mail = RT::Test->fetch_caught_mails;
337 is(@mail, 1, 'caught outgoing mail.');
341 my $tick = RT::Test->last_ticket;
342 my $txn = $tick->Transactions->First;
343 my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef};
344 unlike( ($attach ? $attach->Content : ''), qr/really should not be there either/);
348 # test that if it gets base64 transfer-encoded long mail then it doesn't hang
350 local $SIG{ALRM} = sub {
351 ok 0, "timed out, web server is probably in deadlock";
355 $buf = encode_base64('a'x(250*1024));
356 $mail = RT::Test->open_mailgate_ok($baseurl);
358 From: recipient\@example.com
359 To: general\@$RT::rtname
360 Content-transfer-encoding: base64
361 Subject: Long not encrypted message for queue
365 RT::Test->close_mailgate_ok($mail);
368 my $tick = RT::Test->last_ticket;
369 is( $tick->Subject, 'Long not encrypted message for queue',
372 my $content = $tick->Transactions->First->Content;
373 like $content, qr/a{1024,}/, 'content is not lost';