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 ( ( $From =~ /^mailer-daemon\@/i )
153 or ( $From =~ /^postmaster\@/i )
163 =head2 CheckForAutoGenerated HEAD
165 Takes a HEAD object of L<MIME::Head> class and returns true if message
166 is autogenerated. Checks 'Precedence' and 'X-FC-Machinegenerated'
167 fields of the head in tests.
171 sub CheckForAutoGenerated {
174 my $Precedence = $head->get("Precedence") || "";
175 if ( $Precedence =~ /^(bulk|junk)/i ) {
179 # Per RFC3834, any Auto-Submitted header which is not "no" means
180 # it is auto-generated.
181 my $AutoSubmitted = $head->get("Auto-Submitted") || "";
182 if ( length $AutoSubmitted and $AutoSubmitted ne "no" ) {
186 # First Class mailer uses this as a clue.
187 my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
188 if ( $FCJunk =~ /^true/i ) {
199 my $ReturnPath = $head->get("Return-path") || "";
200 return ( $ReturnPath =~ /<>/ );
204 =head2 MailError PARAM HASH
206 Sends an error message. Takes a param hash:
210 =item From - sender's address, by default is 'CorrespondAddress';
212 =item To - recipient, by default is 'OwnerEmail';
214 =item Bcc - optional Bcc recipients;
216 =item Subject - subject of the message, default is 'There has been an error';
218 =item Explanation - main content of the error, default value is 'Unexplained error';
220 =item MIMEObj - optional MIME entity that's attached to the error mail, as well we
221 add 'In-Reply-To' field to the error that points to this message.
223 =item Attach - optional text that attached to the error as 'message/rfc822' part.
225 =item LogLevel - log level under which we should write explanation message into the
226 log, by default we log it as critical.
234 To => RT->Config->Get('OwnerEmail'),
236 From => RT->Config->Get('CorrespondAddress'),
237 Subject => 'There has been an error',
238 Explanation => 'Unexplained error',
246 level => $args{'LogLevel'},
247 message => $args{'Explanation'}
248 ) if $args{'LogLevel'};
250 # the colons are necessary to make ->build include non-standard headers
252 Type => "multipart/mixed",
253 From => $args{'From'},
256 Subject => $args{'Subject'},
257 'X-RT-Loop-Prevention:' => RT->Config->Get('rtname'),
260 # only set precedence if the sysadmin wants us to
261 if (defined(RT->Config->Get('DefaultErrorMailPrecedence'))) {
262 $entity_args{'Precedence:'} = RT->Config->Get('DefaultErrorMailPrecedence');
265 my $entity = MIME::Entity->build(%entity_args);
266 SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
268 $entity->attach( Data => $args{'Explanation'} . "\n" );
270 if ( $args{'MIMEObj'} ) {
271 $args{'MIMEObj'}->sync_headers;
272 $entity->add_part( $args{'MIMEObj'} );
275 if ( $args{'Attach'} ) {
276 $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
280 SendEmail( Entity => $entity, Bounce => 1 );
284 =head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ]
286 Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using
287 RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a
288 true value, the message will be marked as an autogenerated error, if
289 possible. Sets Date field of the head to now if it's not set.
291 If the C<X-RT-Squelch> header is set to any true value, the mail will
292 not be sent. One use is to let extensions easily cancel outgoing mail.
294 Ticket and Transaction arguments are optional. If Transaction is
295 specified and Ticket is not then ticket of the transaction is
296 used, but only if the transaction belongs to a ticket.
298 Returns 1 on success, 0 on error or -1 if message has no recipients
299 and hasn't been sent.
301 =head3 Signing and Encrypting
303 This function as well signs and/or encrypts the message according to
304 headers of a transaction's attachment or properties of a ticket's queue.
305 To get full access to the configuration Ticket and/or Transaction
306 arguments must be provided, but you can force behaviour using Sign
307 and/or Encrypt arguments.
309 The following precedence of arguments are used to figure out if
310 the message should be encrypted and/or signed:
312 * if Sign or Encrypt argument is defined then its value is used
314 * else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt
315 header field then it's value is used
317 * else properties of a queue of the Ticket are used.
321 sub WillSignEncrypt {
323 my $attachment = delete $args{Attachment};
324 my $ticket = delete $args{Ticket};
326 if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
327 $args{Sign} = $args{Encrypt} = 0;
328 return wantarray ? %args : 0;
331 for my $argument ( qw(Sign Encrypt) ) {
332 next if defined $args{ $argument };
334 if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
335 $args{$argument} = $attachment->GetHeader("X-RT-$argument");
336 } elsif ( $ticket and $argument eq "Encrypt" ) {
337 $args{Encrypt} = $ticket->QueueObj->Encrypt();
338 } elsif ( $ticket and $argument eq "Sign" ) {
339 # Note that $queue->Sign is UI-only, and that all
340 # UI-generated messages explicitly set the X-RT-Crypt header
341 # to 0 or 1; thus this path is only taken for messages
342 # generated _not_ via the web UI.
343 $args{Sign} = $ticket->QueueObj->SignAuto();
347 return wantarray ? %args : ($args{Sign} || $args{Encrypt});
355 Transaction => undef,
359 my $TicketObj = $args{'Ticket'};
360 my $TransactionObj = $args{'Transaction'};
362 foreach my $arg( qw(Entity Bounce) ) {
363 next unless defined $args{ lc $arg };
365 $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
366 $args{ $arg } = delete $args{ lc $arg };
369 unless ( $args{'Entity'} ) {
370 $RT::Logger->crit( "Could not send mail without 'Entity' object" );
374 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
377 # If we don't have any recipients to send to, don't send a message;
378 unless ( $args{'Entity'}->head->get('To')
379 || $args{'Entity'}->head->get('Cc')
380 || $args{'Entity'}->head->get('Bcc') )
382 $RT::Logger->info( $msgid . " No recipients found. Not sending." );
386 if ($args{'Entity'}->head->get('X-RT-Squelch')) {
387 $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
391 if ( $TransactionObj && !$TicketObj
392 && $TransactionObj->ObjectType eq 'RT::Ticket' )
394 $TicketObj = $TransactionObj->Object;
397 if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
398 %args = WillSignEncrypt(
400 Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
401 Ticket => $TicketObj,
403 my $res = SignEncrypt( %args );
404 return $res unless $res > 0;
407 unless ( $args{'Entity'}->head->get('Date') ) {
409 my $date = RT::Date->new( $RT::SystemUser );
411 $args{'Entity'}->head->set( 'Date', $date->RFC2822( Timezone => 'server' ) );
414 my $mail_command = RT->Config->Get('MailCommand');
416 if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
417 $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
418 $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
421 # if it is a sub routine, we just return it;
422 return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
424 if ( $mail_command eq 'sendmailpipe' ) {
425 my $path = RT->Config->Get('SendmailPath');
426 my @args = shellwords(RT->Config->Get('SendmailArguments'));
428 # SetOutgoingMailFrom
429 if ( RT->Config->Get('SetOutgoingMailFrom') ) {
430 my $OutgoingMailAddress;
433 my $QueueName = $TicketObj->QueueObj->Name;
434 my $QueueAddressOverride = RT->Config->Get('OverrideOutgoingMailFrom')->{$QueueName};
436 if ($QueueAddressOverride) {
437 $OutgoingMailAddress = $QueueAddressOverride;
439 $OutgoingMailAddress = $TicketObj->QueueObj->CorrespondAddress;
443 $OutgoingMailAddress ||= RT->Config->Get('OverrideOutgoingMailFrom')->{'Default'};
445 push @args, "-f", $OutgoingMailAddress
446 if $OutgoingMailAddress;
449 # Set Bounce Arguments
450 push @args, shellwords(RT->Config->Get('SendmailBounceArguments'))
454 if ( $TransactionObj and
455 my $prefix = RT->Config->Get('VERPPrefix') and
456 my $domain = RT->Config->Get('VERPDomain') )
458 my $from = $TransactionObj->CreatorObj->EmailAddress;
461 push @args, "-f", "$prefix$from\@$domain";
465 # don't ignore CHLD signal to get proper exit code
466 local $SIG{'CHLD'} = 'DEFAULT';
468 # if something wrong with $mail->print we will get PIPE signal, handle it
469 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
471 # Make it look to open2 like STDIN is on FD 0, like it
472 # should be; this is necessary because under mod_perl with
473 # the perl-script handler, it's not. This causes our
474 # child's "STDIN" (FD 10-ish) to be set to the pipe we want,
475 # but FD 0 (which the exec'd sendmail assumes is STDIN) is
476 # still open to /dev/null; this ends disasterously.
477 local *STDIN = IO::Handle->new_from_fd( 0, "r" );
481 my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
482 or die "couldn't execute program: $!";
484 $args{'Entity'}->print($mail);
485 close $mail or die "close pipe failed: $!";
489 # sendmail exit statuses mostly errors with data not software
490 # TODO: status parsing: core dump, exit on signal or EX_*
491 my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
492 $msg = ", interrupted by signal ". ($?&127) if $?&127;
493 $RT::Logger->error( $msg );
498 $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
500 _RecordSendEmailFailure( $TicketObj );
505 elsif ( $mail_command eq 'smtp' ) {
507 my $smtp = do { local $@; eval { Net::SMTP->new(
508 Host => RT->Config->Get('SMTPServer'),
509 Debug => RT->Config->Get('SMTPDebug'),
512 $RT::Logger->crit( "Could not connect to SMTP server.");
514 _RecordSendEmailFailure( $TicketObj );
519 # duplicate head as we want drop Bcc field
520 my $head = $args{'Entity'}->head->dup;
521 my @recipients = map $_->address, map
522 Email::Address->parse($head->get($_)), qw(To Cc Bcc);
523 $head->delete('Bcc');
525 my $sender = RT->Config->Get('SMTPFrom')
526 || $args{'Entity'}->head->get('From');
529 my $status = $smtp->mail( $sender )
530 && $smtp->recipient( @recipients );
534 my $fh = $smtp->tied_fh;
537 $args{'Entity'}->print_body( $fh );
543 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
545 _RecordSendEmailFailure( $TicketObj );
551 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
553 my @mailer_args = ($mail_command);
554 if ( $mail_command eq 'sendmail' ) {
555 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
556 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
559 push @mailer_args, RT->Config->Get('MailParams');
562 unless ( $args{'Entity'}->send( @mailer_args ) ) {
563 $RT::Logger->crit( "$msgid: Could not send mail." );
565 _RecordSendEmailFailure( $TicketObj );
573 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
575 Loads a template. Parses it using arguments if it's not empty.
576 Returns a tuple (L<RT::Template> object, error message).
578 Note that even if a template object is returned MIMEObj method
579 may return undef for empty templates.
583 sub PrepareEmailUsingTemplate {
590 my $template = RT::Template->new( $RT::SystemUser );
591 $template->LoadGlobalTemplate( $args{'Template'} );
592 unless ( $template->id ) {
593 return (undef, "Couldn't load template '". $args{'Template'} ."'");
595 return $template if $template->IsEmpty;
597 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
598 return (undef, $msg) unless $status;
603 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
605 Sends email using a template, takes name of template, arguments for it and recipients.
609 sub SendEmailUsingTemplate {
616 From => RT->Config->Get('CorrespondAddress'),
621 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
622 return (0, $msg) unless $template;
624 my $mail = $template->MIMEObj;
626 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
630 $mail->head->set( $_ => Encode::encode_utf8( $args{ $_ } ) )
631 foreach grep defined $args{$_}, qw(To Cc Bcc From);
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 return SendForward( %args, Entity => $entity, Transaction => $txn );
653 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
655 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
661 my %args = ( To => '', Cc => '', Bcc => '', @_ );
663 my $txns = $ticket->Transactions;
667 ) for qw(Create Correspond);
669 my $entity = MIME::Entity->build(
670 Type => 'multipart/mixed',
672 $entity->add_part( $_ ) foreach
673 map $_->ContentAsMIME,
674 @{ $txns->ItemsArrayRef };
676 return SendForward( %args, Entity => $entity, Ticket => $ticket, Template => 'Forward Ticket' );
679 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
681 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
689 Transaction => undef,
690 Template => 'Forward',
691 To => '', Cc => '', Bcc => '',
695 my $txn = $args{'Transaction'};
696 my $ticket = $args{'Ticket'};
697 $ticket ||= $txn->Object if $txn;
699 my $entity = $args{'Entity'};
702 $RT::Logger->error(Carp::longmess("No entity provided"));
703 return (0, $ticket->loc("Couldn't send email"));
706 my ($template, $msg) = PrepareEmailUsingTemplate(
707 Template => $args{'Template'},
716 $mail = $template->MIMEObj;
718 $RT::Logger->warning($msg);
721 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
724 unless ( $args{'Transaction'} ) {
725 $description = 'This is forward of ticket #'. $ticket->id;
727 $description = 'This is forward of transaction #'
728 . $txn->id ." of a ticket #". $txn->ObjectId;
730 $mail = MIME::Entity->build(
731 Type => 'text/plain',
732 Data => $description,
736 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
737 foreach grep defined $args{$_}, qw(To Cc Bcc);
740 Type => 'message/rfc822',
741 Disposition => 'attachment',
742 Description => 'forwarded message',
743 Data => $entity->as_string,
748 $subject = $txn->Subject if $txn;
749 $subject ||= $ticket->Subject if $ticket;
750 if ( RT->Config->Get('ForwardFromUser') ) {
751 $from = ($txn || $ticket)->CurrentUser->UserObj->EmailAddress;
753 # XXX: what if want to forward txn of other object than ticket?
754 $subject = AddSubjectTag( $subject, $ticket );
755 $from = $ticket->QueueObj->CorrespondAddress
756 || RT->Config->Get('CorrespondAddress');
758 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
759 $mail->head->set( From => EncodeToMIME( String => $from ) );
761 my $status = RT->Config->Get('ForwardFromUser')
762 # never sign if we forward from User
763 ? SendEmail( %args, Entity => $mail, Sign => 0 )
764 : SendEmail( %args, Entity => $mail );
765 return (0, $ticket->loc("Couldn't send email")) unless $status;
766 return (1, $ticket->loc("Send email successfully"));
769 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
771 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
772 handle errors with users' keys.
774 If a recipient has no key or has other problems with it, then the
775 unction sends a error to him using 'Error: public key' template.
776 Also, notifies RT's owner using template 'Error to RT owner: public key'
777 to inform that there are problems with users' keys. Then we filter
778 all bad recipients and retry.
780 Returns 1 on success, 0 on error and -1 if all recipients are bad and
781 had been filtered out.
792 return 1 unless $args{'Sign'} || $args{'Encrypt'};
794 my $msgid = $args{'Entity'}->head->get('Message-ID') || '';
797 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
798 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
800 require RT::Crypt::GnuPG;
801 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
802 return 1 unless $res{'exit_code'};
804 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
807 foreach my $line ( @status ) {
808 # if the passphrase fails, either you have a bad passphrase
809 # or gpg-agent has died. That should get caught in Create and
810 # Update, but at least throw an error here
811 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
812 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
813 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
816 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
817 next if $line->{'Status'} eq 'DONE';
818 $RT::Logger->error( $line->{'Message'} );
819 push @bad_recipients, $line;
821 return 0 unless @bad_recipients;
823 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
824 foreach @bad_recipients;
826 foreach my $recipient ( @bad_recipients ) {
827 my $status = SendEmailUsingTemplate(
828 To => $recipient->{'AddressObj'}->address,
829 Template => 'Error: public key',
832 TicketObj => $args{'Ticket'},
833 TransactionObj => $args{'Transaction'},
837 $RT::Logger->error("Couldn't send 'Error: public key'");
841 my $status = SendEmailUsingTemplate(
842 To => RT->Config->Get('OwnerEmail'),
843 Template => 'Error to RT owner: public key',
845 BadRecipients => \@bad_recipients,
846 TicketObj => $args{'Ticket'},
847 TransactionObj => $args{'Transaction'},
851 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
854 DeleteRecipientsFromHead(
855 $args{'Entity'}->head,
856 map $_->{'AddressObj'}->address, @bad_recipients
859 unless ( $args{'Entity'}->head->get('To')
860 || $args{'Entity'}->head->get('Cc')
861 || $args{'Entity'}->head->get('Bcc') )
863 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
867 # redo without broken recipients
868 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
869 return 0 if $res{'exit_code'};
878 Takes a hash with a String and a Charset. Returns the string encoded
879 according to RFC2047, using B (base64 based) encoding.
881 String must be a perl string, octets are returned.
883 If Charset is not provided then $EmailOutputEncoding config option
884 is used, or "latin-1" if that is not set.
894 my $value = $args{'String'};
895 return $value unless $value; # 0 is perfect ascii
896 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
899 # using RFC2047 notation, sec 2.
900 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
902 # An 'encoded-word' may not be more than 75 characters long
904 # MIME encoding increases 4/3*(number of bytes), and always in multiples
905 # of 4. Thus we have to find the best available value of bytes available
908 # First we get the integer max which max*4/3 would fit on space.
909 # Then we find the greater multiple of 3 lower or equal than $max.
911 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
915 $max = int( $max / 3 ) * 3;
922 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
926 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
930 # we need perl string to split thing char by char
931 Encode::_utf8_on($value) unless Encode::is_utf8($value);
933 my ( $tmp, @chunks ) = ( '', () );
934 while ( length $value ) {
935 my $char = substr( $value, 0, 1, '' );
936 my $octets = Encode::encode( $charset, $char );
937 if ( length($tmp) + length($octets) > $max ) {
943 push @chunks, $tmp if length $tmp;
945 # encode an join chuncks
947 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
953 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
955 my $NewUser = RT::User->new( $RT::SystemUser );
957 my ( $Val, $Message ) = $NewUser->Create(
958 Name => ( $Username || $Address ),
959 EmailAddress => $Address,
963 Comments => 'Autocreated on ticket submission',
968 # Deal with the race condition of two account creations at once
970 $NewUser->LoadByName($Username);
973 unless ( $NewUser->Id ) {
974 $NewUser->LoadByEmail($Address);
977 unless ( $NewUser->Id ) {
980 Subject => "User could not be created",
982 "User creation failed in mailgateway: $Message",
989 #Load the new user object
990 my $CurrentUser = new RT::CurrentUser;
991 $CurrentUser->LoadByEmail( $Address );
993 unless ( $CurrentUser->id ) {
994 $RT::Logger->warning(
995 "Couldn't load user '$Address'." . "giving up" );
998 Subject => "User could not be loaded",
1000 "User '$Address' could not be loaded in the mail gateway",
1006 return $CurrentUser;
1011 =head2 ParseCcAddressesFromHead HASH
1013 Takes a hash containing QueueObj, Head and CurrentUser objects.
1014 Returns a list of all email addresses in the To and Cc
1015 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
1016 email address and anything that the configuration sub RT::IsRTAddress matches.
1020 sub ParseCcAddressesFromHead {
1024 CurrentUser => undef,
1028 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1029 my $user = $args{'CurrentUser'}->UserObj;
1032 grep { $_ ne $current_address
1033 && !RT::EmailParser->IsRTAddress( $_ )
1034 && !IgnoreCcAddress( $_ )
1036 map lc $user->CanonicalizeEmailAddress( $_->address ),
1037 map Email::Address->parse( $args{'Head'}->get( $_ ) ),
1041 =head2 IgnoreCcAddress ADDRESS
1043 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1047 sub IgnoreCcAddress {
1048 my $address = shift;
1049 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1050 return 1 if $address =~ /$address_re/i;
1055 =head2 ParseSenderAddressFromHead HEAD
1057 Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
1058 of the From (evaluated in order of Reply-To:, From:, Sender)
1062 sub ParseSenderAddressFromHead {
1065 #Figure out who's sending this message.
1066 foreach my $header ('Reply-To', 'From', 'Sender') {
1067 my $addr_line = $head->get($header) || next;
1068 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1069 # only return if the address is not empty
1070 return ($addr, $name) if $addr;
1073 return (undef, undef);
1076 =head2 ParseErrorsToAddressFromHead HEAD
1078 Takes a MIME::Header object. Return a single value : user@host
1079 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1084 sub ParseErrorsToAddressFromHead {
1087 #Figure out who's sending this message.
1089 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1091 # If there's a header of that name
1092 my $headerobj = $head->get($header);
1094 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1096 # If it's got actual useful content...
1097 return ($addr) if ($addr);
1104 =head2 ParseAddressFromHeader ADDRESS
1106 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1110 sub ParseAddressFromHeader {
1113 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1114 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1115 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1117 my ($AddrObj) = grep ref $_, @Addresses;
1118 unless ( $AddrObj ) {
1119 return ( undef, undef );
1122 my $Name = ( $AddrObj->name || $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
1124 #Lets take the from and load a user object.
1125 my $Address = $AddrObj->address;
1127 return ( $Address, $Name );
1130 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1132 Gets a head object and list of addresses.
1133 Deletes addresses from To, Cc or Bcc fields.
1137 sub DeleteRecipientsFromHead {
1139 my %skip = map { lc $_ => 1 } @_;
1141 foreach my $field ( qw(To Cc Bcc) ) {
1142 $head->set( $field =>
1143 join ', ', map $_->format, grep !$skip{ lc $_->address },
1144 Email::Address->parse( $head->get( $field ) )
1153 ScripAction => undef,
1156 my $org = RT->Config->Get('Organization');
1157 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1158 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1159 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1161 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1162 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1172 return unless $args{'Message'} && $args{'InReplyTo'};
1174 my $get_header = sub {
1176 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1177 @res = $args{'InReplyTo'}->head->get( shift );
1179 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1181 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1184 my @id = $get_header->('Message-ID');
1185 #XXX: custom header should begin with X- otherwise is violation of the standard
1186 my @rtid = $get_header->('RT-Message-ID');
1187 my @references = $get_header->('References');
1188 unless ( @references ) {
1189 @references = $get_header->('In-Reply-To');
1191 push @references, @id, @rtid;
1192 if ( $args{'Ticket'} ) {
1193 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1194 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1196 @references = splice @references, 4, -6
1197 if @references > 10;
1199 my $mail = $args{'Message'};
1200 $mail->head->set( 'In-Reply-To' => join ' ', @rtid? (@rtid) : (@id) ) if @id || @rtid;
1201 $mail->head->set( 'References' => join ' ', @references );
1205 my $Subject = shift;
1207 my $rtname = RT->Config->Get('rtname');
1208 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1211 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1214 foreach my $tag ( RT->System->SubjectTag ) {
1215 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1220 return undef unless $id;
1222 $RT::Logger->debug("Found a ticket ID. It's $id");
1227 my $subject = shift;
1229 unless ( ref $ticket ) {
1230 my $tmp = RT::Ticket->new( $RT::SystemUser );
1231 $tmp->Load( $ticket );
1234 my $id = $ticket->id;
1235 my $queue_tag = $ticket->QueueObj->SubjectTag;
1237 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1238 unless ( $tag_re ) {
1239 my $tag = $queue_tag || RT->Config->Get('rtname');
1240 $tag_re = qr/\Q$tag\E/;
1241 } elsif ( $queue_tag ) {
1242 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1244 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1246 $subject =~ s/(\r\n|\n|\s)/ /gi;
1248 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1252 =head2 Gateway ARGSREF
1262 This performs all the "guts" of the mail rt-mailgate program, and is
1263 designed to be called from the web interface with a message, user
1266 Can also take an optional 'ticket' parameter; this ticket id overrides
1267 any ticket id found in the subject.
1273 (status code, message, optional ticket object)
1275 status code is a numeric value.
1277 for temporary failures, the status code should be -75
1279 for permanent failures which are handled by RT, the status code
1282 for succces, the status code should be 1
1289 my @mail_plugins = @_;
1292 foreach my $plugin (@mail_plugins) {
1293 if ( ref($plugin) eq "CODE" ) {
1295 } elsif ( !ref $plugin ) {
1296 my $Class = $plugin;
1297 $Class = "RT::Interface::Email::" . $Class
1298 unless $Class =~ /^RT::Interface::Email::/;
1300 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1303 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1304 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1309 $RT::Logger->crit( "$plugin - is not class name or code reference");
1316 my $argsref = shift;
1318 action => 'correspond',
1328 # Validate the action
1329 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1333 "Invalid 'action' parameter "
1341 my $parser = RT::EmailParser->new();
1342 $parser->SmartParseMIMEEntityFromScalar(
1343 Message => $args{'message'},
1348 my $Message = $parser->Entity();
1351 Subject => "RT Bounce: Unparseable message",
1352 Explanation => "RT couldn't process the message below",
1353 Attach => $args{'message'}
1357 "Failed to parse this message. Something is likely badly wrong with the message"
1361 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1362 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1363 @mail_plugins = _LoadPlugins( @mail_plugins );
1366 foreach my $class( grep !ref, @mail_plugins ) {
1367 # check if we should apply filter before decoding
1370 *{ $class . "::ApplyBeforeDecode" }{CODE};
1372 next unless defined $check_cb;
1373 next unless $check_cb->(
1374 Message => $Message,
1375 RawMessageRef => \$args{'message'},
1378 $skip_plugin{ $class }++;
1382 *{ $class . "::GetCurrentUser" }{CODE};
1384 my ($status, $msg) = $Code->(
1385 Message => $Message,
1386 RawMessageRef => \$args{'message'},
1388 next if $status > 0;
1390 if ( $status == -2 ) {
1391 return (1, $msg, undef);
1392 } elsif ( $status == -1 ) {
1393 return (0, $msg, undef);
1396 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1397 $parser->_DecodeBodies;
1398 $parser->_PostProcessNewEntity;
1400 my $head = $Message->head;
1401 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1403 my $MessageId = $head->get('Message-ID')
1404 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1406 #Pull apart the subject line
1407 my $Subject = $head->get('Subject') || '';
1410 # {{{ Lets check for mail loops of various sorts.
1411 my ($should_store_machine_generated_message, $IsALoop, $result);
1412 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1413 _HandleMachineGeneratedMail(
1414 Message => $Message,
1415 ErrorsTo => $ErrorsTo,
1416 Subject => $Subject,
1417 MessageId => $MessageId
1420 # Do not pass loop messages to MailPlugins, to make sure the loop
1421 # is broken, unless $RT::StoreLoops is set.
1422 if ($IsALoop && !$should_store_machine_generated_message) {
1423 return ( 0, $result, undef );
1427 $args{'ticket'} ||= ParseTicketId( $Subject );
1429 $SystemTicket = RT::Ticket->new( $RT::SystemUser );
1430 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1431 if ( $SystemTicket->id ) {
1432 $Right = 'ReplyToTicket';
1434 $Right = 'CreateTicket';
1437 #Set up a queue object
1438 my $SystemQueueObj = RT::Queue->new( $RT::SystemUser );
1439 $SystemQueueObj->Load( $args{'queue'} );
1441 # We can safely have no queue of we have a known-good ticket
1442 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1443 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1446 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1447 MailPlugins => \@mail_plugins,
1448 Actions => \@actions,
1449 Message => $Message,
1450 RawMessageRef => \$args{message},
1451 SystemTicket => $SystemTicket,
1452 SystemQueue => $SystemQueueObj,
1455 # {{{ If authentication fails and no new user was created, get out.
1456 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1458 # If the plugins refused to create one, they lose.
1459 unless ( $AuthStat == -1 ) {
1460 _NoAuthorizedUserFound(
1462 Message => $Message,
1463 Requestor => $ErrorsTo,
1464 Queue => $args{'queue'}
1468 return ( 0, "Could not load a valid user", undef );
1471 # If we got a user, but they don't have the right to say things
1472 if ( $AuthStat == 0 ) {
1475 Subject => "Permission Denied",
1477 "You do not have permission to communicate with RT",
1482 "$ErrorsTo tried to submit a message to "
1484 . " without permission.",
1490 unless ($should_store_machine_generated_message) {
1491 return ( 0, $result, undef );
1494 # if plugin's updated SystemTicket then update arguments
1495 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1497 my $Ticket = RT::Ticket->new($CurrentUser);
1499 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1503 my @Requestors = ( $CurrentUser->id );
1505 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1506 @Cc = ParseCcAddressesFromHead(
1508 CurrentUser => $CurrentUser,
1509 QueueObj => $SystemQueueObj
1513 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1514 Queue => $SystemQueueObj->Id,
1515 Subject => $Subject,
1516 Requestor => \@Requestors,
1523 Subject => "Ticket creation failed: $Subject",
1524 Explanation => $ErrStr,
1527 return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
1530 # strip comments&corresponds from the actions we don't need
1531 # to record them if we've created the ticket just now
1532 @actions = grep !/^(comment|correspond)$/, @actions;
1533 $args{'ticket'} = $id;
1535 } elsif ( $args{'ticket'} ) {
1537 $Ticket->Load( $args{'ticket'} );
1538 unless ( $Ticket->Id ) {
1539 my $error = "Could not find a ticket with id " . $args{'ticket'};
1542 Subject => "Message not recorded: $Subject",
1543 Explanation => $error,
1547 return ( 0, $error );
1549 $args{'ticket'} = $Ticket->id;
1551 return ( 1, "Success", $Ticket );
1556 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1557 foreach my $action (@actions) {
1559 # If the action is comment, add a comment.
1560 if ( $action =~ /^(?:comment|correspond)$/i ) {
1561 my $method = ucfirst lc $action;
1562 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1565 #Warn the sender that we couldn't actually submit the comment.
1568 Subject => "Message not recorded: $Subject",
1569 Explanation => $msg,
1572 return ( 0, "Message not recorded: $msg", $Ticket );
1574 } elsif ($unsafe_actions) {
1575 my ( $status, $msg ) = _RunUnsafeAction(
1577 ErrorsTo => $ErrorsTo,
1578 Message => $Message,
1580 CurrentUser => $CurrentUser,
1582 return ($status, $msg, $Ticket) unless $status == 1;
1585 return ( 1, "Success", $Ticket );
1588 =head2 GetAuthenticationLevel
1590 # Authentication Level
1591 # -1 - Get out. this user has been explicitly declined
1592 # 0 - User may not do anything (Not used at the moment)
1594 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1598 sub GetAuthenticationLevel {
1603 RawMessageRef => undef,
1604 SystemTicket => undef,
1605 SystemQueue => undef,
1609 my ( $CurrentUser, $AuthStat, $error );
1611 # Initalize AuthStat so comparisons work correctly
1612 $AuthStat = -9999999;
1614 # if plugin returns AuthStat -2 we skip action
1615 # NOTE: this is experimental API and it would be changed
1616 my %skip_action = ();
1618 # Since this needs loading, no matter what
1619 foreach (@{ $args{MailPlugins} }) {
1620 my ($Code, $NewAuthStat);
1621 if ( ref($_) eq "CODE" ) {
1625 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1628 foreach my $action (@{ $args{Actions} }) {
1629 ( $CurrentUser, $NewAuthStat ) = $Code->(
1630 Message => $args{Message},
1631 RawMessageRef => $args{RawMessageRef},
1632 CurrentUser => $CurrentUser,
1633 AuthLevel => $AuthStat,
1635 Ticket => $args{SystemTicket},
1636 Queue => $args{SystemQueue},
1639 # You get the highest level of authentication you were assigned, unless you get the magic -1
1640 # If a module returns a "-1" then we discard the ticket, so.
1641 $AuthStat = $NewAuthStat
1642 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1644 last if $AuthStat == -1;
1645 $skip_action{$action}++ if $AuthStat == -2;
1648 # strip actions we should skip
1649 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1651 last unless @{$args{Actions}};
1653 last if $AuthStat == -1;
1656 return $AuthStat if !wantarray;
1658 return ($AuthStat, $CurrentUser, $error);
1661 sub _RunUnsafeAction {
1667 CurrentUser => undef,
1671 if ( $args{'Action'} =~ /^take$/i ) {
1672 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1675 To => $args{'ErrorsTo'},
1676 Subject => "Ticket not taken",
1677 Explanation => $msg,
1678 MIMEObj => $args{'Message'}
1680 return ( 0, "Ticket not taken" );
1682 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1683 my ( $status, $msg ) = $args{'Ticket'}->SetStatus('resolved');
1686 #Warn the sender that we couldn't actually submit the comment.
1688 To => $args{'ErrorsTo'},
1689 Subject => "Ticket not resolved",
1690 Explanation => $msg,
1691 MIMEObj => $args{'Message'}
1693 return ( 0, "Ticket not resolved" );
1696 return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
1698 return ( 1, "Success" );
1701 =head2 _NoAuthorizedUserFound
1703 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1707 sub _NoAuthorizedUserFound {
1716 # Notify the RT Admin of the failure.
1718 To => RT->Config->Get('OwnerEmail'),
1719 Subject => "Could not load a valid user",
1720 Explanation => <<EOT,
1721 RT could not load a valid user, and RT's configuration does not allow
1722 for the creation of a new user for this email (@{[$args{Requestor}]}).
1724 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1725 queue @{[$args{'Queue'}]}.
1728 MIMEObj => $args{'Message'},
1732 # Also notify the requestor that his request has been dropped.
1733 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1735 To => $args{'Requestor'},
1736 Subject => "Could not load a valid user",
1737 Explanation => <<EOT,
1738 RT could not load a valid user, and RT's configuration does not allow
1739 for the creation of a new user for your email.
1742 MIMEObj => $args{'Message'},
1748 =head2 _HandleMachineGeneratedMail
1755 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1756 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1757 "This message appears to be a loop (boolean)" );
1761 sub _HandleMachineGeneratedMail {
1762 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1763 my $head = $args{'Message'}->head;
1764 my $ErrorsTo = $args{'ErrorsTo'};
1766 my $IsBounce = CheckForBounce($head);
1768 my $IsAutoGenerated = CheckForAutoGenerated($head);
1770 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1772 my $IsALoop = CheckForLoops($head);
1774 my $SquelchReplies = 0;
1776 my $owner_mail = RT->Config->Get('OwnerEmail');
1778 #If the message is autogenerated, we need to know, so we can not
1779 # send mail to the sender
1780 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1781 $SquelchReplies = 1;
1782 $ErrorsTo = $owner_mail;
1785 # Warn someone if it's a loop, before we drop it on the ground
1787 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1789 #Should we mail it to RTOwner?
1790 if ( RT->Config->Get('LoopsToRTOwner') ) {
1793 Subject => "RT Bounce: ".$args{'Subject'},
1794 Explanation => "RT thinks this message may be a bounce",
1795 MIMEObj => $args{Message}
1799 #Do we actually want to store it?
1800 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1801 unless RT->Config->Get('StoreLoops');
1804 # Squelch replies if necessary
1805 # Don't let the user stuff the RT-Squelch-Replies-To header.
1806 if ( $head->get('RT-Squelch-Replies-To') ) {
1808 'RT-Relocated-Squelch-Replies-To',
1809 $head->get('RT-Squelch-Replies-To')
1811 $head->delete('RT-Squelch-Replies-To');
1814 if ($SquelchReplies) {
1816 # Squelch replies to the sender, and also leave a clue to
1817 # allow us to squelch ALL outbound messages. This way we
1818 # can punt the logic of "what to do when we get a bounce"
1819 # to the scrip. We might want to notify nobody. Or just
1820 # the RT Owner. Or maybe all Privileged watchers.
1821 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1822 $head->add( 'RT-Squelch-Replies-To', $Sender );
1823 $head->add( 'RT-DetectedAutoGenerated', 'true' );
1825 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1828 =head2 IsCorrectAction
1830 Returns a list of valid actions we've found for this message
1834 sub IsCorrectAction {
1836 my @actions = grep $_, split /-/, $action;
1837 return ( 0, '(no value)' ) unless @actions;
1838 foreach ( @actions ) {
1839 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1841 return ( 1, @actions );
1844 sub _RecordSendEmailFailure {
1847 $ticket->_RecordNote(
1848 NoteType => 'SystemError',
1849 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1854 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1859 RT::Base->_ImportOverlays();