Upgrade to 4.0.10.
[usit-rt.git] / lib / RT / Action / SendEmail.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
403d7b0b 5# This software is Copyright (c) 1996-2013 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
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
226Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
227
228=cut
229
230sub To {
231 my $self = shift;
232 return ( $self->AddressesFromHeader('To') );
233}
234
235=head2 Cc
236
237Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
238
239=cut
240
241sub Cc {
242 my $self = shift;
243 return ( $self->AddressesFromHeader('Cc') );
244}
245
246=head2 Bcc
247
248Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
249
250=cut
251
252sub Bcc {
253 my $self = shift;
254 return ( $self->AddressesFromHeader('Bcc') );
255
256}
257
258sub 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
269sends the message using RT's preferred API.
270TODO: Break this out to a separate module
271
272=cut
273
274sub 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
323Takes any attachments to this transaction and attaches them to the message
324we're building.
325
326=cut
327
328sub AddAttachments {
329 my $self = shift;
330
331 my $MIMEObj = $self->TemplateObj->MIMEObj;
332
333 $MIMEObj->head->delete('RT-Attach-Message');
334
35ef43cf 335 my $attachments = RT::Attachments->new( RT->SystemUser );
84fb5b46
MKG
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
385Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
386we're building.
387
388=cut
389
390sub 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 my $disp = ($attach->GetHeader('Content-Disposition') || '')
401 =~ /^\s*(inline|attachment)/i ? $1 : undef;
402
403 $MIMEObj->attach(
404 Type => $attach->ContentType,
405 Charset => $attach->OriginalEncoding,
406 Data => $attach->OriginalContent,
407 Disposition => $disp, # a false value defaults to inline in MIME::Entity
408 Filename => $self->MIMEEncodeString( $attach->Filename ),
409 'RT-Attachment:' => $self->TicketObj->Id . "/"
410 . $self->TransactionObj->Id . "/"
411 . $attach->id,
412 Encoding => '-SUGGEST',
413 );
414}
415
416=head2 AttachTickets [@IDs]
417
418Returns or set list of ticket's IDs that should be attached to an outgoing message.
419
420B<Note> this method works as a class method and setup things global, so you have to
421clean list by passing undef as argument.
422
423=cut
424
425{
426 my $list = [];
427
428 sub AttachTickets {
429 my $self = shift;
430 $list = [ grep defined, @_ ] if @_;
431 return @$list;
432 }
433}
434
435=head2 AddTickets
436
437Attaches tickets to the current message, list of tickets' ids get from
438L</AttachTickets> method.
439
440=cut
441
442sub AddTickets {
443 my $self = shift;
444 $self->AddTicket($_) foreach $self->AttachTickets;
445 return;
446}
447
448=head2 AddTicket $ID
449
450Attaches a ticket with ID to the message.
451
452Each ticket is attached as multipart entity and all its messages and attachments
453are attached as sub entities in order of creation, but only if transaction type
454is Create or Correspond.
455
456=cut
457
458sub AddTicket {
459 my $self = shift;
460 my $tid = shift;
461
462 my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj );
463 my $txn_alias = $attachs->TransactionAlias;
464 $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
465 $attachs->Limit(
466 ALIAS => $txn_alias,
467 FIELD => 'Type',
468 VALUE => 'Correspond'
469 );
470 $attachs->LimitByTicket($tid);
471 $attachs->LimitNotEmpty;
472 $attachs->OrderBy( FIELD => 'Created' );
473
474 my $ticket_mime = MIME::Entity->build(
475 Type => 'multipart/mixed',
476 Top => 0,
477 Description => "ticket #$tid",
478 );
479 while ( my $attachment = $attachs->Next ) {
480 $self->AddAttachment( $attachment, $ticket_mime );
481 }
482 if ( $ticket_mime->parts ) {
483 my $email_mime = $self->TemplateObj->MIMEObj;
484 $email_mime->make_multipart;
485 $email_mime->add_part($ticket_mime);
486 }
487 return;
488}
489
490=head2 RecordOutgoingMailTransaction MIMEObj
491
492Record a transaction in RT with this outgoing message for future record-keeping purposes
493
494=cut
495
496sub RecordOutgoingMailTransaction {
497 my $self = shift;
498 my $MIMEObj = shift;
499
500 my @parts = $MIMEObj->parts;
501 my @attachments;
502 my @keep;
503 foreach my $part (@parts) {
504 my $attach = $part->head->get('RT-Attachment');
505 if ($attach) {
506 $RT::Logger->debug(
507 "We found an attachment. we want to not record it.");
508 push @attachments, $attach;
509 } else {
510 $RT::Logger->debug("We found a part. we want to record it.");
511 push @keep, $part;
512 }
513 }
514 $MIMEObj->parts( \@keep );
515 foreach my $attachment (@attachments) {
516 $MIMEObj->head->add( 'RT-Attachment', $attachment );
517 }
518
519 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
520
521 my $transaction
522 = RT::Transaction->new( $self->TransactionObj->CurrentUser );
523
524# XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
525
526 my $type;
527 if ( $self->TransactionObj->Type eq 'Comment' ) {
528 $type = 'CommentEmailRecord';
529 } else {
530 $type = 'EmailRecord';
531 }
532
533 my $msgid = $MIMEObj->head->get('Message-ID');
534 chomp $msgid;
535
536 my ( $id, $msg ) = $transaction->Create(
537 Ticket => $self->TicketObj->Id,
538 Type => $type,
539 Data => $msgid,
540 MIMEObj => $MIMEObj,
541 ActivateScrips => 0
542 );
543
544 if ($id) {
545 $self->{'OutgoingMailTransaction'} = $id;
546 } else {
547 $RT::Logger->warning(
548 "Could not record outgoing message transaction: $msg");
549 }
550 return $id;
551}
552
553=head2 SetRTSpecialHeaders
554
555This routine adds all the random headers that RT wants in a mail message
556that don't matter much to anybody else.
557
558=cut
559
560sub SetRTSpecialHeaders {
561 my $self = shift;
562
563 $self->SetSubject();
564 $self->SetSubjectToken();
565 $self->SetHeaderAsEncoding( 'Subject',
566 RT->Config->Get('EmailOutputEncoding') )
567 if ( RT->Config->Get('EmailOutputEncoding') );
568 $self->SetReturnAddress();
569 $self->SetReferencesHeaders();
570
571 unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
572
573 # Get Message-ID for this txn
574 my $msgid = "";
575 if ( my $msg = $self->TransactionObj->Message->First ) {
576 $msgid = $msg->GetHeader("RT-Message-ID")
577 || $msg->GetHeader("Message-ID");
578 }
579
580 # If there is one, and we can parse it, then base our Message-ID on it
581 if ( $msgid
582 and $msgid
583 =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
584 "<$1." . $self->TicketObj->id
585 . "-" . $self->ScripObj->id
586 . "-" . $self->ScripActionObj->{_Message_ID}
587 . "@" . RT->Config->Get('Organization') . ">"/eg
588 and $2 == $self->TicketObj->id
589 )
590 {
591 $self->SetHeader( "Message-ID" => $msgid );
592 } else {
593 $self->SetHeader(
594 'Message-ID' => RT::Interface::Email::GenMessageId(
595 Ticket => $self->TicketObj,
596 Scrip => $self->ScripObj,
597 ScripAction => $self->ScripActionObj
598 ),
599 );
600 }
601 }
602
603 if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
604 and !$self->TemplateObj->MIMEObj->head->get("Precedence")
605 ) {
606 $self->SetHeader( 'Precedence', $precedence );
607 }
608
609 $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
610 $self->SetHeader( 'RT-Ticket',
611 RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
612 $self->SetHeader( 'Managed-by',
613 "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
614
615# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
616# refactored into user's method.
617 if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
618 and RT->Config->Get('UseOriginatorHeader')
619 ) {
620 $self->SetHeader( 'RT-Originator', $email );
621 }
622
623}
624
625
626sub DeferDigestRecipients {
627 my $self = shift;
628 $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
629
630 # The digest attribute will be an array of notifications that need to
631 # be sent for this transaction. The array will have the following
632 # format for its objects.
633 # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
634 # -> sent -> {true|false}
635 # The "sent" flag will be used by the cron job to indicate that it has
636 # run on this transaction.
637 # In a perfect world we might move this hash construction to the
638 # extension module itself.
639 my $digest_hash = {};
640
641 foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
642 # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
643 next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
644 $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
645
646 # Store the 'daily digest' folk in an array.
647 my ( @send_now, @daily_digest, @weekly_digest, @suspended );
648
649 # Have to get the list of addresses directly from the MIME header
650 # at this point.
651 $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
652 foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
653 next unless $rcpt;
654 my $user_obj = RT::User->new(RT->SystemUser);
655 $user_obj->LoadByEmail($rcpt);
656 if ( ! $user_obj->id ) {
657 # If there's an email address in here without an associated
658 # RT user, pass it on through.
659 $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail.");
660 push( @send_now, $rcpt );
661 next;
662 }
663
664 my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
665 $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
666
667 if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
668 elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
669 elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
670 else { push( @send_now, $rcpt ) }
671 }
672
673 # Reset the relevant mail field.
674 $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
675 if (@send_now) {
676 $self->SetHeader( $mailfield, join( ', ', @send_now ) );
677 } else { # No recipients! Remove the header.
678 $self->TemplateObj->MIMEObj->head->delete($mailfield);
679 }
680
681 # Push the deferred addresses into the appropriate field in
682 # our attribute hash, with the appropriate mail header.
683 $RT::Logger->debug(
684 "Setting deferred recipients for attribute creation");
685 $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest);
686 $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest);
687 $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended);
688 }
689
690 if ( scalar keys %$digest_hash ) {
691
692 # Save the hash so that we can add it as an attribute to the
693 # outgoing email transaction.
694 $self->{'Deferred'} = $digest_hash;
695 } else {
696 $RT::Logger->debug( "No recipients found for deferred delivery on "
697 . "transaction #"
698 . $self->TransactionObj->id );
699 }
700}
701
702
703
704sub RecordDeferredRecipients {
705 my $self = shift;
706 return unless exists $self->{'Deferred'};
707
708 my $txn_id = $self->{'OutgoingMailTransaction'};
709 return unless $txn_id;
710
711 my $txn_obj = RT::Transaction->new( $self->CurrentUser );
712 $txn_obj->Load( $txn_id );
713 my( $ret, $msg ) = $txn_obj->AddAttribute(
714 Name => 'DeferredRecipients',
715 Content => $self->{'Deferred'}
716 );
717 $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
718 unless $ret;
719
720 return ($ret,$msg);
721}
722
723=head2 SquelchMailTo
724
725Returns list of the addresses to squelch on this transaction.
726
727=cut
728
729sub SquelchMailTo {
730 my $self = shift;
731 return map $_->Content, $self->TransactionObj->SquelchMailTo;
732}
733
734=head2 RemoveInappropriateRecipients
735
736Remove addresses that are RT addresses or that are on this transaction's blacklist
737
738=cut
739
740sub RemoveInappropriateRecipients {
741 my $self = shift;
742
743 my @blacklist = ();
744
745 # If there are no recipients, don't try to send the message.
746 # If the transaction has content and has the header RT-Squelch-Replies-To
747
748 my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
749 if ( my $attachment = $self->TransactionObj->Attachments->First ) {
750
751 if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
752
753 # What do we want to do with this? It's probably (?) a bounce
754 # caused by one of the watcher addresses being broken.
755 # Default ("true") is to redistribute, for historical reasons.
756
757 if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
758
759 # Don't send to any watchers.
760 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
761 $RT::Logger->info( $msgid
762 . " The incoming message was autogenerated. "
763 . "Not redistributing this message based on site configuration."
764 );
765 } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
766 'privileged' )
767 {
768
769 # Only send to "privileged" watchers.
770 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
771 foreach my $addr ( @{ $self->{$type} } ) {
772 my $user = RT::User->new(RT->SystemUser);
773 $user->LoadByEmail($addr);
774 push @blacklist, $addr unless $user->id && $user->Privileged;
775 }
776 }
777 $RT::Logger->info( $msgid
778 . " The incoming message was autogenerated. "
779 . "Not redistributing this message to unprivileged users based on site configuration."
780 );
781 }
782 }
783
784 if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
785 push @blacklist, split( /,/, $squelch );
786 }
787 }
788
789 # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
790 push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
791
792 # Cycle through the people we're sending to and pull out anyone on the
793 # system blacklist
794
795 # Trim leading and trailing spaces.
796 @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
797 Email::Address->parse( join ', ', grep defined, @blacklist );
798
799 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
800 my @addrs;
801 foreach my $addr ( @{ $self->{$type} } ) {
802
803 # Weed out any RT addresses. We really don't want to talk to ourselves!
804 # If we get a reply back, that means it's not an RT address
805 if ( !RT::EmailParser->CullRTAddresses($addr) ) {
806 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
807 next;
808 }
809 if ( grep $addr eq $_, @blacklist ) {
810 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
811 next;
812 }
813 push @addrs, $addr;
814 }
815 foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
816 # never send email to itself
817 if ( !RT::EmailParser->CullRTAddresses($addr) ) {
818 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
819 next;
820 }
821 push @addrs, $addr;
822 }
823 @{ $self->{$type} } = @addrs;
824 }
825}
826
827=head2 SetReturnAddress is_comment => BOOLEAN
828
829Calculate and set From and Reply-To headers based on the is_comment flag.
830
831=cut
832
833sub SetReturnAddress {
834
835 my $self = shift;
836 my %args = (
837 is_comment => 0,
838 friendly_name => undef,
839 @_
840 );
841
842 # From and Reply-To
843 # $args{is_comment} should be set if the comment address is to be used.
844 my $replyto;
845
846 if ( $args{'is_comment'} ) {
847 $replyto = $self->TicketObj->QueueObj->CommentAddress
848 || RT->Config->Get('CommentAddress');
849 } else {
850 $replyto = $self->TicketObj->QueueObj->CorrespondAddress
851 || RT->Config->Get('CorrespondAddress');
852 }
853
854 unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
855 $self->SetFrom( %args, From => $replyto );
856 }
857
858 unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
859 $self->SetHeader( 'Reply-To', "$replyto" );
860 }
861
862}
863
864=head2 SetFrom ( From => emailaddress )
865
866Set the From: address for outgoing email
867
868=cut
869
870sub SetFrom {
871 my $self = shift;
872 my %args = @_;
873
874 if ( RT->Config->Get('UseFriendlyFromLine') ) {
875 my $friendly_name = $self->GetFriendlyName(%args);
876 $self->SetHeader(
877 'From',
878 sprintf(
879 RT->Config->Get('FriendlyFromLineFormat'),
880 $self->MIMEEncodeString(
881 $friendly_name, RT->Config->Get('EmailOutputEncoding')
882 ),
883 $args{From}
884 ),
885 );
886 } else {
887 $self->SetHeader( 'From', $args{From} );
888 }
889}
890
891=head2 GetFriendlyName
892
893Calculate the proper Friendly Name based on the creator of the transaction
894
895=cut
896
897sub GetFriendlyName {
898 my $self = shift;
899 my %args = (
900 is_comment => 0,
901 friendly_name => '',
902 @_
903 );
904 my $friendly_name = $args{friendly_name};
905
906 unless ( $friendly_name ) {
907 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
908 if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
909 $friendly_name = $1;
910 }
911 }
912
913 $friendly_name =~ s/"/\\"/g;
914 return $friendly_name;
915
916}
917
918=head2 SetHeader FIELD, VALUE
919
920Set the FIELD of the current MIME object into VALUE.
921
922=cut
923
924sub SetHeader {
925 my $self = shift;
926 my $field = shift;
927 my $val = shift;
928
929 chomp $val;
930 chomp $field;
931 my $head = $self->TemplateObj->MIMEObj->head;
932 $head->fold_length( $field, 10000 );
933 $head->replace( $field, $val );
934 return $head->get($field);
935}
936
937=head2 SetSubject
938
939This routine sets the subject. it does not add the rt tag. That gets done elsewhere
940If subject is already defined via template, it uses that. otherwise, it tries to get
941the transaction's subject.
942
943=cut
944
945sub SetSubject {
946 my $self = shift;
947 my $subject;
948
949 if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
950 return ();
951 }
952
953 # don't use Transaction->Attachments because it caches
954 # and anything which later calls ->Attachments will be hurt
955 # by our RowsPerPage() call. caching is hard.
956 my $message = RT::Attachments->new( $self->CurrentUser );
957 $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
958 $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
959 $message->RowsPerPage(1);
960
961 if ( $self->{'Subject'} ) {
962 $subject = $self->{'Subject'};
963 } elsif ( my $first = $message->First ) {
964 my $tmp = $first->GetHeader('Subject');
965 $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
966 } else {
967 $subject = $self->TicketObj->Subject;
968 }
969 $subject = '' unless defined $subject;
970 chomp $subject;
971
972 $subject =~ s/(\r\n|\n|\s)/ /g;
973
974 $self->SetHeader( 'Subject', $subject );
975
976}
977
978=head2 SetSubjectToken
979
980This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
981
982=cut
983
984sub SetSubjectToken {
985 my $self = shift;
986
987 my $head = $self->TemplateObj->MIMEObj->head;
988 $head->replace(
989 Subject => RT::Interface::Email::AddSubjectTag(
990 Encode::decode_utf8( $head->get('Subject') ),
991 $self->TicketObj,
992 ),
993 );
994}
995
996=head2 SetReferencesHeaders
997
998Set References and In-Reply-To headers for this message.
999
1000=cut
1001
1002sub SetReferencesHeaders {
1003 my $self = shift;
1004
1005 my $top = $self->TransactionObj->Message->First;
1006 unless ( $top ) {
1007 $self->SetHeader( References => $self->PseudoReference );
1008 return (undef);
1009 }
1010
1011 my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1012 my @references = split( /\s+/m, $top->GetHeader('References') || '' );
1013 my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
1014
1015 # There are two main cases -- this transaction was created with
1016 # the RT Web UI, and hence we want to *not* append its Message-ID
1017 # to the References and In-Reply-To. OR it came from an outside
1018 # source, and we should treat it as per the RFC
1019 my $org = RT->Config->Get('Organization');
1020 if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1021
1022 # Make all references which are internal be to version which we
1023 # have sent out
1024
1025 for ( @references, @in_reply_to ) {
1026 s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1027 "<$1." . $self->TicketObj->id .
1028 "-" . $self->ScripObj->id .
1029 "-" . $self->ScripActionObj->{_Message_ID} .
1030 "@" . $org . ">"/eg
1031 }
1032
1033 # In reply to whatever the internal message was in reply to
1034 $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1035
1036 # Default the references to whatever we're in reply to
1037 @references = @in_reply_to unless @references;
1038
1039 # References are unchanged from internal
1040 } else {
1041
1042 # In reply to that message
1043 $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1044
1045 # Default the references to whatever we're in reply to
1046 @references = @in_reply_to unless @references;
1047
1048 # Push that message onto the end of the references
1049 push @references, @msgid;
1050 }
1051
1052 # Push pseudo-ref to the front
1053 my $pseudo_ref = $self->PseudoReference;
1054 @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1055
1056 # If there are more than 10 references headers, remove all but the
1057 # first four and the last six (Gotta keep this from growing
1058 # forever)
1059 splice( @references, 4, -6 ) if ( $#references >= 10 );
1060
1061 # Add on the references
1062 $self->SetHeader( 'References', join( " ", @references ) );
1063 $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1064
1065}
1066
1067=head2 PseudoReference
1068
1069Returns a fake Message-ID: header for the ticket to allow a base level of threading
1070
1071=cut
1072
1073sub PseudoReference {
1074
1075 my $self = shift;
1076 my $pseudo_ref
1077 = '<RT-Ticket-'
1078 . $self->TicketObj->id . '@'
1079 . RT->Config->Get('Organization') . '>';
1080 return $pseudo_ref;
1081}
1082
1083=head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1084
1085This routine converts the field into specified charset encoding.
1086
1087=cut
1088
1089sub SetHeaderAsEncoding {
1090 my $self = shift;
1091 my ( $field, $enc ) = ( shift, shift );
1092
1093 my $head = $self->TemplateObj->MIMEObj->head;
1094
1095 if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1096 $head->replace( $field, RT->Config->Get('SMTPFrom') );
1097 return;
1098 }
1099
1100 my $value = $head->get( $field );
1101 $value = $self->MIMEEncodeString( $value, $enc );
1102 $head->replace( $field, $value );
1103
1104}
1105
1106=head2 MIMEEncodeString
1107
1108Takes a perl string and optional encoding pass it over
1109L<RT::Interface::Email/EncodeToMIME>.
1110
1111Basicly encode a string using B encoding according to RFC2047.
1112
1113=cut
1114
1115sub MIMEEncodeString {
1116 my $self = shift;
1117 return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1118}
1119
1120RT::Base->_ImportOverlays();
1121
11221;
1123