-# BEGIN LICENSE BLOCK
-#
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-#
-# (Except where explictly superceded by other copyright notices)
-#
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
-#
+#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
-#
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-#
-#
-# END LICENSE BLOCK
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
# Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
package RT::Action::SendEmail;
-require RT::Action::Generic;
use strict;
-use vars qw/@ISA/;
-@ISA = qw(RT::Action::Generic);
+use warnings;
-use MIME::Words qw(encode_mimeword);
+use base qw(RT::Action);
use RT::EmailParser;
+use RT::Interface::Email;
+use Email::Address;
+our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);
+
=head1 NAME
=head1 SYNOPSIS
- require RT::Action::SendEmail;
- @ISA = qw(RT::Action::SendEmail);
-
+ use base 'RT::Action::SendEmail';
=head1 DESCRIPTION
Basically, you create another module RT::Action::YourAction which ISA
RT::Action::SendEmail.
-If you want to set the recipients of the mail to something other than
-the addresses mentioned in the To, Cc, Bcc and headers in
-the template, you should subclass RT::Action::SendEmail and override
-either the SetRecipients method or the SetTo, SetCc, etc methods (see
-the comments for the SetRecipients sub).
+=head1 METHODS
+=head2 CleanSlate
-=begin testing
+Cleans class-wide options, like L</AttachTickets>.
-ok (require RT::Action::SendEmail);
+=cut
-=end testing
+sub CleanSlate {
+ my $self = shift;
+ $self->AttachTickets(undef);
+}
+=head2 Commit
-=head1 AUTHOR
+Sends the prepared message and writes outgoing record into DB if the feature is
+activated in the config.
-Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
+=cut
-=head1 SEE ALSO
+sub Commit {
+ my $self = shift;
-perl(1).
+ return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
+ unless RT->Config->Get('RecordOutgoingEmail');
-=cut
+ $self->DeferDigestRecipients();
+ my $message = $self->TemplateObj->MIMEObj;
-# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
+ my $orig_message;
+ $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
+ Attachment => $self->TransactionObj->Attachments->First,
+ Ticket => $self->TicketObj,
+ );
-# {{{ sub _Init
-# We use _Init from RT::Action
-# }}}
+ my ($ret) = $self->SendMessage($message);
+ return abs( $ret ) if $ret <= 0;
-# {{{ sub Commit
-#Do what we need to do and send it out.
-sub Commit {
- my $self = shift;
+ if ($orig_message) {
+ $message->attach(
+ Type => 'application/x-rt-original-message',
+ Disposition => 'inline',
+ Data => $orig_message->as_string,
+ );
+ }
+ $self->RecordOutgoingMailTransaction($message);
+ $self->RecordDeferredRecipients();
+ return 1;
+}
- my $MIMEObj = $self->TemplateObj->MIMEObj;
- my $msgid = $MIMEObj->head->get('Message-Id');
- chomp $msgid;
- $RT::Logger->info($msgid." #".$self->TicketObj->id."/".$self->TransactionObj->id." - Scrip ". $self->ScripObj->id ." ".$self->ScripObj->Description);
- #send the email
+=head2 Prepare
- # Weed out any RT addresses. We really don't want to talk to ourselves!
- @{$self->{'To'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'To'}});
- @{$self->{'Cc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Cc'}});
- @{$self->{'Bcc'}} = RT::EmailParser::CullRTAddresses("", @{$self->{'Bcc'}});
- # If there are no recipients, don't try to send the message.
- # If the transaction has content and has the header RT-Squelch-Replies-To
+Builds an outgoing email we're going to send using scrip's template.
- if ( defined $self->TransactionObj->Attachments->First() ) {
+=cut
- my $squelch = $self->TransactionObj->Attachments->First->GetHeader( 'RT-Squelch-Replies-To');
+sub Prepare {
+ my $self = shift;
- if ($squelch) {
- my @blacklist = split ( /,/, $squelch );
+ unless ( $self->TemplateObj->MIMEObj ) {
+ my ( $result, $message ) = $self->TemplateObj->Parse(
+ Argument => $self->Argument,
+ TicketObj => $self->TicketObj,
+ TransactionObj => $self->TransactionObj
+ );
+ if ( !$result ) {
+ return (undef);
+ }
+ }
- # Cycle through the people we're sending to and pull out anyone on the
- # system blacklist
+ my $MIMEObj = $self->TemplateObj->MIMEObj;
- foreach my $person_to_yank (@blacklist) {
- $person_to_yank =~ s/\s//g;
- @{ $self->{'To'} } =
- grep ( !/^$person_to_yank$/, @{ $self->{'To'} } );
- @{ $self->{'Cc'} } =
- grep ( !/^$person_to_yank$/, @{ $self->{'Cc'} } );
- @{ $self->{'Bcc'} } =
- grep ( !/^$person_to_yank$/, @{ $self->{'Bcc'} } );
- }
- }
+ # Header
+ $self->SetRTSpecialHeaders();
+
+ my %seen;
+ foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
+ @{ $self->{$type} }
+ = grep defined && length && !$seen{ lc $_ }++,
+ @{ $self->{$type} };
}
+ $self->RemoveInappropriateRecipients();
+
# Go add all the Tos, Ccs and Bccs that we need to to the message to
# make it happy, but only if we actually have values in those arrays.
- $self->SetHeader( 'To', join ( ',', @{ $self->{'To'} } ) )
- if ( $self->{'To'} && @{ $self->{'To'} } );
- $self->SetHeader( 'Cc', join ( ',', @{ $self->{'Cc'} } ) )
- if ( $self->{'Cc'} && @{ $self->{'Cc'} } );
- $self->SetHeader( 'Bcc', join ( ',', @{ $self->{'Bcc'} } ) )
- if ( $self->{'Cc'} && @{ $self->{'Bcc'} } );
+# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
+ for my $header (@EMAIL_RECIPIENT_HEADERS) {
- $self->SetHeader('MIME-Version', '1.0');
+ $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
+ if (!$MIMEObj->head->get($header)
+ && $self->{$header}
+ && @{ $self->{$header} } );
+ }
+ # PseudoTo (fake to headers) shouldn't get matched for message recipients.
+ # If we don't have any 'To' header (but do have other recipients), drop in
+ # the pseudo-to header.
+ $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
+ if $self->{'PseudoTo'}
+ && @{ $self->{'PseudoTo'} }
+ && !$MIMEObj->head->get('To')
+ && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
+
+ # For security reasons, we only send out textual mails.
+ foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
+ my $type = $part->mime_type || 'text/plain';
+ $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
+ $part->head->mime_attr( "Content-Type" => $type );
+ # utf-8 here is for _FindOrGuessCharset in I18N.pm
+ # it's not the final charset/encoding sent
+ $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
+ }
- # try to convert message body from utf-8 to $RT::EmailOutputEncoding
- $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' );
+ RT::I18N::SetMIMEEntityToEncoding(
+ Entity => $MIMEObj,
+ Encoding => RT->Config->Get('EmailOutputEncoding'),
+ PreserveWords => 1,
+ IsOut => 1,
+ );
- RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' );
- $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' );
+ # Build up a MIME::Entity that looks like the original message.
+ $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
+ && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
+
+ $self->AddTickets;
+
+ my $attachment = $self->TransactionObj->Attachments->First;
+ if ($attachment
+ && !(
+ $attachment->GetHeader('X-RT-Encrypt')
+ || $self->TicketObj->QueueObj->Encrypt
+ )
+ )
+ {
+ $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
+ if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
+ 'Success';
+ }
+ return 1;
+}
- # Build up a MIME::Entity that looks like the original message.
+=head2 To
- my $do_attach = $self->TemplateObj->MIMEObj->head->get('RT-Attach-Message');
+Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
- if ($do_attach) {
- $self->TemplateObj->MIMEObj->head->delete('RT-Attach-Message');
+=cut
- my $attachments = RT::Attachments->new($RT::SystemUser);
- $attachments->Limit( FIELD => 'TransactionId',
- VALUE => $self->TransactionObj->Id );
- $attachments->OrderBy('id');
+sub To {
+ my $self = shift;
+ return ( $self->AddressesFromHeader('To') );
+}
- my $transaction_content_obj = $self->TransactionObj->ContentObj;
+=head2 Cc
- # attach any of this transaction's attachments
- while ( my $attach = $attachments->Next ) {
+Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
- # Don't attach anything blank
- next unless ( $attach->ContentLength );
+=cut
- # We want to make sure that we don't include the attachment that's being sued as the "Content" of this message"
- next
- if ( $transaction_content_obj
- && $transaction_content_obj->Id == $attach->Id
- && $transaction_content_obj->ContentType =~ qr{text/plain}i
- );
- $MIMEObj->make_multipart('mixed');
- $MIMEObj->attach( Type => $attach->ContentType,
- Charset => $attach->OriginalEncoding,
- Data => $attach->OriginalContent,
- Filename => $self->MIMEEncodeString( $attach->Filename, $RT::EmailOutputEncoding ),
- Encoding => '-SUGGEST');
- }
+sub Cc {
+ my $self = shift;
+ return ( $self->AddressesFromHeader('Cc') );
+}
- }
+=head2 Bcc
+Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
- my $retval = $self->SendMessage($MIMEObj);
+=cut
+sub Bcc {
+ my $self = shift;
+ return ( $self->AddressesFromHeader('Bcc') );
- return ($retval);
}
-# }}}
+sub AddressesFromHeader {
+ my $self = shift;
+ my $field = shift;
+ my $header = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field));
+ my @addresses = Email::Address->parse($header);
-# {{{ sub Prepare
+ return (@addresses);
+}
-sub Prepare {
- my $self = shift;
+=head2 SendMessage MIMEObj
- # This actually populates the MIME::Entity fields in the Template Object
+sends the message using RT's preferred API.
+TODO: Break this out to a separate module
- unless ( $self->TemplateObj ) {
- $RT::Logger->warning("No template object handed to $self\n");
- }
+=cut
- unless ( $self->TransactionObj ) {
- $RT::Logger->warning("No transaction object handed to $self\n");
+sub SendMessage {
- }
+ # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
+ # ability to pass @_ to a 'post' routine.
+ my ( $self, $MIMEObj ) = @_;
- unless ( $self->TicketObj ) {
- $RT::Logger->warning("No ticket object handed to $self\n");
+ my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
+ chomp $msgid;
- }
+ $self->ScripActionObj->{_Message_ID}++;
- my ( $result, $message ) = $self->TemplateObj->Parse(
- Argument => $self->Argument,
- TicketObj => $self->TicketObj,
- TransactionObj => $self->TransactionObj
+ $RT::Logger->info( $msgid . " #"
+ . $self->TicketObj->id . "/"
+ . $self->TransactionObj->id
+ . " - Scrip "
+ . ($self->ScripObj->id || '#rule'). " "
+ . ( $self->ScripObj->Description || '' ) );
+
+ my $status = RT::Interface::Email::SendEmail(
+ Entity => $MIMEObj,
+ Ticket => $self->TicketObj,
+ Transaction => $self->TransactionObj,
);
- if ($result) {
-
- # Header
- $self->SetSubject();
- $self->SetSubjectToken();
- $self->SetRecipients();
- $self->SetReturnAddress();
- $self->SetRTSpecialHeaders();
- if ($RT::EmailOutputEncoding) {
-
- # l10n related header
- $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding );
+
+
+ return $status unless ($status > 0 || exists $self->{'Deferred'});
+
+ my $success = $msgid . " sent ";
+ foreach (@EMAIL_RECIPIENT_HEADERS) {
+ my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) );
+ $success .= " $_: " . $recipients if $recipients;
+ }
+
+ if( exists $self->{'Deferred'} ) {
+ for (qw(daily weekly susp)) {
+ $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
+ if exists $self->{'Deferred'}{ $_ };
}
}
- return $result;
+ $success =~ s/\n//g;
+
+ $RT::Logger->info($success);
+ return (1);
}
-# }}}
+=head2 AttachableFromTransaction
-# }}}
+Function (not method) that takes an L<RT::Transaction> and returns an
+L<RT::Attachments> collection of attachments suitable for attaching to an
+email.
-# {{{ SendMessage
-=head2 SendMessage MIMEObj
+=cut
-sends the message using RT's preferred API.
-TODO: Break this out to a seperate module
+sub AttachableFromTransaction {
+ my $txn = shift;
+
+ my $attachments = RT::Attachments->new( RT->SystemUser );
+ $attachments->Limit(
+ FIELD => 'TransactionId',
+ VALUE => $txn->Id
+ );
+
+ # Don't attach anything blank
+ $attachments->LimitNotEmpty;
+ $attachments->OrderBy( FIELD => 'id' );
+
+ # We want to make sure that we don't include the attachment that's
+ # being used as the "Content" of this message" unless that attachment's
+ # content type is not like text/...
+ my $transaction_content_obj = $txn->ContentObj;
+
+ if ( $transaction_content_obj
+ && $transaction_content_obj->ContentType =~ m{text/}i )
+ {
+ # If this was part of a multipart/alternative, skip all of the kids
+ my $parent = $transaction_content_obj->ParentObj;
+ if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
+ $attachments->Limit(
+ ENTRYAGGREGATOR => 'AND',
+ FIELD => 'parent',
+ OPERATOR => '!=',
+ VALUE => $parent->Id,
+ );
+ } else {
+ $attachments->Limit(
+ ENTRYAGGREGATOR => 'AND',
+ FIELD => 'id',
+ OPERATOR => '!=',
+ VALUE => $transaction_content_obj->Id,
+ );
+ }
+ }
+
+ return $attachments;
+}
+
+=head2 AddAttachments
+
+Takes any attachments to this transaction and attaches them to the message
+we're building.
=cut
-sub SendMessage {
+sub AddAttachments {
my $self = shift;
- my $MIMEObj = shift;
- my $msgid = $MIMEObj->head->get('Message-Id');
+ my $MIMEObj = $self->TemplateObj->MIMEObj;
+
+ $MIMEObj->head->delete('RT-Attach-Message');
+ my $attachments = AttachableFromTransaction($self->TransactionObj);
- #If we don't have any recipients to send to, don't send a message;
- unless ( $MIMEObj->head->get('To')
- || $MIMEObj->head->get('Cc')
- || $MIMEObj->head->get('Bcc') ) {
- $RT::Logger->info($msgid. " No recipients found. Not sending.\n");
- return (1);
+ # attach any of this transaction's attachments
+ my $seen_attachment = 0;
+ while ( my $attach = $attachments->Next ) {
+ if ( !$seen_attachment ) {
+ $MIMEObj->make_multipart( 'mixed', Force => 1 );
+ $seen_attachment = 1;
+ }
+ $self->AddAttachment($attach);
}
+}
- # PseudoTo (fake to headers) shouldn't get matched for message recipients.
- # If we don't have any 'To' header, drop in the pseudo-to header.
+=head2 AddAttachment $attachment
- $self->SetHeader( 'To', join ( ',', @{ $self->{'PseudoTo'} } ) )
- if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } )
- and ( !$MIMEObj->head->get('To') ) );
- if ( $RT::MailCommand eq 'sendmailpipe' ) {
- eval {
- open( MAIL, "|$RT::SendmailPath $RT::SendmailArguments" );
- print MAIL $MIMEObj->as_string;
- close(MAIL);
- };
- if ($@) {
- $RT::Logger->crit($msgid. "Could not send mail. -".$@ );
- }
+Takes one attachment object of L<RT::Attachment> class and attaches it to the message
+we're building.
+
+=cut
+
+sub AddAttachment {
+ my $self = shift;
+ my $attach = shift;
+ my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
+
+ # $attach->TransactionObj may not always be $self->TransactionObj
+ return unless $attach->Id
+ and $attach->TransactionObj->CurrentUserCanSee;
+
+ # ->attach expects just the disposition type; extract it if we have the header
+ # or default to "attachment"
+ my $disp = ($attach->GetHeader('Content-Disposition') || '')
+ =~ /^\s*(inline|attachment)/i ? $1 : "attachment";
+
+ $MIMEObj->attach(
+ Type => $attach->ContentType,
+ Charset => $attach->OriginalEncoding,
+ Data => $attach->OriginalContent,
+ Disposition => $disp,
+ Filename => $self->MIMEEncodeString( $attach->Filename ),
+ Id => $attach->GetHeader('Content-ID'),
+ 'RT-Attachment:' => $self->TicketObj->Id . "/"
+ . $self->TransactionObj->Id . "/"
+ . $attach->id,
+ Encoding => '-SUGGEST',
+ );
+}
+
+=head2 AttachTickets [@IDs]
+
+Returns or set list of ticket's IDs that should be attached to an outgoing message.
+
+B<Note> this method works as a class method and setup things global, so you have to
+clean list by passing undef as argument.
+
+=cut
+
+{
+ my $list = [];
+
+ sub AttachTickets {
+ my $self = shift;
+ $list = [ grep defined, @_ ] if @_;
+ return @$list;
}
- else {
- my @mailer_args = ($RT::MailCommand);
- local $ENV{MAILADDRESS};
+}
- if ( $RT::MailCommand eq 'sendmail' ) {
- push @mailer_args, $RT::SendmailArguments;
- }
- elsif ( $RT::MailCommand eq 'smtp' ) {
- $ENV{MAILADDRESS} = $RT::SMTPFrom || $MIMEObj->head->get('From');
- push @mailer_args, (Server => $RT::SMTPServer);
- push @mailer_args, (Debug => $RT::SMTPDebug);
- }
- else {
- push @mailer_args, $RT::MailParams;
- }
+=head2 AddTickets
+
+Attaches tickets to the current message, list of tickets' ids get from
+L</AttachTickets> method.
+
+=cut
+
+sub AddTickets {
+ my $self = shift;
+ $self->AddTicket($_) foreach $self->AttachTickets;
+ return;
+}
+
+=head2 AddTicket $ID
- unless ( $MIMEObj->send( @mailer_args ) ) {
- $RT::Logger->crit($msgid. "Could not send mail." );
- return (0);
+Attaches a ticket with ID to the message.
+
+Each ticket is attached as multipart entity and all its messages and attachments
+are attached as sub entities in order of creation, but only if transaction type
+is Create or Correspond.
+
+=cut
+
+sub AddTicket {
+ my $self = shift;
+ my $tid = shift;
+
+ my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj );
+ my $txn_alias = $attachs->TransactionAlias;
+ $attachs->Limit(
+ ALIAS => $txn_alias,
+ FIELD => 'Type',
+ OPERATOR => 'IN',
+ VALUE => [qw(Create Correspond)],
+ );
+ $attachs->LimitByTicket($tid);
+ $attachs->LimitNotEmpty;
+ $attachs->OrderBy( FIELD => 'Created' );
+
+ my $ticket_mime = MIME::Entity->build(
+ Type => 'multipart/mixed',
+ Top => 0,
+ Description => "ticket #$tid",
+ );
+ while ( my $attachment = $attachs->Next ) {
+ $self->AddAttachment( $attachment, $ticket_mime );
+ }
+ if ( $ticket_mime->parts ) {
+ my $email_mime = $self->TemplateObj->MIMEObj;
+ $email_mime->make_multipart;
+ $email_mime->add_part($ticket_mime);
+ }
+ return;
+}
+
+=head2 RecordOutgoingMailTransaction MIMEObj
+
+Record a transaction in RT with this outgoing message for future record-keeping purposes
+
+=cut
+
+sub RecordOutgoingMailTransaction {
+ my $self = shift;
+ my $MIMEObj = shift;
+
+ my @parts = $MIMEObj->parts;
+ my @attachments;
+ my @keep;
+ foreach my $part (@parts) {
+ my $attach = $part->head->get('RT-Attachment');
+ if ($attach) {
+ $RT::Logger->debug(
+ "We found an attachment. we want to not record it.");
+ push @attachments, $attach;
+ } else {
+ $RT::Logger->debug("We found a part. we want to record it.");
+ push @keep, $part;
}
}
+ $MIMEObj->parts( \@keep );
+ foreach my $attachment (@attachments) {
+ $MIMEObj->head->add( 'RT-Attachment', $attachment );
+ }
+ RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
- my $success = ($msgid. " sent To: ".$MIMEObj->head->get('To') . " Cc: ".$MIMEObj->head->get('Cc') . " Bcc: ".$MIMEObj->head->get('Bcc'));
- $success =~ s/\n//gi;
- $RT::Logger->info($success);
+ my $transaction
+ = RT::Transaction->new( $self->TransactionObj->CurrentUser );
- return (1);
-}
+# XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
-# }}}
+ my $type;
+ if ( $self->TransactionObj->Type eq 'Comment' ) {
+ $type = 'CommentEmailRecord';
+ } else {
+ $type = 'EmailRecord';
+ }
-# {{{ Deal with message headers (Set* subs, designed for easy overriding)
+ my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
+ chomp $msgid;
-# {{{ sub SetRTSpecialHeaders
+ my ( $id, $msg ) = $transaction->Create(
+ Ticket => $self->TicketObj->Id,
+ Type => $type,
+ Data => $msgid,
+ MIMEObj => $MIMEObj,
+ ActivateScrips => 0
+ );
+
+ if ($id) {
+ $self->{'OutgoingMailTransaction'} = $id;
+ } else {
+ $RT::Logger->warning(
+ "Could not record outgoing message transaction: $msg");
+ }
+ return $id;
+}
=head2 SetRTSpecialHeaders
sub SetRTSpecialHeaders {
my $self = shift;
- $self->SetReferences();
+ $self->SetSubject();
+ $self->SetSubjectToken();
+ $self->SetHeaderAsEncoding( 'Subject',
+ RT->Config->Get('EmailOutputEncoding') )
+ if ( RT->Config->Get('EmailOutputEncoding') );
+ $self->SetReturnAddress();
+ $self->SetReferencesHeaders();
+
+ unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
+
+ # Get Message-ID for this txn
+ my $msgid = "";
+ if ( my $msg = $self->TransactionObj->Message->First ) {
+ $msgid = $msg->GetHeader("RT-Message-ID")
+ || $msg->GetHeader("Message-ID");
+ }
- $self->SetMessageID();
+ # If there is one, and we can parse it, then base our Message-ID on it
+ if ( $msgid
+ and $msgid
+ =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
+ "<$1." . $self->TicketObj->id
+ . "-" . $self->ScripObj->id
+ . "-" . $self->ScripActionObj->{_Message_ID}
+ . "@" . RT->Config->Get('Organization') . ">"/eg
+ and $2 == $self->TicketObj->id
+ )
+ {
+ $self->SetHeader( "Message-ID" => $msgid );
+ } else {
+ $self->SetHeader(
+ 'Message-ID' => RT::Interface::Email::GenMessageId(
+ Ticket => $self->TicketObj,
+ Scrip => $self->ScripObj,
+ ScripAction => $self->ScripActionObj
+ ),
+ );
+ }
+ }
- $self->SetPrecedence();
+ $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
+ $self->SetHeader( 'X-RT-Ticket',
+ RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
+ $self->SetHeader( 'X-Managed-by',
+ "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
+
+# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
+# refactored into user's method.
+ if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
+ and ! defined $self->TemplateObj->MIMEObj->head->get("RT-Originator")
+ and RT->Config->Get('UseOriginatorHeader')
+ ) {
+ $self->SetHeader( 'X-RT-Originator', $email );
+ }
- $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname );
- $self->SetHeader( 'RT-Ticket',
- $RT::rtname . " #" . $self->TicketObj->id() );
- $self->SetHeader( 'Managed-by',
- "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
+}
- $self->SetHeader( 'RT-Originator',
- $self->TransactionObj->CreatorObj->EmailAddress );
- return ();
-}
+sub DeferDigestRecipients {
+ my $self = shift;
+ $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
+
+ # The digest attribute will be an array of notifications that need to
+ # be sent for this transaction. The array will have the following
+ # format for its objects.
+ # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
+ # -> sent -> {true|false}
+ # The "sent" flag will be used by the cron job to indicate that it has
+ # run on this transaction.
+ # In a perfect world we might move this hash construction to the
+ # extension module itself.
+ my $digest_hash = {};
+
+ foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
+ # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
+ next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
+ $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
+
+ # Store the 'daily digest' folk in an array.
+ my ( @send_now, @daily_digest, @weekly_digest, @suspended );
+
+ # Have to get the list of addresses directly from the MIME header
+ # at this point.
+ $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) );
+ foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
+ next unless $rcpt;
+ my $user_obj = RT::User->new(RT->SystemUser);
+ $user_obj->LoadByEmail($rcpt);
+ if ( ! $user_obj->id ) {
+ # If there's an email address in here without an associated
+ # RT user, pass it on through.
+ $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail.");
+ push( @send_now, $rcpt );
+ next;
+ }
-# {{{ sub SetReferences
+ my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
+ $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
-=head2 SetReferences
-
- # This routine will set the References: and In-Reply-To headers,
-# autopopulating it with all the correspondence on this ticket so
-# far. This should make RT responses threadable.
+ if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
+ elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
+ elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
+ else { push( @send_now, $rcpt ) }
+ }
-=cut
+ # Reset the relevant mail field.
+ $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
+ if (@send_now) {
+ $self->SetHeader( $mailfield, join( ', ', @send_now ) );
+ } else { # No recipients! Remove the header.
+ $self->TemplateObj->MIMEObj->head->delete($mailfield);
+ }
+
+ # Push the deferred addresses into the appropriate field in
+ # our attribute hash, with the appropriate mail header.
+ $RT::Logger->debug(
+ "Setting deferred recipients for attribute creation");
+ $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest);
+ $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest);
+ $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended);
+ }
+
+ if ( scalar keys %$digest_hash ) {
+
+ # Save the hash so that we can add it as an attribute to the
+ # outgoing email transaction.
+ $self->{'Deferred'} = $digest_hash;
+ } else {
+ $RT::Logger->debug( "No recipients found for deferred delivery on "
+ . "transaction #"
+ . $self->TransactionObj->id );
+ }
+}
-sub SetReferences {
+
+
+sub RecordDeferredRecipients {
my $self = shift;
+ return unless exists $self->{'Deferred'};
- # TODO: this one is broken. What is this email really a reply to?
- # If it's a reply to an incoming message, we'll need to use the
- # actual message-id from the appropriate Attachment object. For
- # incoming mails, we would like to preserve the In-Reply-To and/or
- # References.
+ my $txn_id = $self->{'OutgoingMailTransaction'};
+ return unless $txn_id;
- $self->SetHeader( 'In-Reply-To',
- "<rt-" . $self->TicketObj->id() . "\@" . $RT::rtname . ">" );
+ my $txn_obj = RT::Transaction->new( $self->CurrentUser );
+ $txn_obj->Load( $txn_id );
+ my( $ret, $msg ) = $txn_obj->AddAttribute(
+ Name => 'DeferredRecipients',
+ Content => $self->{'Deferred'}
+ );
+ $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
+ unless $ret;
- # TODO We should always add References headers for all message-ids
- # of previous messages related to this ticket.
+ return ($ret,$msg);
}
-# }}}
+=head2 SquelchMailTo
-# {{{ sub SetMessageID
+Returns list of the addresses to squelch on this transaction.
-=head2 SetMessageID
+=cut
-Without this one, threading won't work very nice in email agents.
-Anyway, I'm not really sure it's that healthy if we need to send
-several separate/different emails about the same transaction.
+sub SquelchMailTo {
+ my $self = shift;
+ return map $_->Content, $self->TransactionObj->SquelchMailTo;
+}
+
+=head2 RemoveInappropriateRecipients
+
+Remove addresses that are RT addresses or that are on this transaction's blacklist
=cut
-sub SetMessageID {
+my %squelch_reasons = (
+ 'not privileged'
+ => "because autogenerated messages are configured to only be sent to privileged users (RedistributeAutoGeneratedMessages)",
+ 'squelch:attachment'
+ => "by RT-Squelch-Replies-To header in the incoming message",
+ 'squelch:transaction'
+ => "by notification checkboxes for this transaction",
+ 'squelch:ticket'
+ => "by notification checkboxes on this ticket's People page",
+);
+
+
+sub RemoveInappropriateRecipients {
my $self = shift;
- # TODO this one might be sort of broken. If we have several scrips +++
- # sending several emails to several different persons, we need to
- # pull out different message-ids. I'd suggest message ids like
- # "rt-ticket#-transaction#-scrip#-receipient#"
-
- $self->SetHeader( 'Message-ID',
- "<rt-"
- . $RT::VERSION ."-"
- . $self->TicketObj->id() . "-"
- . $self->TransactionObj->id() . "."
- . rand(20) . "\@"
- . $RT::Organization . ">" )
- unless $self->TemplateObj->MIMEObj->head->get('Message-ID');
+ my %blacklist = ();
+
+ # If there are no recipients, don't try to send the message.
+ # If the transaction has content and has the header RT-Squelch-Replies-To
+
+ my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') );
+ chomp $msgid;
+
+ if ( my $attachment = $self->TransactionObj->Attachments->First ) {
+
+ if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
+
+ # What do we want to do with this? It's probably (?) a bounce
+ # caused by one of the watcher addresses being broken.
+ # Default ("true") is to redistribute, for historical reasons.
+
+ my $redistribute = RT->Config->Get('RedistributeAutoGeneratedMessages');
+
+ if ( !$redistribute ) {
+
+ # Don't send to any watchers.
+ @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
+ $RT::Logger->info( $msgid
+ . " The incoming message was autogenerated. "
+ . "Not redistributing this message based on site configuration."
+ );
+ } elsif ( $redistribute eq 'privileged' ) {
+
+ # Only send to "privileged" watchers.
+ foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
+ foreach my $addr ( @{ $self->{$type} } ) {
+ my $user = RT::User->new(RT->SystemUser);
+ $user->LoadByEmail($addr);
+ $blacklist{ $addr } ||= 'not privileged'
+ unless $user->id && $user->Privileged;
+ }
+ }
+ $RT::Logger->info( $msgid
+ . " The incoming message was autogenerated. "
+ . "Not redistributing this message to unprivileged users based on site configuration."
+ );
+ }
+ }
+
+ if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
+ $blacklist{ $_->address } ||= 'squelch:attachment'
+ foreach Email::Address->parse( $squelch );
+ }
+ }
+
+ # Let's grab the SquelchMailTo attributes and push those entries
+ # into the blacklisted
+ $blacklist{ $_->Content } ||= 'squelch:transaction'
+ foreach $self->TransactionObj->SquelchMailTo;
+ $blacklist{ $_->Content } ||= 'squelch:ticket'
+ foreach $self->TicketObj->SquelchMailTo;
+
+ # canonicalize emails
+ foreach my $address ( keys %blacklist ) {
+ my $reason = delete $blacklist{ $address };
+ $blacklist{ lc $_ } = $reason
+ foreach map RT::User->CanonicalizeEmailAddress( $_->address ),
+ Email::Address->parse( $address );
+ }
+
+ $self->RecipientFilter(
+ Callback => sub {
+ return unless RT::EmailParser->IsRTAddress( $_[0] );
+ return "$_[0] appears to point to this RT instance. Skipping";
+ },
+ All => 1,
+ );
+
+ $self->RecipientFilter(
+ Callback => sub {
+ return unless $blacklist{ lc $_[0] };
+ return "$_[0] is blacklisted $squelch_reasons{ $blacklist{ lc $_[0] } }. Skipping";
+ },
+ );
+
+
+ # Cycle through the people we're sending to and pull out anyone that meets any of the callbacks
+ for my $type (@EMAIL_RECIPIENT_HEADERS) {
+ my @addrs;
+
+ ADDRESS:
+ for my $addr ( @{ $self->{$type} } ) {
+ for my $filter ( map {$_->{Callback}} @{$self->{RecipientFilter}} ) {
+ my $skip = $filter->($addr);
+ next unless $skip;
+ $RT::Logger->info( "$msgid $skip" );
+ next ADDRESS;
+ }
+ push @addrs, $addr;
+ }
+
+ NOSQUELCH_ADDRESS:
+ for my $addr ( @{ $self->{NoSquelch}{$type} } ) {
+ for my $filter ( map {$_->{Callback}} grep {$_->{All}} @{$self->{RecipientFilter}} ) {
+ my $skip = $filter->($addr);
+ next unless $skip;
+ $RT::Logger->info( "$msgid $skip" );
+ next NOSQUELCH_ADDRESS;
+ }
+ push @addrs, $addr;
+ }
+
+ @{ $self->{$type} } = @addrs;
+ }
}
-# }}}
+=head2 RecipientFilter Callback => SUB, [All => 1]
-# }}}
+Registers a filter to be applied to addresses by
+L<RemoveInappropriateRecipients>. The C<Callback> will be called with
+one address at a time, and should return false if the address should
+receive mail, or a message explaining why it should not be. Passing a
+true value for C<All> will cause the filter to also be applied to
+NoSquelch (one-time Cc and Bcc) recipients as well.
+
+=cut
-# {{{ sub SetReturnAddress
+sub RecipientFilter {
+ my $self = shift;
+ push @{ $self->{RecipientFilter}}, {@_};
+}
=head2 SetReturnAddress is_comment => BOOLEAN
sub SetReturnAddress {
my $self = shift;
- my %args = ( is_comment => 0,
- @_ );
+ my %args = (
+ is_comment => 0,
+ friendly_name => undef,
+ @_
+ );
# From and Reply-To
# $args{is_comment} should be set if the comment address is to be used.
if ( $args{'is_comment'} ) {
$replyto = $self->TicketObj->QueueObj->CommentAddress
- || $RT::CommentAddress;
- }
- else {
+ || RT->Config->Get('CommentAddress');
+ } else {
$replyto = $self->TicketObj->QueueObj->CorrespondAddress
- || $RT::CorrespondAddress;
+ || RT->Config->Get('CorrespondAddress');
}
unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
- if ($RT::UseFriendlyFromLine) {
- my $friendly_name = $self->TransactionObj->CreatorObj->RealName;
- if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
- $friendly_name = $1;
- }
-
- $friendly_name =~ s/"/\\"/g;
- $self->SetHeader( 'From',
- sprintf($RT::FriendlyFromLineFormat,
- $self->MIMEEncodeString( $friendly_name, $RT::EmailOutputEncoding ), $replyto),
- );
- }
- else {
- $self->SetHeader( 'From', $replyto );
- }
+ $self->SetFrom( %args, From => $replyto );
}
unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
}
-# }}}
+=head2 SetFrom ( From => emailaddress )
-# {{{ sub SetHeader
-
-=head2 SetHeader FIELD, VALUE
-
-Set the FIELD of the current MIME object into VALUE.
+Set the From: address for outgoing email
=cut
-sub SetHeader {
- my $self = shift;
- my $field = shift;
- my $val = shift;
-
- chomp $val;
- chomp $field;
- $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 );
- $self->TemplateObj->MIMEObj->head->replace( $field, $val );
- return $self->TemplateObj->MIMEObj->head->get($field);
-}
+sub SetFrom {
+ my $self = shift;
+ my %args = @_;
+
+ my $from = $args{From};
+
+ if ( RT->Config->Get('UseFriendlyFromLine') ) {
+ my $friendly_name = $self->GetFriendlyName(%args);
+ $from =
+ sprintf(
+ RT->Config->Get('FriendlyFromLineFormat'),
+ $self->MIMEEncodeString(
+ $friendly_name, RT->Config->Get('EmailOutputEncoding')
+ ),
+ $args{From}
+ );
+ }
-# }}}
+ $self->SetHeader( 'From', $from );
-# {{{ sub SetRecipients
+ #also set Sender:, otherwise MTAs add a nonsensical value like rt@machine,
+ #and then Outlook prepends "rt@machine on behalf of" to the From: header
+ $self->SetHeader( 'Sender', $from );
+}
-=head2 SetRecipients
+=head2 GetFriendlyName
-Dummy method to be overriden by subclasses which want to set the recipients.
+Calculate the proper Friendly Name based on the creator of the transaction
=cut
-sub SetRecipients {
+sub GetFriendlyName {
my $self = shift;
- return ();
-}
+ my %args = (
+ is_comment => 0,
+ friendly_name => '',
+ @_
+ );
+ my $friendly_name = $args{friendly_name};
-# }}}
+ unless ( $friendly_name ) {
+ $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
+ if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
+ $friendly_name = $1;
+ }
+ }
-# {{{ sub SetTo
+ $friendly_name =~ s/"/\\"/g;
+ return $friendly_name;
-=head2 SetTo
+}
-Takes a string that is the addresses you want to send mail to
+=head2 SetHeader FIELD, VALUE
+
+Set the FIELD of the current MIME object into VALUE, which should be in
+characters, not bytes. Returns the new header, in bytes.
=cut
-sub SetTo {
- my $self = shift;
- my $addresses = shift;
- return $self->SetHeader( 'To', $addresses );
+sub SetHeader {
+ my $self = shift;
+ my $field = shift;
+ my $val = shift;
+
+ chomp $val;
+ chomp $field;
+ my $head = $self->TemplateObj->MIMEObj->head;
+ $head->fold_length( $field, 10000 );
+ $head->replace( $field, Encode::encode( "UTF-8", $val ) );
+ return $head->get($field);
}
-# }}}
+=head2 SetSubject
-# {{{ sub SetCc
+This routine sets the subject. it does not add the rt tag. That gets done elsewhere
+If subject is already defined via template, it uses that. otherwise, it tries to get
+the transaction's subject.
-=head2 SetCc
+=cut
-Takes a string that is the addresses you want to Cc
+sub SetSubject {
+ my $self = shift;
+ my $subject;
-=cut
+ if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
+ return ();
+ }
-sub SetCc {
- my $self = shift;
- my $addresses = shift;
+ # don't use Transaction->Attachments because it caches
+ # and anything which later calls ->Attachments will be hurt
+ # by our RowsPerPage() call. caching is hard.
+ my $message = RT::Attachments->new( $self->CurrentUser );
+ $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
+ $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
+ $message->RowsPerPage(1);
+
+ if ( $self->{'Subject'} ) {
+ $subject = $self->{'Subject'};
+ } elsif ( my $first = $message->First ) {
+ my $tmp = $first->GetHeader('Subject');
+ $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
+ } else {
+ $subject = $self->TicketObj->Subject;
+ }
+ $subject = '' unless defined $subject;
+ chomp $subject;
- return $self->SetHeader( 'Cc', $addresses );
-}
+ $subject =~ s/(\r\n|\n|\s)/ /g;
-# }}}
+ $self->SetHeader( 'Subject', $subject );
-# {{{ sub SetBcc
+}
-=head2 SetBcc
+=head2 SetSubjectToken
-Takes a string that is the addresses you want to Bcc
+This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
=cut
-sub SetBcc {
- my $self = shift;
- my $addresses = shift;
+sub SetSubjectToken {
+ my $self = shift;
- return $self->SetHeader( 'Bcc', $addresses );
+ my $head = $self->TemplateObj->MIMEObj->head;
+ $self->SetHeader(
+ Subject =>
+ RT::Interface::Email::AddSubjectTag(
+ Encode::decode( "UTF-8", $head->get('Subject') ),
+ $self->TicketObj,
+ ),
+ );
}
-# }}}
+=head2 SetReferencesHeaders
+
+Set References and In-Reply-To headers for this message.
-# {{{ sub SetPrecedence
+=cut
-sub SetPrecedence {
+sub SetReferencesHeaders {
my $self = shift;
- unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ) {
- $self->SetHeader( 'Precedence', "bulk" );
+ my $top = $self->TransactionObj->Message->First;
+ unless ( $top ) {
+ $self->SetHeader( References => $self->PseudoReference );
+ return (undef);
}
-}
-# }}}
+ my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
+ my @references = split( /\s+/m, $top->GetHeader('References') || '' );
+ my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
+
+ # There are two main cases -- this transaction was created with
+ # the RT Web UI, and hence we want to *not* append its Message-ID
+ # to the References and In-Reply-To. OR it came from an outside
+ # source, and we should treat it as per the RFC
+ my $org = RT->Config->Get('Organization');
+ if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
+
+ # Make all references which are internal be to version which we
+ # have sent out
+
+ for ( @references, @in_reply_to ) {
+ s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
+ "<$1." . $self->TicketObj->id .
+ "-" . $self->ScripObj->id .
+ "-" . $self->ScripActionObj->{_Message_ID} .
+ "@" . $org . ">"/eg
+ }
-# {{{ sub SetSubject
+ # In reply to whatever the internal message was in reply to
+ $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
-=head2 SetSubject
+ # Default the references to whatever we're in reply to
+ @references = @in_reply_to unless @references;
-This routine sets the subject. it does not add the rt tag. that gets done elsewhere
-If $self->{'Subject'} is already defined, it uses that. otherwise, it tries to get
-the transaction's subject.
+ # References are unchanged from internal
+ } else {
-=cut
+ # In reply to that message
+ $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
-sub SetSubject {
- my $self = shift;
- my $subject;
+ # Default the references to whatever we're in reply to
+ @references = @in_reply_to unless @references;
- unless ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
- my $message = $self->TransactionObj->Attachments;
- my $ticket = $self->TicketObj->Id;
-
- if ( $self->{'Subject'} ) {
- $subject = $self->{'Subject'};
- }
- elsif ( ( $message->First() )
- && ( $message->First->Headers ) ) {
- my $header = $message->First->Headers();
- $header =~ s/\n\s+/ /g;
- if ( $header =~ /^Subject: (.*?)$/m ) {
- $subject = $1;
- }
- else {
- $subject = $self->TicketObj->Subject();
- }
+ # Push that message onto the end of the references
+ push @references, @msgid;
+ }
- }
- else {
- $subject = $self->TicketObj->Subject();
- }
+ # Push pseudo-ref to the front
+ my $pseudo_ref = $self->PseudoReference;
+ @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
- $subject =~ s/(\r\n|\n|\s)/ /gi;
+ # If there are more than 10 references headers, remove all but the
+ # first four and the last six (Gotta keep this from growing
+ # forever)
+ splice( @references, 4, -6 ) if ( $#references >= 10 );
- chomp $subject;
- $self->SetHeader( 'Subject', $subject );
+ # Add on the references
+ $self->SetHeader( 'References', join( " ", @references ) );
+ $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
- }
- return ($subject);
}
-# }}}
-
-# {{{ sub SetSubjectToken
+=head2 PseudoReference
-=head2 SetSubjectToken
-
-This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
+Returns a fake Message-ID: header for the ticket to allow a base level of threading
=cut
-sub SetSubjectToken {
+sub PseudoReference {
my $self = shift;
- my $tag = "[$RT::rtname #" . $self->TicketObj->id . "]";
- my $sub = $self->TemplateObj->MIMEObj->head->get('Subject');
- unless ( $sub =~ /\Q$tag\E/ ) {
- $sub =~ s/(\r\n|\n|\s)/ /gi;
- chomp $sub;
- $self->TemplateObj->MIMEObj->head->replace( 'Subject', "$tag $sub" );
- }
+ return RT::Interface::Email::PseudoReference( $self->TicketObj );
}
-# }}}
-
-# }}}
-
-# {{{
-
=head2 SetHeaderAsEncoding($field_name, $charset_encoding)
-This routine converts the field into specified charset encoding.
+This routine converts the field into specified charset encoding, then
+applies the MIME-Header transfer encoding.
=cut
my $self = shift;
my ( $field, $enc ) = ( shift, shift );
- if ($field eq 'From' and $RT::SMTPFrom) {
- $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom );
- return;
- }
-
- my $value = $self->TemplateObj->MIMEObj->head->get($field);
-
- # don't bother if it's us-ascii
+ my $head = $self->TemplateObj->MIMEObj->head;
- # See RT::I18N, 'NOTES: Why Encode::_utf8_off before Encode::from_to'
+ my $value = Encode::decode("UTF-8", $head->get( $field ));
+ $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes
+ $head->replace( $field, $value );
- $value = $self->MIMEEncodeString($value, $enc);
-
- $self->TemplateObj->MIMEObj->head->replace( $field, $value );
-
-
-}
-# }}}
+}
-# {{{ MIMENcodeString
+=head2 MIMEEncodeString
-=head2 MIMEEncodeString STRING ENCODING
+Takes a perl string and optional encoding pass it over
+L<RT::Interface::Email/EncodeToMIME>.
-Takes a string and a possible encoding and returns the string wrapped in MIME goo.
+Basicly encode a string using B encoding according to RFC2047, returning
+bytes.
=cut
sub MIMEEncodeString {
- my $self = shift;
- my $value = shift;
- my $enc = shift;
-
- chomp $value;
- return ($value) unless $value =~ /[^\x20-\x7e]/;
-
- $value =~ s/\s*$//;
- Encode::_utf8_off($value);
- my $res = Encode::from_to( $value, "utf-8", $enc );
- $value = encode_mimeword( $value, 'B', $enc );
+ my $self = shift;
+ return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
}
-# }}}
-
-eval "require RT::Action::SendEmail_Vendor";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm});
-eval "require RT::Action::SendEmail_Local";
-die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm});
+RT::Base->_ImportOverlays();
1;