rt/lib/t/04_send_email.pl.in

   1 #!@PERL@ -w
   2
   3 use strict;
   4 use RT::EmailParser;
   5 use RT::Tickets;
   6 use RT::Action::SendEmail;
   7
   8 my @_outgoing_messages;
   9 my @scrips_fired;
  10
  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');
  15
  16
  17 is (__PACKAGE__, 'main', "We're operating in the main package");
  18
  19
  20 {
  21 no warnings qw/redefine/;
  22 sub RT::Action::SendEmail::SendMessage {
  23         my $self = shift;
  24         my $MIME = shift;
  25
  26         main::_fired_scrip($self->ScripObj);
  27         main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
  28 }
  29
  30 }
  31
  32 # instrument SendEmail to pass us what it's about to send.
  33 # create a regular ticket
  34
  35 my $parser = RT::EmailParser->new();
  36 $parser->ParseMIMEEntityFromScalar('From: root@localhost
  37 To: rt@example.com
  38 Subject: This is a test of new ticket creation as an unknown user
  39
  40 Blah!
  41 Foob!');
  42
  43
  44 use Data::Dumper;
  45
  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);
  48 ok ($id,$msg);
  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");
  55
  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
  60
  61
  62 # we need to swap out SendMessage to test the new things we care about;
  63 &utf8_redef_sendmessage;
  64
  65 # create an iso 8859-1 ticket
  66 @scrips_fired = ();
  67
  68 my $content =  `cat ./lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
  69
  70
  71
  72 $parser->ParseMIMEEntityFromScalar($content);
  73
  74
  75 # be as much like the mail gateway as possible.
  76 use RT::Interface::Email;
  77
  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);
  84
  85 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
  86
  87
  88 # make sure it fires scrips.
  89 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
  90 # make sure it sends an autoreply
  91
  92
  93 # make sure it sends a notification to adminccs
  94
  95 # If we correspond, does it do the right thing to the outbound messages?
  96
  97 $parser->ParseMIMEEntityFromScalar($content);
  98 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
  99 ok ($id, $msg);
 100
 101 $parser->ParseMIMEEntityFromScalar($content);
 102 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
 103 ok ($id, $msg);
 104
 105
 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
 110 @scrips_fired = ();
 111
 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;
 115
 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);
 122
 123 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
 124
 125
 126 # make sure it fires scrips.
 127 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
 128 # make sure it sends an autoreply
 129
 130
 131 # make sure it sends a notification to adminccs
 132
 133
 134 # If we correspond, does it do the right thing to the outbound messages?
 135
 136 $parser->ParseMIMEEntityFromScalar($content);
 137 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
 138 ok ($id, $msg);
 139
 140 $parser->ParseMIMEEntityFromScalar($content);
 141 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
 142 ok ($id, $msg);
 143
 144
 145 sub _fired_scrip {
 146         my $scrip = shift;
 147         push @scrips_fired, $scrip;
 148 }
 149
 150 sub utf8_redef_sendmessage {
 151     no warnings qw/redefine/;
 152     eval '
 153     sub RT::Action::SendEmail::SendMessage {
 154         my $self = shift;
 155         my $MIME = shift;
 156
 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();
 168         use Encode;
 169         $message_as_string = Encode::decode_utf8($message_as_string);
 170         main::ok(
 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");
 173
 174     }';
 175 }
 176
 177 sub iso8859_redef_sendmessage {
 178     no warnings qw/redefine/;
 179     eval '
 180     sub RT::Action::SendEmail::SendMessage {
 181         my $self = shift;
 182         my $MIME = shift;
 183
 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();
 195         use Encode;
 196         $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
 197         main::ok(
 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");
 199
 200     }';
 201 }
 202
 203 # {{{ test a multipart alternative containing a text-html part with an umlaut
 204
 205 my $content =  `cat ./lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
 206
 207 $parser->ParseMIMEEntityFromScalar($content);
 208
 209
 210 # be as much like the mail gateway as possible.
 211 &umlauts_redef_sendmessage;
 212
 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);
 219
 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");
 222
 223 sub umlauts_redef_sendmessage {
 224     no warnings qw/redefine/;
 225     eval 'sub RT::Action::SendEmail::SendMessage { }';
 226 }
 227
 228 # }}}
 229
 230 # {{{ test a text-html message with an umlaut
 231
 232 my $content =  `cat ./lib/t/data/text-html-with-umlaut` || die "couldn't find new content";
 233
 234 $parser->ParseMIMEEntityFromScalar($content);
 235
 236
 237 # be as much like the mail gateway as possible.
 238 &text_html_umlauts_redef_sendmessage;
 239
 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);
 246
 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");
 250
 251 sub text_html_umlauts_redef_sendmessage {
 252     no warnings qw/redefine/;
 253     eval 'sub RT::Action::SendEmail::SendMessage {
 254                 my $self = shift;
 255                 my $MIME = shift;
 256                 use Data::Dumper;
 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 ");
 262                  }';
 263 }
 264
 265 # }}}
 266
 267 # {{{ test a text-html message with russian characters
 268
 269 my $content =  `cat ./lib/t/data/text-html-in-russian` || die "couldn't find new content";
 270
 271 $parser->ParseMIMEEntityFromScalar($content);
 272
 273
 274 # be as much like the mail gateway as possible.
 275 &text_html_russian_redef_sendmessage;
 276
 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);
 283
 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");
 286
 287 sub text_html_russian_redef_sendmessage {
 288     no warnings qw/redefine/;
 289     eval 'sub RT::Action::SendEmail::SendMessage {
 290                 my $self = shift;
 291                 my $MIME = shift;
 292                 use Data::Dumper;
 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 ");
 298                 my $content_1251;
 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" );
 302                  }';
 303 }
 304
 305 # }}}
 306
 307 # {{{ test a message containing a russian subject and NO content type
 308
 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";
 312
 313 $parser->ParseMIMEEntityFromScalar($content);
 314
 315
 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);
 324
 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 {
 331                 my $self = shift;
 332                 my $MIME = shift;
 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");
 336                 chomp($subject);
 337                 #is( $subject ,      /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
 338                 };
 339                  ';
 340 }
 341
 342 shift @RT::EmailInputEncodings;
 343 $RT::EmailOutputEncoding = 'utf-8';
 344 # }}}
 345
 346
 347 # {{{ test a message containing a nested RFC 822 message
 348
 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");
 351
 352 $parser->ParseMIMEEntityFromScalar($content);
 353
 354
 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 {
 369                 my $self = shift;
 370                 my $MIME = shift;
 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);
 375                 chomp($subject);
 376                 # TODO, why does this test fail
 377                 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
 378                 1;
 379                  }';
 380 }
 381
 382 # }}}
 383
 384
 385
 386
 387 # Don't taint the environment
 388 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');
 389 1;