X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=rt%2Flib%2FRT%2FInterface%2FEmail.pm;h=4e15436eb6c6f1fb3ffc280d7d5a80049e4c1a5a;hp=dda6f704a933cc7201427bfc03cb5812cb2dc921;hb=187086c479a09629b7d180eec513fb7657f4e291;hpb=96783bdc58be6e4f2fc56d516a9ceba57af00ba8 diff --git a/rt/lib/RT/Interface/Email.pm b/rt/lib/RT/Interface/Email.pm index dda6f704a..4e15436eb 100755 --- a/rt/lib/RT/Interface/Email.pm +++ b/rt/lib/RT/Interface/Email.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -50,27 +50,25 @@ package RT::Interface::Email; use strict; use warnings; +use 5.010; use Email::Address; use MIME::Entity; use RT::EmailParser; use File::Temp; -use UNIVERSAL::require; use Mail::Mailer (); use Text::ParseWords qw/shellwords/; +use RT::Util 'safe_run_child'; +use File::Spec; BEGIN { use base 'Exporter'; use vars qw ( @EXPORT_OK); - # set the version for version checking - our $VERSION = 2.0; - # your exported package globals go here, # as well as any optionally exported functions @EXPORT_OK = qw( &CreateUser - &GetMessageContent &CheckForLoops &CheckForSuspiciousSender &CheckForAutoGenerated @@ -114,7 +112,7 @@ sub CheckForLoops { my $head = shift; # If this instance of RT sent it our, we don't want to take it in - my $RTLoop = $head->get("X-RT-Loop-Prevention") || ""; + my $RTLoop = Encode::decode( "UTF-8", $head->get("X-RT-Loop-Prevention") || "" ); chomp ($RTLoop); # remove that newline if ( $RTLoop eq RT->Config->Get('rtname') ) { return 1; @@ -149,6 +147,9 @@ sub CheckForSuspiciousSender { my ( $From, $junk ) = ParseSenderAddressFromHead($head); + # If unparseable (non-ASCII), $From can come back undef + return undef if not defined $From; + if ( ( $From =~ /^mailer-daemon\@/i ) or ( $From =~ /^postmaster\@/i ) or ( $From eq "" )) @@ -162,17 +163,16 @@ sub CheckForSuspiciousSender { =head2 CheckForAutoGenerated HEAD -Takes a HEAD object of L class and returns true if message -is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated' -fields of the head in tests. +Takes a HEAD object of L class and returns true if message is +autogenerated. Checks C, C, and +C fields of the head in tests. =cut sub CheckForAutoGenerated { my $head = shift; - my $Precedence = $head->get("Precedence") || ""; - if ( $Precedence =~ /^(bulk|junk)/i ) { + if (grep { /^(bulk|junk)/i } $head->get_all("Precedence")) { return (1); } @@ -222,8 +222,8 @@ add 'In-Reply-To' field to the error that points to this message. =item Attach - optional text that attached to the error as 'message/rfc822' part. -=item LogLevel - log level under which we should write explanation message into the -log, by default we log it as critical. +=item LogLevel - log level under which we should write the subject and +explanation message into the log, by default we log it as critical. =back @@ -244,28 +244,33 @@ sub MailError { $RT::Logger->log( level => $args{'LogLevel'}, - message => $args{'Explanation'} + message => "$args{Subject}: $args{'Explanation'}", ) if $args{'LogLevel'}; # the colons are necessary to make ->build include non-standard headers my %entity_args = ( Type => "multipart/mixed", - From => $args{'From'}, - Bcc => $args{'Bcc'}, - To => $args{'To'}, - Subject => $args{'Subject'}, - 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'), + From => Encode::encode( "UTF-8", $args{'From'} ), + Bcc => Encode::encode( "UTF-8", $args{'Bcc'} ), + To => Encode::encode( "UTF-8", $args{'To'} ), + Subject => EncodeToMIME( String => $args{'Subject'} ), + 'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", RT->Config->Get('rtname') ), ); # only set precedence if the sysadmin wants us to if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) { - $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence'); + $entity_args{'Precedence:'} = + Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') ); } my $entity = MIME::Entity->build(%entity_args); SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} ); - $entity->attach( Data => $args{'Explanation'} . "\n" ); + $entity->attach( + Type => "text/plain", + Charset => "UTF-8", + Data => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ), + ); if ( $args{'MIMEObj'} ) { $args{'MIMEObj'}->sync_headers; @@ -273,7 +278,7 @@ sub MailError { } if ( $args{'Attach'} ) { - $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' ); + $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' ); } @@ -323,7 +328,7 @@ sub WillSignEncrypt { my $attachment = delete $args{Attachment}; my $ticket = delete $args{Ticket}; - if ( not RT->Config->Get('GnuPG')->{'Enable'} ) { + if ( not RT->Config->Get('Crypt')->{'Enable'} ) { $args{Sign} = $args{Encrypt} = 0; return wantarray ? %args : 0; } @@ -347,6 +352,32 @@ sub WillSignEncrypt { return wantarray ? %args : ($args{Sign} || $args{Encrypt}); } +sub _OutgoingMailFrom { + my $TicketObj = shift; + + my $MailFrom = RT->Config->Get('SetOutgoingMailFrom'); + my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef; + my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {}; + + if ($TicketObj) { + my $Queue = $TicketObj->QueueObj; + my $QueueAddressOverride = $Overrides->{$Queue->id} + || $Overrides->{$Queue->Name}; + + if ($QueueAddressOverride) { + $OutgoingMailAddress = $QueueAddressOverride; + } else { + $OutgoingMailAddress ||= $Queue->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); + } + } + elsif ($Overrides->{'Default'}) { + $OutgoingMailAddress = $Overrides->{'Default'}; + } + + return $OutgoingMailAddress; +} + sub SendEmail { my (%args) = ( Entity => undef, @@ -359,19 +390,12 @@ sub SendEmail { my $TicketObj = $args{'Ticket'}; my $TransactionObj = $args{'Transaction'}; - foreach my $arg( qw(Entity Bounce) ) { - next unless defined $args{ lc $arg }; - - $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead"); - $args{ $arg } = delete $args{ lc $arg }; - } - unless ( $args{'Entity'} ) { $RT::Logger->crit( "Could not send mail without 'Entity' object" ); return 0; } - my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); chomp $msgid; # If we don't have any recipients to send to, don't send a message; @@ -388,13 +412,46 @@ sub SendEmail { return -1; } + if (my $precedence = RT->Config->Get('DefaultMailPrecedence') + and !$args{'Entity'}->head->get("Precedence") + ) { + if ($TicketObj) { + my $Overrides = RT->Config->Get('OverrideMailPrecedence') || {}; + my $Queue = $TicketObj->QueueObj; + + $precedence = $Overrides->{$Queue->id} + if exists $Overrides->{$Queue->id}; + $precedence = $Overrides->{$Queue->Name} + if exists $Overrides->{$Queue->Name}; + } + + $args{'Entity'}->head->replace( 'Precedence', Encode::encode("UTF-8",$precedence) ) + if $precedence; + } + if ( $TransactionObj && !$TicketObj && $TransactionObj->ObjectType eq 'RT::Ticket' ) { $TicketObj = $TransactionObj->Object; } - if ( RT->Config->Get('GnuPG')->{'Enable'} ) { + my $head = $args{'Entity'}->head; + unless ( $head->get('Date') ) { + require RT::Date; + my $date = RT::Date->new( RT->SystemUser ); + $date->SetToNow; + $head->replace( 'Date', Encode::encode("UTF-8",$date->RFC2822( Timezone => 'server' ) ) ); + } + unless ( $head->get('MIME-Version') ) { + # We should never have to set the MIME-Version header + $head->replace( 'MIME-Version', '1.0' ); + } + unless ( $head->get('Content-Transfer-Encoding') ) { + # fsck.com #5959: Since RT sends 8bit mail, we should say so. + $head->replace( 'Content-Transfer-Encoding', '8bit' ); + } + + if ( RT->Config->Get('Crypt')->{'Enable'} ) { %args = WillSignEncrypt( %args, Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef, @@ -404,45 +461,21 @@ sub SendEmail { return $res unless $res > 0; } - unless ( $args{'Entity'}->head->get('Date') ) { - require RT::Date; - my $date = RT::Date->new( RT->SystemUser ); - $date->SetToNow; - $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) ); - } - my $mail_command = RT->Config->Get('MailCommand'); - if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) { - $Mail::Mailer::testfile::config{outfile} = File::Temp->new; - $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}"); - } - # if it is a sub routine, we just return it; return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' ); if ( $mail_command eq 'sendmailpipe' ) { my $path = RT->Config->Get('SendmailPath'); my @args = shellwords(RT->Config->Get('SendmailArguments')); + push @args, "-t" unless grep {$_ eq "-t"} @args; # SetOutgoingMailFrom and bounces conflict, since they both want -f if ( $args{'Bounce'} ) { push @args, shellwords(RT->Config->Get('SendmailBounceArguments')); } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) { - my $OutgoingMailAddress; - - if ($TicketObj) { - my $QueueName = $TicketObj->QueueObj->Name; - my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName}; - - if ($QueueAddressOverride) { - $OutgoingMailAddress = $QueueAddressOverride; - } else { - $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress; - } - } - - $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'}; + my $OutgoingMailAddress = _OutgoingMailFrom($TicketObj); push @args, "-f", $OutgoingMailAddress if $OutgoingMailAddress; @@ -491,61 +524,43 @@ sub SendEmail { } return 0; } - } - elsif ( $mail_command eq 'smtp' ) { - require Net::SMTP; - my $smtp = do { local $@; eval { Net::SMTP->new( - Host => RT->Config->Get('SMTPServer'), - Debug => RT->Config->Get('SMTPDebug'), - ) } }; - unless ( $smtp ) { - $RT::Logger->crit( "Could not connect to SMTP server."); - if ($TicketObj) { - _RecordSendEmailFailure( $TicketObj ); - } - return 0; - } - - # duplicate head as we want drop Bcc field - my $head = $args{'Entity'}->head->dup; - my @recipients = map $_->address, map - Email::Address->parse($head->get($_)), qw(To Cc Bcc); - $head->delete('Bcc'); - - my $sender = RT->Config->Get('SMTPFrom') - || $args{'Entity'}->head->get('From'); - chomp $sender; - - my $status = $smtp->mail( $sender ) - && $smtp->recipient( @recipients ); - - if ( $status ) { - $smtp->data; - my $fh = $smtp->tied_fh; - $head->print( $fh ); - print $fh "\n"; - $args{'Entity'}->print_body( $fh ); - $smtp->dataend; + } elsif ( $mail_command eq 'mbox' ) { + my $now = RT::Date->new(RT->SystemUser); + $now->SetToNow; + + state $logfile; + unless ($logfile) { + my $when = $now->ISO( Timezone => "server" ); + $when =~ s/\s+/-/g; + $logfile = "$RT::VarPath/$when.mbox"; + $RT::Logger->info("Storing outgoing emails in $logfile"); } - $smtp->quit; - unless ( $status ) { - $RT::Logger->crit( "$msgid: Could not send mail via SMTP." ); - if ( $TicketObj ) { - _RecordSendEmailFailure( $TicketObj ); - } + my $fh; + unless (open($fh, ">>", $logfile)) { + $RT::Logger->crit( "Can't open mbox file $logfile: $!" ); return 0; } - } - else { + my $content = $args{Entity}->stringify; + $content =~ s/^(>*From )/>$1/mg; + my $user = $ENV{USER} || getpwuid($<); + print $fh "From $user\@localhost ".localtime()."\n"; + print $fh $content, "\n"; + close $fh; + } else { local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'}); my @mailer_args = ($mail_command); if ( $mail_command eq 'sendmail' ) { $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath'); - push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments')); - } - else { + push @mailer_args, grep {$_ ne "-t"} + split(/\s+/, RT->Config->Get('SendmailArguments')); + } elsif ( $mail_command eq 'testfile' ) { + unless ($Mail::Mailer::testfile::config{outfile}) { + $Mail::Mailer::testfile::config{outfile} = File::Temp->new; + $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}"); + } + } else { push @mailer_args, RT->Config->Get('MailParams'); } @@ -618,10 +633,10 @@ sub SendEmailUsingTemplate { return -1; } - $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) ) + $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ $_ } ) ) foreach grep defined $args{$_}, qw(To Cc Bcc From); - $mail->head->set( $_ => $args{ExtraHeaders}{$_} ) + $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) ) foreach keys %{ $args{ExtraHeaders} }; SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} ); @@ -629,194 +644,58 @@ sub SendEmailUsingTemplate { return SendEmail( Entity => $mail ); } -=head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => '' - -Forwards transaction with all attachments as 'message/rfc822'. - -=cut - -sub ForwardTransaction { - my $txn = shift; - my %args = ( To => '', Cc => '', Bcc => '', @_ ); - - my $entity = $txn->ContentAsMIME; - - my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn ); - if ($ret) { - my $ticket = $txn->TicketObj; - my ( $ret, $msg ) = $ticket->_NewTransaction( - Type => 'Forward Transaction', - Field => $txn->id, - Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc}, - ); - unless ($ret) { - $RT::Logger->error("Failed to create transaction: $msg"); - } - } - return ( $ret, $msg ); -} - -=head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => '' - -Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'. - -=cut - -sub ForwardTicket { - my $ticket = shift; - my %args = ( To => '', Cc => '', Bcc => '', @_ ); - - my $txns = $ticket->Transactions; - $txns->Limit( - FIELD => 'Type', - VALUE => $_, - ) for qw(Create Correspond); - - my $entity = MIME::Entity->build( - Type => 'multipart/mixed', - Description => 'forwarded ticket', - ); - $entity->add_part( $_ ) foreach - map $_->ContentAsMIME, - @{ $txns->ItemsArrayRef }; - - my ( $ret, $msg ) = SendForward( - %args, - Entity => $entity, - Ticket => $ticket, - Template => 'Forward Ticket', - ); - - if ($ret) { - my ( $ret, $msg ) = $ticket->_NewTransaction( - Type => 'Forward Ticket', - Field => $ticket->id, - Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc}, - ); - unless ($ret) { - $RT::Logger->error("Failed to create transaction: $msg"); - } - } - - return ( $ret, $msg ); - -} - -=head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => '' +=head2 GetForwardFrom Ticket => undef, Transaction => undef -Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template. +Resolve the From field to use in forward mail =cut -sub SendForward { - my (%args) = ( - Entity => undef, - Ticket => undef, - Transaction => undef, - Template => 'Forward', - To => '', Cc => '', Bcc => '', - @_ - ); - - my $txn = $args{'Transaction'}; - my $ticket = $args{'Ticket'}; - $ticket ||= $txn->Object if $txn; - - my $entity = $args{'Entity'}; - unless ( $entity ) { - require Carp; - $RT::Logger->error(Carp::longmess("No entity provided")); - return (0, $ticket->loc("Couldn't send email")); - } - - my ($template, $msg) = PrepareEmailUsingTemplate( - Template => $args{'Template'}, - Arguments => { - Ticket => $ticket, - Transaction => $txn, - }, - ); - - my $mail; - if ( $template ) { - $mail = $template->MIMEObj; - } else { - $RT::Logger->warning($msg); - } - unless ( $mail ) { - $RT::Logger->warning("Couldn't generate email using template '$args{Template}'"); +sub GetForwardFrom { + my %args = ( Ticket => undef, Transaction => undef, @_ ); + my $txn = $args{Transaction}; + my $ticket = $args{Ticket} || $txn->Object; - my $description; - unless ( $args{'Transaction'} ) { - $description = 'This is forward of ticket #'. $ticket->id; - } else { - $description = 'This is forward of transaction #' - . $txn->id ." of a ticket #". $txn->ObjectId; - } - $mail = MIME::Entity->build( - Type => 'text/plain', - Data => $description, - ); + if ( RT->Config->Get('ForwardFromUser') ) { + return ( $txn || $ticket )->CurrentUser->EmailAddress; } - - $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) ) - foreach grep defined $args{$_}, qw(To Cc Bcc); - - $mail->make_multipart unless $mail->is_multipart; - $mail->add_part( $entity ); - - my $from; - unless (defined $mail->head->get('Subject')) { - my $subject = ''; - $subject = $txn->Subject if $txn; - $subject ||= $ticket->Subject if $ticket; - - unless ( RT->Config->Get('ForwardFromUser') ) { - # XXX: what if want to forward txn of other object than ticket? - $subject = AddSubjectTag( $subject, $ticket ); - } - - $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) ); + else { + return $ticket->QueueObj->CorrespondAddress + || RT->Config->Get('CorrespondAddress'); } - - $mail->head->set( - From => EncodeToMIME( - String => GetForwardFrom( Transaction => $txn, Ticket => $ticket ) - ) - ); - - my $status = RT->Config->Get('ForwardFromUser') - # never sign if we forward from User - ? SendEmail( %args, Entity => $mail, Sign => 0 ) - : SendEmail( %args, Entity => $mail ); - return (0, $ticket->loc("Couldn't send email")) unless $status; - return (1, $ticket->loc("Sent email successfully")); } -=head2 GetForwardFrom Ticket => undef, Transaction => undef +=head2 GetForwardAttachments Ticket => undef, Transaction => undef -Resolve the From field to use in forward mail +Resolve the Attachments to forward =cut -sub GetForwardFrom { +sub GetForwardAttachments { my %args = ( Ticket => undef, Transaction => undef, @_ ); my $txn = $args{Transaction}; my $ticket = $args{Ticket} || $txn->Object; - if ( RT->Config->Get('ForwardFromUser') ) { - return ( $txn || $ticket )->CurrentUser->EmailAddress; + my $attachments = RT::Attachments->new( $ticket->CurrentUser ); + if ($txn) { + $attachments->Limit( FIELD => 'TransactionId', VALUE => $txn->id ); } else { - return $ticket->QueueObj->CorrespondAddress - || RT->Config->Get('CorrespondAddress'); + $attachments->LimitByTicket( $ticket->id ); + $attachments->Limit( + ALIAS => $attachments->TransactionAlias, + FIELD => 'Type', + OPERATOR => 'IN', + VALUE => [ qw(Create Correspond) ], + ); } + return $attachments; } + =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0 -Signs and encrypts message using L, but as well -handle errors with users' keys. +Signs and encrypts message using L, but as well handle errors +with users' keys. If a recipient has no key or has other problems with it, then the unction sends a error to him using 'Error: public key' template. @@ -838,17 +717,18 @@ sub SignEncrypt { ); return 1 unless $args{'Sign'} || $args{'Encrypt'}; - my $msgid = $args{'Entity'}->head->get('Message-ID') || ''; + my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' ); chomp $msgid; $RT::Logger->debug("$msgid Signing message") if $args{'Sign'}; $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'}; - require RT::Crypt::GnuPG; - my %res = RT::Crypt::GnuPG::SignEncrypt( %args ); + my %res = RT::Crypt->SignEncrypt( %args ); return 1 unless $res{'exit_code'}; - my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + my @status = RT::Crypt->ParseStatus( + Protocol => $res{'Protocol'}, Status => $res{'status'}, + ); my @bad_recipients; foreach my $line ( @status ) { @@ -912,7 +792,7 @@ sub SignEncrypt { } # redo without broken recipients - %res = RT::Crypt::GnuPG::SignEncrypt( %args ); + %res = RT::Crypt->SignEncrypt( %args ); return 0 if $res{'exit_code'}; return 1; @@ -974,9 +854,6 @@ sub EncodeToMIME { $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, '' ); @@ -1059,7 +936,7 @@ sub CreateUser { Takes a hash containing QueueObj, Head and CurrentUser objects. Returns a list of all email addresses in the To and Cc -headers b the current Queue\'s email addresses, the CurrentUser\'s +headers b the current Queue's email addresses, the CurrentUser's email address and anything that the configuration sub RT::IsRTAddress matches. =cut @@ -1081,7 +958,8 @@ sub ParseCcAddressesFromHead { && !IgnoreCcAddress( $_ ) } map lc $user->CanonicalizeEmailAddress( $_->address ), - map Email::Address->parse( $args{'Head'}->get( $_ ) ), + map RT::EmailParser->CleanupAddresses( Email::Address->parse( + Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ), qw(To Cc); } @@ -1101,23 +979,34 @@ sub IgnoreCcAddress { =head2 ParseSenderAddressFromHead HEAD -Takes a MIME::Header object. Returns a tuple: (user@host, friendly name) -of the From (evaluated in order of Reply-To:, From:, Sender) +Takes a MIME::Header object. Returns (user@host, friendly name, errors) +where the first two values are the From (evaluated in order of +Reply-To:, From:, Sender). + +A list of error messages may be returned even when a Sender value is +found, since it could be a parse error for another (checked earlier) +sender field. In this case, the errors aren't fatal, but may be useful +to investigate the parse failure. =cut sub ParseSenderAddressFromHead { my $head = shift; + my @sender_headers = ('Reply-To', 'From', 'Sender'); + my @errors; # Accumulate any errors #Figure out who's sending this message. - foreach my $header ('Reply-To', 'From', 'Sender') { - my $addr_line = $head->get($header) || next; + foreach my $header ( @sender_headers ) { + my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next; my ($addr, $name) = ParseAddressFromHeader( $addr_line ); # only return if the address is not empty - return ($addr, $name) if $addr; + return ($addr, $name, @errors) if $addr; + + chomp $addr_line; + push @errors, "$header: $addr_line"; } - return (undef, undef); + return (undef, undef, @errors); } =head2 ParseErrorsToAddressFromHead HEAD @@ -1136,7 +1025,7 @@ sub ParseErrorsToAddressFromHead { foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) { # If there's a header of that name - my $headerobj = $head->get($header); + my $headerobj = Encode::decode( "UTF-8", $head->get($header) ); if ($headerobj) { my ( $addr, $name ) = ParseAddressFromHeader($headerobj); @@ -1181,9 +1070,9 @@ sub DeleteRecipientsFromHead { my %skip = map { lc $_ => 1 } @_; foreach my $field ( qw(To Cc Bcc) ) { - $head->set( $field => + $head->replace( $field => Encode::encode( "UTF-8", join ', ', map $_->format, grep !$skip{ lc $_->address }, - Email::Address->parse( $head->get( $field ) ) + Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) ) ); } } @@ -1216,7 +1105,7 @@ sub SetInReplyTo { my $get_header = sub { my @res; if ( $args{'InReplyTo'}->isa('MIME::Entity') ) { - @res = $args{'InReplyTo'}->head->get( shift ); + @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift ); } else { @res = $args{'InReplyTo'}->GetHeader( shift ) || ''; } @@ -1232,38 +1121,66 @@ sub SetInReplyTo { } push @references, @id, @rtid; if ( $args{'Ticket'} ) { - my $pseudo_ref = 'id .'@'. RT->Config->Get('Organization') .'>'; + my $pseudo_ref = PseudoReference( $args{'Ticket'} ); push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references; } - @references = splice @references, 4, -6 + splice @references, 4, -6 if @references > 10; my $mail = $args{'Message'}; - $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; - $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) ); + $mail->head->replace( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid; + $mail->head->replace( 'References' => Encode::encode( "UTF-8", join ' ', @references) ); +} + +sub PseudoReference { + my $ticket = shift; + return 'id .'@'. RT->Config->Get('Organization') .'>'; } +=head2 ExtractTicketId + +Passed a MIME::Entity. Returns a ticket id or undef to signal 'new ticket'. + +This is a great entry point if you need to customize how ticket ids are +handled for your site. RT-Extension-RepliesToResolved demonstrates one +possible use for this extension. + +If the Subject of this ticket is modified, it will be reloaded by the +mail gateway code before Ticket creation. + +=cut + sub ExtractTicketId { my $entity = shift; - my $subject = $entity->head->get('Subject') || ''; + my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' ); chomp $subject; return ParseTicketId( $subject ); } +=head2 ParseTicketId + +Takes a string and searches for [subjecttag #id] + +Returns the id if a match is found. Otherwise returns undef. + +=cut + sub ParseTicketId { my $Subject = shift; my $rtname = RT->Config->Get('rtname'); my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i; + # We use @captures and pull out the last capture value to guard against + # someone using (...) instead of (?:...) in $EmailSubjectTagRegex. my $id; - if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) { - $id = $1; + if ( my @captures = $Subject =~ /\[$test_name\s+\#(\d+)\s*\]/i ) { + $id = $captures[-1]; } else { foreach my $tag ( RT->System->SubjectTag ) { - next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i; - $id = $1; + next unless my @captures = $Subject =~ /\[\Q$tag\E\s+\#(\d+)\s*\]/i; + $id = $captures[-1]; last; } } @@ -1412,6 +1329,10 @@ sub Gateway { push @mail_plugins, "Auth::MailFrom" unless @mail_plugins; @mail_plugins = _LoadPlugins( @mail_plugins ); + #Set up a queue object + my $SystemQueueObj = RT::Queue->new( RT->SystemUser ); + $SystemQueueObj->Load( $args{'queue'} ); + my %skip_plugin; foreach my $class( grep !ref, @mail_plugins ) { # check if we should apply filter before decoding @@ -1423,6 +1344,8 @@ sub Gateway { next unless $check_cb->( Message => $Message, RawMessageRef => \$args{'message'}, + Queue => $SystemQueueObj, + Actions => \@actions, ); $skip_plugin{ $class }++; @@ -1434,6 +1357,8 @@ sub Gateway { my ($status, $msg) = $Code->( Message => $Message, RawMessageRef => \$args{'message'}, + Queue => $SystemQueueObj, + Actions => \@actions, ); next if $status > 0; @@ -1445,16 +1370,20 @@ sub Gateway { } @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins; $parser->_DecodeBodies; + $parser->RescueOutlook; $parser->_PostProcessNewEntity; my $head = $Message->head; my $ErrorsTo = ParseErrorsToAddressFromHead( $head ); + my $Sender = (ParseSenderAddressFromHead( $head ))[0]; + my $From = Encode::decode( "UTF-8", $head->get("From") ); + chomp $From if defined $From; - my $MessageId = $head->get('Message-ID') + my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') ) || "Config->Get('Organization') .'>'; #Pull apart the subject line - my $Subject = $head->get('Subject') || ''; + my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || ''); chomp $Subject; # Lets check for mail loops of various sorts. @@ -1476,6 +1405,10 @@ sub Gateway { $args{'ticket'} ||= ExtractTicketId( $Message ); + # ExtractTicketId may have been overridden, and edited the Subject + my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') ); + chomp $NewSubject; + $SystemTicket = RT::Ticket->new( RT->SystemUser ); $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ; if ( $SystemTicket->id ) { @@ -1484,10 +1417,6 @@ sub Gateway { $Right = 'CreateTicket'; } - #Set up a queue object - my $SystemQueueObj = RT::Queue->new( RT->SystemUser ); - $SystemQueueObj->Load( $args{'queue'} ); - # We can safely have no queue of we have a known-good ticket unless ( $SystemTicket->id || $SystemQueueObj->id ) { return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef ); @@ -1529,7 +1458,8 @@ sub Gateway { ); return ( 0, - "$ErrorsTo tried to submit a message to " + ($CurrentUser->EmailAddress || $CurrentUser->Name) + . " ($Sender) tried to submit a message to " . $args{'Queue'} . " without permission.", undef @@ -1541,6 +1471,8 @@ sub Gateway { return ( 0, $result, undef ); } + $head->replace('X-RT-Interface' => 'Email'); + # if plugin's updated SystemTicket then update arguments $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id; @@ -1562,7 +1494,7 @@ sub Gateway { my ( $id, $Transaction, $ErrStr ) = $Ticket->Create( Queue => $SystemQueueObj->Id, - Subject => $Subject, + Subject => $NewSubject, Requestor => \@Requestors, Cc => \@Cc, MIMEObj => $Message @@ -1574,7 +1506,7 @@ sub Gateway { Explanation => $ErrStr, MIMEObj => $Message ); - return ( 0, "Ticket creation failed: $ErrStr", $Ticket ); + return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket ); } # strip comments&corresponds from the actions we don't need @@ -1615,11 +1547,11 @@ sub Gateway { #Warn the sender that we couldn't actually submit the comment. MailError( To => $ErrorsTo, - Subject => "Message not recorded: $Subject", + Subject => "Message not recorded ($method): $Subject", Explanation => $msg, MIMEObj => $Message ); - return ( 0, "Message not recorded: $msg", $Ticket ); + return ( 0, "Message From: $From not recorded: $msg", $Ticket ); } } elsif ($unsafe_actions) { my ( $status, $msg ) = _RunUnsafeAction( @@ -1718,6 +1650,8 @@ sub _RunUnsafeAction { @_ ); + my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") ); + if ( $args{'Action'} =~ /^take$/i ) { my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id ); unless ($status) { @@ -1727,7 +1661,7 @@ sub _RunUnsafeAction { Explanation => $msg, MIMEObj => $args{'Message'} ); - return ( 0, "Ticket not taken" ); + return ( 0, "Ticket not taken, by email From: $From" ); } } elsif ( $args{'Action'} =~ /^resolve$/i ) { my $new_status = $args{'Ticket'}->FirstInactiveStatus; @@ -1742,11 +1676,11 @@ sub _RunUnsafeAction { Explanation => $msg, MIMEObj => $args{'Message'} ); - return ( 0, "Ticket not resolved" ); + return ( 0, "Ticket not resolved, by email From: $From" ); } } } else { - return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} ); + return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} ); } return ( 1, "Success" ); } @@ -1872,7 +1806,7 @@ sub _HandleMachineGeneratedMail { # to the scrip. We might want to notify nobody. Or just # the RT Owner. Or maybe all Privileged watchers. my ( $Sender, $junk ) = ParseSenderAddressFromHead($head); - $head->replace( 'RT-Squelch-Replies-To', $Sender ); + $head->replace( 'RT-Squelch-Replies-To', Encode::encode("UTF-8", $Sender ) ); $head->replace( 'RT-DetectedAutoGenerated', 'true' ); } return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop ); @@ -1897,9 +1831,10 @@ sub IsCorrectAction { sub _RecordSendEmailFailure { my $ticket = shift; if ($ticket) { - $ticket->_RecordNote( - NoteType => 'SystemError', - Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.", + $ticket->_NewTransaction( + Type => "SystemError", + Data => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.", #loc + ActivateScrips => 0, ); return 1; } @@ -1909,6 +1844,118 @@ sub _RecordSendEmailFailure { } } +=head2 ConvertHTMLToText HTML + +Takes HTML characters and converts it to plain text characters. +Appropriate for generating a plain text part from an HTML part of an +email. Returns undef if conversion fails. + +=cut + +sub ConvertHTMLToText { + return _HTMLFormatter()->(@_); +} + +sub _HTMLFormatter { + state $formatter; + return $formatter if defined $formatter; + + my $wanted = RT->Config->Get("HTMLFormatter"); + + my @order; + if ($wanted) { + @order = ($wanted, "core"); + } else { + @order = ("w3m", "elinks", "links", "html2text", "lynx", "core"); + } + # Always fall back to core, even if it is not listed + for my $prog (@order) { + if ($prog eq "core") { + RT->Logger->debug("Using internal Perl HTML -> text conversion"); + require HTML::FormatText::WithLinks::AndTables; + $formatter = \&_HTMLFormatText; + } else { + unless (HTML::FormatExternal->require) { + RT->Logger->warn("HTML::FormatExternal is not installed; falling back to internal perl formatter") + if $wanted; + next; + } + + my $path = $prog =~ s{(.*/)}{} ? $1 : undef; + my $package = "HTML::FormatText::" . ucfirst($prog); + unless ($package->require) { + RT->Logger->warn("$prog is not a valid formatter provided by HTML::FormatExternal") + if $wanted; + next; + } + + if ($path) { + local $ENV{PATH} = $path; + local $ENV{HOME} = File::Spec->tmpdir(); + if (not defined $package->program_version) { + RT->Logger->warn("Could not find or run external '$prog' HTML formatter in $path$prog") + if $wanted; + next; + } + } else { + local $ENV{PATH} = '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin' + unless defined $ENV{PATH}; + local $ENV{HOME} = File::Spec->tmpdir(); + if (not defined $package->program_version) { + RT->Logger->warn("Could not find or run external '$prog' HTML formatter in \$PATH ($ENV{PATH}) -- you may need to install it or provide the full path") + if $wanted; + next; + } + } + + RT->Logger->debug("Using $prog for HTML -> text conversion"); + $formatter = sub { + my $html = shift; + my $text = RT::Util::safe_run_child { + local $ENV{PATH} = $path || $ENV{PATH} + || '/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin'; + local $ENV{HOME} = File::Spec->tmpdir(); + $package->format_string( + Encode::encode( "UTF-8", $html ), + input_charset => "UTF-8", + output_charset => "UTF-8", + leftmargin => 0, rightmargin => 78 + ); + }; + $text = Encode::decode( "UTF-8", $text ); + return $text; + }; + } + RT->Config->Set( HTMLFormatter => $prog ); + last; + } + return $formatter; +} + +sub _HTMLFormatText { + my $html = shift; + + my $text; + eval { + $text = HTML::FormatText::WithLinks::AndTables->convert( + $html => { + leftmargin => 0, + rightmargin => 78, + no_rowspacing => 1, + before_link => '', + after_link => ' (%l)', + footnote => '', + skip_linked_urls => 1, + with_emphasis => 0, + } + ); + $text //= ''; + }; + $RT::Logger->error("Failed to downgrade HTML to plain text: $@") if $@; + return $text; +} + + RT::Base->_ImportOverlays(); 1;