# BEGIN BPS TAGGED BLOCK {{{
-#
+#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
-# <jesse@bestpractical.com>
-#
+#
+# This software is Copyright (c) 1996-2018 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.
-#
+#
# 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/copyleft/gpl.html.
-#
-#
+# 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
# 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 Mail::Address;
-use Date::Format qw(strftime);
+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.
-=begin testing
-
-ok (require RT::Action::SendEmail);
+=head1 METHODS
-=end testing
+=head2 CleanSlate
+Cleans class-wide options, like L</AttachTickets>.
-=head1 AUTHOR
+=cut
-Jesse Vincent <jesse@bestpractical.com> and Tobias Brox <tobix@cpan.org>
+sub CleanSlate {
+ my $self = shift;
+ $self->AttachTickets(undef);
+}
-=head1 SEE ALSO
+=head2 Commit
-perl(1).
+Sends the prepared message and writes outgoing record into DB if the feature is
+activated in the config.
=cut
-# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable)
+sub Commit {
+ my $self = shift;
+ return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
+ unless RT->Config->Get('RecordOutgoingEmail');
-# {{{ sub Commit
+ $self->DeferDigestRecipients();
+ my $message = $self->TemplateObj->MIMEObj;
-sub Commit {
- my $self = shift;
+ my $orig_message;
+ $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
+ Attachment => $self->TransactionObj->Attachments->First,
+ Ticket => $self->TicketObj,
+ );
+
+ my ($ret) = $self->SendMessage($message);
+ return abs( $ret ) if $ret <= 0;
- my ($ret) = $self->SendMessage( $self->TemplateObj->MIMEObj );
- if ( $ret > 0 ) {
- $self->RecordOutgoingMailTransaction( $self->TemplateObj->MIMEObj )
- if ($RT::RecordOutgoingEmail);
+ if ($orig_message) {
+ $message->attach(
+ Type => 'application/x-rt-original-message',
+ Disposition => 'inline',
+ Data => $orig_message->as_string,
+ );
}
- return (abs $ret);
+ $self->RecordOutgoingMailTransaction($message);
+ $self->RecordDeferredRecipients();
+ return 1;
}
-# }}}
+=head2 Prepare
-# {{{ sub Prepare
+Builds an outgoing email we're going to send using scrip's template.
+
+=cut
sub Prepare {
my $self = shift;
- my ( $result, $message ) = $self->TemplateObj->Parse(
- Argument => $self->Argument,
- TicketObj => $self->TicketObj,
- TransactionObj => $self->TransactionObj
- );
- if ( !$result ) {
- return (undef);
+ unless ( $self->TemplateObj->MIMEObj ) {
+ my ( $result, $message ) = $self->TemplateObj->Parse(
+ Argument => $self->Argument,
+ TicketObj => $self->TicketObj,
+ TransactionObj => $self->TransactionObj
+ );
+ if ( !$result ) {
+ return (undef);
+ }
}
my $MIMEObj = $self->TemplateObj->MIMEObj;
# 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.
- # TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
+# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
- $self->SetHeader( 'To', join ( ', ', @{ $self->{'To'} } ) )
- if ( ! $MIMEObj->head->get('To') && $self->{'To'} && @{ $self->{'To'} } );
- $self->SetHeader( 'Cc', join ( ', ', @{ $self->{'Cc'} } ) )
- if ( !$MIMEObj->head->get('Cc') && $self->{'Cc'} && @{ $self->{'Cc'} } );
- $self->SetHeader( 'Bcc', join ( ', ', @{ $self->{'Bcc'} } ) )
- if ( !$MIMEObj->head->get('Bcc') && $self->{'Bcc'} && @{ $self->{'Bcc'} } );
+ for my $header (@EMAIL_RECIPIENT_HEADERS) {
- # PseudoTo (fake to headers) shouldn't get matched for message recipients.
+ $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'} } )
- and ( !$MIMEObj->head->get('To') ) ) and ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc'));
-
- # We should never have to set the MIME-Version header
- $self->SetHeader( 'MIME-Version', '1.0' );
-
- # try to convert message body from utf-8 to $RT::EmailOutputEncoding
- $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' );
-
- # fsck.com #5959: Since RT sends 8bit mail, we should say so.
- $self->SetHeader( 'Content-Transfer-Encoding','8bit');
-
+ $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' );
+ }
- RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding,
- 'mime_words_ok' );
- $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' );
+ RT::I18N::SetMIMEEntityToEncoding(
+ Entity => $MIMEObj,
+ Encoding => RT->Config->Get('EmailOutputEncoding'),
+ PreserveWords => 1,
+ IsOut => 1,
+ );
# Build up a MIME::Entity that looks like the original message.
- $self->AddAttachments() if ( $MIMEObj->head->get('RT-Attach-Message') );
-
- return $result;
+ $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;
}
-# }}}
-
-# }}}
-
-
-
=head2 To
-Returns an array of Mail::Address objects containing all the To: recipients for this notification
+Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
=cut
sub To {
my $self = shift;
- return ($self->_AddressesFromHeader('To'));
+ return ( $self->AddressesFromHeader('To') );
}
=head2 Cc
-Returns an array of Mail::Address objects containing all the Cc: recipients for this notification
+Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
=cut
-sub Cc {
+sub Cc {
my $self = shift;
- return ($self->_AddressesFromHeader('Cc'));
+ return ( $self->AddressesFromHeader('Cc') );
}
=head2 Bcc
-Returns an array of Mail::Address objects containing all the Bcc: recipients for this notification
+Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
=cut
-
sub Bcc {
my $self = shift;
- return ($self->_AddressesFromHeader('Bcc'));
+ return ( $self->AddressesFromHeader('Bcc') );
}
-sub _AddressesFromHeader {
- my $self = shift;
- my $field = shift;
- my $header = $self->TemplateObj->MIMEObj->head->get($field);
- my @addresses = Mail::Address->parse($header);
+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);
return (@addresses);
}
-
-# {{{ SendMessage
-
=head2 SendMessage MIMEObj
sends the message using RT's preferred API.
=cut
sub SendMessage {
- my $self = shift;
- my $MIMEObj = shift;
- my $msgid = $MIMEObj->head->get('Message-ID');
+ # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
+ # ability to pass @_ to a 'post' routine.
+ my ( $self, $MIMEObj ) = @_;
+
+ my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
chomp $msgid;
$self->ScripActionObj->{_Message_ID}++;
-
- $RT::Logger->info( $msgid . " #"
- . $self->TicketObj->id . "/"
- . $self->TransactionObj->id
- . " - Scrip "
- . $self->ScripObj->id . " "
- . $self->ScripObj->Description );
-
- #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);
- }
- unless ($MIMEObj->head->get('Date')) {
- # We coerce localtime into an array since strftime has a flawed prototype that only accepts
- # a list
- $MIMEObj->head->replace(Date => strftime('%a, %d %b %Y %H:%M:%S %z', @{[localtime()]}));
- }
+ $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,
+ );
- return (0) unless ($self->OutputMIMEObject($MIMEObj));
+
+ return $status unless ($status > 0 || exists $self->{'Deferred'});
my $success = $msgid . " sent ";
- foreach( qw(To Cc Bcc) ) {
- my $recipients = $MIMEObj->head->get($_);
- $success .= " $_: ". $recipients if $recipients;
+ 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'}{ $_ };
+ }
+ }
+
$success =~ s/\n//g;
$RT::Logger->info($success);
return (1);
}
+=head2 AttachableFromTransaction
-=head2 OutputMIMEObject MIME::Entity
-
-Sends C<MIME::Entity> as an email message according to RT's mailer configuration.
-
-=cut
-
-
+Function (not method) that takes an L<RT::Transaction> and returns an
+L<RT::Attachments> collection of attachments suitable for attaching to an
+email.
-sub OutputMIMEObject {
- my $self = shift;
- my $MIMEObj = shift;
-
- my $msgid = $MIMEObj->head->get('Message-ID');
- chomp $msgid;
-
- my $SendmailArguments = $RT::SendmailArguments;
- if (defined $RT::VERPPrefix && defined $RT::VERPDomain) {
- my $EnvelopeFrom = $self->TransactionObj->CreatorObj->EmailAddress;
- $EnvelopeFrom =~ s/@/=/g;
- $EnvelopeFrom =~ s/\s//g;
- $SendmailArguments .= " -f ${RT::VERPPrefix}${EnvelopeFrom}\@${RT::VERPDomain}";
- }
+=cut
+sub AttachableFromTransaction {
+ my $txn = shift;
- if ( $RT::MailCommand eq 'sendmailpipe' ) {
- eval {
- # don't ignore CHLD signal to get proper exit code
- local $SIG{'CHLD'} = 'DEFAULT';
+ my $attachments = RT::Attachments->new( RT->SystemUser );
+ $attachments->Limit(
+ FIELD => 'TransactionId',
+ VALUE => $txn->Id
+ );
- my $mail;
- unless( open $mail, "|$RT::SendmailPath $SendmailArguments" ) {
- die "Couldn't run $RT::SendmailPath: $!";
- }
+ # Don't attach anything blank
+ $attachments->LimitNotEmpty;
+ $attachments->OrderBy( FIELD => 'id' );
- # if something wrong with $mail->print we will get PIPE signal, handle it
- local $SIG{'PIPE'} = sub { die "$RT::SendmailPath closed pipe" };
- $MIMEObj->print($mail);
+ # 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;
- unless ( close $mail ) {
- die "Close failed: $!" if $!; # system error
- # sendmail exit statuses mostly errors with data not software
- # TODO: status parsing: core dump, exit on signal or EX_*
- $RT::Logger->warning( "$RT::SendmailPath exitted with status $?" );
- }
- };
- if ($@) {
- $RT::Logger->crit( $msgid . "Could not send mail: " . $@ );
- return 0;
+ 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,
+ );
}
}
- else {
- my @mailer_args = ($RT::MailCommand);
-
- local $ENV{MAILADDRESS};
-
- if ( $RT::MailCommand eq 'sendmail' ) {
- push @mailer_args, split(/\s+/, $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;
- }
- unless ( $MIMEObj->send(@mailer_args) ) {
- $RT::Logger->crit( $msgid . "Could not send mail." );
- return (0);
- }
- }
- return 1;
+ return $attachments;
}
-# }}}
-
-# {{{ AddAttachments
-
=head2 AddAttachments
Takes any attachments to this transaction and attaches them to the message
=cut
-
sub AddAttachments {
my $self = shift;
$MIMEObj->head->delete('RT-Attach-Message');
- my $attachments = RT::Attachments->new($RT::SystemUser);
- $attachments->Limit(
- FIELD => 'TransactionId',
- VALUE => $self->TransactionObj->Id
- );
- $attachments->OrderBy( FIELD => 'id');
-
- my $transaction_content_obj = $self->TransactionObj->ContentObj;
+ my $attachments = AttachableFromTransaction($self->TransactionObj);
# 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);
+ }
+}
- # Don't attach anything blank
- next unless ( $attach->ContentLength );
-
-# 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 ),
- 'RT-Attachment:' => $self->TicketObj->Id."/".$self->TransactionObj->Id."/".$attach->id,
- Encoding => '-SUGGEST'
- );
+=head2 AddAttachment $attachment
+
+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;
}
+}
+
+=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
+
+Attaches a ticket with ID to the message.
-# {{{ RecordOutgoingMailTransaction
+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
=cut
-
-
sub RecordOutgoingMailTransaction {
- my $self = shift;
+ my $self = shift;
my $MIMEObj = shift;
-
my @parts = $MIMEObj->parts;
my @attachments;
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.");
+ $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);
+ $MIMEObj->parts( \@keep );
foreach my $attachment (@attachments) {
- $MIMEObj->head->add('RT-Attachment', $attachment);
+ $MIMEObj->head->add( 'RT-Attachment', $attachment );
}
RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
- my $transaction = RT::Transaction->new($self->TransactionObj->CurrentUser);
+ my $transaction
+ = RT::Transaction->new( $self->TransactionObj->CurrentUser );
- # XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
+# XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
my $type;
- if ($self->TransactionObj->Type eq 'Comment') {
+ if ( $self->TransactionObj->Type eq 'Comment' ) {
$type = 'CommentEmailRecord';
} else {
$type = 'EmailRecord';
}
- my $msgid = $MIMEObj->head->get('Message-ID');
+ my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
chomp $msgid;
my ( $id, $msg ) = $transaction->Create(
ActivateScrips => 0
);
-
+ if ($id) {
+ $self->{'OutgoingMailTransaction'} = $id;
+ } else {
+ $RT::Logger->warning(
+ "Could not record outgoing message transaction: $msg");
+ }
+ return $id;
}
-# }}}
-#
-
-# {{{ sub SetRTSpecialHeaders
-
=head2 SetRTSpecialHeaders
This routine adds all the random headers that RT wants in a mail message
$self->SetSubject();
$self->SetSubjectToken();
- $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding )
- if ($RT::EmailOutputEncoding);
+ $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 = "";
- $msgid = $self->TransactionObj->Message->First->GetHeader("RT-Message-ID")
- || $self->TransactionObj->Message->First->GetHeader("Message-ID")
- if $self->TransactionObj->Message && $self->TransactionObj->Message->First;
+ 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");
+ }
- # 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+\@\Q$RT::Organization\E>$/
+ # 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::Organization . ">"/eg
- and $2 == $self->TicketObj->id) {
- $self->SetHeader( "Message-ID" => $msgid );
- } else {
- $self->SetHeader( 'Message-ID',
- "<rt-"
- . $RT::VERSION . "-"
- . $$ . "-"
- . CORE::time() . "-"
- . int(rand(2000)) . '.'
- . $self->TicketObj->id . "-"
- . $self->ScripObj->id . "-" # Scrip
- . $self->ScripActionObj->{_Message_ID} . "@" # Email sent
- . $RT::Organization
- . ">" );
- }
- }
-
- $self->SetHeader( 'Precedence', "bulk" )
- unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") );
-
- $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname );
- $self->SetHeader( 'RT-Ticket',
- $RT::rtname . " #" . $self->TicketObj->id() );
- $self->SetHeader( 'Managed-by',
+ . "@" . 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->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/)" );
- $self->SetHeader( 'RT-Originator',
- $self->TransactionObj->CreatorObj->EmailAddress );
+# 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 );
+ }
}
-# }}}
+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;
+ }
-# }}}
+ my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
+ $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
-# {{{ RemoveInappropriateRecipients
+ 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 ) }
+ }
-=head2 RemoveInappropriateRecipients
+ # 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);
+ }
-Remove addresses that are RT addresses or that are on this transaction's blacklist
+ # 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 RecordDeferredRecipients {
+ my $self = shift;
+ return unless exists $self->{'Deferred'};
+
+ my $txn_id = $self->{'OutgoingMailTransaction'};
+ return unless $txn_id;
+
+ 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;
+
+ return ($ret,$msg);
+}
+
+=head2 SquelchMailTo
+
+Returns list of the addresses to squelch on this transaction.
=cut
-sub RemoveInappropriateRecipients {
+sub SquelchMailTo {
my $self = shift;
+ return map $_->Content, $self->TransactionObj->SquelchMailTo;
+}
- my $msgid = $self->TemplateObj->MIMEObj->head->get ('Message-Id');
+=head2 RemoveInappropriateRecipients
+Remove addresses that are RT addresses or that are on this transaction's blacklist
+=cut
- my @blacklist;
+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",
+);
- my @types = qw/To Cc Bcc/;
- # Weed out any RT addresses. We really don't want to talk to ourselves!
- foreach my $type (@types) {
- @{ $self->{$type} } =
- RT::EmailParser::CullRTAddresses( "", @{ $self->{$type} } );
- }
+sub RemoveInappropriateRecipients {
+ my $self = shift;
+
+ 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
- if ( $self->TransactionObj->Attachments->First() ) {
- if (
- $self->TransactionObj->Attachments->First->GetHeader(
- 'RT-DetectedAutoGenerated')
- )
- {
+ 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.
- if ( !$RT::RedistributeAutoGeneratedMessages ) {
+ my $redistribute = RT->Config->Get('RedistributeAutoGeneratedMessages');
- # Don't send to any watchers.
- @{ $self->{'To'} } = ();
- @{ $self->{'Cc'} } = ();
- @{ $self->{'Bcc'} } = ();
+ if ( !$redistribute ) {
- $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message based on site configuration.\n");
- }
- elsif ( $RT::RedistributeAutoGeneratedMessages eq 'privileged' ) {
+ # 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 (@types) {
-
+ foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
foreach my $addr ( @{ $self->{$type} } ) {
- my $user = RT::User->new($RT::SystemUser);
+ my $user = RT::User->new(RT->SystemUser);
$user->LoadByEmail($addr);
- @{ $self->{$type} } =
- grep ( !/^\Q$addr\E$/, @{ $self->{$type} } )
- if ( !$user->Privileged );
-
+ $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.\n");
-
+ $RT::Logger->info( $msgid
+ . " The incoming message was autogenerated. "
+ . "Not redistributing this message to unprivileged users based on site configuration."
+ );
}
-
}
- my $squelch =
- $self->TransactionObj->Attachments->First->GetHeader(
- 'RT-Squelch-Replies-To');
-
- if ($squelch) {
- @blacklist = split( /,/, $squelch );
+ if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
+ $blacklist{ $_->address } ||= 'squelch:attachment'
+ foreach Email::Address->parse( $squelch );
}
}
- # Let's grab the SquelchMailTo attribue and push those entries into the @blacklist
- my @non_recipients = $self->TicketObj->SquelchMailTo;
- foreach my $attribute (@non_recipients) {
- push @blacklist, $attribute->Content;
+ # 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 );
}
- # Cycle through the people we're sending to and pull out anyone on the
- # system blacklist
+ $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;
- foreach my $person_to_yank (@blacklist) {
- $person_to_yank =~ s/\s//g;
- foreach my $type (@types) {
- @{ $self->{$type} } =
- grep ( !/^\Q$person_to_yank\E$/, @{ $self->{$type} } );
+ 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;
}
}
-# }}}
-# {{{ sub SetReturnAddress
+=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 RecipientFilter {
+ my $self = shift;
+ push @{ $self->{RecipientFilter}}, {@_};
+}
=head2 SetReturnAddress is_comment => BOOLEAN
my $self = shift;
my %args = (
is_comment => 0,
+ friendly_name => undef,
@_
);
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
- || $self->TransactionObj->CreatorObj->Name;
- 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 )
+
+Set the From: address for outgoing email
+
+=cut
-# {{{ sub SetHeader
+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 );
+
+ #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 GetFriendlyName
+
+Calculate the proper Friendly Name based on the creator of the transaction
+
+=cut
+
+sub GetFriendlyName {
+ my $self = shift;
+ 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;
+ }
+ }
+
+ $friendly_name =~ s/"/\\"/g;
+ return $friendly_name;
+
+}
=head2 SetHeader FIELD, VALUE
-Set the FIELD of the current MIME object into 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
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);
+ my $head = $self->TemplateObj->MIMEObj->head;
+ $head->fold_length( $field, 10000 );
+ $head->replace( $field, Encode::encode( "UTF-8", $val ) );
+ return $head->get($field);
}
-# }}}
-
-
-# {{{ sub SetSubject
-
=head2 SetSubject
-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
+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.
=cut
my $self = shift;
my $subject;
- my $message = $self->TransactionObj->Attachments;
if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
return ();
}
+
+ # 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;
}
- 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();
- }
-
- }
- else {
- $subject = $self->TicketObj->Subject();
- }
+ $subject = '' unless defined $subject;
+ chomp $subject;
- $subject =~ s/(\r\n|\n|\s)/ /gi;
+ $subject =~ s/(\r\n|\n|\s)/ /g;
- chomp $subject;
$self->SetHeader( 'Subject', $subject );
}
-# }}}
-
-# {{{ sub SetSubjectToken
-
=head2 SetSubjectToken
This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
sub SetSubjectToken {
my $self = shift;
- my $sub = $self->TemplateObj->MIMEObj->head->get('Subject');
- my $id = $self->TicketObj->id;
- my $token_re = $RT::EmailSubjectTagRegex;
- $token_re = qr/\Q$RT::rtname\E/o unless $token_re;
- return if $sub =~ /\[$token_re\s+#$id\]/;
-
- $sub =~ s/(\r\n|\n|\s)/ /gi;
- chomp $sub;
- $self->TemplateObj->MIMEObj->head->replace(
- Subject => "[$RT::rtname #$id] $sub",
+ 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.
=cut
sub SetReferencesHeaders {
-
my $self = shift;
- my ( @in_reply_to, @references, @msgid );
-
- my $attachments = $self->TransactionObj->Message;
- if ( my $top = $attachments->First() ) {
- @in_reply_to = split(/\s+/m, $top->GetHeader('In-Reply-To') || '');
- @references = split(/\s+/m, $top->GetHeader('References') || '' );
- @msgid = split(/\s+/m, $top->GetHeader('Message-ID') || '');
- }
- else {
+ 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
- if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@$RT::Organization>/) {
+ 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)\@$RT::Organization>$/
+ # 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} .
- "@" . $RT::Organization . ">"/eg
- }
+ "@" . $org . ">"/eg
+ }
- # In reply to whatever the internal message was in reply to
- $self->SetHeader( 'In-Reply-To', join( " ", ( @in_reply_to )));
+ # In reply to whatever the internal message was in reply to
+ $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
- # Default the references to whatever we're in reply to
- @references = @in_reply_to unless @references;
+ # Default the references to whatever we're in reply to
+ @references = @in_reply_to unless @references;
- # References are unchanged from internal
+ # References are unchanged from internal
} else {
- # In reply to that message
- $self->SetHeader( 'In-Reply-To', join( " ", ( @msgid )));
- # Default the references to whatever we're in reply to
- @references = @in_reply_to unless @references;
+ # In reply to that message
+ $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
+
+ # Default the references to whatever we're in reply to
+ @references = @in_reply_to unless @references;
- # Push that message onto the end of the references
- push @references, @msgid;
+ # Push that message onto the end of the references
+ push @references, @msgid;
}
# Push pseudo-ref to the front
my $pseudo_ref = $self->PseudoReference;
- @references = ($pseudo_ref, grep { $_ ne $pseudo_ref } @references);
+ @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
# 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);
+ splice( @references, 4, -6 ) if ( $#references >= 10 );
# Add on the references
- $self->SetHeader( 'References', join( " ", @references) );
+ $self->SetHeader( 'References', join( " ", @references ) );
$self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
}
-# }}}
-
=head2 PseudoReference
Returns a fake Message-ID: header for the ticket to allow a base level of threading
=cut
sub PseudoReference {
-
my $self = shift;
- my $pseudo_ref = '<RT-Ticket-'.$self->TicketObj->id .'@'.$RT::Organization .'>';
- return $pseudo_ref;
+ return RT::Interface::Email::PseudoReference( $self->TicketObj );
}
-
-# {{{ SetHeadingAsEncoding
-
=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);
+ my $head = $self->TemplateObj->MIMEObj->head;
- # don't bother if it's us-ascii
+ my $value = Encode::decode("UTF-8", $head->get( $field ));
+ $value = $self->MIMEEncodeString( $value, $enc ); # Returns bytes
+ $head->replace( $field, $value );
- # See RT::I18N, 'NOTES: Why Encode::_utf8_off before Encode::from_to'
-
- $value = $self->MIMEEncodeString($value, $enc);
-
- $self->TemplateObj->MIMEObj->head->replace( $field, $value );
-
-
-}
-# }}}
+}
-# {{{ MIMEEncodeString
+=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;
- # using RFC2047 notation, sec 2.
- # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
- my $charset = shift;
- my $encoding = 'B';
- # An 'encoded-word' may not be more than 75 characters long
- #
- # MIME encoding increases 4/3*(number of bytes), and always in multiples
- # of 4. Thus we have to find the best available value of bytes available
- # for each chunk.
- #
- # First we get the integer max which max*4/3 would fit on space.
- # Then we find the greater multiple of 3 lower or equal than $max.
- my $max = int(((75-length('=?'.$charset.'?'.$encoding.'?'.'?='))*3)/4);
- $max = int($max/3)*3;
-
- chomp $value;
- return ($value) unless $value =~ /[^\x20-\x7e]/;
-
- $value =~ s/\s*$//;
- Encode::_utf8_off($value);
- my $res = Encode::from_to( $value, "utf-8", $charset );
-
- if ($max > 0) {
- # copy value and split in chuncks
- my $str=$value;
- my @chunks = unpack("a$max" x int(length($str)/$max
- + ((length($str) % $max) ? 1:0)), $str);
- # encode an join chuncks
- $value = join " ",
- map encode_mimeword( $_, $encoding, $charset ), @chunks ;
- return($value);
- } else {
- # gives an error...
- $RT::Logger->crit("Can't encode! Charset or encoding too big.\n");
- }
+ 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;
projects / freeside.git / blobdiff