import rt 3.4.4
[freeside.git] / rt / lib / RT / Interface / Email.pm
index e954360..5db7c8a 100755 (executable)
@@ -1,74 +1,98 @@
-# $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/Interface/Email.pm,v 1.1 2002-08-12 06:17:08 ivan Exp $
-# RT is (c) 1996-2001 Jesse Vincent <jesse@fsck.com>
-
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+#  
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC 
+#                                          <jesse@bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
 package RT::Interface::Email;
 
 use strict;
 use Mail::Address;
 use MIME::Entity;
+use RT::EmailParser;
+use File::Temp;
 
 BEGIN {
     use Exporter ();
     use vars qw ($VERSION  @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
     
     # set the version for version checking
-    $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
+    $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
     
     @ISA         = qw(Exporter);
     
     # your exported package globals go here,
     # as well as any optionally exported functions
-    @EXPORT_OK   = qw(&CleanEnv 
-                     &LoadConfig 
-                     &DBConnect 
-                     &GetCurrentUser
-                     &GetMessageContent
-                     &CheckForLoops 
-                     &CheckForSuspiciousSender
-                     &CheckForAutoGenerated 
-                     &ParseMIMEEntityFromSTDIN
-                     &ParseTicketId 
-                     &MailError 
-                     &ParseCcAddressesFromHead
-                     &ParseSenderAddressFromHead 
-                     &ParseErrorsToAddressFromHead
+    @EXPORT_OK   = qw(
+              &CreateUser
+              &GetMessageContent
+              &CheckForLoops 
+              &CheckForSuspiciousSender
+              &CheckForAutoGenerated 
+              &MailError 
+              &ParseCcAddressesFromHead
+              &ParseSenderAddressFromHead 
+              &ParseErrorsToAddressFromHead
               &ParseAddressFromHeader
+              &Gateway);
 
-
-                     &debug);
 }
 
 =head1 NAME
 
-  RT::Interface::CLI - helper functions for creating a commandline RT interface
+  RT::Interface::Email - helper functions for parsing email sent to RT
 
 =head1 SYNOPSIS
 
   use lib "!!RT_LIB_PATH!!";
   use lib "!!RT_ETC_PATH!!";
 
-  use RT::Interface::Email  qw(CleanEnv LoadConfig DBConnect 
-                             );
-
-  #Clean out all the nasties from the environment
-  CleanEnv();
-
-  #Load etc/config.pm and drop privs
-  LoadConfig();
-
-  #Connect to the database and get RT::SystemUser and RT::Nobody loaded
-  DBConnect();
-
-
-  #Get the current user all loaded
-  my $CurrentUser = GetCurrentUser();
+  use RT::Interface::Email  qw(Gateway CreateUser);
 
 =head1 DESCRIPTION
 
 
 =begin testing
 
-ok(require RT::TestHarness);
 ok(require RT::Interface::Email);
 
 =end testing
@@ -79,71 +103,6 @@ ok(require RT::Interface::Email);
 =cut
 
 
-=head2 CleanEnv
-
-Removes some of the nastiest nasties from the user\'s environment.
-
-=cut
-
-sub CleanEnv {
-    $ENV{'PATH'} = '/bin:/usr/bin';    # or whatever you need
-    $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'};
-    $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
-    $ENV{'ENV'} = '' if defined $ENV{'ENV'};
-    $ENV{'IFS'} = '' if defined $ENV{'IFS'};
-}
-
-
-
-=head2 LoadConfig
-
-Loads RT's config file and then drops setgid privileges.
-
-=cut
-
-sub LoadConfig {
-    
-    #This drags in  RT's config.pm
-    use config;
-    
-}      
-
-
-
-=head2 DBConnect
-
-  Calls RT::Init, which creates a database connection and then creates $RT::Nobody
-  and $RT::SystemUser
-
-=cut
-
-
-sub DBConnect {
-    use RT;
-    RT::Init();
-}
-
-
-
-# {{{ sub debug
-
-sub debug {
-    my $val = shift;
-    my ($debug);
-    if ($val) {
-       $RT::Logger->debug($val."\n");
-       if ($debug) {
-           print STDERR "$val\n";
-       }
-    }
-    if ($debug) {
-       return(1);
-    }  
-}
-
-# }}}
-
-
 # {{{ sub CheckForLoops 
 
 sub CheckForLoops  {
@@ -180,8 +139,8 @@ sub CheckForSuspiciousSender {
 
     my ($From, $junk) = ParseSenderAddressFromHead($head);
     
-    if (($From =~ /^mailer-daemon/i) or
-       ($From =~ /^postmaster/i)){
+    if (($From =~ /^mailer-daemon\@/i) or
+       ($From =~ /^postmaster\@/i)){
        return (1);
        
     }
@@ -200,88 +159,56 @@ sub CheckForAutoGenerated {
     if ($Precedence =~ /^(bulk|junk)/i) {
        return (1);
     }
-    else {
-       return (0);
+    
+    # First Class mailer uses this as a clue.
+    my $FCJunk = $head->get("X-FC-Machinegenerated") || "";
+    if ($FCJunk =~ /^true/i) {
+        return (1);
     }
+
+    return (0);
 }
 
 # }}}
 
-# {{{ sub ParseMIMEEntityFromSTDIN
-
-sub ParseMIMEEntityFromSTDIN {
+# {{{ IsRTAddress
 
-    # Create a new parser object:
-    
-    my $parser = new MIME::Parser;
-    
-    # {{{ Config $parser to store large attacments in temp dir
-
-    ## TODO: Does it make sense storing to disk at all?  After all, we
-    ## need to put each msg as an in-core scalar before saving it to
-    ## the database, don't we?
+=head2 IsRTAddress ADDRESS
 
-    ## At the same time, we should make sure that we nuke attachments 
-    ## Over max size and return them
+Takes a single parameter, an email address. 
+Returns true if that address matches the $RTAddressRegexp.  
+Returns false, otherwise.
 
-    ## TODO: Remove the temp dir when we don't need it any more.
+=cut
 
-    my $AttachmentDir = File::Temp::tempdir (TMPDIR => 1, CLEANUP => 1);
-    
-    # Set up output directory for files:
-    $parser->output_dir("$AttachmentDir");
-  
-    #If someone includes a message, don't extract it
-    $parser->extract_nested_messages(0);
+sub IsRTAddress {
+    my $address = shift || '';
 
-   
-    # Set up the prefix for files with auto-generated names:
-    $parser->output_prefix("part");
+    # Example: the following rule would tell RT not to Cc 
+    #   "tickets@noc.example.com"
+    if ( defined($RT::RTAddressRegexp) &&
+                       $address =~ /$RT::RTAddressRegexp/ ) {
+        return(1);
+    } else {
+        return (undef);
+    }
+}
 
-    # If content length is <= 20000 bytes, store each msg as in-core scalar;
-    # Else, write to a disk file (the default action):
-  
-    $parser->output_to_core(20000);
+# }}}
 
-    # }}} (temporary directory)
+# {{{ CullRTAddresses
 
-    #Ok. now that we're set up, let's get the stdin.
-    my $entity;
-    unless ($entity = $parser->read(\*STDIN)) {
-       die "couldn't parse MIME stream";
-    }
-    #Now we've got a parsed mime object. 
-    
-    # Get the head, a MIME::Head:
-    my $head = $entity->head;
-   
+=head2 CullRTAddresses ARRAY
 
-    # Unfold headers that are have embedded newlines
-    $head->unfold; 
-    
-    # TODO - information about the charset is lost here!
-    $head->decode;
+Takes a single argument, an array of email addresses.
+Returns the same array with any IsRTAddress()es weeded out.
 
-    return ($entity, $head);
+=cut
 
+sub CullRTAddresses {
+    return (grep { IsRTAddress($_) } @_);
 }
-# }}}
-
-# {{{ sub ParseTicketId 
 
-sub ParseTicketId {
-    my $Subject = shift;
-    my ($Id);
-    
-    if ($Subject =~ s/\[$RT::rtname \#(\d+)\]//i) {
-       $Id = $1;
-       $RT::Logger->debug("Found a ticket ID. It's $Id");
-       return($Id);
-    }
-    else {
-       return(undef);
-    }
-}
 # }}}
 
 # {{{ sub MailError 
@@ -292,6 +219,7 @@ sub MailError {
                Subject => 'There has been an error',
                Explanation => 'Unexplained error',
                MIMEObj => undef,
+        Attach => undef,
                LogLevel => 'crit',
                @_);
 
@@ -304,6 +232,7 @@ sub MailError {
                                      Bcc => $args{'Bcc'},
                                      To => $args{'To'},
                                      Subject => $args{'Subject'},
+                                     Precedence => 'bulk',
                                      'X-RT-Loop-Prevention' => $RT::rtname,
                                    );
 
@@ -313,7 +242,12 @@ sub MailError {
     if ($mimeobj) {
         $mimeobj->sync_headers();
         $entity->add_part($mimeobj);
-    } 
+    }
+   
+    if ($args{'Attach'}) {
+        $entity->attach(Data => $args{'Attach'}, Type => 'message/rfc822');
+
+    }
 
     if ($RT::MailCommand eq 'sendmailpipe') {
         open (MAIL, "|$RT::SendmailPath $RT::SendmailArguments") || return(0);
@@ -321,147 +255,64 @@ sub MailError {
         close(MAIL);
     }
     else {
-       $entity->send($RT::MailCommand, $RT::MailParams);
+       $entity->send($RT::MailCommand, $RT::MailParams);
     }
 }
 
 # }}}
 
-# {{{ sub GetCurrentUser 
-
-sub GetCurrentUser  {
-    my $head = shift;
-    my $entity = shift;
-    my $ErrorsTo = shift;
+# {{{ Create User
 
-    my %UserInfo = ();
+sub CreateUser {
+    my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_;
+    my $NewUser = RT::User->new($RT::SystemUser);
 
-    #Suck the address of the sender out of the header
-    my ($Address, $Name) = ParseSenderAddressFromHead($head);
+    my ($Val, $Message) = 
+      $NewUser->Create(Name => ($Username || $Address),
+                       EmailAddress => $Address,
+                       RealName => $Name,
+                       Password => undef,
+                       Privileged => 0,
+                       Comments => 'Autocreated on ticket submission'
+                      );
     
-    #This will apply local address canonicalization rules
-    $Address = RT::CanonicalizeAddress($Address);
-  
-    #If desired, synchronize with an external database
-
-    my $UserFoundInExternalDatabase = 0;
-
-    # Username is the 'Name' attribute of the user that RT uses for things
-    # like authentication
-    my $Username = undef;
-    if ($RT::LookupSenderInExternalDatabase) {
-       ($UserFoundInExternalDatabase, %UserInfo) = 
-         RT::LookupExternalUserInfo($Address, $Name);
-   
-       $Address = $UserInfo{'EmailAddress'};
-       $Username = $UserInfo{'Name'}; 
+    unless ($Val) {
+        
+        # Deal with the race condition of two account creations at once
+        #
+        if ($Username) {
+            $NewUser->LoadByName($Username);
+        }
+        
+        unless ($NewUser->Id) {
+            $NewUser->LoadByEmail($Address);
+        }
+        
+        unless ($NewUser->Id) {  
+            MailError( To => $ErrorsTo,
+                       Subject => "User could not be created",
+                       Explanation => "User creation failed in mailgateway: $Message",
+                       MIMEObj => $entity,
+                       LogLevel => 'crit'
+                     );
+        }
     }
-    
-    my $CurrentUser = RT::CurrentUser->new();
-    
-    # First try looking up by a username, if we got one from the external
-    # db lookup. Next, try looking up by email address. Failing that,
-    # try looking up by users who have this user's email address as their
-    # username.
-
-    if ($Username) {
-       $CurrentUser->LoadByName($Username);
-    }  
-    
-    unless ($CurrentUser->Id) {
-       $CurrentUser->LoadByEmail($Address);
-    }  
 
-    #If we can't get it by email address, try by name.  
-    unless ($CurrentUser->Id) {
-       $CurrentUser->LoadByName($Address);
-    }
-    
-    
-    unless ($CurrentUser->Id) {
-        #If we couldn't load a user, determine whether to create a user
-
-        # {{{ If we require an incoming address to be found in the external
-       # user database, reject the incoming message appropriately
-        if ( $RT::LookupSenderInExternalDatabase &&
-            $RT::SenderMustExistInExternalDatabase && 
-            !$UserFoundInExternalDatabase) {
-           
-           my $Message = "Sender's email address was not found in the user database.";
-
-           # {{{  This code useful only if you've defined an AutoRejectRequest template
-           
-           require RT::Template;
-           my $template = new RT::Template($RT::Nobody);
-           $template->Load('AutoRejectRequest');
-           $Message = $template->Content || $Message;
-           
-           # }}}
-           
-           MailError( To => $ErrorsTo,
-                      Subject => "Ticket Creation failed: user could not be created",
-                      Explanation => $Message,
-                      MIMEObj => $entity,
-                      LogLevel => 'notice'
-                    );
-
-           return($CurrentUser);
-
-       } 
-       # }}}
-       
-       else {
-           my $NewUser = RT::User->new($RT::SystemUser);
-           
-           my ($Val, $Message) = 
-             $NewUser->Create(Name => ($Username || $Address),
-                              EmailAddress => $Address,
-                              RealName => "$Name",
-                              Password => undef,
-                              Privileged => 0,
-                              Comments => 'Autocreated on ticket submission'
-                             );
-           
-           unless ($Val) {
-               
-               # Deal with the race condition of two account creations at once
-               #
-               if ($Username) {
-                   $NewUser->LoadByName($Username);
-               }
-               
-               unless ($NewUser->Id) {
-                   $NewUser->LoadByEmail($Address);
-               }
-               
-               unless ($NewUser->Id) {  
-                   MailError( To => $ErrorsTo,
-                              Subject => "User could not be created",
-                              Explanation => "User creation failed in mailgateway: $Message",
-                              MIMEObj => $entity,
-                              LogLevel => 'crit'
-                            );
-               }
-           }
-       }
-       
-       #Load the new user object
-       $CurrentUser->LoadByEmail($Address);
-       
-       unless ($CurrentUser->id) {
-           $RT::Logger->warning("Couldn't load user '$Address'.".  "giving up");
-               MailError( To => $ErrorsTo,
-                          Subject => "User could not be loaded",
-                          Explanation => "User  '$Address' could not be loaded in the mail gateway",
-                          MIMEObj => $entity,
-                          LogLevel => 'crit'
-                        );
-           
-       }
+    #Load the new user object
+    my $CurrentUser = RT::CurrentUser->new();
+    $CurrentUser->LoadByEmail($Address);
+
+    unless ($CurrentUser->id) {
+            $RT::Logger->warning("Couldn't load user '$Address'.".  "giving up");
+                MailError( To => $ErrorsTo,
+                           Subject => "User could not be loaded",
+                           Explanation => "User  '$Address' could not be loaded in the mail gateway",
+                           MIMEObj => $entity,
+                           LogLevel => 'crit'
+                     );
     }
-    
-    return ($CurrentUser);
-    
+
+    return $CurrentUser;
 }
 # }}}
 
@@ -489,11 +340,11 @@ sub ParseCcAddressesFromHead {
     
     foreach my $AddrObj (@ToObjs, @CcObjs) {
        my $Address = $AddrObj->address;
-       $Address = RT::CanonicalizeAddress($Address);
-       next if ($args{'CurrentUser'}->EmailAddress =~ /^$Address$/i);
-       next if ($args{'QueueObj'}->CorrespondAddress =~ /^$Address$/i);
-       next if ($args{'QueueObj'}->CommentAddress =~ /^$Address$/i);
-       next if (RT::IsRTAddress($Address));
+       $Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($Address);
+       next if ($args{'CurrentUser'}->EmailAddress =~ /^\Q$Address\E$/i);
+       next if ($args{'QueueObj'}->CorrespondAddress =~ /^\Q$Address\E$/i);
+       next if ($args{'QueueObj'}->CommentAddress =~ /^\Q$Address\E$/i);
+       next if (RT::EmailParser->IsRTAddress($Address));
        
        push (@Addresses, $Address);
     }
@@ -559,6 +410,8 @@ Takes an address from $head->get('Line') and returns a tuple: user@host, friendl
 sub ParseAddressFromHeader{
     my $Addr = shift;
     
+    # Perl 5.8.0 breaks when doing regex matches on utf8
+    Encode::_utf8_off($Addr) if $] == 5.008;
     my @Addresses = Mail::Address->parse($Addr);
     
     my $AddrObj = $Addresses[0];
@@ -568,8 +421,7 @@ sub ParseAddressFromHeader{
     }
  
     my $Name =  ($AddrObj->phrase || $AddrObj->comment || $AddrObj->address);
-
-
+    
     #Lets take the from and load a user object.
     my $Address = $AddrObj->address;
 
@@ -577,5 +429,455 @@ sub ParseAddressFromHeader{
 }
 # }}}
 
+# {{{ sub ParseTicketId 
+
+
+sub ParseTicketId {
+    my $Subject = shift;
+    my $id;
+
+    my $test_name = $RT::EmailSubjectTagRegex || qr/\Q$RT::rtname\E/;
+
+    if ( $Subject =~ s/\[$test_name\s+\#(\d+)\s*\]//i ) {
+        my $id = $1;
+        $RT::Logger->debug("Found a ticket ID. It's $id");
+        return ($id);
+    }
+    else {
+        return (undef);
+    }
+}
+
+# }}}
+
+
+=head2 Gateway ARGSREF
+
+
+Takes parameters:
+
+    action
+    queue
+    message
+
+
+This performs all the "guts" of the mail rt-mailgate program, and is
+designed to be called from the web interface with a message, user
+object, and so on.
+
+Can also take an optional 'ticket' parameter; this ticket id overrides
+any ticket id found in the subject.
+
+Returns:
+
+    An array of:
+    
+    (status code, message, optional ticket object)
+
+    status code is a numeric value.
+
+      for temporary failures, the status code should be -75
+
+      for permanent failures which are handled by RT, the status code 
+      should be 0
+    
+      for succces, the status code should be 1
+
+
+
+=cut
+
+sub Gateway {
+    my $argsref = shift;
+
+    my %args = %$argsref;
+
+    # Set some reasonable defaults
+    $args{'action'} ||= 'correspond';
+    $args{'queue'}  ||= '1';
+
+    # Validate the action
+    my ($status, @actions) = IsCorrectAction( $args{'action'} );
+    unless ( $status ) {
+
+        # Can't safely loc this. What object do we loc around?
+        $RT::Logger->crit("Mail gateway called with an invalid action paramenter '".$actions[0]."' for queue '".$args{'queue'}."'");
+
+        return ( -75, "Invalid 'action' parameter", undef );
+    }
+
+    my $parser = RT::EmailParser->new();
+
+    $parser->SmartParseMIMEEntityFromScalar( Message => $args{'message'});
+
+    if (!$parser->Entity()) {
+        MailError(
+            To          => $RT::OwnerEmail,
+            Subject     => "RT Bounce: Unparseable message",
+            Explanation => "RT couldn't process the message below",
+            Attach     => $args{'message'}
+        );
+
+        return(0,"Failed to parse this message. Something is likely badly wrong with the message");
+    }
+
+    my $Message = $parser->Entity();
+    my $head    = $Message->head;
+
+    my ( $CurrentUser, $AuthStat, $error );
+
+    # Initalize AuthStat so comparisons work correctly
+    $AuthStat = -9999999;
+
+    my $ErrorsTo = ParseErrorsToAddressFromHead($head);
+
+    my $MessageId = $head->get('Message-ID')
+      || "<no-message-id-" . time . rand(2000) . "\@.$RT::Organization>";
+
+    #Pull apart the subject line
+    my $Subject = $head->get('Subject') || '';
+    chomp $Subject;
+
+    $args{'ticket'} ||= ParseTicketId($Subject);
+
+    my $SystemTicket;
+    my $Right = 'CreateTicket';
+    if ( $args{'ticket'} ) {
+        $SystemTicket = RT::Ticket->new($RT::SystemUser);
+        $SystemTicket->Load( $args{'ticket'} );
+       # if there's an existing ticket, this must be a reply
+       $Right = 'ReplyToTicket';
+    }
+
+    #Set up a queue object
+    my $SystemQueueObj = RT::Queue->new($RT::SystemUser);
+    $SystemQueueObj->Load( $args{'queue'} );
+
+    # We can safely have no queue of we have a known-good ticket
+    unless ( $args{'ticket'} || $SystemQueueObj->id ) {
+        return ( -75, "RT couldn't find the queue: " . $args{'queue'}, undef );
+    }
+
+    # Authentication Level
+    # -1 - Get out.  this user has been explicitly declined
+    # 0 - User may not do anything (Not used at the moment)
+    # 1 - Normal user
+    # 2 - User is allowed to specify status updates etc. a la enhanced-mailgate
+
+    push @RT::MailPlugins, "Auth::MailFrom" unless @RT::MailPlugins;
+
+    # Since this needs loading, no matter what
+
+    foreach (@RT::MailPlugins) {
+        my $Code;
+        my $NewAuthStat;
+        if ( ref($_) eq "CODE" ) {
+            $Code = $_;
+        }
+        else {
+            $_ = "RT::Interface::Email::".$_ unless $_ =~ /^RT::Interface::Email::/;
+            eval "require $_;";
+            if ($@) {
+                $RT::Logger->crit("Couldn't load module '$_': $@");
+                next;
+            }
+            no strict 'refs';
+            if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) {
+                $RT::Logger->crit("No GetCurrentUser code found in $_ module");
+                next;
+            }
+        }
+
+       foreach my $action ( @actions ) {
+
+            ( $CurrentUser, $NewAuthStat ) = $Code->(
+                Message     => $Message,
+                RawMessageRef => \$args{'message'},
+                CurrentUser => $CurrentUser,
+                AuthLevel   => $AuthStat,
+                Action      => $action,
+                Ticket      => $SystemTicket,
+                Queue       => $SystemQueueObj
+            );
+
+
+            # If a module returns a "-1" then we discard the ticket, so.
+            $AuthStat = -1 if $NewAuthStat == -1;
+
+            # You get the highest level of authentication you were assigned.
+            $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
+
+            last if $AuthStat == -1;
+       }
+
+        last if $AuthStat == -1;
+    }
+
+    # {{{ If authentication fails and no new user was created, get out.
+    if ( !$CurrentUser or !$CurrentUser->Id or $AuthStat == -1 ) {
+
+        # If the plugins refused to create one, they lose.
+        unless ( $AuthStat == -1 ) {
+
+            # Notify the RT Admin of the failure.
+            # XXX Should this be configurable?
+            MailError(
+                To          => $RT::OwnerEmail,
+                Subject     => "Could not load a valid user",
+                Explanation => <<EOT,
+RT could not load a valid user, and RT's configuration does not allow
+for the creation of a new user for this email ($ErrorsTo).
+
+You might need to grant 'Everyone' the right '$Right' for the
+queue @{[$args{'queue'}]}.
+
+EOT
+                MIMEObj  => $Message,
+                LogLevel => 'error'
+            );
+
+            # Also notify the requestor that his request has been dropped.
+            MailError(
+                To          => $ErrorsTo,
+                Subject     => "Could not load a valid user",
+                Explanation => <<EOT,
+RT could not load a valid user, and RT's configuration does not allow
+for the creation of a new user for your email.
+
+EOT
+                MIMEObj  => $Message,
+                LogLevel => 'error'
+            );
+        }
+        return ( 0, "Could not load a valid user", undef );
+    }
+
+    # }}}
+
+    # {{{ Lets check for mail loops of various sorts.
+    my $IsAutoGenerated = CheckForAutoGenerated($head);
+
+    my $IsSuspiciousSender = CheckForSuspiciousSender($head);
+
+    my $IsALoop = CheckForLoops($head);
+
+    my $SquelchReplies = 0;
+
+    #If the message is autogenerated, we need to know, so we can not
+    # send mail to the sender
+    if ( $IsSuspiciousSender || $IsAutoGenerated || $IsALoop ) {
+        $SquelchReplies = 1;
+        $ErrorsTo       = $RT::OwnerEmail;
+    }
+
+    # }}}
+
+    # {{{ Drop it if it's disallowed
+    if ( $AuthStat == 0 ) {
+        MailError(
+            To          => $ErrorsTo,
+            Subject     => "Permission Denied",
+            Explanation => "You do not have permission to communicate with RT",
+            MIMEObj     => $Message
+        );
+    }
+
+    # }}}
+    # {{{ Warn someone  if it's a loop
+
+    # Warn someone if it's a loop, before we drop it on the ground
+    if ($IsALoop) {
+        $RT::Logger->crit("RT Recieved mail ($MessageId) from itself.");
+
+        #Should we mail it to RTOwner?
+        if ($RT::LoopsToRTOwner) {
+            MailError(
+                To          => $RT::OwnerEmail,
+                Subject     => "RT Bounce: $Subject",
+                Explanation => "RT thinks this message may be a bounce",
+                MIMEObj     => $Message
+            );
+        }
+
+        #Do we actually want to store it?
+        return ( 0, "Message Bounced", undef ) unless ($RT::StoreLoops);
+    }
+
+    # }}}
+
+    # {{{ Squelch replies if necessary
+    # Don't let the user stuff the RT-Squelch-Replies-To header.
+    if ( $head->get('RT-Squelch-Replies-To') ) {
+        $head->add(
+            'RT-Relocated-Squelch-Replies-To',
+            $head->get('RT-Squelch-Replies-To')
+        );
+        $head->delete('RT-Squelch-Replies-To');
+    }
+
+    if ($SquelchReplies) {
+
+        # Squelch replies to the sender, and also leave a clue to
+        # allow us to squelch ALL outbound messages. This way we
+        # can punt the logic of "what to do when we get a bounce"
+        # to the scrip. We might want to notify nobody. Or just
+        # the RT Owner. Or maybe all Privileged watchers.
+        my ( $Sender, $junk ) = ParseSenderAddressFromHead($head);
+        $head->add( 'RT-Squelch-Replies-To', $Sender );
+        $head->add( 'RT-DetectedAutoGenerated', 'true' );
+    }
+
+    # }}}
+
+    my $Ticket = RT::Ticket->new($CurrentUser);
+
+    # {{{ If we don't have a ticket Id, we're creating a new ticket
+    if ( (!$SystemTicket || !$SystemTicket->Id) && 
+           grep /^(comment|correspond)$/, @actions ) {
+
+        # {{{ Create a new ticket
+
+        my @Cc;
+        my @Requestors = ( $CurrentUser->id );
+
+        if ($RT::ParseNewMessageForTicketCcs) {
+            @Cc = ParseCcAddressesFromHead(
+                Head        => $head,
+                CurrentUser => $CurrentUser,
+                QueueObj    => $SystemQueueObj
+            );
+        }
+
+        my ( $id, $Transaction, $ErrStr ) = $Ticket->Create(
+            Queue     => $SystemQueueObj->Id,
+            Subject   => $Subject,
+            Requestor => \@Requestors,
+            Cc        => \@Cc,
+            MIMEObj   => $Message
+        );
+        if ( $id == 0 ) {
+            MailError(
+                To          => $ErrorsTo,
+                Subject     => "Ticket creation failed",
+                Explanation => $ErrStr,
+                MIMEObj     => $Message
+            );
+            $RT::Logger->error("Create failed: $id / $Transaction / $ErrStr ");
+            return ( 0, "Ticket creation failed", $Ticket );
+        }
+       # strip comments&corresponds from the actions we don't need record twice
+       @actions = grep !/^(comment|correspond)$/, @actions;
+       $args{'ticket'} = $id;
+
+        # }}}
+    }
+
+    $Ticket->Load( $args{'ticket'} );
+    unless ( $Ticket->Id ) {
+        my $message = "Could not find a ticket with id " . $args{'ticket'};
+        MailError(
+            To          => $ErrorsTo,
+            Subject     => "Message not recorded",
+            Explanation => $message,
+            MIMEObj     => $Message
+        );
+    
+        return ( 0, $message );
+    }
+
+    # }}}
+    foreach my $action( @actions ) {
+        #   If the action is comment, add a comment.
+        if ( $action =~ /^(comment|correspond)$/i ) {
+            my ( $status, $msg );
+            if ( $action =~ /^correspond$/i ) {
+                ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message );
+            }
+            else {
+                ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message );
+            }
+            unless ($status) {
+    
+                #Warn the sender that we couldn't actually submit the comment.
+                MailError(
+                    To          => $ErrorsTo,
+                    Subject     => "Message not recorded",
+                    Explanation => $msg,
+                    MIMEObj     => $Message
+                );
+                return ( 0, "Message not recorded", $Ticket );
+            }
+        }
+        elsif ($RT::UnsafeEmailCommands && $action =~ /^take$/i ) {
+            my ( $status, $msg ) = $Ticket->SetOwner( $CurrentUser->id );
+            unless ($status) {
+    
+                #Warn the sender that we couldn't actually submit the comment.
+                MailError(
+                    To          => $ErrorsTo,
+                    Subject     => "Ticket not taken",
+                    Explanation => $msg,
+                    MIMEObj     => $Message
+                );
+                return ( 0, "Ticket not taken", $Ticket );
+            }
+        }
+        elsif ( $RT::UnsafeEmailCommands && $action =~ /^resolve$/i ) {
+            my ( $status, $msg ) = $Ticket->SetStatus( 'resolved' );
+            unless ($status) {
+                #Warn the sender that we couldn't actually submit the comment.
+                MailError(
+                    To          => $ErrorsTo,
+                    Subject     => "Ticket not resolved",
+                    Explanation => $msg,
+                    MIMEObj     => $Message
+                );
+                return ( 0, "Ticket not resolved", $Ticket );
+            }
+        }
+    
+        else {
+    
+            #Return mail to the sender with an error
+            MailError(
+                To          => $ErrorsTo,
+                Subject     => "RT Configuration error",
+                Explanation => "'"
+                  . $args{'action'}
+                  . "' not a recognized action."
+                  . " Your RT administrator has misconfigured "
+                  . "the mail aliases which invoke RT",
+                MIMEObj => $Message
+            );
+            $RT::Logger->crit( $args{'action'} . " type unknown for $MessageId" );
+            return (
+                -75,
+                "Configuration error: "
+                  . $args{'action'}
+                  . " not a recognized action",
+                $Ticket
+            );
+    
+        }
+    }
+
+    return ( 1, "Success", $Ticket );
+}
+
+sub IsCorrectAction
+{
+       my $action = shift;
+       my @actions = split /-/, $action;
+       foreach ( @actions ) {
+               return (0, $_) unless /^(?:comment|correspond|take|resolve)$/;
+       }
+       return (1, @actions);
+}
+
+
+eval "require RT::Interface::Email_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm});
+eval "require RT::Interface::Email_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Local.pm});
 
 1;