6 use RT::Action::SendEmail;
8 my @_outgoing_messages;
11 #We're not testing acls here.
12 my $everyone = RT::Group->new($RT::SystemUser);
13 $everyone->LoadSystemInternalGroup('Everyone');
14 $everyone->PrincipalObj->GrantRight(Right =>'SuperUser');
17 is (__PACKAGE__, 'main', "We're operating in the main package");
21 no warnings qw/redefine/;
22 sub RT::Action::SendEmail::SendMessage {
26 main::_fired_scrip($self->ScripObj);
27 main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
32 # instrument SendEmail to pass us what it's about to send.
33 # create a regular ticket
35 my $parser = RT::EmailParser->new();
38 # Let's test to make sure a multipart/report is processed correctly
39 my $content = `cat /opt/rt3/lib/t/data/multipart-report` || die "couldn't find new content";
40 # be as much like the mail gateway as possible.
41 use RT::Interface::Email;
43 my %args = (message => $content, queue => 1, action => 'correspond');
44 RT::Interface::Email::Gateway(\%args);
45 my $tickets = RT::Tickets->new($RT::SystemUser);
46 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
47 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
48 my $tick = $tickets->First();
49 ok ($tick->Id, "found ticket ".$tick->Id);
51 ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce");
54 # make sure it fires scrips.
55 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
62 $parser->ParseMIMEEntityFromScalar('From: root@localhost
64 Subject: This is a test of new ticket creation as an unknown user
72 my $ticket = RT::Ticket->new($RT::SystemUser);
73 my ($id, $tid, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
75 my $tickets = RT::Tickets->new($RT::SystemUser);
76 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
77 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
78 my $tick = $tickets->First();
79 ok ($tick->Id, "found ticket ".$tick->Id);
80 ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account");
82 # make sure it fires scrips.
83 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
84 # make sure it sends an autoreply
85 # make sure it sends a notification to adminccs
88 # we need to swap out SendMessage to test the new things we care about;
89 &utf8_redef_sendmessage;
91 # create an iso 8859-1 ticket
94 my $content = `cat /opt/rt3/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
98 $parser->ParseMIMEEntityFromScalar($content);
101 # be as much like the mail gateway as possible.
102 use RT::Interface::Email;
104 my %args = (message => $content, queue => 1, action => 'correspond');
105 RT::Interface::Email::Gateway(\%args);
106 my $tickets = RT::Tickets->new($RT::SystemUser);
107 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
108 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
109 my $tick = $tickets->First();
110 ok ($tick->Id, "found ticket ".$tick->Id);
112 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
115 # make sure it fires scrips.
116 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
117 # make sure it sends an autoreply
120 # make sure it sends a notification to adminccs
122 # If we correspond, does it do the right thing to the outbound messages?
124 $parser->ParseMIMEEntityFromScalar($content);
125 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
128 $parser->ParseMIMEEntityFromScalar($content);
129 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
136 # we need to swap out SendMessage to test the new things we care about;
137 &iso8859_redef_sendmessage;
138 $RT::EmailOutputEncoding = 'iso-8859-1';
139 # create an iso 8859-1 ticket
142 my $content = `cat /opt/rt3/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
143 # be as much like the mail gateway as possible.
144 use RT::Interface::Email;
146 my %args = (message => $content, queue => 1, action => 'correspond');
147 RT::Interface::Email::Gateway(\%args);
148 my $tickets = RT::Tickets->new($RT::SystemUser);
149 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
150 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
151 my $tick = $tickets->First();
152 ok ($tick->Id, "found ticket ".$tick->Id);
154 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
157 # make sure it fires scrips.
158 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
159 # make sure it sends an autoreply
162 # make sure it sends a notification to adminccs
165 # If we correspond, does it do the right thing to the outbound messages?
167 $parser->ParseMIMEEntityFromScalar($content);
168 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
171 $parser->ParseMIMEEntityFromScalar($content);
172 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
178 push @scrips_fired, $scrip;
181 sub utf8_redef_sendmessage {
182 no warnings qw/redefine/;
184 sub RT::Action::SendEmail::SendMessage {
188 my $scrip = $self->ScripObj->id;
189 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
190 main::_fired_scrip($self->ScripObj);
191 $MIME->make_singlepart;
192 main::ok( ref($MIME) eq \'MIME::Entity\',
193 "hey, look. it\'s a mime entity" );
194 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
195 "its mime header is a mime header. yay" );
196 main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/,
197 "Its content type is utf-8" );
198 my $message_as_string = $MIME->bodyhandle->as_string();
200 $message_as_string = Encode::decode_utf8($message_as_string);
202 $message_as_string =~ /H\x{e5}vard/,
203 "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
208 sub iso8859_redef_sendmessage {
209 no warnings qw/redefine/;
211 sub RT::Action::SendEmail::SendMessage {
215 my $scrip = $self->ScripObj->id;
216 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
217 main::_fired_scrip($self->ScripObj);
218 $MIME->make_singlepart;
219 main::ok( ref($MIME) eq \'MIME::Entity\',
220 "hey, look. it\'s a mime entity" );
221 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
222 "its mime header is a mime header. yay" );
223 main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/,
224 "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
225 my $message_as_string = $MIME->bodyhandle->as_string();
227 $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
229 $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
234 # {{{ test a multipart alternative containing a text-html part with an umlaut
236 my $content = `cat /opt/rt3/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
238 $parser->ParseMIMEEntityFromScalar($content);
241 # be as much like the mail gateway as possible.
242 ¨auts_redef_sendmessage;
244 my %args = (message => $content, queue => 1, action => 'correspond');
245 RT::Interface::Email::Gateway(\%args);
246 my $tickets = RT::Tickets->new($RT::SystemUser);
247 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
248 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
249 my $tick = $tickets->First();
250 ok ($tick->Id, "found ticket ".$tick->Id);
252 ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain");
253 is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
255 sub umlauts_redef_sendmessage {
256 no warnings qw/redefine/;
257 eval 'sub RT::Action::SendEmail::SendMessage { }';
262 # {{{ test a text-html message with an umlaut
264 my $content = `cat /opt/rt3/lib/t/data/text-html-with-umlaut` || die "couldn't find new content";
266 $parser->ParseMIMEEntityFromScalar($content);
269 # be as much like the mail gateway as possible.
270 &text_html_umlauts_redef_sendmessage;
272 my %args = (message => $content, queue => 1, action => 'correspond');
273 RT::Interface::Email::Gateway(\%args);
274 my $tickets = RT::Tickets->new($RT::SystemUser);
275 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
276 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
277 my $tick = $tickets->First();
278 ok ($tick->Id, "found ticket ".$tick->Id);
280 ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'");
281 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html");
282 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
284 sub text_html_umlauts_redef_sendmessage {
285 no warnings qw/redefine/;
286 eval 'sub RT::Action::SendEmail::SendMessage {
290 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
291 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
292 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
293 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
294 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
300 # {{{ test a text-html message with russian characters
302 my $content = `cat /opt/rt3/lib/t/data/text-html-in-russian` || die "couldn't find new content";
304 $parser->ParseMIMEEntityFromScalar($content);
307 # be as much like the mail gateway as possible.
308 &text_html_russian_redef_sendmessage;
310 my %args = (message => $content, queue => 1, action => 'correspond');
311 RT::Interface::Email::Gateway(\%args);
312 my $tickets = RT::Tickets->new($RT::SystemUser);
313 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
314 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
315 my $tick = $tickets->First();
316 ok ($tick->Id, "found ticket ".$tick->Id);
318 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html");
319 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
321 sub text_html_russian_redef_sendmessage {
322 no warnings qw/redefine/;
323 eval 'sub RT::Action::SendEmail::SendMessage {
327 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
328 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
329 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
330 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
331 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
333 $content_1251 = $MIME->parts(1)->bodyhandle->as_string();
334 ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:},
335 "Content matches drugim in codepage 1251" );
341 # {{{ test a message containing a russian subject and NO content type
343 unshift (@RT::EmailInputEncodings, 'koi8-r');
344 $RT::EmailOutputEncoding = 'koi8-r';
345 my $content = `cat /opt/rt3/lib/t/data/russian-subject-no-content-type` || die "couldn't find new content";
347 $parser->ParseMIMEEntityFromScalar($content);
350 # be as much like the mail gateway as possible.
351 &text_plain_russian_redef_sendmessage;
352 my %args = (message => $content, queue => 1, action => 'correspond');
353 RT::Interface::Email::Gateway(\%args);
354 my $tickets = RT::Tickets->new($RT::SystemUser);
355 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
356 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
357 my $tick = $tickets->First();
358 ok ($tick->Id, "found ticket ".$tick->Id);
360 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right");
361 ok ($tick->Transactions->First->Attachments->Count ==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 shift @RT::EmailInputEncodings;
378 $RT::EmailOutputEncoding = 'utf-8';
382 # {{{ test a message containing a nested RFC 822 message
384 my $content = `cat /opt/rt3/lib/t/data/nested-rfc-822` || die "couldn't find new content";
385 ok ($content, "Loaded nested-rfc-822 to test");
387 $parser->ParseMIMEEntityFromScalar($content);
390 # be as much like the mail gateway as possible.
391 &text_plain_nested_redef_sendmessage;
392 my %args = (message => $content, queue => 1, action => 'correspond');
393 RT::Interface::Email::Gateway(\%args);
394 my $tickets = RT::Tickets->new($RT::SystemUser);
395 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
396 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
397 my $tick = $tickets->First();
398 ok ($tick->Id, "found ticket ".$tick->Id);
399 is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
400 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
401 is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
402 sub text_plain_nested_redef_sendmessage {
403 no warnings qw/redefine/;
404 eval 'sub RT::Action::SendEmail::SendMessage {
407 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
408 is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
409 my $subject = $MIME->head->get("subject");
410 $subject = MIME::Base64::decode_base64( $subject);
412 # TODO, why does this test fail
413 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
421 # {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
423 my $content = `cat /opt/rt3/lib/t/data/notes-uuencoded` || die "couldn't find new content";
425 $parser->ParseMIMEEntityFromScalar($content);
428 # be as much like the mail gateway as possible.
429 ¬es_redef_sendmessage;
431 my %args = (message => $content, queue => 1, action => 'correspond');
432 RT::Interface::Email::Gateway(\%args);
433 my $tickets = RT::Tickets->new($RT::SystemUser);
434 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
435 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
436 my $tick = $tickets->First();
437 ok ($tick->Id, "found ticket ".$tick->Id);
439 ok ($tick->Transactions->First->Content =~ /from Lotus Notes/, "We recorded the content right");
440 is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments");
442 sub notes_redef_sendmessage {
443 no warnings qw/redefine/;
444 eval 'sub RT::Action::SendEmail::SendMessage { }';
449 # {{{ test a multipart that crashes the file-based mime-parser works
451 my $content = `cat /opt/rt3/lib/t/data/crashes-file-based-parser` || die "couldn't find new content";
453 $parser->ParseMIMEEntityFromScalar($content);
456 # be as much like the mail gateway as possible.
457 &crashes_redef_sendmessage;
459 my %args = (message => $content, queue => 1, action => 'correspond');
460 RT::Interface::Email::Gateway(\%args);
461 my $tickets = RT::Tickets->new($RT::SystemUser);
462 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
463 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
464 my $tick = $tickets->First();
465 ok ($tick->Id, "found ticket ".$tick->Id);
467 ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right");
468 is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments");
470 sub crashes_redef_sendmessage {
471 no warnings qw/redefine/;
472 eval 'sub RT::Action::SendEmail::SendMessage { }';
479 # {{{ test a multi-line RT-Send-CC header
481 my $content = `cat /opt/rt3/lib/t/data/rt-send-cc` || die "couldn't find new content";
483 $parser->ParseMIMEEntityFromScalar($content);
487 my %args = (message => $content, queue => 1, action => 'correspond');
488 RT::Interface::Email::Gateway(\%args);
489 my $tickets = RT::Tickets->new($RT::SystemUser);
490 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
491 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
492 my $tick = $tickets->First();
493 ok ($tick->Id, "found ticket ".$tick->Id);
495 my $cc = $tick->Transactions->First->Attachments->First->GetHeader('RT-Send-Cc');
496 ok ($cc =~ /test1/, "Found test 1");
497 ok ($cc =~ /test2/, "Found test 2");
498 ok ($cc =~ /test3/, "Found test 3");
499 ok ($cc =~ /test4/, "Found test 4");
500 ok ($cc =~ /test5/, "Found test 5");
504 # Don't taint the environment
505 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');