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.
321 sub WillSignEncrypt {
323 my $attachment = delete $args{Attachment};
324 my $ticket = delete $args{Ticket};
326 if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
327 $args{Sign} = $args{Encrypt} = 0;
328 return wantarray ? %args : 0;
331 for my $argument ( qw(Sign Encrypt) ) {
332 next if defined $args{ $argument };
334 if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
335 $args{$argument} = $attachment->GetHeader("X-RT-$argument");
336 } elsif ( $ticket and $argument eq "Encrypt" ) {
337 $args{Encrypt} = $ticket->QueueObj->Encrypt();
338 } elsif ( $ticket and $argument eq "Sign" ) {
339 # Note that $queue->Sign is UI-only, and that all
340 # UI-generated messages explicitly set the X-RT-Crypt header
341 # to 0 or 1; thus this path is only taken for messages
342 # generated _not_ via the web UI.
343 $args{Sign} = $ticket->QueueObj->SignAuto();
347 return wantarray ? %args : ($args{Sign} || $args{Encrypt});
355 Transaction => undef,
359 my $TicketObj = $args{'Ticket'};
360 my $TransactionObj = $args{'Transaction'};
362 foreach my $arg( qw(Entity Bounce) ) {
363 next unless defined $args{ lc $arg };
365 $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
366 $args{ $arg } = delete $args{ lc $arg };
369 unless ( $args{'Entity'} ) {
370 $RT::Logger->crit( "Could not send mail without 'Entity' object" );
374 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
377 # If we don't have any recipients to send to, don't send a message;
378 unless ( $args{'Entity'}->head->get('To')
379 || $args{'Entity'}->head->get('Cc')
380 || $args{'Entity'}->head->get('Bcc') )
382 $RT::Logger->info( $msgid . " No recipients found. Not sending." );
386 if ($args{'Entity'}->head->get('X-RT-Squelch')) {
387 $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
391 if ( $TransactionObj && !$TicketObj
392 && $TransactionObj->ObjectType eq 'RT::Ticket' )
394 $TicketObj = $TransactionObj->Object;
397 if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
398 %args = WillSignEncrypt(
400 Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
401 Ticket => $TicketObj,
403 my $res = SignEncrypt( %args );
404 return $res unless $res > 0;
407 unless ( $args{'Entity'}->head->get('Date') ) {
409 my $date = RT::Date->new( RT->SystemUser );
411 $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
414 my $mail_command = RT->Config->Get('MailCommand');
416 if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
417 $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
418 $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
421 # if it is a sub routine, we just return it;
422 return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
424 if ( $mail_command eq 'sendmailpipe' ) {
425 my $path = RT->Config->Get('SendmailPath');
426 my @args = shellwords(RT->Config->Get('SendmailArguments'));
428 # SetOutgoingMailFrom and bounces conflict, since they both want -f
429 if ( $args{'Bounce'} ) {
430 push @args, shellwords(RT->Config->Get('SendmailBounceArguments'));
431 } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
432 my $OutgoingMailAddress;
435 my $QueueName = $TicketObj->QueueObj->Name;
436 my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName};
438 if ($QueueAddressOverride) {
439 $OutgoingMailAddress = $QueueAddressOverride;
441 $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress;
445 $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'};
447 push @args, "-f", $OutgoingMailAddress
448 if $OutgoingMailAddress;
452 if ( $TransactionObj and
453 my $prefix = RT->Config->Get('VERPPrefix') and
454 my $domain = RT->Config->Get('VERPDomain') )
456 my $from = $TransactionObj->CreatorObj->EmailAddress;
459 push @args, "-f", "$prefix$from\@$domain";
463 # don't ignore CHLD signal to get proper exit code
464 local $SIG{'CHLD'} = 'DEFAULT';
466 # if something wrong with $mail->print we will get PIPE signal, handle it
467 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
471 my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
472 or die "couldn't execute program: $!";
474 $args{'Entity'}->print($mail);
475 close $mail or die "close pipe failed: $!";
479 # sendmail exit statuses mostly errors with data not software
480 # TODO: status parsing: core dump, exit on signal or EX_*
481 my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
482 $msg = ", interrupted by signal ". ($?&127) if $?&127;
483 $RT::Logger->error( $msg );
488 $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
490 _RecordSendEmailFailure( $TicketObj );
495 elsif ( $mail_command eq 'smtp' ) {
497 my $smtp = do { local $@; eval { Net::SMTP->new(
498 Host => RT->Config->Get('SMTPServer'),
499 Debug => RT->Config->Get('SMTPDebug'),
502 $RT::Logger->crit( "Could not connect to SMTP server.");
504 _RecordSendEmailFailure( $TicketObj );
509 # duplicate head as we want drop Bcc field
510 my $head = $args{'Entity'}->head->dup;
511 my @recipients = map $_->address, map
512 Email::Address->parse($head->get($_)), qw(To Cc Bcc);
513 $head->delete('Bcc');
515 my $sender = RT->Config->Get('SMTPFrom')
516 || $args{'Entity'}->head->get('From');
519 my $status = $smtp->mail( $sender )
520 && $smtp->recipient( @recipients );
524 my $fh = $smtp->tied_fh;
527 $args{'Entity'}->print_body( $fh );
533 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
535 _RecordSendEmailFailure( $TicketObj );
541 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
543 my @mailer_args = ($mail_command);
544 if ( $mail_command eq 'sendmail' ) {
545 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
546 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
549 push @mailer_args, RT->Config->Get('MailParams');
552 unless ( $args{'Entity'}->send( @mailer_args ) ) {
553 $RT::Logger->crit( "$msgid: Could not send mail." );
555 _RecordSendEmailFailure( $TicketObj );
563 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
565 Loads a template. Parses it using arguments if it's not empty.
566 Returns a tuple (L<RT::Template> object, error message).
568 Note that even if a template object is returned MIMEObj method
569 may return undef for empty templates.
573 sub PrepareEmailUsingTemplate {
580 my $template = RT::Template->new( RT->SystemUser );
581 $template->LoadGlobalTemplate( $args{'Template'} );
582 unless ( $template->id ) {
583 return (undef, "Couldn't load template '". $args{'Template'} ."'");
585 return $template if $template->IsEmpty;
587 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
588 return (undef, $msg) unless $status;
593 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
595 Sends email using a template, takes name of template, arguments for it and recipients.
599 sub SendEmailUsingTemplate {
606 From => RT->Config->Get('CorrespondAddress'),
612 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
613 return (0, $msg) unless $template;
615 my $mail = $template->MIMEObj;
617 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
621 $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
622 foreach grep defined $args{$_}, qw(To Cc Bcc From);
624 $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
625 foreach keys %{ $args{ExtraHeaders} };
627 SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
629 return SendEmail( Entity => $mail );
632 =head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
634 Forwards transaction with all attachments as 'message/rfc822'.
638 sub ForwardTransaction {
640 my %args = ( To => '', Cc => '', Bcc => '', @_ );
642 my $entity = $txn->ContentAsMIME;
644 my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
646 my $ticket = $txn->TicketObj;
647 my ( $ret, $msg ) = $ticket->_NewTransaction(
648 Type => 'Forward Transaction',
650 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
653 $RT::Logger->error("Failed to create transaction: $msg");
656 return ( $ret, $msg );
659 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
661 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
667 my %args = ( To => '', Cc => '', Bcc => '', @_ );
669 my $txns = $ticket->Transactions;
673 ) for qw(Create Correspond);
675 my $entity = MIME::Entity->build(
676 Type => 'multipart/mixed',
677 Description => 'forwarded ticket',
679 $entity->add_part( $_ ) foreach
680 map $_->ContentAsMIME,
681 @{ $txns->ItemsArrayRef };
683 my ( $ret, $msg ) = SendForward(
687 Template => 'Forward Ticket',
691 my ( $ret, $msg ) = $ticket->_NewTransaction(
692 Type => 'Forward Ticket',
693 Field => $ticket->id,
694 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
697 $RT::Logger->error("Failed to create transaction: $msg");
701 return ( $ret, $msg );
705 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
707 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
715 Transaction => undef,
716 Template => 'Forward',
717 To => '', Cc => '', Bcc => '',
721 my $txn = $args{'Transaction'};
722 my $ticket = $args{'Ticket'};
723 $ticket ||= $txn->Object if $txn;
725 my $entity = $args{'Entity'};
728 $RT::Logger->error(Carp::longmess("No entity provided"));
729 return (0, $ticket->loc("Couldn't send email"));
732 my ($template, $msg) = PrepareEmailUsingTemplate(
733 Template => $args{'Template'},
742 $mail = $template->MIMEObj;
744 $RT::Logger->warning($msg);
747 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
750 unless ( $args{'Transaction'} ) {
751 $description = 'This is forward of ticket #'. $ticket->id;
753 $description = 'This is forward of transaction #'
754 . $txn->id ." of a ticket #". $txn->ObjectId;
756 $mail = MIME::Entity->build(
757 Type => 'text/plain',
758 Data => $description,
762 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
763 foreach grep defined $args{$_}, qw(To Cc Bcc);
765 $mail->make_multipart unless $mail->is_multipart;
766 $mail->add_part( $entity );
769 unless (defined $mail->head->get('Subject')) {
771 $subject = $txn->Subject if $txn;
772 $subject ||= $ticket->Subject if $ticket;
774 unless ( RT->Config->Get('ForwardFromUser') ) {
775 # XXX: what if want to forward txn of other object than ticket?
776 $subject = AddSubjectTag( $subject, $ticket );
779 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
783 From => EncodeToMIME(
784 String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
788 my $status = RT->Config->Get('ForwardFromUser')
789 # never sign if we forward from User
790 ? SendEmail( %args, Entity => $mail, Sign => 0 )
791 : SendEmail( %args, Entity => $mail );
792 return (0, $ticket->loc("Couldn't send email")) unless $status;
793 return (1, $ticket->loc("Sent email successfully"));
796 =head2 GetForwardFrom Ticket => undef, Transaction => undef
798 Resolve the From field to use in forward mail
803 my %args = ( Ticket => undef, Transaction => undef, @_ );
804 my $txn = $args{Transaction};
805 my $ticket = $args{Ticket} || $txn->Object;
807 if ( RT->Config->Get('ForwardFromUser') ) {
808 return ( $txn || $ticket )->CurrentUser->EmailAddress;
811 return $ticket->QueueObj->CorrespondAddress
812 || RT->Config->Get('CorrespondAddress');
816 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
818 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
819 handle errors with users' keys.
821 If a recipient has no key or has other problems with it, then the
822 unction sends a error to him using 'Error: public key' template.
823 Also, notifies RT's owner using template 'Error to RT owner: public key'
824 to inform that there are problems with users' keys. Then we filter
825 all bad recipients and retry.
827 Returns 1 on success, 0 on error and -1 if all recipients are bad and
828 had been filtered out.
839 return 1 unless $args{'Sign'} || $args{'Encrypt'};
841 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
844 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
845 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
847 require RT::Crypt::GnuPG;
848 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
849 return 1 unless $res{'exit_code'};
851 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
854 foreach my $line ( @status ) {
855 # if the passphrase fails, either you have a bad passphrase
856 # or gpg-agent has died. That should get caught in Create and
857 # Update, but at least throw an error here
858 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
859 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
860 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
863 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
864 next if $line->{'Status'} eq 'DONE';
865 $RT::Logger->error( $line->{'Message'} );
866 push @bad_recipients, $line;
868 return 0 unless @bad_recipients;
870 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
871 foreach @bad_recipients;
873 foreach my $recipient ( @bad_recipients ) {
874 my $status = SendEmailUsingTemplate(
875 To => $recipient->{'AddressObj'}->address,
876 Template => 'Error: public key',
879 TicketObj => $args{'Ticket'},
880 TransactionObj => $args{'Transaction'},
884 $RT::Logger->error("Couldn't send 'Error: public key'");
888 my $status = SendEmailUsingTemplate(
889 To => RT->Config->Get('OwnerEmail'),
890 Template => 'Error to RT owner: public key',
892 BadRecipients => \@bad_recipients,
893 TicketObj => $args{'Ticket'},
894 TransactionObj => $args{'Transaction'},
898 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
901 DeleteRecipientsFromHead(
902 $args{'Entity'}->head,
903 map $_->{'AddressObj'}->address, @bad_recipients
906 unless ( $args{'Entity'}->head->get('To')
907 || $args{'Entity'}->head->get('Cc')
908 || $args{'Entity'}->head->get('Bcc') )
910 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
914 # redo without broken recipients
915 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
916 return 0 if $res{'exit_code'};
925 Takes a hash with a String and a Charset. Returns the string encoded
926 according to RFC2047, using B (base64 based) encoding.
928 String must be a perl string, octets are returned.
930 If Charset is not provided then $EmailOutputEncoding config option
931 is used, or "latin-1" if that is not set.
941 my $value = $args{'String'};
942 return $value unless $value; # 0 is perfect ascii
943 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
946 # using RFC2047 notation, sec 2.
947 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
949 # An 'encoded-word' may not be more than 75 characters long
951 # MIME encoding increases 4/3*(number of bytes), and always in multiples
952 # of 4. Thus we have to find the best available value of bytes available
955 # First we get the integer max which max*4/3 would fit on space.
956 # Then we find the greater multiple of 3 lower or equal than $max.
958 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
962 $max = int( $max / 3 ) * 3;
969 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
973 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
977 # we need perl string to split thing char by char
978 Encode::_utf8_on($value) unless Encode::is_utf8($value);
980 my ( $tmp, @chunks ) = ( '', () );
981 while ( length $value ) {
982 my $char = substr( $value, 0, 1, '' );
983 my $octets = Encode::encode( $charset, $char );
984 if ( length($tmp) + length($octets) > $max ) {
990 push @chunks, $tmp if length $tmp;
992 # encode an join chuncks
994 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
1000 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
1002 my $NewUser = RT::User->new( RT->SystemUser );
1004 my ( $Val, $Message ) = $NewUser->Create(
1005 Name => ( $Username || $Address ),
1006 EmailAddress => $Address,
1010 Comments => 'Autocreated on ticket submission',
1015 # Deal with the race condition of two account creations at once
1017 $NewUser->LoadByName($Username);
1020 unless ( $NewUser->Id ) {
1021 $NewUser->LoadByEmail($Address);
1024 unless ( $NewUser->Id ) {
1027 Subject => "User could not be created",
1029 "User creation failed in mailgateway: $Message",
1036 #Load the new user object
1037 my $CurrentUser = RT::CurrentUser->new;
1038 $CurrentUser->LoadByEmail( $Address );
1040 unless ( $CurrentUser->id ) {
1041 $RT::Logger->warning(
1042 "Couldn't load user '$Address'." . "giving up" );
1045 Subject => "User could not be loaded",
1047 "User '$Address' could not be loaded in the mail gateway",
1053 return $CurrentUser;
1058 =head2 ParseCcAddressesFromHead HASH
1060 Takes a hash containing QueueObj, Head and CurrentUser objects.
1061 Returns a list of all email addresses in the To and Cc
1062 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
1063 email address and anything that the configuration sub RT::IsRTAddress matches.
1067 sub ParseCcAddressesFromHead {
1071 CurrentUser => undef,
1075 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1076 my $user = $args{'CurrentUser'}->UserObj;
1079 grep { $_ ne $current_address
1080 && !RT::EmailParser->IsRTAddress( $_ )
1081 && !IgnoreCcAddress( $_ )
1083 map lc $user->CanonicalizeEmailAddress( $_->address ),
1084 map Email::Address->parse( $args{'Head'}->get( $_ ) ),
1088 =head2 IgnoreCcAddress ADDRESS
1090 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1094 sub IgnoreCcAddress {
1095 my $address = shift;
1096 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1097 return 1 if $address =~ /$address_re/i;
1102 =head2 ParseSenderAddressFromHead HEAD
1104 Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
1105 of the From (evaluated in order of Reply-To:, From:, Sender)
1109 sub ParseSenderAddressFromHead {
1112 #Figure out who's sending this message.
1113 foreach my $header ('Reply-To', 'From', 'Sender') {
1114 my $addr_line = $head->get($header) || next;
1115 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1116 # only return if the address is not empty
1117 return ($addr, $name) if $addr;
1120 return (undef, undef);
1123 =head2 ParseErrorsToAddressFromHead HEAD
1125 Takes a MIME::Header object. Return a single value : user@host
1126 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1131 sub ParseErrorsToAddressFromHead {
1134 #Figure out who's sending this message.
1136 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1138 # If there's a header of that name
1139 my $headerobj = $head->get($header);
1141 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1143 # If it's got actual useful content...
1144 return ($addr) if ($addr);
1151 =head2 ParseAddressFromHeader ADDRESS
1153 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1157 sub ParseAddressFromHeader {
1160 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1161 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1162 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1164 my ($AddrObj) = grep ref $_, @Addresses;
1165 unless ( $AddrObj ) {
1166 return ( undef, undef );
1169 return ( $AddrObj->address, $AddrObj->phrase );
1172 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1174 Gets a head object and list of addresses.
1175 Deletes addresses from To, Cc or Bcc fields.
1179 sub DeleteRecipientsFromHead {
1181 my %skip = map { lc $_ => 1 } @_;
1183 foreach my $field ( qw(To Cc Bcc) ) {
1184 $head->set( $field =>
1185 join ', ', map $_->format, grep !$skip{ lc $_->address },
1186 Email::Address->parse( $head->get( $field ) )
1195 ScripAction => undef,
1198 my $org = RT->Config->Get('Organization');
1199 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1200 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1201 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1203 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1204 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1214 return unless $args{'Message'} && $args{'InReplyTo'};
1216 my $get_header = sub {
1218 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1219 @res = $args{'InReplyTo'}->head->get( shift );
1221 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1223 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1226 my @id = $get_header->('Message-ID');
1227 #XXX: custom header should begin with X- otherwise is violation of the standard
1228 my @rtid = $get_header->('RT-Message-ID');
1229 my @references = $get_header->('References');
1230 unless ( @references ) {
1231 @references = $get_header->('In-Reply-To');
1233 push @references, @id, @rtid;
1234 if ( $args{'Ticket'} ) {
1235 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1236 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1238 @references = splice @references, 4, -6
1239 if @references > 10;
1241 my $mail = $args{'Message'};
1242 $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
1243 $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) );
1246 sub ExtractTicketId {
1249 my $subject = $entity->head->get('Subject') || '';
1251 return ParseTicketId( $subject );
1255 my $Subject = shift;
1257 my $rtname = RT->Config->Get('rtname');
1258 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1261 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1264 foreach my $tag ( RT->System->SubjectTag ) {
1265 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1270 return undef unless $id;
1272 $RT::Logger->debug("Found a ticket ID. It's $id");
1277 my $subject = shift;
1279 unless ( ref $ticket ) {
1280 my $tmp = RT::Ticket->new( RT->SystemUser );
1281 $tmp->Load( $ticket );
1284 my $id = $ticket->id;
1285 my $queue_tag = $ticket->QueueObj->SubjectTag;
1287 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1288 unless ( $tag_re ) {
1289 my $tag = $queue_tag || RT->Config->Get('rtname');
1290 $tag_re = qr/\Q$tag\E/;
1291 } elsif ( $queue_tag ) {
1292 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1294 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1296 $subject =~ s/(\r\n|\n|\s)/ /g;
1298 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1302 =head2 Gateway ARGSREF
1312 This performs all the "guts" of the mail rt-mailgate program, and is
1313 designed to be called from the web interface with a message, user
1316 Can also take an optional 'ticket' parameter; this ticket id overrides
1317 any ticket id found in the subject.
1323 (status code, message, optional ticket object)
1325 status code is a numeric value.
1327 for temporary failures, the status code should be -75
1329 for permanent failures which are handled by RT, the status code
1332 for succces, the status code should be 1
1339 my @mail_plugins = @_;
1342 foreach my $plugin (@mail_plugins) {
1343 if ( ref($plugin) eq "CODE" ) {
1345 } elsif ( !ref $plugin ) {
1346 my $Class = $plugin;
1347 $Class = "RT::Interface::Email::" . $Class
1348 unless $Class =~ /^RT::/;
1350 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1353 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1354 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1359 $RT::Logger->crit( "$plugin - is not class name or code reference");
1366 my $argsref = shift;
1368 action => 'correspond',
1378 # Validate the action
1379 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1383 "Invalid 'action' parameter "
1391 my $parser = RT::EmailParser->new();
1392 $parser->SmartParseMIMEEntityFromScalar(
1393 Message => $args{'message'},
1398 my $Message = $parser->Entity();
1401 Subject => "RT Bounce: Unparseable message",
1402 Explanation => "RT couldn't process the message below",
1403 Attach => $args{'message'}
1407 "Failed to parse this message. Something is likely badly wrong with the message"
1411 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1412 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1413 @mail_plugins = _LoadPlugins( @mail_plugins );
1416 foreach my $class( grep !ref, @mail_plugins ) {
1417 # check if we should apply filter before decoding
1420 *{ $class . "::ApplyBeforeDecode" }{CODE};
1422 next unless defined $check_cb;
1423 next unless $check_cb->(
1424 Message => $Message,
1425 RawMessageRef => \$args{'message'},
1428 $skip_plugin{ $class }++;
1432 *{ $class . "::GetCurrentUser" }{CODE};
1434 my ($status, $msg) = $Code->(
1435 Message => $Message,
1436 RawMessageRef => \$args{'message'},
1438 next if $status > 0;
1440 if ( $status == -2 ) {
1441 return (1, $msg, undef);
1442 } elsif ( $status == -1 ) {
1443 return (0, $msg, undef);
1446 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1447 $parser->_DecodeBodies;
1448 $parser->_PostProcessNewEntity;
1450 my $head = $Message->head;
1451 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1453 my $MessageId = $head->get('Message-ID')
1454 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1456 #Pull apart the subject line
1457 my $Subject = $head->get('Subject') || '';
1460 # Lets check for mail loops of various sorts.
1461 my ($should_store_machine_generated_message, $IsALoop, $result);
1462 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1463 _HandleMachineGeneratedMail(
1464 Message => $Message,
1465 ErrorsTo => $ErrorsTo,
1466 Subject => $Subject,
1467 MessageId => $MessageId
1470 # Do not pass loop messages to MailPlugins, to make sure the loop
1471 # is broken, unless $RT::StoreLoops is set.
1472 if ($IsALoop && !$should_store_machine_generated_message) {
1473 return ( 0, $result, undef );
1477 $args{'ticket'} ||= ExtractTicketId( $Message );
1479 $SystemTicket = RT::Ticket->new( RT->SystemUser );
1480 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1481 if ( $SystemTicket->id ) {
1482 $Right = 'ReplyToTicket';
1484 $Right = 'CreateTicket';
1487 #Set up a queue object
1488 my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
1489 $SystemQueueObj->Load( $args{'queue'} );
1491 # We can safely have no queue of we have a known-good ticket
1492 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1493 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1496 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1497 MailPlugins => \@mail_plugins,
1498 Actions => \@actions,
1499 Message => $Message,
1500 RawMessageRef => \$args{message},
1501 SystemTicket => $SystemTicket,
1502 SystemQueue => $SystemQueueObj,
1505 # If authentication fails and no new user was created, get out.
1506 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1508 # If the plugins refused to create one, they lose.
1509 unless ( $AuthStat == -1 ) {
1510 _NoAuthorizedUserFound(
1512 Message => $Message,
1513 Requestor => $ErrorsTo,
1514 Queue => $args{'queue'}
1518 return ( 0, "Could not load a valid user", undef );
1521 # If we got a user, but they don't have the right to say things
1522 if ( $AuthStat == 0 ) {
1525 Subject => "Permission Denied",
1527 "You do not have permission to communicate with RT",
1532 "$ErrorsTo tried to submit a message to "
1534 . " without permission.",
1540 unless ($should_store_machine_generated_message) {
1541 return ( 0, $result, undef );
1544 # if plugin's updated SystemTicket then update arguments
1545 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1547 my $Ticket = RT::Ticket->new($CurrentUser);
1549 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1553 my @Requestors = ( $CurrentUser->id );
1555 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1556 @Cc = ParseCcAddressesFromHead(
1558 CurrentUser => $CurrentUser,
1559 QueueObj => $SystemQueueObj
1563 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1564 Queue => $SystemQueueObj->Id,
1565 Subject => $Subject,
1566 Requestor => \@Requestors,
1573 Subject => "Ticket creation failed: $Subject",
1574 Explanation => $ErrStr,
1577 return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
1580 # strip comments&corresponds from the actions we don't need
1581 # to record them if we've created the ticket just now
1582 @actions = grep !/^(comment|correspond)$/, @actions;
1583 $args{'ticket'} = $id;
1585 } elsif ( $args{'ticket'} ) {
1587 $Ticket->Load( $args{'ticket'} );
1588 unless ( $Ticket->Id ) {
1589 my $error = "Could not find a ticket with id " . $args{'ticket'};
1592 Subject => "Message not recorded: $Subject",
1593 Explanation => $error,
1597 return ( 0, $error );
1599 $args{'ticket'} = $Ticket->id;
1601 return ( 1, "Success", $Ticket );
1606 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1607 foreach my $action (@actions) {
1609 # If the action is comment, add a comment.
1610 if ( $action =~ /^(?:comment|correspond)$/i ) {
1611 my $method = ucfirst lc $action;
1612 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1615 #Warn the sender that we couldn't actually submit the comment.
1618 Subject => "Message not recorded: $Subject",
1619 Explanation => $msg,
1622 return ( 0, "Message not recorded: $msg", $Ticket );
1624 } elsif ($unsafe_actions) {
1625 my ( $status, $msg ) = _RunUnsafeAction(
1627 ErrorsTo => $ErrorsTo,
1628 Message => $Message,
1630 CurrentUser => $CurrentUser,
1632 return ($status, $msg, $Ticket) unless $status == 1;
1635 return ( 1, "Success", $Ticket );
1638 =head2 GetAuthenticationLevel
1640 # Authentication Level
1641 # -1 - Get out. this user has been explicitly declined
1642 # 0 - User may not do anything (Not used at the moment)
1644 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1648 sub GetAuthenticationLevel {
1653 RawMessageRef => undef,
1654 SystemTicket => undef,
1655 SystemQueue => undef,
1659 my ( $CurrentUser, $AuthStat, $error );
1661 # Initalize AuthStat so comparisons work correctly
1662 $AuthStat = -9999999;
1664 # if plugin returns AuthStat -2 we skip action
1665 # NOTE: this is experimental API and it would be changed
1666 my %skip_action = ();
1668 # Since this needs loading, no matter what
1669 foreach (@{ $args{MailPlugins} }) {
1670 my ($Code, $NewAuthStat);
1671 if ( ref($_) eq "CODE" ) {
1675 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1678 foreach my $action (@{ $args{Actions} }) {
1679 ( $CurrentUser, $NewAuthStat ) = $Code->(
1680 Message => $args{Message},
1681 RawMessageRef => $args{RawMessageRef},
1682 CurrentUser => $CurrentUser,
1683 AuthLevel => $AuthStat,
1685 Ticket => $args{SystemTicket},
1686 Queue => $args{SystemQueue},
1689 # You get the highest level of authentication you were assigned, unless you get the magic -1
1690 # If a module returns a "-1" then we discard the ticket, so.
1691 $AuthStat = $NewAuthStat
1692 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1694 last if $AuthStat == -1;
1695 $skip_action{$action}++ if $AuthStat == -2;
1698 # strip actions we should skip
1699 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1701 last unless @{$args{Actions}};
1703 last if $AuthStat == -1;
1706 return $AuthStat if !wantarray;
1708 return ($AuthStat, $CurrentUser, $error);
1711 sub _RunUnsafeAction {
1717 CurrentUser => undef,
1721 if ( $args{'Action'} =~ /^take$/i ) {
1722 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1725 To => $args{'ErrorsTo'},
1726 Subject => "Ticket not taken",
1727 Explanation => $msg,
1728 MIMEObj => $args{'Message'}
1730 return ( 0, "Ticket not taken" );
1732 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1733 my $new_status = $args{'Ticket'}->FirstInactiveStatus;
1735 my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status);
1738 #Warn the sender that we couldn't actually submit the comment.
1740 To => $args{'ErrorsTo'},
1741 Subject => "Ticket not resolved",
1742 Explanation => $msg,
1743 MIMEObj => $args{'Message'}
1745 return ( 0, "Ticket not resolved" );
1749 return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
1751 return ( 1, "Success" );
1754 =head2 _NoAuthorizedUserFound
1756 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1760 sub _NoAuthorizedUserFound {
1769 # Notify the RT Admin of the failure.
1771 To => RT->Config->Get('OwnerEmail'),
1772 Subject => "Could not load a valid user",
1773 Explanation => <<EOT,
1774 RT could not load a valid user, and RT's configuration does not allow
1775 for the creation of a new user for this email (@{[$args{Requestor}]}).
1777 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1778 queue @{[$args{'Queue'}]}.
1781 MIMEObj => $args{'Message'},
1785 # Also notify the requestor that his request has been dropped.
1786 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1788 To => $args{'Requestor'},
1789 Subject => "Could not load a valid user",
1790 Explanation => <<EOT,
1791 RT could not load a valid user, and RT's configuration does not allow
1792 for the creation of a new user for your email.
1795 MIMEObj => $args{'Message'},
1801 =head2 _HandleMachineGeneratedMail
1808 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1809 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1810 "This message appears to be a loop (boolean)" );
1814 sub _HandleMachineGeneratedMail {
1815 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1816 my $head = $args{'Message'}->head;
1817 my $ErrorsTo = $args{'ErrorsTo'};
1819 my $IsBounce = CheckForBounce($head);
1821 my $IsAutoGenerated = CheckForAutoGenerated($head);
1823 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1825 my $IsALoop = CheckForLoops($head);
1827 my $SquelchReplies = 0;
1829 my $owner_mail = RT->Config->Get('OwnerEmail');
1831 #If the message is autogenerated, we need to know, so we can not
1832 # send mail to the sender
1833 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1834 $SquelchReplies = 1;
1835 $ErrorsTo = $owner_mail;
1838 # Warn someone if it's a loop, before we drop it on the ground
1840 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1842 #Should we mail it to RTOwner?
1843 if ( RT->Config->Get('LoopsToRTOwner') ) {
1846 Subject => "RT Bounce: ".$args{'Subject'},
1847 Explanation => "RT thinks this message may be a bounce",
1848 MIMEObj => $args{Message}
1852 #Do we actually want to store it?
1853 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1854 unless RT->Config->Get('StoreLoops');
1857 # Squelch replies if necessary
1858 # Don't let the user stuff the RT-Squelch-Replies-To header.
1859 if ( $head->get('RT-Squelch-Replies-To') ) {
1861 'RT-Relocated-Squelch-Replies-To',
1862 $head->get('RT-Squelch-Replies-To')
1864 $head->delete('RT-Squelch-Replies-To');
1867 if ($SquelchReplies) {
1869 # Squelch replies to the sender, and also leave a clue to
1870 # allow us to squelch ALL outbound messages. This way we
1871 # can punt the logic of "what to do when we get a bounce"
1872 # to the scrip. We might want to notify nobody. Or just
1873 # the RT Owner. Or maybe all Privileged watchers.
1874 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1875 $head->replace( 'RT-Squelch-Replies-To', $Sender );
1876 $head->replace( 'RT-DetectedAutoGenerated', 'true' );
1878 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1881 =head2 IsCorrectAction
1883 Returns a list of valid actions we've found for this message
1887 sub IsCorrectAction {
1889 my @actions = grep $_, split /-/, $action;
1890 return ( 0, '(no value)' ) unless @actions;
1891 foreach ( @actions ) {
1892 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1894 return ( 1, @actions );
1897 sub _RecordSendEmailFailure {
1900 $ticket->_RecordNote(
1901 NoteType => 'SystemError',
1902 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1907 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1912 RT::Base->_ImportOverlays();