This commit was generated by cvs2svn to compensate for changes in r4407,
[freeside.git] / rt / lib / RT / Interface / Email.pm
index 04539a3..7eec050 100755 (executable)
@@ -1,14 +1,8 @@
-# {{{ BEGIN BPS TAGGED BLOCK
+# BEGIN LICENSE BLOCK
 # 
-# COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
-#                                          <jesse@bestpractical.com>
+# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
 # 
-# (Except where explicitly superseded by other copyright notices)
-# 
-# 
-# LICENSE:
+# (Except where explictly superceded by other copyright notices)
 # 
 # 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
 # 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:
+# Unless otherwise specified, all modifications, corrections or
+# extensions to this work which alter its source code become the
+# property of Best Practical Solutions, LLC when submitted for
+# inclusion in the work.
 # 
-# (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
+# END LICENSE 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.1.4 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
+    $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
     
     @ISA         = qw(Exporter);
     
@@ -79,7 +57,7 @@ BEGIN {
 
 =head1 NAME
 
-  RT::Interface::Email - helper functions for parsing email sent to RT
+  RT::Interface::CLI - helper functions for creating a commandline RT interface
 
 =head1 SYNOPSIS
 
@@ -175,7 +153,6 @@ sub MailError {
                Subject => 'There has been an error',
                Explanation => 'Unexplained error',
                MIMEObj => undef,
-        Attach => undef,
                LogLevel => 'crit',
                @_);
 
@@ -188,7 +165,6 @@ sub MailError {
                                      Bcc => $args{'Bcc'},
                                      To => $args{'To'},
                                      Subject => $args{'Subject'},
-                                     Precedence => 'bulk',
                                      'X-RT-Loop-Prevention' => $RT::rtname,
                                    );
 
@@ -199,19 +175,14 @@ sub MailError {
         $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);
         print MAIL $entity->as_string;
         close(MAIL);
     }
     else {
-       $entity->send($RT::MailCommand, $RT::MailParams);
+       $entity->send($RT::MailCommand, $RT::MailParams);
     }
 }
 
@@ -223,6 +194,12 @@ sub CreateUser {
     my ($Username, $Address, $Name, $ErrorsTo, $entity) = @_;
     my $NewUser = RT::User->new($RT::SystemUser);
 
+    # This data is tainted by some Very Broken mailers.
+    # (Sometimes they send raw ISO 8859-1 data here. fear that.
+    require Encode;
+    $Username = Encode::encode(utf8 => $Username, Encode::FB_PERLQQ()) if defined $Username;
+    $Name = Encode::encode(utf8 => $Name, Encode::FB_PERLQQ()) if defined $Name;
+    
     my ($Val, $Message) = 
       $NewUser->Create(Name => ($Username || $Address),
                        EmailAddress => $Address,
@@ -384,82 +361,36 @@ sub ParseAddressFromHeader{
 
 
 
-=head2 Gateway ARGSREF
-
-
-Takes parameters:
-
-    action
-    queue
-    message
-
+=head2 Gateway
 
 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, status code should be -75
-
-    for permanent failures which are handled by RT, 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' unless ( $args{'action'} );
-    $args{'queue'}  = '1'          unless ( $args{'queue'} );
+    my %args = ( message => undef,
+                 queue   => 1,
+                 action  => 'correspond',
+                 ticket  => undef,
+                 @_ );
 
     # Validate the action
     unless ( $args{'action'} =~ /^(comment|correspond|action)$/ ) {
 
         # 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'}."'");
-
-        return ( -75, "Invalid 'action' parameter", undef );
+        return ( 0, "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");
-    }
+    $parser->ParseMIMEEntityFromScalar( $args{'message'} );
 
     my $Message = $parser->Entity();
-    my $head    = $Message->head;
+    my $head = $Message->head;
 
     my ( $CurrentUser, $AuthStat, $status, $error );
 
-    # Initalize AuthStat so comparisons work correctly
-    $AuthStat = -9999999;
-
     my $ErrorsTo = ParseErrorsToAddressFromHead($head);
 
     my $MessageId = $head->get('Message-Id')
@@ -469,111 +400,88 @@ sub Gateway {
     my $Subject = $head->get('Subject') || '';
     chomp $Subject;
 
+
     $args{'ticket'} ||= $parser->ParseTicketId($Subject);
 
     my $SystemTicket;
-    my $Right = 'CreateTicket';
-    if ( $args{'ticket'} ) {
+    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';
+        $SystemTicket->Load($args{'ticket'});
     }
 
     #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 );
+        MailError(
+                 To          => $RT::OwnerEmail,
+                 Subject     => "RT Bounce: $Subject",
+                 Explanation => "RT couldn't find the queue: " . $args{'queue'},
+                 MIMEObj     => $Message );
+        return ( 0, "RT couldn't find the queue: " . $args{'queue'}, undef );
     }
 
     # Authentication Level
-    # -1 - Get out.  this user has been explicitly declined
+    # -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;
-
+    push @RT::MailPlugins, "Auth::MailFrom"   unless @RT::MailPlugins;
     # Since this needs loading, no matter what
 
-    foreach (@RT::MailPlugins) {
+    for (@RT::MailPlugins) {
         my $Code;
         my $NewAuthStat;
         if ( ref($_) eq "CODE" ) {
             $Code = $_;
         }
         else {
-            $_ = "RT::Interface::Email::".$_ unless $_ =~ /^RT::Interface::Email::/;
+            $_ = "RT::Interface::Email::$_" unless /^RT::Interface::Email::/;
             eval "require $_;";
             if ($@) {
-                $RT::Logger->crit("Couldn't load module '$_': $@");
+                die ("Couldn't load module $_: $@");
                 next;
             }
             no strict 'refs';
             if ( !defined( $Code = *{ $_ . "::GetCurrentUser" }{CODE} ) ) {
-                $RT::Logger->crit("No GetCurrentUser code found in $_ module");
+                die ("No GetCurrentUser code found in $_ module");
                 next;
             }
         }
 
-        ( $CurrentUser, $NewAuthStat ) = $Code->(
-            Message     => $Message,
-            RawMessageRef => \$args{'message'},
-            CurrentUser => $CurrentUser,
-            AuthLevel   => $AuthStat,
-            Action      => $args{'action'},
-            Ticket      => $SystemTicket,
-            Queue       => $SystemQueueObj
-        );
-
-
-        # If a module returns a "-1" then we discard the ticket, so.
-        $AuthStat = -1 if $NewAuthStat == -1;
+        ( $CurrentUser, $NewAuthStat ) = $Code->( Message     => $Message,
+                                                  CurrentUser => $CurrentUser,
+                                                  AuthLevel   => $AuthStat,
+                                                  Action => $args{'action'},
+                                                  Ticket => $SystemTicket,
+                                                  Queue  => $SystemQueueObj );
 
         # You get the highest level of authentication you were assigned.
-        $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
         last if $AuthStat == -1;
+        $AuthStat = $NewAuthStat if $NewAuthStat > $AuthStat;
     }
 
     # {{{ 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,
+        MailError(
+            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.
 
+Your RT administrator needs to grant 'Everyone' the right 'CreateTicket'
+for this queue.
+
 EOT
-                MIMEObj  => $Message,
-                LogLevel => 'error'
-            );
-        }
+            MIMEObj  => $Message,
+            LogLevel => 'error' )
+          unless $AuthStat == -1;
         return ( 0, "Could not load a valid user", undef );
     }
 
@@ -600,11 +508,10 @@ EOT
     # {{{ 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
-        );
+             To          => $ErrorsTo,
+             Subject     => "Permission Denied",
+             Explanation => "You do not have permission to communicate with RT",
+             MIMEObj     => $Message );
     }
 
     # }}}
@@ -616,16 +523,14 @@ EOT
 
         #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
-            );
-        }
+            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);
+            #Do we actually want to store it?
+            return ( 0, "Message Bounced", undef ) unless ($RT::StoreLoops);
+        }
     }
 
     # }}}
@@ -633,10 +538,8 @@ EOT
     # {{{ 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->add( 'RT-Relocated-Squelch-Replies-To',
+                    $head->get('RT-Squelch-Replies-To') );
         $head->delete('RT-Squelch-Replies-To');
     }
 
@@ -661,27 +564,22 @@ EOT
         my @Requestors = ( $CurrentUser->id );
 
         if ($RT::ParseNewMessageForTicketCcs) {
-            @Cc = ParseCcAddressesFromHead(
-                Head        => $head,
-                CurrentUser => $CurrentUser,
-                QueueObj    => $SystemQueueObj
-            );
+            @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
-        );
+                                                      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
-            );
+            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 );
         }
@@ -693,17 +591,15 @@ EOT
 
     #   If the action is comment, add a comment.
     elsif ( $args{'action'} =~ /^(comment|correspond)$/i ) {
-        $Ticket->Load( $args{'ticket'} );
+        $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 );
+            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);
         }
 
         my ( $status, $msg );
@@ -716,12 +612,10 @@ EOT
         unless ($status) {
 
             #Warn the sender that we couldn't actually submit the comment.
-            MailError(
-                To          => $ErrorsTo,
-                Subject     => "Message not recorded",
-                Explanation => $msg,
-                MIMEObj     => $Message
-            );
+            MailError( To          => $ErrorsTo,
+                       Subject     => "Message not recorded",
+                       Explanation => $msg,
+                       MIMEObj     => $Message );
             return ( 0, "Message not recorded", $Ticket );
         }
     }
@@ -729,30 +623,22 @@ EOT
     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
-        );
+        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 ( 0, "Configuration error: " . $args{'action'} . " not a recognized action", $Ticket );
 
     }
 
-    return ( 1, "Success", $Ticket );
-}
 
+return ( 1, "Success", $Ticket );
+}
 
 eval "require RT::Interface::Email_Vendor";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT/Interface/Email_Vendor.pm});