X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FAction%2FSendEmail.pm;h=dac8fc8e72a35c2fa28d7fc53f65e10902b81803;hb=67ea829b418b1c7a97a51793ed920dba6ff36393;hp=8b682c118d144b16bc5dad5d15f04f5fedd1ce21;hpb=e70abd21bab68b23488f7ef1ee2e693a3b365691;p=freeside.git diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index 8b682c118..dac8fc8e7 100755 --- a/rt/lib/RT/Action/SendEmail.pm +++ b/rt/lib/RT/Action/SendEmail.pm @@ -1,14 +1,8 @@ -# BEGIN BPS TAGGED BLOCK {{{ +# BEGIN LICENSE BLOCK # -# COPYRIGHT: +# Copyright (c) 1996-2003 Jesse Vincent # -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC -# -# -# (Except where explicitly superseded by other copyright notices) -# -# -# LICENSE: +# (Except where explictly superceded by other copyright notices) # # 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 @@ -20,46 +14,25 @@ # 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/licenses/old-licenses/gpl-2.0.html. -# -# -# CONTRIBUTION SUBMISSION POLICY: +# 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. # -# (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 }}} - +# END LICENSE BLOCK # Portions Copyright 2000 Tobias Brox package RT::Action::SendEmail; +require RT::Action::Generic; use strict; -use warnings; +use vars qw/@ISA/; +@ISA = qw(RT::Action::Generic); -use base qw(RT::Action); +use MIME::Words qw(encode_mimeword); use RT::EmailParser; -use RT::Interface::Email; -use Email::Address; -our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc); - =head1 NAME @@ -69,493 +42,273 @@ RT::Action::AutoReply is a good example subclass. =head1 SYNOPSIS - use base 'RT::Action::SendEmail'; + require RT::Action::SendEmail; + @ISA = qw(RT::Action::SendEmail); + =head1 DESCRIPTION Basically, you create another module RT::Action::YourAction which ISA RT::Action::SendEmail. -=head1 METHODS +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). -=head2 CleanSlate -Cleans class-wide options, like L or L. +=begin testing -=cut +ok (require RT::Action::SendEmail); -sub CleanSlate { - my $self = shift; - $self->SquelchMailTo(undef); - $self->AttachTickets(undef); -} +=end testing -=head2 Commit -Sends the prepared message and writes outgoing record into DB if the feature is -activated in the config. +=head1 AUTHOR -=cut +Jesse Vincent and Tobias Brox -sub Commit { - my $self = shift; +=head1 SEE ALSO - $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail'); - my $message = $self->TemplateObj->MIMEObj; - - my $orig_message; - if ( RT->Config->Get('RecordOutgoingEmail') - && RT->Config->Get('GnuPG')->{'Enable'} ) - { - - # it's hacky, but we should know if we're going to crypt things - my $attachment = $self->TransactionObj->Attachments->First; - - my %crypt; - foreach my $argument (qw(Sign Encrypt)) { - if ( $attachment - && defined $attachment->GetHeader("X-RT-$argument") ) - { - $crypt{$argument} = $attachment->GetHeader("X-RT-$argument"); - } else { - $crypt{$argument} = $self->TicketObj->QueueObj->$argument(); - } - } - if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) { - $orig_message = $message->dup; - } - } +perl(1). - my ($ret) = $self->SendMessage($message); - if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) { - if ($orig_message) { - $message->attach( - Type => 'application/x-rt-original-message', - Disposition => 'inline', - Data => $orig_message->as_string, - ); - } - $self->RecordOutgoingMailTransaction($message); - $self->RecordDeferredRecipients(); - } +=cut +# {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) - return ( abs $ret ); -} +# {{{ sub _Init +# We use _Init from RT::Action +# }}} -=head2 Prepare +# {{{ sub Commit +#Do what we need to do and send it out. +sub Commit { + my $self = shift; -Builds an outgoing email we're going to send using scrip's template. + 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 -=cut + # 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 -sub Prepare { - my $self = shift; + if ( defined $self->TransactionObj->Attachments->First() ) { - my ( $result, $message ) = $self->TemplateObj->Parse( - Argument => $self->Argument, - TicketObj => $self->TicketObj, - TransactionObj => $self->TransactionObj - ); - if ( !$result ) { - return (undef); - } - - my $MIMEObj = $self->TemplateObj->MIMEObj; + my $squelch = $self->TransactionObj->Attachments->First->GetHeader( 'RT-Squelch-Replies-To'); - # Header - $self->SetRTSpecialHeaders(); + if ($squelch) { + my @blacklist = split ( /,/, $squelch ); - $self->RemoveInappropriateRecipients(); + # Cycle through the people we're sending to and pull out anyone on the + # system blacklist - my %seen; - foreach my $type (@EMAIL_RECIPIENT_HEADERS) { - @{ $self->{$type} } - = grep defined && length && !$seen{ lc $_ }++, - @{ $self->{$type} }; + 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'} } ); + } + } } # 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 + $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'} } ); - for my $header (@EMAIL_RECIPIENT_HEADERS) { - $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') ); - - # We should never have to set the MIME-Version header - $self->SetHeader( 'MIME-Version', '1.0' ); - - # fsck.com #5959: Since RT sends 8bit mail, we should say so. - $self->SetHeader( 'Content-Transfer-Encoding', '8bit' ); - - # 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 ); - $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); - } + $self->SetHeader('MIME-Version', '1.0'); - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, - RT->Config->Get('EmailOutputEncoding'), - 'mime_words_ok', ); + # try to convert message body from utf-8 to $RT::EmailOutputEncoding + $self->SetHeader( 'Content-Type', 'text/plain; charset="utf-8"' ); - # 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'; - } + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' ); + $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' ); - return $result; -} -=head2 To + # Build up a MIME::Entity that looks like the original message. -Returns an array of L objects containing all the To: recipients for this notification + my $do_attach = $self->TemplateObj->MIMEObj->head->get('RT-Attach-Message'); -=cut + if ($do_attach) { + $self->TemplateObj->MIMEObj->head->delete('RT-Attach-Message'); -sub To { - my $self = shift; - return ( $self->AddressesFromHeader('To') ); -} + my $attachments = RT::Attachments->new($RT::SystemUser); + $attachments->Limit( FIELD => 'TransactionId', + VALUE => $self->TransactionObj->Id ); + $attachments->OrderBy('id'); -=head2 Cc + my $transaction_content_obj = $self->TransactionObj->ContentObj; -Returns an array of L objects containing all the Cc: recipients for this notification + # attach any of this transaction's attachments + while ( my $attach = $attachments->Next ) { -=cut + # Don't attach anything blank + next unless ( $attach->ContentLength ); -sub Cc { - my $self = shift; - return ( $self->AddressesFromHeader('Cc') ); -} - -=head2 Bcc - -Returns an array of L objects containing all the Bcc: recipients for this notification + # 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'); + } -=cut + } -sub Bcc { - my $self = shift; - return ( $self->AddressesFromHeader('Bcc') ); -} + my $retval = $self->SendMessage($MIMEObj); -sub AddressesFromHeader { - my $self = shift; - my $field = shift; - my $header = $self->TemplateObj->MIMEObj->head->get($field); - my @addresses = Email::Address->parse($header); - return (@addresses); + return ($retval); } -=head2 SendMessage MIMEObj - -sends the message using RT's preferred API. -TODO: Break this out to a separate module - -=cut +# }}} -sub SendMessage { +# {{{ sub Prepare - # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's - # ability to pass @_ to a 'post' routine. - my ( $self, $MIMEObj ) = @_; - - my $msgid = $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 || '#rule'). " " - . ( $self->ScripObj->Description || '' ) ); - - my $status = RT::Interface::Email::SendEmail( - Entity => $MIMEObj, - Ticket => $self->TicketObj, - Transaction => $self->TransactionObj, - ); +sub Prepare { + my $self = shift; - - return $status unless ($status > 0 || exists $self->{'Deferred'}); + # This actually populates the MIME::Entity fields in the Template Object - my $success = $msgid . " sent "; - foreach (@EMAIL_RECIPIENT_HEADERS) { - my $recipients = $MIMEObj->head->get($_); - $success .= " $_: " . $recipients if $recipients; + unless ( $self->TemplateObj ) { + $RT::Logger->warning("No template object handed to $self\n"); } - 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 AddAttachments + unless ( $self->TransactionObj ) { + $RT::Logger->warning("No transaction object handed to $self\n"); -Takes any attachments to this transaction and attaches them to the message -we're building. - -=cut - -sub AddAttachments { - my $self = shift; - - my $MIMEObj = $self->TemplateObj->MIMEObj; - - $MIMEObj->head->delete('RT-Attach-Message'); + } - my $attachments = RT::Attachments->new($RT::SystemUser); - $attachments->Limit( - FIELD => 'TransactionId', - VALUE => $self->TransactionObj->Id - ); + unless ( $self->TicketObj ) { + $RT::Logger->warning("No ticket object handed to $self\n"); - # 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 = $self->TransactionObj->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, - ); - } } - # 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; + my ( $result, $message ) = $self->TemplateObj->Parse( + Argument => $self->Argument, + TicketObj => $self->TicketObj, + TransactionObj => $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 ); } - $self->AddAttachment($attach); } -} - -=head2 AddAttachment $attachment -Takes one attachment object of L class and attaches it to the message -we're building. - -=cut + return $result; -sub AddAttachment { - my $self = shift; - my $attach = shift; - my $MIMEObj = shift || $self->TemplateObj->MIMEObj; - - $MIMEObj->attach( - Type => $attach->ContentType, - Charset => $attach->OriginalEncoding, - Data => $attach->OriginalContent, - Filename => $self->MIMEEncodeString( $attach->Filename ), - '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 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 +# {{{ SendMessage +=head2 SendMessage MIMEObj -Attaches tickets to the current message, list of tickets' ids get from -L method. +sends the message using RT's preferred API. +TODO: Break this out to a seperate module =cut -sub AddTickets { +sub SendMessage { my $self = shift; - $self->AddTicket($_) foreach $self->AttachTickets; - return; -} - -=head2 AddTicket $ID - -Attaches a ticket with ID to the message. + my $MIMEObj = shift; -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. + my $msgid = $MIMEObj->head->get('Message-Id'); -=cut -sub AddTicket { - my $self = shift; - my $tid = shift; - - # XXX: we need a current user here, but who is current user? - my $attachs = RT::Attachments->new($RT::SystemUser); - my $txn_alias = $attachs->TransactionAlias; - $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' ); - $attachs->Limit( - ALIAS => $txn_alias, - FIELD => 'Type', - VALUE => '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); + #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); } - return; -} - -=head2 RecordOutgoingMailTransaction MIMEObj -Record a transaction in RT with this outgoing message for future record-keeping purposes + # 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. -=cut + $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. -".$@ ); + } + } + else { + my @mailer_args = ($RT::MailCommand); + local $ENV{MAILADDRESS}; -sub RecordOutgoingMailTransaction { - my $self = shift; - my $MIMEObj = shift; + 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; + } - 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; + unless ( $MIMEObj->send( @mailer_args ) ) { + $RT::Logger->crit($msgid. "Could not send mail." ); + return (0); } } - $MIMEObj->parts( \@keep ); - foreach my $attachment (@attachments) { - $MIMEObj->head->add( 'RT-Attachment', $attachment ); - } - - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' ); - my $transaction - = RT::Transaction->new( $self->TransactionObj->CurrentUser ); -# XXX: TODO -> Record attachments as references to things in the attachments table, maybe. + 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 $type; - if ( $self->TransactionObj->Type eq 'Comment' ) { - $type = 'CommentEmailRecord'; - } else { - $type = 'EmailRecord'; - } + return (1); +} - my $msgid = $MIMEObj->head->get('Message-ID'); - chomp $msgid; +# }}} - my ( $id, $msg ) = $transaction->Create( - Ticket => $self->TicketObj->Id, - Type => $type, - Data => $msgid, - MIMEObj => $MIMEObj, - ActivateScrips => 0 - ); +# {{{ Deal with message headers (Set* subs, designed for easy overriding) - if ($id) { - $self->{'OutgoingMailTransaction'} = $id; - } else { - $RT::Logger->warning( - "Could not record outgoing message transaction: $msg"); - } - return $id; -} +# {{{ sub SetRTSpecialHeaders =head2 SetRTSpecialHeaders @@ -567,272 +320,85 @@ that don't matter much to anybody else. sub SetRTSpecialHeaders { my $self = shift; - $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->SetReferences(); - # 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->SetMessageID(); - if (my $precedence = RT->Config->Get('DefaultMailPrecedence') - and !$self->TemplateObj->MIMEObj->head->get("Precedence") - ) { - $self->SetHeader( 'Precedence', $precedence ); - } + $self->SetPrecedence(); - $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') ); + $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname ); $self->SetHeader( 'RT-Ticket', - RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); + $RT::rtname . " #" . $self->TicketObj->id() ); $self->SetHeader( '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 RT->Config->Get('UseOriginatorHeader') - ) { - $self->SetHeader( '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( $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; - } + "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); - my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || ''; - $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt"); + $self->SetHeader( 'RT-Originator', + $self->TransactionObj->CreatorObj->EmailAddress ); + return (); - 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 ) } - } - - # 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 ) { +# {{{ sub SetReferences - # 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 ); - } -} +=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. +=cut - -sub RecordDeferredRecipients { +sub SetReferences { my $self = shift; - return unless exists $self->{'Deferred'}; - my $txn_id = $self->{'OutgoingMailTransaction'}; - return unless $txn_id; + # 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_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; + $self->SetHeader( 'In-Reply-To', + "TicketObj->id() . "\@" . $RT::rtname . ">" ); - return ($ret,$msg); + # TODO We should always add References headers for all message-ids + # of previous messages related to this ticket. } -=head2 SquelchMailTo [@ADDRESSES] - -Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses. -To empty list pass undefined argument. - -B that this method can be called as class method and works globaly. Don't forget to -clean this list when blocking is not required anymore, pass undef to do this. - -=cut +# }}} -{ - my $squelch = []; +# {{{ sub SetMessageID - sub SquelchMailTo { - my $self = shift; - if (@_) { - $squelch = [ grep defined, @_ ]; - } - return @$squelch; - } -} +=head2 SetMessageID -=head2 RemoveInappropriateRecipients - -Remove addresses that are RT addresses or that are on this transaction's blacklist +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. =cut -sub RemoveInappropriateRecipients { +sub SetMessageID { 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 - - my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); - 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->Config->Get('RedistributeAutoGeneratedMessages') ) { - - # 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 ( RT->Config->Get('RedistributeAutoGeneratedMessages') 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); - push @blacklist, $addr if ( !$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') ) { - push @blacklist, split( /,/, $squelch ); - } - } - -# Let's grab the SquelchMailTo attribue and push those entries into the @blacklist - push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo; - push @blacklist, $self->SquelchMailTo; - - # Cycle through the people we're sending to and pull out anyone on the - # system blacklist + # 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', + "TicketObj->id() . "-" + . $self->TransactionObj->id() . "." + . rand(20) . "\@" + . $RT::Organization . ">" ) + unless $self->TemplateObj->MIMEObj->head->get('Message-ID'); +} - # Trim leading and trailing spaces. - @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } Email::Address->parse(join(', ', grep {defined} @blacklist)); +# }}} - foreach my $type (@EMAIL_RECIPIENT_HEADERS) { - my @addrs; - foreach my $addr ( @{ $self->{$type} } ) { +# }}} - # Weed out any RT addresses. We really don't want to talk to ourselves! - # If we get a reply back, that means it's not an RT address - if ( !RT::EmailParser->CullRTAddresses($addr) ) { - $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); - next; - } - if ( grep /^\Q$addr\E$/, @blacklist ) { - $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping"); - next; - } - push @addrs, $addr; - } - @{ $self->{$type} } = @addrs; - } -} +# {{{ sub SetReturnAddress =head2 SetReturnAddress is_comment => BOOLEAN @@ -843,11 +409,8 @@ Calculate and set From and Reply-To headers based on the is_comment flag. sub SetReturnAddress { my $self = shift; - my %args = ( - is_comment => 0, - friendly_name => undef, - @_ - ); + my %args = ( is_comment => 0, + @_ ); # From and Reply-To # $args{is_comment} should be set if the comment address is to be used. @@ -855,37 +418,29 @@ sub SetReturnAddress { if ( $args{'is_comment'} ) { $replyto = $self->TicketObj->QueueObj->CommentAddress - || RT->Config->Get('CommentAddress'); - } else { + || $RT::CommentAddress; + } + else { $replyto = $self->TicketObj->QueueObj->CorrespondAddress - || RT->Config->Get('CorrespondAddress'); + || $RT::CorrespondAddress; } unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { - if ( RT->Config->Get('UseFriendlyFromLine') ) { - 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; - $self->SetHeader( - 'From', - sprintf( - RT->Config->Get('FriendlyFromLineFormat'), - $self->MIMEEncodeString( - $friendly_name, RT->Config->Get('EmailOutputEncoding') - ), - $replyto - ), - ); - } else { - $self->SetHeader( 'From', $replyto ); - } + 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 ); + } } unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { @@ -894,6 +449,10 @@ sub SetReturnAddress { } +# }}} + +# {{{ sub SetHeader + =head2 SetHeader FIELD, VALUE Set the FIELD of the current MIME object into VALUE. @@ -907,151 +466,163 @@ sub SetHeader { chomp $val; chomp $field; - my $head = $self->TemplateObj->MIMEObj->head; - $head->fold_length( $field, 10000 ); - $head->replace( $field, $val ); - return $head->get($field); + $self->TemplateObj->MIMEObj->head->fold_length( $field, 10000 ); + $self->TemplateObj->MIMEObj->head->replace( $field, $val ); + return $self->TemplateObj->MIMEObj->head->get($field); } -=head2 SetSubject +# }}} -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. +# {{{ sub SetRecipients -=cut +=head2 SetRecipients -sub SetSubject { +Dummy method to be overriden by subclasses which want to set the recipients. + +=cut + +sub SetRecipients { my $self = shift; - my $subject; + return (); +} - if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { - return (); - } +# }}} - my $message = $self->TransactionObj->Attachments; - $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; +# {{{ sub SetTo - $subject =~ s/(\r\n|\n|\s)/ /g; +=head2 SetTo - $self->SetHeader( 'Subject', $subject ); +Takes a string that is the addresses you want to send mail to +=cut + +sub SetTo { + my $self = shift; + my $addresses = shift; + return $self->SetHeader( 'To', $addresses ); } -=head2 SetSubjectToken +# }}} -This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. +# {{{ sub SetCc + +=head2 SetCc + +Takes a string that is the addresses you want to Cc =cut -sub SetSubjectToken { - my $self = shift; +sub SetCc { + my $self = shift; + my $addresses = shift; - my $head = $self->TemplateObj->MIMEObj->head; - $head->replace( - Subject => RT::Interface::Email::AddSubjectTag( - Encode::decode_utf8( $head->get('Subject') ), - $self->TicketObj, - ), - ); + return $self->SetHeader( 'Cc', $addresses ); } -=head2 SetReferencesHeaders +# }}} + +# {{{ sub SetBcc -Set References and In-Reply-To headers for this message. +=head2 SetBcc + +Takes a string that is the addresses you want to Bcc =cut -sub SetReferencesHeaders { +sub SetBcc { + my $self = shift; + my $addresses = shift; + + return $self->SetHeader( 'Bcc', $addresses ); +} + +# }}} + +# {{{ sub SetPrecedence + +sub SetPrecedence { my $self = shift; - my ( @in_reply_to, @references, @msgid ); - - if ( my $top = $self->TransactionObj->Message->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 { - return (undef); + + unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ) { + $self->SetHeader( 'Precedence', "bulk" ); } +} - # 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 - } +# }}} - # In reply to whatever the internal message was in reply to - $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) ); +# {{{ sub SetSubject + +=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; - # Push that message onto the end of the references - push @references, @msgid; - } + 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 pseudo-ref to the front - my $pseudo_ref = $self->PseudoReference; - @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references ); + } + else { + $subject = $self->TicketObj->Subject(); + } - # 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 ); + $subject =~ s/(\r\n|\n|\s)/ /gi; - # Add on the references - $self->SetHeader( 'References', join( " ", @references ) ); - $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 ); + chomp $subject; + $self->SetHeader( 'Subject', $subject ); + } + return ($subject); } -=head2 PseudoReference +# }}} -Returns a fake Message-ID: header for the ticket to allow a base level of threading +# {{{ sub SetSubjectToken -=cut +=head2 SetSubjectToken + +This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. -sub PseudoReference { +=cut +sub SetSubjectToken { my $self = shift; - my $pseudo_ref - = 'TicketObj->id . '@' - . RT->Config->Get('Organization') . '>'; - return $pseudo_ref; + 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" ); + } } +# }}} + +# }}} + +# {{{ + =head2 SetHeaderAsEncoding($field_name, $charset_encoding) This routine converts the field into specified charset encoding. @@ -1062,37 +633,53 @@ sub SetHeaderAsEncoding { my $self = shift; my ( $field, $enc ) = ( shift, shift ); - my $head = $self->TemplateObj->MIMEObj->head; - - if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { - $head->replace( $field, RT->Config->Get('SMTPFrom') ); - return; + if ($field eq 'From' and $RT::SMTPFrom) { + $self->TemplateObj->MIMEObj->head->replace( $field, $RT::SMTPFrom ); + return; } - my $value = $head->get( $field ); - $value = $self->MIMEEncodeString( $value, $enc ); - $head->replace( $field, $value ); + my $value = $self->TemplateObj->MIMEObj->head->get($field); -} + # don't bother if it's us-ascii + + # See RT::I18N, 'NOTES: Why Encode::_utf8_off before Encode::from_to' -=head2 MIMEEncodeString + $value = $self->MIMEEncodeString($value, $enc); -Takes a perl string and optional encoding pass it over -L. + $self->TemplateObj->MIMEObj->head->replace( $field, $value ); -Basicly encode a string using B encoding according to RFC2047. + +} +# }}} + +# {{{ MIMENcodeString + +=head2 MIMEEncodeString STRING ENCODING + +Takes a string and a possible encoding and returns the string wrapped in MIME goo. =cut sub MIMEEncodeString { - my $self = shift; - return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); + 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 ); } +# }}} + eval "require RT::Action::SendEmail_Vendor"; -die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Vendor.pm} ); +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} ); +die $@ if ($@ && $@ !~ qr{^Can't locate RT/Action/SendEmail_Local.pm}); 1;