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