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 = Encode::decode( "UTF-8", $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 => Encode::encode( "UTF-8", $args{'From'} ),
257 Bcc => Encode::encode( "UTF-8", $args{'Bcc'} ),
258 To => Encode::encode( "UTF-8", $args{'To'} ),
259 Subject => EncodeToMIME( String => $args{'Subject'} ),
260 'X-RT-Loop-Prevention:' => Encode::encode( "UTF-8", 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:'} =
266 Encode::encode( "UTF-8", RT->Config->Get('DefaultErrorMailPrecedence') );
269 my $entity = MIME::Entity->build(%entity_args);
270 SetInReplyTo( Message => $entity, InReplyTo => $args{'MIMEObj'} );
273 Type => "text/plain",
275 Data => Encode::encode( "UTF-8", $args{'Explanation'} . "\n" ),
278 if ( $args{'MIMEObj'} ) {
279 $args{'MIMEObj'}->sync_headers;
280 $entity->add_part( $args{'MIMEObj'} );
283 if ( $args{'Attach'} ) {
284 $entity->attach( Data => Encode::encode( "UTF-8", $args{'Attach'} ), Type => 'message/rfc822' );
288 SendEmail( Entity => $entity, Bounce => 1 );
292 =head2 SendEmail Entity => undef, [ Bounce => 0, Ticket => undef, Transaction => undef ]
294 Sends an email (passed as a L<MIME::Entity> object C<ENTITY>) using
295 RT's outgoing mail configuration. If C<BOUNCE> is passed, and is a
296 true value, the message will be marked as an autogenerated error, if
297 possible. Sets Date field of the head to now if it's not set.
299 If the C<X-RT-Squelch> header is set to any true value, the mail will
300 not be sent. One use is to let extensions easily cancel outgoing mail.
302 Ticket and Transaction arguments are optional. If Transaction is
303 specified and Ticket is not then ticket of the transaction is
304 used, but only if the transaction belongs to a ticket.
306 Returns 1 on success, 0 on error or -1 if message has no recipients
307 and hasn't been sent.
309 =head3 Signing and Encrypting
311 This function as well signs and/or encrypts the message according to
312 headers of a transaction's attachment or properties of a ticket's queue.
313 To get full access to the configuration Ticket and/or Transaction
314 arguments must be provided, but you can force behaviour using Sign
315 and/or Encrypt arguments.
317 The following precedence of arguments are used to figure out if
318 the message should be encrypted and/or signed:
320 * if Sign or Encrypt argument is defined then its value is used
322 * else if Transaction's first attachment has X-RT-Sign or X-RT-Encrypt
323 header field then it's value is used
325 * else properties of a queue of the Ticket are used.
329 sub WillSignEncrypt {
331 my $attachment = delete $args{Attachment};
332 my $ticket = delete $args{Ticket};
334 if ( not RT->Config->Get('GnuPG')->{'Enable'} ) {
335 $args{Sign} = $args{Encrypt} = 0;
336 return wantarray ? %args : 0;
339 for my $argument ( qw(Sign Encrypt) ) {
340 next if defined $args{ $argument };
342 if ( $attachment and defined $attachment->GetHeader("X-RT-$argument") ) {
343 $args{$argument} = $attachment->GetHeader("X-RT-$argument");
344 } elsif ( $ticket and $argument eq "Encrypt" ) {
345 $args{Encrypt} = $ticket->QueueObj->Encrypt();
346 } elsif ( $ticket and $argument eq "Sign" ) {
347 # Note that $queue->Sign is UI-only, and that all
348 # UI-generated messages explicitly set the X-RT-Crypt header
349 # to 0 or 1; thus this path is only taken for messages
350 # generated _not_ via the web UI.
351 $args{Sign} = $ticket->QueueObj->SignAuto();
355 return wantarray ? %args : ($args{Sign} || $args{Encrypt});
363 Transaction => undef,
367 my $TicketObj = $args{'Ticket'};
368 my $TransactionObj = $args{'Transaction'};
370 foreach my $arg( qw(Entity Bounce) ) {
371 next unless defined $args{ lc $arg };
373 $RT::Logger->warning("'". lc($arg) ."' argument is deprecated, use '$arg' instead");
374 $args{ $arg } = delete $args{ lc $arg };
377 unless ( $args{'Entity'} ) {
378 $RT::Logger->crit( "Could not send mail without 'Entity' object" );
382 my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' );
385 # If we don't have any recipients to send to, don't send a message;
386 unless ( $args{'Entity'}->head->get('To')
387 || $args{'Entity'}->head->get('Cc')
388 || $args{'Entity'}->head->get('Bcc') )
390 $RT::Logger->info( $msgid . " No recipients found. Not sending." );
394 if ($args{'Entity'}->head->get('X-RT-Squelch')) {
395 $RT::Logger->info( $msgid . " Squelch header found. Not sending." );
399 if ( $TransactionObj && !$TicketObj
400 && $TransactionObj->ObjectType eq 'RT::Ticket' )
402 $TicketObj = $TransactionObj->Object;
405 if ( RT->Config->Get('GnuPG')->{'Enable'} ) {
406 %args = WillSignEncrypt(
408 Attachment => $TransactionObj ? $TransactionObj->Attachments->First : undef,
409 Ticket => $TicketObj,
411 my $res = SignEncrypt( %args );
412 return $res unless $res > 0;
415 unless ( $args{'Entity'}->head->get('Date') ) {
417 my $date = RT::Date->new( RT->SystemUser );
419 $args{'Entity'}->head->set( 'Date', Encode::encode( "UTF-8", $date->RFC2822( Timezone => 'server' ) ) );
422 my $mail_command = RT->Config->Get('MailCommand');
424 if ($mail_command eq 'testfile' and not $Mail::Mailer::testfile::config{outfile}) {
425 $Mail::Mailer::testfile::config{outfile} = File::Temp->new;
426 $RT::Logger->info("Storing outgoing emails in $Mail::Mailer::testfile::config{outfile}");
429 # if it is a sub routine, we just return it;
430 return $mail_command->($args{'Entity'}) if UNIVERSAL::isa( $mail_command, 'CODE' );
432 if ( $mail_command eq 'sendmailpipe' ) {
433 my $path = RT->Config->Get('SendmailPath');
434 my @args = shellwords(RT->Config->Get('SendmailArguments'));
436 # SetOutgoingMailFrom and bounces conflict, since they both want -f
437 if ( $args{'Bounce'} ) {
438 push @args, shellwords(RT->Config->Get('SendmailBounceArguments'));
439 } elsif ( my $MailFrom = RT->Config->Get('SetOutgoingMailFrom') ) {
440 my $OutgoingMailAddress = $MailFrom =~ /\@/ ? $MailFrom : undef;
441 my $Overrides = RT->Config->Get('OverrideOutgoingMailFrom') || {};
444 my $QueueName = $TicketObj->QueueObj->Name;
445 my $QueueAddressOverride = $Overrides->{$QueueName};
447 if ($QueueAddressOverride) {
448 $OutgoingMailAddress = $QueueAddressOverride;
450 $OutgoingMailAddress ||= $TicketObj->QueueObj->CorrespondAddress
451 || RT->Config->Get('CorrespondAddress');
454 elsif ($Overrides->{'Default'}) {
455 $OutgoingMailAddress = $Overrides->{'Default'};
458 push @args, "-f", $OutgoingMailAddress
459 if $OutgoingMailAddress;
463 if ( $TransactionObj and
464 my $prefix = RT->Config->Get('VERPPrefix') and
465 my $domain = RT->Config->Get('VERPDomain') )
467 my $from = $TransactionObj->CreatorObj->EmailAddress;
470 push @args, "-f", "$prefix$from\@$domain";
474 # don't ignore CHLD signal to get proper exit code
475 local $SIG{'CHLD'} = 'DEFAULT';
477 # if something wrong with $mail->print we will get PIPE signal, handle it
478 local $SIG{'PIPE'} = sub { die "program unexpectedly closed pipe" };
482 my $pid = IPC::Open2::open2( $stdout, $mail, $path, @args )
483 or die "couldn't execute program: $!";
485 $args{'Entity'}->print($mail);
486 close $mail or die "close pipe failed: $!";
490 # sendmail exit statuses mostly errors with data not software
491 # TODO: status parsing: core dump, exit on signal or EX_*
492 my $msg = "$msgid: `$path @args` exited with code ". ($?>>8);
493 $msg = ", interrupted by signal ". ($?&127) if $?&127;
494 $RT::Logger->error( $msg );
499 $RT::Logger->crit( "$msgid: Could not send mail with command `$path @args`: " . $@ );
501 _RecordSendEmailFailure( $TicketObj );
506 elsif ( $mail_command eq 'smtp' ) {
508 my $smtp = do { local $@; eval { Net::SMTP->new(
509 Host => RT->Config->Get('SMTPServer'),
510 Debug => RT->Config->Get('SMTPDebug'),
513 $RT::Logger->crit( "Could not connect to SMTP server.");
515 _RecordSendEmailFailure( $TicketObj );
520 # duplicate head as we want drop Bcc field
521 my $head = $args{'Entity'}->head->dup;
522 my @recipients = map $_->address, map
523 Email::Address->parse(Encode::decode("UTF-8", $head->get($_))),
525 $head->delete('Bcc');
527 my $sender = RT->Config->Get('SMTPFrom')
528 || Encode::decode( "UTF-8", $args{'Entity'}->head->get('From') );
531 my $status = $smtp->mail( $sender )
532 && $smtp->recipient( @recipients );
536 my $fh = $smtp->tied_fh;
539 $args{'Entity'}->print_body( $fh );
545 $RT::Logger->crit( "$msgid: Could not send mail via SMTP." );
547 _RecordSendEmailFailure( $TicketObj );
553 local ($ENV{'MAILADDRESS'}, $ENV{'PERL_MAILERS'});
555 my @mailer_args = ($mail_command);
556 if ( $mail_command eq 'sendmail' ) {
557 $ENV{'PERL_MAILERS'} = RT->Config->Get('SendmailPath');
558 push @mailer_args, split(/\s+/, RT->Config->Get('SendmailArguments'));
561 push @mailer_args, RT->Config->Get('MailParams');
564 unless ( $args{'Entity'}->send( @mailer_args ) ) {
565 $RT::Logger->crit( "$msgid: Could not send mail." );
567 _RecordSendEmailFailure( $TicketObj );
575 =head2 PrepareEmailUsingTemplate Template => '', Arguments => {}
577 Loads a template. Parses it using arguments if it's not empty.
578 Returns a tuple (L<RT::Template> object, error message).
580 Note that even if a template object is returned MIMEObj method
581 may return undef for empty templates.
585 sub PrepareEmailUsingTemplate {
592 my $template = RT::Template->new( RT->SystemUser );
593 $template->LoadGlobalTemplate( $args{'Template'} );
594 unless ( $template->id ) {
595 return (undef, "Couldn't load template '". $args{'Template'} ."'");
597 return $template if $template->IsEmpty;
599 my ($status, $msg) = $template->Parse( %{ $args{'Arguments'} } );
600 return (undef, $msg) unless $status;
605 =head2 SendEmailUsingTemplate Template => '', Arguments => {}, From => CorrespondAddress, To => '', Cc => '', Bcc => ''
607 Sends email using a template, takes name of template, arguments for it and recipients.
611 sub SendEmailUsingTemplate {
618 From => RT->Config->Get('CorrespondAddress'),
624 my ($template, $msg) = PrepareEmailUsingTemplate( %args );
625 return (0, $msg) unless $template;
627 my $mail = $template->MIMEObj;
629 $RT::Logger->info("Message is not sent as template #". $template->id ." is empty");
633 $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ $_ } ) )
634 foreach grep defined $args{$_}, qw(To Cc Bcc From);
636 $mail->head->set( $_ => Encode::encode( "UTF-8", $args{ExtraHeaders}{$_} ) )
637 foreach keys %{ $args{ExtraHeaders} };
639 SetInReplyTo( Message => $mail, InReplyTo => $args{'InReplyTo'} );
641 return SendEmail( Entity => $mail );
644 =head2 ForwardTransaction TRANSACTION, To => '', Cc => '', Bcc => ''
646 Forwards transaction with all attachments as 'message/rfc822'.
650 sub ForwardTransaction {
652 my %args = ( To => '', Cc => '', Bcc => '', @_ );
654 my $entity = $txn->ContentAsMIME;
656 my ( $ret, $msg ) = SendForward( %args, Entity => $entity, Transaction => $txn );
658 my $ticket = $txn->TicketObj;
659 my ( $ret, $msg ) = $ticket->_NewTransaction(
660 Type => 'Forward Transaction',
662 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
665 $RT::Logger->error("Failed to create transaction: $msg");
668 return ( $ret, $msg );
671 =head2 ForwardTicket TICKET, To => '', Cc => '', Bcc => ''
673 Forwards a ticket's Create and Correspond Transactions and their Attachments as 'message/rfc822'.
679 my %args = ( To => '', Cc => '', Bcc => '', @_ );
681 my $txns = $ticket->Transactions;
685 ) for qw(Create Correspond);
687 my $entity = MIME::Entity->build(
688 Type => 'multipart/mixed',
689 Description => 'forwarded ticket',
691 $entity->add_part( $_ ) foreach
692 map $_->ContentAsMIME,
693 @{ $txns->ItemsArrayRef };
695 my ( $ret, $msg ) = SendForward(
699 Template => 'Forward Ticket',
703 my ( $ret, $msg ) = $ticket->_NewTransaction(
704 Type => 'Forward Ticket',
705 Field => $ticket->id,
706 Data => join ', ', grep { length } $args{To}, $args{Cc}, $args{Bcc},
709 $RT::Logger->error("Failed to create transaction: $msg");
713 return ( $ret, $msg );
717 =head2 SendForward Entity => undef, Ticket => undef, Transaction => undef, Template => undef, To => '', Cc => '', Bcc => ''
719 Forwards an Entity representing Ticket or Transaction as 'message/rfc822'. Entity is wrapped into Template.
727 Transaction => undef,
728 Template => 'Forward',
729 To => '', Cc => '', Bcc => '',
733 my $txn = $args{'Transaction'};
734 my $ticket = $args{'Ticket'};
735 $ticket ||= $txn->Object if $txn;
737 my $entity = $args{'Entity'};
740 $RT::Logger->error(Carp::longmess("No entity provided"));
741 return (0, $ticket->loc("Couldn't send email"));
744 my ($template, $msg) = PrepareEmailUsingTemplate(
745 Template => $args{'Template'},
754 $mail = $template->MIMEObj;
756 $RT::Logger->warning($msg);
759 $RT::Logger->warning("Couldn't generate email using template '$args{Template}'");
762 unless ( $args{'Transaction'} ) {
763 $description = 'This is forward of ticket #'. $ticket->id;
765 $description = 'This is forward of transaction #'
766 . $txn->id ." of a ticket #". $txn->ObjectId;
768 $mail = MIME::Entity->build(
769 Type => 'text/plain',
771 Data => Encode::encode( "UTF-8", $description ),
775 $mail->head->set( $_ => EncodeToMIME( String => $args{$_} ) )
776 foreach grep defined $args{$_}, qw(To Cc Bcc);
778 $mail->make_multipart unless $mail->is_multipart;
779 $mail->add_part( $entity );
782 unless (defined $mail->head->get('Subject')) {
784 $subject = $txn->Subject if $txn;
785 $subject ||= $ticket->Subject if $ticket;
787 unless ( RT->Config->Get('ForwardFromUser') ) {
788 # XXX: what if want to forward txn of other object than ticket?
789 $subject = AddSubjectTag( $subject, $ticket );
792 $mail->head->set( Subject => EncodeToMIME( String => "Fwd: $subject" ) );
796 From => EncodeToMIME(
797 String => GetForwardFrom( Transaction => $txn, Ticket => $ticket )
801 my $status = RT->Config->Get('ForwardFromUser')
802 # never sign if we forward from User
803 ? SendEmail( %args, Entity => $mail, Sign => 0 )
804 : SendEmail( %args, Entity => $mail );
805 return (0, $ticket->loc("Couldn't send email")) unless $status;
806 return (1, $ticket->loc("Sent email successfully"));
809 =head2 GetForwardFrom Ticket => undef, Transaction => undef
811 Resolve the From field to use in forward mail
816 my %args = ( Ticket => undef, Transaction => undef, @_ );
817 my $txn = $args{Transaction};
818 my $ticket = $args{Ticket} || $txn->Object;
820 if ( RT->Config->Get('ForwardFromUser') ) {
821 return ( $txn || $ticket )->CurrentUser->EmailAddress;
824 return $ticket->QueueObj->CorrespondAddress
825 || RT->Config->Get('CorrespondAddress');
829 =head2 SignEncrypt Entity => undef, Sign => 0, Encrypt => 0
831 Signs and encrypts message using L<RT::Crypt::GnuPG>, but as well
832 handle errors with users' keys.
834 If a recipient has no key or has other problems with it, then the
835 unction sends a error to him using 'Error: public key' template.
836 Also, notifies RT's owner using template 'Error to RT owner: public key'
837 to inform that there are problems with users' keys. Then we filter
838 all bad recipients and retry.
840 Returns 1 on success, 0 on error and -1 if all recipients are bad and
841 had been filtered out.
852 return 1 unless $args{'Sign'} || $args{'Encrypt'};
854 my $msgid = Encode::decode( "UTF-8", $args{'Entity'}->head->get('Message-ID') || '' );
857 $RT::Logger->debug("$msgid Signing message") if $args{'Sign'};
858 $RT::Logger->debug("$msgid Encrypting message") if $args{'Encrypt'};
860 require RT::Crypt::GnuPG;
861 my %res = RT::Crypt::GnuPG::SignEncrypt( %args );
862 return 1 unless $res{'exit_code'};
864 my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} );
867 foreach my $line ( @status ) {
868 # if the passphrase fails, either you have a bad passphrase
869 # or gpg-agent has died. That should get caught in Create and
870 # Update, but at least throw an error here
871 if (($line->{'Operation'}||'') eq 'PassphraseCheck'
872 && $line->{'Status'} =~ /^(?:BAD|MISSING)$/ ) {
873 $RT::Logger->error( "$line->{'Status'} PASSPHRASE: $line->{'Message'}" );
876 next unless ($line->{'Operation'}||'') eq 'RecipientsCheck';
877 next if $line->{'Status'} eq 'DONE';
878 $RT::Logger->error( $line->{'Message'} );
879 push @bad_recipients, $line;
881 return 0 unless @bad_recipients;
883 $_->{'AddressObj'} = (Email::Address->parse( $_->{'Recipient'} ))[0]
884 foreach @bad_recipients;
886 foreach my $recipient ( @bad_recipients ) {
887 my $status = SendEmailUsingTemplate(
888 To => $recipient->{'AddressObj'}->address,
889 Template => 'Error: public key',
892 TicketObj => $args{'Ticket'},
893 TransactionObj => $args{'Transaction'},
897 $RT::Logger->error("Couldn't send 'Error: public key'");
901 my $status = SendEmailUsingTemplate(
902 To => RT->Config->Get('OwnerEmail'),
903 Template => 'Error to RT owner: public key',
905 BadRecipients => \@bad_recipients,
906 TicketObj => $args{'Ticket'},
907 TransactionObj => $args{'Transaction'},
911 $RT::Logger->error("Couldn't send 'Error to RT owner: public key'");
914 DeleteRecipientsFromHead(
915 $args{'Entity'}->head,
916 map $_->{'AddressObj'}->address, @bad_recipients
919 unless ( $args{'Entity'}->head->get('To')
920 || $args{'Entity'}->head->get('Cc')
921 || $args{'Entity'}->head->get('Bcc') )
923 $RT::Logger->debug("$msgid No recipients that have public key, not sending");
927 # redo without broken recipients
928 %res = RT::Crypt::GnuPG::SignEncrypt( %args );
929 return 0 if $res{'exit_code'};
938 Takes a hash with a String and a Charset. Returns the string encoded
939 according to RFC2047, using B (base64 based) encoding.
941 String must be a perl string, octets are returned.
943 If Charset is not provided then $EmailOutputEncoding config option
944 is used, or "latin-1" if that is not set.
954 my $value = $args{'String'};
955 return $value unless $value; # 0 is perfect ascii
956 my $charset = $args{'Charset'} || RT->Config->Get('EmailOutputEncoding');
959 # using RFC2047 notation, sec 2.
960 # encoded-word = "=?" charset "?" encoding "?" encoded-text "?="
962 # An 'encoded-word' may not be more than 75 characters long
964 # MIME encoding increases 4/3*(number of bytes), and always in multiples
965 # of 4. Thus we have to find the best available value of bytes available
968 # First we get the integer max which max*4/3 would fit on space.
969 # Then we find the greater multiple of 3 lower or equal than $max.
971 ( ( 75 - length( '=?' . $charset . '?' . $encoding . '?' . '?=' ) )
975 $max = int( $max / 3 ) * 3;
982 $RT::Logger->crit("Can't encode! Charset or encoding too big.");
986 return ($value) if $value =~ /^(?:[\t\x20-\x7e]|\x0D*\x0A[ \t])+$/s;
990 my ( $tmp, @chunks ) = ( '', () );
991 while ( length $value ) {
992 my $char = substr( $value, 0, 1, '' );
993 my $octets = Encode::encode( $charset, $char );
994 if ( length($tmp) + length($octets) > $max ) {
1000 push @chunks, $tmp if length $tmp;
1002 # encode an join chuncks
1003 $value = join "\n ",
1004 map MIME::Words::encode_mimeword( $_, $encoding, $charset ),
1010 my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
1012 my $NewUser = RT::User->new( RT->SystemUser );
1014 my ( $Val, $Message ) = $NewUser->Create(
1015 Name => ( $Username || $Address ),
1016 EmailAddress => $Address,
1020 Comments => 'Autocreated on ticket submission',
1025 # Deal with the race condition of two account creations at once
1027 $NewUser->LoadByName($Username);
1030 unless ( $NewUser->Id ) {
1031 $NewUser->LoadByEmail($Address);
1034 unless ( $NewUser->Id ) {
1037 Subject => "User could not be created",
1039 "User creation failed in mailgateway: $Message",
1046 #Load the new user object
1047 my $CurrentUser = RT::CurrentUser->new;
1048 $CurrentUser->LoadByEmail( $Address );
1050 unless ( $CurrentUser->id ) {
1051 $RT::Logger->warning(
1052 "Couldn't load user '$Address'." . "giving up" );
1055 Subject => "User could not be loaded",
1057 "User '$Address' could not be loaded in the mail gateway",
1063 return $CurrentUser;
1068 =head2 ParseCcAddressesFromHead HASH
1070 Takes a hash containing QueueObj, Head and CurrentUser objects.
1071 Returns a list of all email addresses in the To and Cc
1072 headers b<except> the current Queue's email addresses, the CurrentUser's
1073 email address and anything that the configuration sub RT::IsRTAddress matches.
1077 sub ParseCcAddressesFromHead {
1081 CurrentUser => undef,
1085 my $current_address = lc $args{'CurrentUser'}->EmailAddress;
1086 my $user = $args{'CurrentUser'}->UserObj;
1089 grep { $_ ne $current_address
1090 && !RT::EmailParser->IsRTAddress( $_ )
1091 && !IgnoreCcAddress( $_ )
1093 map lc $user->CanonicalizeEmailAddress( $_->address ),
1094 map RT::EmailParser->CleanupAddresses( Email::Address->parse(
1095 Encode::decode( "UTF-8", $args{'Head'}->get( $_ ) ) ) ),
1099 =head2 IgnoreCcAddress ADDRESS
1101 Returns true if ADDRESS matches the $IgnoreCcRegexp config variable.
1105 sub IgnoreCcAddress {
1106 my $address = shift;
1107 if ( my $address_re = RT->Config->Get('IgnoreCcRegexp') ) {
1108 return 1 if $address =~ /$address_re/i;
1113 =head2 ParseSenderAddressFromHead HEAD
1115 Takes a MIME::Header object. Returns (user@host, friendly name, errors)
1116 where the first two values are the From (evaluated in order of
1117 Reply-To:, From:, Sender).
1119 A list of error messages may be returned even when a Sender value is
1120 found, since it could be a parse error for another (checked earlier)
1121 sender field. In this case, the errors aren't fatal, but may be useful
1122 to investigate the parse failure.
1126 sub ParseSenderAddressFromHead {
1128 my @sender_headers = ('Reply-To', 'From', 'Sender');
1129 my @errors; # Accumulate any errors
1131 #Figure out who's sending this message.
1132 foreach my $header ( @sender_headers ) {
1133 my $addr_line = Encode::decode( "UTF-8", $head->get($header) ) || next;
1134 my ($addr, $name) = ParseAddressFromHeader( $addr_line );
1135 # only return if the address is not empty
1136 return ($addr, $name, @errors) if $addr;
1139 push @errors, "$header: $addr_line";
1142 return (undef, undef, @errors);
1145 =head2 ParseErrorsToAddressFromHead HEAD
1147 Takes a MIME::Header object. Return a single value : user@host
1148 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
1153 sub ParseErrorsToAddressFromHead {
1156 #Figure out who's sending this message.
1158 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
1160 # If there's a header of that name
1161 my $headerobj = Encode::decode( "UTF-8", $head->get($header) );
1163 my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
1165 # If it's got actual useful content...
1166 return ($addr) if ($addr);
1173 =head2 ParseAddressFromHeader ADDRESS
1175 Takes an address from C<$head->get('Line')> and returns a tuple: user@host, friendly name
1179 sub ParseAddressFromHeader {
1182 # Some broken mailers send: ""Vincent, Jesse"" <jesse@fsck.com>. Hate
1183 $Addr =~ s/\"\"(.*?)\"\"/\"$1\"/g;
1184 my @Addresses = RT::EmailParser->ParseEmailAddress($Addr);
1186 my ($AddrObj) = grep ref $_, @Addresses;
1187 unless ( $AddrObj ) {
1188 return ( undef, undef );
1191 return ( $AddrObj->address, $AddrObj->phrase );
1194 =head2 DeleteRecipientsFromHead HEAD RECIPIENTS
1196 Gets a head object and list of addresses.
1197 Deletes addresses from To, Cc or Bcc fields.
1201 sub DeleteRecipientsFromHead {
1203 my %skip = map { lc $_ => 1 } @_;
1205 foreach my $field ( qw(To Cc Bcc) ) {
1206 $head->set( $field => Encode::encode( "UTF-8",
1207 join ', ', map $_->format, grep !$skip{ lc $_->address },
1208 Email::Address->parse( Encode::decode( "UTF-8", $head->get( $field ) ) ) )
1217 ScripAction => undef,
1220 my $org = RT->Config->Get('Organization');
1221 my $ticket_id = ( ref $args{'Ticket'}? $args{'Ticket'}->id : $args{'Ticket'} ) || 0;
1222 my $scrip_id = ( ref $args{'Scrip'}? $args{'Scrip'}->id : $args{'Scrip'} ) || 0;
1223 my $sent = ( ref $args{'ScripAction'}? $args{'ScripAction'}->{'_Message_ID'} : 0 ) || 0;
1225 return "<rt-". $RT::VERSION ."-". $$ ."-". CORE::time() ."-". int(rand(2000)) .'.'
1226 . $ticket_id ."-". $scrip_id ."-". $sent ."@". $org .">" ;
1236 return unless $args{'Message'} && $args{'InReplyTo'};
1238 my $get_header = sub {
1240 if ( $args{'InReplyTo'}->isa('MIME::Entity') ) {
1241 @res = map {Encode::decode("UTF-8", $_)} $args{'InReplyTo'}->head->get( shift );
1243 @res = $args{'InReplyTo'}->GetHeader( shift ) || '';
1245 return grep length, map { split /\s+/m, $_ } grep defined, @res;
1248 my @id = $get_header->('Message-ID');
1249 #XXX: custom header should begin with X- otherwise is violation of the standard
1250 my @rtid = $get_header->('RT-Message-ID');
1251 my @references = $get_header->('References');
1252 unless ( @references ) {
1253 @references = $get_header->('In-Reply-To');
1255 push @references, @id, @rtid;
1256 if ( $args{'Ticket'} ) {
1257 my $pseudo_ref = '<RT-Ticket-'. $args{'Ticket'}->id .'@'. RT->Config->Get('Organization') .'>';
1258 push @references, $pseudo_ref unless grep $_ eq $pseudo_ref, @references;
1260 @references = splice @references, 4, -6
1261 if @references > 10;
1263 my $mail = $args{'Message'};
1264 $mail->head->set( 'In-Reply-To' => Encode::encode( "UTF-8", join ' ', @rtid? (@rtid) : (@id)) ) if @id || @rtid;
1265 $mail->head->set( 'References' => Encode::encode( "UTF-8", join ' ', @references) );
1268 sub ExtractTicketId {
1271 my $subject = Encode::decode( "UTF-8", $entity->head->get('Subject') || '' );
1273 return ParseTicketId( $subject );
1277 my $Subject = shift;
1279 my $rtname = RT->Config->Get('rtname');
1280 my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
1283 if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
1286 foreach my $tag ( RT->System->SubjectTag ) {
1287 next unless $Subject =~ s/\[\Q$tag\E\s+\#(\d+)\s*\]//i;
1292 return undef unless $id;
1294 $RT::Logger->debug("Found a ticket ID. It's $id");
1299 my $subject = shift;
1301 unless ( ref $ticket ) {
1302 my $tmp = RT::Ticket->new( RT->SystemUser );
1303 $tmp->Load( $ticket );
1306 my $id = $ticket->id;
1307 my $queue_tag = $ticket->QueueObj->SubjectTag;
1309 my $tag_re = RT->Config->Get('EmailSubjectTagRegex');
1310 unless ( $tag_re ) {
1311 my $tag = $queue_tag || RT->Config->Get('rtname');
1312 $tag_re = qr/\Q$tag\E/;
1313 } elsif ( $queue_tag ) {
1314 $tag_re = qr/$tag_re|\Q$queue_tag\E/;
1316 return $subject if $subject =~ /\[$tag_re\s+#$id\]/;
1318 $subject =~ s/(\r\n|\n|\s)/ /g;
1320 return "[". ($queue_tag || RT->Config->Get('rtname')) ." #$id] $subject";
1324 =head2 Gateway ARGSREF
1334 This performs all the "guts" of the mail rt-mailgate program, and is
1335 designed to be called from the web interface with a message, user
1338 Can also take an optional 'ticket' parameter; this ticket id overrides
1339 any ticket id found in the subject.
1345 (status code, message, optional ticket object)
1347 status code is a numeric value.
1349 for temporary failures, the status code should be -75
1351 for permanent failures which are handled by RT, the status code
1354 for succces, the status code should be 1
1361 my @mail_plugins = @_;
1364 foreach my $plugin (@mail_plugins) {
1365 if ( ref($plugin) eq "CODE" ) {
1367 } elsif ( !ref $plugin ) {
1368 my $Class = $plugin;
1369 $Class = "RT::Interface::Email::" . $Class
1370 unless $Class =~ /^RT::/;
1372 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
1375 unless ( defined *{ $Class . "::GetCurrentUser" }{CODE} ) {
1376 $RT::Logger->crit( "No GetCurrentUser code found in $Class module");
1381 $RT::Logger->crit( "$plugin - is not class name or code reference");
1388 my $argsref = shift;
1390 action => 'correspond',
1400 # Validate the action
1401 my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
1405 "Invalid 'action' parameter "
1413 my $parser = RT::EmailParser->new();
1414 $parser->SmartParseMIMEEntityFromScalar(
1415 Message => $args{'message'},
1420 my $Message = $parser->Entity();
1423 Subject => "RT Bounce: Unparseable message",
1424 Explanation => "RT couldn't process the message below",
1425 Attach => $args{'message'}
1429 "Failed to parse this message. Something is likely badly wrong with the message"
1433 my @mail_plugins = grep $_, RT->Config->Get('MailPlugins');
1434 push @mail_plugins, "Auth::MailFrom" unless @mail_plugins;
1435 @mail_plugins = _LoadPlugins( @mail_plugins );
1438 foreach my $class( grep !ref, @mail_plugins ) {
1439 # check if we should apply filter before decoding
1442 *{ $class . "::ApplyBeforeDecode" }{CODE};
1444 next unless defined $check_cb;
1445 next unless $check_cb->(
1446 Message => $Message,
1447 RawMessageRef => \$args{'message'},
1450 $skip_plugin{ $class }++;
1454 *{ $class . "::GetCurrentUser" }{CODE};
1456 my ($status, $msg) = $Code->(
1457 Message => $Message,
1458 RawMessageRef => \$args{'message'},
1460 next if $status > 0;
1462 if ( $status == -2 ) {
1463 return (1, $msg, undef);
1464 } elsif ( $status == -1 ) {
1465 return (0, $msg, undef);
1468 @mail_plugins = grep !$skip_plugin{"$_"}, @mail_plugins;
1469 $parser->_DecodeBodies;
1470 $parser->RescueOutlook;
1471 $parser->_PostProcessNewEntity;
1473 my $head = $Message->head;
1474 my $ErrorsTo = ParseErrorsToAddressFromHead( $head );
1475 my $Sender = (ParseSenderAddressFromHead( $head ))[0];
1476 my $From = Encode::decode( "UTF-8", $head->get("From") );
1477 chomp $From if defined $From;
1479 my $MessageId = Encode::decode( "UTF-8", $head->get('Message-ID') )
1480 || "<no-message-id-". time . rand(2000) .'@'. RT->Config->Get('Organization') .'>';
1482 #Pull apart the subject line
1483 my $Subject = Encode::decode( "UTF-8", $head->get('Subject') || '');
1486 # Lets check for mail loops of various sorts.
1487 my ($should_store_machine_generated_message, $IsALoop, $result);
1488 ( $should_store_machine_generated_message, $ErrorsTo, $result, $IsALoop ) =
1489 _HandleMachineGeneratedMail(
1490 Message => $Message,
1491 ErrorsTo => $ErrorsTo,
1492 Subject => $Subject,
1493 MessageId => $MessageId
1496 # Do not pass loop messages to MailPlugins, to make sure the loop
1497 # is broken, unless $RT::StoreLoops is set.
1498 if ($IsALoop && !$should_store_machine_generated_message) {
1499 return ( 0, $result, undef );
1503 $args{'ticket'} ||= ExtractTicketId( $Message );
1505 # ExtractTicketId may have been overridden, and edited the Subject
1506 my $NewSubject = Encode::decode( "UTF-8", $Message->head->get('Subject') );
1509 $SystemTicket = RT::Ticket->new( RT->SystemUser );
1510 $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
1511 if ( $SystemTicket->id ) {
1512 $Right = 'ReplyToTicket';
1514 $Right = 'CreateTicket';
1517 #Set up a queue object
1518 my $SystemQueueObj = RT::Queue->new( RT->SystemUser );
1519 $SystemQueueObj->Load( $args{'queue'} );
1521 # We can safely have no queue of we have a known-good ticket
1522 unless ( $SystemTicket->id || $SystemQueueObj->id ) {
1523 return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
1526 my ($AuthStat, $CurrentUser, $error) = GetAuthenticationLevel(
1527 MailPlugins => \@mail_plugins,
1528 Actions => \@actions,
1529 Message => $Message,
1530 RawMessageRef => \$args{message},
1531 SystemTicket => $SystemTicket,
1532 SystemQueue => $SystemQueueObj,
1535 # If authentication fails and no new user was created, get out.
1536 if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
1538 # If the plugins refused to create one, they lose.
1539 unless ( $AuthStat == -1 ) {
1540 _NoAuthorizedUserFound(
1542 Message => $Message,
1543 Requestor => $ErrorsTo,
1544 Queue => $args{'queue'}
1548 return ( 0, "Could not load a valid user", undef );
1551 # If we got a user, but they don't have the right to say things
1552 if ( $AuthStat == 0 ) {
1555 Subject => "Permission Denied",
1557 "You do not have permission to communicate with RT",
1562 ($CurrentUser->EmailAddress || $CurrentUser->Name)
1563 . " ($Sender) tried to submit a message to "
1565 . " without permission.",
1571 unless ($should_store_machine_generated_message) {
1572 return ( 0, $result, undef );
1575 # if plugin's updated SystemTicket then update arguments
1576 $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
1578 my $Ticket = RT::Ticket->new($CurrentUser);
1580 if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
1584 my @Requestors = ( $CurrentUser->id );
1586 if (RT->Config->Get('ParseNewMessageForTicketCcs')) {
1587 @Cc = ParseCcAddressesFromHead(
1589 CurrentUser => $CurrentUser,
1590 QueueObj => $SystemQueueObj
1594 $head->replace('X-RT-Interface' => 'Email');
1596 my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
1597 Queue => $SystemQueueObj->Id,
1598 Subject => $NewSubject,
1599 Requestor => \@Requestors,
1606 Subject => "Ticket creation failed: $Subject",
1607 Explanation => $ErrStr,
1610 return ( 0, "Ticket creation From: $From failed: $ErrStr", $Ticket );
1613 # strip comments&corresponds from the actions we don't need
1614 # to record them if we've created the ticket just now
1615 @actions = grep !/^(comment|correspond)$/, @actions;
1616 $args{'ticket'} = $id;
1618 } elsif ( $args{'ticket'} ) {
1620 $Ticket->Load( $args{'ticket'} );
1621 unless ( $Ticket->Id ) {
1622 my $error = "Could not find a ticket with id " . $args{'ticket'};
1625 Subject => "Message not recorded: $Subject",
1626 Explanation => $error,
1630 return ( 0, $error );
1632 $args{'ticket'} = $Ticket->id;
1634 return ( 1, "Success", $Ticket );
1639 my $unsafe_actions = RT->Config->Get('UnsafeEmailCommands');
1640 foreach my $action (@actions) {
1642 # If the action is comment, add a comment.
1643 if ( $action =~ /^(?:comment|correspond)$/i ) {
1644 my $method = ucfirst lc $action;
1645 my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
1648 #Warn the sender that we couldn't actually submit the comment.
1651 Subject => "Message not recorded ($method): $Subject",
1652 Explanation => $msg,
1655 return ( 0, "Message From: $From not recorded: $msg", $Ticket );
1657 } elsif ($unsafe_actions) {
1658 my ( $status, $msg ) = _RunUnsafeAction(
1660 ErrorsTo => $ErrorsTo,
1661 Message => $Message,
1663 CurrentUser => $CurrentUser,
1665 return ($status, $msg, $Ticket) unless $status == 1;
1668 return ( 1, "Success", $Ticket );
1671 =head2 GetAuthenticationLevel
1673 # Authentication Level
1674 # -1 - Get out. this user has been explicitly declined
1675 # 0 - User may not do anything (Not used at the moment)
1677 # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
1681 sub GetAuthenticationLevel {
1686 RawMessageRef => undef,
1687 SystemTicket => undef,
1688 SystemQueue => undef,
1692 my ( $CurrentUser, $AuthStat, $error );
1694 # Initalize AuthStat so comparisons work correctly
1695 $AuthStat = -9999999;
1697 # if plugin returns AuthStat -2 we skip action
1698 # NOTE: this is experimental API and it would be changed
1699 my %skip_action = ();
1701 # Since this needs loading, no matter what
1702 foreach (@{ $args{MailPlugins} }) {
1703 my ($Code, $NewAuthStat);
1704 if ( ref($_) eq "CODE" ) {
1708 $Code = *{ $_ . "::GetCurrentUser" }{CODE};
1711 foreach my $action (@{ $args{Actions} }) {
1712 ( $CurrentUser, $NewAuthStat ) = $Code->(
1713 Message => $args{Message},
1714 RawMessageRef => $args{RawMessageRef},
1715 CurrentUser => $CurrentUser,
1716 AuthLevel => $AuthStat,
1718 Ticket => $args{SystemTicket},
1719 Queue => $args{SystemQueue},
1722 # You get the highest level of authentication you were assigned, unless you get the magic -1
1723 # If a module returns a "-1" then we discard the ticket, so.
1724 $AuthStat = $NewAuthStat
1725 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
1727 last if $AuthStat == -1;
1728 $skip_action{$action}++ if $AuthStat == -2;
1731 # strip actions we should skip
1732 @{$args{Actions}} = grep !$skip_action{$_}, @{$args{Actions}}
1734 last unless @{$args{Actions}};
1736 last if $AuthStat == -1;
1739 return $AuthStat if !wantarray;
1741 return ($AuthStat, $CurrentUser, $error);
1744 sub _RunUnsafeAction {
1750 CurrentUser => undef,
1754 my $From = Encode::decode( "UTF-8", $args{Message}->head->get("From") );
1756 if ( $args{'Action'} =~ /^take$/i ) {
1757 my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
1760 To => $args{'ErrorsTo'},
1761 Subject => "Ticket not taken",
1762 Explanation => $msg,
1763 MIMEObj => $args{'Message'}
1765 return ( 0, "Ticket not taken, by email From: $From" );
1767 } elsif ( $args{'Action'} =~ /^resolve$/i ) {
1768 my $new_status = $args{'Ticket'}->FirstInactiveStatus;
1770 my ( $status, $msg ) = $args{'Ticket'}->SetStatus($new_status);
1773 #Warn the sender that we couldn't actually submit the comment.
1775 To => $args{'ErrorsTo'},
1776 Subject => "Ticket not resolved",
1777 Explanation => $msg,
1778 MIMEObj => $args{'Message'}
1780 return ( 0, "Ticket not resolved, by email From: $From" );
1784 return ( 0, "Not supported unsafe action $args{'Action'}, by email From: $From", $args{'Ticket'} );
1786 return ( 1, "Success" );
1789 =head2 _NoAuthorizedUserFound
1791 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
1795 sub _NoAuthorizedUserFound {
1804 # Notify the RT Admin of the failure.
1806 To => RT->Config->Get('OwnerEmail'),
1807 Subject => "Could not load a valid user",
1808 Explanation => <<EOT,
1809 RT could not load a valid user, and RT's configuration does not allow
1810 for the creation of a new user for this email (@{[$args{Requestor}]}).
1812 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
1813 queue @{[$args{'Queue'}]}.
1816 MIMEObj => $args{'Message'},
1820 # Also notify the requestor that his request has been dropped.
1821 if ($args{'Requestor'} ne RT->Config->Get('OwnerEmail')) {
1823 To => $args{'Requestor'},
1824 Subject => "Could not load a valid user",
1825 Explanation => <<EOT,
1826 RT could not load a valid user, and RT's configuration does not allow
1827 for the creation of a new user for your email.
1830 MIMEObj => $args{'Message'},
1836 =head2 _HandleMachineGeneratedMail
1843 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
1844 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message",
1845 "This message appears to be a loop (boolean)" );
1849 sub _HandleMachineGeneratedMail {
1850 my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
1851 my $head = $args{'Message'}->head;
1852 my $ErrorsTo = $args{'ErrorsTo'};
1854 my $IsBounce = CheckForBounce($head);
1856 my $IsAutoGenerated = CheckForAutoGenerated($head);
1858 my $IsSuspiciousSender = CheckForSuspiciousSender($head);
1860 my $IsALoop = CheckForLoops($head);
1862 my $SquelchReplies = 0;
1864 my $owner_mail = RT->Config->Get('OwnerEmail');
1866 #If the message is autogenerated, we need to know, so we can not
1867 # send mail to the sender
1868 if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
1869 $SquelchReplies = 1;
1870 $ErrorsTo = $owner_mail;
1873 # Warn someone if it's a loop, before we drop it on the ground
1875 $RT::Logger->crit("RT Received mail (".$args{MessageId}.") from itself.");
1877 #Should we mail it to RTOwner?
1878 if ( RT->Config->Get('LoopsToRTOwner') ) {
1881 Subject => "RT Bounce: ".$args{'Subject'},
1882 Explanation => "RT thinks this message may be a bounce",
1883 MIMEObj => $args{Message}
1887 #Do we actually want to store it?
1888 return ( 0, $ErrorsTo, "Message Bounced", $IsALoop )
1889 unless RT->Config->Get('StoreLoops');
1892 # Squelch replies if necessary
1893 # Don't let the user stuff the RT-Squelch-Replies-To header.
1894 if ( $head->get('RT-Squelch-Replies-To') ) {
1896 'RT-Relocated-Squelch-Replies-To',
1897 $head->get('RT-Squelch-Replies-To')
1899 $head->delete('RT-Squelch-Replies-To');
1902 if ($SquelchReplies) {
1904 # Squelch replies to the sender, and also leave a clue to
1905 # allow us to squelch ALL outbound messages. This way we
1906 # can punt the logic of "what to do when we get a bounce"
1907 # to the scrip. We might want to notify nobody. Or just
1908 # the RT Owner. Or maybe all Privileged watchers.
1909 my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
1910 $head->replace( 'RT-Squelch-Replies-To', Encode::encode("UTF-8", $Sender ) );
1911 $head->replace( 'RT-DetectedAutoGenerated', 'true' );
1913 return ( 1, $ErrorsTo, "Handled machine detection", $IsALoop );
1916 =head2 IsCorrectAction
1918 Returns a list of valid actions we've found for this message
1922 sub IsCorrectAction {
1924 my @actions = grep $_, split /-/, $action;
1925 return ( 0, '(no value)' ) unless @actions;
1926 foreach ( @actions ) {
1927 return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
1929 return ( 1, @actions );
1932 sub _RecordSendEmailFailure {
1935 $ticket->_RecordNote(
1936 NoteType => 'SystemError',
1937 Content => "Sending the previous mail has failed. Please contact your admin, they can find more details in the logs.",
1942 $RT::Logger->error( "Can't record send email failure as ticket is missing" );
1947 RT::Base->_ImportOverlays();