1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2013 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 my ( $result, $message ) = $self->TemplateObj->Parse(
139 Argument => $self->Argument,
140 TicketObj => $self->TicketObj,
141 TransactionObj => $self->TransactionObj
147 my $MIMEObj = $self->TemplateObj->MIMEObj;
150 $self->SetRTSpecialHeaders();
153 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
155 = grep defined && length && !$seen{ lc $_ }++,
159 $self->RemoveInappropriateRecipients();
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.
164 # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
166 for my $header (@EMAIL_RECIPIENT_HEADERS) {
168 $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
169 if (!$MIMEObj->head->get($header)
171 && @{ $self->{$header} } );
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') );
182 # We should never have to set the MIME-Version header
183 $self->SetHeader( 'MIME-Version', '1.0' );
185 # fsck.com #5959: Since RT sends 8bit mail, we should say so.
186 $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
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' );
198 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
199 RT->Config->Get('EmailOutputEncoding'),
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 ) );
208 my $attachment = $self->TransactionObj->Attachments->First;
211 $attachment->GetHeader('X-RT-Encrypt')
212 || $self->TicketObj->QueueObj->Encrypt
216 $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
217 if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
226 Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
232 return ( $self->AddressesFromHeader('To') );
237 Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
243 return ( $self->AddressesFromHeader('Cc') );
248 Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
254 return ( $self->AddressesFromHeader('Bcc') );
258 sub AddressesFromHeader {
261 my $header = $self->TemplateObj->MIMEObj->head->get($field);
262 my @addresses = Email::Address->parse($header);
267 =head2 SendMessage MIMEObj
269 sends the message using RT's preferred API.
270 TODO: Break this out to a separate module
276 # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
277 # ability to pass @_ to a 'post' routine.
278 my ( $self, $MIMEObj ) = @_;
280 my $msgid = $MIMEObj->head->get('Message-ID');
283 $self->ScripActionObj->{_Message_ID}++;
285 $RT::Logger->info( $msgid . " #"
286 . $self->TicketObj->id . "/"
287 . $self->TransactionObj->id
289 . ($self->ScripObj->id || '#rule'). " "
290 . ( $self->ScripObj->Description || '' ) );
292 my $status = RT::Interface::Email::SendEmail(
294 Ticket => $self->TicketObj,
295 Transaction => $self->TransactionObj,
299 return $status unless ($status > 0 || exists $self->{'Deferred'});
301 my $success = $msgid . " sent ";
302 foreach (@EMAIL_RECIPIENT_HEADERS) {
303 my $recipients = $MIMEObj->head->get($_);
304 $success .= " $_: " . $recipients if $recipients;
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'}{ $_ };
316 $RT::Logger->info($success);
321 =head2 AddAttachments
323 Takes any attachments to this transaction and attaches them to the message
331 my $MIMEObj = $self->TemplateObj->MIMEObj;
333 $MIMEObj->head->delete('RT-Attach-Message');
335 my $attachments = RT::Attachments->new( RT->SystemUser );
337 FIELD => 'TransactionId',
338 VALUE => $self->TransactionObj->Id
341 # Don't attach anything blank
342 $attachments->LimitNotEmpty;
343 $attachments->OrderBy( FIELD => 'id' );
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;
350 if ( $transaction_content_obj
351 && $transaction_content_obj->ContentType =~ m{text/}i )
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") {
357 ENTRYAGGREGATOR => 'AND',
360 VALUE => $parent->Id,
364 ENTRYAGGREGATOR => 'AND',
367 VALUE => $transaction_content_obj->Id,
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;
379 $self->AddAttachment($attach);
383 =head2 AddAttachment $attachment
385 Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
393 my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
395 # $attach->TransactionObj may not always be $self->TransactionObj
396 return unless $attach->Id
397 and $attach->TransactionObj->CurrentUserCanSee;
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;
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 . "/"
412 Encoding => '-SUGGEST',
416 =head2 AttachTickets [@IDs]
418 Returns or set list of ticket's IDs that should be attached to an outgoing message.
420 B<Note> this method works as a class method and setup things global, so you have to
421 clean list by passing undef as argument.
430 $list = [ grep defined, @_ ] if @_;
437 Attaches tickets to the current message, list of tickets' ids get from
438 L</AttachTickets> method.
444 $self->AddTicket($_) foreach $self->AttachTickets;
450 Attaches a ticket with ID to the message.
452 Each ticket is attached as multipart entity and all its messages and attachments
453 are attached as sub entities in order of creation, but only if transaction type
454 is Create or Correspond.
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' );
468 VALUE => 'Correspond'
470 $attachs->LimitByTicket($tid);
471 $attachs->LimitNotEmpty;
472 $attachs->OrderBy( FIELD => 'Created' );
474 my $ticket_mime = MIME::Entity->build(
475 Type => 'multipart/mixed',
477 Description => "ticket #$tid",
479 while ( my $attachment = $attachs->Next ) {
480 $self->AddAttachment( $attachment, $ticket_mime );
482 if ( $ticket_mime->parts ) {
483 my $email_mime = $self->TemplateObj->MIMEObj;
484 $email_mime->make_multipart;
485 $email_mime->add_part($ticket_mime);
490 =head2 RecordOutgoingMailTransaction MIMEObj
492 Record a transaction in RT with this outgoing message for future record-keeping purposes
496 sub RecordOutgoingMailTransaction {
500 my @parts = $MIMEObj->parts;
503 foreach my $part (@parts) {
504 my $attach = $part->head->get('RT-Attachment');
507 "We found an attachment. we want to not record it.");
508 push @attachments, $attach;
510 $RT::Logger->debug("We found a part. we want to record it.");
514 $MIMEObj->parts( \@keep );
515 foreach my $attachment (@attachments) {
516 $MIMEObj->head->add( 'RT-Attachment', $attachment );
519 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
522 = RT::Transaction->new( $self->TransactionObj->CurrentUser );
524 # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
527 if ( $self->TransactionObj->Type eq 'Comment' ) {
528 $type = 'CommentEmailRecord';
530 $type = 'EmailRecord';
533 my $msgid = $MIMEObj->head->get('Message-ID');
536 my ( $id, $msg ) = $transaction->Create(
537 Ticket => $self->TicketObj->Id,
545 $self->{'OutgoingMailTransaction'} = $id;
547 $RT::Logger->warning(
548 "Could not record outgoing message transaction: $msg");
553 =head2 SetRTSpecialHeaders
555 This routine adds all the random headers that RT wants in a mail message
556 that don't matter much to anybody else.
560 sub SetRTSpecialHeaders {
564 $self->SetSubjectToken();
565 $self->SetHeaderAsEncoding( 'Subject',
566 RT->Config->Get('EmailOutputEncoding') )
567 if ( RT->Config->Get('EmailOutputEncoding') );
568 $self->SetReturnAddress();
569 $self->SetReferencesHeaders();
571 unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
573 # Get Message-ID for this txn
575 if ( my $msg = $self->TransactionObj->Message->First ) {
576 $msgid = $msg->GetHeader("RT-Message-ID")
577 || $msg->GetHeader("Message-ID");
580 # If there is one, and we can parse it, then base our Message-ID on it
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
591 $self->SetHeader( "Message-ID" => $msgid );
594 'Message-ID' => RT::Interface::Email::GenMessageId(
595 Ticket => $self->TicketObj,
596 Scrip => $self->ScripObj,
597 ScripAction => $self->ScripActionObj
603 if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
604 and !$self->TemplateObj->MIMEObj->head->get("Precedence")
606 $self->SetHeader( 'Precedence', $precedence );
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/)" );
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')
620 $self->SetHeader( 'RT-Originator', $email );
626 sub DeferDigestRecipients {
628 $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
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 = {};
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} } ) );
646 # Store the 'daily digest' folk in an array.
647 my ( @send_now, @daily_digest, @weekly_digest, @suspended );
649 # Have to get the list of addresses directly from the MIME header
651 $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
652 foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
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 );
664 my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
665 $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
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 ) }
673 # Reset the relevant mail field.
674 $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
676 $self->SetHeader( $mailfield, join( ', ', @send_now ) );
677 } else { # No recipients! Remove the header.
678 $self->TemplateObj->MIMEObj->head->delete($mailfield);
681 # Push the deferred addresses into the appropriate field in
682 # our attribute hash, with the appropriate mail header.
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);
690 if ( scalar keys %$digest_hash ) {
692 # Save the hash so that we can add it as an attribute to the
693 # outgoing email transaction.
694 $self->{'Deferred'} = $digest_hash;
696 $RT::Logger->debug( "No recipients found for deferred delivery on "
698 . $self->TransactionObj->id );
704 sub RecordDeferredRecipients {
706 return unless exists $self->{'Deferred'};
708 my $txn_id = $self->{'OutgoingMailTransaction'};
709 return unless $txn_id;
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'}
717 $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
725 Returns list of the addresses to squelch on this transaction.
731 return map $_->Content, $self->TransactionObj->SquelchMailTo;
734 =head2 RemoveInappropriateRecipients
736 Remove addresses that are RT addresses or that are on this transaction's blacklist
740 sub RemoveInappropriateRecipients {
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
748 my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
749 if ( my $attachment = $self->TransactionObj->Attachments->First ) {
751 if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
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.
757 if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
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."
765 } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
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;
777 $RT::Logger->info( $msgid
778 . " The incoming message was autogenerated. "
779 . "Not redistributing this message to unprivileged users based on site configuration."
784 if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
785 push @blacklist, split( /,/, $squelch );
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;
792 # Cycle through the people we're sending to and pull out anyone on the
795 # Trim leading and trailing spaces.
796 @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
797 Email::Address->parse( join ', ', grep defined, @blacklist );
799 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
801 foreach my $addr ( @{ $self->{$type} } ) {
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" );
809 if ( grep $addr eq $_, @blacklist ) {
810 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
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" );
823 @{ $self->{$type} } = @addrs;
827 =head2 SetReturnAddress is_comment => BOOLEAN
829 Calculate and set From and Reply-To headers based on the is_comment flag.
833 sub SetReturnAddress {
838 friendly_name => undef,
843 # $args{is_comment} should be set if the comment address is to be used.
846 if ( $args{'is_comment'} ) {
847 $replyto = $self->TicketObj->QueueObj->CommentAddress
848 || RT->Config->Get('CommentAddress');
850 $replyto = $self->TicketObj->QueueObj->CorrespondAddress
851 || RT->Config->Get('CorrespondAddress');
854 unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
855 $self->SetFrom( %args, From => $replyto );
858 unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
859 $self->SetHeader( 'Reply-To', "$replyto" );
864 =head2 SetFrom ( From => emailaddress )
866 Set the From: address for outgoing email
874 my $from = $args{From};
876 if ( RT->Config->Get('UseFriendlyFromLine') ) {
877 my $friendly_name = $self->GetFriendlyName(%args);
880 RT->Config->Get('FriendlyFromLineFormat'),
881 $self->MIMEEncodeString(
882 $friendly_name, RT->Config->Get('EmailOutputEncoding')
888 $self->SetHeader( 'From', $from );
890 #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine,
891 #and then Outlook prepends "rt@machine on behalf of" to the From: header
892 $self->SetHeader( 'Sender', $from );
895 =head2 GetFriendlyName
897 Calculate the proper Friendly Name based on the creator of the transaction
901 sub GetFriendlyName {
908 my $friendly_name = $args{friendly_name};
910 unless ( $friendly_name ) {
911 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
912 if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
917 $friendly_name =~ s/"/\\"/g;
918 return $friendly_name;
922 =head2 SetHeader FIELD, VALUE
924 Set the FIELD of the current MIME object into VALUE.
935 my $head = $self->TemplateObj->MIMEObj->head;
936 $head->fold_length( $field, 10000 );
937 $head->replace( $field, $val );
938 return $head->get($field);
943 This routine sets the subject. it does not add the rt tag. That gets done elsewhere
944 If subject is already defined via template, it uses that. otherwise, it tries to get
945 the transaction's subject.
953 if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
957 # don't use Transaction->Attachments because it caches
958 # and anything which later calls ->Attachments will be hurt
959 # by our RowsPerPage() call. caching is hard.
960 my $message = RT::Attachments->new( $self->CurrentUser );
961 $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
962 $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
963 $message->RowsPerPage(1);
965 if ( $self->{'Subject'} ) {
966 $subject = $self->{'Subject'};
967 } elsif ( my $first = $message->First ) {
968 my $tmp = $first->GetHeader('Subject');
969 $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
971 $subject = $self->TicketObj->Subject;
973 $subject = '' unless defined $subject;
976 $subject =~ s/(\r\n|\n|\s)/ /g;
978 $self->SetHeader( 'Subject', $subject );
982 =head2 SetSubjectToken
984 This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
988 sub SetSubjectToken {
991 my $head = $self->TemplateObj->MIMEObj->head;
993 Subject => RT::Interface::Email::AddSubjectTag(
994 Encode::decode_utf8( $head->get('Subject') ),
1000 =head2 SetReferencesHeaders
1002 Set References and In-Reply-To headers for this message.
1006 sub SetReferencesHeaders {
1009 my $top = $self->TransactionObj->Message->First;
1011 $self->SetHeader( References => $self->PseudoReference );
1015 my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1016 my @references = split( /\s+/m, $top->GetHeader('References') || '' );
1017 my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
1019 # There are two main cases -- this transaction was created with
1020 # the RT Web UI, and hence we want to *not* append its Message-ID
1021 # to the References and In-Reply-To. OR it came from an outside
1022 # source, and we should treat it as per the RFC
1023 my $org = RT->Config->Get('Organization');
1024 if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1026 # Make all references which are internal be to version which we
1029 for ( @references, @in_reply_to ) {
1030 s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1031 "<$1." . $self->TicketObj->id .
1032 "-" . $self->ScripObj->id .
1033 "-" . $self->ScripActionObj->{_Message_ID} .
1037 # In reply to whatever the internal message was in reply to
1038 $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1040 # Default the references to whatever we're in reply to
1041 @references = @in_reply_to unless @references;
1043 # References are unchanged from internal
1046 # In reply to that message
1047 $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1049 # Default the references to whatever we're in reply to
1050 @references = @in_reply_to unless @references;
1052 # Push that message onto the end of the references
1053 push @references, @msgid;
1056 # Push pseudo-ref to the front
1057 my $pseudo_ref = $self->PseudoReference;
1058 @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1060 # If there are more than 10 references headers, remove all but the
1061 # first four and the last six (Gotta keep this from growing
1063 splice( @references, 4, -6 ) if ( $#references >= 10 );
1065 # Add on the references
1066 $self->SetHeader( 'References', join( " ", @references ) );
1067 $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1071 =head2 PseudoReference
1073 Returns a fake Message-ID: header for the ticket to allow a base level of threading
1077 sub PseudoReference {
1082 . $self->TicketObj->id . '@'
1083 . RT->Config->Get('Organization') . '>';
1087 =head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1089 This routine converts the field into specified charset encoding.
1093 sub SetHeaderAsEncoding {
1095 my ( $field, $enc ) = ( shift, shift );
1097 my $head = $self->TemplateObj->MIMEObj->head;
1099 if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1100 $head->replace( $field, RT->Config->Get('SMTPFrom') );
1104 my $value = $head->get( $field );
1105 $value = $self->MIMEEncodeString( $value, $enc );
1106 $head->replace( $field, $value );
1110 =head2 MIMEEncodeString
1112 Takes a perl string and optional encoding pass it over
1113 L<RT::Interface::Email/EncodeToMIME>.
1115 Basicly encode a string using B encoding according to RFC2047.
1119 sub MIMEEncodeString {
1121 return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1124 RT::Base->_ImportOverlays();