1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
49 # Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
51 package RT::Action::SendEmail;
56 use base qw(RT::Action);
59 use RT::Interface::Email;
61 our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);
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.
72 use base 'RT::Action::SendEmail';
76 Basically, you create another module RT::Action::YourAction which ISA
77 RT::Action::SendEmail.
83 Cleans class-wide options, like L</AttachTickets>.
89 $self->AttachTickets(undef);
94 Sends the prepared message and writes outgoing record into DB if the feature is
95 activated in the config.
102 return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
103 unless RT->Config->Get('RecordOutgoingEmail');
105 $self->DeferDigestRecipients();
106 my $message = $self->TemplateObj->MIMEObj;
109 $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
110 Attachment => $self->TransactionObj->Attachments->First,
111 Ticket => $self->TicketObj,
114 my ($ret) = $self->SendMessage($message);
115 return abs( $ret ) if $ret <= 0;
119 Type => 'application/x-rt-original-message',
120 Disposition => 'inline',
121 Data => $orig_message->as_string,
124 $self->RecordOutgoingMailTransaction($message);
125 $self->RecordDeferredRecipients();
131 Builds an outgoing email we're going to send using scrip's template.
138 unless ( $self->TemplateObj->MIMEObj ) {
139 my ( $result, $message ) = $self->TemplateObj->Parse(
140 Argument => $self->Argument,
141 TicketObj => $self->TicketObj,
142 TransactionObj => $self->TransactionObj
149 my $MIMEObj = $self->TemplateObj->MIMEObj;
152 $self->SetRTSpecialHeaders();
155 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
157 = grep defined && length && !$seen{ lc $_ }++,
161 $self->RemoveInappropriateRecipients();
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.
166 # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
168 for my $header (@EMAIL_RECIPIENT_HEADERS) {
170 $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
171 if (!$MIMEObj->head->get($header)
173 && @{ $self->{$header} } );
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') );
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' );
194 RT::I18N::SetMIMEEntityToEncoding(
196 Encoding => RT->Config->Get('EmailOutputEncoding'),
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 ) );
207 my $attachment = $self->TransactionObj->Attachments->First;
210 $attachment->GetHeader('X-RT-Encrypt')
211 || $self->TicketObj->QueueObj->Encrypt
215 $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
216 if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
225 Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
231 return ( $self->AddressesFromHeader('To') );
236 Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
242 return ( $self->AddressesFromHeader('Cc') );
247 Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
253 return ( $self->AddressesFromHeader('Bcc') );
257 sub AddressesFromHeader {
260 my $header = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field));
261 my @addresses = Email::Address->parse($header);
266 =head2 SendMessage MIMEObj
268 sends the message using RT's preferred API.
269 TODO: Break this out to a separate module
275 # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
276 # ability to pass @_ to a 'post' routine.
277 my ( $self, $MIMEObj ) = @_;
279 my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
282 $self->ScripActionObj->{_Message_ID}++;
284 $RT::Logger->info( $msgid . " #"
285 . $self->TicketObj->id . "/"
286 . $self->TransactionObj->id
288 . ($self->ScripObj->id || '#rule'). " "
289 . ( $self->ScripObj->Description || '' ) );
291 my $status = RT::Interface::Email::SendEmail(
293 Ticket => $self->TicketObj,
294 Transaction => $self->TransactionObj,
298 return $status unless ($status > 0 || exists $self->{'Deferred'});
300 my $success = $msgid . " sent ";
301 foreach (@EMAIL_RECIPIENT_HEADERS) {
302 my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) );
303 $success .= " $_: " . $recipients if $recipients;
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'}{ $_ };
315 $RT::Logger->info($success);
320 =head2 AttachableFromTransaction
322 Function (not method) that takes an L<RT::Transaction> and returns an
323 L<RT::Attachments> collection of attachments suitable for attaching to an
328 sub AttachableFromTransaction {
331 my $attachments = RT::Attachments->new( RT->SystemUser );
333 FIELD => 'TransactionId',
337 # Don't attach anything blank
338 $attachments->LimitNotEmpty;
339 $attachments->OrderBy( FIELD => 'id' );
341 # We want to make sure that we don't include the attachment that's
342 # being used as the "Content" of this message" unless that attachment's
343 # content type is not like text/...
344 my $transaction_content_obj = $txn->ContentObj;
346 if ( $transaction_content_obj
347 && $transaction_content_obj->ContentType =~ m{text/}i )
349 # If this was part of a multipart/alternative, skip all of the kids
350 my $parent = $transaction_content_obj->ParentObj;
351 if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
353 ENTRYAGGREGATOR => 'AND',
356 VALUE => $parent->Id,
360 ENTRYAGGREGATOR => 'AND',
363 VALUE => $transaction_content_obj->Id,
371 =head2 AddAttachments
373 Takes any attachments to this transaction and attaches them to the message
381 my $MIMEObj = $self->TemplateObj->MIMEObj;
383 $MIMEObj->head->delete('RT-Attach-Message');
385 my $attachments = AttachableFromTransaction($self->TransactionObj);
387 # attach any of this transaction's attachments
388 my $seen_attachment = 0;
389 while ( my $attach = $attachments->Next ) {
390 if ( !$seen_attachment ) {
391 $MIMEObj->make_multipart( 'mixed', Force => 1 );
392 $seen_attachment = 1;
394 $self->AddAttachment($attach);
398 =head2 AddAttachment $attachment
400 Takes one attachment object of L<RT::Attachment> class and attaches it to the message
408 my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
410 # $attach->TransactionObj may not always be $self->TransactionObj
411 return unless $attach->Id
412 and $attach->TransactionObj->CurrentUserCanSee;
414 # ->attach expects just the disposition type; extract it if we have the header
415 # or default to "attachment"
416 my $disp = ($attach->GetHeader('Content-Disposition') || '')
417 =~ /^\s*(inline|attachment)/i ? $1 : "attachment";
420 Type => $attach->ContentType,
421 Charset => $attach->OriginalEncoding,
422 Data => $attach->OriginalContent,
423 Disposition => $disp,
424 Filename => $self->MIMEEncodeString( $attach->Filename ),
425 Id => $attach->GetHeader('Content-ID'),
426 'RT-Attachment:' => $self->TicketObj->Id . "/"
427 . $self->TransactionObj->Id . "/"
429 Encoding => '-SUGGEST',
433 =head2 AttachTickets [@IDs]
435 Returns or set list of ticket's IDs that should be attached to an outgoing message.
437 B<Note> this method works as a class method and setup things global, so you have to
438 clean list by passing undef as argument.
447 $list = [ grep defined, @_ ] if @_;
454 Attaches tickets to the current message, list of tickets' ids get from
455 L</AttachTickets> method.
461 $self->AddTicket($_) foreach $self->AttachTickets;
467 Attaches a ticket with ID to the message.
469 Each ticket is attached as multipart entity and all its messages and attachments
470 are attached as sub entities in order of creation, but only if transaction type
471 is Create or Correspond.
479 my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj );
480 my $txn_alias = $attachs->TransactionAlias;
485 VALUE => [qw(Create Correspond)],
487 $attachs->LimitByTicket($tid);
488 $attachs->LimitNotEmpty;
489 $attachs->OrderBy( FIELD => 'Created' );
491 my $ticket_mime = MIME::Entity->build(
492 Type => 'multipart/mixed',
494 Description => "ticket #$tid",
496 while ( my $attachment = $attachs->Next ) {
497 $self->AddAttachment( $attachment, $ticket_mime );
499 if ( $ticket_mime->parts ) {
500 my $email_mime = $self->TemplateObj->MIMEObj;
501 $email_mime->make_multipart;
502 $email_mime->add_part($ticket_mime);
507 =head2 RecordOutgoingMailTransaction MIMEObj
509 Record a transaction in RT with this outgoing message for future record-keeping purposes
513 sub RecordOutgoingMailTransaction {
517 my @parts = $MIMEObj->parts;
520 foreach my $part (@parts) {
521 my $attach = $part->head->get('RT-Attachment');
524 "We found an attachment. we want to not record it.");
525 push @attachments, $attach;
527 $RT::Logger->debug("We found a part. we want to record it.");
531 $MIMEObj->parts( \@keep );
532 foreach my $attachment (@attachments) {
533 $MIMEObj->head->add( 'RT-Attachment', $attachment );
536 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
539 = RT::Transaction->new( $self->TransactionObj->CurrentUser );
541 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
544 if ( $self->TransactionObj->Type eq 'Comment' ) {
545 $type = 'CommentEmailRecord';
547 $type = 'EmailRecord';
550 my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
553 my ( $id, $msg ) = $transaction->Create(
554 Ticket => $self->TicketObj->Id,
562 $self->{'OutgoingMailTransaction'} = $id;
564 $RT::Logger->warning(
565 "Could not record outgoing message transaction: $msg");
570 =head2 SetRTSpecialHeaders
572 This routine adds all the random headers that RT wants in a mail message
573 that don't matter much to anybody else.
577 sub SetRTSpecialHeaders {
581 $self->SetSubjectToken();
582 $self->SetHeaderAsEncoding( 'Subject',
583 RT->Config->Get('EmailOutputEncoding') )
584 if ( RT->Config->Get('EmailOutputEncoding') );
585 $self->SetReturnAddress();
586 $self->SetReferencesHeaders();
588 unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
590 # Get Message-ID for this txn
592 if ( my $msg = $self->TransactionObj->Message->First ) {
593 $msgid = $msg->GetHeader("RT-Message-ID")
594 || $msg->GetHeader("Message-ID");
597 # If there is one, and we can parse it, then base our Message-ID on it
600 =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
601 "<$1." . $self->TicketObj->id
602 . "-" . $self->ScripObj->id
603 . "-" . $self->ScripActionObj->{_Message_ID}
604 . "@" . RT->Config->Get('Organization') . ">"/eg
605 and $2 == $self->TicketObj->id
608 $self->SetHeader( "Message-ID" => $msgid );
611 'Message-ID' => RT::Interface::Email::GenMessageId(
612 Ticket => $self->TicketObj,
613 Scrip => $self->ScripObj,
614 ScripAction => $self->ScripActionObj
620 $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
621 $self->SetHeader( 'X-RT-Ticket',
622 RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
623 $self->SetHeader( 'X-Managed-by',
624 "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
626 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
627 # refactored into user's method.
628 if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
629 and ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator")
630 and RT->Config->Get('UseOriginatorHeader')
632 $self->SetHeader( 'X-RT-Originator', $email );
638 sub DeferDigestRecipients {
640 $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
642 # The digest attribute will be an array of notifications that need to
643 # be sent for this transaction. The array will have the following
644 # format for its objects.
645 # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
646 # -> sent -> {true|false}
647 # The "sent" flag will be used by the cron job to indicate that it has
648 # run on this transaction.
649 # In a perfect world we might move this hash construction to the
650 # extension module itself.
651 my $digest_hash = {};
653 foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
654 # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
655 next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
656 $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
658 # Store the 'daily digest' folk in an array.
659 my ( @send_now, @daily_digest, @weekly_digest, @suspended );
661 # Have to get the list of addresses directly from the MIME header
663 $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) );
664 foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
666 my $user_obj = RT::User->new(RT->SystemUser);
667 $user_obj->LoadByEmail($rcpt);
668 if ( ! $user_obj->id ) {
669 # If there's an email address in here without an associated
670 # RT user, pass it on through.
671 $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail.");
672 push( @send_now, $rcpt );
676 my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
677 $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
679 if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
680 elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
681 elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
682 else { push( @send_now, $rcpt ) }
685 # Reset the relevant mail field.
686 $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
688 $self->SetHeader( $mailfield, join( ', ', @send_now ) );
689 } else { # No recipients! Remove the header.
690 $self->TemplateObj->MIMEObj->head->delete($mailfield);
693 # Push the deferred addresses into the appropriate field in
694 # our attribute hash, with the appropriate mail header.
696 "Setting deferred recipients for attribute creation");
697 $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest);
698 $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest);
699 $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended);
702 if ( scalar keys %$digest_hash ) {
704 # Save the hash so that we can add it as an attribute to the
705 # outgoing email transaction.
706 $self->{'Deferred'} = $digest_hash;
708 $RT::Logger->debug( "No recipients found for deferred delivery on "
710 . $self->TransactionObj->id );
716 sub RecordDeferredRecipients {
718 return unless exists $self->{'Deferred'};
720 my $txn_id = $self->{'OutgoingMailTransaction'};
721 return unless $txn_id;
723 my $txn_obj = RT::Transaction->new( $self->CurrentUser );
724 $txn_obj->Load( $txn_id );
725 my( $ret, $msg ) = $txn_obj->AddAttribute(
726 Name => 'DeferredRecipients',
727 Content => $self->{'Deferred'}
729 $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
737 Returns list of the addresses to squelch on this transaction.
743 return map $_->Content, $self->TransactionObj->SquelchMailTo;
746 =head2 RemoveInappropriateRecipients
748 Remove addresses that are RT addresses or that are on this transaction's blacklist
752 my %squelch_reasons = (
754 => "because autogenerated messages are configured to only be sent to privileged users (RedistributeAutoGeneratedMessages)",
756 => "by RT-Squelch-Replies-To header in the incoming message",
757 'squelch:transaction'
758 => "by notification checkboxes for this transaction",
760 => "by notification checkboxes on this ticket's People page",
764 sub RemoveInappropriateRecipients {
769 # If there are no recipients, don't try to send the message.
770 # If the transaction has content and has the header RT-Squelch-Replies-To
772 my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') );
775 if ( my $attachment = $self->TransactionObj->Attachments->First ) {
777 if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
779 # What do we want to do with this? It's probably (?) a bounce
780 # caused by one of the watcher addresses being broken.
781 # Default ("true") is to redistribute, for historical reasons.
783 my $redistribute = RT->Config->Get('RedistributeAutoGeneratedMessages');
785 if ( !$redistribute ) {
787 # Don't send to any watchers.
788 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
789 $RT::Logger->info( $msgid
790 . " The incoming message was autogenerated. "
791 . "Not redistributing this message based on site configuration."
793 } elsif ( $redistribute eq 'privileged' ) {
795 # Only send to "privileged" watchers.
796 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
797 foreach my $addr ( @{ $self->{$type} } ) {
798 my $user = RT::User->new(RT->SystemUser);
799 $user->LoadByEmail($addr);
800 $blacklist{ $addr } ||= 'not privileged'
801 unless $user->id && $user->Privileged;
804 $RT::Logger->info( $msgid
805 . " The incoming message was autogenerated. "
806 . "Not redistributing this message to unprivileged users based on site configuration."
811 if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
812 $blacklist{ $_->address } ||= 'squelch:attachment'
813 foreach Email::Address->parse( $squelch );
817 # Let's grab the SquelchMailTo attributes and push those entries
818 # into the blacklisted
819 $blacklist{ $_->Content } ||= 'squelch:transaction'
820 foreach $self->TransactionObj->SquelchMailTo;
821 $blacklist{ $_->Content } ||= 'squelch:ticket'
822 foreach $self->TicketObj->SquelchMailTo;
824 # canonicalize emails
825 foreach my $address ( keys %blacklist ) {
826 my $reason = delete $blacklist{ $address };
827 $blacklist{ lc $_ } = $reason
828 foreach map RT::User->CanonicalizeEmailAddress( $_->address ),
829 Email::Address->parse( $address );
832 $self->RecipientFilter(
834 return unless RT::EmailParser->IsRTAddress( $_[0] );
835 return "$_[0] appears to point to this RT instance. Skipping";
840 $self->RecipientFilter(
842 return unless $blacklist{ lc $_[0] };
843 return "$_[0] is blacklisted $squelch_reasons{ $blacklist{ lc $_[0] } }. Skipping";
848 # Cycle through the people we're sending to and pull out anyone that meets any of the callbacks
849 for my $type (@EMAIL_RECIPIENT_HEADERS) {
853 for my $addr ( @{ $self->{$type} } ) {
854 for my $filter ( map {$_->{Callback}} @{$self->{RecipientFilter}} ) {
855 my $skip = $filter->($addr);
857 $RT::Logger->info( "$msgid $skip" );
864 for my $addr ( @{ $self->{NoSquelch}{$type} } ) {
865 for my $filter ( map {$_->{Callback}} grep {$_->{All}} @{$self->{RecipientFilter}} ) {
866 my $skip = $filter->($addr);
868 $RT::Logger->info( "$msgid $skip" );
869 next NOSQUELCH_ADDRESS;
874 @{ $self->{$type} } = @addrs;
878 =head2 RecipientFilter Callback => SUB, [All => 1]
880 Registers a filter to be applied to addresses by
881 L<RemoveInappropriateRecipients>. The C<Callback> will be called with
882 one address at a time, and should return false if the address should
883 receive mail, or a message explaining why it should not be. Passing a
884 true value for C<All> will cause the filter to also be applied to
885 NoSquelch (one-time Cc and Bcc) recipients as well.
889 sub RecipientFilter {
891 push @{ $self->{RecipientFilter}}, {@_};
894 =head2 SetReturnAddress is_comment => BOOLEAN
896 Calculate and set From and Reply-To headers based on the is_comment flag.
900 sub SetReturnAddress {
905 friendly_name => undef,
910 # $args{is_comment} should be set if the comment address is to be used.
913 if ( $args{'is_comment'} ) {
914 $replyto = $self->TicketObj->QueueObj->CommentAddress
915 || RT->Config->Get('CommentAddress');
917 $replyto = $self->TicketObj->QueueObj->CorrespondAddress
918 || RT->Config->Get('CorrespondAddress');
921 unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
922 $self->SetFrom( %args, From => $replyto );
925 unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
926 $self->SetHeader( 'Reply-To', "$replyto" );
931 =head2 SetFrom ( From => emailaddress )
933 Set the From: address for outgoing email
941 my $from = $args{From};
943 if ( RT->Config->Get('UseFriendlyFromLine') ) {
944 my $friendly_name = $self->GetFriendlyName(%args);
947 RT->Config->Get('FriendlyFromLineFormat'),
948 $self->MIMEEncodeString(
949 $friendly_name, RT->Config->Get('EmailOutputEncoding')
955 $self->SetHeader( 'From', $from );
957 #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine,
958 #and then Outlook prepends "rt@machine on behalf of" to the From: header
959 $self->SetHeader( 'Sender', $from );
962 =head2 GetFriendlyName
964 Calculate the proper Friendly Name based on the creator of the transaction
968 sub GetFriendlyName {
975 my $friendly_name = $args{friendly_name};
977 unless ( $friendly_name ) {
978 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
979 if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
984 $friendly_name =~ s/"/\\"/g;
985 return $friendly_name;
989 =head2 SetHeader FIELD, VALUE
991 Set the FIELD of the current MIME object into VALUE, which should be in
992 characters, not bytes. Returns the new header, in bytes.
1003 my $head = $self->TemplateObj->MIMEObj->head;
1004 $head->fold_length( $field, 10000 );
1005 $head->replace( $field, Encode::encode( "UTF-8", $val ) );
1006 return $head->get($field);
1011 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
1012 If subject is already defined via template, it uses that. otherwise, it tries to get
1013 the transaction's subject.
1021 if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
1025 # don't use Transaction->Attachments because it caches
1026 # and anything which later calls ->Attachments will be hurt
1027 # by our RowsPerPage() call. caching is hard.
1028 my $message = RT::Attachments->new( $self->CurrentUser );
1029 $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
1030 $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
1031 $message->RowsPerPage(1);
1033 if ( $self->{'Subject'} ) {
1034 $subject = $self->{'Subject'};
1035 } elsif ( my $first = $message->First ) {
1036 my $tmp = $first->GetHeader('Subject');
1037 $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
1039 $subject = $self->TicketObj->Subject;
1041 $subject = '' unless defined $subject;
1044 $subject =~ s/(\r\n|\n|\s)/ /g;
1046 $self->SetHeader( 'Subject', $subject );
1050 =head2 SetSubjectToken
1052 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
1056 sub SetSubjectToken {
1059 my $head = $self->TemplateObj->MIMEObj->head;
1062 RT::Interface::Email::AddSubjectTag(
1063 Encode::decode( "UTF-8", $head->get('Subject') ),
1069 =head2 SetReferencesHeaders
1071 Set References and In-Reply-To headers for this message.
1075 sub SetReferencesHeaders {
1078 my $top = $self->TransactionObj->Message->First;
1080 $self->SetHeader( References => $self->PseudoReference );
1084 my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1085 my @references = split( /\s+/m, $top->GetHeader('References') || '' );
1086 my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
1088 # There are two main cases -- this transaction was created with
1089 # the RT Web UI, and hence we want to *not* append its Message-ID
1090 # to the References and In-Reply-To. OR it came from an outside
1091 # source, and we should treat it as per the RFC
1092 my $org = RT->Config->Get('Organization');
1093 if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1095 # Make all references which are internal be to version which we
1098 for ( @references, @in_reply_to ) {
1099 s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1100 "<$1." . $self->TicketObj->id .
1101 "-" . $self->ScripObj->id .
1102 "-" . $self->ScripActionObj->{_Message_ID} .
1106 # In reply to whatever the internal message was in reply to
1107 $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1109 # Default the references to whatever we're in reply to
1110 @references = @in_reply_to unless @references;
1112 # References are unchanged from internal
1115 # In reply to that message
1116 $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1118 # Default the references to whatever we're in reply to
1119 @references = @in_reply_to unless @references;
1121 # Push that message onto the end of the references
1122 push @references, @msgid;
1125 # Push pseudo-ref to the front
1126 my $pseudo_ref = $self->PseudoReference;
1127 @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1129 # If there are more than 10 references headers, remove all but the
1130 # first four and the last six (Gotta keep this from growing
1132 splice( @references, 4, -6 ) if ( $#references >= 10 );
1134 # Add on the references
1135 $self->SetHeader( 'References', join( " ", @references ) );
1136 $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1140 =head2 PseudoReference
1142 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1146 sub PseudoReference {
1148 return RT::Interface::Email::PseudoReference( $self->TicketObj );
1151 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1153 This routine converts the field into specified charset encoding, then
1154 applies the MIME-Header transfer encoding.
1158 sub SetHeaderAsEncoding {
1160 my ( $field, $enc ) = ( shift, shift );
1162 my $head = $self->TemplateObj->MIMEObj->head;
1164 my $value = Encode::decode("UTF-8", $head->get( $field ));
1165 $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes
1166 $head->replace( $field, $value );
1170 =head2 MIMEEncodeString
1172 Takes a perl string and optional encoding pass it over
1173 L<RT::Interface::Email/EncodeToMIME>.
1175 Basicly encode a string using B encoding according to RFC2047, returning
1180 sub MIMEEncodeString {
1182 return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1185 RT::Base->_ImportOverlays();