1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2011 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</SquelchMailTo> or L</AttachTickets>.
89 $self->SquelchMailTo(undef);
90 $self->AttachTickets(undef);
95 Sends the prepared message and writes outgoing record into DB if the feature is
96 activated in the config.
103 $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail');
104 my $message = $self->TemplateObj->MIMEObj;
107 if ( RT->Config->Get('RecordOutgoingEmail')
108 && RT->Config->Get('GnuPG')->{'Enable'} )
111 # it's hacky, but we should know if we're going to crypt things
112 my $attachment = $self->TransactionObj->Attachments->First;
115 foreach my $argument (qw(Sign Encrypt)) {
117 && defined $attachment->GetHeader("X-RT-$argument") )
119 $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
121 $crypt{$argument} = $self->TicketObj->QueueObj->$argument();
124 if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) {
125 $orig_message = $message->dup;
129 my ($ret) = $self->SendMessage($message);
130 if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) {
133 Type => 'application/x-rt-original-message',
134 Disposition => 'inline',
135 Data => $orig_message->as_string,
138 $self->RecordOutgoingMailTransaction($message);
139 $self->RecordDeferredRecipients();
148 Builds an outgoing email we're going to send using scrip's template.
155 my ( $result, $message ) = $self->TemplateObj->Parse(
156 Argument => $self->Argument,
157 TicketObj => $self->TicketObj,
158 TransactionObj => $self->TransactionObj
164 my $MIMEObj = $self->TemplateObj->MIMEObj;
167 $self->SetRTSpecialHeaders();
169 $self->RemoveInappropriateRecipients();
172 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
174 = grep defined && length && !$seen{ lc $_ }++,
178 # Go add all the Tos, Ccs and Bccs that we need to to the message to
179 # make it happy, but only if we actually have values in those arrays.
181 # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
183 for my $header (@EMAIL_RECIPIENT_HEADERS) {
185 $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
186 if (!$MIMEObj->head->get($header)
188 && @{ $self->{$header} } );
190 # PseudoTo (fake to headers) shouldn't get matched for message recipients.
191 # If we don't have any 'To' header (but do have other recipients), drop in
192 # the pseudo-to header.
193 $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
194 if $self->{'PseudoTo'}
195 && @{ $self->{'PseudoTo'} }
196 && !$MIMEObj->head->get('To')
197 && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
199 # We should never have to set the MIME-Version header
200 $self->SetHeader( 'MIME-Version', '1.0' );
202 # fsck.com #5959: Since RT sends 8bit mail, we should say so.
203 $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
205 # For security reasons, we only send out textual mails.
206 foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
207 my $type = $part->mime_type || 'text/plain';
208 $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
209 $part->head->mime_attr( "Content-Type" => $type );
210 # utf-8 here is for _FindOrGuessCharset in I18N.pm
211 # it's not the final charset/encoding sent
212 $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
215 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
216 RT->Config->Get('EmailOutputEncoding'),
219 # Build up a MIME::Entity that looks like the original message.
220 $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
221 && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
225 my $attachment = $self->TransactionObj->Attachments->First;
228 $attachment->GetHeader('X-RT-Encrypt')
229 || $self->TicketObj->QueueObj->Encrypt
233 $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
234 if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
243 Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
249 return ( $self->AddressesFromHeader('To') );
254 Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
260 return ( $self->AddressesFromHeader('Cc') );
265 Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
271 return ( $self->AddressesFromHeader('Bcc') );
275 sub AddressesFromHeader {
278 my $header = $self->TemplateObj->MIMEObj->head->get($field);
279 my @addresses = Email::Address->parse($header);
284 =head2 SendMessage MIMEObj
286 sends the message using RT's preferred API.
287 TODO: Break this out to a separate module
293 # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
294 # ability to pass @_ to a 'post' routine.
295 my ( $self, $MIMEObj ) = @_;
297 my $msgid = $MIMEObj->head->get('Message-ID');
300 $self->ScripActionObj->{_Message_ID}++;
302 $RT::Logger->info( $msgid . " #"
303 . $self->TicketObj->id . "/"
304 . $self->TransactionObj->id
306 . ($self->ScripObj->id || '#rule'). " "
307 . ( $self->ScripObj->Description || '' ) );
309 my $status = RT::Interface::Email::SendEmail(
311 Ticket => $self->TicketObj,
312 Transaction => $self->TransactionObj,
316 return $status unless ($status > 0 || exists $self->{'Deferred'});
318 my $success = $msgid . " sent ";
319 foreach (@EMAIL_RECIPIENT_HEADERS) {
320 my $recipients = $MIMEObj->head->get($_);
321 $success .= " $_: " . $recipients if $recipients;
324 if( exists $self->{'Deferred'} ) {
325 for (qw(daily weekly susp)) {
326 $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
327 if exists $self->{'Deferred'}{ $_ };
333 $RT::Logger->info($success);
338 =head2 AddAttachments
340 Takes any attachments to this transaction and attaches them to the message
348 my $MIMEObj = $self->TemplateObj->MIMEObj;
350 $MIMEObj->head->delete('RT-Attach-Message');
352 my $attachments = RT::Attachments->new($RT::SystemUser);
354 FIELD => 'TransactionId',
355 VALUE => $self->TransactionObj->Id
358 # Don't attach anything blank
359 $attachments->LimitNotEmpty;
360 $attachments->OrderBy( FIELD => 'id' );
362 # We want to make sure that we don't include the attachment that's
363 # being used as the "Content" of this message" unless that attachment's
364 # content type is not like text/...
365 my $transaction_content_obj = $self->TransactionObj->ContentObj;
367 if ( $transaction_content_obj
368 && $transaction_content_obj->ContentType =~ m{text/}i )
370 # If this was part of a multipart/alternative, skip all of the kids
371 my $parent = $transaction_content_obj->ParentObj;
372 if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
374 ENTRYAGGREGATOR => 'AND',
377 VALUE => $parent->Id,
381 ENTRYAGGREGATOR => 'AND',
384 VALUE => $transaction_content_obj->Id,
389 # attach any of this transaction's attachments
390 my $seen_attachment = 0;
391 while ( my $attach = $attachments->Next ) {
392 if ( !$seen_attachment ) {
393 $MIMEObj->make_multipart( 'mixed', Force => 1 );
394 $seen_attachment = 1;
396 $self->AddAttachment($attach);
400 =head2 AddAttachment $attachment
402 Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
410 my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
413 Type => $attach->ContentType,
414 Charset => $attach->OriginalEncoding,
415 Data => $attach->OriginalContent,
416 Filename => $self->MIMEEncodeString( $attach->Filename ),
417 'RT-Attachment:' => $self->TicketObj->Id . "/"
418 . $self->TransactionObj->Id . "/"
420 Encoding => '-SUGGEST',
424 =head2 AttachTickets [@IDs]
426 Returns or set list of ticket's IDs that should be attached to an outgoing message.
428 B<Note> this method works as a class method and setup things global, so you have to
429 clean list by passing undef as argument.
438 $list = [ grep defined, @_ ] if @_;
445 Attaches tickets to the current message, list of tickets' ids get from
446 L</AttachTickets> method.
452 $self->AddTicket($_) foreach $self->AttachTickets;
458 Attaches a ticket with ID to the message.
460 Each ticket is attached as multipart entity and all its messages and attachments
461 are attached as sub entities in order of creation, but only if transaction type
462 is Create or Correspond.
470 # XXX: we need a current user here, but who is current user?
471 my $attachs = RT::Attachments->new($RT::SystemUser);
472 my $txn_alias = $attachs->TransactionAlias;
473 $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
477 VALUE => 'Correspond'
479 $attachs->LimitByTicket($tid);
480 $attachs->LimitNotEmpty;
481 $attachs->OrderBy( FIELD => 'Created' );
483 my $ticket_mime = MIME::Entity->build(
484 Type => 'multipart/mixed',
486 Description => "ticket #$tid",
488 while ( my $attachment = $attachs->Next ) {
489 $self->AddAttachment( $attachment, $ticket_mime );
491 if ( $ticket_mime->parts ) {
492 my $email_mime = $self->TemplateObj->MIMEObj;
493 $email_mime->make_multipart;
494 $email_mime->add_part($ticket_mime);
499 =head2 RecordOutgoingMailTransaction MIMEObj
501 Record a transaction in RT with this outgoing message for future record-keeping purposes
505 sub RecordOutgoingMailTransaction {
509 my @parts = $MIMEObj->parts;
512 foreach my $part (@parts) {
513 my $attach = $part->head->get('RT-Attachment');
516 "We found an attachment. we want to not record it.");
517 push @attachments, $attach;
519 $RT::Logger->debug("We found a part. we want to record it.");
523 $MIMEObj->parts( \@keep );
524 foreach my $attachment (@attachments) {
525 $MIMEObj->head->add( 'RT-Attachment', $attachment );
528 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
531 = RT::Transaction->new( $self->TransactionObj->CurrentUser );
533 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
536 if ( $self->TransactionObj->Type eq 'Comment' ) {
537 $type = 'CommentEmailRecord';
539 $type = 'EmailRecord';
542 my $msgid = $MIMEObj->head->get('Message-ID');
545 my ( $id, $msg ) = $transaction->Create(
546 Ticket => $self->TicketObj->Id,
554 $self->{'OutgoingMailTransaction'} = $id;
556 $RT::Logger->warning(
557 "Could not record outgoing message transaction: $msg");
562 =head2 SetRTSpecialHeaders
564 This routine adds all the random headers that RT wants in a mail message
565 that don't matter much to anybody else.
569 sub SetRTSpecialHeaders {
573 $self->SetSubjectToken();
574 $self->SetHeaderAsEncoding( 'Subject',
575 RT->Config->Get('EmailOutputEncoding') )
576 if ( RT->Config->Get('EmailOutputEncoding') );
577 $self->SetReturnAddress();
578 $self->SetReferencesHeaders();
580 unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
582 # Get Message-ID for this txn
584 if ( my $msg = $self->TransactionObj->Message->First ) {
585 $msgid = $msg->GetHeader("RT-Message-ID")
586 || $msg->GetHeader("Message-ID");
589 # If there is one, and we can parse it, then base our Message-ID on it
592 =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
593 "<$1." . $self->TicketObj->id
594 . "-" . $self->ScripObj->id
595 . "-" . $self->ScripActionObj->{_Message_ID}
596 . "@" . RT->Config->Get('Organization') . ">"/eg
597 and $2 == $self->TicketObj->id
600 $self->SetHeader( "Message-ID" => $msgid );
603 'Message-ID' => RT::Interface::Email::GenMessageId(
604 Ticket => $self->TicketObj,
605 Scrip => $self->ScripObj,
606 ScripAction => $self->ScripActionObj
612 if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
613 and !$self->TemplateObj->MIMEObj->head->get("Precedence")
615 $self->SetHeader( 'Precedence', $precedence );
618 $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
619 $self->SetHeader( 'RT-Ticket',
620 RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
621 $self->SetHeader( 'Managed-by',
622 "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
624 # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
625 # refactored into user's method.
626 if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
627 and RT->Config->Get('UseOriginatorHeader')
629 $self->SetHeader( 'RT-Originator', $email );
635 sub DeferDigestRecipients {
637 $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
639 # The digest attribute will be an array of notifications that need to
640 # be sent for this transaction. The array will have the following
641 # format for its objects.
642 # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
643 # -> sent -> {true|false}
644 # The "sent" flag will be used by the cron job to indicate that it has
645 # run on this transaction.
646 # In a perfect world we might move this hash construction to the
647 # extension module itself.
648 my $digest_hash = {};
650 foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
651 # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
652 next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
653 $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
655 # Store the 'daily digest' folk in an array.
656 my ( @send_now, @daily_digest, @weekly_digest, @suspended );
658 # Have to get the list of addresses directly from the MIME header
660 $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
661 foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
663 my $user_obj = RT::User->new($RT::SystemUser);
664 $user_obj->LoadByEmail($rcpt);
665 if ( ! $user_obj->id ) {
666 # If there's an email address in here without an associated
667 # RT user, pass it on through.
668 $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail.");
669 push( @send_now, $rcpt );
673 my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
674 $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
676 if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
677 elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
678 elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
679 else { push( @send_now, $rcpt ) }
682 # Reset the relevant mail field.
683 $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
685 $self->SetHeader( $mailfield, join( ', ', @send_now ) );
686 } else { # No recipients! Remove the header.
687 $self->TemplateObj->MIMEObj->head->delete($mailfield);
690 # Push the deferred addresses into the appropriate field in
691 # our attribute hash, with the appropriate mail header.
693 "Setting deferred recipients for attribute creation");
694 $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest);
695 $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest);
696 $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended);
699 if ( scalar keys %$digest_hash ) {
701 # Save the hash so that we can add it as an attribute to the
702 # outgoing email transaction.
703 $self->{'Deferred'} = $digest_hash;
705 $RT::Logger->debug( "No recipients found for deferred delivery on "
707 . $self->TransactionObj->id );
713 sub RecordDeferredRecipients {
715 return unless exists $self->{'Deferred'};
717 my $txn_id = $self->{'OutgoingMailTransaction'};
718 return unless $txn_id;
720 my $txn_obj = RT::Transaction->new( $self->CurrentUser );
721 $txn_obj->Load( $txn_id );
722 my( $ret, $msg ) = $txn_obj->AddAttribute(
723 Name => 'DeferredRecipients',
724 Content => $self->{'Deferred'}
726 $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
732 =head2 SquelchMailTo [@ADDRESSES]
734 Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses.
735 To empty list pass undefined argument.
737 B<Note> that this method can be called as class method and works globaly. Don't forget to
738 clean this list when blocking is not required anymore, pass undef to do this.
748 $squelch = [ grep defined, @_ ];
754 =head2 RemoveInappropriateRecipients
756 Remove addresses that are RT addresses or that are on this transaction's blacklist
760 sub RemoveInappropriateRecipients {
765 # If there are no recipients, don't try to send the message.
766 # If the transaction has content and has the header RT-Squelch-Replies-To
768 my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
769 if ( my $attachment = $self->TransactionObj->Attachments->First ) {
771 if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
773 # What do we want to do with this? It's probably (?) a bounce
774 # caused by one of the watcher addresses being broken.
775 # Default ("true") is to redistribute, for historical reasons.
777 if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
779 # Don't send to any watchers.
780 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
781 $RT::Logger->info( $msgid
782 . " The incoming message was autogenerated. "
783 . "Not redistributing this message based on site configuration."
785 } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
789 # Only send to "privileged" watchers.
790 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
791 foreach my $addr ( @{ $self->{$type} } ) {
792 my $user = RT::User->new($RT::SystemUser);
793 $user->LoadByEmail($addr);
794 push @blacklist, $addr if ( !$user->Privileged );
797 $RT::Logger->info( $msgid
798 . " The incoming message was autogenerated. "
799 . "Not redistributing this message to unprivileged users based on site configuration."
804 if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
805 push @blacklist, split( /,/, $squelch );
809 # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
810 push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo;
811 push @blacklist, $self->SquelchMailTo;
813 # Cycle through the people we're sending to and pull out anyone on the
816 # Trim leading and trailing spaces.
817 @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse(join(', ', grep {defined} @blacklist));
819 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
821 foreach my $addr ( @{ $self->{$type} } ) {
823 # Weed out any RT addresses. We really don't want to talk to ourselves!
824 # If we get a reply back, that means it's not an RT address
825 if ( !RT::EmailParser->CullRTAddresses($addr) ) {
826 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
829 if ( grep /^\Q$addr\E$/, @blacklist ) {
830 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
835 @{ $self->{$type} } = @addrs;
839 =head2 SetReturnAddress is_comment => BOOLEAN
841 Calculate and set From and Reply-To headers based on the is_comment flag.
845 sub SetReturnAddress {
850 friendly_name => undef,
855 # $args{is_comment} should be set if the comment address is to be used.
858 if ( $args{'is_comment'} ) {
859 $replyto = $self->TicketObj->QueueObj->CommentAddress
860 || RT->Config->Get('CommentAddress');
862 $replyto = $self->TicketObj->QueueObj->CorrespondAddress
863 || RT->Config->Get('CorrespondAddress');
866 unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
867 if ( RT->Config->Get('UseFriendlyFromLine') ) {
868 my $friendly_name = $args{friendly_name};
870 unless ( $friendly_name ) {
871 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
872 if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
877 $friendly_name =~ s/"/\\"/g;
881 RT->Config->Get('FriendlyFromLineFormat'),
882 $self->MIMEEncodeString(
883 $friendly_name, RT->Config->Get('EmailOutputEncoding')
889 $self->SetHeader( 'From', $replyto );
893 unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
894 $self->SetHeader( 'Reply-To', "$replyto" );
899 =head2 SetHeader FIELD, VALUE
901 Set the FIELD of the current MIME object into VALUE.
912 my $head = $self->TemplateObj->MIMEObj->head;
913 $head->fold_length( $field, 10000 );
914 $head->replace( $field, $val );
915 return $head->get($field);
920 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
921 If subject is already defined via template, it uses that. otherwise, it tries to get
922 the transaction's subject.
930 if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
934 # don't use Transaction->Attachments because it caches
935 # and anything which later calls ->Attachments will be hurt
936 # by our RowsPerPage() call. caching is hard.
937 my $message = RT::Attachments->new( $self->CurrentUser );
938 $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
939 $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
940 $message->RowsPerPage(1);
942 if ( $self->{'Subject'} ) {
943 $subject = $self->{'Subject'};
944 } elsif ( my $first = $message->First ) {
945 my $tmp = $first->GetHeader('Subject');
946 $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
948 $subject = $self->TicketObj->Subject;
950 $subject = '' unless defined $subject;
953 $subject =~ s/(\r\n|\n|\s)/ /g;
955 $self->SetHeader( 'Subject', $subject );
959 =head2 SetSubjectToken
961 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
965 sub SetSubjectToken {
968 my $head = $self->TemplateObj->MIMEObj->head;
970 Subject => RT::Interface::Email::AddSubjectTag(
971 Encode::decode_utf8( $head->get('Subject') ),
977 =head2 SetReferencesHeaders
979 Set References and In-Reply-To headers for this message.
983 sub SetReferencesHeaders {
985 my ( @in_reply_to, @references, @msgid );
987 if ( my $top = $self->TransactionObj->Message->First ) {
988 @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
989 @references = split( /\s+/m, $top->GetHeader('References') || '' );
990 @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
995 # There are two main cases -- this transaction was created with
996 # the RT Web UI, and hence we want to *not* append its Message-ID
997 # to the References and In-Reply-To. OR it came from an outside
998 # source, and we should treat it as per the RFC
999 my $org = RT->Config->Get('Organization');
1000 if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1002 # Make all references which are internal be to version which we
1005 for ( @references, @in_reply_to ) {
1006 s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1007 "<$1." . $self->TicketObj->id .
1008 "-" . $self->ScripObj->id .
1009 "-" . $self->ScripActionObj->{_Message_ID} .
1013 # In reply to whatever the internal message was in reply to
1014 $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1016 # Default the references to whatever we're in reply to
1017 @references = @in_reply_to unless @references;
1019 # References are unchanged from internal
1022 # In reply to that message
1023 $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1025 # Default the references to whatever we're in reply to
1026 @references = @in_reply_to unless @references;
1028 # Push that message onto the end of the references
1029 push @references, @msgid;
1032 # Push pseudo-ref to the front
1033 my $pseudo_ref = $self->PseudoReference;
1034 @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1036 # If there are more than 10 references headers, remove all but the
1037 # first four and the last six (Gotta keep this from growing
1039 splice( @references, 4, -6 ) if ( $#references >= 10 );
1041 # Add on the references
1042 $self->SetHeader( 'References', join( " ", @references ) );
1043 $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1047 =head2 PseudoReference
1049 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1053 sub PseudoReference {
1058 . $self->TicketObj->id . '@'
1059 . RT->Config->Get('Organization') . '>';
1063 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1065 This routine converts the field into specified charset encoding.
1069 sub SetHeaderAsEncoding {
1071 my ( $field, $enc ) = ( shift, shift );
1073 my $head = $self->TemplateObj->MIMEObj->head;
1075 if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1076 $head->replace( $field, RT->Config->Get('SMTPFrom') );
1080 my $value = $head->get( $field );
1081 $value = $self->MIMEEncodeString( $value, $enc );
1082 $head->replace( $field, $value );
1086 =head2 MIMEEncodeString
1088 Takes a perl string and optional encoding pass it over
1089 L<RT::Interface::Email/EncodeToMIME>.
1091 Basicly encode a string using B encoding according to RFC2047.
1095 sub MIMEEncodeString {
1097 return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1100 RT::Base->_ImportOverlays();