1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2013 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 unparseable (non-ASCII), $From can come back undef
153 return undef if not defined $From;
155 if ( ( $From =~ /^mailer-daemon\@/i )
156 or ( $From =~ /^postmaster\@/i )
166 =head2 CheckForAutoGenerated HEAD
168 Takes a HEAD object of L<MIME::Head> class and returns true if message
169 is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated'
170 fields of the head in tests.
174 sub CheckForAutoGenerated {
177 my $Precedence = $head->get("Precedence") || "";
178 if ( $Precedence =~ /^(bulk|junk)/i ) {
182 # Per RFC3834, any Auto-Submitted header which is not "no" means
183 # it is auto-generated.
184 my $AutoSubmitted = $head->get("Auto-Submitted") || "";
185 if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) {
189 # First Class mailer uses this as a clue.
190 my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
191 if ( $FCJunk =~ /^true/i ) {
202 my $ReturnPath = $head->get("Return-path") || "";
203 return ( $ReturnPath =~ /<>/ );
207 =head2 MailError PARAM HASH
209 Sends an error message. Takes a param hash:
213 =item From - sender's address, by default is 'CorrespondAddress';
215 =item To - recipient, by default is 'OwnerEmail';
217 =item Bcc - optional Bcc recipients;
219 =item Subject - subject of the message, default is 'There has been an error';
221 =item Explanation - main content of the error, default value is 'Unexplained error';
223 =item MIMEObj - optional MIME entity that's attached to the error mail, as well we
224 add 'In-Reply-To' field to the error that points to this message.
226 =item Attach - optional text that attached to the error as 'message/rfc822' part.
228 =item LogLevel - log level under which we should write the subject and
229 explanation message into the log, by default we log it as critical.
237 To => RT->Config->Get('OwnerEmail'),
239 From => RT->Config->Get('CorrespondAddress'),
240 Subject => 'There has been an error',
241 Explanation => 'Unexplained error',
249 level => $args{'LogLevel'},
250 message => "$args{Subject}: $args{'Explanation'}",
251 ) if $args{'LogLevel'};
253 # the colons are necessary to make ->build include non-standard headers
255 Type => "multipart/mixed",
256 From => $args{'From'},
259 Subject => $args{'Subject'},
260 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'),
263 # only set precedence if the sysadmin wants us to
264 if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) {
265 $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence');
268 my $entity = MIME::Entity->build(%entity_args);
269 SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
271 $entity->attach( Data => $args{'Explanation'} . "\n" );
273 if ( $args{'MIMEObj'} ) {
274 $args{'MIMEObj'}->sync_headers;
275 $entity->add_part( $args{'MIMEObj'} );
278 if ( $args{'Attach'} ) {
279 $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
283 SendEmail( Entity => $entity, Bounce => 1 );
287 =head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ]
289 Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using
290 RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a
291 true value, the message will be marked as an autogenerated error, if
292 possible. Sets Date field of the head to now if it's not set.
294 If the C<X-RT-Squelch> header is set to any true value, the mail will
295 not be sent. One use is to let extensions easily cancel outgoing mail.
297 Ticket and Transaction arguments are optional. If Transaction is
298 specified and Ticket is not then ticket of the transaction is
299 used, but only if the transaction belongs to a ticket.
301 Returns 1 on success, 0 on error or -1 if message has no recipients
302 and hasn't been sent.
304 =head3 Signing and Encrypting
306 This function as well signs and/or encrypts the message according to
307 headers of a transaction's attachment or properties of a ticket's queue.
308 To get full access to the configuration Ticket and/or Transaction
309 arguments must be provided, but you can force behaviour using Sign
310 and/or Encrypt arguments.
312 The following precedence of arguments are used to figure out if
313 the message should be encrypted and/or signed:
315 * if Sign or Encrypt argument is defined then its value is used
317 * else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt
318 header field then it's value is used
320 * else properties of a queue of the Ticket are used.
324 sub WillSignEncrypt {
326 my $attachment = delete $args{Attachment};
327 my $ticket = delete $args{Ticket};
329 if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
330 $args{Sign} = $args{Encrypt} = 0;
331 return wantarray ? %args : 0;
334 for my $argument ( qw(Sign Encrypt) ) {
335 next if defined $args{ $argument };
337 if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
338 $args{$argument} = $attachment->GetHeader("X-RT-$argument");
339 } elsif ( $ticket and $argument eq "Encrypt" ) {
340 $args{Encrypt} = $ticket->QueueObj->Encrypt();
341 } elsif ( $ticket and $argument eq "Sign" ) {
342 # Note that $queue->Sign is UI-only, and that all
343 # UI-generated messages explicitly set the X-RT-Crypt header
344 # to 0 or 1; thus this path is only taken for messages
345 # generated _not_ via the web UI.
346 $args{Sign} = $ticket->QueueObj->SignAuto();
350 return wantarray ? %args : ($args{Sign} || $args{Encrypt});
358 Transaction => undef,
362 my $TicketObj = $args{'Ticket'};
363 my $TransactionObj = $args{'Transaction'};
365 foreach my $arg( qw(Entity Bounce) ) {
366 next unless defined $args{ lc $arg };
368 $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
369 $args{ $arg } = delete $args{ lc $arg };
372 unless ( $args{'Entity'} ) {
373 $RT::Logger->crit( "Could not send mail without 'Entity' object" );
377 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
380 # If we don't have any recipients to send to, don't send a message;
381 unless ( $args{'Entity'}->head->get('To')
382 || $args{'Entity'}->head->get('Cc')
383 || $args{'Entity'}->head->get('Bcc') )
385 $RT::Logger->info( $msgid . " No recipients found. Not sending." );
389 if ($args{'Entity'}->head->get('X-RT-Squelch')) {
390 $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
394 if ( $TransactionObj && !$TicketObj
395 && $TransactionObj->ObjectType eq 'RT::Ticket' )
397 $TicketObj = $TransactionObj->Object;
400 if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
401 %args = WillSignEncrypt(
403 Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
404 Ticket => $TicketObj,
406 my $res = SignEncrypt( %args );
407 return $res unless $res > 0;
410 unless ( $args{'Entity'}->head->get('Date') ) {
412 my $date = RT::Date->new( RT->SystemUser );
414 $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
417 my $mail_command = RT->Config->Get('MailCommand');
419 if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
420 $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
421 $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
424 # if it is a sub routine, we just return it;
425 return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
427 if ( $mail_command eq 'sendmailpipe' ) {
428 my $path = RT->Config->Get('SendmailPath');
429 my @args = shellwords(RT->Config->Get('SendmailArguments'));
431 # SetOutgoingMailFrom and bounces conflict, since they both want -f
432 if ( $args{'Bounce'} ) {
433 push @args, shellwords(RT->Config->Get('SendmailBounceArguments'));
434 } elsif ( RT->Config->Get('SetOutgoingMailFrom') ) {
435 my $OutgoingMailAddress;
438 my $QueueName = $TicketObj->QueueObj->Name;
439 my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName};
441 if ($QueueAddressOverride) {
442 $OutgoingMailAddress = $QueueAddressOverride;
444 $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress;
448 $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'};
450 push @args, "-f", $OutgoingMailAddress
451 if $OutgoingMailAddress;
455 if ( $TransactionObj and
456 my $prefix = RT->Config->Get('VERPPrefix') and
457 my $domain = RT->Config->Get('VERPDomain') )
459 my $from = $TransactionObj->CreatorObj->EmailAddress;
462 push @args, "-f", "$prefix$from\@$domain";
466 # don't ignore CHLD signal to get proper exit code
467 local $SIG{'CHLD'} = 'DEFAULT';
469 # if something wrong with $mail->print we will get PIPE signal, handle it
470 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
474 my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
475 or die "couldn't execute program: $!";
477 $args{'Entity'}->print($mail);
478 close $mail or die "close pipe failed: $!";
482 # sendmail exit statuses mostly errors with data not software
483 # TODO: status parsing: core dump, exit on signal or EX_*
484 my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
485 $msg = ", interrupted by signal ". ($?&127) if $?&127;
486 $RT::Logger->error( $msg );
491 $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
493 _RecordSendEmailFailure( $TicketObj );
498 elsif ( $mail_command eq 'smtp' ) {
500 my $smtp = do { local $@; eval { Net::SMTP->new(
501 Host => RT->Config->Get('SMTPServer'),
502 Debug => RT->Config->Get('SMTPDebug'),
505 $RT::Logger->crit( "Could not connect to SMTP server.");
507 _RecordSendEmailFailure( $TicketObj );
512 # duplicate head as we want drop Bcc field
513 my $head = $args{'Entity'}->head->dup;
514 my @recipients = map $_->address, map
515 Email::Address->parse($head->get($_)), qw(To Cc Bcc);
516 $head->delete('Bcc');
518 my $sender = RT->Config->Get('SMTPFrom')
519 || $args{'Entity'}->head->get('From');
522 my $status = $smtp->mail( $sender )
523 && $smtp->recipient( @recipients );
527 my $fh = $smtp->tied_fh;
530 $args{'Entity'}->print_body( $fh );
536 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
538 _RecordSendEmailFailure( $TicketObj );
544 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
546 my @mailer_args = ($mail_command);
547 if ( $mail_command eq 'sendmail' ) {
548 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
549 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
552 push @mailer_args, RT->Config->Get('MailParams');
555 unless ( $args{'Entity'}->send( @mailer_args ) ) {
556 $RT::Logger->crit( "$msgid: Could not send mail." );
558 _RecordSendEmailFailure( $TicketObj );
566 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
568 Loads a template. Parses it using arguments if it's not empty.
569 Returns a tuple (L<RT::Template> object, error message).
571 Note that even if a template object is returned MIMEObj method
572 may return undef for empty templates.
576 sub PrepareEmailUsingTemplate {
583 my $template = RT::Template->new( RT->SystemUser );
584 $template->LoadGlobalTemplate( $args{'Template'} );
585 unless ( $template->id ) {
586 return (undef, "Couldn't load template '". $args{'Template'} ."'");
588 return $template if $template->IsEmpty;
590 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
591 return (undef, $msg) unless $status;
596 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
598 Sends email using a template, takes name of template, arguments for it and recipients.
602 sub SendEmailUsingTemplate {
609 From => RT->Config->Get('CorrespondAddress'),
615 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
616 return (0, $msg) unless $template;
618 my $mail = $template->MIMEObj;
620 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
624 $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
625 foreach grep defined $args{$_}, qw(To Cc Bcc From);
627 $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
628 foreach keys %{ $args{ExtraHeaders} };
630 SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
632 return SendEmail( Entity => $mail );
635 =head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
637 Forwards transaction with all attachments as 'message/rfc822'.
641 sub ForwardTransaction {
643 my %args = ( To => '', Cc => '', Bcc => '', @_ );
645 my $entity = $txn->ContentAsMIME;
647 my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
649 my $ticket = $txn->TicketObj;
650 my ( $ret, $msg ) = $ticket->_NewTransaction(
651 Type => 'Forward Transaction',
653 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
656 $RT::Logger->error("Failed to create transaction: $msg");
659 return ( $ret, $msg );
662 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
664 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
670 my %args = ( To => '', Cc => '', Bcc => '', @_ );
672 my $txns = $ticket->Transactions;
676 ) for qw(Create Correspond);
678 my $entity = MIME::Entity->build(
679 Type => 'multipart/mixed',
680 Description => 'forwarded ticket',
682 $entity->add_part( $_ ) foreach
683 map $_->ContentAsMIME,
684 @{ $txns->ItemsArrayRef };
686 my ( $ret, $msg ) = SendForward(
690 Template => 'Forward Ticket',
694 my ( $ret, $msg ) = $ticket->_NewTransaction(
695 Type => 'Forward Ticket',
696 Field => $ticket->id,
697 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
700 $RT::Logger->error("Failed to create transaction: $msg");
704 return ( $ret, $msg );
708 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
710 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
718 Transaction => undef,
719 Template => 'Forward',
720 To => '', Cc => '', Bcc => '',
724 my $txn = $args{'Transaction'};
725 my $ticket = $args{'Ticket'};
726 $ticket ||= $txn->Object if $txn;
728 my $entity = $args{'Entity'};
731 $RT::Logger->error(Carp::longmess("No entity provided"));
732 return (0, $ticket->loc("Couldn't send email"));
735 my ($template, $msg) = PrepareEmailUsingTemplate(
736 Template => $args{'Template'},
745 $mail = $template->MIMEObj;
747 $RT::Logger->warning($msg);
750 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
753 unless ( $args{'Transaction'} ) {
754 $description = 'This is forward of ticket #'. $ticket->id;
756 $description = 'This is forward of transaction #'
757 . $txn->id ." of a ticket #". $txn->ObjectId;
759 $mail = MIME::Entity->build(
760 Type => 'text/plain',
761 Data => $description,
765 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
766 foreach grep defined $args{$_}, qw(To Cc Bcc);
768 $mail->make_multipart unless $mail->is_multipart;
769 $mail->add_part( $entity );
772 unless (defined $mail->head->get('Subject')) {
774 $subject = $txn->Subject if $txn;
775 $subject ||= $ticket->Subject if $ticket;
777 unless ( RT->Config->Get('ForwardFromUser') ) {
778 # XXX: what if want to forward txn of other object than ticket?
779 $subject = AddSubjectTag( $subject, $ticket );
782 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
786 From => EncodeToMIME(
787 String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
791 my $status = RT->Config->Get('ForwardFromUser')
792 # never sign if we forward from User
793 ? SendEmail( %args, Entity => $mail, Sign => 0 )
794 : SendEmail( %args, Entity => $mail );
795 return (0, $ticket->loc("Couldn't send email")) unless $status;
796 return (1, $ticket->loc("Sent email successfully"));
799 =head2 GetForwardFrom Ticket => undef, Transaction => undef
801 Resolve the From field to use in forward mail
806 my %args = ( Ticket => undef, Transaction => undef, @_ );
807 my $txn = $args{Transaction};
808 my $ticket = $args{Ticket} || $txn->Object;
810 if ( RT->Config->Get('ForwardFromUser') ) {
811 return ( $txn || $ticket )->CurrentUser->EmailAddress;
814 return $ticket->QueueObj->CorrespondAddress
815 || RT->Config->Get('CorrespondAddress');
819 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
821 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
822 handle errors with users' keys.
824 If a recipient has no key or has other problems with it, then the
825 unction sends a error to him using 'Error: public key' template.
826 Also, notifies RT's owner using template 'Error to RT owner: public key'
827 to inform that there are problems with users' keys. Then we filter
828 all bad recipients and retry.
830 Returns 1 on success, 0 on error and -1 if all recipients are bad and
831 had been filtered out.
842 return 1 unless $args{'Sign'} || $args{'Encrypt'};
844 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
847 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
848 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
850 require RT::Crypt::GnuPG;
851 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
852 return 1 unless $res{'exit_code'};
854 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
857 foreach my $line ( @status ) {
858 # if the passphrase fails, either you have a bad passphrase
859 # or gpg-agent has died. That should get caught in Create and
860 # Update, but at least throw an error here
861 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
862 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
863 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
866 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
867 next if $line->{'Status'} eq 'DONE';
868 $RT::Logger->error( $line->{'Message'} );
869 push @bad_recipients, $line;
871 return 0 unless @bad_recipients;
873 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
874 foreach @bad_recipients;
876 foreach my $recipient ( @bad_recipients ) {
877 my $status = SendEmailUsingTemplate(
878 To => $recipient->{'AddressObj'}->address,
879 Template => 'Error: public key',
882 TicketObj => $args{'Ticket'},
883 TransactionObj => $args{'Transaction'},
887 $RT::Logger->error("Couldn't send 'Error: public key'");
891 my $status = SendEmailUsingTemplate(
892 To => RT->Config->Get('OwnerEmail'),
893 Template => 'Error to RT owner: public key',
895 BadRecipients => \@bad_recipients,
896 TicketObj => $args{'Ticket'},
897 TransactionObj => $args{'Transaction'},
901 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
904 DeleteRecipientsFromHead(
905 $args{'Entity'}->head,
906 map $_->{'AddressObj'}->address, @bad_recipients
909 unless ( $args{'Entity'}->head->get('To')
910 || $args{'Entity'}->head->get('Cc')
911 || $args{'Entity'}->head->get('Bcc') )
913 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
917 # redo without broken recipients
918 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
919 return 0 if $res{'exit_code'};
928 Takes a hash with a String and a Charset. Returns the string encoded
929 according to RFC2047, using B (base64 based) encoding.
931 String must be a perl string, octets are returned.
933 If Charset is not provided then $EmailOutputEncoding config option
934 is used, or "latin-1" if that is not set.
944 my $value = $args{'String'};
945 return $value unless $value; # 0 is perfect ascii
946 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
949 # using RFC2047 notation, sec 2.
950 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
952 # An 'encoded-word' may not be more than 75 characters long
954 # MIME encoding increases 4/3*(number of bytes), and always in multiples
955 # of 4. Thus we have to find the best available value of bytes available
958 # First we get the integer max which max*4/3 would fit on space.
959 # Then we find the greater multiple of 3 lower or equal than $max.
961 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
965 $max = int( $max / 3 ) * 3;
972 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
976 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
980 # we need perl string to split thing char by char
981 Encode::_utf8_on($value) unless Encode::is_utf8($value);
983 my ( $tmp, @chunks ) = ( '', () );
984 while ( length $value ) {
985 my $char = substr( $value, 0, 1, '' );
986 my $octets = Encode::encode( $charset, $char );
987 if ( length($tmp) + length($octets) > $max ) {
993 push @chunks, $tmp if length $tmp;
995 # encode an join chuncks
997 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
1003 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
1005 my $NewUser = RT::User->new( RT->SystemUser );
1007 my ( $Val, $Message ) = $NewUser->Create(
1008 Name => ( $Username || $Address ),
1009 EmailAddress => $Address,
1013 Comments => 'Autocreated on ticket submission',
1018 # Deal with the race condition of two account creations at once
1020 $NewUser->LoadByName($Username);
1023 unless ( $NewUser->Id ) {
1024 $NewUser->LoadByEmail($Address);
1027 unless ( $NewUser->Id ) {
1030 Subject => "User could not be created",
1032 "User creation failed in mailgateway: $Message",
1039 #Load the new user object
1040 my $CurrentUser = RT::CurrentUser->new;
1041 $CurrentUser->LoadByEmail( $Address );
1043 unless ( $CurrentUser->id ) {
1044 $RT::Logger->warning(
1045 "Couldn't load user '$Address'." . "giving up" );
1048 Subject => "User could not be loaded",
1050 "User '$Address' could not be loaded in the mail gateway",
1056 return $CurrentUser;
1061 =head2 ParseCcAddressesFromHead HASH
1063 Takes a hash containing QueueObj, Head and CurrentUser objects.
1064 Returns a list of all email addresses in the To and Cc
1065 headers b<except> the current Queue's email addresses, the CurrentUser's
1066 email address and anything that the configuration sub RT::IsRTAddress matches.
1070 sub ParseCcAddressesFromHead {
1074 CurrentUser => undef,
1078 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1079 my $user = $args{'CurrentUser'}->UserObj;
1082 grep { $_ ne $current_address
1083 && !RT::EmailParser->IsRTAddress( $_ )
1084 && !IgnoreCcAddress( $_ )
1086 map lc $user->CanonicalizeEmailAddress( $_->address ),
1087 map Email::Address->parse( $args{'Head'}->get( $_ ) ),
1091 =head2 IgnoreCcAddress ADDRESS
1093 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1097 sub IgnoreCcAddress {
1098 my $address = shift;
1099 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1100 return 1 if $address =~ /$address_re/i;
1105 =head2 ParseSenderAddressFromHead HEAD
1107 Takes a MIME::Header object. Returns (user@host, friendly name, errors)
1108 where the first two values are the From (evaluated in order of
1109 Reply-To:, From:, Sender).
1111 A list of error messages may be returned even when a Sender value is
1112 found, since it could be a parse error for another (checked earlier)
1113 sender field. In this case, the errors aren't fatal, but may be useful
1114 to investigate the parse failure.
1118 sub ParseSenderAddressFromHead {
1120 my @sender_headers = ('Reply-To', 'From', 'Sender');
1121 my @errors; # Accumulate any errors
1123 #Figure out who's sending this message.
1124 foreach my $header ( @sender_headers ) {
1125 my $addr_line = $head->get($header) || next;
1126 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1127 # only return if the address is not empty
1128 return ($addr, $name, @errors) if $addr;
1131 push @errors, "$header: $addr_line";
1134 return (undef, undef, @errors);
1137 =head2 ParseErrorsToAddressFromHead HEAD
1139 Takes a MIME::Header object. Return a single value : user@host
1140 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1145 sub ParseErrorsToAddressFromHead {
1148 #Figure out who's sending this message.
1150 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1152 # If there's a header of that name
1153 my $headerobj = $head->get($header);
1155 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1157 # If it's got actual useful content...
1158 return ($addr) if ($addr);
1165 =head2 ParseAddressFromHeader ADDRESS
1167 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1171 sub ParseAddressFromHeader {
1174 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1175 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1176 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1178 my ($AddrObj) = grep ref $_, @Addresses;
1179 unless ( $AddrObj ) {
1180 return ( undef, undef );
1183 return ( $AddrObj->address, $AddrObj->phrase );
1186 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1188 Gets a head object and list of addresses.
1189 Deletes addresses from To, Cc or Bcc fields.
1193 sub DeleteRecipientsFromHead {
1195 my %skip = map { lc $_ => 1 } @_;
1197 foreach my $field ( qw(To Cc Bcc) ) {
1198 $head->set( $field =>
1199 join ', ', map $_->format, grep !$skip{ lc $_->address },
1200 Email::Address->parse( $head->get( $field ) )
1209 ScripAction => undef,
1212 my $org = RT->Config->Get('Organization');
1213 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1214 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1215 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1217 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1218 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1228 return unless $args{'Message'} && $args{'InReplyTo'};
1230 my $get_header = sub {
1232 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1233 @res = $args{'InReplyTo'}->head->get( shift );
1235 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1237 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1240 my @id = $get_header->('Message-ID');
1241 #XXX: custom header should begin with X- otherwise is violation of the standard
1242 my @rtid = $get_header->('RT-Message-ID');
1243 my @references = $get_header->('References');
1244 unless ( @references ) {
1245 @references = $get_header->('In-Reply-To');
1247 push @references, @id, @rtid;
1248 if ( $args{'Ticket'} ) {
1249 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1250 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1252 @references = splice @references, 4, -6
1253 if @references > 10;
1255 my $mail = $args{'Message'};
1256 $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
1257 $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) );
1260 sub ExtractTicketId {
1263 my $subject = $entity->head->get('Subject') || '';
1265 return ParseTicketId( $subject );
1269 my $Subject = shift;
1271 my $rtname = RT->Config->Get('rtname');
1272 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1275 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1278 foreach my $tag ( RT->System->SubjectTag ) {
1279 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1284 return undef unless $id;
1286 $RT::Logger->debug("Found a ticket ID. It's $id");
1291 my $subject = shift;
1293 unless ( ref $ticket ) {
1294 my $tmp = RT::Ticket->new( RT->SystemUser );
1295 $tmp->Load( $ticket );
1298 my $id = $ticket->id;
1299 my $queue_tag = $ticket->QueueObj->SubjectTag;
1301 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1302 unless ( $tag_re ) {
1303 my $tag = $queue_tag || RT->Config->Get('rtname');
1304 $tag_re = qr/\Q$tag\E/;
1305 } elsif ( $queue_tag ) {
1306 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1308 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1310 $subject =~ s/(\r\n|\n|\s)/ /g;
1312 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1316 =head2 Gateway ARGSREF
1326 This performs all the "guts" of the mail rt-mailgate program, and is
1327 designed to be called from the web interface with a message, user
1330 Can also take an optional 'ticket' parameter; this ticket id overrides
1331 any ticket id found in the subject.
1337 (status code, message, optional ticket object)
1339 status code is a numeric value.
1341 for temporary failures, the status code should be -75
1343 for permanent failures which are handled by RT, the status code
1346 for succces, the status code should be 1
1353 my @mail_plugins = @_;
1356 foreach my $plugin (@mail_plugins) {
1357 if ( ref($plugin) eq "CODE" ) {
1359 } elsif ( !ref $plugin ) {
1360 my $Class = $plugin;
1361 $Class = "RT::Interface::Email::" . $Class
1362 unless $Class =~ /^RT::/;
1364 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1367 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1368 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1373 $RT::Logger->crit( "$plugin - is not class name or code reference");
1380 my $argsref = shift;
1382 action => 'correspond',
1392 # Validate the action
1393 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1397 "Invalid 'action' parameter "
1405 my $parser = RT::EmailParser->new();
1406 $parser->SmartParseMIMEEntityFromScalar(
1407 Message => $args{'message'},
1412 my $Message = $parser->Entity();
1415 Subject => "RT Bounce: Unparseable message",
1416 Explanation => "RT couldn't process the message below",
1417 Attach => $args{'message'}
1421 "Failed to parse this message. Something is likely badly wrong with the message"
1425 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1426 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1427 @mail_plugins = _LoadPlugins( @mail_plugins );
1430 foreach my $class( grep !ref, @mail_plugins ) {
1431 # check if we should apply filter before decoding
1434 *{ $class . "::ApplyBeforeDecode" }{CODE};
1436 next unless defined $check_cb;
1437 next unless $check_cb->(
1438 Message => $Message,
1439 RawMessageRef => \$args{'message'},
1442 $skip_plugin{ $class }++;
1446 *{ $class . "::GetCurrentUser" }{CODE};
1448 my ($status, $msg) = $Code->(
1449 Message => $Message,
1450 RawMessageRef => \$args{'message'},
1452 next if $status > 0;
1454 if ( $status == -2 ) {
1455 return (1, $msg, undef);
1456 } elsif ( $status == -1 ) {
1457 return (0, $msg, undef);
1460 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1461 $parser->_DecodeBodies;
1462 $parser->RescueOutlook;
1463 $parser->_PostProcessNewEntity;
1465 my $head = $Message->head;
1466 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1468 my $MessageId = $head->get('Message-ID')
1469 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1471 #Pull apart the subject line
1472 my $Subject = $head->get('Subject') || '';
1475 # Lets check for mail loops of various sorts.
1476 my ($should_store_machine_generated_message, $IsALoop, $result);
1477 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1478 _HandleMachineGeneratedMail(
1479 Message => $Message,
1480 ErrorsTo => $ErrorsTo,
1481 Subject => $Subject,
1482 MessageId => $MessageId
1485 # Do not pass loop messages to MailPlugins, to make sure the loop
1486 # is broken, unless $RT::StoreLoops is set.
1487 if ($IsALoop && !$should_store_machine_generated_message) {
1488 return ( 0, $result, undef );
1492 $args{'ticket'} ||= ExtractTicketId( $Message );
1494 # ExtractTicketId may have been overridden, and edited the Subject
1495 my $NewSubject = $Message->head->get('Subject');
1498 $SystemTicket = RT::Ticket->new( RT->SystemUser );
1499 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1500 if ( $SystemTicket->id ) {
1501 $Right = 'ReplyToTicket';
1503 $Right = 'CreateTicket';
1506 #Set up a queue object
1507 my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
1508 $SystemQueueObj->Load( $args{'queue'} );
1510 # We can safely have no queue of we have a known-good ticket
1511 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1512 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1515 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1516 MailPlugins => \@mail_plugins,
1517 Actions => \@actions,
1518 Message => $Message,
1519 RawMessageRef => \$args{message},
1520 SystemTicket => $SystemTicket,
1521 SystemQueue => $SystemQueueObj,
1524 # If authentication fails and no new user was created, get out.
1525 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1527 # If the plugins refused to create one, they lose.
1528 unless ( $AuthStat == -1 ) {
1529 _NoAuthorizedUserFound(
1531 Message => $Message,
1532 Requestor => $ErrorsTo,
1533 Queue => $args{'queue'}
1537 return ( 0, "Could not load a valid user", undef );
1540 # If we got a user, but they don't have the right to say things
1541 if ( $AuthStat == 0 ) {
1544 Subject => "Permission Denied",
1546 "You do not have permission to communicate with RT",
1551 "$ErrorsTo tried to submit a message to "
1553 . " without permission.",
1559 unless ($should_store_machine_generated_message) {
1560 return ( 0, $result, undef );
1563 # if plugin's updated SystemTicket then update arguments
1564 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1566 my $Ticket = RT::Ticket->new($CurrentUser);
1568 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1572 my @Requestors = ( $CurrentUser->id );
1574 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1575 @Cc = ParseCcAddressesFromHead(
1577 CurrentUser => $CurrentUser,
1578 QueueObj => $SystemQueueObj
1582 $head->replace('X-RT-Interface' => 'Email');
1584 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1585 Queue => $SystemQueueObj->Id,
1586 Subject => $NewSubject,
1587 Requestor => \@Requestors,
1594 Subject => "Ticket creation failed: $Subject",
1595 Explanation => $ErrStr,
1598 return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
1601 # strip comments&corresponds from the actions we don't need
1602 # to record them if we've created the ticket just now
1603 @actions = grep !/^(comment|correspond)$/, @actions;
1604 $args{'ticket'} = $id;
1606 } elsif ( $args{'ticket'} ) {
1608 $Ticket->Load( $args{'ticket'} );
1609 unless ( $Ticket->Id ) {
1610 my $error = "Could not find a ticket with id " . $args{'ticket'};
1613 Subject => "Message not recorded: $Subject",
1614 Explanation => $error,
1618 return ( 0, $error );
1620 $args{'ticket'} = $Ticket->id;
1622 return ( 1, "Success", $Ticket );
1627 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1628 foreach my $action (@actions) {
1630 # If the action is comment, add a comment.
1631 if ( $action =~ /^(?:comment|correspond)$/i ) {
1632 my $method = ucfirst lc $action;
1633 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1636 #Warn the sender that we couldn't actually submit the comment.
1639 Subject => "Message not recorded ($method): $Subject",
1640 Explanation => $msg,
1643 return ( 0, "Message not recorded: $msg", $Ticket );
1645 } elsif ($unsafe_actions) {
1646 my ( $status, $msg ) = _RunUnsafeAction(
1648 ErrorsTo => $ErrorsTo,
1649 Message => $Message,
1651 CurrentUser => $CurrentUser,
1653 return ($status, $msg, $Ticket) unless $status == 1;
1656 return ( 1, "Success", $Ticket );
1659 =head2 GetAuthenticationLevel
1661 # Authentication Level
1662 # -1 - Get out. this user has been explicitly declined
1663 # 0 - User may not do anything (Not used at the moment)
1665 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1669 sub GetAuthenticationLevel {
1674 RawMessageRef => undef,
1675 SystemTicket => undef,
1676 SystemQueue => undef,
1680 my ( $CurrentUser, $AuthStat, $error );
1682 # Initalize AuthStat so comparisons work correctly
1683 $AuthStat = -9999999;
1685 # if plugin returns AuthStat -2 we skip action
1686 # NOTE: this is experimental API and it would be changed
1687 my %skip_action = ();
1689 # Since this needs loading, no matter what
1690 foreach (@{ $args{MailPlugins} }) {
1691 my ($Code, $NewAuthStat);
1692 if ( ref($_) eq "CODE" ) {
1696 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1699 foreach my $action (@{ $args{Actions} }) {
1700 ( $CurrentUser, $NewAuthStat ) = $Code->(
1701 Message => $args{Message},
1702 RawMessageRef => $args{RawMessageRef},
1703 CurrentUser => $CurrentUser,
1704 AuthLevel => $AuthStat,
1706 Ticket => $args{SystemTicket},
1707 Queue => $args{SystemQueue},
1710 # You get the highest level of authentication you were assigned, unless you get the magic -1
1711 # If a module returns a "-1" then we discard the ticket, so.
1712 $AuthStat = $NewAuthStat
1713 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1715 last if $AuthStat == -1;
1716 $skip_action{$action}++ if $AuthStat == -2;
1719 # strip actions we should skip
1720 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1722 last unless @{$args{Actions}};
1724 last if $AuthStat == -1;
1727 return $AuthStat if !wantarray;
1729 return ($AuthStat, $CurrentUser, $error);
1732 sub _RunUnsafeAction {
1738 CurrentUser => undef,
1742 if ( $args{'Action'} =~ /^take$/i ) {
1743 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1746 To => $args{'ErrorsTo'},
1747 Subject => "Ticket not taken",
1748 Explanation => $msg,
1749 MIMEObj => $args{'Message'}
1751 return ( 0, "Ticket not taken" );
1753 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1754 my $new_status = $args{'Ticket'}->FirstInactiveStatus;
1756 my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status);
1759 #Warn the sender that we couldn't actually submit the comment.
1761 To => $args{'ErrorsTo'},
1762 Subject => "Ticket not resolved",
1763 Explanation => $msg,
1764 MIMEObj => $args{'Message'}
1766 return ( 0, "Ticket not resolved" );
1770 return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
1772 return ( 1, "Success" );
1775 =head2 _NoAuthorizedUserFound
1777 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1781 sub _NoAuthorizedUserFound {
1790 # Notify the RT Admin of the failure.
1792 To => RT->Config->Get('OwnerEmail'),
1793 Subject => "Could not load a valid user",
1794 Explanation => <<EOT,
1795 RT could not load a valid user, and RT's configuration does not allow
1796 for the creation of a new user for this email (@{[$args{Requestor}]}).
1798 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1799 queue @{[$args{'Queue'}]}.
1802 MIMEObj => $args{'Message'},
1806 # Also notify the requestor that his request has been dropped.
1807 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1809 To => $args{'Requestor'},
1810 Subject => "Could not load a valid user",
1811 Explanation => <<EOT,
1812 RT could not load a valid user, and RT's configuration does not allow
1813 for the creation of a new user for your email.
1816 MIMEObj => $args{'Message'},
1822 =head2 _HandleMachineGeneratedMail
1829 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1830 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1831 "This message appears to be a loop (boolean)" );
1835 sub _HandleMachineGeneratedMail {
1836 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1837 my $head = $args{'Message'}->head;
1838 my $ErrorsTo = $args{'ErrorsTo'};
1840 my $IsBounce = CheckForBounce($head);
1842 my $IsAutoGenerated = CheckForAutoGenerated($head);
1844 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1846 my $IsALoop = CheckForLoops($head);
1848 my $SquelchReplies = 0;
1850 my $owner_mail = RT->Config->Get('OwnerEmail');
1852 #If the message is autogenerated, we need to know, so we can not
1853 # send mail to the sender
1854 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1855 $SquelchReplies = 1;
1856 $ErrorsTo = $owner_mail;
1859 # Warn someone if it's a loop, before we drop it on the ground
1861 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1863 #Should we mail it to RTOwner?
1864 if ( RT->Config->Get('LoopsToRTOwner') ) {
1867 Subject => "RT Bounce: ".$args{'Subject'},
1868 Explanation => "RT thinks this message may be a bounce",
1869 MIMEObj => $args{Message}
1873 #Do we actually want to store it?
1874 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1875 unless RT->Config->Get('StoreLoops');
1878 # Squelch replies if necessary
1879 # Don't let the user stuff the RT-Squelch-Replies-To header.
1880 if ( $head->get('RT-Squelch-Replies-To') ) {
1882 'RT-Relocated-Squelch-Replies-To',
1883 $head->get('RT-Squelch-Replies-To')
1885 $head->delete('RT-Squelch-Replies-To');
1888 if ($SquelchReplies) {
1890 # Squelch replies to the sender, and also leave a clue to
1891 # allow us to squelch ALL outbound messages. This way we
1892 # can punt the logic of "what to do when we get a bounce"
1893 # to the scrip. We might want to notify nobody. Or just
1894 # the RT Owner. Or maybe all Privileged watchers.
1895 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1896 $head->replace( 'RT-Squelch-Replies-To', $Sender );
1897 $head->replace( 'RT-DetectedAutoGenerated', 'true' );
1899 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1902 =head2 IsCorrectAction
1904 Returns a list of valid actions we've found for this message
1908 sub IsCorrectAction {
1910 my @actions = grep $_, split /-/, $action;
1911 return ( 0, '(no value)' ) unless @actions;
1912 foreach ( @actions ) {
1913 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1915 return ( 1, @actions );
1918 sub _RecordSendEmailFailure {
1921 $ticket->_RecordNote(
1922 NoteType => 'SystemError',
1923 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1928 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1933 RT::Base->_ImportOverlays();