rt/lib/t/04_send_email.pl

   1 #!/usr/bin/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
  37
  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;
  42
  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);
  50
  51 ok ($tick->Transactions->First->Content =~ /The original message was received/, "It's the bounce");
  52
  53
  54 # make sure it fires scrips.
  55 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
  56
  57 undef @scrips_fired;
  58
  59
  60
  61
  62 $parser->ParseMIMEEntityFromScalar('From: root@localhost
  63 To: rt@example.com
  64 Subject: This is a test of new ticket creation as an unknown user
  65
  66 Blah!
  67 Foob!');
  68
  69
  70 use Data::Dumper;
  71
  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);
  74 ok ($id,$msg);
  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");
  81
  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
  86
  87
  88 # we need to swap out SendMessage to test the new things we care about;
  89 &utf8_redef_sendmessage;
  90
  91 # create an iso 8859-1 ticket
  92 @scrips_fired = ();
  93
  94 my $content =  `cat /opt/rt3/lib/t/data/new-ticket-from-iso-8859-1` || die "couldn't find new content";
  95
  96
  97
  98 $parser->ParseMIMEEntityFromScalar($content);
  99
 100
 101 # be as much like the mail gateway as possible.
 102 use RT::Interface::Email;
 103
 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);
 111
 112 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
 113
 114
 115 # make sure it fires scrips.
 116 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
 117 # make sure it sends an autoreply
 118
 119
 120 # make sure it sends a notification to adminccs
 121
 122 # If we correspond, does it do the right thing to the outbound messages?
 123
 124 $parser->ParseMIMEEntityFromScalar($content);
 125 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
 126 ok ($id, $msg);
 127
 128 $parser->ParseMIMEEntityFromScalar($content);
 129 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
 130 ok ($id, $msg);
 131
 132
 133
 134
 135
 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
 140 @scrips_fired = ();
 141
 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;
 145
 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);
 153
 154 ok ($tick->Transactions->First->Content =~ /H\x{e5}vard/, "It's signed by havard. yay");
 155
 156
 157 # make sure it fires scrips.
 158 is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation");
 159 # make sure it sends an autoreply
 160
 161
 162 # make sure it sends a notification to adminccs
 163
 164
 165 # If we correspond, does it do the right thing to the outbound messages?
 166
 167 $parser->ParseMIMEEntityFromScalar($content);
 168 my ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity);
 169 ok ($id, $msg);
 170
 171 $parser->ParseMIMEEntityFromScalar($content);
 172 ($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity);
 173 ok ($id, $msg);
 174
 175
 176 sub _fired_scrip {
 177         my $scrip = shift;
 178         push @scrips_fired, $scrip;
 179 }
 180
 181 sub utf8_redef_sendmessage {
 182     no warnings qw/redefine/;
 183     eval '
 184     sub RT::Action::SendEmail::SendMessage {
 185         my $self = shift;
 186         my $MIME = shift;
 187
 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();
 199         use Encode;
 200         $message_as_string = Encode::decode_utf8($message_as_string);
 201         main::ok(
 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");
 204
 205     }';
 206 }
 207
 208 sub iso8859_redef_sendmessage {
 209     no warnings qw/redefine/;
 210     eval '
 211     sub RT::Action::SendEmail::SendMessage {
 212         my $self = shift;
 213         my $MIME = shift;
 214
 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();
 226         use Encode;
 227         $message_as_string = Encode::decode("iso-8859-1",$message_as_string);
 228         main::ok(
 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");
 230
 231     }';
 232 }
 233
 234 # {{{ test a multipart alternative containing a text-html part with an umlaut
 235
 236 my $content =  `cat /opt/rt3/lib/t/data/multipart-alternative-with-umlaut` || die "couldn't find new content";
 237
 238 $parser->ParseMIMEEntityFromScalar($content);
 239
 240
 241 # be as much like the mail gateway as possible.
 242 &umlauts_redef_sendmessage;
 243
 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);
 251
 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");
 254
 255 sub umlauts_redef_sendmessage {
 256     no warnings qw/redefine/;
 257     eval 'sub RT::Action::SendEmail::SendMessage { }';
 258 }
 259
 260 # }}}
 261
 262 # {{{ test a text-html message with an umlaut
 263
 264 my $content =  `cat /opt/rt3/lib/t/data/text-html-with-umlaut` || die "couldn't find new content";
 265
 266 $parser->ParseMIMEEntityFromScalar($content);
 267
 268
 269 # be as much like the mail gateway as possible.
 270 &text_html_umlauts_redef_sendmessage;
 271
 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);
 279
 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");
 283
 284 sub text_html_umlauts_redef_sendmessage {
 285     no warnings qw/redefine/;
 286     eval 'sub RT::Action::SendEmail::SendMessage {
 287                 my $self = shift;
 288                 my $MIME = shift;
 289                 use Data::Dumper;
 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 ");
 295                  }';
 296 }
 297
 298 # }}}
 299
 300 # {{{ test a text-html message with russian characters
 301
 302 my $content =  `cat /opt/rt3/lib/t/data/text-html-in-russian` || die "couldn't find new content";
 303
 304 $parser->ParseMIMEEntityFromScalar($content);
 305
 306
 307 # be as much like the mail gateway as possible.
 308 &text_html_russian_redef_sendmessage;
 309
 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);
 317
 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");
 320
 321 sub text_html_russian_redef_sendmessage {
 322     no warnings qw/redefine/;
 323     eval 'sub RT::Action::SendEmail::SendMessage {
 324                 my $self = shift;
 325                 my $MIME = shift;
 326                 use Data::Dumper;
 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 ");
 332                 my $content_1251;
 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" );
 336                  }';
 337 }
 338
 339 # }}}
 340
 341 # {{{ test a message containing a russian subject and NO content type
 342
 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";
 346
 347 $parser->ParseMIMEEntityFromScalar($content);
 348
 349
 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);
 359
 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 {
 366                 my $self = shift;
 367                 my $MIME = shift;
 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");
 371                 chomp($subject);
 372                 #is( $subject ,      /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly");
 373                 };
 374                  ';
 375 }
 376
 377 shift @RT::EmailInputEncodings;
 378 $RT::EmailOutputEncoding = 'utf-8';
 379 # }}}
 380
 381
 382 # {{{ test a message containing a nested RFC 822 message
 383
 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");
 386
 387 $parser->ParseMIMEEntityFromScalar($content);
 388
 389
 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 {
 405                 my $self = shift;
 406                 my $MIME = shift;
 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);
 411                 chomp($subject);
 412                 # TODO, why does this test fail
 413                 #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject");
 414                 1;
 415                  }';
 416 }
 417
 418 # }}}
 419
 420
 421 # {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes
 422
 423 my $content =  `cat /opt/rt3/lib/t/data/notes-uuencoded` || die "couldn't find new content";
 424
 425 $parser->ParseMIMEEntityFromScalar($content);
 426
 427
 428 # be as much like the mail gateway as possible.
 429 &notes_redef_sendmessage;
 430
 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);
 438
 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");
 441
 442 sub notes_redef_sendmessage {
 443     no warnings qw/redefine/;
 444     eval 'sub RT::Action::SendEmail::SendMessage { }';
 445 }
 446
 447 # }}}
 448
 449 # {{{ test a multipart that crashes the file-based mime-parser works
 450
 451 my $content =  `cat /opt/rt3/lib/t/data/crashes-file-based-parser` || die "couldn't find new content";
 452
 453 $parser->ParseMIMEEntityFromScalar($content);
 454
 455
 456 # be as much like the mail gateway as possible.
 457 &crashes_redef_sendmessage;
 458
 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);
 466
 467 ok ($tick->Transactions->First->Content =~ /FYI/, "We recorded the content right");
 468 is ($tick->Transactions->First->Attachments->Count , 5 , "Has three attachments");
 469
 470 sub crashes_redef_sendmessage {
 471     no warnings qw/redefine/;
 472     eval 'sub RT::Action::SendEmail::SendMessage { }';
 473 }
 474
 475
 476
 477 # }}}
 478
 479 # Don't taint the environment
 480 $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser');
 481 1;