Upgrade 4.0.17 clean.
[usit-rt.git] / lib / RT / Action / SendEmail.pm
1 # BEGIN BPS TAGGED BLOCK {{{
2 #
3 # COPYRIGHT:
4 #
5 # This software is Copyright (c) 1996-2013 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    = $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 = $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 = $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 = $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 RT->Config->Get('UseOriginatorHeader')
620     ) {
621         $self->SetHeader( 'RT-Originator', $email );
622     }
623
624 }
625
626
627 sub DeferDigestRecipients {
628     my $self = shift;
629     $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
630
631     # The digest attribute will be an array of notifications that need to
632     # be sent for this transaction.  The array will have the following
633     # format for its objects.
634     # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
635     #                                     -> sent -> {true|false}
636     # The "sent" flag will be used by the cron job to indicate that it has
637     # run on this transaction.
638     # In a perfect world we might move this hash construction to the
639     # extension module itself.
640     my $digest_hash = {};
641
642     foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
643         # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
644         next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
645         $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
646
647         # Store the 'daily digest' folk in an array.
648         my ( @send_now, @daily_digest, @weekly_digest, @suspended );
649
650         # Have to get the list of addresses directly from the MIME header
651         # at this point.
652         $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
653         foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
654             next unless $rcpt;
655             my $user_obj = RT::User->new(RT->SystemUser);
656             $user_obj->LoadByEmail($rcpt);
657             if  ( ! $user_obj->id ) {
658                 # If there's an email address in here without an associated
659                 # RT user, pass it on through.
660                 $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
661                 push( @send_now, $rcpt );
662                 next;
663             }
664
665             my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
666             $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
667
668             if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
669             elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
670             elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
671             else { push( @send_now, $rcpt ) }
672         }
673
674         # Reset the relevant mail field.
675         $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
676         if (@send_now) {
677             $self->SetHeader( $mailfield, join( ', ', @send_now ) );
678         } else {    # No recipients!  Remove the header.
679             $self->TemplateObj->MIMEObj->head->delete($mailfield);
680         }
681
682         # Push the deferred addresses into the appropriate field in
683         # our attribute hash, with the appropriate mail header.
684         $RT::Logger->debug(
685             "Setting deferred recipients for attribute creation");
686         $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
687         $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
688         $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
689     }
690
691     if ( scalar keys %$digest_hash ) {
692
693         # Save the hash so that we can add it as an attribute to the
694         # outgoing email transaction.
695         $self->{'Deferred'} = $digest_hash;
696     } else {
697         $RT::Logger->debug( "No recipients found for deferred delivery on "
698                 . "transaction #"
699                 . $self->TransactionObj->id );
700     }
701 }
702
703
704     
705 sub RecordDeferredRecipients {
706     my $self = shift;
707     return unless exists $self->{'Deferred'};
708
709     my $txn_id = $self->{'OutgoingMailTransaction'};
710     return unless $txn_id;
711
712     my $txn_obj = RT::Transaction->new( $self->CurrentUser );
713     $txn_obj->Load( $txn_id );
714     my( $ret, $msg ) = $txn_obj->AddAttribute(
715         Name => 'DeferredRecipients',
716         Content => $self->{'Deferred'}
717     );
718     $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) 
719         unless $ret;
720
721     return ($ret,$msg);
722 }
723
724 =head2 SquelchMailTo
725
726 Returns list of the addresses to squelch on this transaction.
727
728 =cut
729
730 sub SquelchMailTo {
731     my $self = shift;
732     return map $_->Content, $self->TransactionObj->SquelchMailTo;
733 }
734
735 =head2 RemoveInappropriateRecipients
736
737 Remove addresses that are RT addresses or that are on this transaction's blacklist
738
739 =cut
740
741 sub RemoveInappropriateRecipients {
742     my $self = shift;
743
744     my @blacklist = ();
745
746     # If there are no recipients, don't try to send the message.
747     # If the transaction has content and has the header RT-Squelch-Replies-To
748
749     my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
750     if ( my $attachment = $self->TransactionObj->Attachments->First ) {
751
752         if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
753
754             # What do we want to do with this? It's probably (?) a bounce
755             # caused by one of the watcher addresses being broken.
756             # Default ("true") is to redistribute, for historical reasons.
757
758             if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
759
760                 # Don't send to any watchers.
761                 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
762                 $RT::Logger->info( $msgid
763                         . " The incoming message was autogenerated. "
764                         . "Not redistributing this message based on site configuration."
765                 );
766             } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
767                 'privileged' )
768             {
769
770                 # Only send to "privileged" watchers.
771                 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
772                     foreach my $addr ( @{ $self->{$type} } ) {
773                         my $user = RT::User->new(RT->SystemUser);
774                         $user->LoadByEmail($addr);
775                         push @blacklist, $addr unless $user->id && $user->Privileged;
776                     }
777                 }
778                 $RT::Logger->info( $msgid
779                         . " The incoming message was autogenerated. "
780                         . "Not redistributing this message to unprivileged users based on site configuration."
781                 );
782             }
783         }
784
785         if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
786             push @blacklist, split( /,/, $squelch );
787         }
788     }
789
790     # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
791     push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
792
793     # Cycle through the people we're sending to and pull out anyone on the
794     # system blacklist
795
796     # Trim leading and trailing spaces. 
797     @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
798         Email::Address->parse( join ', ', grep defined, @blacklist );
799
800     foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
801         my @addrs;
802         foreach my $addr ( @{ $self->{$type} } ) {
803
804          # Weed out any RT addresses. We really don't want to talk to ourselves!
805          # If we get a reply back, that means it's not an RT address
806             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
807                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
808                 next;
809             }
810             if ( grep $addr eq $_, @blacklist ) {
811                 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
812                 next;
813             }
814             push @addrs, $addr;
815         }
816         foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
817             # never send email to itself
818             if ( !RT::EmailParser->CullRTAddresses($addr) ) {
819                 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
820                 next;
821             }
822             push @addrs, $addr;
823         }
824         @{ $self->{$type} } = @addrs;
825     }
826 }
827
828 =head2 SetReturnAddress is_comment => BOOLEAN
829
830 Calculate and set From and Reply-To headers based on the is_comment flag.
831
832 =cut
833
834 sub SetReturnAddress {
835
836     my $self = shift;
837     my %args = (
838         is_comment => 0,
839         friendly_name => undef,
840         @_
841     );
842
843     # From and Reply-To
844     # $args{is_comment} should be set if the comment address is to be used.
845     my $replyto;
846
847     if ( $args{'is_comment'} ) {
848         $replyto = $self->TicketObj->QueueObj->CommentAddress
849             || RT->Config->Get('CommentAddress');
850     } else {
851         $replyto = $self->TicketObj->QueueObj->CorrespondAddress
852             || RT->Config->Get('CorrespondAddress');
853     }
854
855     unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
856         $self->SetFrom( %args, From => $replyto );
857     }
858
859     unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
860         $self->SetHeader( 'Reply-To', "$replyto" );
861     }
862
863 }
864
865 =head2 SetFrom ( From => emailaddress )
866
867 Set the From: address for outgoing email
868
869 =cut
870
871 sub SetFrom {
872     my $self = shift;
873     my %args = @_;
874
875     if ( RT->Config->Get('UseFriendlyFromLine') ) {
876         my $friendly_name = $self->GetFriendlyName(%args);
877         $self->SetHeader(
878             'From',
879             sprintf(
880                 RT->Config->Get('FriendlyFromLineFormat'),
881                 $self->MIMEEncodeString(
882                     $friendly_name, RT->Config->Get('EmailOutputEncoding')
883                 ),
884                 $args{From}
885             ),
886         );
887     } else {
888         $self->SetHeader( 'From', $args{From} );
889     }
890 }
891
892 =head2 GetFriendlyName
893
894 Calculate the proper Friendly Name based on the creator of the transaction
895
896 =cut
897
898 sub GetFriendlyName {
899     my $self = shift;
900     my %args = (
901         is_comment => 0,
902         friendly_name => '',
903         @_
904     );
905     my $friendly_name = $args{friendly_name};
906
907     unless ( $friendly_name ) {
908         $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
909         if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
910             $friendly_name = $1;
911         }
912     }
913
914     $friendly_name =~ s/"/\\"/g;
915     return $friendly_name;
916
917 }
918
919 =head2 SetHeader FIELD, VALUE
920
921 Set the FIELD of the current MIME object into VALUE.
922
923 =cut
924
925 sub SetHeader {
926     my $self  = shift;
927     my $field = shift;
928     my $val   = shift;
929
930     chomp $val;
931     chomp $field;
932     my $head = $self->TemplateObj->MIMEObj->head;
933     $head->fold_length( $field, 10000 );
934     $head->replace( $field, $val );
935     return $head->get($field);
936 }
937
938 =head2 SetSubject
939
940 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
941 If subject is already defined via template, it uses that. otherwise, it tries to get
942 the transaction's subject.
943
944 =cut 
945
946 sub SetSubject {
947     my $self = shift;
948     my $subject;
949
950     if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
951         return ();
952     }
953
954     # don't use Transaction->Attachments because it caches
955     # and anything which later calls ->Attachments will be hurt
956     # by our RowsPerPage() call.  caching is hard.
957     my $message = RT::Attachments->new( $self->CurrentUser );
958     $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
959     $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
960     $message->RowsPerPage(1);
961
962     if ( $self->{'Subject'} ) {
963         $subject = $self->{'Subject'};
964     } elsif ( my $first = $message->First ) {
965         my $tmp = $first->GetHeader('Subject');
966         $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
967     } else {
968         $subject = $self->TicketObj->Subject;
969     }
970     $subject = '' unless defined $subject;
971     chomp $subject;
972
973     $subject =~ s/(\r\n|\n|\s)/ /g;
974
975     $self->SetHeader( 'Subject', $subject );
976
977 }
978
979 =head2 SetSubjectToken
980
981 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
982
983 =cut
984
985 sub SetSubjectToken {
986     my $self = shift;
987
988     my $head = $self->TemplateObj->MIMEObj->head;
989     $head->replace(
990         Subject => RT::Interface::Email::AddSubjectTag(
991             Encode::decode_utf8( $head->get('Subject') ),
992             $self->TicketObj,
993         ),
994     );
995 }
996
997 =head2 SetReferencesHeaders
998
999 Set References and In-Reply-To headers for this message.
1000
1001 =cut
1002
1003 sub SetReferencesHeaders {
1004     my $self = shift;
1005
1006     my $top = $self->TransactionObj->Message->First;
1007     unless ( $top ) {
1008         $self->SetHeader( References => $self->PseudoReference );
1009         return (undef);
1010     }
1011
1012     my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1013     my @references  = split( /\s+/m, $top->GetHeader('References')  || '' );
1014     my @msgid       = split( /\s+/m, $top->GetHeader('Message-ID')  || '' );
1015
1016     # There are two main cases -- this transaction was created with
1017     # the RT Web UI, and hence we want to *not* append its Message-ID
1018     # to the References and In-Reply-To.  OR it came from an outside
1019     # source, and we should treat it as per the RFC
1020     my $org = RT->Config->Get('Organization');
1021     if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1022
1023         # Make all references which are internal be to version which we
1024         # have sent out
1025
1026         for ( @references, @in_reply_to ) {
1027             s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1028           "<$1." . $self->TicketObj->id .
1029              "-" . $self->ScripObj->id .
1030              "-" . $self->ScripActionObj->{_Message_ID} .
1031              "@" . $org . ">"/eg
1032         }
1033
1034         # In reply to whatever the internal message was in reply to
1035         $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1036
1037         # Default the references to whatever we're in reply to
1038         @references = @in_reply_to unless @references;
1039
1040         # References are unchanged from internal
1041     } else {
1042
1043         # In reply to that message
1044         $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1045
1046         # Default the references to whatever we're in reply to
1047         @references = @in_reply_to unless @references;
1048
1049         # Push that message onto the end of the references
1050         push @references, @msgid;
1051     }
1052
1053     # Push pseudo-ref to the front
1054     my $pseudo_ref = $self->PseudoReference;
1055     @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1056
1057     # If there are more than 10 references headers, remove all but the
1058     # first four and the last six (Gotta keep this from growing
1059     # forever)
1060     splice( @references, 4, -6 ) if ( $#references >= 10 );
1061
1062     # Add on the references
1063     $self->SetHeader( 'References', join( " ", @references ) );
1064     $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1065
1066 }
1067
1068 =head2 PseudoReference
1069
1070 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1071
1072 =cut
1073
1074 sub PseudoReference {
1075
1076     my $self = shift;
1077     my $pseudo_ref
1078         = '<RT-Ticket-'
1079         . $self->TicketObj->id . '@'
1080         . RT->Config->Get('Organization') . '>';
1081     return $pseudo_ref;
1082 }
1083
1084 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1085
1086 This routine converts the field into specified charset encoding.
1087
1088 =cut
1089
1090 sub SetHeaderAsEncoding {
1091     my $self = shift;
1092     my ( $field, $enc ) = ( shift, shift );
1093
1094     my $head = $self->TemplateObj->MIMEObj->head;
1095
1096     if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1097         $head->replace( $field, RT->Config->Get('SMTPFrom') );
1098         return;
1099     }
1100
1101     my $value = $head->get( $field );
1102     $value = $self->MIMEEncodeString( $value, $enc );
1103     $head->replace( $field, $value );
1104
1105 }
1106
1107 =head2 MIMEEncodeString
1108
1109 Takes a perl string and optional encoding pass it over
1110 L<RT::Interface::Email/EncodeToMIME>.
1111
1112 Basicly encode a string using B encoding according to RFC2047.
1113
1114 =cut
1115
1116 sub MIMEEncodeString {
1117     my $self  = shift;
1118     return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1119 }
1120
1121 RT::Base->_ImportOverlays();
1122
1123 1;
1124