X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FAction%2FSendEmail.pm;h=dac8fc8e72a35c2fa28d7fc53f65e10902b81803;hb=74e058c8a010ef6feb539248a550d0bb169c1e94;hp=cfa91391a5313195e755938f3363b1db01e7f1d9;hpb=8103c1fc1b2c27a6855feadf26f91b980a54bc52;p=freeside.git diff --git a/rt/lib/RT/Action/SendEmail.pm b/rt/lib/RT/Action/SendEmail.pm index cfa91391a..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: -# -# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC -# +# Copyright (c) 1996-2003 Jesse Vincent # -# (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,31 +14,13 @@ # 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. -# -# -# 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.) +# 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. # -# 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; @@ -57,8 +33,6 @@ use vars qw/@ISA/; use MIME::Words qw(encode_mimeword); use RT::EmailParser; -use Mail::Address; -use Date::Format qw(strftime); =head1 NAME @@ -77,6 +51,13 @@ RT::Action::AutoReply is a good example subclass. 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). + + =begin testing ok (require RT::Action::SendEmail); @@ -96,407 +77,236 @@ perl(1). # {{{ Scrip methods (_Init, Commit, Prepare, IsApplicable) +# {{{ sub _Init +# We use _Init from RT::Action +# }}} # {{{ sub Commit - +#Do what we need to do and send it out. sub Commit { - # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's - # ability to pass @_ to a 'post' routine. - my $self = $_[0]; - - my ($ret) = $self->SendMessage( $self->TemplateObj->MIMEObj ); - if ( $ret > 0 ) { - $self->RecordOutgoingMailTransaction( $self->TemplateObj->MIMEObj ) - if ($RT::RecordOutgoingEmail); - } - return (abs $ret); -} - -# }}} - -# {{{ sub Prepare - -sub Prepare { my $self = shift; - 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 $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 - # Header - $self->SetRTSpecialHeaders(); + # 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 + + if ( defined $self->TransactionObj->Attachments->First() ) { - $self->RemoveInappropriateRecipients(); + my $squelch = $self->TransactionObj->Attachments->First->GetHeader( 'RT-Squelch-Replies-To'); - my %seen; - foreach my $type qw(To Cc Bcc) { - @{ $self->{ $type } } = - grep defined && length && !$seen{ lc $_ }++, - @{ $self->{ $type } }; + if ($squelch) { + my @blacklist = split ( /,/, $squelch ); + + # Cycle through the people we're sending to and pull out anyone on the + # system blacklist + + 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'} } ); - $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'} } ); - # 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')); + $self->SetHeader('MIME-Version', '1.0'); - # 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'); + RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' ); + $self->SetHeader( 'Content-Type', 'text/plain; charset="' . $RT::EmailOutputEncoding . '"' ); - # For security reasons, we only send out textual mails. - my @parts = $MIMEObj; - while (my $part = shift @parts) { - if ($part->is_multipart) { - push @parts, $part->parts; - } - else { - if ( RT::I18N::IsTextualContentType( $part->mime_type ) ) { - $part->head->mime_attr( "Content-Type" => $part->mime_type ) - } else { - $part->head->mime_attr( "Content-Type" => 'text/plain' ); - } - $part->head->mime_attr( "Content-Type.charset" => 'utf-8' ); - } - } + # Build up a MIME::Entity that looks like the original message. - RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, $RT::EmailOutputEncoding, 'mime_words_ok' ); + my $do_attach = $self->TemplateObj->MIMEObj->head->get('RT-Attach-Message'); - # Build up a MIME::Entity that looks like the original message. - $self->AddAttachments() if ( $MIMEObj->head->get('RT-Attach-Message') ); + if ($do_attach) { + $self->TemplateObj->MIMEObj->head->delete('RT-Attach-Message'); - return $result; + my $attachments = RT::Attachments->new($RT::SystemUser); + $attachments->Limit( FIELD => 'TransactionId', + VALUE => $self->TransactionObj->Id ); + $attachments->OrderBy('id'); -} + my $transaction_content_obj = $self->TransactionObj->ContentObj; -# }}} + # attach any of this transaction's attachments + while ( my $attach = $attachments->Next ) { -# }}} + # 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 ), + Encoding => '-SUGGEST'); + } + } -=head2 To -Returns an array of Mail::Address objects containing all the To: recipients for this notification + my $retval = $self->SendMessage($MIMEObj); -=cut -sub To { - my $self = shift; - return ($self->_AddressesFromHeader('To')); + return ($retval); } -=head2 Cc - -Returns an array of Mail::Address objects containing all the Cc: recipients for this notification +# }}} -=cut +# {{{ sub Prepare -sub Cc { +sub Prepare { my $self = shift; - return ($self->_AddressesFromHeader('Cc')); -} -=head2 Bcc + # This actually populates the MIME::Entity fields in the Template Object -Returns an array of Mail::Address objects containing all the Bcc: recipients for this notification + 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 Bcc { - my $self = shift; - return ($self->_AddressesFromHeader('Bcc')); + unless ( $self->TicketObj ) { + $RT::Logger->warning("No ticket object handed to $self\n"); -} + } -sub _AddressesFromHeader { - my $self = shift; - my $field = shift; - my $header = $self->TemplateObj->MIMEObj->head->get($field); - my @addresses = Mail::Address->parse($header); + 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 ); + } + } + + return $result; - return (@addresses); } +# }}} -# {{{ SendMessage +# }}} +# {{{ SendMessage =head2 SendMessage MIMEObj sends the message using RT's preferred API. -TODO: Break this out to a separate module +TODO: Break this out to a seperate module =cut sub SendMessage { - # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's - # ability to pass @_ to a 'post' routine. - my ( $self, $MIMEObj ) = @_; + my $self = shift; + my $MIMEObj = shift; - my $msgid = $MIMEObj->head->get('Message-ID'); - chomp $msgid; + my $msgid = $MIMEObj->head->get('Message-Id'); - $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()]})); - } - - return (0) unless ($self->OutputMIMEObject($MIMEObj)); - - my $success = $msgid . " sent "; - foreach( qw(To Cc Bcc) ) { - my $recipients = $MIMEObj->head->get($_); - $success .= " $_: ". $recipients if $recipients; - } - $success =~ s/\n//g; - - $RT::Logger->info($success); - - return (1); -} - - -=head2 OutputMIMEObject MIME::Entity - -Sends C as an email message according to RT's mailer configuration. - -=cut - - - -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}"; + 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); } + # 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. + $self->SetHeader( 'To', join ( ',', @{ $self->{'PseudoTo'} } ) ) + if ( $self->{'PseudoTo'} && ( @{ $self->{'PseudoTo'} } ) + and ( !$MIMEObj->head->get('To') ) ); if ( $RT::MailCommand eq 'sendmailpipe' ) { eval { - # don't ignore CHLD signal to get proper exit code - local $SIG{'CHLD'} = 'DEFAULT'; - - my $mail; - unless( open $mail, "|$RT::SendmailPath $SendmailArguments" ) { - die "Couldn't run $RT::SendmailPath: $!"; - } - - # 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); - - 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; + 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}; + my @mailer_args = ($RT::MailCommand); + local $ENV{MAILADDRESS}; if ( $RT::MailCommand eq 'sendmail' ) { - push @mailer_args, split(/\s+/, $SendmailArguments); + 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; + $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." ); + unless ( $MIMEObj->send( @mailer_args ) ) { + $RT::Logger->crit($msgid. "Could not send mail." ); return (0); } } - return 1; -} -# }}} - -# {{{ AddAttachments - -=head2 AddAttachments - -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 - ); - $attachments->OrderBy( FIELD => 'id'); - - my $transaction_content_obj = $self->TransactionObj->ContentObj; - - # attach any of this transaction's attachments - while ( my $attach = $attachments->Next ) { - - # Don't attach anything blank - next unless ( $attach->ContentLength ); - -# We want to make sure that we don't include the attachment that's being used 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' - ); - } + 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); + return (1); } # }}} -# {{{ RecordOutgoingMailTransaction - -=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 $transaction = RT::Transaction->new($self->TransactionObj->CurrentUser); - - # 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'; - } - - 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 - ); - - if( $id ) { - $self->{'OutgoingMailTransaction'} = $id; - } else { - $RT::Logger->warning( "Could not record outgoing message transaction: $msg" ); - } - return $id; -} - -# }}} -# +# {{{ Deal with message headers (Set* subs, designed for easy overriding) # {{{ sub SetRTSpecialHeaders @@ -510,161 +320,84 @@ that don't matter much to anybody else. sub SetRTSpecialHeaders { my $self = shift; - $self->SetSubject(); - $self->SetSubjectToken(); - $self->SetHeaderAsEncoding( 'Subject', $RT::EmailOutputEncoding ) - if ($RT::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; - - # 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>$/ - "<$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', - "TicketObj->id . "-" - . $self->ScripObj->id . "-" # Scrip - . $self->ScripActionObj->{_Message_ID} . "@" # Email sent - . $RT::Organization - . ">" ); - } - } + $self->SetReferences(); + + $self->SetMessageID(); - $self->SetHeader( 'Precedence', "bulk" ) - unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ); + $self->SetPrecedence(); $self->SetHeader( 'X-RT-Loop-Prevention', $RT::rtname ); $self->SetHeader( 'RT-Ticket', - $RT::rtname . " #" . $self->TicketObj->id() ); + $RT::rtname . " #" . $self->TicketObj->id() ); $self->SetHeader( 'Managed-by', - "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); + "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); $self->SetHeader( 'RT-Originator', - $self->TransactionObj->CreatorObj->EmailAddress ); + $self->TransactionObj->CreatorObj->EmailAddress ); + return (); } -# }}} - - -# }}} - -# {{{ RemoveInappropriateRecipients +# {{{ sub SetReferences -=head2 RemoveInappropriateRecipients - -Remove addresses that are RT addresses or that are on this transaction's blacklist +=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 RemoveInappropriateRecipients { +sub SetReferences { my $self = shift; - my $msgid = $self->TemplateObj->MIMEObj->head->get ('Message-Id'); - - - - my @blacklist; + # 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 @types = qw/To Cc Bcc/; + $self->SetHeader( 'In-Reply-To', + "TicketObj->id() . "\@" . $RT::rtname . ">" ); - # 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} } ); - } - - # 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') - ) - { - - # 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 ) { - - # Don't send to any watchers. - @{ $self->{'To'} } = (); - @{ $self->{'Cc'} } = (); - @{ $self->{'Bcc'} } = (); - - $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message based on site configuration.\n"); - } - elsif ( $RT::RedistributeAutoGeneratedMessages eq 'privileged' ) { - - # Only send to "privileged" watchers. - # - - foreach my $type (@types) { - - foreach my $addr ( @{ $self->{$type} } ) { - my $user = RT::User->new($RT::SystemUser); - $user->LoadByEmail($addr); - @{ $self->{$type} } = - grep ( !/^\Q$addr\E$/, @{ $self->{$type} } ) - if ( !$user->Privileged ); + # TODO We should always add References headers for all message-ids + # of previous messages related to this ticket. +} - } - } - $RT::Logger->info( $msgid . " The incoming message was autogenerated. Not redistributing this message to unprivileged users based on site configuration.\n"); +# }}} - } +# {{{ sub SetMessageID - } +=head2 SetMessageID - my $squelch = - $self->TransactionObj->Attachments->First->GetHeader( - 'RT-Squelch-Replies-To'); +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. - if ($squelch) { - @blacklist = split( /,/, $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; - } +=cut - # Cycle through the people we're sending to and pull out anyone on the - # system blacklist +sub SetMessageID { + my $self = shift; - 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} } ); - } - } + # 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'); } # }}} + +# }}} + # {{{ sub SetReturnAddress =head2 SetReturnAddress is_comment => BOOLEAN @@ -676,10 +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, - @_ - ); + my %args = ( is_comment => 0, + @_ ); # From and Reply-To # $args{is_comment} should be set if the comment address is to be used. @@ -695,27 +426,21 @@ sub SetReturnAddress { } 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 ); - } + 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') ) { @@ -748,166 +473,155 @@ sub SetHeader { # }}} +# {{{ sub SetRecipients -# {{{ sub SetSubject +=head2 SetRecipients -=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 -the transaction's subject. +Dummy method to be overriden by subclasses which want to set the recipients. -=cut +=cut -sub SetSubject { +sub SetRecipients { my $self = shift; - my $subject; + return (); +} - my $message = $self->TransactionObj->Attachments; - if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { - return (); - } - 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(); - } +# }}} - } - else { - $subject = $self->TicketObj->Subject(); - } +# {{{ sub SetTo - $subject =~ s/(\r\n|\n|\s)/ /gi; +=head2 SetTo - chomp $subject; - $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 ); } # }}} -# {{{ sub SetSubjectToken +# {{{ sub SetCc -=head2 SetSubjectToken +=head2 SetCc -This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. +Takes a string that is the addresses you want to Cc =cut -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 SetCc { + my $self = shift; + my $addresses = shift; - $sub =~ s/(\r\n|\n|\s)/ /gi; - chomp $sub; - $self->TemplateObj->MIMEObj->head->replace( - Subject => "[$RT::rtname #$id] $sub", - ); + return $self->SetHeader( 'Cc', $addresses ); } # }}} -=head2 SetReferencesHeaders +# {{{ sub SetBcc + +=head2 SetBcc -Set References and In-Reply-To headers for this message. +Takes a string that is the addresses you want to Bcc =cut -sub SetReferencesHeaders { +sub SetBcc { + my $self = shift; + my $addresses = shift; - my $self = shift; - my ( @in_reply_to, @references, @msgid ); + return $self->SetHeader( 'Bcc', $addresses ); +} - 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 { - return (undef); - } +# {{{ sub SetPrecedence - # 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>/) { - - # 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>$/ - "<$1." . $self->TicketObj->id . - "-" . $self->ScripObj->id . - "-" . $self->ScripActionObj->{_Message_ID} . - "@" . $RT::Organization . ">"/eg - } - - # 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; - - # 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; - - # Push that message onto the end of the references - push @references, @msgid; +sub SetPrecedence { + my $self = shift; + + unless ( $self->TemplateObj->MIMEObj->head->get("Precedence") ) { + $self->SetHeader( 'Precedence', "bulk" ); } +} + +# }}} + +# {{{ 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 +the transaction's subject. + +=cut - # Push pseudo-ref to the front - my $pseudo_ref = $self->PseudoReference; - @references = ($pseudo_ref, grep { $_ ne $pseudo_ref } @references); +sub SetSubject { + my $self = shift; + my $subject; + + 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(); + } + + } + 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 +# {{{ sub SetSubjectToken -Returns a fake Message-ID: header for the ticket to allow a base level of threading +=head2 SetSubjectToken -=cut +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::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" ); + } } +# }}} -# {{{ SetHeadingAsEncoding +# }}} + +# {{{ =head2 SetHeaderAsEncoding($field_name, $charset_encoding) @@ -926,6 +640,10 @@ sub SetHeaderAsEncoding { 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' + $value = $self->MIMEEncodeString($value, $enc); $self->TemplateObj->MIMEObj->head->replace( $field, $value ); @@ -934,7 +652,7 @@ sub SetHeaderAsEncoding { } # }}} -# {{{ MIMEEncodeString +# {{{ MIMENcodeString =head2 MIMEEncodeString STRING ENCODING @@ -945,52 +663,15 @@ Takes a string and a possible encoding and returns the string wrapped in MIME go 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; + my $enc = shift; chomp $value; - - if ( $max <= 0 ) { - # gives an error... - $RT::Logger->crit("Can't encode! Charset or encoding too big.\n"); - return ($value); - } - return ($value) unless $value =~ /[^\x20-\x7e]/; $value =~ s/\s*$//; - - # we need perl string to split thing char by char - Encode::_utf8_on($value) unless Encode::is_utf8( $value ); - - my ($tmp, @chunks) = ('', ()); - while ( length $value ) { - my $char = substr($value, 0, 1, ''); - my $octets = Encode::encode( $charset, $char ); - if ( length($tmp) + length($octets) > $max ) { - push @chunks, $tmp; - $tmp = ''; - } - $tmp .= $octets; - } - push @chunks, $tmp if length $tmp; - - # encode an join chuncks - $value = join "\n ", - map encode_mimeword( $_, $encoding, $charset ), @chunks ; - return($value); + Encode::_utf8_off($value); + my $res = Encode::from_to( $value, "utf-8", $enc ); + $value = encode_mimeword( $value, 'B', $enc ); } # }}}