rt/lib/RT/Action/SendEmail.pm

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