rt/lib/RT/Action/SendEmail.pm.orig

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
   6 #                                          <sales@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/licenses/old-licenses/gpl-2.0.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
  49 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
  50
  51 package RT::Action::SendEmail;
  52
  53 use strict;
  54 use warnings;
  55
  56 use base qw(RT::Action);
  57
  58 use RT::EmailParser;
  59 use RT::Interface::Email;
  60 use Email::Address;
  61 our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);
  62
  63
  64 =head1 NAME
  65
  66 RT::Action::SendEmail - An Action which users can use to send mail
  67 or can subclassed for more specialized mail sending behavior.
  68 RT::Action::AutoReply is a good example subclass.
  69
  70 =head1 SYNOPSIS
  71
  72   use base 'RT::Action::SendEmail';
  73
  74 =head1 DESCRIPTION
  75
  76 Basically, you create another module RT::Action::YourAction which ISA
  77 RT::Action::SendEmail.
  78
  79 =head1 METHODS
  80
  81 =head2 CleanSlate
  82
  83 Cleans class-wide options, like L</AttachTickets>.
  84
  85 =cut
  86
  87 sub CleanSlate {
  88     my $self = shift;
  89     $self->AttachTickets(undef);
  90 }
  91
  92 =head2 Commit
  93
  94 Sends the prepared message and writes outgoing record into DB if the feature is
  95 activated in the config.
  96
  97 =cut
  98
  99 sub Commit {
 100     my $self = shift;
 101
 102     return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
 103         unless RT->Config->Get('RecordOutgoingEmail');
 104
 105     $self->DeferDigestRecipients();
 106     my $message = $self->TemplateObj->MIMEObj;
 107
 108     my $orig_message;
 109     $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
 110         Attachment => $self->TransactionObj->Attachments->First,
 111         Ticket     => $self->TicketObj,
 112     );
 113
 114     my ($ret) = $self->SendMessage($message);
 115     return abs( $ret ) if $ret <= 0;
 116
 117     if ($orig_message) {
 118         $message->attach(
 119             Type        => 'application/x-rt-original-message',
 120             Disposition => 'inline',
 121             Data        => $orig_message->as_string,
 122         );
 123     }
 124     $self->RecordOutgoingMailTransaction($message);
 125     $self->RecordDeferredRecipients();
 126     return 1;
 127 }
 128
 129 =head2 Prepare
 130
 131 Builds an outgoing email we're going to send using scrip's template.
 132
 133 =cut
 134
 135 sub Prepare {
 136     my $self = shift;
 137
 138     my ( $result, $message ) = $self->TemplateObj->Parse(
 139         Argument       => $self->Argument,
 140         TicketObj      => $self->TicketObj,
 141         TransactionObj => $self->TransactionObj
 142     );
 143     if ( !$result ) {
 144         return (undef);
 145     }
 146
 147     my $MIMEObj = $self->TemplateObj->MIMEObj;
 148
 149     # Header
 150     $self->SetRTSpecialHeaders();
 151
 152     my %seen;
 153     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 154         @{ $self->{$type} }
 155             = grep defined && length && !$seen{ lc $_ }++,
 156             @{ $self->{$type} };
 157     }
 158
 159     $self->RemoveInappropriateRecipients();
 160
 161     # Go add all the Tos, Ccs and Bccs that we need to to the message to
 162     # make it happy, but only if we actually have values in those arrays.
 163
 164 # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
 165
 166     for my $header (@EMAIL_RECIPIENT_HEADERS) {
 167
 168         $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
 169           if (!$MIMEObj->head->get($header)
 170             && $self->{$header}
 171             && @{ $self->{$header} } );
 172     }
 173     # PseudoTo (fake to headers) shouldn't get matched for message recipients.
 174     # If we don't have any 'To' header (but do have other recipients), drop in
 175     # the pseudo-to header.
 176     $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
 177         if $self->{'PseudoTo'}
 178             && @{ $self->{'PseudoTo'} }
 179             && !$MIMEObj->head->get('To')
 180             && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
 181
 182     # We should never have to set the MIME-Version header
 183     $self->SetHeader( 'MIME-Version', '1.0' );
 184
 185     # fsck.com #5959: Since RT sends 8bit mail, we should say so.
 186     $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
 187
 188     # For security reasons, we only send out textual mails.
 189     foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
 190         my $type = $part->mime_type || 'text/plain';
 191         $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
 192         $part->head->mime_attr( "Content-Type" => $type );
 193         # utf-8 here is for _FindOrGuessCharset in I18N.pm
 194         # it's not the final charset/encoding sent
 195         $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
 196     }
 197
 198     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
 199         RT->Config->Get('EmailOutputEncoding'),
 200         'mime_words_ok', );
 201
 202     # Build up a MIME::Entity that looks like the original message.
 203     $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
 204                                && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
 205
 206     $self->AddTickets;
 207
 208     my $attachment = $self->TransactionObj->Attachments->First;
 209     if ($attachment
 210         && !(
 211                $attachment->GetHeader('X-RT-Encrypt')
 212             || $self->TicketObj->QueueObj->Encrypt
 213         )
 214         )
 215     {
 216         $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
 217             if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
 218             'Success';
 219     }
 220
 221     return $result;
 222 }
 223
 224 =head2 To
 225
 226 Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
 227
 228 =cut
 229
 230 sub To {
 231     my $self = shift;
 232     return ( $self->AddressesFromHeader('To') );
 233 }
 234
 235 =head2 Cc
 236
 237 Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
 238
 239 =cut
 240
 241 sub Cc {
 242     my $self = shift;
 243     return ( $self->AddressesFromHeader('Cc') );
 244 }
 245
 246 =head2 Bcc
 247
 248 Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
 249
 250 =cut
 251
 252 sub Bcc {
 253     my $self = shift;
 254     return ( $self->AddressesFromHeader('Bcc') );
 255
 256 }
 257
 258 sub AddressesFromHeader {
 259     my $self      = shift;
 260     my $field     = shift;
 261     my $header    = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field));
 262     my @addresses = Email::Address->parse($header);
 263
 264     return (@addresses);
 265 }
 266
 267 =head2 SendMessage MIMEObj
 268
 269 sends the message using RT's preferred API.
 270 TODO: Break this out to a separate module
 271
 272 =cut
 273
 274 sub SendMessage {
 275
 276     # DO NOT SHIFT @_ in this subroutine.  It breaks Hook::LexWrap's
 277     # ability to pass @_ to a 'post' routine.
 278     my ( $self, $MIMEObj ) = @_;
 279
 280     my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
 281     chomp $msgid;
 282
 283     $self->ScripActionObj->{_Message_ID}++;
 284
 285     $RT::Logger->info( $msgid . " #"
 286             . $self->TicketObj->id . "/"
 287             . $self->TransactionObj->id
 288             . " - Scrip "
 289             . ($self->ScripObj->id || '#rule'). " "
 290             . ( $self->ScripObj->Description || '' ) );
 291
 292     my $status = RT::Interface::Email::SendEmail(
 293         Entity      => $MIMEObj,
 294         Ticket      => $self->TicketObj,
 295         Transaction => $self->TransactionObj,
 296     );
 297
 298
 299     return $status unless ($status > 0 || exists $self->{'Deferred'});
 300
 301     my $success = $msgid . " sent ";
 302     foreach (@EMAIL_RECIPIENT_HEADERS) {
 303         my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) );
 304         $success .= " $_: " . $recipients if $recipients;
 305     }
 306
 307     if( exists $self->{'Deferred'} ) {
 308         for (qw(daily weekly susp)) {
 309             $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
 310                 if exists $self->{'Deferred'}{ $_ };
 311         }
 312     }
 313
 314     $success =~ s/\n//g;
 315
 316     $RT::Logger->info($success);
 317
 318     return (1);
 319 }
 320
 321 =head2 AddAttachments
 322
 323 Takes any attachments to this transaction and attaches them to the message
 324 we're building.
 325
 326 =cut
 327
 328 sub AddAttachments {
 329     my $self = shift;
 330
 331     my $MIMEObj = $self->TemplateObj->MIMEObj;
 332
 333     $MIMEObj->head->delete('RT-Attach-Message');
 334
 335     my $attachments = RT::Attachments->new( RT->SystemUser );
 336     $attachments->Limit(
 337         FIELD => 'TransactionId',
 338         VALUE => $self->TransactionObj->Id
 339     );
 340
 341     # Don't attach anything blank
 342     $attachments->LimitNotEmpty;
 343     $attachments->OrderBy( FIELD => 'id' );
 344
 345     # We want to make sure that we don't include the attachment that's
 346     # being used as the "Content" of this message" unless that attachment's
 347     # content type is not like text/...
 348     my $transaction_content_obj = $self->TransactionObj->ContentObj;
 349
 350     if (   $transaction_content_obj
 351         && $transaction_content_obj->ContentType =~ m{text/}i )
 352     {
 353         # If this was part of a multipart/alternative, skip all of the kids
 354         my $parent = $transaction_content_obj->ParentObj;
 355         if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
 356             $attachments->Limit(
 357                 ENTRYAGGREGATOR => 'AND',
 358                 FIELD           => 'parent',
 359                 OPERATOR        => '!=',
 360                 VALUE           => $parent->Id,
 361             );
 362         } else {
 363             $attachments->Limit(
 364                 ENTRYAGGREGATOR => 'AND',
 365                 FIELD           => 'id',
 366                 OPERATOR        => '!=',
 367                 VALUE           => $transaction_content_obj->Id,
 368             );
 369         }
 370     }
 371
 372     # attach any of this transaction's attachments
 373     my $seen_attachment = 0;
 374     while ( my $attach = $attachments->Next ) {
 375         if ( !$seen_attachment ) {
 376             $MIMEObj->make_multipart( 'mixed', Force => 1 );
 377             $seen_attachment = 1;
 378         }
 379         $self->AddAttachment($attach);
 380     }
 381 }
 382
 383 =head2 AddAttachment $attachment
 384
 385 Takes one attachment object of L<RT::Attachment> class and attaches it to the message
 386 we're building.
 387
 388 =cut
 389
 390 sub AddAttachment {
 391     my $self    = shift;
 392     my $attach  = shift;
 393     my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
 394
 395     # $attach->TransactionObj may not always be $self->TransactionObj
 396     return unless $attach->Id
 397               and $attach->TransactionObj->CurrentUserCanSee;
 398
 399     # ->attach expects just the disposition type; extract it if we have the header
 400     # or default to "attachment"
 401     my $disp = ($attach->GetHeader('Content-Disposition') || '')
 402                     =~ /^\s*(inline|attachment)/i ? $1 : "attachment";
 403
 404     $MIMEObj->attach(
 405         Type        => $attach->ContentType,
 406         Charset     => $attach->OriginalEncoding,
 407         Data        => $attach->OriginalContent,
 408         Disposition => $disp,
 409         Filename    => $self->MIMEEncodeString( $attach->Filename ),
 410         'RT-Attachment:' => $self->TicketObj->Id . "/"
 411             . $self->TransactionObj->Id . "/"
 412             . $attach->id,
 413         Encoding => '-SUGGEST',
 414     );
 415 }
 416
 417 =head2 AttachTickets [@IDs]
 418
 419 Returns or set list of ticket's IDs that should be attached to an outgoing message.
 420
 421 B<Note> this method works as a class method and setup things global, so you have to
 422 clean list by passing undef as argument.
 423
 424 =cut
 425
 426 {
 427     my $list = [];
 428
 429     sub AttachTickets {
 430         my $self = shift;
 431         $list = [ grep defined, @_ ] if @_;
 432         return @$list;
 433     }
 434 }
 435
 436 =head2 AddTickets
 437
 438 Attaches tickets to the current message, list of tickets' ids get from
 439 L</AttachTickets> method.
 440
 441 =cut
 442
 443 sub AddTickets {
 444     my $self = shift;
 445     $self->AddTicket($_) foreach $self->AttachTickets;
 446     return;
 447 }
 448
 449 =head2 AddTicket $ID
 450
 451 Attaches a ticket with ID to the message.
 452
 453 Each ticket is attached as multipart entity and all its messages and attachments
 454 are attached as sub entities in order of creation, but only if transaction type
 455 is Create or Correspond.
 456
 457 =cut
 458
 459 sub AddTicket {
 460     my $self = shift;
 461     my $tid  = shift;
 462
 463     my $attachs   = RT::Attachments->new( $self->TransactionObj->CreatorObj );
 464     my $txn_alias = $attachs->TransactionAlias;
 465     $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
 466     $attachs->Limit(
 467         ALIAS => $txn_alias,
 468         FIELD => 'Type',
 469         VALUE => 'Correspond'
 470     );
 471     $attachs->LimitByTicket($tid);
 472     $attachs->LimitNotEmpty;
 473     $attachs->OrderBy( FIELD => 'Created' );
 474
 475     my $ticket_mime = MIME::Entity->build(
 476         Type        => 'multipart/mixed',
 477         Top         => 0,
 478         Description => "ticket #$tid",
 479     );
 480     while ( my $attachment = $attachs->Next ) {
 481         $self->AddAttachment( $attachment, $ticket_mime );
 482     }
 483     if ( $ticket_mime->parts ) {
 484         my $email_mime = $self->TemplateObj->MIMEObj;
 485         $email_mime->make_multipart;
 486         $email_mime->add_part($ticket_mime);
 487     }
 488     return;
 489 }
 490
 491 =head2 RecordOutgoingMailTransaction MIMEObj
 492
 493 Record a transaction in RT with this outgoing message for future record-keeping purposes
 494
 495 =cut
 496
 497 sub RecordOutgoingMailTransaction {
 498     my $self    = shift;
 499     my $MIMEObj = shift;
 500
 501     my @parts = $MIMEObj->parts;
 502     my @attachments;
 503     my @keep;
 504     foreach my $part (@parts) {
 505         my $attach = $part->head->get('RT-Attachment');
 506         if ($attach) {
 507             $RT::Logger->debug(
 508                 "We found an attachment. we want to not record it.");
 509             push @attachments, $attach;
 510         } else {
 511             $RT::Logger->debug("We found a part. we want to record it.");
 512             push @keep, $part;
 513         }
 514     }
 515     $MIMEObj->parts( \@keep );
 516     foreach my $attachment (@attachments) {
 517         $MIMEObj->head->add( 'RT-Attachment', $attachment );
 518     }
 519
 520     RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
 521
 522     my $transaction
 523         = RT::Transaction->new( $self->TransactionObj->CurrentUser );
 524
 525 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
 526
 527     my $type;
 528     if ( $self->TransactionObj->Type eq 'Comment' ) {
 529         $type = 'CommentEmailRecord';
 530     } else {
 531         $type = 'EmailRecord';
 532     }
 533
 534     my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
 535     chomp $msgid;
 536
 537     my ( $id, $msg ) = $transaction->Create(
 538         Ticket         => $self->TicketObj->Id,
 539         Type           => $type,
 540         Data           => $msgid,
 541         MIMEObj        => $MIMEObj,
 542         ActivateScrips => 0
 543     );
 544
 545     if ($id) {
 546         $self->{'OutgoingMailTransaction'} = $id;
 547     } else {
 548         $RT::Logger->warning(
 549             "Could not record outgoing message transaction: $msg");
 550     }
 551     return $id;
 552 }
 553
 554 =head2 SetRTSpecialHeaders
 555
 556 This routine adds all the random headers that RT wants in a mail message
 557 that don't matter much to anybody else.
 558
 559 =cut
 560
 561 sub SetRTSpecialHeaders {
 562     my $self = shift;
 563
 564     $self->SetSubject();
 565     $self->SetSubjectToken();
 566     $self->SetHeaderAsEncoding( 'Subject',
 567         RT->Config->Get('EmailOutputEncoding') )
 568         if ( RT->Config->Get('EmailOutputEncoding') );
 569     $self->SetReturnAddress();
 570     $self->SetReferencesHeaders();
 571
 572     unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
 573
 574         # Get Message-ID for this txn
 575         my $msgid = "";
 576         if ( my $msg = $self->TransactionObj->Message->First ) {
 577             $msgid = $msg->GetHeader("RT-Message-ID")
 578                 || $msg->GetHeader("Message-ID");
 579         }
 580
 581         # If there is one, and we can parse it, then base our Message-ID on it
 582         if (    $msgid
 583             and $msgid
 584             =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
 585                          "<$1." . $self->TicketObj->id
 586                           . "-" . $self->ScripObj->id
 587                           . "-" . $self->ScripActionObj->{_Message_ID}
 588                           . "@" . RT->Config->Get('Organization') . ">"/eg
 589             and $2 == $self->TicketObj->id
 590             )
 591         {
 592             $self->SetHeader( "Message-ID" => $msgid );
 593         } else {
 594             $self->SetHeader(
 595                 'Message-ID' => RT::Interface::Email::GenMessageId(
 596                     Ticket      => $self->TicketObj,
 597                     Scrip       => $self->ScripObj,
 598                     ScripAction => $self->ScripActionObj
 599                 ),
 600             );
 601         }
 602     }
 603
 604     if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
 605         and !$self->TemplateObj->MIMEObj->head->get("Precedence")
 606     ) {
 607         $self->SetHeader( 'Precedence', $precedence );
 608     }
 609
 610     $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
 611     $self->SetHeader( 'RT-Ticket',
 612         RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
 613     $self->SetHeader( 'Managed-by',
 614         "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
 615
 616 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
 617 #            refactored into user's method.
 618     if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
 619          and ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator")
 620          and RT->Config->Get('UseOriginatorHeader')
 621     ) {
 622         $self->SetHeader( 'RT-Originator', $email );
 623     }
 624
 625 }
 626
 627
 628 sub DeferDigestRecipients {
 629     my $self = shift;
 630     $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
 631
 632     # The digest attribute will be an array of notifications that need to
 633     # be sent for this transaction.  The array will have the following
 634     # format for its objects.
 635     # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
 636     #                                     -> sent -> {true|false}
 637     # The "sent" flag will be used by the cron job to indicate that it has
 638     # run on this transaction.
 639     # In a perfect world we might move this hash construction to the
 640     # extension module itself.
 641     my $digest_hash = {};
 642
 643     foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
 644         # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
 645         next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
 646         $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
 647
 648         # Store the 'daily digest' folk in an array.
 649         my ( @send_now, @daily_digest, @weekly_digest, @suspended );
 650
 651         # Have to get the list of addresses directly from the MIME header
 652         # at this point.
 653         $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) );
 654         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
 655             next unless $rcpt;
 656             my $user_obj = RT::User->new(RT->SystemUser);
 657             $user_obj->LoadByEmail($rcpt);
 658             if  ( ! $user_obj->id ) {
 659                 # If there's an email address in here without an associated
 660                 # RT user, pass it on through.
 661                 $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
 662                 push( @send_now, $rcpt );
 663                 next;
 664             }
 665
 666             my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
 667             $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
 668
 669             if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
 670             elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
 671             elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
 672             else { push( @send_now, $rcpt ) }
 673         }
 674
 675         # Reset the relevant mail field.
 676         $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
 677         if (@send_now) {
 678             $self->SetHeader( $mailfield, join( ', ', @send_now ) );
 679         } else {    # No recipients!  Remove the header.
 680             $self->TemplateObj->MIMEObj->head->delete($mailfield);
 681         }
 682
 683         # Push the deferred addresses into the appropriate field in
 684         # our attribute hash, with the appropriate mail header.
 685         $RT::Logger->debug(
 686             "Setting deferred recipients for attribute creation");
 687         $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
 688         $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
 689         $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
 690     }
 691
 692     if ( scalar keys %$digest_hash ) {
 693
 694         # Save the hash so that we can add it as an attribute to the
 695         # outgoing email transaction.
 696         $self->{'Deferred'} = $digest_hash;
 697     } else {
 698         $RT::Logger->debug( "No recipients found for deferred delivery on "
 699                 . "transaction #"
 700                 . $self->TransactionObj->id );
 701     }
 702 }
 703
 704
 705
 706 sub RecordDeferredRecipients {
 707     my $self = shift;
 708     return unless exists $self->{'Deferred'};
 709
 710     my $txn_id = $self->{'OutgoingMailTransaction'};
 711     return unless $txn_id;
 712
 713     my $txn_obj = RT::Transaction->new( $self->CurrentUser );
 714     $txn_obj->Load( $txn_id );
 715     my( $ret, $msg ) = $txn_obj->AddAttribute(
 716         Name => 'DeferredRecipients',
 717         Content => $self->{'Deferred'}
 718     );
 719     $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
 720         unless $ret;
 721
 722     return ($ret,$msg);
 723 }
 724
 725 =head2 SquelchMailTo
 726
 727 Returns list of the addresses to squelch on this transaction.
 728
 729 =cut
 730
 731 sub SquelchMailTo {
 732     my $self = shift;
 733     return map $_->Content, $self->TransactionObj->SquelchMailTo;
 734 }
 735
 736 =head2 RemoveInappropriateRecipients
 737
 738 Remove addresses that are RT addresses or that are on this transaction's blacklist
 739
 740 =cut
 741
 742 sub RemoveInappropriateRecipients {
 743     my $self = shift;
 744
 745     my @blacklist = ();
 746
 747     # If there are no recipients, don't try to send the message.
 748     # If the transaction has content and has the header RT-Squelch-Replies-To
 749
 750     my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') );
 751     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
 752
 753         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
 754
 755             # What do we want to do with this? It's probably (?) a bounce
 756             # caused by one of the watcher addresses being broken.
 757             # Default ("true") is to redistribute, for historical reasons.
 758
 759             if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
 760
 761                 # Don't send to any watchers.
 762                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
 763                 $RT::Logger->info( $msgid
 764                         . " The incoming message was autogenerated. "
 765                         . "Not redistributing this message based on site configuration."
 766                 );
 767             } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
 768                 'privileged' )
 769             {
 770
 771                 # Only send to "privileged" watchers.
 772                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 773                     foreach my $addr ( @{ $self->{$type} } ) {
 774                         my $user = RT::User->new(RT->SystemUser);
 775                         $user->LoadByEmail($addr);
 776                         push @blacklist, $addr unless $user->id && $user->Privileged;
 777                     }
 778                 }
 779                 $RT::Logger->info( $msgid
 780                         . " The incoming message was autogenerated. "
 781                         . "Not redistributing this message to unprivileged users based on site configuration."
 782                 );
 783             }
 784         }
 785
 786         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
 787             push @blacklist, split( /,/, $squelch );
 788         }
 789     }
 790
 791     # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
 792     push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
 793
 794     # Cycle through the people we're sending to and pull out anyone on the
 795     # system blacklist
 796
 797     # Trim leading and trailing spaces.
 798     @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
 799         Email::Address->parse( join ', ', grep defined, @blacklist );
 800
 801     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
 802         my @addrs;
 803         foreach my $addr ( @{ $self->{$type} } ) {
 804
 805          # Weed out any RT addresses. We really don't want to talk to ourselves!
 806          # If we get a reply back, that means it's not an RT address
 807             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 808                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 809                 next;
 810             }
 811             if ( grep $addr eq $_, @blacklist ) {
 812                 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
 813                 next;
 814             }
 815             push @addrs, $addr;
 816         }
 817         foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
 818             # never send email to itself
 819             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
 820                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
 821                 next;
 822             }
 823             push @addrs, $addr;
 824         }
 825         @{ $self->{$type} } = @addrs;
 826     }
 827 }
 828
 829 =head2 SetReturnAddress is_comment => BOOLEAN
 830
 831 Calculate and set From and Reply-To headers based on the is_comment flag.
 832
 833 =cut
 834
 835 sub SetReturnAddress {
 836
 837     my $self = shift;
 838     my %args = (
 839         is_comment => 0,
 840         friendly_name => undef,
 841         @_
 842     );
 843
 844     # From and Reply-To
 845     # $args{is_comment} should be set if the comment address is to be used.
 846     my $replyto;
 847
 848     if ( $args{'is_comment'} ) {
 849         $replyto = $self->TicketObj->QueueObj->CommentAddress
 850             || RT->Config->Get('CommentAddress');
 851     } else {
 852         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
 853             || RT->Config->Get('CorrespondAddress');
 854     }
 855
 856     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
 857         $self->SetFrom( %args, From => $replyto );
 858     }
 859
 860     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
 861         $self->SetHeader( 'Reply-To', "$replyto" );
 862     }
 863
 864 }
 865
 866 =head2 SetFrom ( From => emailaddress )
 867
 868 Set the From: address for outgoing email
 869
 870 =cut
 871
 872 sub SetFrom {
 873     my $self = shift;
 874     my %args = @_;
 875
 876     my $from = $args{From};
 877
 878     if ( RT->Config->Get('UseFriendlyFromLine') ) {
 879         my $friendly_name = $self->GetFriendlyName(%args);
 880         $from =
 881             sprintf(
 882                 RT->Config->Get('FriendlyFromLineFormat'),
 883                 $self->MIMEEncodeString(
 884                     $friendly_name, RT->Config->Get('EmailOutputEncoding')
 885                 ),
 886                 $args{From}
 887             );
 888     }
 889
 890     $self->SetHeader( 'From', $from );
 891
 892     #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine,
 893     #and then Outlook prepends "rt@machine on behalf of" to the From: header
 894     $self->SetHeader( 'Sender', $from );
 895 }
 896
 897 =head2 GetFriendlyName
 898
 899 Calculate the proper Friendly Name based on the creator of the transaction
 900
 901 =cut
 902
 903 sub GetFriendlyName {
 904     my $self = shift;
 905     my %args = (
 906         is_comment => 0,
 907         friendly_name => '',
 908         @_
 909     );
 910     my $friendly_name = $args{friendly_name};
 911
 912     unless ( $friendly_name ) {
 913         $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
 914         if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
 915             $friendly_name = $1;
 916         }
 917     }
 918
 919     $friendly_name =~ s/"/\\"/g;
 920     return $friendly_name;
 921
 922 }
 923
 924 =head2 SetHeader FIELD, VALUE
 925
 926 Set the FIELD of the current MIME object into VALUE, which should be in
 927 characters, not bytes.  Returns the new header, in bytes.
 928
 929 =cut
 930
 931 sub SetHeader {
 932     my $self  = shift;
 933     my $field = shift;
 934     my $val   = shift;
 935
 936     chomp $val;
 937     chomp $field;
 938     my $head = $self->TemplateObj->MIMEObj->head;
 939     $head->fold_length( $field, 10000 );
 940     $head->replace( $field, Encode::encode( "UTF-8", $val ) );
 941     return $head->get($field);
 942 }
 943
 944 =head2 SetSubject
 945
 946 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
 947 If subject is already defined via template, it uses that. otherwise, it tries to get
 948 the transaction's subject.
 949
 950 =cut
 951
 952 sub SetSubject {
 953     my $self = shift;
 954     my $subject;
 955
 956     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
 957         return ();
 958     }
 959
 960     # don't use Transaction->Attachments because it caches
 961     # and anything which later calls ->Attachments will be hurt
 962     # by our RowsPerPage() call.  caching is hard.
 963     my $message = RT::Attachments->new( $self->CurrentUser );
 964     $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
 965     $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
 966     $message->RowsPerPage(1);
 967
 968     if ( $self->{'Subject'} ) {
 969         $subject = $self->{'Subject'};
 970     } elsif ( my $first = $message->First ) {
 971         my $tmp = $first->GetHeader('Subject');
 972         $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
 973     } else {
 974         $subject = $self->TicketObj->Subject;
 975     }
 976     $subject = '' unless defined $subject;
 977     chomp $subject;
 978
 979     $subject =~ s/(\r\n|\n|\s)/ /g;
 980
 981     $self->SetHeader( 'Subject', $subject );
 982
 983 }
 984
 985 =head2 SetSubjectToken
 986
 987 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
 988
 989 =cut
 990
 991 sub SetSubjectToken {
 992     my $self = shift;
 993
 994     my $head = $self->TemplateObj->MIMEObj->head;
 995     $self->SetHeader(
 996         Subject =>
 997             RT::Interface::Email::AddSubjectTag(
 998                 Encode::decode( "UTF-8", $head->get('Subject') ),
 999                 $self->TicketObj,
1000             ),
1001     );
1002 }
1003
1004 =head2 SetReferencesHeaders
1005
1006 Set References and In-Reply-To headers for this message.
1007
1008 =cut
1009
1010 sub SetReferencesHeaders {
1011     my $self = shift;
1012
1013     my $top = $self->TransactionObj->Message->First;
1014     unless ( $top ) {
1015         $self->SetHeader( References => $self->PseudoReference );
1016         return (undef);
1017     }
1018
1019     my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1020     my @references  = split( /\s+/m, $top->GetHeader('References')  || '' );
1021     my @msgid       = split( /\s+/m, $top->GetHeader('Message-ID')  || '' );
1022
1023     # There are two main cases -- this transaction was created with
1024     # the RT Web UI, and hence we want to *not* append its Message-ID
1025     # to the References and In-Reply-To.  OR it came from an outside
1026     # source, and we should treat it as per the RFC
1027     my $org = RT->Config->Get('Organization');
1028     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1029
1030         # Make all references which are internal be to version which we
1031         # have sent out
1032
1033         for ( @references, @in_reply_to ) {
1034             s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1035           "<$1." . $self->TicketObj->id .
1036              "-" . $self->ScripObj->id .
1037              "-" . $self->ScripActionObj->{_Message_ID} .
1038              "@" . $org . ">"/eg
1039         }
1040
1041         # In reply to whatever the internal message was in reply to
1042         $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1043
1044         # Default the references to whatever we're in reply to
1045         @references = @in_reply_to unless @references;
1046
1047         # References are unchanged from internal
1048     } else {
1049
1050         # In reply to that message
1051         $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1052
1053         # Default the references to whatever we're in reply to
1054         @references = @in_reply_to unless @references;
1055
1056         # Push that message onto the end of the references
1057         push @references, @msgid;
1058     }
1059
1060     # Push pseudo-ref to the front
1061     my $pseudo_ref = $self->PseudoReference;
1062     @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1063
1064     # If there are more than 10 references headers, remove all but the
1065     # first four and the last six (Gotta keep this from growing
1066     # forever)
1067     splice( @references, 4, -6 ) if ( $#references >= 10 );
1068
1069     # Add on the references
1070     $self->SetHeader( 'References', join( " ", @references ) );
1071     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1072
1073 }
1074
1075 =head2 PseudoReference
1076
1077 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1078
1079 =cut
1080
1081 sub PseudoReference {
1082
1083     my $self = shift;
1084     my $pseudo_ref
1085         = '<RT-Ticket-'
1086         . $self->TicketObj->id . '@'
1087         . RT->Config->Get('Organization') . '>';
1088     return $pseudo_ref;
1089 }
1090
1091 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1092
1093 This routine converts the field into specified charset encoding, then
1094 applies the MIME-Header transfer encoding.
1095
1096 =cut
1097
1098 sub SetHeaderAsEncoding {
1099     my $self = shift;
1100     my ( $field, $enc ) = ( shift, shift );
1101
1102     my $head = $self->TemplateObj->MIMEObj->head;
1103
1104     if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1105         $head->replace( $field, Encode::encode( "UTF-8", RT->Config->Get('SMTPFrom') ) );
1106         return;
1107     }
1108
1109     my $value = Encode::decode("UTF-8", $head->get( $field ));
1110     $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes
1111     $head->replace( $field, $value );
1112
1113 }
1114
1115 =head2 MIMEEncodeString
1116
1117 Takes a perl string and optional encoding pass it over
1118 L<RT::Interface::Email/EncodeToMIME>.
1119
1120 Basicly encode a string using B encoding according to RFC2047, returning
1121 bytes.
1122
1123 =cut
1124
1125 sub MIMEEncodeString {
1126     my $self  = shift;
1127     return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1128 }
1129
1130 RT::Base->_ImportOverlays();
1131
1132 1;
1133