1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
13 # This work is made available to you under the terms of Version 2 of
14 # the GNU General Public License. A copy of that license should have
15 # been provided with this software, but in any event can be snarfed
18 # This work is distributed in the hope that it will be useful, but
19 # WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
21 # General Public License for more details.
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 # 02110-1301 or visit their web page on the internet at
27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
30 # CONTRIBUTION SUBMISSION POLICY:
32 # (The following paragraph is not intended to limit the rights granted
33 # to you to modify and distribute this software under the terms of
34 # the GNU General Public License and is only of importance to you if
35 # you choose to contribute your changes and enhancements to the
36 # community by submitting them to Best Practical Solutions, LLC.)
38 # By intentionally submitting any modifications, corrections or
39 # derivatives to this work, or any other work intended for use with
40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
41 # you are the copyright holder for those contributions and you grant
42 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
43 # royalty-free, perpetual, license to use, copy, create derivative
44 # works based on those contributions, and sublicense and distribute
45 # those contributions and any derivatives thereof.
47 # END BPS TAGGED BLOCK }}}
49 package RT::Interface::Email;
58 use UNIVERSAL::require;
63 use vars qw ( @EXPORT_OK);
65 # set the version for version checking
68 # your exported package globals go here,
69 # as well as any optionally exported functions
74 &CheckForSuspiciousSender
75 &CheckForAutoGenerated
78 &ParseCcAddressesFromHead
79 &ParseSenderAddressFromHead
80 &ParseErrorsToAddressFromHead
81 &ParseAddressFromHeader
88 RT::Interface::Email - helper functions for parsing email sent to RT
92 use lib "!!RT_LIB_PATH!!";
93 use lib "!!RT_ETC_PATH!!";
95 use RT::Interface::Email qw(Gateway CreateUser);
104 =head2 CheckForLoops HEAD
106 Takes a HEAD object of L<MIME::Head> class and returns true if the
107 message's been sent by this RT instance. Uses "X-RT-Loop-Prevention"
108 field of the head for test.
115 # If this instance of RT sent it our, we don't want to take it in
116 my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
117 chomp ($RTLoop); # remove that newline
118 if ( $RTLoop eq RT->Config->Get('rtname') ) {
122 # TODO: We might not trap the case where RT instance A sends a mail
123 # to RT instance B which sends a mail to ...
127 =head2 CheckForSuspiciousSender HEAD
129 Takes a HEAD object of L<MIME::Head> class and returns true if sender
130 is suspicious. Suspicious means mailer daemon.
132 See also L</ParseSenderAddressFromHead>.
136 sub CheckForSuspiciousSender {
139 #if it's from a postmaster or mailer daemon, it's likely a bounce.
141 #TODO: better algorithms needed here - there is no standards for
142 #bounces, so it's very difficult to separate them from anything
143 #else. At the other hand, the Return-To address is only ment to be
144 #used as an error channel, we might want to put up a separate
145 #Return-To address which is treated differently.
147 #TODO: search through the whole email and find the right Ticket ID.
149 my ( $From, $junk ) = ParseSenderAddressFromHead($head);
151 if ( ( $From =~ /^mailer-daemon\@/i )
152 or ( $From =~ /^postmaster\@/i )
162 =head2 CheckForAutoGenerated HEAD
164 Takes a HEAD object of L<MIME::Head> class and returns true if message
165 is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated'
166 fields of the head in tests.
170 sub CheckForAutoGenerated {
173 my $Precedence = $head->get("Precedence") || "";
174 if ( $Precedence =~ /^(bulk|junk)/i ) {
178 # Per RFC3834, any Auto-Submitted header which is not "no" means
179 # it is auto-generated.
180 my $AutoSubmitted = $head->get("Auto-Submitted") || "";
181 if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) {
185 # First Class mailer uses this as a clue.
186 my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
187 if ( $FCJunk =~ /^true/i ) {
198 my $ReturnPath = $head->get("Return-path") || "";
199 return ( $ReturnPath =~ /<>/ );
203 =head2 MailError PARAM HASH
205 Sends an error message. Takes a param hash:
209 =item From - sender's address, by default is 'CorrespondAddress';
211 =item To - recipient, by default is 'OwnerEmail';
213 =item Bcc - optional Bcc recipients;
215 =item Subject - subject of the message, default is 'There has been an error';
217 =item Explanation - main content of the error, default value is 'Unexplained error';
219 =item MIMEObj - optional MIME entity that's attached to the error mail, as well we
220 add 'In-Reply-To' field to the error that points to this message.
222 =item Attach - optional text that attached to the error as 'message/rfc822' part.
224 =item LogLevel - log level under which we should write explanation message into the
225 log, by default we log it as critical.
233 To => RT->Config->Get('OwnerEmail'),
235 From => RT->Config->Get('CorrespondAddress'),
236 Subject => 'There has been an error',
237 Explanation => 'Unexplained error',
245 level => $args{'LogLevel'},
246 message => $args{'Explanation'}
247 ) if $args{'LogLevel'};
249 # the colons are necessary to make ->build include non-standard headers
251 Type => "multipart/mixed",
252 From => $args{'From'},
255 Subject => $args{'Subject'},
256 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'),
259 # only set precedence if the sysadmin wants us to
260 if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) {
261 $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence');
264 my $entity = MIME::Entity->build(%entity_args);
265 SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
267 $entity->attach( Data => $args{'Explanation'} . "\n" );
269 if ( $args{'MIMEObj'} ) {
270 $args{'MIMEObj'}->sync_headers;
271 $entity->add_part( $args{'MIMEObj'} );
274 if ( $args{'Attach'} ) {
275 $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
279 SendEmail( Entity => $entity, Bounce => 1 );
283 =head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ]
285 Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using
286 RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a
287 true value, the message will be marked as an autogenerated error, if
288 possible. Sets Date field of the head to now if it's not set.
290 If the C<X-RT-Squelch> header is set to any true value, the mail will
291 not be sent. One use is to let extensions easily cancel outgoing mail.
293 Ticket and Transaction arguments are optional. If Transaction is
294 specified and Ticket is not then ticket of the transaction is
295 used, but only if the transaction belongs to a ticket.
297 Returns 1 on success, 0 on error or -1 if message has no recipients
298 and hasn't been sent.
300 =head3 Signing and Encrypting
302 This function as well signs and/or encrypts the message according to
303 headers of a transaction's attachment or properties of a ticket's queue.
304 To get full access to the configuration Ticket and/or Transaction
305 arguments must be provided, but you can force behaviour using Sign
306 and/or Encrypt arguments.
308 The following precedence of arguments are used to figure out if
309 the message should be encrypted and/or signed:
311 * if Sign or Encrypt argument is defined then its value is used
313 * else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt
314 header field then it's value is used
316 * else properties of a queue of the Ticket are used.
325 Transaction => undef,
329 my $TicketObj = $args{'Ticket'};
330 my $TransactionObj = $args{'Transaction'};
332 foreach my $arg( qw(Entity Bounce) ) {
333 next unless defined $args{ lc $arg };
335 $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
336 $args{ $arg } = delete $args{ lc $arg };
339 unless ( $args{'Entity'} ) {
340 $RT::Logger->crit( "Could not send mail without 'Entity' object" );
344 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
347 # If we don't have any recipients to send to, don't send a message;
348 unless ( $args{'Entity'}->head->get('To')
349 || $args{'Entity'}->head->get('Cc')
350 || $args{'Entity'}->head->get('Bcc') )
352 $RT::Logger->info( $msgid . " No recipients found. Not sending." );
356 if ($args{'Entity'}->head->get('X-RT-Squelch')) {
357 $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
361 if ( $TransactionObj && !$TicketObj
362 && $TransactionObj->ObjectType eq 'RT::Ticket' )
364 $TicketObj = $TransactionObj->Object;
367 if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
371 $attachment = $TransactionObj->Attachments->First
374 foreach my $argument ( qw(Sign Encrypt) ) {
375 next if defined $args{ $argument };
377 if ( $attachment && defined $attachment->GetHeader("X-RT-$argument") ) {
378 $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
379 } elsif ( $TicketObj ) {
380 $crypt{$argument} = $TicketObj->QueueObj->$argument();
384 my $res = SignEncrypt( %args, %crypt );
385 return $res unless $res > 0;
388 unless ( $args{'Entity'}->head->get('Date') ) {
390 my $date = RT::Date->new( RT->SystemUser );
392 $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
395 my $mail_command = RT->Config->Get('MailCommand');
397 if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
398 $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
399 $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
402 # if it is a sub routine, we just return it;
403 return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
405 if ( $mail_command eq 'sendmailpipe' ) {
406 my $path = RT->Config->Get('SendmailPath');
407 my $args = RT->Config->Get('SendmailArguments');
409 # SetOutgoingMailFrom and bounces conflict, since they both want -f
410 if ( $args{'Bounce'} ) {
411 $args .= ' '. RT->Config->Get('SendmailBounceArguments');
412 } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
413 my $OutgoingMailAddress;
416 my $QueueName = $TicketObj->QueueObj->Name;
417 my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName};
419 if ($QueueAddressOverride) {
420 $OutgoingMailAddress = $QueueAddressOverride;
422 $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress;
426 $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'};
428 $args .= " -f $OutgoingMailAddress"
429 if $OutgoingMailAddress;
433 if ( $TransactionObj and
434 my $prefix = RT->Config->Get('VERPPrefix') and
435 my $domain = RT->Config->Get('VERPDomain') )
437 my $from = $TransactionObj->CreatorObj->EmailAddress;
440 $args .= " -f $prefix$from\@$domain";
444 # don't ignore CHLD signal to get proper exit code
445 local $SIG{'CHLD'} = 'DEFAULT';
447 open( my $mail, '|-', "$path $args >/dev/null" )
448 or die "couldn't execute program: $!";
450 # if something wrong with $mail->print we will get PIPE signal, handle it
451 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
452 $args{'Entity'}->print($mail);
454 unless ( close $mail ) {
455 die "close pipe failed: $!" if $!; # system error
456 # sendmail exit statuses mostly errors with data not software
457 # TODO: status parsing: core dump, exit on signal or EX_*
458 my $msg = "$msgid: `$path $args` exitted with code ". ($?>>8);
459 $msg = ", interrupted by signal ". ($?&127) if $?&127;
460 $RT::Logger->error( $msg );
465 $RT::Logger->crit( "$msgid: Could not send mail with command `$path $args`: " . $@ );
467 _RecordSendEmailFailure( $TicketObj );
472 elsif ( $mail_command eq 'smtp' ) {
474 my $smtp = do { local $@; eval { Net::SMTP->new(
475 Host => RT->Config->Get('SMTPServer'),
476 Debug => RT->Config->Get('SMTPDebug'),
479 $RT::Logger->crit( "Could not connect to SMTP server.");
481 _RecordSendEmailFailure( $TicketObj );
486 # duplicate head as we want drop Bcc field
487 my $head = $args{'Entity'}->head->dup;
488 my @recipients = map $_->address, map
489 Email::Address->parse($head->get($_)), qw(To Cc Bcc);
490 $head->delete('Bcc');
492 my $sender = RT->Config->Get('SMTPFrom')
493 || $args{'Entity'}->head->get('From');
496 my $status = $smtp->mail( $sender )
497 && $smtp->recipient( @recipients );
501 my $fh = $smtp->tied_fh;
504 $args{'Entity'}->print_body( $fh );
510 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
512 _RecordSendEmailFailure( $TicketObj );
518 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
520 my @mailer_args = ($mail_command);
521 if ( $mail_command eq 'sendmail' ) {
522 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
523 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
526 push @mailer_args, RT->Config->Get('MailParams');
529 unless ( $args{'Entity'}->send( @mailer_args ) ) {
530 $RT::Logger->crit( "$msgid: Could not send mail." );
532 _RecordSendEmailFailure( $TicketObj );
540 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
542 Loads a template. Parses it using arguments if it's not empty.
543 Returns a tuple (L<RT::Template> object, error message).
545 Note that even if a template object is returned MIMEObj method
546 may return undef for empty templates.
550 sub PrepareEmailUsingTemplate {
557 my $template = RT::Template->new( RT->SystemUser );
558 $template->LoadGlobalTemplate( $args{'Template'} );
559 unless ( $template->id ) {
560 return (undef, "Couldn't load template '". $args{'Template'} ."'");
562 return $template if $template->IsEmpty;
564 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
565 return (undef, $msg) unless $status;
570 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
572 Sends email using a template, takes name of template, arguments for it and recipients.
576 sub SendEmailUsingTemplate {
583 From => RT->Config->Get('CorrespondAddress'),
589 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
590 return (0, $msg) unless $template;
592 my $mail = $template->MIMEObj;
594 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
598 $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
599 foreach grep defined $args{$_}, qw(To Cc Bcc From);
601 $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
602 foreach keys %{ $args{ExtraHeaders} };
604 SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
606 return SendEmail( Entity => $mail );
609 =head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
611 Forwards transaction with all attachments as 'message/rfc822'.
615 sub ForwardTransaction {
617 my %args = ( To => '', Cc => '', Bcc => '', @_ );
619 my $entity = $txn->ContentAsMIME;
621 my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
623 my $ticket = $txn->TicketObj;
624 my ( $ret, $msg ) = $ticket->_NewTransaction(
625 Type => 'Forward Transaction',
627 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
630 $RT::Logger->error("Failed to create transaction: $msg");
633 return ( $ret, $msg );
636 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
638 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
644 my %args = ( To => '', Cc => '', Bcc => '', @_ );
646 my $txns = $ticket->Transactions;
650 ) for qw(Create Correspond);
652 my $entity = MIME::Entity->build(
653 Type => 'multipart/mixed',
654 Description => 'forwarded ticket',
656 $entity->add_part( $_ ) foreach
657 map $_->ContentAsMIME,
658 @{ $txns->ItemsArrayRef };
660 my ( $ret, $msg ) = SendForward(
664 Template => 'Forward Ticket',
668 my ( $ret, $msg ) = $ticket->_NewTransaction(
669 Type => 'Forward Ticket',
670 Field => $ticket->id,
671 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
674 $RT::Logger->error("Failed to create transaction: $msg");
678 return ( $ret, $msg );
682 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
684 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
692 Transaction => undef,
693 Template => 'Forward',
694 To => '', Cc => '', Bcc => '',
698 my $txn = $args{'Transaction'};
699 my $ticket = $args{'Ticket'};
700 $ticket ||= $txn->Object if $txn;
702 my $entity = $args{'Entity'};
705 $RT::Logger->error(Carp::longmess("No entity provided"));
706 return (0, $ticket->loc("Couldn't send email"));
709 my ($template, $msg) = PrepareEmailUsingTemplate(
710 Template => $args{'Template'},
719 $mail = $template->MIMEObj;
721 $RT::Logger->warning($msg);
724 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
727 unless ( $args{'Transaction'} ) {
728 $description = 'This is forward of ticket #'. $ticket->id;
730 $description = 'This is forward of transaction #'
731 . $txn->id ." of a ticket #". $txn->ObjectId;
733 $mail = MIME::Entity->build(
734 Type => 'text/plain',
735 Data => $description,
739 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
740 foreach grep defined $args{$_}, qw(To Cc Bcc);
742 $mail->make_multipart unless $mail->is_multipart;
743 $mail->add_part( $entity );
747 $subject = $txn->Subject if $txn;
748 $subject ||= $ticket->Subject if $ticket;
750 unless ( RT->Config->Get('ForwardFromUser') ) {
751 # XXX: what if want to forward txn of other object than ticket?
752 $subject = AddSubjectTag( $subject, $ticket );
755 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
757 From => EncodeToMIME(
758 String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
762 my $status = RT->Config->Get('ForwardFromUser')
763 # never sign if we forward from User
764 ? SendEmail( %args, Entity => $mail, Sign => 0 )
765 : SendEmail( %args, Entity => $mail );
766 return (0, $ticket->loc("Couldn't send email")) unless $status;
767 return (1, $ticket->loc("Sent email successfully"));
770 =head2 GetForwardFrom Ticket => undef, Transaction => undef
772 Resolve the From field to use in forward mail
777 my %args = ( Ticket => undef, Transaction => undef, @_ );
778 my $txn = $args{Transaction};
779 my $ticket = $args{Ticket} || $txn->Object;
781 if ( RT->Config->Get('ForwardFromUser') ) {
782 return ( $txn || $ticket )->CurrentUser->UserObj->EmailAddress;
785 return $ticket->QueueObj->CorrespondAddress
786 || RT->Config->Get('CorrespondAddress');
790 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
792 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
793 handle errors with users' keys.
795 If a recipient has no key or has other problems with it, then the
796 unction sends a error to him using 'Error: public key' template.
797 Also, notifies RT's owner using template 'Error to RT owner: public key'
798 to inform that there are problems with users' keys. Then we filter
799 all bad recipients and retry.
801 Returns 1 on success, 0 on error and -1 if all recipients are bad and
802 had been filtered out.
813 return 1 unless $args{'Sign'} || $args{'Encrypt'};
815 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
818 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
819 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
821 require RT::Crypt::GnuPG;
822 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
823 return 1 unless $res{'exit_code'};
825 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
828 foreach my $line ( @status ) {
829 # if the passphrase fails, either you have a bad passphrase
830 # or gpg-agent has died. That should get caught in Create and
831 # Update, but at least throw an error here
832 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
833 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
834 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
837 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
838 next if $line->{'Status'} eq 'DONE';
839 $RT::Logger->error( $line->{'Message'} );
840 push @bad_recipients, $line;
842 return 0 unless @bad_recipients;
844 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
845 foreach @bad_recipients;
847 foreach my $recipient ( @bad_recipients ) {
848 my $status = SendEmailUsingTemplate(
849 To => $recipient->{'AddressObj'}->address,
850 Template => 'Error: public key',
853 TicketObj => $args{'Ticket'},
854 TransactionObj => $args{'Transaction'},
858 $RT::Logger->error("Couldn't send 'Error: public key'");
862 my $status = SendEmailUsingTemplate(
863 To => RT->Config->Get('OwnerEmail'),
864 Template => 'Error to RT owner: public key',
866 BadRecipients => \@bad_recipients,
867 TicketObj => $args{'Ticket'},
868 TransactionObj => $args{'Transaction'},
872 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
875 DeleteRecipientsFromHead(
876 $args{'Entity'}->head,
877 map $_->{'AddressObj'}->address, @bad_recipients
880 unless ( $args{'Entity'}->head->get('To')
881 || $args{'Entity'}->head->get('Cc')
882 || $args{'Entity'}->head->get('Bcc') )
884 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
888 # redo without broken recipients
889 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
890 return 0 if $res{'exit_code'};
899 Takes a hash with a String and a Charset. Returns the string encoded
900 according to RFC2047, using B (base64 based) encoding.
902 String must be a perl string, octets are returned.
904 If Charset is not provided then $EmailOutputEncoding config option
905 is used, or "latin-1" if that is not set.
915 my $value = $args{'String'};
916 return $value unless $value; # 0 is perfect ascii
917 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
920 # using RFC2047 notation, sec 2.
921 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
923 # An 'encoded-word' may not be more than 75 characters long
925 # MIME encoding increases 4/3*(number of bytes), and always in multiples
926 # of 4. Thus we have to find the best available value of bytes available
929 # First we get the integer max which max*4/3 would fit on space.
930 # Then we find the greater multiple of 3 lower or equal than $max.
932 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
936 $max = int( $max / 3 ) * 3;
943 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
947 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
951 # we need perl string to split thing char by char
952 Encode::_utf8_on($value) unless Encode::is_utf8($value);
954 my ( $tmp, @chunks ) = ( '', () );
955 while ( length $value ) {
956 my $char = substr( $value, 0, 1, '' );
957 my $octets = Encode::encode( $charset, $char );
958 if ( length($tmp) + length($octets) > $max ) {
964 push @chunks, $tmp if length $tmp;
966 # encode an join chuncks
968 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
974 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
976 my $NewUser = RT::User->new( RT->SystemUser );
978 my ( $Val, $Message ) = $NewUser->Create(
979 Name => ( $Username || $Address ),
980 EmailAddress => $Address,
984 Comments => 'Autocreated on ticket submission',
989 # Deal with the race condition of two account creations at once
991 $NewUser->LoadByName($Username);
994 unless ( $NewUser->Id ) {
995 $NewUser->LoadByEmail($Address);
998 unless ( $NewUser->Id ) {
1001 Subject => "User could not be created",
1003 "User creation failed in mailgateway: $Message",
1010 #Load the new user object
1011 my $CurrentUser = RT::CurrentUser->new;
1012 $CurrentUser->LoadByEmail( $Address );
1014 unless ( $CurrentUser->id ) {
1015 $RT::Logger->warning(
1016 "Couldn't load user '$Address'." . "giving up" );
1019 Subject => "User could not be loaded",
1021 "User '$Address' could not be loaded in the mail gateway",
1027 return $CurrentUser;
1032 =head2 ParseCcAddressesFromHead HASH
1034 Takes a hash containing QueueObj, Head and CurrentUser objects.
1035 Returns a list of all email addresses in the To and Cc
1036 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
1037 email address and anything that the configuration sub RT::IsRTAddress matches.
1041 sub ParseCcAddressesFromHead {
1045 CurrentUser => undef,
1049 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1050 my $user = $args{'CurrentUser'}->UserObj;
1053 grep { $_ ne $current_address
1054 && !RT::EmailParser->IsRTAddress( $_ )
1055 && !IgnoreCcAddress( $_ )
1057 map lc $user->CanonicalizeEmailAddress( $_->address ),
1058 map Email::Address->parse( $args{'Head'}->get( $_ ) ),
1062 =head2 IgnoreCcAddress ADDRESS
1064 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1068 sub IgnoreCcAddress {
1069 my $address = shift;
1070 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1071 return 1 if $address =~ /$address_re/i;
1076 =head2 ParseSenderAddressFromHead HEAD
1078 Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
1079 of the From (evaluated in order of Reply-To:, From:, Sender)
1083 sub ParseSenderAddressFromHead {
1086 #Figure out who's sending this message.
1087 foreach my $header ('Reply-To', 'From', 'Sender') {
1088 my $addr_line = $head->get($header) || next;
1089 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1090 # only return if the address is not empty
1091 return ($addr, $name) if $addr;
1094 return (undef, undef);
1097 =head2 ParseErrorsToAddressFromHead HEAD
1099 Takes a MIME::Header object. Return a single value : user@host
1100 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1105 sub ParseErrorsToAddressFromHead {
1108 #Figure out who's sending this message.
1110 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1112 # If there's a header of that name
1113 my $headerobj = $head->get($header);
1115 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1117 # If it's got actual useful content...
1118 return ($addr) if ($addr);
1125 =head2 ParseAddressFromHeader ADDRESS
1127 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1131 sub ParseAddressFromHeader {
1134 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1135 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1136 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1138 my ($AddrObj) = grep ref $_, @Addresses;
1139 unless ( $AddrObj ) {
1140 return ( undef, undef );
1143 return ( $AddrObj->address, $AddrObj->phrase );
1146 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1148 Gets a head object and list of addresses.
1149 Deletes addresses from To, Cc or Bcc fields.
1153 sub DeleteRecipientsFromHead {
1155 my %skip = map { lc $_ => 1 } @_;
1157 foreach my $field ( qw(To Cc Bcc) ) {
1158 $head->set( $field =>
1159 join ', ', map $_->format, grep !$skip{ lc $_->address },
1160 Email::Address->parse( $head->get( $field ) )
1169 ScripAction => undef,
1172 my $org = RT->Config->Get('Organization');
1173 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1174 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1175 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1177 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1178 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1188 return unless $args{'Message'} && $args{'InReplyTo'};
1190 my $get_header = sub {
1192 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1193 @res = $args{'InReplyTo'}->head->get( shift );
1195 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1197 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1200 my @id = $get_header->('Message-ID');
1201 #XXX: custom header should begin with X- otherwise is violation of the standard
1202 my @rtid = $get_header->('RT-Message-ID');
1203 my @references = $get_header->('References');
1204 unless ( @references ) {
1205 @references = $get_header->('In-Reply-To');
1207 push @references, @id, @rtid;
1208 if ( $args{'Ticket'} ) {
1209 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1210 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1212 @references = splice @references, 4, -6
1213 if @references > 10;
1215 my $mail = $args{'Message'};
1216 $mail->head->set( 'In-Reply-To' => join ' ', @rtid? (@rtid) : (@id) ) if @id || @rtid;
1217 $mail->head->set( 'References' => join ' ', @references );
1221 my $Subject = shift;
1223 my $rtname = RT->Config->Get('rtname');
1224 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1227 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1230 foreach my $tag ( RT->System->SubjectTag ) {
1231 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1236 return undef unless $id;
1238 $RT::Logger->debug("Found a ticket ID. It's $id");
1243 my $subject = shift;
1245 unless ( ref $ticket ) {
1246 my $tmp = RT::Ticket->new( RT->SystemUser );
1247 $tmp->Load( $ticket );
1250 my $id = $ticket->id;
1251 my $queue_tag = $ticket->QueueObj->SubjectTag;
1253 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1254 unless ( $tag_re ) {
1255 my $tag = $queue_tag || RT->Config->Get('rtname');
1256 $tag_re = qr/\Q$tag\E/;
1257 } elsif ( $queue_tag ) {
1258 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1260 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1262 $subject =~ s/(\r\n|\n|\s)/ /g;
1264 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1268 =head2 Gateway ARGSREF
1278 This performs all the "guts" of the mail rt-mailgate program, and is
1279 designed to be called from the web interface with a message, user
1282 Can also take an optional 'ticket' parameter; this ticket id overrides
1283 any ticket id found in the subject.
1289 (status code, message, optional ticket object)
1291 status code is a numeric value.
1293 for temporary failures, the status code should be -75
1295 for permanent failures which are handled by RT, the status code
1298 for succces, the status code should be 1
1305 my @mail_plugins = @_;
1308 foreach my $plugin (@mail_plugins) {
1309 if ( ref($plugin) eq "CODE" ) {
1311 } elsif ( !ref $plugin ) {
1312 my $Class = $plugin;
1313 $Class = "RT::Interface::Email::" . $Class
1314 unless $Class =~ /^RT::/;
1316 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1319 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1320 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1325 $RT::Logger->crit( "$plugin - is not class name or code reference");
1332 my $argsref = shift;
1334 action => 'correspond',
1344 # Validate the action
1345 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1349 "Invalid 'action' parameter "
1357 my $parser = RT::EmailParser->new();
1358 $parser->SmartParseMIMEEntityFromScalar(
1359 Message => $args{'message'},
1364 my $Message = $parser->Entity();
1367 Subject => "RT Bounce: Unparseable message",
1368 Explanation => "RT couldn't process the message below",
1369 Attach => $args{'message'}
1373 "Failed to parse this message. Something is likely badly wrong with the message"
1377 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1378 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1379 @mail_plugins = _LoadPlugins( @mail_plugins );
1382 foreach my $class( grep !ref, @mail_plugins ) {
1383 # check if we should apply filter before decoding
1386 *{ $class . "::ApplyBeforeDecode" }{CODE};
1388 next unless defined $check_cb;
1389 next unless $check_cb->(
1390 Message => $Message,
1391 RawMessageRef => \$args{'message'},
1394 $skip_plugin{ $class }++;
1398 *{ $class . "::GetCurrentUser" }{CODE};
1400 my ($status, $msg) = $Code->(
1401 Message => $Message,
1402 RawMessageRef => \$args{'message'},
1404 next if $status > 0;
1406 if ( $status == -2 ) {
1407 return (1, $msg, undef);
1408 } elsif ( $status == -1 ) {
1409 return (0, $msg, undef);
1412 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1413 $parser->_DecodeBodies;
1414 $parser->_PostProcessNewEntity;
1416 my $head = $Message->head;
1417 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1419 my $MessageId = $head->get('Message-ID')
1420 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1422 #Pull apart the subject line
1423 my $Subject = $head->get('Subject') || '';
1426 # Lets check for mail loops of various sorts.
1427 my ($should_store_machine_generated_message, $IsALoop, $result);
1428 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1429 _HandleMachineGeneratedMail(
1430 Message => $Message,
1431 ErrorsTo => $ErrorsTo,
1432 Subject => $Subject,
1433 MessageId => $MessageId
1436 # Do not pass loop messages to MailPlugins, to make sure the loop
1437 # is broken, unless $RT::StoreLoops is set.
1438 if ($IsALoop && !$should_store_machine_generated_message) {
1439 return ( 0, $result, undef );
1443 $args{'ticket'} ||= ParseTicketId( $Subject );
1445 $SystemTicket = RT::Ticket->new( RT->SystemUser );
1446 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1447 if ( $SystemTicket->id ) {
1448 $Right = 'ReplyToTicket';
1450 $Right = 'CreateTicket';
1453 #Set up a queue object
1454 my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
1455 $SystemQueueObj->Load( $args{'queue'} );
1457 # We can safely have no queue of we have a known-good ticket
1458 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1459 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1462 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1463 MailPlugins => \@mail_plugins,
1464 Actions => \@actions,
1465 Message => $Message,
1466 RawMessageRef => \$args{message},
1467 SystemTicket => $SystemTicket,
1468 SystemQueue => $SystemQueueObj,
1471 # If authentication fails and no new user was created, get out.
1472 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1474 # If the plugins refused to create one, they lose.
1475 unless ( $AuthStat == -1 ) {
1476 _NoAuthorizedUserFound(
1478 Message => $Message,
1479 Requestor => $ErrorsTo,
1480 Queue => $args{'queue'}
1484 return ( 0, "Could not load a valid user", undef );
1487 # If we got a user, but they don't have the right to say things
1488 if ( $AuthStat == 0 ) {
1491 Subject => "Permission Denied",
1493 "You do not have permission to communicate with RT",
1498 "$ErrorsTo tried to submit a message to "
1500 . " without permission.",
1506 unless ($should_store_machine_generated_message) {
1507 return ( 0, $result, undef );
1510 # if plugin's updated SystemTicket then update arguments
1511 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1513 my $Ticket = RT::Ticket->new($CurrentUser);
1515 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1519 my @Requestors = ( $CurrentUser->id );
1521 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1522 @Cc = ParseCcAddressesFromHead(
1524 CurrentUser => $CurrentUser,
1525 QueueObj => $SystemQueueObj
1529 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1530 Queue => $SystemQueueObj->Id,
1531 Subject => $Subject,
1532 Requestor => \@Requestors,
1539 Subject => "Ticket creation failed: $Subject",
1540 Explanation => $ErrStr,
1543 return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
1546 # strip comments&corresponds from the actions we don't need
1547 # to record them if we've created the ticket just now
1548 @actions = grep !/^(comment|correspond)$/, @actions;
1549 $args{'ticket'} = $id;
1551 } elsif ( $args{'ticket'} ) {
1553 $Ticket->Load( $args{'ticket'} );
1554 unless ( $Ticket->Id ) {
1555 my $error = "Could not find a ticket with id " . $args{'ticket'};
1558 Subject => "Message not recorded: $Subject",
1559 Explanation => $error,
1563 return ( 0, $error );
1565 $args{'ticket'} = $Ticket->id;
1567 return ( 1, "Success", $Ticket );
1572 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1573 foreach my $action (@actions) {
1575 # If the action is comment, add a comment.
1576 if ( $action =~ /^(?:comment|correspond)$/i ) {
1577 my $method = ucfirst lc $action;
1578 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1581 #Warn the sender that we couldn't actually submit the comment.
1584 Subject => "Message not recorded: $Subject",
1585 Explanation => $msg,
1588 return ( 0, "Message not recorded: $msg", $Ticket );
1590 } elsif ($unsafe_actions) {
1591 my ( $status, $msg ) = _RunUnsafeAction(
1593 ErrorsTo => $ErrorsTo,
1594 Message => $Message,
1596 CurrentUser => $CurrentUser,
1598 return ($status, $msg, $Ticket) unless $status == 1;
1601 return ( 1, "Success", $Ticket );
1604 =head2 GetAuthenticationLevel
1606 # Authentication Level
1607 # -1 - Get out. this user has been explicitly declined
1608 # 0 - User may not do anything (Not used at the moment)
1610 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1614 sub GetAuthenticationLevel {
1619 RawMessageRef => undef,
1620 SystemTicket => undef,
1621 SystemQueue => undef,
1625 my ( $CurrentUser, $AuthStat, $error );
1627 # Initalize AuthStat so comparisons work correctly
1628 $AuthStat = -9999999;
1630 # if plugin returns AuthStat -2 we skip action
1631 # NOTE: this is experimental API and it would be changed
1632 my %skip_action = ();
1634 # Since this needs loading, no matter what
1635 foreach (@{ $args{MailPlugins} }) {
1636 my ($Code, $NewAuthStat);
1637 if ( ref($_) eq "CODE" ) {
1641 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1644 foreach my $action (@{ $args{Actions} }) {
1645 ( $CurrentUser, $NewAuthStat ) = $Code->(
1646 Message => $args{Message},
1647 RawMessageRef => $args{RawMessageRef},
1648 CurrentUser => $CurrentUser,
1649 AuthLevel => $AuthStat,
1651 Ticket => $args{SystemTicket},
1652 Queue => $args{SystemQueue},
1655 # You get the highest level of authentication you were assigned, unless you get the magic -1
1656 # If a module returns a "-1" then we discard the ticket, so.
1657 $AuthStat = $NewAuthStat
1658 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1660 last if $AuthStat == -1;
1661 $skip_action{$action}++ if $AuthStat == -2;
1664 # strip actions we should skip
1665 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1667 last unless @{$args{Actions}};
1669 last if $AuthStat == -1;
1672 return $AuthStat if !wantarray;
1674 return ($AuthStat, $CurrentUser, $error);
1677 sub _RunUnsafeAction {
1683 CurrentUser => undef,
1687 if ( $args{'Action'} =~ /^take$/i ) {
1688 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1691 To => $args{'ErrorsTo'},
1692 Subject => "Ticket not taken",
1693 Explanation => $msg,
1694 MIMEObj => $args{'Message'}
1696 return ( 0, "Ticket not taken" );
1698 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1699 my ( $status, $msg ) = $args{'Ticket'}->SetStatus('resolved');
1702 #Warn the sender that we couldn't actually submit the comment.
1704 To => $args{'ErrorsTo'},
1705 Subject => "Ticket not resolved",
1706 Explanation => $msg,
1707 MIMEObj => $args{'Message'}
1709 return ( 0, "Ticket not resolved" );
1712 return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
1714 return ( 1, "Success" );
1717 =head2 _NoAuthorizedUserFound
1719 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1723 sub _NoAuthorizedUserFound {
1732 # Notify the RT Admin of the failure.
1734 To => RT->Config->Get('OwnerEmail'),
1735 Subject => "Could not load a valid user",
1736 Explanation => <<EOT,
1737 RT could not load a valid user, and RT's configuration does not allow
1738 for the creation of a new user for this email (@{[$args{Requestor}]}).
1740 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1741 queue @{[$args{'Queue'}]}.
1744 MIMEObj => $args{'Message'},
1748 # Also notify the requestor that his request has been dropped.
1749 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1751 To => $args{'Requestor'},
1752 Subject => "Could not load a valid user",
1753 Explanation => <<EOT,
1754 RT could not load a valid user, and RT's configuration does not allow
1755 for the creation of a new user for your email.
1758 MIMEObj => $args{'Message'},
1764 =head2 _HandleMachineGeneratedMail
1771 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1772 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1773 "This message appears to be a loop (boolean)" );
1777 sub _HandleMachineGeneratedMail {
1778 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1779 my $head = $args{'Message'}->head;
1780 my $ErrorsTo = $args{'ErrorsTo'};
1782 my $IsBounce = CheckForBounce($head);
1784 my $IsAutoGenerated = CheckForAutoGenerated($head);
1786 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1788 my $IsALoop = CheckForLoops($head);
1790 my $SquelchReplies = 0;
1792 my $owner_mail = RT->Config->Get('OwnerEmail');
1794 #If the message is autogenerated, we need to know, so we can not
1795 # send mail to the sender
1796 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1797 $SquelchReplies = 1;
1798 $ErrorsTo = $owner_mail;
1801 # Warn someone if it's a loop, before we drop it on the ground
1803 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1805 #Should we mail it to RTOwner?
1806 if ( RT->Config->Get('LoopsToRTOwner') ) {
1809 Subject => "RT Bounce: ".$args{'Subject'},
1810 Explanation => "RT thinks this message may be a bounce",
1811 MIMEObj => $args{Message}
1815 #Do we actually want to store it?
1816 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1817 unless RT->Config->Get('StoreLoops');
1820 # Squelch replies if necessary
1821 # Don't let the user stuff the RT-Squelch-Replies-To header.
1822 if ( $head->get('RT-Squelch-Replies-To') ) {
1824 'RT-Relocated-Squelch-Replies-To',
1825 $head->get('RT-Squelch-Replies-To')
1827 $head->delete('RT-Squelch-Replies-To');
1830 if ($SquelchReplies) {
1832 # Squelch replies to the sender, and also leave a clue to
1833 # allow us to squelch ALL outbound messages. This way we
1834 # can punt the logic of "what to do when we get a bounce"
1835 # to the scrip. We might want to notify nobody. Or just
1836 # the RT Owner. Or maybe all Privileged watchers.
1837 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1838 $head->replace( 'RT-Squelch-Replies-To', $Sender );
1839 $head->replace( 'RT-DetectedAutoGenerated', 'true' );
1841 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1844 =head2 IsCorrectAction
1846 Returns a list of valid actions we've found for this message
1850 sub IsCorrectAction {
1852 my @actions = grep $_, split /-/, $action;
1853 return ( 0, '(no value)' ) unless @actions;
1854 foreach ( @actions ) {
1855 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1857 return ( 1, @actions );
1860 sub _RecordSendEmailFailure {
1863 $ticket->_RecordNote(
1864 NoteType => 'SystemError',
1865 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1870 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1875 RT::Base->_ImportOverlays();