import rt 3.4.4
[freeside.git] / rt / lib / RT / Interface / Email.pm
index 04539a3..5db7c8a 100755 (executable)
@@ -1,8 +1,8 @@
-# {{{ BEGIN BPS TAGGED BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:
 #  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC 
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
@@ -42,7 +42,7 @@
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
 # 
-# }}} END BPS TAGGED BLOCK
+# END BPS TAGGED BLOCK }}}
 package RT::Interface::Email;
 
 use strict;
@@ -56,7 +56,7 @@ BEGIN {
     use vars qw ($VERSION  @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
     
     # set the version for version checking
-    $VERSION = do { my @r = (q$Revision: 1.1.1.4 $ =~ /\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);
     
@@ -64,15 +64,15 @@ BEGIN {
     # as well as any optionally exported functions
     @EXPORT_OK   = qw(
               &CreateUser
-                     &GetMessageContent
-                     &CheckForLoops 
-                     &CheckForSuspiciousSender
-                     &CheckForAutoGenerated 
-                     &MailError 
-                     &ParseCcAddressesFromHead
-                     &ParseSenderAddressFromHead 
-                     &ParseErrorsToAddressFromHead
-                      &ParseAddressFromHeader
+              &GetMessageContent
+              &CheckForLoops 
+              &CheckForSuspiciousSender
+              &CheckForAutoGenerated 
+              &MailError 
+              &ParseCcAddressesFromHead
+              &ParseSenderAddressFromHead 
+              &ParseErrorsToAddressFromHead
+              &ParseAddressFromHeader
               &Gateway);
 
 }
@@ -139,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);
        
     }
@@ -159,13 +159,57 @@ 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);
 }
 
 # }}}
 
+# {{{ IsRTAddress
+
+=head2 IsRTAddress ADDRESS
+
+Takes a single parameter, an email address. 
+Returns true if that address matches the $RTAddressRegexp.  
+Returns false, otherwise.
+
+=cut
+
+sub IsRTAddress {
+    my $address = shift || '';
+
+    # 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);
+    }
+}
+
+# }}}
+
+# {{{ CullRTAddresses
+
+=head2 CullRTAddresses ARRAY
+
+Takes a single argument, an array of email addresses.
+Returns the same array with any IsRTAddress()es weeded out.
+
+=cut
+
+sub CullRTAddresses {
+    return (grep { IsRTAddress($_) } @_);
+}
+
+# }}}
 
 # {{{ sub MailError 
 sub MailError {
@@ -270,7 +314,8 @@ sub CreateUser {
 
     return $CurrentUser;
 }
-# }}}      
+# }}}
+
 # {{{ ParseCcAddressesFromHead 
 
 =head2 ParseCcAddressesFromHead HASHREF
@@ -296,10 +341,10 @@ sub ParseCcAddressesFromHead {
     foreach my $AddrObj (@ToObjs, @CcObjs) {
        my $Address = $AddrObj->address;
        $Address = $args{'CurrentUser'}->UserObj->CanonicalizeEmailAddress($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::EmailParser::IsRTAddress(undef, $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);
     }
@@ -365,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];
@@ -382,6 +429,26 @@ 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
@@ -409,11 +476,12 @@ Returns:
 
     status code is a numeric value.
 
-    for temporary failures, status code should be -75
+      for temporary failures, the status code should be -75
 
-    for permanent failures which are handled by RT, status code should be 0
+      for permanent failures which are handled by RT, the status code 
+      should be 0
     
-    for succces, the status code should be 1
+      for succces, the status code should be 1
 
 
 
@@ -425,14 +493,15 @@ sub Gateway {
     my %args = %$argsref;
 
     # Set some reasonable defaults
-    $args{'action'} = 'correspond' unless ( $args{'action'} );
-    $args{'queue'}  = '1'          unless ( $args{'queue'} );
+    $args{'action'} ||= 'correspond';
+    $args{'queue'}  ||= '1';
 
     # Validate the action
-    unless ( $args{'action'} =~ /^(comment|correspond|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 '".$args{'action'}."' for queue '".$args{'queue'}."'");
+        $RT::Logger->crit("Mail gateway called with an invalid action paramenter '".$actions[0]."' for queue '".$args{'queue'}."'");
 
         return ( -75, "Invalid 'action' parameter", undef );
     }
@@ -455,21 +524,21 @@ sub Gateway {
     my $Message = $parser->Entity();
     my $head    = $Message->head;
 
-    my ( $CurrentUser, $AuthStat, $status, $error );
+    my ( $CurrentUser, $AuthStat, $error );
 
     # Initalize AuthStat so comparisons work correctly
     $AuthStat = -9999999;
 
     my $ErrorsTo = ParseErrorsToAddressFromHead($head);
 
-    my $MessageId = $head->get('Message-Id')
+    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'} ||= $parser->ParseTicketId($Subject);
+    $args{'ticket'} ||= ParseTicketId($Subject);
 
     my $SystemTicket;
     my $Right = 'CreateTicket';
@@ -519,22 +588,28 @@ sub Gateway {
             }
         }
 
-        ( $CurrentUser, $NewAuthStat ) = $Code->(
-            Message     => $Message,
-            RawMessageRef => \$args{'message'},
-            CurrentUser => $CurrentUser,
-            AuthLevel   => $AuthStat,
-            Action      => $args{'action'},
-            Ticket      => $SystemTicket,
-            Queue       => $SystemQueueObj
-        );
+       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;
 
-        # 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;
+       }
 
-        # You get the highest level of authentication you were assigned.
-        $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
         last if $AuthStat == -1;
     }
 
@@ -641,11 +716,15 @@ EOT
     }
 
     if ($SquelchReplies) {
-        ## TODO: This is a hack.  It should be some other way to
-        ## indicate that the transaction should be "silent".
 
+        # 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' );
     }
 
     # }}}
@@ -653,7 +732,8 @@ EOT
     my $Ticket = RT::Ticket->new($CurrentUser);
 
     # {{{ If we don't have a ticket Id, we're creating a new ticket
-    if ( !$args{'ticket'} ) {
+    if ( (!$SystemTicket || !$SystemTicket->Id) && 
+           grep /^(comment|correspond)$/, @actions ) {
 
         # {{{ Create a new ticket
 
@@ -685,74 +765,115 @@ EOT
             $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;
 
         # }}}
     }
 
-    # }}}
-
-    #   If the action is comment, add a comment.
-    elsif ( $args{'action'} =~ /^(comment|correspond)$/i ) {
-        $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
-            );
+    $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 );
+    }
 
-            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 );
+            }
         }
-
-        my ( $status, $msg );
-        if ( $args{'action'} =~ /^correspond$/ ) {
-            ( $status, $msg ) = $Ticket->Correspond( MIMEObj => $Message );
+        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 );
+            }
         }
-        else {
-            ( $status, $msg ) = $Ticket->Comment( MIMEObj => $Message );
+        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 );
+            }
         }
-        unless ($status) {
-
-            #Warn the sender that we couldn't actually submit the comment.
+    
+        else {
+    
+            #Return mail to the sender with an error
             MailError(
                 To          => $ErrorsTo,
-                Subject     => "Message not recorded",
-                Explanation => $msg,
-                MIMEObj     => $Message
+                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 ( 0, "Message not recorded", $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});