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();
36 $parser->ParseMIMEEntityFromScalar('From: root@localhost
38 Subject: This is a test of new ticket creation as an unknown user
46 my $ticket = RT::Ticket->new($RT::SystemUser);
47 my ($id, $tid, $msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity);
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 ok ($tick->Id, "found ticket ".$tick->Id);
54 ok ($tick->Subject eq 'I18NTest', "failed to create the new ticket from an unprivileged account");
56 # make sure it fires scrips.
57 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
58 # make sure it sends an autoreply
59 # make sure it sends a notification to adminccs
62 # we need to swap out SendMessage to test the new things we care about;
63 &utf8_redef_sendmessage;
65 # create an iso 8859-1 ticket
68 my $content = `cat ./lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
72 $parser->ParseMIMEEntityFromScalar($content);
75 # be as much like the mail gateway as possible.
76 use RT::Interface::Email;
78 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
79 my $tickets = RT::Tickets->new($RT::SystemUser);
80 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
81 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
82 my $tick = $tickets->First();
83 ok ($tick->Id, "found ticket ".$tick->Id);
85 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
88 # make sure it fires scrips.
89 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
90 # make sure it sends an autoreply
93 # make sure it sends a notification to adminccs
95 # If we correspond, does it do the right thing to the outbound messages?
97 $parser->ParseMIMEEntityFromScalar($content);
98 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
101 $parser->ParseMIMEEntityFromScalar($content);
102 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
106 # we need to swap out SendMessage to test the new things we care about;
107 &iso8859_redef_sendmessage;
108 $RT::EmailOutputEncoding = 'iso-8859-1';
109 # create an iso 8859-1 ticket
112 my $content = `cat ./lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
113 # be as much like the mail gateway as possible.
114 use RT::Interface::Email;
116 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
117 my $tickets = RT::Tickets->new($RT::SystemUser);
118 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
119 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
120 my $tick = $tickets->First();
121 ok ($tick->Id, "found ticket ".$tick->Id);
123 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
126 # make sure it fires scrips.
127 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
128 # make sure it sends an autoreply
131 # 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 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
140 $parser->ParseMIMEEntityFromScalar($content);
141 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
147 push @scrips_fired, $scrip;
150 sub utf8_redef_sendmessage {
151 no warnings qw/redefine/;
153 sub RT::Action::SendEmail::SendMessage {
157 my $scrip = $self->ScripObj->id;
158 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
159 main::_fired_scrip($self->ScripObj);
160 $MIME->make_singlepart;
161 main::ok( ref($MIME) eq \'MIME::Entity\',
162 "hey, look. it\'s a mime entity" );
163 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
164 "its mime header is a mime header. yay" );
165 main::ok( $MIME->head->get(\'Content-Type\') =~ /utf-8/,
166 "Its content type is utf-8" );
167 my $message_as_string = $MIME->bodyhandle->as_string();
169 $message_as_string = Encode::decode_utf8($message_as_string);
171 $message_as_string =~ /H\x{e5}vard/,
172 "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
177 sub iso8859_redef_sendmessage {
178 no warnings qw/redefine/;
180 sub RT::Action::SendEmail::SendMessage {
184 my $scrip = $self->ScripObj->id;
185 ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name);
186 main::_fired_scrip($self->ScripObj);
187 $MIME->make_singlepart;
188 main::ok( ref($MIME) eq \'MIME::Entity\',
189 "hey, look. it\'s a mime entity" );
190 main::ok( ref( $MIME->head ) eq \'MIME::Head\',
191 "its mime header is a mime header. yay" );
192 main::ok( $MIME->head->get(\'Content-Type\') =~ /iso-8859-1/,
193 "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") );
194 my $message_as_string = $MIME->bodyhandle->as_string();
196 $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
198 $message_as_string =~ /H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out");
203 # {{{ test a multipart alternative containing a text-html part with an umlaut
205 my $content = `cat ./lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
207 $parser->ParseMIMEEntityFromScalar($content);
210 # be as much like the mail gateway as possible.
211 ¨auts_redef_sendmessage;
213 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
214 my $tickets = RT::Tickets->new($RT::SystemUser);
215 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
216 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
217 my $tick = $tickets->First();
218 ok ($tick->Id, "found ticket ".$tick->Id);
220 ok ($tick->Transactions->First->Content =~ /causes Error/, "We recorded the content right as text-plain");
221 is ($tick->Transactions->First->Attachments->Count , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative");
223 sub umlauts_redef_sendmessage {
224 no warnings qw/redefine/;
225 eval 'sub RT::Action::SendEmail::SendMessage { }';
230 # {{{ test a text-html message with an umlaut
232 my $content = `cat ./lib/t/data/text-html-with-umlaut` || die "couldn't find new content";
234 $parser->ParseMIMEEntityFromScalar($content);
237 # be as much like the mail gateway as possible.
238 &text_html_umlauts_redef_sendmessage;
240 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
241 my $tickets = RT::Tickets->new($RT::SystemUser);
242 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
243 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
244 my $tick = $tickets->First();
245 ok ($tick->Id, "found ticket ".$tick->Id);
247 ok ($tick->Transactions->First->Attachments->First->Content =~ /causes Error/, "We recorded the content as containing 'causes error'");
248 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content as text/html");
249 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
251 sub text_html_umlauts_redef_sendmessage {
252 no warnings qw/redefine/;
253 eval 'sub RT::Action::SendEmail::SendMessage {
257 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
258 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
259 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
260 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
261 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
267 # {{{ test a text-html message with russian characters
269 my $content = `cat ./lib/t/data/text-html-in-russian` || die "couldn't find new content";
271 $parser->ParseMIMEEntityFromScalar($content);
274 # be as much like the mail gateway as possible.
275 &text_html_russian_redef_sendmessage;
277 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
278 my $tickets = RT::Tickets->new($RT::SystemUser);
279 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
280 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
281 my $tick = $tickets->First();
282 ok ($tick->Id, "found ticket ".$tick->Id);
284 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/html/, "We recorded the content right as text-html");
285 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-html and a multipart alternative");
287 sub text_html_russian_redef_sendmessage {
288 no warnings qw/redefine/;
289 eval 'sub RT::Action::SendEmail::SendMessage {
293 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
294 ok (is $MIME->parts, 2, "generated correspondence mime entityis composed of three parts");
295 is ($MIME->head->mime_type , "multipart/mixed", "The first part is a multipart mixed". $MIME->head->mime_type);
296 is ($MIME->parts(0)->head->mime_type , "text/plain", "The second part is a plain");
297 is ($MIME->parts(1)->head->mime_type , "text/html", "The third part is an html ");
299 $content_1251 = $MIME->parts(1)->bodyhandle->as_string();
300 ok ($content_1251 =~ qr{Ó÷eáíûé Öeíòp "ÊÀÄÐÛ ÄÅËÎÂÎÃÎ ÌÈÐÀ" ïpèãëaøaeò ía òpeíèíã:},
301 "Content matches drugim in codepage 1251" );
307 # {{{ test a message containing a russian subject and NO content type
309 unshift (@RT::EmailInputEncodings, 'koi8-r');
310 $RT::EmailOutputEncoding = 'koi8-r';
311 my $content = `cat ./lib/t/data/russian-subject-no-content-type` || die "couldn't find new content";
313 $parser->ParseMIMEEntityFromScalar($content);
316 # be as much like the mail gateway as possible.
317 &text_plain_russian_redef_sendmessage;
318 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
319 my $tickets = RT::Tickets->new($RT::SystemUser);
320 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
321 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
322 my $tick = $tickets->First();
323 ok ($tick->Id, "found ticket ".$tick->Id);
325 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /text\/plain/, "We recorded the content type right");
326 ok ($tick->Transactions->First->Attachments->Count ==1 , "Has one attachment, presumably a text-plain");
327 is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right");
328 sub text_plain_russian_redef_sendmessage {
329 no warnings qw/redefine/;
330 eval 'sub RT::Action::SendEmail::SendMessage {
333 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
334 is ($MIME->head->mime_type , "text/plain", "The only part is text/plain ");
335 my $subject = $MIME->head->get("subject");
337 #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
342 shift @RT::EmailInputEncodings;
343 $RT::EmailOutputEncoding = 'utf-8';
347 # {{{ test a message containing a nested RFC 822 message
349 my $content = `cat ./lib/t/data/nested-rfc-822` || die "couldn't find new content";
350 ok ($content, "Loaded nested-rfc-822 to test");
352 $parser->ParseMIMEEntityFromScalar($content);
355 # be as much like the mail gateway as possible.
356 &text_plain_nested_redef_sendmessage;
357 RT::Interface::Email::Gateway(message => $content, queue => 1, action => 'correspond');
358 my $tickets = RT::Tickets->new($RT::SystemUser);
359 $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC');
360 $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0');
361 my $tick = $tickets->First();
362 ok ($tick->Id, "found ticket ".$tick->Id);
363 is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?");
364 ok ($tick->Transactions->First->Attachments->First->ContentType =~ /multipart\/mixed/, "We recorded the content type right");
365 is ($tick->Transactions->First->Attachments->Count , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain");
366 sub text_plain_nested_redef_sendmessage {
367 no warnings qw/redefine/;
368 eval 'sub RT::Action::SendEmail::SendMessage {
371 return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" );
372 is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart");
373 my $subject = $MIME->head->get("subject");
374 $subject = MIME::Base64::decode_base64( $subject);
376 # TODO, why does this test fail
377 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
387 # Don't taint the environment
388 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');