1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2014 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 ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) {
435 my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef;
436 my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {};
439 my $QueueName = $TicketObj->QueueObj->Name;
440 my $QueueAddressOverride = $Overrides->{$QueueName};
442 if ($QueueAddressOverride) {
443 $OutgoingMailAddress = $QueueAddressOverride;
445 $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress
446 || RT->Config->Get('CorrespondAddress');
449 elsif ($Overrides->{'Default'}) {
450 $OutgoingMailAddress = $Overrides->{'Default'};
453 push @args, "-f", $OutgoingMailAddress
454 if $OutgoingMailAddress;
458 if ( $TransactionObj and
459 my $prefix = RT->Config->Get('VERPPrefix') and
460 my $domain = RT->Config->Get('VERPDomain') )
462 my $from = $TransactionObj->CreatorObj->EmailAddress;
465 push @args, "-f", "$prefix$from\@$domain";
469 # don't ignore CHLD signal to get proper exit code
470 local $SIG{'CHLD'} = 'DEFAULT';
472 # if something wrong with $mail->print we will get PIPE signal, handle it
473 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
477 my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
478 or die "couldn't execute program: $!";
480 $args{'Entity'}->print($mail);
481 close $mail or die "close pipe failed: $!";
485 # sendmail exit statuses mostly errors with data not software
486 # TODO: status parsing: core dump, exit on signal or EX_*
487 my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
488 $msg = ", interrupted by signal ". ($?&127) if $?&127;
489 $RT::Logger->error( $msg );
494 $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
496 _RecordSendEmailFailure( $TicketObj );
501 elsif ( $mail_command eq 'smtp' ) {
503 my $smtp = do { local $@; eval { Net::SMTP->new(
504 Host => RT->Config->Get('SMTPServer'),
505 Debug => RT->Config->Get('SMTPDebug'),
508 $RT::Logger->crit( "Could not connect to SMTP server.");
510 _RecordSendEmailFailure( $TicketObj );
515 # duplicate head as we want drop Bcc field
516 my $head = $args{'Entity'}->head->dup;
517 my @recipients = map $_->address, map
518 Email::Address->parse($head->get($_)), qw(To Cc Bcc);
519 $head->delete('Bcc');
521 my $sender = RT->Config->Get('SMTPFrom')
522 || $args{'Entity'}->head->get('From');
525 my $status = $smtp->mail( $sender )
526 && $smtp->recipient( @recipients );
530 my $fh = $smtp->tied_fh;
533 $args{'Entity'}->print_body( $fh );
539 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
541 _RecordSendEmailFailure( $TicketObj );
547 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
549 my @mailer_args = ($mail_command);
550 if ( $mail_command eq 'sendmail' ) {
551 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
552 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
555 push @mailer_args, RT->Config->Get('MailParams');
558 unless ( $args{'Entity'}->send( @mailer_args ) ) {
559 $RT::Logger->crit( "$msgid: Could not send mail." );
561 _RecordSendEmailFailure( $TicketObj );
569 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
571 Loads a template. Parses it using arguments if it's not empty.
572 Returns a tuple (L<RT::Template> object, error message).
574 Note that even if a template object is returned MIMEObj method
575 may return undef for empty templates.
579 sub PrepareEmailUsingTemplate {
586 my $template = RT::Template->new( RT->SystemUser );
587 $template->LoadGlobalTemplate( $args{'Template'} );
588 unless ( $template->id ) {
589 return (undef, "Couldn't load template '". $args{'Template'} ."'");
591 return $template if $template->IsEmpty;
593 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
594 return (undef, $msg) unless $status;
599 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
601 Sends email using a template, takes name of template, arguments for it and recipients.
605 sub SendEmailUsingTemplate {
612 From => RT->Config->Get('CorrespondAddress'),
618 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
619 return (0, $msg) unless $template;
621 my $mail = $template->MIMEObj;
623 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
627 $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
628 foreach grep defined $args{$_}, qw(To Cc Bcc From);
630 $mail->head->set( $_ => $args{ExtraHeaders}{$_} )
631 foreach keys %{ $args{ExtraHeaders} };
633 SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
635 return SendEmail( Entity => $mail );
638 =head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
640 Forwards transaction with all attachments as 'message/rfc822'.
644 sub ForwardTransaction {
646 my %args = ( To => '', Cc => '', Bcc => '', @_ );
648 my $entity = $txn->ContentAsMIME;
650 my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
652 my $ticket = $txn->TicketObj;
653 my ( $ret, $msg ) = $ticket->_NewTransaction(
654 Type => 'Forward Transaction',
656 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
659 $RT::Logger->error("Failed to create transaction: $msg");
662 return ( $ret, $msg );
665 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
667 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
673 my %args = ( To => '', Cc => '', Bcc => '', @_ );
675 my $txns = $ticket->Transactions;
679 ) for qw(Create Correspond);
681 my $entity = MIME::Entity->build(
682 Type => 'multipart/mixed',
683 Description => 'forwarded ticket',
685 $entity->add_part( $_ ) foreach
686 map $_->ContentAsMIME,
687 @{ $txns->ItemsArrayRef };
689 my ( $ret, $msg ) = SendForward(
693 Template => 'Forward Ticket',
697 my ( $ret, $msg ) = $ticket->_NewTransaction(
698 Type => 'Forward Ticket',
699 Field => $ticket->id,
700 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
703 $RT::Logger->error("Failed to create transaction: $msg");
707 return ( $ret, $msg );
711 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
713 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
721 Transaction => undef,
722 Template => 'Forward',
723 To => '', Cc => '', Bcc => '',
727 my $txn = $args{'Transaction'};
728 my $ticket = $args{'Ticket'};
729 $ticket ||= $txn->Object if $txn;
731 my $entity = $args{'Entity'};
734 $RT::Logger->error(Carp::longmess("No entity provided"));
735 return (0, $ticket->loc("Couldn't send email"));
738 my ($template, $msg) = PrepareEmailUsingTemplate(
739 Template => $args{'Template'},
748 $mail = $template->MIMEObj;
750 $RT::Logger->warning($msg);
753 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
756 unless ( $args{'Transaction'} ) {
757 $description = 'This is forward of ticket #'. $ticket->id;
759 $description = 'This is forward of transaction #'
760 . $txn->id ." of a ticket #". $txn->ObjectId;
762 $mail = MIME::Entity->build(
763 Type => 'text/plain',
764 Data => $description,
768 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
769 foreach grep defined $args{$_}, qw(To Cc Bcc);
771 $mail->make_multipart unless $mail->is_multipart;
772 $mail->add_part( $entity );
775 unless (defined $mail->head->get('Subject')) {
777 $subject = $txn->Subject if $txn;
778 $subject ||= $ticket->Subject if $ticket;
780 unless ( RT->Config->Get('ForwardFromUser') ) {
781 # XXX: what if want to forward txn of other object than ticket?
782 $subject = AddSubjectTag( $subject, $ticket );
785 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
789 From => EncodeToMIME(
790 String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
794 my $status = RT->Config->Get('ForwardFromUser')
795 # never sign if we forward from User
796 ? SendEmail( %args, Entity => $mail, Sign => 0 )
797 : SendEmail( %args, Entity => $mail );
798 return (0, $ticket->loc("Couldn't send email")) unless $status;
799 return (1, $ticket->loc("Sent email successfully"));
802 =head2 GetForwardFrom Ticket => undef, Transaction => undef
804 Resolve the From field to use in forward mail
809 my %args = ( Ticket => undef, Transaction => undef, @_ );
810 my $txn = $args{Transaction};
811 my $ticket = $args{Ticket} || $txn->Object;
813 if ( RT->Config->Get('ForwardFromUser') ) {
814 return ( $txn || $ticket )->CurrentUser->EmailAddress;
817 return $ticket->QueueObj->CorrespondAddress
818 || RT->Config->Get('CorrespondAddress');
822 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
824 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
825 handle errors with users' keys.
827 If a recipient has no key or has other problems with it, then the
828 unction sends a error to him using 'Error: public key' template.
829 Also, notifies RT's owner using template 'Error to RT owner: public key'
830 to inform that there are problems with users' keys. Then we filter
831 all bad recipients and retry.
833 Returns 1 on success, 0 on error and -1 if all recipients are bad and
834 had been filtered out.
845 return 1 unless $args{'Sign'} || $args{'Encrypt'};
847 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
850 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
851 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
853 require RT::Crypt::GnuPG;
854 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
855 return 1 unless $res{'exit_code'};
857 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
860 foreach my $line ( @status ) {
861 # if the passphrase fails, either you have a bad passphrase
862 # or gpg-agent has died. That should get caught in Create and
863 # Update, but at least throw an error here
864 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
865 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
866 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
869 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
870 next if $line->{'Status'} eq 'DONE';
871 $RT::Logger->error( $line->{'Message'} );
872 push @bad_recipients, $line;
874 return 0 unless @bad_recipients;
876 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
877 foreach @bad_recipients;
879 foreach my $recipient ( @bad_recipients ) {
880 my $status = SendEmailUsingTemplate(
881 To => $recipient->{'AddressObj'}->address,
882 Template => 'Error: public key',
885 TicketObj => $args{'Ticket'},
886 TransactionObj => $args{'Transaction'},
890 $RT::Logger->error("Couldn't send 'Error: public key'");
894 my $status = SendEmailUsingTemplate(
895 To => RT->Config->Get('OwnerEmail'),
896 Template => 'Error to RT owner: public key',
898 BadRecipients => \@bad_recipients,
899 TicketObj => $args{'Ticket'},
900 TransactionObj => $args{'Transaction'},
904 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
907 DeleteRecipientsFromHead(
908 $args{'Entity'}->head,
909 map $_->{'AddressObj'}->address, @bad_recipients
912 unless ( $args{'Entity'}->head->get('To')
913 || $args{'Entity'}->head->get('Cc')
914 || $args{'Entity'}->head->get('Bcc') )
916 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
920 # redo without broken recipients
921 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
922 return 0 if $res{'exit_code'};
931 Takes a hash with a String and a Charset. Returns the string encoded
932 according to RFC2047, using B (base64 based) encoding.
934 String must be a perl string, octets are returned.
936 If Charset is not provided then $EmailOutputEncoding config option
937 is used, or "latin-1" if that is not set.
947 my $value = $args{'String'};
948 return $value unless $value; # 0 is perfect ascii
949 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
952 # using RFC2047 notation, sec 2.
953 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
955 # An 'encoded-word' may not be more than 75 characters long
957 # MIME encoding increases 4/3*(number of bytes), and always in multiples
958 # of 4. Thus we have to find the best available value of bytes available
961 # First we get the integer max which max*4/3 would fit on space.
962 # Then we find the greater multiple of 3 lower or equal than $max.
964 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
968 $max = int( $max / 3 ) * 3;
975 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
979 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
983 # we need perl string to split thing char by char
984 Encode::_utf8_on($value) unless Encode::is_utf8($value);
986 my ( $tmp, @chunks ) = ( '', () );
987 while ( length $value ) {
988 my $char = substr( $value, 0, 1, '' );
989 my $octets = Encode::encode( $charset, $char );
990 if ( length($tmp) + length($octets) > $max ) {
996 push @chunks, $tmp if length $tmp;
998 # encode an join chuncks
1000 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
1006 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
1008 my $NewUser = RT::User->new( RT->SystemUser );
1010 my ( $Val, $Message ) = $NewUser->Create(
1011 Name => ( $Username || $Address ),
1012 EmailAddress => $Address,
1016 Comments => 'Autocreated on ticket submission',
1021 # Deal with the race condition of two account creations at once
1023 $NewUser->LoadByName($Username);
1026 unless ( $NewUser->Id ) {
1027 $NewUser->LoadByEmail($Address);
1030 unless ( $NewUser->Id ) {
1033 Subject => "User could not be created",
1035 "User creation failed in mailgateway: $Message",
1042 #Load the new user object
1043 my $CurrentUser = RT::CurrentUser->new;
1044 $CurrentUser->LoadByEmail( $Address );
1046 unless ( $CurrentUser->id ) {
1047 $RT::Logger->warning(
1048 "Couldn't load user '$Address'." . "giving up" );
1051 Subject => "User could not be loaded",
1053 "User '$Address' could not be loaded in the mail gateway",
1059 return $CurrentUser;
1064 =head2 ParseCcAddressesFromHead HASH
1066 Takes a hash containing QueueObj, Head and CurrentUser objects.
1067 Returns a list of all email addresses in the To and Cc
1068 headers b<except> the current Queue's email addresses, the CurrentUser's
1069 email address and anything that the configuration sub RT::IsRTAddress matches.
1073 sub ParseCcAddressesFromHead {
1077 CurrentUser => undef,
1081 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1082 my $user = $args{'CurrentUser'}->UserObj;
1085 grep { $_ ne $current_address
1086 && !RT::EmailParser->IsRTAddress( $_ )
1087 && !IgnoreCcAddress( $_ )
1089 map lc $user->CanonicalizeEmailAddress( $_->address ),
1090 map RT::EmailParser->CleanupAddresses( Email::Address->parse( $args{'Head'}->get( $_ ) ) ),
1094 =head2 IgnoreCcAddress ADDRESS
1096 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1100 sub IgnoreCcAddress {
1101 my $address = shift;
1102 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1103 return 1 if $address =~ /$address_re/i;
1108 =head2 ParseSenderAddressFromHead HEAD
1110 Takes a MIME::Header object. Returns (user@host, friendly name, errors)
1111 where the first two values are the From (evaluated in order of
1112 Reply-To:, From:, Sender).
1114 A list of error messages may be returned even when a Sender value is
1115 found, since it could be a parse error for another (checked earlier)
1116 sender field. In this case, the errors aren't fatal, but may be useful
1117 to investigate the parse failure.
1121 sub ParseSenderAddressFromHead {
1123 my @sender_headers = ('Reply-To', 'From', 'Sender');
1124 my @errors; # Accumulate any errors
1126 #Figure out who's sending this message.
1127 foreach my $header ( @sender_headers ) {
1128 my $addr_line = $head->get($header) || next;
1129 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1130 # only return if the address is not empty
1131 return ($addr, $name, @errors) if $addr;
1134 push @errors, "$header: $addr_line";
1137 return (undef, undef, @errors);
1140 =head2 ParseErrorsToAddressFromHead HEAD
1142 Takes a MIME::Header object. Return a single value : user@host
1143 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1148 sub ParseErrorsToAddressFromHead {
1151 #Figure out who's sending this message.
1153 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1155 # If there's a header of that name
1156 my $headerobj = $head->get($header);
1158 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1160 # If it's got actual useful content...
1161 return ($addr) if ($addr);
1168 =head2 ParseAddressFromHeader ADDRESS
1170 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1174 sub ParseAddressFromHeader {
1177 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1178 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1179 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1181 my ($AddrObj) = grep ref $_, @Addresses;
1182 unless ( $AddrObj ) {
1183 return ( undef, undef );
1186 return ( $AddrObj->address, $AddrObj->phrase );
1189 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1191 Gets a head object and list of addresses.
1192 Deletes addresses from To, Cc or Bcc fields.
1196 sub DeleteRecipientsFromHead {
1198 my %skip = map { lc $_ => 1 } @_;
1200 foreach my $field ( qw(To Cc Bcc) ) {
1201 $head->set( $field =>
1202 join ', ', map $_->format, grep !$skip{ lc $_->address },
1203 Email::Address->parse( $head->get( $field ) )
1212 ScripAction => undef,
1215 my $org = RT->Config->Get('Organization');
1216 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1217 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1218 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1220 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1221 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1231 return unless $args{'Message'} && $args{'InReplyTo'};
1233 my $get_header = sub {
1235 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1236 @res = $args{'InReplyTo'}->head->get( shift );
1238 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1240 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1243 my @id = $get_header->('Message-ID');
1244 #XXX: custom header should begin with X- otherwise is violation of the standard
1245 my @rtid = $get_header->('RT-Message-ID');
1246 my @references = $get_header->('References');
1247 unless ( @references ) {
1248 @references = $get_header->('In-Reply-To');
1250 push @references, @id, @rtid;
1251 if ( $args{'Ticket'} ) {
1252 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1253 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1255 @references = splice @references, 4, -6
1256 if @references > 10;
1258 my $mail = $args{'Message'};
1259 $mail->head->set( 'In-Reply-To' => Encode::encode_utf8(join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
1260 $mail->head->set( 'References' => Encode::encode_utf8(join ' ', @references) );
1263 sub ExtractTicketId {
1266 my $subject = $entity->head->get('Subject') || '';
1268 return ParseTicketId( $subject );
1272 my $Subject = shift;
1274 my $rtname = RT->Config->Get('rtname');
1275 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1278 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1281 foreach my $tag ( RT->System->SubjectTag ) {
1282 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1287 return undef unless $id;
1289 $RT::Logger->debug("Found a ticket ID. It's $id");
1294 my $subject = shift;
1296 unless ( ref $ticket ) {
1297 my $tmp = RT::Ticket->new( RT->SystemUser );
1298 $tmp->Load( $ticket );
1301 my $id = $ticket->id;
1302 my $queue_tag = $ticket->QueueObj->SubjectTag;
1304 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1305 unless ( $tag_re ) {
1306 my $tag = $queue_tag || RT->Config->Get('rtname');
1307 $tag_re = qr/\Q$tag\E/;
1308 } elsif ( $queue_tag ) {
1309 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1311 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1313 $subject =~ s/(\r\n|\n|\s)/ /g;
1315 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1319 =head2 Gateway ARGSREF
1329 This performs all the "guts" of the mail rt-mailgate program, and is
1330 designed to be called from the web interface with a message, user
1333 Can also take an optional 'ticket' parameter; this ticket id overrides
1334 any ticket id found in the subject.
1340 (status code, message, optional ticket object)
1342 status code is a numeric value.
1344 for temporary failures, the status code should be -75
1346 for permanent failures which are handled by RT, the status code
1349 for succces, the status code should be 1
1356 my @mail_plugins = @_;
1359 foreach my $plugin (@mail_plugins) {
1360 if ( ref($plugin) eq "CODE" ) {
1362 } elsif ( !ref $plugin ) {
1363 my $Class = $plugin;
1364 $Class = "RT::Interface::Email::" . $Class
1365 unless $Class =~ /^RT::/;
1367 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1370 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1371 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1376 $RT::Logger->crit( "$plugin - is not class name or code reference");
1383 my $argsref = shift;
1385 action => 'correspond',
1395 # Validate the action
1396 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1400 "Invalid 'action' parameter "
1408 my $parser = RT::EmailParser->new();
1409 $parser->SmartParseMIMEEntityFromScalar(
1410 Message => $args{'message'},
1415 my $Message = $parser->Entity();
1418 Subject => "RT Bounce: Unparseable message",
1419 Explanation => "RT couldn't process the message below",
1420 Attach => $args{'message'}
1424 "Failed to parse this message. Something is likely badly wrong with the message"
1428 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1429 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1430 @mail_plugins = _LoadPlugins( @mail_plugins );
1433 foreach my $class( grep !ref, @mail_plugins ) {
1434 # check if we should apply filter before decoding
1437 *{ $class . "::ApplyBeforeDecode" }{CODE};
1439 next unless defined $check_cb;
1440 next unless $check_cb->(
1441 Message => $Message,
1442 RawMessageRef => \$args{'message'},
1445 $skip_plugin{ $class }++;
1449 *{ $class . "::GetCurrentUser" }{CODE};
1451 my ($status, $msg) = $Code->(
1452 Message => $Message,
1453 RawMessageRef => \$args{'message'},
1455 next if $status > 0;
1457 if ( $status == -2 ) {
1458 return (1, $msg, undef);
1459 } elsif ( $status == -1 ) {
1460 return (0, $msg, undef);
1463 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1464 $parser->_DecodeBodies;
1465 $parser->RescueOutlook;
1466 $parser->_PostProcessNewEntity;
1468 my $head = $Message->head;
1469 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1470 my $Sender = (ParseSenderAddressFromHead( $head ))[0];
1471 my $From = $head->get("From");
1472 chomp $From if defined $From;
1474 my $MessageId = $head->get('Message-ID')
1475 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1477 #Pull apart the subject line
1478 my $Subject = $head->get('Subject') || '';
1481 # Lets check for mail loops of various sorts.
1482 my ($should_store_machine_generated_message, $IsALoop, $result);
1483 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1484 _HandleMachineGeneratedMail(
1485 Message => $Message,
1486 ErrorsTo => $ErrorsTo,
1487 Subject => $Subject,
1488 MessageId => $MessageId
1491 # Do not pass loop messages to MailPlugins, to make sure the loop
1492 # is broken, unless $RT::StoreLoops is set.
1493 if ($IsALoop && !$should_store_machine_generated_message) {
1494 return ( 0, $result, undef );
1498 $args{'ticket'} ||= ExtractTicketId( $Message );
1500 # ExtractTicketId may have been overridden, and edited the Subject
1501 my $NewSubject = $Message->head->get('Subject');
1504 $SystemTicket = RT::Ticket->new( RT->SystemUser );
1505 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1506 if ( $SystemTicket->id ) {
1507 $Right = 'ReplyToTicket';
1509 $Right = 'CreateTicket';
1512 #Set up a queue object
1513 my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
1514 $SystemQueueObj->Load( $args{'queue'} );
1516 # We can safely have no queue of we have a known-good ticket
1517 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1518 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1521 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1522 MailPlugins => \@mail_plugins,
1523 Actions => \@actions,
1524 Message => $Message,
1525 RawMessageRef => \$args{message},
1526 SystemTicket => $SystemTicket,
1527 SystemQueue => $SystemQueueObj,
1530 # If authentication fails and no new user was created, get out.
1531 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1533 # If the plugins refused to create one, they lose.
1534 unless ( $AuthStat == -1 ) {
1535 _NoAuthorizedUserFound(
1537 Message => $Message,
1538 Requestor => $ErrorsTo,
1539 Queue => $args{'queue'}
1543 return ( 0, "Could not load a valid user", undef );
1546 # If we got a user, but they don't have the right to say things
1547 if ( $AuthStat == 0 ) {
1550 Subject => "Permission Denied",
1552 "You do not have permission to communicate with RT",
1557 ($CurrentUser->EmailAddress || $CurrentUser->Name)
1558 . " ($Sender) tried to submit a message to "
1560 . " without permission.",
1566 unless ($should_store_machine_generated_message) {
1567 return ( 0, $result, undef );
1570 # if plugin's updated SystemTicket then update arguments
1571 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1573 my $Ticket = RT::Ticket->new($CurrentUser);
1575 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1579 my @Requestors = ( $CurrentUser->id );
1581 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1582 @Cc = ParseCcAddressesFromHead(
1584 CurrentUser => $CurrentUser,
1585 QueueObj => $SystemQueueObj
1589 $head->replace('X-RT-Interface' => 'Email');
1591 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1592 Queue => $SystemQueueObj->Id,
1593 Subject => $NewSubject,
1594 Requestor => \@Requestors,
1601 Subject => "Ticket creation failed: $Subject",
1602 Explanation => $ErrStr,
1605 return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket );
1608 # strip comments&corresponds from the actions we don't need
1609 # to record them if we've created the ticket just now
1610 @actions = grep !/^(comment|correspond)$/, @actions;
1611 $args{'ticket'} = $id;
1613 } elsif ( $args{'ticket'} ) {
1615 $Ticket->Load( $args{'ticket'} );
1616 unless ( $Ticket->Id ) {
1617 my $error = "Could not find a ticket with id " . $args{'ticket'};
1620 Subject => "Message not recorded: $Subject",
1621 Explanation => $error,
1625 return ( 0, $error );
1627 $args{'ticket'} = $Ticket->id;
1629 return ( 1, "Success", $Ticket );
1634 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1635 foreach my $action (@actions) {
1637 # If the action is comment, add a comment.
1638 if ( $action =~ /^(?:comment|correspond)$/i ) {
1639 my $method = ucfirst lc $action;
1640 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1643 #Warn the sender that we couldn't actually submit the comment.
1646 Subject => "Message not recorded ($method): $Subject",
1647 Explanation => $msg,
1650 return ( 0, "Message From: $From not recorded: $msg", $Ticket );
1652 } elsif ($unsafe_actions) {
1653 my ( $status, $msg ) = _RunUnsafeAction(
1655 ErrorsTo => $ErrorsTo,
1656 Message => $Message,
1658 CurrentUser => $CurrentUser,
1660 return ($status, $msg, $Ticket) unless $status == 1;
1663 return ( 1, "Success", $Ticket );
1666 =head2 GetAuthenticationLevel
1668 # Authentication Level
1669 # -1 - Get out. this user has been explicitly declined
1670 # 0 - User may not do anything (Not used at the moment)
1672 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1676 sub GetAuthenticationLevel {
1681 RawMessageRef => undef,
1682 SystemTicket => undef,
1683 SystemQueue => undef,
1687 my ( $CurrentUser, $AuthStat, $error );
1689 # Initalize AuthStat so comparisons work correctly
1690 $AuthStat = -9999999;
1692 # if plugin returns AuthStat -2 we skip action
1693 # NOTE: this is experimental API and it would be changed
1694 my %skip_action = ();
1696 # Since this needs loading, no matter what
1697 foreach (@{ $args{MailPlugins} }) {
1698 my ($Code, $NewAuthStat);
1699 if ( ref($_) eq "CODE" ) {
1703 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1706 foreach my $action (@{ $args{Actions} }) {
1707 ( $CurrentUser, $NewAuthStat ) = $Code->(
1708 Message => $args{Message},
1709 RawMessageRef => $args{RawMessageRef},
1710 CurrentUser => $CurrentUser,
1711 AuthLevel => $AuthStat,
1713 Ticket => $args{SystemTicket},
1714 Queue => $args{SystemQueue},
1717 # You get the highest level of authentication you were assigned, unless you get the magic -1
1718 # If a module returns a "-1" then we discard the ticket, so.
1719 $AuthStat = $NewAuthStat
1720 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1722 last if $AuthStat == -1;
1723 $skip_action{$action}++ if $AuthStat == -2;
1726 # strip actions we should skip
1727 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1729 last unless @{$args{Actions}};
1731 last if $AuthStat == -1;
1734 return $AuthStat if !wantarray;
1736 return ($AuthStat, $CurrentUser, $error);
1739 sub _RunUnsafeAction {
1745 CurrentUser => undef,
1749 my $From = $args{Message}->head->get("From");
1751 if ( $args{'Action'} =~ /^take$/i ) {
1752 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1755 To => $args{'ErrorsTo'},
1756 Subject => "Ticket not taken",
1757 Explanation => $msg,
1758 MIMEObj => $args{'Message'}
1760 return ( 0, "Ticket not taken, by email From: $From" );
1762 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1763 my $new_status = $args{'Ticket'}->FirstInactiveStatus;
1765 my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status);
1768 #Warn the sender that we couldn't actually submit the comment.
1770 To => $args{'ErrorsTo'},
1771 Subject => "Ticket not resolved",
1772 Explanation => $msg,
1773 MIMEObj => $args{'Message'}
1775 return ( 0, "Ticket not resolved, by email From: $From" );
1779 return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} );
1781 return ( 1, "Success" );
1784 =head2 _NoAuthorizedUserFound
1786 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1790 sub _NoAuthorizedUserFound {
1799 # Notify the RT Admin of the failure.
1801 To => RT->Config->Get('OwnerEmail'),
1802 Subject => "Could not load a valid user",
1803 Explanation => <<EOT,
1804 RT could not load a valid user, and RT's configuration does not allow
1805 for the creation of a new user for this email (@{[$args{Requestor}]}).
1807 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1808 queue @{[$args{'Queue'}]}.
1811 MIMEObj => $args{'Message'},
1815 # Also notify the requestor that his request has been dropped.
1816 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1818 To => $args{'Requestor'},
1819 Subject => "Could not load a valid user",
1820 Explanation => <<EOT,
1821 RT could not load a valid user, and RT's configuration does not allow
1822 for the creation of a new user for your email.
1825 MIMEObj => $args{'Message'},
1831 =head2 _HandleMachineGeneratedMail
1838 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1839 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1840 "This message appears to be a loop (boolean)" );
1844 sub _HandleMachineGeneratedMail {
1845 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1846 my $head = $args{'Message'}->head;
1847 my $ErrorsTo = $args{'ErrorsTo'};
1849 my $IsBounce = CheckForBounce($head);
1851 my $IsAutoGenerated = CheckForAutoGenerated($head);
1853 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1855 my $IsALoop = CheckForLoops($head);
1857 my $SquelchReplies = 0;
1859 my $owner_mail = RT->Config->Get('OwnerEmail');
1861 #If the message is autogenerated, we need to know, so we can not
1862 # send mail to the sender
1863 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1864 $SquelchReplies = 1;
1865 $ErrorsTo = $owner_mail;
1868 # Warn someone if it's a loop, before we drop it on the ground
1870 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1872 #Should we mail it to RTOwner?
1873 if ( RT->Config->Get('LoopsToRTOwner') ) {
1876 Subject => "RT Bounce: ".$args{'Subject'},
1877 Explanation => "RT thinks this message may be a bounce",
1878 MIMEObj => $args{Message}
1882 #Do we actually want to store it?
1883 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1884 unless RT->Config->Get('StoreLoops');
1887 # Squelch replies if necessary
1888 # Don't let the user stuff the RT-Squelch-Replies-To header.
1889 if ( $head->get('RT-Squelch-Replies-To') ) {
1891 'RT-Relocated-Squelch-Replies-To',
1892 $head->get('RT-Squelch-Replies-To')
1894 $head->delete('RT-Squelch-Replies-To');
1897 if ($SquelchReplies) {
1899 # Squelch replies to the sender, and also leave a clue to
1900 # allow us to squelch ALL outbound messages. This way we
1901 # can punt the logic of "what to do when we get a bounce"
1902 # to the scrip. We might want to notify nobody. Or just
1903 # the RT Owner. Or maybe all Privileged watchers.
1904 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1905 $head->replace( 'RT-Squelch-Replies-To', $Sender );
1906 $head->replace( 'RT-DetectedAutoGenerated', 'true' );
1908 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1911 =head2 IsCorrectAction
1913 Returns a list of valid actions we've found for this message
1917 sub IsCorrectAction {
1919 my @actions = grep $_, split /-/, $action;
1920 return ( 0, '(no value)' ) unless @actions;
1921 foreach ( @actions ) {
1922 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1924 return ( 1, @actions );
1927 sub _RecordSendEmailFailure {
1930 $ticket->_RecordNote(
1931 NoteType => 'SystemError',
1932 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1937 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1942 RT::Base->_ImportOverlays();