rt/lib/RT/Action/SendEmail.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/copyleft/gpl.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
  49
  50 package RT::Action::SendEmail;
  51 require RT::Action::Generic;
  52
  53 use strict;
  54 use vars qw/@ISA/;
  55 @ISA = qw(RT::Action::Generic);
  56
  57 use MIME::Words qw(encode_mimeword);
  58
  59 use RT::EmailParser;
  60 use Mail::Address;
  61 use Date::Format qw(strftime);
  62
  63 =head1 NAME
  64
  65 RT::Action::SendEmail - An Action which users can use to send mail
  66 or can subclassed for more specialized mail sending behavior.
  67 RT::Action::AutoReply is a good example subclass.
  68
  69 =head1 SYNOPSIS
  70
  71   require RT::Action::SendEmail;
  72   @ISA  = qw(RT::Action::SendEmail);
  73
  74
  75 =head1 DESCRIPTION
  76
  77 Basically, you create another module RT::Action::YourAction which ISA
  78 RT::Action::SendEmail.
  79
  80 =begin testing
  81
  82 ok (require RT::Action::SendEmail);
  83
  84 =end testing
  85
  86
  87 =head1 AUTHOR
  88
  89 Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
  90
  91 =head1 SEE ALSO
  92
  93 perl(1).
  94
  95 =cut
  96
  97 # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
  98
  99
 100 # {{{ sub Commit
 101
 102 sub Commit {
 103     # DO NOT SHIFT @_ in this subroutine.  It breaks Hook::LexWrap's
 104     # ability to pass @_ to a 'post' routine.
 105     my $self = $_[0];
 106
 107     my ($ret) = $self->SendMessage( $self->TemplateObj->MIMEObj );
 108     if ( $ret > 0 ) {
 109         $self->RecordOutgoingMailTransaction( $self->TemplateObj->MIMEObj )
 110             if ($RT::RecordOutgoingEmail);
 111     }
 112     return (abs $ret);
 113 }
 114
 115 # }}}
 116
 117 # {{{ sub Prepare
 118
 119 sub Prepare {
 120     my $self = shift;
 121
 122     my ( $result, $message ) = $self->TemplateObj->Parse(
 123         Argument       => $self->Argument,
 124         TicketObj      => $self->TicketObj,
 125         TransactionObj => $self->TransactionObj
 126     );
 127     if ( !$result ) {
 128         return (undef);
 129     }
 130
 131     my $MIMEObj = $self->TemplateObj->MIMEObj;
 132
 133     # Header
 134     $self->SetRTSpecialHeaders();
 135
 136     $self->RemoveInappropriateRecipients();
 137
 138     my %seen;
 139     foreach my $type qw(To Cc Bcc) {
 140         @{ $self->{ $type } } =
 141             grep defined && length && !$seen{ lc $_ }++,
 142                 @{ $self->{ $type } };
 143     }
 144
 145     # Go add all the Tos, Ccs and Bccs that we need to to the message to
 146     # make it happy, but only if we actually have values in those arrays.
 147
 148     # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
 149
 150     $self->SetHeader( 'To', join ( ', ', @{ $self->{'To'} } ) )
 151       if ( ! $MIMEObj->head->get('To') &&  $self->{'To'} && @{ $self->{'To'} } );
 152     $self->SetHeader( 'Cc', join ( ', ', @{ $self->{'Cc'} } ) )
 153       if ( !$MIMEObj->head->get('Cc') && $self->{'Cc'} && @{ $self->{'Cc'} } );
 154     $self->SetHeader( 'Bcc', join ( ', ', @{ $self->{'Bcc'} } ) )
 155       if ( !$MIMEObj->head->get('Bcc') && $self->{'Bcc'} && @{ $self->{'Bcc'} } );
 156
 157     # PseudoTo  (fake to headers) shouldn't get matched for message recipients.
 158     # If we don't have any 'To' header (but do have other recipients), drop in
 159     # the pseudo-to header.
 160     $self->SetHeader( 'To', join ( ', ', @{ $self->{'PseudoTo'} } ) )
 161       if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } )
 162         and ( !$MIMEObj->head->get('To') ) ) and ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc'));
 163
 164     # We should never have to set the MIME-Version header
 165     $self->SetHeader( 'MIME-Version', '1.0' );
 166
 167     # fsck.com #5959: Since RT sends 8bit mail, we should say so.
 168     $self->SetHeader( 'Content-Transfer-Encoding','8bit');
 169
 170     # For security reasons, we only send out textual mails.
 171     my @parts = $MIMEObj;
 172     while (my $part = shift @parts) {
 173         if ($part->is_multipart) {
 174             push @parts, $part->parts;
 175         }
 176         else {
 177             if ( RT::I18N::IsTextualContentType( $part->mime_type ) ) {
 178                 $part->head->mime_attr( "Content-Type" => $part->mime_type )
 179             } else {
 180                 $part->head->mime_attr( "Content-Type" => 'text/plain' );
 181             }
 182             $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
 183         }
 184     }
 185
 186
 187     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' );
 188
 189     # Build up a MIME::Entity that looks like the original message.
 190     $self->AddAttachments() if ( $MIMEObj->head->get('RT-Attach-Message') );
 191
 192     return $result;
 193
 194 }
 195
 196 # }}}
 197
 198 # }}}
 199
 200
 201
 202 =head2 To
 203
 204 Returns an array of Mail::Address objects containing all the To: recipients for this notification
 205
 206 =cut
 207
 208 sub To {
 209     my $self = shift;
 210     return ($self->_AddressesFromHeader('To'));
 211 }
 212
 213 =head2 Cc
 214
 215 Returns an array of Mail::Address objects containing all the Cc: recipients for this notification
 216
 217 =cut
 218
 219 sub Cc {
 220     my $self = shift;
 221     return ($self->_AddressesFromHeader('Cc'));
 222 }
 223
 224 =head2 Bcc
 225
 226 Returns an array of Mail::Address objects containing all the Bcc: recipients for this notification
 227
 228 =cut
 229
 230
 231 sub Bcc {
 232     my $self = shift;
 233     return ($self->_AddressesFromHeader('Bcc'));
 234
 235 }
 236
 237 sub _AddressesFromHeader  {
 238     my $self = shift;
 239     my $field = shift;
 240     my $header = $self->TemplateObj->MIMEObj->head->get($field);
 241     my @addresses = Mail::Address->parse($header);
 242
 243     return (@addresses);
 244 }
 245
 246
 247 # {{{ SendMessage
 248
 249 =head2 SendMessage MIMEObj
 250
 251 sends the message using RT's preferred API.
 252 TODO: Break this out to a separate module
 253
 254 =cut
 255
 256 sub SendMessage {
 257     # DO NOT SHIFT @_ in this subroutine.  It breaks Hook::LexWrap's
 258     # ability to pass @_ to a 'post' routine.
 259     my ( $self, $MIMEObj ) = @_;
 260
 261     my $msgid = $MIMEObj->head->get('Message-ID');
 262     chomp $msgid;
 263
 264     $self->ScripActionObj->{_Message_ID}++;
 265
 266     $RT::Logger->info( $msgid . " #"
 267         . $self->TicketObj->id . "/"
 268         . $self->TransactionObj->id
 269         . " - Scrip "
 270         . $self->ScripObj->id . " "
 271         . $self->ScripObj->Description );
 272
 273     #If we don't have any recipients to send to, don't send a message;
 274     unless ( $MIMEObj->head->get('To')
 275         || $MIMEObj->head->get('Cc')
 276         || $MIMEObj->head->get('Bcc') )
 277     {
 278         $RT::Logger->info( $msgid . " No recipients found. Not sending.\n" );
 279         return (-1);
 280     }
 281
 282     unless ($MIMEObj->head->get('Date')) {
 283         # We coerce localtime into an array since strftime has a flawed prototype that only accepts
 284         # a list
 285       $MIMEObj->head->replace(Date => strftime('%a, %d %b %Y %H:%M:%S %z', @{[localtime()]}));
 286     }
 287
 288     return (0) unless ($self->OutputMIMEObject($MIMEObj));
 289
 290     my $success = $msgid . " sent ";
 291     foreach( qw(To Cc Bcc) ) {
 292         my $recipients = $MIMEObj->head->get($_);
 293         $success .= " $_: ". $recipients if $recipients;
 294     }
 295     $success =~ s/\n//g;
 296
 297     $RT::Logger->info($success);
 298
 299     return (1);
 300 }
 301
 302
 303 =head2 OutputMIMEObject MIME::Entity
 304
 305 Sends C<MIME::Entity> as an email message according to RT's mailer configuration.
 306
 307 =cut
 308
 309
 310
 311 sub OutputMIMEObject {
 312     my $self = shift;
 313     my $MIMEObj = shift;
 314
 315     my $msgid = $MIMEObj->head->get('Message-ID');
 316     chomp $msgid;
 317
 318     my $SendmailArguments = $RT::SendmailArguments;
 319     if (defined $RT::VERPPrefix && defined $RT::VERPDomain) {
 320       my $EnvelopeFrom = $self->TransactionObj->CreatorObj->EmailAddress;
 321       $EnvelopeFrom =~ s/@/=/g;
 322       $EnvelopeFrom =~ s/\s//g;
 323       $SendmailArguments .= " -f ${RT::VERPPrefix}${EnvelopeFrom}\@${RT::VERPDomain}";
 324     }
 325
 326
 327     if ( $RT::MailCommand eq 'sendmailpipe' ) {
 328         eval {
 329             # don't ignore CHLD signal to get proper exit code
 330             local $SIG{'CHLD'} = 'DEFAULT';
 331
 332             my $mail;
 333             unless( open $mail, "|$RT::SendmailPath $SendmailArguments" ) {
 334                 die "Couldn't run $RT::SendmailPath: $!";
 335             }
 336
 337             # if something wrong with $mail->print we will get PIPE signal, handle it
 338             local $SIG{'PIPE'} = sub { die "$RT::SendmailPath closed pipe" };
 339             $MIMEObj->print($mail);
 340
 341             unless ( close $mail ) {
 342                 die "Close failed: $!" if $!; # system error
 343                 # sendmail exit statuses mostly errors with data not software
 344                 # TODO: status parsing: core dump, exit on signal or EX_*
 345                 $RT::Logger->warning( "$RT::SendmailPath exitted with status $?" );
 346             }
 347         };
 348         if ($@) {
 349             $RT::Logger->crit( $msgid . "Could not send mail: " . $@ );
 350             return 0;
 351         }
 352     }
 353     else {
 354         my @mailer_args = ($RT::MailCommand);
 355
 356         local $ENV{MAILADDRESS};
 357
 358         if ( $RT::MailCommand eq 'sendmail' ) {
 359             push @mailer_args, split(/\s+/, $SendmailArguments);
 360         }
 361         elsif ( $RT::MailCommand eq 'smtp' ) {
 362             $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From');
 363             push @mailer_args, ( Server => $RT::SMTPServer );
 364             push @mailer_args, ( Debug  => $RT::SMTPDebug );
 365         }
 366         else {
 367             push @mailer_args, $RT::MailParams;
 368         }
 369
 370         unless ( $MIMEObj->send(@mailer_args) ) {
 371             $RT::Logger->crit( $msgid . "Could not send mail." );
 372             return (0);
 373         }
 374     }
 375     return 1;
 376 }
 377
 378 # }}}
 379
 380 # {{{ AddAttachments
 381
 382 =head2 AddAttachments
 383
 384 Takes any attachments to this transaction and attaches them to the message
 385 we're building.
 386
 387 =cut
 388
 389
 390 sub AddAttachments {
 391     my $self = shift;
 392
 393     my $MIMEObj = $self->TemplateObj->MIMEObj;
 394
 395     $MIMEObj->head->delete('RT-Attach-Message');
 396
 397     my $attachments = RT::Attachments->new($RT::SystemUser);
 398     $attachments->Limit(
 399         FIELD => 'TransactionId',
 400         VALUE => $self->TransactionObj->Id
 401     );
 402     $attachments->OrderBy( FIELD => 'id');
 403
 404     my $transaction_content_obj = $self->TransactionObj->ContentObj;
 405
 406     # attach any of this transaction's attachments
 407     while ( my $attach = $attachments->Next ) {
 408
 409         # Don't attach anything blank
 410         next unless ( $attach->ContentLength );
 411
 412 # We want to make sure that we don't include the attachment that's being used as the "Content" of this message.
 413         next
 414           if ( $transaction_content_obj
 415             && $transaction_content_obj->Id == $attach->Id
 416             && $transaction_content_obj->ContentType =~ qr{text/plain}i );
 417         $MIMEObj->make_multipart('mixed');
 418         $MIMEObj->attach(
 419             Type     => $attach->ContentType,
 420             Charset  => $attach->OriginalEncoding,
 421             Data     => $attach->OriginalContent,
 422             Filename => $self->MIMEEncodeString( $attach->Filename,
 423                 $RT::EmailOutputEncoding ),
 424             'RT-Attachment:' => $self->TicketObj->Id."/".$self->TransactionObj->Id."/".$attach->id,
 425             Encoding => '-SUGGEST'
 426         );
 427     }
 428
 429 }
 430
 431 # }}}
 432
 433 # {{{ RecordOutgoingMailTransaction
 434
 435 =head2 RecordOutgoingMailTransaction MIMEObj
 436
 437 Record a transaction in RT with this outgoing message for future record-keeping purposes
 438
 439 =cut
 440
 441
 442
 443 sub RecordOutgoingMailTransaction {
 444     my $self = shift;
 445     my $MIMEObj = shift;
 446
 447
 448     my @parts = $MIMEObj->parts;
 449     my @attachments;
 450     my @keep;
 451     foreach my $part (@parts) {
 452         my $attach = $part->head->get('RT-Attachment');
 453         if ($attach) {
 454             $RT::Logger->debug("We found an attachment. we want to not record it.");
 455             push @attachments, $attach;
 456         } else {
 457             $RT::Logger->debug("We found a part. we want to record it.");
 458             push @keep, $part;
 459         }
 460     }
 461     $MIMEObj->parts(\@keep);
 462     foreach my $attachment (@attachments) {
 463         $MIMEObj->head->add('RT-Attachment', $attachment);
 464     }
 465
 466     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
 467
 468     my $transaction = RT::Transaction->new($self->TransactionObj->CurrentUser);
 469
 470     # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
 471
 472     my $type;
 473     if ($self->TransactionObj->Type eq 'Comment') {
 474         $type = 'CommentEmailRecord';
 475     } else {
 476         $type = 'EmailRecord';
 477     }
 478
 479     my $msgid = $MIMEObj->head->get('Message-ID');
 480     chomp $msgid;
 481
 482     my ( $id, $msg ) = $transaction->Create(
 483         Ticket         => $self->TicketObj->Id,
 484         Type           => $type,
 485         Data           => $msgid,
 486         MIMEObj        => $MIMEObj,
 487         ActivateScrips => 0
 488     );
 489
 490     if( $id ) {
 491         $self->{'OutgoingMailTransaction'} = $id;
 492     } else {
 493         $RT::Logger->warning( "Could not record outgoing message transaction: $msg" );
 494     }
 495     return $id;
 496 }
 497
 498 # }}}
 499 #
 500
 501 # {{{ sub SetRTSpecialHeaders
 502
 503 =head2 SetRTSpecialHeaders
 504
 505 This routine adds all the random headers that RT wants in a mail message
 506 that don't matter much to anybody else.
 507
 508 =cut
 509
 510 sub SetRTSpecialHeaders {
 511     my $self = shift;
 512
 513     $self->SetSubject();
 514     $self->SetSubjectToken();
 515     $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding )
 516       if ($RT::EmailOutputEncoding);
 517     $self->SetReturnAddress();
 518     $self->SetReferencesHeaders();
 519
 520     unless ($self->TemplateObj->MIMEObj->head->get('Message-ID')) {
 521       # Get Message-ID for this txn
 522       my $msgid = "";
 523       $msgid = $self->TransactionObj->Message->First->GetHeader("RT-Message-ID")
 524         || $self->TransactionObj->Message->First->GetHeader("Message-ID")
 525         if $self->TransactionObj->Message && $self->TransactionObj->Message->First;
 526
 527       # If there is one, and we can parse it, then base our Message-ID on it
 528       if ($msgid
 529           and $msgid =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\Q$RT::Organization\E>$/
 530                          "<$1." . $self->TicketObj->id
 531                           . "-" . $self->ScripObj->id
 532                           . "-" . $self->ScripActionObj->{_Message_ID}
 533                           . "@" . $RT::Organization . ">"/eg
 534           and $2 == $self->TicketObj->id) {
 535         $self->SetHeader( "Message-ID" => $msgid );
 536       } else {
 537         $self->SetHeader( 'Message-ID',
 538             "<rt-"
 539             . $RT::VERSION . "-"
 540             . $$ . "-"
 541             . CORE::time() . "-"
 542             . int(rand(2000)) . '.'
 543             . $self->TicketObj->id . "-"
 544             . $self->ScripObj->id . "-"  # Scrip
 545             . $self->ScripActionObj->{_Message_ID} . "@"  # Email sent
 546             . $RT::Organization
 547             . ">" );
 548       }
 549     }
 550
 551     $self->SetHeader( 'Precedence', "bulk" )
 552       unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") );
 553
 554     $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname );
 555     $self->SetHeader( 'RT-Ticket',
 556         $RT::rtname . " #" . $self->TicketObj->id() );
 557     $self->SetHeader( 'Managed-by',
 558         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 559
 560     $self->SetHeader( 'RT-Originator',
 561         $self->TransactionObj->CreatorObj->EmailAddress );
 562
 563 }
 564
 565 # }}}
 566
 567
 568 # }}}
 569
 570 # {{{ RemoveInappropriateRecipients
 571
 572 =head2 RemoveInappropriateRecipients
 573
 574 Remove addresses that are RT addresses or that are on this transaction's blacklist
 575
 576 =cut
 577
 578 sub RemoveInappropriateRecipients {
 579     my $self = shift;
 580
 581     my $msgid = $self->TemplateObj->MIMEObj->head->get  ('Message-Id');
 582
 583
 584
 585     my @blacklist;
 586
 587     my @types = qw/To Cc Bcc/;
 588
 589     # Weed out any RT addresses. We really don't want to talk to ourselves!
 590     foreach my $type (@types) {
 591         @{ $self->{$type} } =
 592           RT::EmailParser::CullRTAddresses( "", @{ $self->{$type} } );
 593     }
 594
 595     # If there are no recipients, don't try to send the message.
 596     # If the transaction has content and has the header RT-Squelch-Replies-To
 597
 598     if ( $self->TransactionObj->Attachments->First() ) {
 599         if (
 600             $self->TransactionObj->Attachments->First->GetHeader(
 601                 'RT-DetectedAutoGenerated')
 602           )
 603         {
 604
 605             # What do we want to do with this? It's probably (?) a bounce
 606             # caused by one of the watcher addresses being broken.
 607             # Default ("true") is to redistribute, for historical reasons.
 608
 609             if ( !$RT::RedistributeAutoGeneratedMessages ) {
 610
 611                 # Don't send to any watchers.
 612                 @{ $self->{'To'} }  = ();
 613                 @{ $self->{'Cc'} }  = ();
 614                 @{ $self->{'Bcc'} } = ();
 615
 616                 $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message based on site configuration.\n");
 617             }
 618             elsif ( $RT::RedistributeAutoGeneratedMessages eq 'privileged' ) {
 619
 620                 # Only send to "privileged" watchers.
 621                 #
 622
 623                 foreach my $type (@types) {
 624
 625                     foreach my $addr ( @{ $self->{$type} } ) {
 626                         my $user = RT::User->new($RT::SystemUser);
 627                         $user->LoadByEmail($addr);
 628                         @{ $self->{$type} } =
 629                           grep ( !/^\Q$addr\E$/, @{ $self->{$type} } )
 630                           if ( !$user->Privileged );
 631
 632                     }
 633                 }
 634                 $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message to unprivileged users based on site configuration.\n");
 635
 636             }
 637
 638         }
 639
 640         my $squelch =
 641           $self->TransactionObj->Attachments->First->GetHeader(
 642             'RT-Squelch-Replies-To');
 643
 644         if ($squelch) {
 645             @blacklist = split( /,/, $squelch );
 646         }
 647     }
 648
 649     # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
 650     my @non_recipients = $self->TicketObj->SquelchMailTo;
 651     foreach my $attribute (@non_recipients) {
 652         push @blacklist, $attribute->Content;
 653     }
 654
 655     # Cycle through the people we're sending to and pull out anyone on the
 656     # system blacklist
 657
 658     foreach my $person_to_yank (@blacklist) {
 659         $person_to_yank =~ s/\s//g;
 660         foreach my $type (@types) {
 661             @{ $self->{$type} } =
 662               grep ( !/^\Q$person_to_yank\E$/, @{ $self->{$type} } );
 663         }
 664     }
 665 }
 666
 667 # }}}
 668 # {{{ sub SetReturnAddress
 669
 670 =head2 SetReturnAddress is_comment => BOOLEAN
 671
 672 Calculate and set From and Reply-To headers based on the is_comment flag.
 673
 674 =cut
 675
 676 sub SetReturnAddress {
 677
 678     my $self = shift;
 679     my %args = (
 680         is_comment => 0,
 681         @_
 682     );
 683
 684     # From and Reply-To
 685     # $args{is_comment} should be set if the comment address is to be used.
 686     my $replyto;
 687
 688     if ( $args{'is_comment'} ) {
 689         $replyto = $self->TicketObj->QueueObj->CommentAddress
 690           || $RT::CommentAddress;
 691     }
 692     else {
 693         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 694           || $RT::CorrespondAddress;
 695     }
 696
 697     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 698         if ($RT::UseFriendlyFromLine) {
 699             my $friendly_name = $self->TransactionObj->CreatorObj->RealName
 700                 || $self->TransactionObj->CreatorObj->Name;
 701             if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 702                 $friendly_name = $1;
 703             }
 704
 705             $friendly_name =~ s/"/\\"/g;
 706             $self->SetHeader(
 707                 'From',
 708                 sprintf(
 709                     $RT::FriendlyFromLineFormat,
 710                     $self->MIMEEncodeString( $friendly_name,
 711                         $RT::EmailOutputEncoding ),
 712                     $replyto
 713                 ),
 714             );
 715         }
 716         else {
 717             $self->SetHeader( 'From', $replyto );
 718         }
 719     }
 720
 721     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 722         $self->SetHeader( 'Reply-To', "$replyto" );
 723     }
 724
 725 }
 726
 727 # }}}
 728
 729 # {{{ sub SetHeader
 730
 731 =head2 SetHeader FIELD, VALUE
 732
 733 Set the FIELD of the current MIME object into VALUE.
 734
 735 =cut
 736
 737 sub SetHeader {
 738     my $self  = shift;
 739     my $field = shift;
 740     my $val   = shift;
 741
 742     chomp $val;
 743     chomp $field;
 744     $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 );
 745     $self->TemplateObj->MIMEObj->head->replace( $field,     $val );
 746     return $self->TemplateObj->MIMEObj->head->get($field);
 747 }
 748
 749 # }}}
 750
 751
 752 # {{{ sub SetSubject
 753
 754 =head2 SetSubject
 755
 756 This routine sets the subject. it does not add the rt tag. that gets done elsewhere
 757 If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get
 758 the transaction's subject.
 759
 760 =cut
 761
 762 sub SetSubject {
 763     my $self = shift;
 764     my $subject;
 765
 766     my $message = $self->TransactionObj->Attachments;
 767     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 768         return ();
 769     }
 770     if ( $self->{'Subject'} ) {
 771         $subject = $self->{'Subject'};
 772     }
 773     elsif ( ( $message->First() ) && ( $message->First->Headers ) ) {
 774         my $header = $message->First->Headers();
 775         $header =~ s/\n\s+/ /g;
 776         if ( $header =~ /^Subject: (.*?)$/m ) {
 777             $subject = $1;
 778         }
 779         else {
 780             $subject = $self->TicketObj->Subject();
 781         }
 782
 783     }
 784     else {
 785         $subject = $self->TicketObj->Subject();
 786     }
 787
 788     $subject =~ s/(\r\n|\n|\s)/ /gi;
 789
 790     chomp $subject;
 791     $self->SetHeader( 'Subject', $subject );
 792
 793 }
 794
 795 # }}}
 796
 797 # {{{ sub SetSubjectToken
 798
 799 =head2 SetSubjectToken
 800
 801 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 802
 803 =cut
 804
 805 sub SetSubjectToken {
 806     my $self = shift;
 807     my $sub  = $self->TemplateObj->MIMEObj->head->get('Subject');
 808     my $id   = $self->TicketObj->id;
 809
 810     my $token_re = $RT::EmailSubjectTagRegex;
 811     $token_re = qr/\Q$RT::rtname\E/o unless $token_re;
 812     return if $sub =~ /\[$token_re\s+#$id\]/;
 813
 814     $sub =~ s/(\r\n|\n|\s)/ /gi;
 815     chomp $sub;
 816     $self->TemplateObj->MIMEObj->head->replace(
 817         Subject => "[$RT::rtname #$id] $sub",
 818     );
 819 }
 820
 821 # }}}
 822
 823 =head2 SetReferencesHeaders
 824
 825 Set References and In-Reply-To headers for this message.
 826
 827 =cut
 828
 829 sub SetReferencesHeaders {
 830
 831     my $self = shift;
 832     my ( @in_reply_to, @references, @msgid );
 833
 834     my $attachments = $self->TransactionObj->Message;
 835
 836     if ( my $top = $attachments->First() ) {
 837         @in_reply_to = split(/\s+/m, $top->GetHeader('In-Reply-To') || '');
 838         @references = split(/\s+/m, $top->GetHeader('References') || '' );
 839         @msgid = split(/\s+/m, $top->GetHeader('Message-ID') || '');
 840     }
 841     else {
 842         return (undef);
 843     }
 844
 845     # There are two main cases -- this transaction was created with
 846     # the RT Web UI, and hence we want to *not* append its Message-ID
 847     # to the References and In-Reply-To.  OR it came from an outside
 848     # source, and we should treat it as per the RFC
 849     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@$RT::Organization>/) {
 850
 851       # Make all references which are internal be to version which we
 852       # have sent out
 853       for (@references, @in_reply_to) {
 854         s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@$RT::Organization>$/
 855           "<$1." . $self->TicketObj->id .
 856              "-" . $self->ScripObj->id .
 857              "-" . $self->ScripActionObj->{_Message_ID} .
 858              "@" . $RT::Organization . ">"/eg
 859       }
 860
 861       # In reply to whatever the internal message was in reply to
 862       $self->SetHeader( 'In-Reply-To', join( " ",  ( @in_reply_to )));
 863
 864       # Default the references to whatever we're in reply to
 865       @references = @in_reply_to unless @references;
 866
 867       # References are unchanged from internal
 868     } else {
 869       # In reply to that message
 870       $self->SetHeader( 'In-Reply-To', join( " ",  ( @msgid )));
 871
 872       # Default the references to whatever we're in reply to
 873       @references = @in_reply_to unless @references;
 874
 875       # Push that message onto the end of the references
 876       push @references, @msgid;
 877     }
 878
 879     # Push pseudo-ref to the front
 880     my $pseudo_ref = $self->PseudoReference;
 881     @references = ($pseudo_ref, grep { $_ ne $pseudo_ref } @references);
 882
 883     # If there are more than 10 references headers, remove all but the
 884     # first four and the last six (Gotta keep this from growing
 885     # forever)
 886     splice(@references, 4, -6) if ($#references >= 10);
 887
 888     # Add on the references
 889     $self->SetHeader( 'References', join( " ",   @references) );
 890     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
 891
 892 }
 893
 894 # }}}
 895
 896 =head2 PseudoReference
 897
 898 Returns a fake Message-ID: header for the ticket to allow a base level of threading
 899
 900 =cut
 901
 902 sub PseudoReference {
 903
 904     my $self = shift;
 905     my $pseudo_ref =  '<RT-Ticket-'.$self->TicketObj->id .'@'.$RT::Organization .'>';
 906     return $pseudo_ref;
 907 }
 908
 909
 910 # {{{ SetHeadingAsEncoding
 911
 912 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
 913
 914 This routine converts the field into specified charset encoding.
 915
 916 =cut
 917
 918 sub SetHeaderAsEncoding {
 919     my $self = shift;
 920     my ( $field, $enc ) = ( shift, shift );
 921
 922     if ($field eq 'From' and $RT::SMTPFrom) {
 923         $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom );
 924         return;
 925     }
 926
 927     my $value = $self->TemplateObj->MIMEObj->head->get($field);
 928
 929     $value =  $self->MIMEEncodeString($value, $enc);
 930
 931     $self->TemplateObj->MIMEObj->head->replace( $field, $value );
 932
 933
 934 }
 935 # }}}
 936
 937 # {{{ MIMEEncodeString
 938
 939 =head2 MIMEEncodeString STRING ENCODING
 940
 941 Takes a string and a possible encoding and returns the string wrapped in MIME goo.
 942
 943 =cut
 944
 945 sub MIMEEncodeString {
 946     my  $self = shift;
 947     my $value = shift;
 948     # using RFC2047 notation, sec 2.
 949     # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
 950     my $charset = shift;
 951     my $encoding = 'B';
 952     # An 'encoded-word' may not be more than 75 characters long
 953     #
 954     # MIME encoding increases 4/3*(number of bytes), and always in multiples
 955     # of 4. Thus we have to find the best available value of bytes available
 956     # for each chunk.
 957     #
 958     # First we get the integer max which max*4/3 would fit on space.
 959     # Then we find the greater multiple of 3 lower or equal than $max.
 960     my $max = int(((75-length('=?'.$charset.'?'.$encoding.'?'.'?='))*3)/4);
 961     $max = int($max/3)*3;
 962
 963     chomp $value;
 964
 965     if ( $max <= 0 ) {
 966       # gives an error...
 967       $RT::Logger->crit("Can't encode! Charset or encoding too big.\n");
 968       return ($value);
 969     }
 970
 971     return ($value) unless $value =~ /[^\x20-\x7e]/;
 972
 973     $value =~ s/\s*$//;
 974
 975     # we need perl string to split thing char by char
 976     Encode::_utf8_on($value) unless Encode::is_utf8( $value );
 977
 978     my ($tmp, @chunks) = ('', ());
 979     while ( length $value ) {
 980         my $char = substr($value, 0, 1, '');
 981         my $octets = Encode::encode( $charset, $char );
 982         if ( length($tmp) + length($octets) > $max ) {
 983             push @chunks, $tmp;
 984             $tmp = '';
 985         }
 986         $tmp .= $octets;
 987     }
 988     push @chunks, $tmp if length $tmp;
 989
 990     # encode an join chuncks
 991     $value = join "\n ",
 992                map encode_mimeword( $_, $encoding, $charset ), @chunks ;
 993     return($value);
 994 }
 995
 996 # }}}
 997
 998 eval "require RT::Action::SendEmail_Vendor";
 999 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm});
1000 eval "require RT::Action::SendEmail_Local";
1001 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm});
1002
1003 1;
1004