#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2019 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
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
=head2 CheckForAutoGenerated HEAD
-Takes a HEAD object of L<MIME::Head> 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<MIME::Head> class and returns true if message is
+autogenerated. Checks C<Precedence>, C<Auto-Submitted>, and
+C<X-FC-Machinegenerated> 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);
}
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;
}
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,
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;
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,
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', Encode::encode( "UTF-8", $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 ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) {
- my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef;
- my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {};
-
- if ($TicketObj) {
- my $QueueName = $TicketObj->QueueObj->Name;
- my $QueueAddressOverride = $Overrides->{$QueueName};
-
- if ($QueueAddressOverride) {
- $OutgoingMailAddress = $QueueAddressOverride;
- } else {
- $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress
- || RT->Config->Get('CorrespondAddress');
- }
- }
- elsif ($Overrides->{'Default'}) {
- $OutgoingMailAddress = $Overrides->{'Default'};
- }
+ } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
+ my $OutgoingMailAddress = _OutgoingMailFrom($TicketObj);
push @args, "-f", $OutgoingMailAddress
if $OutgoingMailAddress;
}
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;
+ } 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");
}
- # duplicate head as we want drop Bcc field
- my $head = $args{'Entity'}->head->dup;
- my @recipients = map $_->address, map
- Email::Address->parse(Encode::decode("UTF-8", $head->get($_))),
- qw(To Cc Bcc);
- $head->delete('Bcc');
-
- my $sender = RT->Config->Get('SMTPFrom')
- || Encode::decode( "UTF-8", $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;
- }
- $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');
}
return -1;
}
- $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) )
+ $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ $_ } ) )
foreach grep defined $args{$_}, qw(To Cc Bcc From);
- $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) )
+ $mail->head->replace( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) )
foreach keys %{ $args{ExtraHeaders} };
SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
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',
- Charset => "UTF-8",
- Data => Encode::encode( "UTF-8", $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<RT::Crypt::GnuPG>, but as well
-handle errors with users' keys.
+Signs and encrypts message using L<RT::Crypt>, 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.
$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 ) {
}
# redo without broken recipients
- %res = RT::Crypt::GnuPG::SignEncrypt( %args );
+ %res = RT::Crypt->SignEncrypt( %args );
return 0 if $res{'exit_code'};
return 1;
my %skip = map { lc $_ => 1 } @_;
foreach my $field ( qw(To Cc Bcc) ) {
- $head->set( $field => Encode::encode( "UTF-8",
+ $head->replace( $field => Encode::encode( "UTF-8",
join ', ', map $_->format, grep !$skip{ lc $_->address },
Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) )
);
}
push @references, @id, @rtid;
if ( $args{'Ticket'} ) {
- my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->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( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
- $mail->head->set( 'References' => Encode::encode( "UTF-8", 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 '<RT-Ticket-'. $ticket->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;
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;
}
}
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
next unless $check_cb->(
Message => $Message,
RawMessageRef => \$args{'message'},
+ Queue => $SystemQueueObj,
+ Actions => \@actions,
);
$skip_plugin{ $class }++;
my ($status, $msg) = $Code->(
Message => $Message,
RawMessageRef => \$args{'message'},
+ Queue => $SystemQueueObj,
+ Actions => \@actions,
);
next if $status > 0;
$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 );
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;
);
}
- $head->replace('X-RT-Interface' => 'Email');
-
my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
Queue => $SystemQueueObj->Id,
Subject => $NewSubject,
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;
}
}
}
+=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;
projects / freeside.git / blobdiff