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