4 use Test::More 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");
25 no warnings qw/redefine/;
26 sub RT::Action::SendEmail::SendMessage {
30 main::_fired_scrip($self->ScripObj);
31 main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
36 # instrument SendEmail to pass us what it's about to send.
37 # create a regular ticket
39 my $parser = RT::EmailParser->new();
42 # Let's test to make sure a multipart/report is processed correctly
43 my $content = `cat $RT::BasePath/lib/t/data/multipart-report` || die "couldn't find new content";
44 # be as much like the mail gateway as possible.
45 use RT::Interface::Email;
47 my %args = (message => $content, queue => 1, action => 'correspond');
48 RT::Interface::Email::Gateway(\%args);
49 my $tickets = RT::Tickets->new($RT::SystemUser);
50 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
51 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
52 my $tick= $tickets->First();
53 isa_ok($tick, "RT::Ticket", "got a ticket object");
54 ok ($tick->Id, "found ticket ".$tick->Id);
56 ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce");
59 # make sure it fires scrips.
60 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
67 $parser->ParseMIMEEntityFromScalar('From: root@localhost
69 Subject: This is a test of new ticket creation as an unknown user
77 my $ticket = RT::Ticket->new($RT::SystemUser);
78 my ($id, undef, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
80 $tickets = RT::Tickets->new($RT::SystemUser);
81 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
82 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
83 $tick = $tickets->First();
84 ok ($tick->Id, "found ticket ".$tick->Id);
85 ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account");
87 # make sure it fires scrips.
88 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
89 # make sure it sends an autoreply
90 # make sure it sends a notification to adminccs
93 # we need to swap out SendMessage to test the new things we care about;
94 &utf8_redef_sendmessage;
96 # create an iso 8859-1 ticket
99 $content = `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
103 $parser->ParseMIMEEntityFromScalar($content);
106 # be as much like the mail gateway as possible.
107 use RT::Interface::Email;
109 %args = (message => $content, queue => 1, action => 'correspond');
110 RT::Interface::Email::Gateway(\%args);
111 $tickets = RT::Tickets->new($RT::SystemUser);
112 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
113 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
114 $tick = $tickets->First();
115 ok ($tick->Id, "found ticket ".$tick->Id);
117 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
120 # make sure it fires scrips.
121 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
122 # make sure it sends an autoreply
125 # make sure it sends a notification to adminccs
127 # If we correspond, does it do the right thing to the outbound messages?
129 $parser->ParseMIMEEntityFromScalar($content);
130 ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
133 $parser->ParseMIMEEntityFromScalar($content);
134 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
141 # we need to swap out SendMessage to test the new things we care about;
142 &iso8859_redef_sendmessage;
143 $RT::EmailOutputEncoding = 'iso-8859-1';
144 # create an iso 8859-1 ticket
147 $content = `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
148 # be as much like the mail gateway as possible.
149 use RT::Interface::Email;
151 %args = (message => $content, queue => 1, action => 'correspond');
152 RT::Interface::Email::Gateway(\%args);
153 $tickets = RT::Tickets->new($RT::SystemUser);
154 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
155 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
156 $tick = $tickets->First();
157 ok ($tick->Id, "found ticket ".$tick->Id);
159 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
162 # make sure it fires scrips.
163 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
164 # make sure it sends an autoreply
167 # make sure it sends a notification to adminccs
170 # If we correspond, does it do the right thing to the outbound messages?
172 $parser->ParseMIMEEntityFromScalar($content);
173 ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
176 $parser->ParseMIMEEntityFromScalar($content);
177 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
183 push @scrips_fired, $scrip;
186 sub utf8_redef_sendmessage {
187 no warnings qw/redefine/;
189 sub RT::Action::SendEmail::SendMessage {
193 my $scrip = $self->ScripObj->id;
194 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
195 main::_fired_scrip($self->ScripObj);
196 $MIME->make_singlepart;
197 main::ok( ref($MIME) eq \'MIME::Entity\',
198 "hey, look. it\'s a mime entity" );
199 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
200 "its mime header is a mime header. yay" );
201 main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/,
202 "Its content type is utf-8" );
203 my $message_as_string = $MIME->bodyhandle->as_string();
205 $message_as_string = Encode::decode_utf8($message_as_string);
207 $message_as_string =~ /H\x{e5}vard/,
208 "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
213 sub iso8859_redef_sendmessage {
214 no warnings qw/redefine/;
216 sub RT::Action::SendEmail::SendMessage {
220 my $scrip = $self->ScripObj->id;
221 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
222 main::_fired_scrip($self->ScripObj);
223 $MIME->make_singlepart;
224 main::ok( ref($MIME) eq \'MIME::Entity\',
225 "hey, look. it\'s a mime entity" );
226 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
227 "its mime header is a mime header. yay" );
228 main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/,
229 "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
230 my $message_as_string = $MIME->bodyhandle->as_string();
232 $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
234 $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
239 # {{{ test a multipart alternative containing a text-html part with an umlaut
241 $content = `cat $RT::BasePath/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
243 $parser->ParseMIMEEntityFromScalar($content);
246 # be as much like the mail gateway as possible.
247 ¨auts_redef_sendmessage;
249 %args = (message => $content, queue => 1, action => 'correspond');
250 RT::Interface::Email::Gateway(\%args);
251 $tickets = RT::Tickets->new($RT::SystemUser);
252 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
253 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
254 $tick = $tickets->First();
255 ok ($tick->Id, "found ticket ".$tick->Id);
257 ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain");
258 is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
260 sub umlauts_redef_sendmessage {
261 no warnings qw/redefine/;
262 eval 'sub RT::Action::SendEmail::SendMessage { }';
267 # {{{ test a text-html message with an umlaut
269 $content = `cat $RT::BasePath/lib/t/data/text-html-with-umlaut` || die "couldn't find new content";
271 $parser->ParseMIMEEntityFromScalar($content);
274 # be as much like the mail gateway as possible.
275 &text_html_umlauts_redef_sendmessage;
277 %args = (message => $content, queue => 1, action => 'correspond');
278 RT::Interface::Email::Gateway(\%args);
279 $tickets = RT::Tickets->new($RT::SystemUser);
280 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
281 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
282 $tick = $tickets->First();
283 ok ($tick->Id, "found ticket ".$tick->Id);
285 ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'");
286 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html");
287 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
289 sub text_html_umlauts_redef_sendmessage {
290 no warnings qw/redefine/;
291 eval 'sub RT::Action::SendEmail::SendMessage {
295 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
296 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
297 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
298 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
299 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
305 # {{{ test a text-html message with russian characters
307 $content = `cat $RT::BasePath/lib/t/data/text-html-in-russian` || die "couldn't find new content";
309 $parser->ParseMIMEEntityFromScalar($content);
312 # be as much like the mail gateway as possible.
313 &text_html_russian_redef_sendmessage;
315 %args = (message => $content, queue => 1, action => 'correspond');
316 RT::Interface::Email::Gateway(\%args);
317 $tickets = RT::Tickets->new($RT::SystemUser);
318 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
319 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
320 $tick = $tickets->First();
321 ok ($tick->Id, "found ticket ".$tick->Id);
323 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html");
324 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
326 sub text_html_russian_redef_sendmessage {
327 no warnings qw/redefine/;
328 eval 'sub RT::Action::SendEmail::SendMessage {
332 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
333 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
334 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
335 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
336 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
338 $content_1251 = $MIME->parts(1)->bodyhandle->as_string();
339 ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:},
340 "Content matches drugim in codepage 1251" );
346 # {{{ test a message containing a russian subject and NO content type
348 unshift (@RT::EmailInputEncodings, 'koi8-r');
349 $RT::EmailOutputEncoding = 'koi8-r';
350 $content = `cat $RT::BasePath/lib/t/data/russian-subject-no-content-type` || die "couldn't find new content";
352 $parser->ParseMIMEEntityFromScalar($content);
355 # be as much like the mail gateway as possible.
356 &text_plain_russian_redef_sendmessage;
357 %args = (message => $content, queue => 1, action => 'correspond');
358 RT::Interface::Email::Gateway(\%args);
359 $tickets = RT::Tickets->new($RT::SystemUser);
360 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
361 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
362 $tick= $tickets->First();
363 ok ($tick->Id, "found ticket ".$tick->Id);
365 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right");
366 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain");
367 is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
368 sub text_plain_russian_redef_sendmessage {
369 no warnings qw/redefine/;
370 eval 'sub RT::Action::SendEmail::SendMessage {
373 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
374 is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
375 my $subject = $MIME->head->get("subject");
377 #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
382 shift @RT::EmailInputEncodings;
383 $RT::EmailOutputEncoding = 'utf-8';
387 # {{{ test a message containing a nested RFC 822 message
389 $content = `cat $RT::BasePath/lib/t/data/nested-rfc-822` || die "couldn't find new content";
390 ok ($content, "Loaded nested-rfc-822 to test");
392 $parser->ParseMIMEEntityFromScalar($content);
395 # be as much like the mail gateway as possible.
396 &text_plain_nested_redef_sendmessage;
397 %args = (message => $content, queue => 1, action => 'correspond');
398 RT::Interface::Email::Gateway(\%args);
399 $tickets = RT::Tickets->new($RT::SystemUser);
400 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
401 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
402 $tick= $tickets->First();
403 ok ($tick->Id, "found ticket ".$tick->Id);
404 is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
405 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
406 is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
407 sub text_plain_nested_redef_sendmessage {
408 no warnings qw/redefine/;
409 eval 'sub RT::Action::SendEmail::SendMessage {
412 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
413 is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
414 my $subject = $MIME->head->get("subject");
415 $subject = MIME::Base64::decode_base64( $subject);
417 # TODO, why does this test fail
418 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
426 # {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
428 $content = `cat $RT::BasePath/lib/t/data/notes-uuencoded` || die "couldn't find new content";
430 $parser->ParseMIMEEntityFromScalar($content);
433 # be as much like the mail gateway as possible.
434 ¬es_redef_sendmessage;
436 %args = (message => $content, queue => 1, action => 'correspond');
437 RT::Interface::Email::Gateway(\%args);
438 $tickets = RT::Tickets->new($RT::SystemUser);
439 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
440 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
441 $tick= $tickets->First();
442 ok ($tick->Id, "found ticket ".$tick->Id);
444 ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right");
445 is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments");
447 sub notes_redef_sendmessage {
448 no warnings qw/redefine/;
449 eval 'sub RT::Action::SendEmail::SendMessage { }';
454 # {{{ test a multipart that crashes the file-based mime-parser works
456 $content = `cat $RT::BasePath/lib/t/data/crashes-file-based-parser` || die "couldn't find new content";
458 $parser->ParseMIMEEntityFromScalar($content);
461 # be as much like the mail gateway as possible.
462 &crashes_redef_sendmessage;
464 %args = (message => $content, queue => 1, action => 'correspond');
465 RT::Interface::Email::Gateway(\%args);
466 $tickets = RT::Tickets->new($RT::SystemUser);
467 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
468 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
469 $tick= $tickets->First();
470 ok ($tick->Id, "found ticket ".$tick->Id);
472 ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right");
473 is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments");
475 sub crashes_redef_sendmessage {
476 no warnings qw/redefine/;
477 eval 'sub RT::Action::SendEmail::SendMessage { }';
484 # {{{ test a multi-line RT-Send-CC header
486 $content = `cat $RT::BasePath/lib/t/data/rt-send-cc` || die "couldn't find new content";
488 $parser->ParseMIMEEntityFromScalar($content);
492 %args = (message => $content, queue => 1, action => 'correspond');
493 RT::Interface::Email::Gateway(\%args);
494 $tickets = RT::Tickets->new($RT::SystemUser);
495 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
496 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
497 $tick= $tickets->First();
498 ok ($tick->Id, "found ticket ".$tick->Id);
500 my $cc = $tick->Transactions->First->Attachments->First->GetHeader('RT-Send-Cc');
501 ok ($cc =~ /test1/, "Found test 1");
502 ok ($cc =~ /test2/, "Found test 2");
503 ok ($cc =~ /test3/, "Found test 3");
504 ok ($cc =~ /test4/, "Found test 4");
505 ok ($cc =~ /test5/, "Found test 5");
509 # Don't taint the environment
510 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');