rt/lib/t/regression/04send_email.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More tests => 137;
   5 use RT;
   6 RT::LoadConfig();
   7 RT::Init;
   8 use RT::EmailParser;
   9 use RT::Tickets;
  10 use RT::Action::SendEmail;
  11
  12 my @_outgoing_messages;
  13 my @scrips_fired;
  14
  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');
  19
  20
  21 is (__PACKAGE__, 'main', "We're operating in the main package");
  22
  23
  24 {
  25 no warnings qw/redefine/;
  26 sub RT::Action::SendEmail::SendMessage {
  27         my $self = shift;
  28         my $MIME = shift;
  29
  30         main::_fired_scrip($self->ScripObj);
  31         main::ok(ref($MIME) eq 'MIME::Entity', "hey, look. it's a mime entity");
  32 }
  33
  34 }
  35
  36 # instrument SendEmail to pass us what it's about to send.
  37 # create a regular ticket
  38
  39 my $parser = RT::EmailParser->new();
  40
  41
  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;
  46
  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);
  55
  56 ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce");
  57
  58
  59 # make sure it fires scrips.
  60 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
  61
  62 undef @scrips_fired;
  63
  64
  65
  66
  67 $parser->ParseMIMEEntityFromScalar('From: root@localhost
  68 To: rt@example.com
  69 Subject: This is a test of new ticket creation as an unknown user
  70
  71 Blah!
  72 Foob!');
  73
  74
  75 use Data::Dumper;
  76
  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);
  79 ok ($id,$msg);
  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");
  86
  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
  91
  92
  93 # we need to swap out SendMessage to test the new things we care about;
  94 &utf8_redef_sendmessage;
  95
  96 # create an iso 8859-1 ticket
  97 @scrips_fired = ();
  98
  99 $content =  `cat $RT::BasePath/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
 100
 101
 102
 103 $parser->ParseMIMEEntityFromScalar($content);
 104
 105
 106 # be as much like the mail gateway as possible.
 107 use RT::Interface::Email;
 108
 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);
 116
 117 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
 118
 119
 120 # make sure it fires scrips.
 121 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
 122 # make sure it sends an autoreply
 123
 124
 125 # make sure it sends a notification to adminccs
 126
 127 # If we correspond, does it do the right thing to the outbound messages?
 128
 129 $parser->ParseMIMEEntityFromScalar($content);
 130   ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
 131 ok ($id, $msg);
 132
 133 $parser->ParseMIMEEntityFromScalar($content);
 134 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
 135 ok ($id, $msg);
 136
 137
 138
 139
 140
 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
 145 @scrips_fired = ();
 146
 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;
 150
 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);
 158
 159 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
 160
 161
 162 # make sure it fires scrips.
 163 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
 164 # make sure it sends an autoreply
 165
 166
 167 # make sure it sends a notification to adminccs
 168
 169
 170 # If we correspond, does it do the right thing to the outbound messages?
 171
 172 $parser->ParseMIMEEntityFromScalar($content);
 173  ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
 174 ok ($id, $msg);
 175
 176 $parser->ParseMIMEEntityFromScalar($content);
 177 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
 178 ok ($id, $msg);
 179
 180
 181 sub _fired_scrip {
 182         my $scrip = shift;
 183         push @scrips_fired, $scrip;
 184 }
 185
 186 sub utf8_redef_sendmessage {
 187     no warnings qw/redefine/;
 188     eval '
 189     sub RT::Action::SendEmail::SendMessage {
 190         my $self = shift;
 191         my $MIME = shift;
 192
 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();
 204         use Encode;
 205         $message_as_string = Encode::decode_utf8($message_as_string);
 206         main::ok(
 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");
 209
 210     }';
 211 }
 212
 213 sub iso8859_redef_sendmessage {
 214     no warnings qw/redefine/;
 215     eval '
 216     sub RT::Action::SendEmail::SendMessage {
 217         my $self = shift;
 218         my $MIME = shift;
 219
 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();
 231         use Encode;
 232         $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
 233         main::ok(
 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");
 235
 236     }';
 237 }
 238
 239 # {{{ test a multipart alternative containing a text-html part with an umlaut
 240
 241  $content =  `cat $RT::BasePath/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
 242
 243 $parser->ParseMIMEEntityFromScalar($content);
 244
 245
 246 # be as much like the mail gateway as possible.
 247 &umlauts_redef_sendmessage;
 248
 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);
 256
 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");
 259
 260 sub umlauts_redef_sendmessage {
 261     no warnings qw/redefine/;
 262     eval 'sub RT::Action::SendEmail::SendMessage { }';
 263 }
 264
 265 # }}}
 266
 267 # {{{ test a text-html message with an umlaut
 268
 269  $content =  `cat $RT::BasePath/lib/t/data/text-html-with-umlaut` || 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_umlauts_redef_sendmessage;
 276
 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);
 284
 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");
 288
 289 sub text_html_umlauts_redef_sendmessage {
 290     no warnings qw/redefine/;
 291     eval 'sub RT::Action::SendEmail::SendMessage {
 292                 my $self = shift;
 293                 my $MIME = shift;
 294                 use Data::Dumper;
 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 ");
 300                  }';
 301 }
 302
 303 # }}}
 304
 305 # {{{ test a text-html message with russian characters
 306
 307  $content =  `cat $RT::BasePath/lib/t/data/text-html-in-russian` || die "couldn't find new content";
 308
 309 $parser->ParseMIMEEntityFromScalar($content);
 310
 311
 312 # be as much like the mail gateway as possible.
 313 &text_html_russian_redef_sendmessage;
 314
 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);
 322
 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");
 325
 326 sub text_html_russian_redef_sendmessage {
 327     no warnings qw/redefine/;
 328     eval 'sub RT::Action::SendEmail::SendMessage {
 329                 my $self = shift;
 330                 my $MIME = shift;
 331                 use Data::Dumper;
 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 ");
 337                 my $content_1251;
 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" );
 341                  }';
 342 }
 343
 344 # }}}
 345
 346 # {{{ test a message containing a russian subject and NO content type
 347
 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";
 351
 352 $parser->ParseMIMEEntityFromScalar($content);
 353
 354
 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);
 364
 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 {
 371                 my $self = shift;
 372                 my $MIME = shift;
 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");
 376                 chomp($subject);
 377                 #is( $subject ,      /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
 378                 };
 379                  ';
 380 }
 381
 382 shift @RT::EmailInputEncodings;
 383 $RT::EmailOutputEncoding = 'utf-8';
 384 # }}}
 385
 386
 387 # {{{ test a message containing a nested RFC 822 message
 388
 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");
 391
 392 $parser->ParseMIMEEntityFromScalar($content);
 393
 394
 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 {
 410                 my $self = shift;
 411                 my $MIME = shift;
 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);
 416                 chomp($subject);
 417                 # TODO, why does this test fail
 418                 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
 419                 1;
 420                  }';
 421 }
 422
 423 # }}}
 424
 425
 426 # {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
 427
 428  $content =  `cat $RT::BasePath/lib/t/data/notes-uuencoded` || die "couldn't find new content";
 429
 430 $parser->ParseMIMEEntityFromScalar($content);
 431
 432
 433 # be as much like the mail gateway as possible.
 434 &notes_redef_sendmessage;
 435
 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);
 443
 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");
 446
 447 sub notes_redef_sendmessage {
 448     no warnings qw/redefine/;
 449     eval 'sub RT::Action::SendEmail::SendMessage { }';
 450 }
 451
 452 # }}}
 453
 454 # {{{ test a multipart that crashes the file-based mime-parser works
 455
 456  $content =  `cat $RT::BasePath/lib/t/data/crashes-file-based-parser` || die "couldn't find new content";
 457
 458 $parser->ParseMIMEEntityFromScalar($content);
 459
 460
 461 # be as much like the mail gateway as possible.
 462 &crashes_redef_sendmessage;
 463
 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);
 471
 472 ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right");
 473 is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments");
 474
 475 sub crashes_redef_sendmessage {
 476     no warnings qw/redefine/;
 477     eval 'sub RT::Action::SendEmail::SendMessage { }';
 478 }
 479
 480
 481
 482 # }}}
 483
 484 # {{{ test a multi-line RT-Send-CC header
 485
 486  $content =  `cat $RT::BasePath/lib/t/data/rt-send-cc` || die "couldn't find new content";
 487
 488 $parser->ParseMIMEEntityFromScalar($content);
 489
 490
 491
 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);
 499
 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");
 506
 507 # }}}
 508
 509 # Don't taint the environment
 510 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');
 511 1;