6 use RT::Test tests => 137;
10 use RT::Action::SendEmail;
12 my @_outgoing_messages;
15 #We're not testing acls here.
16 my $everyone = RT::Group->new($RT::SystemUser);
17 $everyone->LoadSystemInternalGroup('Everyone');
18 $everyone->PrincipalObj->GrantRight( Right =>'SuperUser' );
21 is (__PACKAGE__, 'main', "We're operating in the main package");
24 no warnings qw/redefine/;
25 sub RT::Action::SendEmail::SendMessage {
29 main::_fired_scrip($self->ScripObj);
30 main::is(ref($MIME) , 'MIME::Entity', "hey, look. it's a mime entity");
35 sub first_txn { return $_[0]->Transactions->First }
36 sub first_attach { return first_txn($_[0])->Attachments->First }
38 sub count_txns { return $_[0]->Transactions->Count }
39 sub count_attachs { return first_txn($_[0])->Attachments->Count }
41 # instrument SendEmail to pass us what it's about to send.
42 # create a regular ticket
44 my $parser = RT::EmailParser->new();
46 # Let's test to make sure a multipart/report is processed correctly
47 my $multipart_report_email = RT::Test::get_relocatable_file('multipart-report',
48 (File::Spec->updir(), 'data', 'emails'));
49 my $content = RT::Test->file_content($multipart_report_email);
50 # be as much like the mail gateway as possible.
51 use RT::Interface::Email;
52 my %args = (message => $content, queue => 1, action => 'correspond');
53 my ($status, $msg) = RT::Interface::Email::Gateway(\%args);
54 ok($status, "successfuly used Email::Gateway interface") or diag("error: $msg");
55 my $tickets = RT::Tickets->new($RT::SystemUser);
56 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
57 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
58 my $tick= $tickets->First();
59 isa_ok($tick, "RT::Ticket", "got a ticket object");
60 ok ($tick->Id, "found ticket ".$tick->Id);
61 like (first_txn($tick)->Content , qr/The original message was received/, "It's the bounce");
64 # make sure it fires scrips.
65 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
72 $parser->ParseMIMEEntityFromScalar('From: root@localhost
74 Subject: This is a test of new ticket creation as an unknown user
82 my $ticket = RT::Ticket->new($RT::SystemUser);
83 my ($id, undef, $create_msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
85 $tickets = RT::Tickets->new($RT::SystemUser);
86 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
87 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
88 $tick = $tickets->First();
89 ok ($tick->Id, "found ticket ".$tick->Id);
90 is ($tick->Subject , 'I18NTest', "failed to create the new ticket from an unprivileged account");
92 # make sure it fires scrips.
93 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
94 # make sure it sends an autoreply
95 # make sure it sends a notification to adminccs
98 # we need to swap out SendMessage to test the new things we care about;
99 &utf8_redef_sendmessage;
101 # create an iso 8859-1 ticket
104 my $iso_8859_1_ticket_email = RT::Test::get_relocatable_file(
105 'new-ticket-from-iso-8859-1', (File::Spec->updir(), 'data', 'emails'));
106 $content = RT::Test->file_content($iso_8859_1_ticket_email);
110 $parser->ParseMIMEEntityFromScalar($content);
113 # be as much like the mail gateway as possible.
114 use RT::Interface::Email;
116 %args = (message => $content, queue => 1, action => 'correspond');
117 RT::Interface::Email::Gateway(\%args);
118 $tickets = RT::Tickets->new($RT::SystemUser);
119 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
120 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
121 $tick = $tickets->First();
122 ok ($tick->Id, "found ticket ".$tick->Id);
124 like (first_txn($tick)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay");
127 # make sure it fires scrips.
128 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
129 # make sure it sends an autoreply
132 # make sure it sends a notification to adminccs
134 # If we correspond, does it do the right thing to the outbound messages?
136 $parser->ParseMIMEEntityFromScalar($content);
137 ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
140 $parser->ParseMIMEEntityFromScalar($content);
141 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
148 # we need to swap out SendMessage to test the new things we care about;
149 &iso8859_redef_sendmessage;
150 RT->Config->Set( EmailOutputEncoding => 'iso-8859-1' );
151 # create an iso 8859-1 ticket
154 $content = RT::Test->file_content($iso_8859_1_ticket_email);
155 # be as much like the mail gateway as possible.
156 use RT::Interface::Email;
158 %args = (message => $content, queue => 1, action => 'correspond');
159 RT::Interface::Email::Gateway(\%args);
160 $tickets = RT::Tickets->new($RT::SystemUser);
161 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
162 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
163 $tick = $tickets->First();
164 ok ($tick->Id, "found ticket ".$tick->Id);
166 like (first_txn($tick)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay");
169 # make sure it fires scrips.
170 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
171 # make sure it sends an autoreply
174 # make sure it sends a notification to adminccs
177 # If we correspond, does it do the right thing to the outbound messages?
179 $parser->ParseMIMEEntityFromScalar($content);
180 ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
183 $parser->ParseMIMEEntityFromScalar($content);
184 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
190 push @scrips_fired, $scrip;
193 sub utf8_redef_sendmessage {
194 no warnings qw/redefine/;
196 sub RT::Action::SendEmail::SendMessage {
200 my $scrip = $self->ScripObj->id;
201 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
202 main::_fired_scrip($self->ScripObj);
203 $MIME->make_singlepart;
204 main::is( ref($MIME) , \'MIME::Entity\',
205 "hey, look. it\'s a mime entity" );
206 main::is( ref( $MIME->head ) , \'MIME::Head\',
207 "its mime header is a mime header. yay" );
208 main::like( $MIME->head->get(\'Content-Type\') , qr/utf-8/,
209 "Its content type is utf-8" );
210 my $message_as_string = $MIME->bodyhandle->as_string();
212 $message_as_string = Encode::decode_utf8($message_as_string);
214 $message_as_string , qr/H\x{e5}vard/,
215 "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
220 sub iso8859_redef_sendmessage {
221 no warnings qw/redefine/;
223 sub RT::Action::SendEmail::SendMessage {
227 my $scrip = $self->ScripObj->id;
228 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
229 main::_fired_scrip($self->ScripObj);
230 $MIME->make_singlepart;
231 main::is( ref($MIME) , \'MIME::Entity\',
232 "hey, look. it\'s a mime entity" );
233 main::is( ref( $MIME->head ) , \'MIME::Head\',
234 "its mime header is a mime header. yay" );
235 main::like( $MIME->head->get(\'Content-Type\') , qr/iso-8859-1/,
236 "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
237 my $message_as_string = $MIME->bodyhandle->as_string();
239 $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
241 $message_as_string , qr/H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
246 # {{{ test a multipart alternative containing a text-html part with an umlaut
248 my $alt_umlaut_email = RT::Test::get_relocatable_file(
249 'multipart-alternative-with-umlaut', (File::Spec->updir(), 'data', 'emails'));
250 $content = RT::Test->file_content($alt_umlaut_email);
252 $parser->ParseMIMEEntityFromScalar($content);
255 # be as much like the mail gateway as possible.
257 no warnings qw/redefine/;
258 local *RT::Action::SendEmail::SendMessage = sub { return 1};
260 %args = (message => $content, queue => 1, action => 'correspond');
261 RT::Interface::Email::Gateway(\%args);
262 # TODO: following 5 lines should replaced by get_latest_ticket_ok()
263 $tickets = RT::Tickets->new($RT::SystemUser);
264 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
265 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
266 $tick = $tickets->First();
268 ok ($tick->Id, "found ticket ".$tick->Id);
270 like (first_txn($tick)->Content , qr/causes Error/, "We recorded the content right as text-plain");
271 is (count_attachs($tick) , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
277 # {{{ test a text-html message with an umlaut
278 my $text_html_email = RT::Test::get_relocatable_file('text-html-with-umlaut',
279 (File::Spec->updir(), 'data', 'emails'));
280 $content = RT::Test->file_content($text_html_email);
282 $parser->ParseMIMEEntityFromScalar($content);
285 # be as much like the mail gateway as possible.
286 &text_html_redef_sendmessage;
288 %args = (message => $content, queue => 1, action => 'correspond');
289 RT::Interface::Email::Gateway(\%args);
290 $tickets = RT::Tickets->new($RT::SystemUser);
291 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
292 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
293 $tick = $tickets->First();
294 ok ($tick->Id, "found ticket ".$tick->Id);
296 like (first_attach($tick)->Content , qr/causes Error/, "We recorded the content as containing 'causes error'") or diag( first_attach($tick)->Content );
297 like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the content as text/html");
298 is (count_attachs($tick), 1 , "Has one attachment, presumably a text-html and a multipart alternative");
300 sub text_html_redef_sendmessage {
301 no warnings qw/redefine/;
302 eval 'sub RT::Action::SendEmail::SendMessage {
305 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
306 is ($MIME->parts, 0, "generated correspondence mime entity
307 does not have parts");
308 is ($MIME->head->mime_type , "text/plain", "The mime type is a plain");
314 # {{{ test a text-html message with russian characters
315 my $russian_email = RT::Test::get_relocatable_file('text-html-in-russian',
316 (File::Spec->updir(), 'data', 'emails'));
317 $content = RT::Test->file_content($russian_email);
319 $parser->ParseMIMEEntityFromScalar($content);
322 # be as much like the mail gateway as possible.
323 &text_html_redef_sendmessage;
325 %args = (message => $content, queue => 1, action => 'correspond');
326 RT::Interface::Email::Gateway(\%args);
327 $tickets = RT::Tickets->new($RT::SystemUser);
328 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
329 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
330 $tick = $tickets->First();
331 ok ($tick->Id, "found ticket ".$tick->Id);
333 like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the content right as text-html");
335 is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-html and a multipart alternative");
339 # {{{ test a message containing a russian subject and NO content type
341 RT->Config->Set( EmailInputEncodings => 'koi8-r', RT->Config->Get('EmailInputEncodings') );
342 RT->Config->Set( EmailOutputEncoding => 'koi8-r' );
343 my $russian_subject_email = RT::Test::get_relocatable_file(
344 'russian-subject-no-content-type', (File::Spec->updir(), 'data', 'emails'));
345 $content = RT::Test->file_content($russian_subject_email);
347 $parser->ParseMIMEEntityFromScalar($content);
350 # be as much like the mail gateway as possible.
351 &text_plain_russian_redef_sendmessage;
352 %args = (message => $content, queue => 1, action => 'correspond');
353 RT::Interface::Email::Gateway(\%args);
354 $tickets = RT::Tickets->new($RT::SystemUser);
355 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
356 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
357 $tick= $tickets->First();
358 ok ($tick->Id, "found ticket ".$tick->Id);
360 like (first_attach($tick)->ContentType , qr/text\/plain/, "We recorded the content type right");
361 is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-plain");
362 is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
363 sub text_plain_russian_redef_sendmessage {
364 no warnings qw/redefine/;
365 eval 'sub RT::Action::SendEmail::SendMessage {
368 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
369 is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
370 my $subject = $MIME->head->get("subject");
372 #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
377 my @input_encodings = RT->Config->Get( 'EmailInputEncodings' );
378 shift @input_encodings;
379 RT->Config->Set(EmailInputEncodings => @input_encodings );
380 RT->Config->Set(EmailOutputEncoding => 'utf-8');
384 # {{{ test a message containing a nested RFC 822 message
386 my $nested_rfc822_email = RT::Test::get_relocatable_file('nested-rfc-822',
387 (File::Spec->updir(), 'data', 'emails'));
388 $content = RT::Test->file_content($nested_rfc822_email);
389 ok ($content, "Loaded nested-rfc-822 to test");
391 $parser->ParseMIMEEntityFromScalar($content);
394 # be as much like the mail gateway as possible.
395 &text_plain_nested_redef_sendmessage;
396 %args = (message => $content, queue => 1, action => 'correspond');
397 RT::Interface::Email::Gateway(\%args);
398 $tickets = RT::Tickets->new($RT::SystemUser);
399 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
400 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
401 $tick= $tickets->First();
402 ok ($tick->Id, "found ticket ".$tick->Id);
403 is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
404 like (first_attach($tick)->ContentType , qr/multipart\/mixed/, "We recorded the content type right");
405 is (count_attachs($tick) , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
406 sub text_plain_nested_redef_sendmessage {
407 no warnings qw/redefine/;
408 eval 'sub RT::Action::SendEmail::SendMessage {
411 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
412 is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
413 my $subject = $MIME->head->get("subject");
414 $subject = MIME::Base64::decode_base64( $subject);
416 # TODO, why does this test fail
417 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
425 # {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
427 my $uuencoded_email = RT::Test::get_relocatable_file('notes-uuencoded',
428 (File::Spec->updir(), 'data', 'emails'));
429 $content = RT::Test->file_content($uuencoded_email);
431 $parser->ParseMIMEEntityFromScalar($content);
434 # be as much like the mail gateway as possible.
436 no warnings qw/redefine/;
437 local *RT::Action::SendEmail::SendMessage = sub { return 1};
438 %args = (message => $content, queue => 1, action => 'correspond');
439 RT::Interface::Email::Gateway(\%args);
440 $tickets = RT::Tickets->new($RT::SystemUser);
441 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
442 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
443 $tick= $tickets->First();
444 ok ($tick->Id, "found ticket ".$tick->Id);
446 like (first_txn($tick)->Content , qr/from Lotus Notes/, "We recorded the content right");
447 is (count_attachs($tick) , 3 , "Has three attachments");
452 # {{{ test a multipart that crashes the file-based mime-parser works
454 my $crashes_file_based_parser_email = RT::Test::get_relocatable_file(
455 'crashes-file-based-parser', (File::Spec->updir(), 'data', 'emails'));
456 $content = RT::Test->file_content($crashes_file_based_parser_email);
458 $parser->ParseMIMEEntityFromScalar($content);
461 # be as much like the mail gateway as possible.
463 no warnings qw/redefine/;
464 local *RT::Action::SendEmail::SendMessage = sub { return 1};
465 %args = (message => $content, queue => 1, action => 'correspond');
466 RT::Interface::Email::Gateway(\%args);
467 $tickets = RT::Tickets->new($RT::SystemUser);
468 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
469 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
470 $tick= $tickets->First();
471 ok ($tick->Id, "found ticket ".$tick->Id);
473 like (first_txn($tick)->Content , qr/FYI/, "We recorded the content right");
474 is (count_attachs($tick) , 5 , "Has three attachments");
481 # {{{ test a multi-line RT-Send-CC header
483 my $rt_send_cc_email = RT::Test::get_relocatable_file('rt-send-cc',
484 (File::Spec->updir(), 'data', 'emails'));
485 $content = RT::Test->file_content($rt_send_cc_email);
487 $parser->ParseMIMEEntityFromScalar($content);
491 %args = (message => $content, queue => 1, action => 'correspond');
492 RT::Interface::Email::Gateway(\%args);
493 $tickets = RT::Tickets->new($RT::SystemUser);
494 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
495 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
496 $tick= $tickets->First();
497 ok ($tick->Id, "found ticket ".$tick->Id);
499 my $cc = first_attach($tick)->GetHeader('RT-Send-Cc');
500 like ($cc , qr/test1/, "Found test 1");
501 like ($cc , qr/test2/, "Found test 2");
502 like ($cc , qr/test3/, "Found test 3");
503 like ($cc , qr/test4/, "Found test 4");
504 like ($cc , qr/test5/, "Found test 5");
508 diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
510 my $subject_folding_email = RT::Test::get_relocatable_file(
511 'subject-with-folding-ws', (File::Spec->updir(), 'data', 'emails'));
512 my $content = RT::Test->file_content($subject_folding_email);
513 my ($status, $msg, $ticket) = RT::Interface::Email::Gateway(
514 { message => $content, queue => 1, action => 'correspond' }
516 ok ($status, 'created ticket') or diag "error: $msg";
517 ok ($ticket->id, "found ticket ". $ticket->id);
518 is ($ticket->Subject, 'test', 'correct subject');
521 diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
523 my $long_subject_email = RT::Test::get_relocatable_file('very-long-subject',
524 (File::Spec->updir(), 'data', 'emails'));
525 my $content = RT::Test->file_content($long_subject_email);
526 my ($status, $msg, $ticket) = RT::Interface::Email::Gateway(
527 { message => $content, queue => 1, action => 'correspond' }
529 ok ($status, 'created ticket') or diag "error: $msg";
530 ok ($ticket->id, "found ticket ". $ticket->id);
531 is ($ticket->Subject, '0123456789'x20, 'correct subject');
536 # Don't taint the environment
537 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');