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