rt/lib/RT/Interface/Email.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  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
  16 # from www.gnu.org.
  17 #
  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.
  22 #
  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., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 #
  27 #
  28 # CONTRIBUTION SUBMISSION POLICY:
  29 #
  30 # (The following paragraph is not intended to limit the rights granted
  31 # to you to modify and distribute this software under the terms of
  32 # the GNU General Public License and is only of importance to you if
  33 # you choose to contribute your changes and enhancements to the
  34 # community by submitting them to Best Practical Solutions, LLC.)
  35 #
  36 # By intentionally submitting any modifications, corrections or
  37 # derivatives to this work, or any other work intended for use with
  38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  39 # you are the copyright holder for those contributions and you grant
  40 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  41 # royalty-free, perpetual, license to use, copy, create derivative
  42 # works based on those contributions, and sublicense and distribute
  43 # those contributions and any derivatives thereof.
  44 #
  45 # END BPS TAGGED BLOCK }}}
  46 package RT::Interface::Email;
  47
  48 use strict;
  49 use Mail::Address;
  50 use MIME::Entity;
  51 use RT::EmailParser;
  52 use File::Temp;
  53 use UNIVERSAL::require;
  54
  55 BEGIN {
  56     use Exporter ();
  57     use vars qw ( @ISA @EXPORT_OK);
  58
  59     # set the version for version checking
  60     our $VERSION = 2.0;
  61
  62     @ISA = qw(Exporter);
  63
  64     # your exported package globals go here,
  65     # as well as any optionally exported functions
  66     @EXPORT_OK = qw(
  67         &CreateUser
  68         &GetMessageContent
  69         &CheckForLoops
  70         &CheckForSuspiciousSender
  71         &CheckForAutoGenerated
  72         &CheckForBounce
  73         &MailError
  74         &ParseCcAddressesFromHead
  75         &ParseSenderAddressFromHead
  76         &ParseErrorsToAddressFromHead
  77         &ParseAddressFromHeader
  78         &Gateway);
  79
  80 }
  81
  82 =head1 NAME
  83
  84   RT::Interface::Email - helper functions for parsing email sent to RT
  85
  86 =head1 SYNOPSIS
  87
  88   use lib "!!RT_LIB_PATH!!";
  89   use lib "!!RT_ETC_PATH!!";
  90
  91   use RT::Interface::Email  qw(Gateway CreateUser);
  92
  93 =head1 DESCRIPTION
  94
  95
  96 =begin testing
  97
  98 ok(require RT::Interface::Email);
  99
 100 =end testing
 101
 102
 103 =head1 METHODS
 104
 105 =cut
 106
 107 # {{{ sub CheckForLoops
 108
 109 sub CheckForLoops {
 110     my $head = shift;
 111
 112     #If this instance of RT sent it our, we don't want to take it in
 113     my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
 114     chomp($RTLoop);    #remove that newline
 115     if ( $RTLoop eq "$RT::rtname" ) {
 116         return (1);
 117     }
 118
 119     # TODO: We might not trap the case where RT instance A sends a mail
 120     # to RT instance B which sends a mail to ...
 121     return (undef);
 122 }
 123
 124 # }}}
 125
 126 # {{{ sub CheckForSuspiciousSender
 127
 128 sub CheckForSuspiciousSender {
 129     my $head = shift;
 130
 131     #if it's from a postmaster or mailer daemon, it's likely a bounce.
 132
 133     #TODO: better algorithms needed here - there is no standards for
 134     #bounces, so it's very difficult to separate them from anything
 135     #else.  At the other hand, the Return-To address is only ment to be
 136     #used as an error channel, we might want to put up a separate
 137     #Return-To address which is treated differently.
 138
 139     #TODO: search through the whole email and find the right Ticket ID.
 140
 141     my ( $From, $junk ) = ParseSenderAddressFromHead($head);
 142
 143     if (   ( $From =~ /^mailer-daemon\@/i )
 144         or ( $From =~ /^postmaster\@/i ) )
 145     {
 146         return (1);
 147
 148     }
 149
 150     return (undef);
 151
 152 }
 153
 154 # }}}
 155
 156 # {{{ sub CheckForAutoGenerated
 157 sub CheckForAutoGenerated {
 158     my $head = shift;
 159
 160     my $Precedence = $head->get("Precedence") || "";
 161     if ( $Precedence =~ /^(bulk|junk)/i ) {
 162         return (1);
 163     }
 164
 165     # First Class mailer uses this as a clue.
 166     my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
 167     if ( $FCJunk =~ /^true/i ) {
 168         return (1);
 169     }
 170
 171     return (0);
 172 }
 173
 174 # }}}
 175
 176 # {{{ sub CheckForBounce
 177 sub CheckForBounce {
 178     my $head = shift;
 179
 180     my $ReturnPath = $head->get("Return-path") || "";
 181     return ( $ReturnPath =~ /<>/ );
 182 }
 183
 184 # }}}
 185
 186 # {{{ IsRTAddress
 187
 188 =head2 IsRTAddress ADDRESS
 189
 190 Takes a single parameter, an email address.
 191 Returns true if that address matches the $RTAddressRegexp.
 192 Returns false, otherwise.
 193
 194 =cut
 195
 196 sub IsRTAddress {
 197     my $address = shift || '';
 198
 199     # Example: the following rule would tell RT not to Cc
 200     #   "tickets@noc.example.com"
 201     if ( defined($RT::RTAddressRegexp)
 202         && $address =~ /$RT::RTAddressRegexp/i )
 203     {
 204         return (1);
 205     } else {
 206         return (undef);
 207     }
 208 }
 209
 210 # }}}
 211
 212 # {{{ CullRTAddresses
 213
 214 =head2 CullRTAddresses ARRAY
 215
 216 Takes a single argument, an array of email addresses.
 217 Returns the same array with any IsRTAddress()es weeded out.
 218
 219 =cut
 220
 221 sub CullRTAddresses {
 222     return ( grep { IsRTAddress($_) } @_ );
 223 }
 224
 225 # }}}
 226
 227 # {{{ sub MailError
 228 sub MailError {
 229     my %args = (
 230         To          => $RT::OwnerEmail,
 231         Bcc         => undef,
 232         From        => $RT::CorrespondAddress,
 233         Subject     => 'There has been an error',
 234         Explanation => 'Unexplained error',
 235         MIMEObj     => undef,
 236         Attach      => undef,
 237         LogLevel    => 'crit',
 238         @_
 239     );
 240
 241     $RT::Logger->log(
 242         level   => $args{'LogLevel'},
 243         message => $args{'Explanation'}
 244     );
 245     my $entity = MIME::Entity->build(
 246         Type                   => "multipart/mixed",
 247         From                   => $args{'From'},
 248         Bcc                    => $args{'Bcc'},
 249         To                     => $args{'To'},
 250         Subject                => $args{'Subject'},
 251         Precedence             => 'bulk',
 252         'X-RT-Loop-Prevention' => $RT::rtname,
 253     );
 254
 255     $entity->attach( Data => $args{'Explanation'} . "\n" );
 256
 257     my $mimeobj = $args{'MIMEObj'};
 258     if ($mimeobj) {
 259         $mimeobj->sync_headers();
 260         $entity->add_part($mimeobj);
 261     }
 262
 263     if ( $args{'Attach'} ) {
 264         $entity->attach( Data => $args{'Attach'}, Type => 'message/rfc822' );
 265
 266     }
 267
 268     if ( $RT::MailCommand eq 'sendmailpipe' ) {
 269         open( MAIL,
 270             "|$RT::SendmailPath $RT::SendmailBounceArguments $RT::SendmailArguments"
 271             )
 272             || return (0);
 273         print MAIL $entity->as_string;
 274         close(MAIL);
 275     } else {
 276         $entity->send( $RT::MailCommand, $RT::MailParams );
 277     }
 278 }
 279
 280 # }}}
 281
 282 # {{{ Create User
 283
 284 sub CreateUser {
 285     my ( $Username, $Address, $Name, $ErrorsTo, $entity ) = @_;
 286     my $NewUser = RT::User->new($RT::SystemUser);
 287
 288     my ( $Val, $Message ) = $NewUser->Create(
 289         Name => ( $Username || $Address ),
 290         EmailAddress => $Address,
 291         RealName     => $Name,
 292         Password     => undef,
 293         Privileged   => 0,
 294         Comments     => 'Autocreated on ticket submission'
 295     );
 296
 297     unless ($Val) {
 298
 299         # Deal with the race condition of two account creations at once
 300         #
 301         if ($Username) {
 302             $NewUser->LoadByName($Username);
 303         }
 304
 305         unless ( $NewUser->Id ) {
 306             $NewUser->LoadByEmail($Address);
 307         }
 308
 309         unless ( $NewUser->Id ) {
 310             MailError(
 311                 To          => $ErrorsTo,
 312                 Subject     => "User could not be created",
 313                 Explanation =>
 314                     "User creation failed in mailgateway: $Message",
 315                 MIMEObj  => $entity,
 316                 LogLevel => 'crit'
 317             );
 318         }
 319     }
 320
 321     #Load the new user object
 322     my $CurrentUser = RT::CurrentUser->new();
 323     $CurrentUser->LoadByEmail($Address);
 324
 325     unless ( $CurrentUser->id ) {
 326         $RT::Logger->warning(
 327             "Couldn't load user '$Address'." . "giving up" );
 328         MailError(
 329             To          => $ErrorsTo,
 330             Subject     => "User could not be loaded",
 331             Explanation =>
 332                 "User  '$Address' could not be loaded in the mail gateway",
 333             MIMEObj  => $entity,
 334             LogLevel => 'crit'
 335         );
 336     }
 337
 338     return $CurrentUser;
 339 }
 340
 341 # }}}
 342
 343 # {{{ ParseCcAddressesFromHead
 344
 345 =head2 ParseCcAddressesFromHead HASHREF
 346
 347 Takes a hashref object containing QueueObj, Head and CurrentUser objects.
 348 Returns a list of all email addresses in the To and Cc
 349 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
 350 email address  and anything that the configuration sub RT::IsRTAddress matches.
 351
 352 =cut
 353
 354 sub ParseCcAddressesFromHead {
 355     my %args = (
 356         Head        => undef,
 357         QueueObj    => undef,
 358         CurrentUser => undef,
 359         @_
 360     );
 361
 362     my (@Addresses);
 363
 364     my @ToObjs = Mail::Address->parse( $args{'Head'}->get('To') );
 365     my @CcObjs = Mail::Address->parse( $args{'Head'}->get('Cc') );
 366
 367     foreach my $AddrObj ( @ToObjs, @CcObjs ) {
 368         my $Address = $AddrObj->address;
 369         $Address = $args{'CurrentUser'}
 370             ->UserObj->CanonicalizeEmailAddress($Address);
 371         next if ( $args{'CurrentUser'}->EmailAddress   =~ /^\Q$Address\E$/i );
 372         next if ( $args{'QueueObj'}->CorrespondAddress =~ /^\Q$Address\E$/i );
 373         next if ( $args{'QueueObj'}->CommentAddress    =~ /^\Q$Address\E$/i );
 374         next if ( RT::EmailParser->IsRTAddress($Address) );
 375
 376         push( @Addresses, $Address );
 377     }
 378     return (@Addresses);
 379 }
 380
 381 # }}}
 382
 383 # {{{ ParseSenderAdddressFromHead
 384
 385 =head2 ParseSenderAddressFromHead
 386
 387 Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
 388 of the From (evaluated in order of Reply-To:, From:, Sender)
 389
 390 =cut
 391
 392 sub ParseSenderAddressFromHead {
 393     my $head = shift;
 394
 395     #Figure out who's sending this message.
 396     my $From = $head->get('Reply-To')
 397         || $head->get('From')
 398         || $head->get('Sender');
 399     return ( ParseAddressFromHeader($From) );
 400 }
 401
 402 # }}}
 403
 404 # {{{ ParseErrorsToAdddressFromHead
 405
 406 =head2 ParseErrorsToAddressFromHead
 407
 408 Takes a MIME::Header object. Return a single value : user@host
 409 of the From (evaluated in order of Return-path:,Errors-To:,Reply-To:,
 410 From:, Sender)
 411
 412 =cut
 413
 414 sub ParseErrorsToAddressFromHead {
 415     my $head = shift;
 416
 417     #Figure out who's sending this message.
 418
 419     foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
 420
 421         # If there's a header of that name
 422         my $headerobj = $head->get($header);
 423         if ($headerobj) {
 424             my ( $addr, $name ) = ParseAddressFromHeader($headerobj);
 425
 426             # If it's got actual useful content...
 427             return ($addr) if ($addr);
 428         }
 429     }
 430 }
 431
 432 # }}}
 433
 434 # {{{ ParseAddressFromHeader
 435
 436 =head2 ParseAddressFromHeader ADDRESS
 437
 438 Takes an address from $head->get('Line') and returns a tuple: user@host, friendly name
 439
 440 =cut
 441
 442 sub ParseAddressFromHeader {
 443     my $Addr = shift;
 444
 445     my @Addresses = Mail::Address->parse($Addr);
 446
 447     my $AddrObj = $Addresses[0];
 448
 449     unless ( ref($AddrObj) ) {
 450         return ( undef, undef );
 451     }
 452
 453     my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
 454
 455     #Lets take the from and load a user object.
 456     my $Address = $AddrObj->address;
 457
 458     return ( $Address, $Name );
 459 }
 460
 461 # }}}
 462
 463 # {{{ sub ParseTicketId
 464
 465 sub ParseTicketId {
 466     my $Subject = shift;
 467     my $id;
 468
 469     my $test_name = $RT::EmailSubjectTagRegex || qr/\Q$RT::rtname\E/i;
 470
 471     if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
 472         my $id = $1;
 473         $RT::Logger->debug("Found a ticket ID. It's $id");
 474         return ($id);
 475     } else {
 476         return (undef);
 477     }
 478 }
 479
 480 # }}}
 481
 482 =head2 Gateway ARGSREF
 483
 484
 485 Takes parameters:
 486
 487     action
 488     queue
 489     message
 490
 491
 492 This performs all the "guts" of the mail rt-mailgate program, and is
 493 designed to be called from the web interface with a message, user
 494 object, and so on.
 495
 496 Can also take an optional 'ticket' parameter; this ticket id overrides
 497 any ticket id found in the subject.
 498
 499 Returns:
 500
 501     An array of:
 502
 503     (status code, message, optional ticket object)
 504
 505     status code is a numeric value.
 506
 507       for temporary failures, the status code should be -75
 508
 509       for permanent failures which are handled by RT, the status code
 510       should be 0
 511
 512       for succces, the status code should be 1
 513
 514
 515
 516 =cut
 517
 518 sub Gateway {
 519     my $argsref = shift;
 520     my %args    = (
 521         action  => 'correspond',
 522         queue   => '1',
 523         ticket  => undef,
 524         message => undef,
 525         %$argsref
 526     );
 527
 528     my $SystemTicket;
 529     my $Right;
 530
 531     # Validate the action
 532     my ( $status, @actions ) = IsCorrectAction( $args{'action'} );
 533     unless ($status) {
 534         return (
 535             -75,
 536             "Invalid 'action' parameter "
 537                 . $actions[0]
 538                 . " for queue "
 539                 . $args{'queue'},
 540             undef
 541         );
 542     }
 543
 544     my $parser = RT::EmailParser->new();
 545     $parser->SmartParseMIMEEntityFromScalar( Message => $args{'message'} );
 546     my $Message = $parser->Entity();
 547
 548     unless ($Message) {
 549         MailError(
 550             To          => $RT::OwnerEmail,
 551             Subject     => "RT Bounce: Unparseable message",
 552             Explanation => "RT couldn't process the message below",
 553             Attach      => $args{'message'}
 554         );
 555
 556         return ( 0,
 557             "Failed to parse this message. Something is likely badly wrong with the message"
 558         );
 559     }
 560
 561     my $head = $Message->head;
 562
 563     my $ErrorsTo = ParseErrorsToAddressFromHead($head);
 564
 565     my $MessageId = $head->get('Message-ID')
 566         || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>";
 567
 568     #Pull apart the subject line
 569     my $Subject = $head->get('Subject') || '';
 570     chomp $Subject;
 571
 572     $args{'ticket'} ||= ParseTicketId($Subject);
 573
 574     $SystemTicket = RT::Ticket->new($RT::SystemUser);
 575     $SystemTicket->Load( $args{'ticket'} ) if ( $args{'ticket'} ) ;
 576     if ( $SystemTicket->id ) {
 577         $Right = 'ReplyToTicket';
 578     } else {
 579         $Right = 'CreateTicket';
 580     }
 581
 582     #Set up a queue object
 583     my $SystemQueueObj = RT::Queue->new($RT::SystemUser);
 584     $SystemQueueObj->Load( $args{'queue'} );
 585
 586     # We can safely have no queue of we have a known-good ticket
 587     unless ( $SystemTicket->id || $SystemQueueObj->id ) {
 588         return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
 589     }
 590
 591     # Authentication Level ($AuthStat)
 592     # -1 - Get out.  this user has been explicitly declined
 593     # 0 - User may not do anything (Not used at the moment)
 594     # 1 - Normal user
 595     # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
 596     my ( $CurrentUser, $AuthStat, $error );
 597
 598     # Initalize AuthStat so comparisons work correctly
 599     $AuthStat = -9999999;
 600
 601     push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
 602
 603     # if plugin returns AuthStat -2 we skip action
 604     # NOTE: this is experimental API and it would be changed
 605     my %skip_action = ();
 606
 607     # Since this needs loading, no matter what
 608     foreach (@RT::MailPlugins) {
 609         my ($Code, $NewAuthStat);
 610         if ( ref($_) eq "CODE" ) {
 611             $Code = $_;
 612         } else {
 613             my $Class = $_;
 614             $Class = "RT::Interface::Email::" . $Class
 615                 unless $Class =~ /^RT::Interface::Email::/;
 616             $Class->require or
 617                 do { $RT::Logger->error("Couldn't load $Class: $@"); next };
 618
 619             no strict 'refs';
 620             unless ( defined( $Code = *{ $Class . "::GetCurrentUser" }{CODE} ) ) {
 621                 $RT::Logger->crit( "No 'GetCurrentUser' function found in '$Class' module");
 622                 next;
 623             }
 624         }
 625
 626         foreach my $action (@actions) {
 627             ( $CurrentUser, $NewAuthStat ) = $Code->(
 628                 Message       => $Message,
 629                 RawMessageRef => \$args{'message'},
 630                 CurrentUser   => $CurrentUser,
 631                 AuthLevel     => $AuthStat,
 632                 Action        => $action,
 633                 Ticket        => $SystemTicket,
 634                 Queue         => $SystemQueueObj
 635             );
 636
 637 # You get the highest level of authentication you were assigned, unless you get the magic -1
 638 # If a module returns a "-1" then we discard the ticket, so.
 639             $AuthStat = $NewAuthStat
 640                 if ( $NewAuthStat > $AuthStat or $NewAuthStat == -1 or $NewAuthStat == -2 );
 641
 642             last if $AuthStat == -1;
 643             $skip_action{$action}++ if $AuthStat == -2;
 644         }
 645
 646         last if $AuthStat == -1;
 647     }
 648     # {{{ If authentication fails and no new user was created, get out.
 649     if ( !$CurrentUser || !$CurrentUser->id || $AuthStat == -1 ) {
 650
 651         # If the plugins refused to create one, they lose.
 652         unless ( $AuthStat == -1 ) {
 653             _NoAuthorizedUserFound(
 654                 Right     => $Right,
 655                 Message   => $Message,
 656                 Requestor => $ErrorsTo,
 657                 Queue     => $args{'queue'}
 658             );
 659
 660         }
 661         return ( 0, "Could not load a valid user", undef );
 662     }
 663
 664     # If we got a user, but they don't have the right to say things
 665     if ( $AuthStat == 0 ) {
 666         MailError(
 667             To          => $ErrorsTo,
 668             Subject     => "Permission Denied",
 669             Explanation =>
 670                 "You do not have permission to communicate with RT",
 671             MIMEObj => $Message
 672         );
 673         return (
 674             0,
 675             "$ErrorsTo tried to submit a message to "
 676                 . $args{'Queue'}
 677                 . " without permission.",
 678             undef
 679         );
 680     }
 681
 682     # {{{ Lets check for mail loops of various sorts.
 683     my ($continue, $result);
 684      ( $continue, $ErrorsTo, $result ) = _HandleMachineGeneratedMail(
 685         Message  => $Message,
 686         ErrorsTo => $ErrorsTo,
 687         Subject  => $Subject,
 688         MessageId => $MessageId
 689     );
 690
 691     unless ($continue) {
 692         return ( 0, $result, undef );
 693     }
 694
 695     # strip actions we should skip
 696     @actions = grep !$skip_action{$_}, @actions;
 697
 698     # if plugin's updated SystemTicket then update arguments
 699     $args{'ticket'} = $SystemTicket->Id if $SystemTicket && $SystemTicket->Id;
 700
 701     my $Ticket = RT::Ticket->new($CurrentUser);
 702
 703     if ( !$args{'ticket'} && grep /^(comment|correspond)$/, @actions )
 704     {
 705
 706         my @Cc;
 707         my @Requestors = ( $CurrentUser->id );
 708
 709         if ($RT::ParseNewMessageForTicketCcs) {
 710             @Cc = ParseCcAddressesFromHead(
 711                 Head        => $head,
 712                 CurrentUser => $CurrentUser,
 713                 QueueObj    => $SystemQueueObj
 714             );
 715         }
 716
 717         my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
 718             Queue     => $SystemQueueObj->Id,
 719             Subject   => $Subject,
 720             Requestor => \@Requestors,
 721             Cc        => \@Cc,
 722             MIMEObj   => $Message
 723         );
 724         if ( $id == 0 ) {
 725             MailError(
 726                 To          => $ErrorsTo,
 727                 Subject     => "Ticket creation failed",
 728                 Explanation => $ErrStr,
 729                 MIMEObj     => $Message
 730             );
 731             return ( 0, "Ticket creation failed: $ErrStr", $Ticket );
 732         }
 733
 734         # strip comments&corresponds from the actions we don't need
 735         # to record them if we've created the ticket just now
 736         @actions = grep !/^(comment|correspond)$/, @actions;
 737         $args{'ticket'} = $id;
 738
 739     } else {
 740
 741         $Ticket->Load( $args{'ticket'} );
 742         unless ( $Ticket->Id ) {
 743             my $error = "Could not find a ticket with id " . $args{'ticket'};
 744             MailError(
 745                 To          => $ErrorsTo,
 746                 Subject     => "Message not recorded",
 747                 Explanation => $error,
 748                 MIMEObj     => $Message
 749             );
 750
 751             return ( 0, $error );
 752         }
 753     }
 754
 755     # }}}
 756     foreach my $action (@actions) {
 757
 758         #   If the action is comment, add a comment.
 759         if ( $action =~ /^(?:comment|correspond)$/i ) {
 760             my $method = ucfirst lc $action;
 761             my ( $status, $msg ) = $Ticket->$method( MIMEObj => $Message );
 762             unless ($status) {
 763
 764                 #Warn the sender that we couldn't actually submit the comment.
 765                 MailError(
 766                     To          => $ErrorsTo,
 767                     Subject     => "Message not recorded",
 768                     Explanation => $msg,
 769                     MIMEObj     => $Message
 770                 );
 771                 return ( 0, "Message not recorded: $msg", $Ticket );
 772             }
 773         } elsif ($RT::UnsafeEmailCommands) {
 774             my ( $status, $msg ) = _RunUnsafeAction(
 775                 Action      => $action,
 776                 ErrorsTo    => $ErrorsTo,
 777                 Message     => $Message,
 778                 Ticket      => $Ticket,
 779                 CurrentUser => $CurrentUser,
 780             );
 781             return ($status, $msg, $Ticket) unless $status == 1;
 782         }
 783     }
 784     return ( 1, "Success", $Ticket );
 785 }
 786
 787 sub _RunUnsafeAction {
 788     my %args = (
 789         Action      => undef,
 790         ErrorsTo    => undef,
 791         Message     => undef,
 792         Ticket      => undef,
 793         CurrentUser => undef,
 794         @_
 795     );
 796
 797     if ( $args{'Action'} =~ /^take$/i ) {
 798         my ( $status, $msg ) = $args{'Ticket'}->SetOwner( $args{'CurrentUser'}->id );
 799         unless ($status) {
 800             MailError(
 801                 To          => $args{'ErrorsTo'},
 802                 Subject     => "Ticket not taken",
 803                 Explanation => $msg,
 804                 MIMEObj     => $args{'Message'}
 805             );
 806             return ( 0, "Ticket not taken" );
 807         }
 808     } elsif ( $args{'Action'} =~ /^resolve$/i ) {
 809         my ( $status, $msg ) = $args{'Ticket'}->SetStatus('resolved');
 810         unless ($status) {
 811
 812             #Warn the sender that we couldn't actually submit the comment.
 813             MailError(
 814                 To          => $args{'ErrorsTo'},
 815                 Subject     => "Ticket not resolved",
 816                 Explanation => $msg,
 817                 MIMEObj     => $args{'Message'}
 818             );
 819             return ( 0, "Ticket not resolved" );
 820         }
 821     } else {
 822         return ( 0, "Not supported unsafe action $args{'Action'}", $args{'Ticket'} );
 823     }
 824     return ( 1, "Success" );
 825 }
 826
 827 =head2 _NoAuthorizedUserFound
 828
 829 Emails the RT Owner and the requestor when the auth plugins return "No auth user found"
 830
 831 =cut
 832
 833 sub _NoAuthorizedUserFound {
 834     my %args = (
 835         Right     => undef,
 836         Message   => undef,
 837         Requestor => undef,
 838         Queue     => undef,
 839         @_
 840     );
 841
 842     # Notify the RT Admin of the failure.
 843     MailError(
 844         To          => $RT::OwnerEmail,
 845         Subject     => "Could not load a valid user",
 846         Explanation => <<EOT,
 847 RT could not load a valid user, and RT's configuration does not allow
 848 for the creation of a new user for this email (@{[$args{Requestor}]}).
 849
 850 You might need to grant 'Everyone' the right '@{[$args{Right}]}' for the
 851 queue @{[$args{'Queue'}]}.
 852
 853 EOT
 854         MIMEObj  => $args{'Message'},
 855         LogLevel => 'error'
 856     );
 857
 858     # Also notify the requestor that his request has been dropped.
 859     MailError(
 860         To          => $args{'Requestor'},
 861         Subject     => "Could not load a valid user",
 862         Explanation => <<EOT,
 863 RT could not load a valid user, and RT's configuration does not allow
 864 for the creation of a new user for your email.
 865
 866 EOT
 867         MIMEObj  => $args{'Message'},
 868         LogLevel => 'error'
 869     );
 870 }
 871
 872 =head2 _HandleMachineGeneratedMail
 873
 874 Takes named params:
 875     Message
 876     ErrorsTo
 877     Subject
 878
 879 Checks the message to see if it's a bounce, if it looks like a loop, if it's autogenerated, etc.
 880 Returns a triple of ("Should we continue (boolean)", "New value for $ErrorsTo", "Status message");
 881
 882 =cut
 883
 884 sub _HandleMachineGeneratedMail {
 885     my %args = ( Message => undef, ErrorsTo => undef, Subject => undef, MessageId => undef, @_ );
 886     my $head = $args{'Message'}->head;
 887     my $ErrorsTo = $args{'ErrorsTo'};
 888
 889     my $IsBounce = CheckForBounce($head);
 890
 891     my $IsAutoGenerated = CheckForAutoGenerated($head);
 892
 893     my $IsSuspiciousSender = CheckForSuspiciousSender($head);
 894
 895     my $IsALoop = CheckForLoops($head);
 896
 897     my $SquelchReplies = 0;
 898
 899     #If the message is autogenerated, we need to know, so we can not
 900     # send mail to the sender
 901     if ( $IsBounce || $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
 902         $SquelchReplies = 1;
 903         $ErrorsTo       = $RT::OwnerEmail;
 904     }
 905
 906     # Warn someone if it's a loop, before we drop it on the ground
 907     if ($IsALoop) {
 908         $RT::Logger->crit("RT Recieved mail (".$args{MessageId}.") from itself.");
 909
 910         #Should we mail it to RTOwner?
 911         if ($RT::LoopsToRTOwner) {
 912             MailError(
 913                 To          => $RT::OwnerEmail,
 914                 Subject     => "RT Bounce: ".$args{'Subject'},
 915                 Explanation => "RT thinks this message may be a bounce",
 916                 MIMEObj     => $args{Message}
 917             );
 918         }
 919
 920         #Do we actually want to store it?
 921         return ( 0, $ErrorsTo, "Message Bounced" ) unless ($RT::StoreLoops);
 922     }
 923
 924     # Squelch replies if necessary
 925     # Don't let the user stuff the RT-Squelch-Replies-To header.
 926     if ( $head->get('RT-Squelch-Replies-To') ) {
 927         $head->add(
 928             'RT-Relocated-Squelch-Replies-To',
 929             $head->get('RT-Squelch-Replies-To')
 930         );
 931         $head->delete('RT-Squelch-Replies-To');
 932     }
 933
 934     if ($SquelchReplies) {
 935
 936         # Squelch replies to the sender, and also leave a clue to
 937         # allow us to squelch ALL outbound messages. This way we
 938         # can punt the logic of "what to do when we get a bounce"
 939         # to the scrip. We might want to notify nobody. Or just
 940         # the RT Owner. Or maybe all Privileged watchers.
 941         my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
 942         $head->add( 'RT-Squelch-Replies-To',    $Sender );
 943         $head->add( 'RT-DetectedAutoGenerated', 'true' );
 944     }
 945     return ( 1, $ErrorsTo, "Handled machine detection" );
 946 }
 947
 948 =head2 IsCorrectAction
 949
 950 Returns a list of valid actions we've found for this message
 951
 952 =cut
 953
 954 sub IsCorrectAction {
 955     my $action = shift;
 956     my @actions = split /-/, $action;
 957     foreach (@actions) {
 958         return ( 0, $_ ) unless /^(?:comment|correspond|take|resolve)$/;
 959     }
 960     return ( 1, @actions );
 961 }
 962
 963 eval "require RT::Interface::Email_Vendor";
 964 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm} );
 965 eval "require RT::Interface::Email_Local";
 966 die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm} );
 967
 968 1;