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