4 use Test::More tests => 142;
12 use RT::Action::SendEmail;
14 my @_outgoing_messages;
17 #We're not testing acls here.
18 my $everyone = RT::Group->new($RT::SystemUser);
19 $everyone->LoadSystemInternalGroup('Everyone');
20 $everyone->PrincipalObj->GrantRight(Right =>'SuperUser');
23 is (__PACKAGE__, 'main', "We're operating in the main package");
26 no warnings qw/redefine/;
27 sub RT::Action::SendEmail::SendMessage {
31 main::_fired_scrip($self->ScripObj);
32 main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
37 sub first_txn { return $_[0]->Transactions->First }
38 sub first_attach { return first_txn($_[0])->Attachments->First }
40 sub count_txns { return $_[0]->Transactions->Count }
41 sub count_attachs { return first_txn($_[0])->Attachments->Count }
45 open my $fh, "<:raw", $_[0] or die "couldn't open file '$_[0]': $!";
50 # instrument SendEmail to pass us what it's about to send.
51 # create a regular ticket
53 my $parser = RT::EmailParser->new();
56 # Let's test to make sure a multipart/report is processed correctly
57 my $content = file_content("$RT::BasePath/lib/t/data/multipart-report");
58 # be as much like the mail gateway as possible.
59 use RT::Interface::Email;
61 my %args = (message => $content, queue => 1, action => 'correspond');
62 RT::Interface::Email::Gateway(\%args);
63 my $tickets = RT::Tickets->new($RT::SystemUser);
64 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
65 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
66 my $tick= $tickets->First();
67 isa_ok($tick, "RT::Ticket", "got a ticket object");
68 ok ($tick->Id, "found ticket ".$tick->Id);
70 ok (first_txn($tick)->Content =~ /The original message was received/, "It's the bounce");
73 # make sure it fires scrips.
74 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
81 $parser->ParseMIMEEntityFromScalar('From: root@localhost
83 Subject: This is a test of new ticket creation as an unknown user
91 my $ticket = RT::Ticket->new($RT::SystemUser);
92 my ($id, undef, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
94 $tickets = RT::Tickets->new($RT::SystemUser);
95 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
96 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
97 $tick = $tickets->First();
98 ok ($tick->Id, "found ticket ".$tick->Id);
99 ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account");
101 # make sure it fires scrips.
102 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
103 # make sure it sends an autoreply
104 # make sure it sends a notification to adminccs
107 # we need to swap out SendMessage to test the new things we care about;
108 &utf8_redef_sendmessage;
110 # create an iso 8859-1 ticket
113 $content = file_content("$RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1");
117 $parser->ParseMIMEEntityFromScalar($content);
120 # be as much like the mail gateway as possible.
121 use RT::Interface::Email;
123 %args = (message => $content, queue => 1, action => 'correspond');
124 RT::Interface::Email::Gateway(\%args);
125 $tickets = RT::Tickets->new($RT::SystemUser);
126 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
127 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
128 $tick = $tickets->First();
129 ok ($tick->Id, "found ticket ".$tick->Id);
131 ok (first_txn($tick)->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
134 # make sure it fires scrips.
135 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
136 # make sure it sends an autoreply
139 # make sure it sends a notification to adminccs
141 # If we correspond, does it do the right thing to the outbound messages?
143 $parser->ParseMIMEEntityFromScalar($content);
144 ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
147 $parser->ParseMIMEEntityFromScalar($content);
148 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
155 # we need to swap out SendMessage to test the new things we care about;
156 &iso8859_redef_sendmessage;
157 $RT::EmailOutputEncoding = 'iso-8859-1';
158 # create an iso 8859-1 ticket
161 $content = file_content("$RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1");
162 # be as much like the mail gateway as possible.
163 use RT::Interface::Email;
165 %args = (message => $content, queue => 1, action => 'correspond');
166 RT::Interface::Email::Gateway(\%args);
167 $tickets = RT::Tickets->new($RT::SystemUser);
168 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
169 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
170 $tick = $tickets->First();
171 ok ($tick->Id, "found ticket ".$tick->Id);
173 ok (first_txn($tick)->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
176 # make sure it fires scrips.
177 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
178 # make sure it sends an autoreply
181 # make sure it sends a notification to adminccs
184 # If we correspond, does it do the right thing to the outbound messages?
186 $parser->ParseMIMEEntityFromScalar($content);
187 ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
190 $parser->ParseMIMEEntityFromScalar($content);
191 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
197 push @scrips_fired, $scrip;
200 sub utf8_redef_sendmessage {
201 no warnings qw/redefine/;
203 sub RT::Action::SendEmail::SendMessage {
207 my $scrip = $self->ScripObj->id;
208 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
209 main::_fired_scrip($self->ScripObj);
210 $MIME->make_singlepart;
211 main::ok( ref($MIME) eq \'MIME::Entity\',
212 "hey, look. it\'s a mime entity" );
213 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
214 "its mime header is a mime header. yay" );
215 main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/,
216 "Its content type is utf-8" );
217 my $message_as_string = $MIME->bodyhandle->as_string();
219 $message_as_string = Encode::decode_utf8($message_as_string);
221 $message_as_string =~ /H\x{e5}vard/,
222 "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
227 sub iso8859_redef_sendmessage {
228 no warnings qw/redefine/;
230 sub RT::Action::SendEmail::SendMessage {
234 my $scrip = $self->ScripObj->id;
235 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
236 main::_fired_scrip($self->ScripObj);
237 $MIME->make_singlepart;
238 main::ok( ref($MIME) eq \'MIME::Entity\',
239 "hey, look. it\'s a mime entity" );
240 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
241 "its mime header is a mime header. yay" );
242 main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/,
243 "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
244 my $message_as_string = $MIME->bodyhandle->as_string();
246 $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
248 $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
253 # {{{ test a multipart alternative containing a text-html part with an umlaut
255 $content = file_content("$RT::BasePath/lib/t/data/multipart-alternative-with-umlaut");
257 $parser->ParseMIMEEntityFromScalar($content);
260 # be as much like the mail gateway as possible.
261 ¨auts_redef_sendmessage;
263 %args = (message => $content, queue => 1, action => 'correspond');
264 RT::Interface::Email::Gateway(\%args);
265 $tickets = RT::Tickets->new($RT::SystemUser);
266 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
267 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
268 $tick = $tickets->First();
270 ok ($tick->Id, "found ticket ".$tick->Id);
272 ok (first_txn($tick)->Content =~ /causes Error/, "We recorded the content right as text-plain");
273 is (count_attachs($tick) , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
275 sub umlauts_redef_sendmessage {
276 no warnings qw/redefine/;
277 eval 'sub RT::Action::SendEmail::SendMessage { }';
282 # {{{ test a text-html message with an umlaut
284 $content = file_content("$RT::BasePath/lib/t/data/text-html-with-umlaut");
286 $parser->ParseMIMEEntityFromScalar($content);
289 # be as much like the mail gateway as possible.
290 &text_html_umlauts_redef_sendmessage;
292 %args = (message => $content, queue => 1, action => 'correspond');
293 RT::Interface::Email::Gateway(\%args);
294 $tickets = RT::Tickets->new($RT::SystemUser);
295 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
296 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
297 $tick = $tickets->First();
298 ok ($tick->Id, "found ticket ".$tick->Id);
300 ok (first_attach($tick)->Content =~ /causes Error/, "We recorded the content as containing 'causes error'") or diag( first_attach($tick)->Content );
301 ok (first_attach($tick)->ContentType =~ /text\/html/, "We recorded the content as text/html");
302 is (count_attachs($tick), 1 , "Has one attachment, presumably a text-html and a multipart alternative");
304 sub text_html_umlauts_redef_sendmessage {
305 no warnings qw/redefine/;
306 eval 'sub RT::Action::SendEmail::SendMessage {
309 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
310 is ($MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
311 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
312 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
313 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
319 # {{{ test a text-html message with russian characters
321 $content = file_content("$RT::BasePath/lib/t/data/text-html-in-russian");
323 $parser->ParseMIMEEntityFromScalar($content);
326 # be as much like the mail gateway as possible.
327 &text_html_russian_redef_sendmessage;
329 %args = (message => $content, queue => 1, action => 'correspond');
330 RT::Interface::Email::Gateway(\%args);
331 $tickets = RT::Tickets->new($RT::SystemUser);
332 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
333 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
334 $tick = $tickets->First();
335 ok ($tick->Id, "found ticket ".$tick->Id);
337 ok (first_attach($tick)->ContentType =~ /text\/html/, "We recorded the content right as text-html");
338 ok (count_attachs($tick) ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
340 sub text_html_russian_redef_sendmessage {
341 no warnings qw/redefine/;
342 eval 'sub RT::Action::SendEmail::SendMessage {
346 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
347 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
348 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
349 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
350 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
352 $content_1251 = $MIME->parts(1)->bodyhandle->as_string();
353 ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:},
354 "Content matches drugim in codepage 1251" );
360 # {{{ test a message containing a russian subject and NO content type
362 unshift (@RT::EmailInputEncodings, 'koi8-r');
363 $RT::EmailOutputEncoding = 'koi8-r';
364 $content = file_content("$RT::BasePath/lib/t/data/russian-subject-no-content-type");
366 $parser->ParseMIMEEntityFromScalar($content);
369 # be as much like the mail gateway as possible.
370 &text_plain_russian_redef_sendmessage;
371 %args = (message => $content, queue => 1, action => 'correspond');
372 RT::Interface::Email::Gateway(\%args);
373 $tickets = RT::Tickets->new($RT::SystemUser);
374 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
375 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
376 $tick= $tickets->First();
377 ok ($tick->Id, "found ticket ".$tick->Id);
379 ok (first_attach($tick)->ContentType =~ /text\/plain/, "We recorded the content type right");
380 ok (count_attachs($tick) ==1 , "Has one attachment, presumably a text-plain");
381 is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
382 sub text_plain_russian_redef_sendmessage {
383 no warnings qw/redefine/;
384 eval 'sub RT::Action::SendEmail::SendMessage {
387 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
388 is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
389 my $subject = $MIME->head->get("subject");
391 #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
396 shift @RT::EmailInputEncodings;
397 $RT::EmailOutputEncoding = 'utf-8';
401 # {{{ test a message containing a nested RFC 822 message
403 $content = file_content("$RT::BasePath/lib/t/data/nested-rfc-822");
404 ok ($content, "Loaded nested-rfc-822 to test");
406 $parser->ParseMIMEEntityFromScalar($content);
409 # be as much like the mail gateway as possible.
410 &text_plain_nested_redef_sendmessage;
411 %args = (message => $content, queue => 1, action => 'correspond');
412 RT::Interface::Email::Gateway(\%args);
413 $tickets = RT::Tickets->new($RT::SystemUser);
414 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
415 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
416 $tick= $tickets->First();
417 ok ($tick->Id, "found ticket ".$tick->Id);
418 is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
419 ok (first_attach($tick)->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
420 is (count_attachs($tick) , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
421 sub text_plain_nested_redef_sendmessage {
422 no warnings qw/redefine/;
423 eval 'sub RT::Action::SendEmail::SendMessage {
426 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
427 is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
428 my $subject = $MIME->head->get("subject");
429 $subject = MIME::Base64::decode_base64( $subject);
431 # TODO, why does this test fail
432 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
440 # {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
442 $content = file_content("$RT::BasePath/lib/t/data/notes-uuencoded");
444 $parser->ParseMIMEEntityFromScalar($content);
447 # be as much like the mail gateway as possible.
448 ¬es_redef_sendmessage;
450 %args = (message => $content, queue => 1, action => 'correspond');
451 RT::Interface::Email::Gateway(\%args);
452 $tickets = RT::Tickets->new($RT::SystemUser);
453 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
454 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
455 $tick= $tickets->First();
456 ok ($tick->Id, "found ticket ".$tick->Id);
458 ok (first_txn($tick)->Content =~ /from Lotus Notes/, "We recorded the content right");
459 is (count_attachs($tick) , 3 , "Has three attachments");
461 sub notes_redef_sendmessage {
462 no warnings qw/redefine/;
463 eval 'sub RT::Action::SendEmail::SendMessage { }';
468 # {{{ test a multipart that crashes the file-based mime-parser works
470 $content = file_content("$RT::BasePath/lib/t/data/crashes-file-based-parser");
472 $parser->ParseMIMEEntityFromScalar($content);
475 # be as much like the mail gateway as possible.
476 &crashes_redef_sendmessage;
478 %args = (message => $content, queue => 1, action => 'correspond');
479 RT::Interface::Email::Gateway(\%args);
480 $tickets = RT::Tickets->new($RT::SystemUser);
481 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
482 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
483 $tick= $tickets->First();
484 ok ($tick->Id, "found ticket ".$tick->Id);
486 ok (first_txn($tick)->Content =~ /FYI/, "We recorded the content right");
487 is (count_attachs($tick) , 5 , "Has three attachments");
489 sub crashes_redef_sendmessage {
490 no warnings qw/redefine/;
491 eval 'sub RT::Action::SendEmail::SendMessage { }';
498 # {{{ test a multi-line RT-Send-CC header
500 $content = file_content("$RT::BasePath/lib/t/data/rt-send-cc");
502 $parser->ParseMIMEEntityFromScalar($content);
506 %args = (message => $content, queue => 1, action => 'correspond');
507 RT::Interface::Email::Gateway(\%args);
508 $tickets = RT::Tickets->new($RT::SystemUser);
509 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
510 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
511 $tick= $tickets->First();
512 ok ($tick->Id, "found ticket ".$tick->Id);
514 my $cc = first_attach($tick)->GetHeader('RT-Send-Cc');
515 ok ($cc =~ /test1/, "Found test 1");
516 ok ($cc =~ /test2/, "Found test 2");
517 ok ($cc =~ /test3/, "Found test 3");
518 ok ($cc =~ /test4/, "Found test 4");
519 ok ($cc =~ /test5/, "Found test 5");
523 diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
525 my $content = file_content("$RT::BasePath/lib/t/data/subject-with-folding-ws");
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, 'test', 'correct subject');
534 diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE};
536 my $content = file_content("$RT::BasePath/lib/t/data/very-long-subject");
537 my ($status, $msg, $ticket) = RT::Interface::Email::Gateway(
538 { message => $content, queue => 1, action => 'correspond' }
540 ok ($status, 'created ticket') or diag "error: $msg";
541 ok ($ticket->id, "found ticket ". $ticket->id);
542 is ($ticket->Subject, '0123456789'x20, 'correct subject');
547 # Don't taint the environment
548 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');