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;
60 use Text::ParseWords qw/shellwords/;
64 use vars qw ( @EXPORT_OK);
66 # set the version for version checking
69 # your exported package globals go here,
70 # as well as any optionally exported functions
75 &CheckForSuspiciousSender
76 &CheckForAutoGenerated
79 &ParseCcAddressesFromHead
80 &ParseSenderAddressFromHead
81 &ParseErrorsToAddressFromHead
82 &ParseAddressFromHeader
89 RT::Interface::Email - helper functions for parsing email sent to RT
93 use lib "!!RT_LIB_PATH!!";
94 use lib "!!RT_ETC_PATH!!";
96 use RT::Interface::Email qw(Gateway CreateUser);
105 =head2 CheckForLoops HEAD
107 Takes a HEAD object of L<MIME::Head> class and returns true if the
108 message's been sent by this RT instance. Uses "X-RT-Loop-Prevention"
109 field of the head for test.
116 # If this instance of RT sent it our, we don't want to take it in
117 my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
118 chomp ($RTLoop); # remove that newline
119 if ( $RTLoop eq RT->Config->Get('rtname') ) {
123 # TODO: We might not trap the case where RT instance A sends a mail
124 # to RT instance B which sends a mail to ...
128 =head2 CheckForSuspiciousSender HEAD
130 Takes a HEAD object of L<MIME::Head> class and returns true if sender
131 is suspicious. Suspicious means mailer daemon.
133 See also L</ParseSenderAddressFromHead>.
137 sub CheckForSuspiciousSender {
140 #if it's from a postmaster or mailer daemon, it's likely a bounce.
142 #TODO: better algorithms needed here - there is no standards for
143 #bounces, so it's very difficult to separate them from anything
144 #else. At the other hand, the Return-To address is only ment to be
145 #used as an error channel, we might want to put up a separate
146 #Return-To address which is treated differently.
148 #TODO: search through the whole email and find the right Ticket ID.
150 my ( $From, $junk ) = ParseSenderAddressFromHead($head);
152 if ( ( $From =~ /^mailer-daemon\@/i )
153 or ( $From =~ /^postmaster\@/i )
163 =head2 CheckForAutoGenerated HEAD
165 Takes a HEAD object of L<MIME::Head> class and returns true if message
166 is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated'
167 fields of the head in tests.
171 sub CheckForAutoGenerated {
174 my $Precedence = $head->get("Precedence") || "";
175 if ( $Precedence =~ /^(bulk|junk)/i ) {
179 # Per RFC3834, any Auto-Submitted header which is not "no" means
180 # it is auto-generated.
181 my $AutoSubmitted = $head->get("Auto-Submitted") || "";
182 if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) {
186 # First Class mailer uses this as a clue.
187 my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
188 if ( $FCJunk =~ /^true/i ) {
199 my $ReturnPath = $head->get("Return-path") || "";
200 return ( $ReturnPath =~ /<>/ );
204 =head2 MailError PARAM HASH
206 Sends an error message. Takes a param hash:
210 =item From - sender's address, by default is 'CorrespondAddress';
212 =item To - recipient, by default is 'OwnerEmail';
214 =item Bcc - optional Bcc recipients;
216 =item Subject - subject of the message, default is 'There has been an error';
218 =item Explanation - main content of the error, default value is 'Unexplained error';
220 =item MIMEObj - optional MIME entity that's attached to the error mail, as well we
221 add 'In-Reply-To' field to the error that points to this message.
223 =item Attach - optional text that attached to the error as 'message/rfc822' part.
225 =item LogLevel - log level under which we should write explanation message into the
226 log, by default we log it as critical.
234 To => RT->Config->Get('OwnerEmail'),
236 From => RT->Config->Get('CorrespondAddress'),
237 Subject => 'There has been an error',
238 Explanation => 'Unexplained error',
246 level => $args{'LogLevel'},
247 message => $args{'Explanation'}
248 ) if $args{'LogLevel'};
250 # the colons are necessary to make ->build include non-standard headers
252 Type => "multipart/mixed",
253 From => $args{'From'},
256 Subject => $args{'Subject'},
257 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'),
260 # only set precedence if the sysadmin wants us to
261 if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) {
262 $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence');
265 my $entity = MIME::Entity->build(%entity_args);
266 SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
268 $entity->attach( Data => $args{'Explanation'} . "\n" );
270 if ( $args{'MIMEObj'} ) {
271 $args{'MIMEObj'}->sync_headers;
272 $entity->add_part( $args{'MIMEObj'} );
275 if ( $args{'Attach'} ) {
276 $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
280 SendEmail( Entity => $entity, Bounce => 1 );
284 =head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ]
286 Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using
287 RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a
288 true value, the message will be marked as an autogenerated error, if
289 possible. Sets Date field of the head to now if it's not set.
291 If the C<X-RT-Squelch> header is set to any true value, the mail will
292 not be sent. One use is to let extensions easily cancel outgoing mail.
294 Ticket and Transaction arguments are optional. If Transaction is
295 specified and Ticket is not then ticket of the transaction is
296 used, but only if the transaction belongs to a ticket.
298 Returns 1 on success, 0 on error or -1 if message has no recipients
299 and hasn't been sent.
301 =head3 Signing and Encrypting
303 This function as well signs and/or encrypts the message according to
304 headers of a transaction's attachment or properties of a ticket's queue.
305 To get full access to the configuration Ticket and/or Transaction
306 arguments must be provided, but you can force behaviour using Sign
307 and/or Encrypt arguments.
309 The following precedence of arguments are used to figure out if
310 the message should be encrypted and/or signed:
312 * if Sign or Encrypt argument is defined then its value is used
314 * else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt
315 header field then it's value is used
317 * else properties of a queue of the Ticket are used.
326 Transaction => undef,
330 my $TicketObj = $args{'Ticket'};
331 my $TransactionObj = $args{'Transaction'};
333 foreach my $arg( qw(Entity Bounce) ) {
334 next unless defined $args{ lc $arg };
336 $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
337 $args{ $arg } = delete $args{ lc $arg };
340 unless ( $args{'Entity'} ) {
341 $RT::Logger->crit( "Could not send mail without 'Entity' object" );
345 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
348 # If we don't have any recipients to send to, don't send a message;
349 unless ( $args{'Entity'}->head->get('To')
350 || $args{'Entity'}->head->get('Cc')
351 || $args{'Entity'}->head->get('Bcc') )
353 $RT::Logger->info( $msgid . " No recipients found. Not sending." );
357 if ($args{'Entity'}->head->get('X-RT-Squelch')) {
358 $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
362 if ( $TransactionObj && !$TicketObj
363 && $TransactionObj->ObjectType eq 'RT::Ticket' )
365 $TicketObj = $TransactionObj->Object;
368 if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
372 $attachment = $TransactionObj->Attachments->First
375 foreach my $argument ( qw(Sign Encrypt) ) {
376 next if defined $args{ $argument };
378 if ( $attachment && defined $attachment->GetHeader("X-RT-$argument") ) {
379 $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
380 } elsif ( $TicketObj ) {
381 $crypt{$argument} = $TicketObj->QueueObj->$argument();
385 my $res = SignEncrypt( %args, %crypt );
386 return $res unless $res > 0;
389 unless ( $args{'Entity'}->head->get('Date') ) {
391 my $date = RT::Date->new( RT->SystemUser );
393 $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
396 my $mail_command = RT->Config->Get('MailCommand');
398 if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
399 $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
400 $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
403 # if it is a sub routine, we just return it;
404 return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
406 if ( $mail_command eq 'sendmailpipe' ) {
407 my $path = RT->Config->Get('SendmailPath');
408 my @args = shellwords(RT->Config->Get('SendmailArguments'));
410 # SetOutgoingMailFrom and bounces conflict, since they both want -f
411 if ( $args{'Bounce'} ) {
412 push @args, shellwords(RT->Config->Get('SendmailBounceArguments'));
413 } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
414 my $OutgoingMailAddress;
417 my $QueueName = $TicketObj->QueueObj->Name;
418 my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName};
420 if ($QueueAddressOverride) {
421 $OutgoingMailAddress = $QueueAddressOverride;
423 $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress;
427 $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'};
429 push @args, "-f", $OutgoingMailAddress
430 if $OutgoingMailAddress;
434 if ( $TransactionObj and
435 my $prefix = RT->Config->Get('VERPPrefix') and
436 my $domain = RT->Config->Get('VERPDomain') )
438 my $from = $TransactionObj->CreatorObj->EmailAddress;
441 push @args, "-f", "$prefix$from\@$domain";
445 # don't ignore CHLD signal to get proper exit code
446 local $SIG{'CHLD'} = 'DEFAULT';
448 # if something wrong with $mail->print we will get PIPE signal, handle it
449 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
453 my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
454 or die "couldn't execute program: $!";
456 $args{'Entity'}->print($mail);
457 close $mail or die "close pipe failed: $!";
461 # sendmail exit statuses mostly errors with data not software
462 # TODO: status parsing: core dump, exit on signal or EX_*
463 my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
464 $msg = ", interrupted by signal ". ($?&127) if $?&127;
465 $RT::Logger->error( $msg );
470 $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
472 _RecordSendEmailFailure( $TicketObj );
477 elsif ( $mail_command eq 'smtp' ) {
479 my $smtp = do { local $@; eval { Net::SMTP->new(
480 Host => RT->Config->Get('SMTPServer'),
481 Debug => RT->Config->Get('SMTPDebug'),
484 $RT::Logger->crit( "Could not connect to SMTP server.");
486 _RecordSendEmailFailure( $TicketObj );
491 # duplicate head as we want drop Bcc field
492 my $head = $args{'Entity'}->head->dup;
493 my @recipients = map $_->address, map
494 Email::Address->parse($head->get($_)), qw(To Cc Bcc);
495 $head->delete('Bcc');
497 my $sender = RT->Config->Get('SMTPFrom')
498 || $args{'Entity'}->head->get('From');
501 my $status = $smtp->mail( $sender )
502 && $smtp->recipient( @recipients );
506 my $fh = $smtp->tied_fh;
509 $args{'Entity'}->print_body( $fh );
515 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
517 _RecordSendEmailFailure( $TicketObj );
523 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
525 my @mailer_args = ($mail_command);
526 if ( $mail_command eq 'sendmail' ) {
527 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
528 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
531 push @mailer_args, RT->Config->Get('MailParams');
534 unless ( $args{'Entity'}->send( @mailer_args ) ) {
535 $RT::Logger->crit( "$msgid: Could not send mail." );
537 _RecordSendEmailFailure( $TicketObj );
545 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
547 Loads a template. Parses it using arguments if it's not empty.
548 Returns a tuple (L<RT::Template> object, error message).
550 Note that even if a template object is returned MIMEObj method
551 may return undef for empty templates.
555 sub PrepareEmailUsingTemplate {
562 my $template = RT::Template->new( RT->SystemUser );
563 $template->LoadGlobalTemplate( $args{'Template'} );
564 unless ( $template->id ) {
565 return (undef, "Couldn't load template '". $args{'Template'} ."'");
567 return $template if $template->IsEmpty;
569 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
570 return (undef, $msg) unless $status;
575 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
577 Sends email using a template, takes name of template, arguments for it and recipients.
581 sub SendEmailUsingTemplate {
588 From => RT->Config->Get('CorrespondAddress'),
594 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
595 return (0, $msg) unless $template;
597 my $mail = $template->MIMEObj;
599 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
603 $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
604 foreach grep defined $args{$_}, qw(To Cc Bcc From);
606 $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
607 foreach keys %{ $args{ExtraHeaders} };
609 SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
611 return SendEmail( Entity => $mail );
614 =head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
616 Forwards transaction with all attachments as 'message/rfc822'.
620 sub ForwardTransaction {
622 my %args = ( To => '', Cc => '', Bcc => '', @_ );
624 my $entity = $txn->ContentAsMIME;
626 my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
628 my $ticket = $txn->TicketObj;
629 my ( $ret, $msg ) = $ticket->_NewTransaction(
630 Type => 'Forward Transaction',
632 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
635 $RT::Logger->error("Failed to create transaction: $msg");
638 return ( $ret, $msg );
641 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
643 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
649 my %args = ( To => '', Cc => '', Bcc => '', @_ );
651 my $txns = $ticket->Transactions;
655 ) for qw(Create Correspond);
657 my $entity = MIME::Entity->build(
658 Type => 'multipart/mixed',
659 Description => 'forwarded ticket',
661 $entity->add_part( $_ ) foreach
662 map $_->ContentAsMIME,
663 @{ $txns->ItemsArrayRef };
665 my ( $ret, $msg ) = SendForward(
669 Template => 'Forward Ticket',
673 my ( $ret, $msg ) = $ticket->_NewTransaction(
674 Type => 'Forward Ticket',
675 Field => $ticket->id,
676 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
679 $RT::Logger->error("Failed to create transaction: $msg");
683 return ( $ret, $msg );
687 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
689 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
697 Transaction => undef,
698 Template => 'Forward',
699 To => '', Cc => '', Bcc => '',
703 my $txn = $args{'Transaction'};
704 my $ticket = $args{'Ticket'};
705 $ticket ||= $txn->Object if $txn;
707 my $entity = $args{'Entity'};
710 $RT::Logger->error(Carp::longmess("No entity provided"));
711 return (0, $ticket->loc("Couldn't send email"));
714 my ($template, $msg) = PrepareEmailUsingTemplate(
715 Template => $args{'Template'},
724 $mail = $template->MIMEObj;
726 $RT::Logger->warning($msg);
729 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
732 unless ( $args{'Transaction'} ) {
733 $description = 'This is forward of ticket #'. $ticket->id;
735 $description = 'This is forward of transaction #'
736 . $txn->id ." of a ticket #". $txn->ObjectId;
738 $mail = MIME::Entity->build(
739 Type => 'text/plain',
740 Data => $description,
744 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
745 foreach grep defined $args{$_}, qw(To Cc Bcc);
747 $mail->make_multipart unless $mail->is_multipart;
748 $mail->add_part( $entity );
751 unless (defined $mail->head->get('Subject')) {
753 $subject = $txn->Subject if $txn;
754 $subject ||= $ticket->Subject if $ticket;
756 unless ( RT->Config->Get('ForwardFromUser') ) {
757 # XXX: what if want to forward txn of other object than ticket?
758 $subject = AddSubjectTag( $subject, $ticket );
761 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
765 From => EncodeToMIME(
766 String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
770 my $status = RT->Config->Get('ForwardFromUser')
771 # never sign if we forward from User
772 ? SendEmail( %args, Entity => $mail, Sign => 0 )
773 : SendEmail( %args, Entity => $mail );
774 return (0, $ticket->loc("Couldn't send email")) unless $status;
775 return (1, $ticket->loc("Sent email successfully"));
778 =head2 GetForwardFrom Ticket => undef, Transaction => undef
780 Resolve the From field to use in forward mail
785 my %args = ( Ticket => undef, Transaction => undef, @_ );
786 my $txn = $args{Transaction};
787 my $ticket = $args{Ticket} || $txn->Object;
789 if ( RT->Config->Get('ForwardFromUser') ) {
790 return ( $txn || $ticket )->CurrentUser->EmailAddress;
793 return $ticket->QueueObj->CorrespondAddress
794 || RT->Config->Get('CorrespondAddress');
798 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
800 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
801 handle errors with users' keys.
803 If a recipient has no key or has other problems with it, then the
804 unction sends a error to him using 'Error: public key' template.
805 Also, notifies RT's owner using template 'Error to RT owner: public key'
806 to inform that there are problems with users' keys. Then we filter
807 all bad recipients and retry.
809 Returns 1 on success, 0 on error and -1 if all recipients are bad and
810 had been filtered out.
821 return 1 unless $args{'Sign'} || $args{'Encrypt'};
823 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
826 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
827 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
829 require RT::Crypt::GnuPG;
830 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
831 return 1 unless $res{'exit_code'};
833 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
836 foreach my $line ( @status ) {
837 # if the passphrase fails, either you have a bad passphrase
838 # or gpg-agent has died. That should get caught in Create and
839 # Update, but at least throw an error here
840 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
841 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
842 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
845 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
846 next if $line->{'Status'} eq 'DONE';
847 $RT::Logger->error( $line->{'Message'} );
848 push @bad_recipients, $line;
850 return 0 unless @bad_recipients;
852 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
853 foreach @bad_recipients;
855 foreach my $recipient ( @bad_recipients ) {
856 my $status = SendEmailUsingTemplate(
857 To => $recipient->{'AddressObj'}->address,
858 Template => 'Error: public key',
861 TicketObj => $args{'Ticket'},
862 TransactionObj => $args{'Transaction'},
866 $RT::Logger->error("Couldn't send 'Error: public key'");
870 my $status = SendEmailUsingTemplate(
871 To => RT->Config->Get('OwnerEmail'),
872 Template => 'Error to RT owner: public key',
874 BadRecipients => \@bad_recipients,
875 TicketObj => $args{'Ticket'},
876 TransactionObj => $args{'Transaction'},
880 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
883 DeleteRecipientsFromHead(
884 $args{'Entity'}->head,
885 map $_->{'AddressObj'}->address, @bad_recipients
888 unless ( $args{'Entity'}->head->get('To')
889 || $args{'Entity'}->head->get('Cc')
890 || $args{'Entity'}->head->get('Bcc') )
892 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
896 # redo without broken recipients
897 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
898 return 0 if $res{'exit_code'};
907 Takes a hash with a String and a Charset. Returns the string encoded
908 according to RFC2047, using B (base64 based) encoding.
910 String must be a perl string, octets are returned.
912 If Charset is not provided then $EmailOutputEncoding config option
913 is used, or "latin-1" if that is not set.
923 my $value = $args{'String'};
924 return $value unless $value; # 0 is perfect ascii
925 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
928 # using RFC2047 notation, sec 2.
929 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
931 # An 'encoded-word' may not be more than 75 characters long
933 # MIME encoding increases 4/3*(number of bytes), and always in multiples
934 # of 4. Thus we have to find the best available value of bytes available
937 # First we get the integer max which max*4/3 would fit on space.
938 # Then we find the greater multiple of 3 lower or equal than $max.
940 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
944 $max = int( $max / 3 ) * 3;
951 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
955 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
959 # we need perl string to split thing char by char
960 Encode::_utf8_on($value) unless Encode::is_utf8($value);
962 my ( $tmp, @chunks ) = ( '', () );
963 while ( length $value ) {
964 my $char = substr( $value, 0, 1, '' );
965 my $octets = Encode::encode( $charset, $char );
966 if ( length($tmp) + length($octets) > $max ) {
972 push @chunks, $tmp if length $tmp;
974 # encode an join chuncks
976 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
982 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
984 my $NewUser = RT::User->new( RT->SystemUser );
986 my ( $Val, $Message ) = $NewUser->Create(
987 Name => ( $Username || $Address ),
988 EmailAddress => $Address,
992 Comments => 'Autocreated on ticket submission',
997 # Deal with the race condition of two account creations at once
999 $NewUser->LoadByName($Username);
1002 unless ( $NewUser->Id ) {
1003 $NewUser->LoadByEmail($Address);
1006 unless ( $NewUser->Id ) {
1009 Subject => "User could not be created",
1011 "User creation failed in mailgateway: $Message",
1018 #Load the new user object
1019 my $CurrentUser = RT::CurrentUser->new;
1020 $CurrentUser->LoadByEmail( $Address );
1022 unless ( $CurrentUser->id ) {
1023 $RT::Logger->warning(
1024 "Couldn't load user '$Address'." . "giving up" );
1027 Subject => "User could not be loaded",
1029 "User '$Address' could not be loaded in the mail gateway",
1035 return $CurrentUser;
1040 =head2 ParseCcAddressesFromHead HASH
1042 Takes a hash containing QueueObj, Head and CurrentUser objects.
1043 Returns a list of all email addresses in the To and Cc
1044 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
1045 email address and anything that the configuration sub RT::IsRTAddress matches.
1049 sub ParseCcAddressesFromHead {
1053 CurrentUser => undef,
1057 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1058 my $user = $args{'CurrentUser'}->UserObj;
1061 grep { $_ ne $current_address
1062 && !RT::EmailParser->IsRTAddress( $_ )
1063 && !IgnoreCcAddress( $_ )
1065 map lc $user->CanonicalizeEmailAddress( $_->address ),
1066 map Email::Address->parse( $args{'Head'}->get( $_ ) ),
1070 =head2 IgnoreCcAddress ADDRESS
1072 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1076 sub IgnoreCcAddress {
1077 my $address = shift;
1078 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1079 return 1 if $address =~ /$address_re/i;
1084 =head2 ParseSenderAddressFromHead HEAD
1086 Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
1087 of the From (evaluated in order of Reply-To:, From:, Sender)
1091 sub ParseSenderAddressFromHead {
1094 #Figure out who's sending this message.
1095 foreach my $header ('Reply-To', 'From', 'Sender') {
1096 my $addr_line = $head->get($header) || next;
1097 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1098 # only return if the address is not empty
1099 return ($addr, $name) if $addr;
1102 return (undef, undef);
1105 =head2 ParseErrorsToAddressFromHead HEAD
1107 Takes a MIME::Header object. Return a single value : user@host
1108 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1113 sub ParseErrorsToAddressFromHead {
1116 #Figure out who's sending this message.
1118 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1120 # If there's a header of that name
1121 my $headerobj = $head->get($header);
1123 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1125 # If it's got actual useful content...
1126 return ($addr) if ($addr);
1133 =head2 ParseAddressFromHeader ADDRESS
1135 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1139 sub ParseAddressFromHeader {
1142 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1143 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1144 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1146 my ($AddrObj) = grep ref $_, @Addresses;
1147 unless ( $AddrObj ) {
1148 return ( undef, undef );
1151 return ( $AddrObj->address, $AddrObj->phrase );
1154 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1156 Gets a head object and list of addresses.
1157 Deletes addresses from To, Cc or Bcc fields.
1161 sub DeleteRecipientsFromHead {
1163 my %skip = map { lc $_ => 1 } @_;
1165 foreach my $field ( qw(To Cc Bcc) ) {
1166 $head->set( $field =>
1167 join ', ', map $_->format, grep !$skip{ lc $_->address },
1168 Email::Address->parse( $head->get( $field ) )
1177 ScripAction => undef,
1180 my $org = RT->Config->Get('Organization');
1181 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1182 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1183 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1185 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1186 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1196 return unless $args{'Message'} && $args{'InReplyTo'};
1198 my $get_header = sub {
1200 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1201 @res = $args{'InReplyTo'}->head->get( shift );
1203 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1205 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1208 my @id = $get_header->('Message-ID');
1209 #XXX: custom header should begin with X- otherwise is violation of the standard
1210 my @rtid = $get_header->('RT-Message-ID');
1211 my @references = $get_header->('References');
1212 unless ( @references ) {
1213 @references = $get_header->('In-Reply-To');
1215 push @references, @id, @rtid;
1216 if ( $args{'Ticket'} ) {
1217 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1218 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1220 @references = splice @references, 4, -6
1221 if @references > 10;
1223 my $mail = $args{'Message'};
1224 $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
1225 $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) );
1228 sub ExtractTicketId {
1231 my $subject = $entity->head->get('Subject') || '';
1233 return ParseTicketId( $subject );
1237 my $Subject = shift;
1239 my $rtname = RT->Config->Get('rtname');
1240 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1243 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1246 foreach my $tag ( RT->System->SubjectTag ) {
1247 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1252 return undef unless $id;
1254 $RT::Logger->debug("Found a ticket ID. It's $id");
1259 my $subject = shift;
1261 unless ( ref $ticket ) {
1262 my $tmp = RT::Ticket->new( RT->SystemUser );
1263 $tmp->Load( $ticket );
1266 my $id = $ticket->id;
1267 my $queue_tag = $ticket->QueueObj->SubjectTag;
1269 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1270 unless ( $tag_re ) {
1271 my $tag = $queue_tag || RT->Config->Get('rtname');
1272 $tag_re = qr/\Q$tag\E/;
1273 } elsif ( $queue_tag ) {
1274 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1276 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1278 $subject =~ s/(\r\n|\n|\s)/ /g;
1280 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1284 =head2 Gateway ARGSREF
1294 This performs all the "guts" of the mail rt-mailgate program, and is
1295 designed to be called from the web interface with a message, user
1298 Can also take an optional 'ticket' parameter; this ticket id overrides
1299 any ticket id found in the subject.
1305 (status code, message, optional ticket object)
1307 status code is a numeric value.
1309 for temporary failures, the status code should be -75
1311 for permanent failures which are handled by RT, the status code
1314 for succces, the status code should be 1
1321 my @mail_plugins = @_;
1324 foreach my $plugin (@mail_plugins) {
1325 if ( ref($plugin) eq "CODE" ) {
1327 } elsif ( !ref $plugin ) {
1328 my $Class = $plugin;
1329 $Class = "RT::Interface::Email::" . $Class
1330 unless $Class =~ /^RT::/;
1332 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1335 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1336 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1341 $RT::Logger->crit( "$plugin - is not class name or code reference");
1348 my $argsref = shift;
1350 action => 'correspond',
1360 # Validate the action
1361 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1365 "Invalid 'action' parameter "
1373 my $parser = RT::EmailParser->new();
1374 $parser->SmartParseMIMEEntityFromScalar(
1375 Message => $args{'message'},
1380 my $Message = $parser->Entity();
1383 Subject => "RT Bounce: Unparseable message",
1384 Explanation => "RT couldn't process the message below",
1385 Attach => $args{'message'}
1389 "Failed to parse this message. Something is likely badly wrong with the message"
1393 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1394 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1395 @mail_plugins = _LoadPlugins( @mail_plugins );
1398 foreach my $class( grep !ref, @mail_plugins ) {
1399 # check if we should apply filter before decoding
1402 *{ $class . "::ApplyBeforeDecode" }{CODE};
1404 next unless defined $check_cb;
1405 next unless $check_cb->(
1406 Message => $Message,
1407 RawMessageRef => \$args{'message'},
1410 $skip_plugin{ $class }++;
1414 *{ $class . "::GetCurrentUser" }{CODE};
1416 my ($status, $msg) = $Code->(
1417 Message => $Message,
1418 RawMessageRef => \$args{'message'},
1420 next if $status > 0;
1422 if ( $status == -2 ) {
1423 return (1, $msg, undef);
1424 } elsif ( $status == -1 ) {
1425 return (0, $msg, undef);
1428 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1429 $parser->_DecodeBodies;
1430 $parser->_PostProcessNewEntity;
1432 my $head = $Message->head;
1433 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1435 my $MessageId = $head->get('Message-ID')
1436 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1438 #Pull apart the subject line
1439 my $Subject = $head->get('Subject') || '';
1442 # Lets check for mail loops of various sorts.
1443 my ($should_store_machine_generated_message, $IsALoop, $result);
1444 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1445 _HandleMachineGeneratedMail(
1446 Message => $Message,
1447 ErrorsTo => $ErrorsTo,
1448 Subject => $Subject,
1449 MessageId => $MessageId
1452 # Do not pass loop messages to MailPlugins, to make sure the loop
1453 # is broken, unless $RT::StoreLoops is set.
1454 if ($IsALoop && !$should_store_machine_generated_message) {
1455 return ( 0, $result, undef );
1459 $args{'ticket'} ||= ExtractTicketId( $Message );
1461 $SystemTicket = RT::Ticket->new( RT->SystemUser );
1462 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1463 if ( $SystemTicket->id ) {
1464 $Right = 'ReplyToTicket';
1466 $Right = 'CreateTicket';
1469 #Set up a queue object
1470 my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
1471 $SystemQueueObj->Load( $args{'queue'} );
1473 # We can safely have no queue of we have a known-good ticket
1474 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1475 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1478 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1479 MailPlugins => \@mail_plugins,
1480 Actions => \@actions,
1481 Message => $Message,
1482 RawMessageRef => \$args{message},
1483 SystemTicket => $SystemTicket,
1484 SystemQueue => $SystemQueueObj,
1487 # If authentication fails and no new user was created, get out.
1488 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1490 # If the plugins refused to create one, they lose.
1491 unless ( $AuthStat == -1 ) {
1492 _NoAuthorizedUserFound(
1494 Message => $Message,
1495 Requestor => $ErrorsTo,
1496 Queue => $args{'queue'}
1500 return ( 0, "Could not load a valid user", undef );
1503 # If we got a user, but they don't have the right to say things
1504 if ( $AuthStat == 0 ) {
1507 Subject => "Permission Denied",
1509 "You do not have permission to communicate with RT",
1514 "$ErrorsTo tried to submit a message to "
1516 . " without permission.",
1522 unless ($should_store_machine_generated_message) {
1523 return ( 0, $result, undef );
1526 # if plugin's updated SystemTicket then update arguments
1527 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1529 my $Ticket = RT::Ticket->new($CurrentUser);
1531 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1535 my @Requestors = ( $CurrentUser->id );
1537 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1538 @Cc = ParseCcAddressesFromHead(
1540 CurrentUser => $CurrentUser,
1541 QueueObj => $SystemQueueObj
1545 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1546 Queue => $SystemQueueObj->Id,
1547 Subject => $Subject,
1548 Requestor => \@Requestors,
1555 Subject => "Ticket creation failed: $Subject",
1556 Explanation => $ErrStr,
1559 return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
1562 # strip comments&corresponds from the actions we don't need
1563 # to record them if we've created the ticket just now
1564 @actions = grep !/^(comment|correspond)$/, @actions;
1565 $args{'ticket'} = $id;
1567 } elsif ( $args{'ticket'} ) {
1569 $Ticket->Load( $args{'ticket'} );
1570 unless ( $Ticket->Id ) {
1571 my $error = "Could not find a ticket with id " . $args{'ticket'};
1574 Subject => "Message not recorded: $Subject",
1575 Explanation => $error,
1579 return ( 0, $error );
1581 $args{'ticket'} = $Ticket->id;
1583 return ( 1, "Success", $Ticket );
1588 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1589 foreach my $action (@actions) {
1591 # If the action is comment, add a comment.
1592 if ( $action =~ /^(?:comment|correspond)$/i ) {
1593 my $method = ucfirst lc $action;
1594 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1597 #Warn the sender that we couldn't actually submit the comment.
1600 Subject => "Message not recorded: $Subject",
1601 Explanation => $msg,
1604 return ( 0, "Message not recorded: $msg", $Ticket );
1606 } elsif ($unsafe_actions) {
1607 my ( $status, $msg ) = _RunUnsafeAction(
1609 ErrorsTo => $ErrorsTo,
1610 Message => $Message,
1612 CurrentUser => $CurrentUser,
1614 return ($status, $msg, $Ticket) unless $status == 1;
1617 return ( 1, "Success", $Ticket );
1620 =head2 GetAuthenticationLevel
1622 # Authentication Level
1623 # -1 - Get out. this user has been explicitly declined
1624 # 0 - User may not do anything (Not used at the moment)
1626 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1630 sub GetAuthenticationLevel {
1635 RawMessageRef => undef,
1636 SystemTicket => undef,
1637 SystemQueue => undef,
1641 my ( $CurrentUser, $AuthStat, $error );
1643 # Initalize AuthStat so comparisons work correctly
1644 $AuthStat = -9999999;
1646 # if plugin returns AuthStat -2 we skip action
1647 # NOTE: this is experimental API and it would be changed
1648 my %skip_action = ();
1650 # Since this needs loading, no matter what
1651 foreach (@{ $args{MailPlugins} }) {
1652 my ($Code, $NewAuthStat);
1653 if ( ref($_) eq "CODE" ) {
1657 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1660 foreach my $action (@{ $args{Actions} }) {
1661 ( $CurrentUser, $NewAuthStat ) = $Code->(
1662 Message => $args{Message},
1663 RawMessageRef => $args{RawMessageRef},
1664 CurrentUser => $CurrentUser,
1665 AuthLevel => $AuthStat,
1667 Ticket => $args{SystemTicket},
1668 Queue => $args{SystemQueue},
1671 # You get the highest level of authentication you were assigned, unless you get the magic -1
1672 # If a module returns a "-1" then we discard the ticket, so.
1673 $AuthStat = $NewAuthStat
1674 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1676 last if $AuthStat == -1;
1677 $skip_action{$action}++ if $AuthStat == -2;
1680 # strip actions we should skip
1681 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1683 last unless @{$args{Actions}};
1685 last if $AuthStat == -1;
1688 return $AuthStat if !wantarray;
1690 return ($AuthStat, $CurrentUser, $error);
1693 sub _RunUnsafeAction {
1699 CurrentUser => undef,
1703 if ( $args{'Action'} =~ /^take$/i ) {
1704 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1707 To => $args{'ErrorsTo'},
1708 Subject => "Ticket not taken",
1709 Explanation => $msg,
1710 MIMEObj => $args{'Message'}
1712 return ( 0, "Ticket not taken" );
1714 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1715 my $new_status = $args{'Ticket'}->FirstInactiveStatus;
1717 my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status);
1720 #Warn the sender that we couldn't actually submit the comment.
1722 To => $args{'ErrorsTo'},
1723 Subject => "Ticket not resolved",
1724 Explanation => $msg,
1725 MIMEObj => $args{'Message'}
1727 return ( 0, "Ticket not resolved" );
1731 return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
1733 return ( 1, "Success" );
1736 =head2 _NoAuthorizedUserFound
1738 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1742 sub _NoAuthorizedUserFound {
1751 # Notify the RT Admin of the failure.
1753 To => RT->Config->Get('OwnerEmail'),
1754 Subject => "Could not load a valid user",
1755 Explanation => <<EOT,
1756 RT could not load a valid user, and RT's configuration does not allow
1757 for the creation of a new user for this email (@{[$args{Requestor}]}).
1759 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1760 queue @{[$args{'Queue'}]}.
1763 MIMEObj => $args{'Message'},
1767 # Also notify the requestor that his request has been dropped.
1768 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1770 To => $args{'Requestor'},
1771 Subject => "Could not load a valid user",
1772 Explanation => <<EOT,
1773 RT could not load a valid user, and RT's configuration does not allow
1774 for the creation of a new user for your email.
1777 MIMEObj => $args{'Message'},
1783 =head2 _HandleMachineGeneratedMail
1790 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1791 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1792 "This message appears to be a loop (boolean)" );
1796 sub _HandleMachineGeneratedMail {
1797 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1798 my $head = $args{'Message'}->head;
1799 my $ErrorsTo = $args{'ErrorsTo'};
1801 my $IsBounce = CheckForBounce($head);
1803 my $IsAutoGenerated = CheckForAutoGenerated($head);
1805 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1807 my $IsALoop = CheckForLoops($head);
1809 my $SquelchReplies = 0;
1811 my $owner_mail = RT->Config->Get('OwnerEmail');
1813 #If the message is autogenerated, we need to know, so we can not
1814 # send mail to the sender
1815 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1816 $SquelchReplies = 1;
1817 $ErrorsTo = $owner_mail;
1820 # Warn someone if it's a loop, before we drop it on the ground
1822 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1824 #Should we mail it to RTOwner?
1825 if ( RT->Config->Get('LoopsToRTOwner') ) {
1828 Subject => "RT Bounce: ".$args{'Subject'},
1829 Explanation => "RT thinks this message may be a bounce",
1830 MIMEObj => $args{Message}
1834 #Do we actually want to store it?
1835 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1836 unless RT->Config->Get('StoreLoops');
1839 # Squelch replies if necessary
1840 # Don't let the user stuff the RT-Squelch-Replies-To header.
1841 if ( $head->get('RT-Squelch-Replies-To') ) {
1843 'RT-Relocated-Squelch-Replies-To',
1844 $head->get('RT-Squelch-Replies-To')
1846 $head->delete('RT-Squelch-Replies-To');
1849 if ($SquelchReplies) {
1851 # Squelch replies to the sender, and also leave a clue to
1852 # allow us to squelch ALL outbound messages. This way we
1853 # can punt the logic of "what to do when we get a bounce"
1854 # to the scrip. We might want to notify nobody. Or just
1855 # the RT Owner. Or maybe all Privileged watchers.
1856 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1857 $head->replace( 'RT-Squelch-Replies-To', $Sender );
1858 $head->replace( 'RT-DetectedAutoGenerated', 'true' );
1860 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1863 =head2 IsCorrectAction
1865 Returns a list of valid actions we've found for this message
1869 sub IsCorrectAction {
1871 my @actions = grep $_, split /-/, $action;
1872 return ( 0, '(no value)' ) unless @actions;
1873 foreach ( @actions ) {
1874 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1876 return ( 1, @actions );
1879 sub _RecordSendEmailFailure {
1882 $ticket->_RecordNote(
1883 NoteType => 'SystemError',
1884 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1889 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1894 RT::Base->_ImportOverlays();