ticketing escalation, part 1, RT#8254

[freeside.git] / rt / lib / RT / EmailParser.pm

diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm
index 8ed810c..63c7698 100644 (file)
--- a/rt/lib/RT/EmailParser.pm
+++ b/rt/lib/RT/EmailParser.pm
@@ -1,8 +1,8 @@
-# {{{ BEGIN BPS TAGGED BLOCK
+# BEGIN BPS TAGGED BLOCK {{{

 # 
 # COPYRIGHT:
 # 
 # COPYRIGHT:

-#  
-# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
+# 
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC

 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)
 #                                          <jesse@bestpractical.com>
 # 
 # (Except where explicitly superseded by other copyright notices)


@@ -22,7 +22,9 @@
 # 
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # 
 # 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.
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.

 # 
 # 
 # CONTRIBUTION SUBMISSION POLICY:
 # 
 # 
 # CONTRIBUTION SUBMISSION POLICY:


@@ -42,14 +44,17 @@
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
 # 
 # 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::EmailParser;
 
 
 use base qw/RT::Base/;
 
 use strict;
 package RT::EmailParser;
 
 
 use base qw/RT::Base/;
 
 use strict;

-use Mail::Address;
+use warnings;
+
+use Email::Address;

 use MIME::Entity;
 use MIME::Head;
 use MIME::Parser;
 use MIME::Entity;
 use MIME::Head;
 use MIME::Parser;


@@ -66,17 +71,13 @@ use File::Temp qw/tempdir/;
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 
 

-=begin testing
-
-ok(require RT::EmailParser);
-
-=end testing

 
 
 =head1 METHODS
 
 =head2 new
 
 
 
 =head1 METHODS
 
 =head2 new
 

+Returns a new RT::EmailParser object

 
 =cut
 
 
 =cut
 


@@ -89,105 +90,18 @@ sub new  {
 }
 
 
 }
 
 

+=head2 SmartParseMIMEEntityFromScalar Message => SCALAR_REF [, Decode => BOOL, Exact => BOOL ] }

 
 

-# {{{ 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 {
-    my $self = shift;
-
-    my $head = $self->Head;
-
-    #If this instance of RT sent it our, we don't want to take it in
-    my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
-    chomp($RTLoop);    #remove that newline
-    if ( $RTLoop =~ /^\Q$RT::rtname\E/o ) {
-        return (1);
-    }
-
-    # TODO: We might not trap the case where RT instance A sends a mail
-    # to RT instance B which sends a mail to ...
-    return (undef);
-}
-
-# }}}
-
-# {{{ sub CheckForSuspiciousSender
-
-sub CheckForSuspiciousSender {
-    my $self = shift;
-
-    #if it's from a postmaster or mailer daemon, it's likely a bounce.
-
-    #TODO: better algorithms needed here - there is no standards for
-    #bounces, so it's very difficult to separate them from anything
-    #else.  At the other hand, the Return-To address is only ment to be
-    #used as an error channel, we might want to put up a separate
-    #Return-To address which is treated differently.
-
-    #TODO: search through the whole email and find the right Ticket ID.
-
-    my ( $From, $junk ) = $self->ParseSenderAddressFromHead();
-
-    if ( ( $From =~ /^mailer-daemon/i ) or ( $From =~ /^postmaster/i ) ) {
-        return (1);
-
-    }
-
-    return (undef);
-
-}
-
-# }}}
-
-# {{{ sub CheckForAutoGenerated
-sub CheckForAutoGenerated {
-    my $self = shift;
-    my $head = $self->Head;
-
-    my $Precedence = $head->get("Precedence") || "";
-    if ( $Precedence =~ /^(bulk|junk)/i ) {
-        return (1);
-    }
-    else {
-        return (undef);
-    }
-}
-
-# }}}
-
-
-=head2 SmartParseMIMEEntityFromScalar { Message => SCALAR_REF, Decode => BOOL }
-
-Parse a message stored in a scalar from scalar_ref
-
+Parse a message stored in a scalar from scalar_ref.

 
 =cut
 
 sub SmartParseMIMEEntityFromScalar {
     my $self = shift;
 
 =cut
 
 sub SmartParseMIMEEntityFromScalar {
     my $self = shift;

-    my %args = ( Message => undef, Decode => 1, @_ );
+    my %args = ( Message => undef, Decode => 1, Exact => 0, @_ );

 
 

-    my ( $fh, $temp_file );

     eval {
     eval {

-
+        my ( $fh, $temp_file );

         for ( 1 .. 10 ) {
 
             # on NFS and NTFS, it is possible that tempfile() conflicts
         for ( 1 .. 10 ) {
 
             # on NFS and NTFS, it is possible that tempfile() conflicts


@@ -209,8 +123,9 @@ sub SmartParseMIMEEntityFromScalar {
 
                 # We have to trust the temp file's name -- untaint it
                 $temp_file =~ /(.*)/;
 
                 # We have to trust the temp file's name -- untaint it
                 $temp_file =~ /(.*)/;

-                $self->ParseMIMEEntityFromFile( $1, $args{'Decode'} );
+                my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} );

                 unlink($1);
                 unlink($1);

+                return $entity;

             }
         }
     };
             }
         }
     };


@@ -218,42 +133,38 @@ sub SmartParseMIMEEntityFromScalar {
     #If for some reason we weren't able to parse the message using a temp file
     # try it with a scalar
     if ( $@ || !$self->Entity ) {
     #If for some reason we weren't able to parse the message using a temp file
     # try it with a scalar
     if ( $@ || !$self->Entity ) {

-        $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'} );
+        return $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'}, $args{'Exact'} );

     }
 
 }
 
     }
 
 }
 

-# {{{ sub ParseMIMEEntityFromSTDIN
+
+=head2 ParseMIMEEntityFromSTDIN
+
+Parse a message from standard input
+
+=cut

 
 sub ParseMIMEEntityFromSTDIN {
     my $self = shift;
 
 sub ParseMIMEEntityFromSTDIN {
     my $self = shift;

-    my $postprocess = (@_ ? shift : 1);
-    return $self->ParseMIMEEntityFromFileHandle(\*STDIN, $postprocess);
+    return $self->ParseMIMEEntityFromFileHandle(\*STDIN, @_);

 }
 
 }
 

-# }}}
-

 =head2 ParseMIMEEntityFromScalar  $message
 
 =head2 ParseMIMEEntityFromScalar  $message
 

-Takes either a scalar or a reference to a scalr which contains a stringified MIME message.
+Takes either a scalar or a reference to a scalar which contains a stringified MIME message.

 Parses it.
 
 Returns true if it wins.
 Returns false if it loses.
 
 Parses it.
 
 Returns true if it wins.
 Returns false if it loses.
 

-

 =cut
 
 sub ParseMIMEEntityFromScalar {
     my $self = shift;
 =cut
 
 sub ParseMIMEEntityFromScalar {
     my $self = shift;

-    my $message = shift;
-    my $postprocess = (@_ ? shift : 1);
-    $self->_ParseMIMEEntity($message,'parse_data', $postprocess);
+    return $self->_ParseMIMEEntity( shift, 'parse_data', @_ );

 }
 
 }
 

-
-# {{{ ParseMIMEEntityFromFilehandle *FH
-

 =head2 ParseMIMEEntityFromFilehandle *FH
 
 Parses a mime entity from a filehandle passed in as an argument
 =head2 ParseMIMEEntityFromFilehandle *FH
 
 Parses a mime entity from a filehandle passed in as an argument


@@ -262,15 +173,9 @@ Parses a mime entity from a filehandle passed in as an argument
 
 sub ParseMIMEEntityFromFileHandle {
     my $self = shift;
 
 sub ParseMIMEEntityFromFileHandle {
     my $self = shift;

-    my $filehandle = shift;
-    my $postprocess = (@_ ? shift : 1);
-    $self->_ParseMIMEEntity($filehandle,'parse', $postprocess);
+    return $self->_ParseMIMEEntity( shift, 'parse', @_ );

 }
 
 }
 

-# }}}
-
-# {{{ ParseMIMEEntityFromFile
-

 =head2 ParseMIMEEntityFromFile 
 
 Parses a mime entity from a filename passed in as an argument
 =head2 ParseMIMEEntityFromFile 
 
 Parses a mime entity from a filename passed in as an argument


@@ -279,24 +184,21 @@ Parses a mime entity from a filename passed in as an argument
 
 sub ParseMIMEEntityFromFile {
     my $self = shift;
 
 sub ParseMIMEEntityFromFile {
     my $self = shift;

-    my $file = shift;
-    my $postprocess = (@_ ? shift : 1);
-    $self->_ParseMIMEEntity($file,'parse_open',$postprocess);
+    return $self->_ParseMIMEEntity( shift, 'parse_open', @_ );

 }
 
 }
 

-# }}}
-#
-#  {{{ _ParseMIMEEntity {
+

 sub _ParseMIMEEntity {
     my $self = shift;
     my $message = shift;
     my $method = shift;
 sub _ParseMIMEEntity {
     my $self = shift;
     my $message = shift;
     my $method = shift;

-    my $postprocess = shift;
-    # Create a new parser object:
+    my $postprocess = (@_ ? shift : 1);
+    my $exact = shift;

 
 

+    # Create a new parser object:

     my $parser = MIME::Parser->new();
     $self->_SetupMIMEParser($parser);
     my $parser = MIME::Parser->new();
     $self->_SetupMIMEParser($parser);

-
+    $parser->decode_bodies(0) if $exact;

 
     # TODO: XXX 3.0 we really need to wrap this in an eval { }
     unless ( $self->{'entity'} = $parser->$method($message) ) {
 
     # TODO: XXX 3.0 we really need to wrap this in an eval { }
     unless ( $self->{'entity'} = $parser->$method($message) ) {


@@ -308,16 +210,54 @@ sub _ParseMIMEEntity {
             return ( undef);
         }
     }
             return ( undef);
         }
     }

-    if ($postprocess) {
-    $self->_PostProcessNewEntity() ;
-    }

 
 

+    $self->_PostProcessNewEntity if $postprocess;
+
+    return $self->{'entity'};

 }
 
 }
 

+sub _DecodeBodies {
+    my $self = shift;
+    return unless $self->{'entity'};
+    
+    my @parts = $self->{'entity'}->parts_DFS;
+    $self->_DecodeBody($_) foreach @parts;
+}

 
 

-# }}}
+sub _DecodeBody {
+    my $self = shift;
+    my $entity = shift;
+
+    my $old = $entity->bodyhandle or return;
+    return unless $old->is_encoded;
+
+    require MIME::Decoder;
+    my $encoding = $entity->head->mime_encoding;
+    my $decoder = new MIME::Decoder $encoding;
+    unless ( $decoder ) {
+        $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary");
+        $old->is_encoded(0);
+        return;
+    }

 
 

-# {{{ _PostProcessNewEntity 
+    require MIME::Body;
+    # XXX: use InCore for now, but later must switch to files
+    my $new = new MIME::Body::InCore;
+    $new->binmode(1);
+    $new->is_encoded(0);
+
+    my $source = $old->open('r') or die "couldn't open body: $!";
+    my $destination = $new->open('w') or die "couldn't open body: $!";
+    { 
+        local $@;
+        eval { $decoder->decode($source, $destination) };
+        $RT::Logger->error($@) if $@;
+    }
+    $source->close or die "can't close: $!";
+    $destination->close or die "can't close: $!";
+
+    $entity->bodyhandle( $new );
+}

 
 =head2 _PostProcessNewEntity
 
 
 =head2 _PostProcessNewEntity
 


@@ -330,54 +270,26 @@ sub _PostProcessNewEntity {
 
     #Now we've got a parsed mime object. 
 
 
     #Now we've got a parsed mime object. 
 

-    # try to convert text parts into utf-8 charset
-    RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');
-
-

     # Unfold headers that are have embedded newlines
     # Unfold headers that are have embedded newlines

+    #  Better do this before conversion or it will break
+    #  with multiline encoded Subject (RFC2047) (fsck.com #5594)

     $self->Head->unfold;
 
     $self->Head->unfold;
 

-
-}
-
-# }}}
-
-# {{{ sub ParseTicketId 
-
-sub ParseTicketId {
-    my $self = shift;
-
-    my $Subject = shift;
-
-    if ( $Subject =~ s/\[\Q$RT::rtname\E\s+\#(\d+)\s*\]//i ) {
-        my $id = $1;
-        $RT::Logger->debug("Found a ticket ID. It's $id");
-        return ($id);
-    }
-    else {
-        return (undef);
-    }
+    # try to convert text parts into utf-8 charset
+    RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');

 }
 
 }
 

-# }}}
-
-
-
-# {{{ ParseCcAddressesFromHead 
-

 =head2 ParseCcAddressesFromHead HASHREF
 
 Takes a hashref object containing QueueObj, Head and CurrentUser objects.
 Returns a list of all email addresses in the To and Cc 
 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s 
 =head2 ParseCcAddressesFromHead HASHREF
 
 Takes a hashref object containing QueueObj, Head and CurrentUser objects.
 Returns a list of all email addresses in the To and Cc 
 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s 

-email address  and anything that the $RTAddressRegexp matches.
+email address and anything that the RT->Config->Get('RTAddressRegexp') matches.

 
 =cut
 
 sub ParseCcAddressesFromHead {
 
 =cut
 
 sub ParseCcAddressesFromHead {

-

     my $self = shift;
     my $self = shift;

-

     my %args = (
         QueueObj    => undef,
         CurrentUser => undef,
     my %args = (
         QueueObj    => undef,
         CurrentUser => undef,


@@ -386,121 +298,28 @@ sub ParseCcAddressesFromHead {
 
     my (@Addresses);
 
 
     my (@Addresses);
 

-    my @ToObjs = Mail::Address->parse( $self->Head->get('To') );
-    my @CcObjs = Mail::Address->parse( $self->Head->get('Cc') );
+    my @ToObjs = Email::Address->parse( $self->Head->get('To') );
+    my @CcObjs = Email::Address->parse( $self->Head->get('Cc') );

 
     foreach my $AddrObj ( @ToObjs, @CcObjs ) {
         my $Address = $AddrObj->address;
         my $user = RT::User->new($RT::SystemUser);
         $Address = $user->CanonicalizeEmailAddress($Address);
 
     foreach my $AddrObj ( @ToObjs, @CcObjs ) {
         my $Address = $AddrObj->address;
         my $user = RT::User->new($RT::SystemUser);
         $Address = $user->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 ( IsRTAddress($Address) );
+        next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address;
+        next if $self->IsRTAddress($Address);

 
         push ( @Addresses, $Address );
     }
     return (@Addresses);
 }
 
 
         push ( @Addresses, $Address );
     }
     return (@Addresses);
 }
 

-# }}}
-
-# {{{ ParseSenderAdddressFromHead
-
-=head2 ParseSenderAddressFromHead
-
-Takes a MIME::Header object. Returns a tuple: (user@host, friendly name) 
-of the From (evaluated in order of Reply-To:, From:, Sender)
-
-=cut
-
-sub ParseSenderAddressFromHead {
-    my $self = shift;
-
-    #Figure out who's sending this message.
-    my $From = $self->Head->get('Reply-To')
-      || $self->Head->get('From')
-      || $self->Head->get('Sender');
-    return ( $self->ParseAddressFromHeader($From) );
-}
-
-# }}}
-
-# {{{ ParseErrorsToAdddressFromHead
-
-=head2 ParseErrorsToAddressFromHead
-
-Takes a MIME::Header object. Return a single value : user@host
-of the From (evaluated in order of Errors-To:,Reply-To:, From:, Sender)
-
-=cut
-
-sub ParseErrorsToAddressFromHead {
-    my $self = shift;
-
-    #Figure out who's sending this message.
-
-    foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
-
-        # If there's a header of that name
-        my $headerobj = $self->Head->get($header);
-        if ($headerobj) {
-            my ( $addr, $name ) = $self->ParseAddressFromHeader($headerobj);
-
-            # If it's got actual useful content...
-            return ($addr) if ($addr);
-        }
-    }
-}
-
-# }}}
-
-# {{{ ParseAddressFromHeader
-
-=head2 ParseAddressFromHeader ADDRESS
-
-Takes an address from $self->Head->get('Line') and returns a tuple: user@host, friendly name
-
-=cut
-
-sub ParseAddressFromHeader {
-    my $self = shift;
-    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];
-
-    unless ( ref($AddrObj) ) {
-        return ( undef, undef );
-    }
-
-    my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
-
-    #Lets take the from and load a user object.
-    my $Address = $AddrObj->address;
-
-    return ( $Address, $Name );
-}
-
-# }}}
-
-# {{{ IsRTAddress

 
 

-=item IsRTaddress ADDRESS
+=head2 IsRTaddress ADDRESS

 
 Takes a single parameter, an email address. 
 
 Takes a single parameter, an email address. 

-Returns true if that address matches the $RTAddressRegexp.  
+Returns true if that address matches the C<RTAddressRegexp> config option.

 Returns false, otherwise.
 
 Returns false, otherwise.
 

-=begin testing
-
-is(RT::EmailParser::IsRTAddress("","rt\@example.com"),1, "Regexp matched rt address" );
-is(RT::EmailParser::IsRTAddress("","frt\@example.com"),undef, "Regexp didn't match non-rt address" );
-
-=end testing

 
 =cut
 
 
 =cut
 


@@ -508,33 +327,34 @@ sub IsRTAddress {
     my $self = shift;
     my $address = shift;
 
     my $self = shift;
     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);
+    if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) {
+        return $address =~ /$address_re/i ? 1 : undef;

     }
     }

-}

 
 

-# }}}
+    # we don't warn here, but do in config check
+    if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) {
+        return 1 if lc $correspond_address eq lc $address;
+    }
+    if ( my $comment_address = RT->Config->Get('CommentAddress') ) {
+        return 1 if lc $comment_address eq lc $address;
+    }

 
 

+    my $queue = RT::Queue->new( $RT::SystemUser );
+    $queue->LoadByCols( CorrespondAddress => $address );
+    return 1 if $queue->id;

 
 

-# {{{ CullRTAddresses
+    $queue->LoadByCols( CommentAddress => $address );
+    return 1 if $queue->id;

 
 

-=item CullRTAddresses ARRAY
+    return undef;
+}

 
 

-Takes a single argument, an array of email addresses.
-Returns the same array with any IsRTAddress()es weeded out.

 
 

-=begin testing
+=head2 CullRTAddresses ARRAY

 
 

-@before = ("rt\@example.com", "frt\@example.com");
-@after = ("frt\@example.com");
-ok(eq_array(RT::EmailParser::CullRTAddresses("",@before),@after), "CullRTAddresses only culls RT addresses");
+Takes a single argument, an array of email addresses.
+Returns the same array with any IsRTAddress()es weeded out.

 
 

-=end testing

 
 =cut
 
 
 =cut
 


@@ -544,15 +364,16 @@ sub CullRTAddresses {
     my @addrlist;
 
     foreach my $addr( @addresses ) {
     my @addrlist;
 
     foreach my $addr( @addresses ) {

-      push (@addrlist, $addr)    unless IsRTAddress("", $addr);
+                                 # We use the class instead of the instance
+                                 # because sloppy code calls this method
+                                 # without a $self
+      push (@addrlist, $addr)    unless RT::EmailParser->IsRTAddress($addr);

     }
     return (@addrlist);
 }
 
     }
     return (@addrlist);
 }
 

-# }}}

 
 
 
 

-# {{{ LookupExternalUserInfo

 
 
 # LookupExternalUserInfo is a site-definable method for synchronizing
 
 
 # LookupExternalUserInfo is a site-definable method for synchronizing


@@ -568,7 +389,7 @@ sub CullRTAddresses {
 # template for the rejection message.
 
 
 # template for the rejection message.
 
 

-=item LookupExternalUserInfo
+=head2 LookupExternalUserInfo

 
  LookupExternalUserInfo is a site-definable method for synchronizing
  incoming users with an external data source. 
 
  LookupExternalUserInfo is a site-definable method for synchronizing
  incoming users with an external data source. 


@@ -581,12 +402,12 @@ sub CullRTAddresses {
 
  It returns (FoundInExternalDatabase, ParamHash);
 
 
  It returns (FoundInExternalDatabase, ParamHash);
 

-   FoundInExternalDatabase must  be set to 1 before return if the user was
-   found in the external database.
+   FoundInExternalDatabase must  be set to 1 before return if the user 
+   was found in the external database.

 
 

-   ParamHash is a Perl parameter hash which can contain at least the following
-   fields. These fields are used to populate RT's users database when the user 
-   is created
+   ParamHash is a Perl parameter hash which can contain at least the 
+   following fields. These fields are used to populate RT's users 
+   database when the user is created.

 
     EmailAddress is the email address that RT should use for this user.  
     Name is the 'Name' attribute RT should use for this user. 
 
     EmailAddress is the email address that RT should use for this user.  
     Name is the 'Name' attribute RT should use for this user. 


@@ -614,10 +435,6 @@ sub LookupExternalUserInfo {
   return ($FoundInExternalDatabase, %params);
 }
 
   return ($FoundInExternalDatabase, %params);
 }
 

-# }}}
-
-# {{{ Accessor methods for parsed email messages
-

 =head2 Head
 
 Return the parsed head from this message
 =head2 Head
 
 Return the parsed head from this message


@@ -640,8 +457,7 @@ sub Entity {
     return $self->{'entity'};
 }
 
     return $self->{'entity'};
 }
 

-# }}}
-# {{{ _SetupMIMEParser 
+

 
 =head2 _SetupMIMEParser $parser
 
 
 =head2 _SetupMIMEParser $parser
 


@@ -661,40 +477,92 @@ sub _SetupMIMEParser {
     my $self   = shift;
     my $parser = shift;
     
     my $self   = shift;
     my $parser = shift;
     

-    # Set up output directory for files:
-
-    my $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
-    push ( @{ $self->{'AttachmentDirs'} }, $tmpdir );
-    $parser->output_dir($tmpdir);
-    $parser->filer->ignore_filename(1);
+    # Set up output directory for files; we use $RT::VarPath instead
+    # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always
+    # writable.
+    my $tmpdir;
+    if ( -w $RT::VarPath ) {
+        $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 );
+    } elsif (-w File::Spec->tmpdir) {
+        $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
+    } else {
+        $RT::Logger->crit("Neither the RT var directory ($RT::VarPath) nor the system tmpdir (@{[File::Spec->tmpdir]}) are writable; falling back to in-memory parsing!");
+    }

 
     #If someone includes a message, extract it
     $parser->extract_nested_messages(1);
 
     #If someone includes a message, extract it
     $parser->extract_nested_messages(1);

-

     $parser->extract_uuencode(1);    ### default is false
 
     $parser->extract_uuencode(1);    ### default is false
 

-    # Set up the prefix for files with auto-generated names:
-    $parser->output_prefix("part");
+    if ($tmpdir) {
+        # If we got a writable tmpdir, write to disk
+        push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir );
+        $parser->output_dir($tmpdir);
+        $parser->filer->ignore_filename(1);

 
 

-    # do _not_ store each msg as in-core scalar;
+        # Set up the prefix for files with auto-generated names:
+        $parser->output_prefix("part");

 
 

-    $parser->output_to_core(0);
+        # From the MIME::Parser docs:
+        # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope"
+        # Turns out that the default is to recycle tempfiles
+        # Temp files should never be recycled, especially when running under perl taint checking

 
 

-    # From the MIME::Parser docs:
-    # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope"
-    # Turns out that the default is to recycle tempfiles
-    # Temp files should never be recycled, especially when running under perl taint checking
-    
-    $parser->tmp_recycling(0);
-    
+        $parser->tmp_recycling(0) if $parser->can('tmp_recycling');
+    } else {
+        # Otherwise, fall back to storing it in memory
+        $parser->output_to_core(1);
+        $parser->tmp_to_core(1);
+        $parser->use_inner_files(1);
+    }
+
+}
+
+=head2 ParseEmailAddress string
+
+Returns a list of Email::Address objects
+Works around the bug that Email::Address 1.889 and earlier
+doesn't handle local-only email addresses (when users pass
+in just usernames on the RT system in fields that expect
+Email Addresses)
+
+We don't handle the case of 
+bob, fred@bestpractical.com 
+because we don't want to fail parsing
+bob, "Falcone, Fred" <fred@bestpractical.com>
+The next release of Email::Address will have a new method
+we can use that removes the bandaid
+
+=cut
+
+sub ParseEmailAddress {
+    my $self = shift;
+    my $address_string = shift;
+
+    $address_string =~ s/^\s+|\s+$//g;
+
+    my @addresses;
+    # if it looks like a username / local only email
+    if ($address_string !~ /@/ && $address_string =~ /^\w+$/) {
+        my $user = RT::User->new( $RT::SystemUser );
+        my ($id, $msg) = $user->Load($address_string);
+        if ($id) {
+            push @addresses, Email::Address->new($user->Name,$user->EmailAddress);
+        } else {
+            $RT::Logger->error("Unable to parse an email address from $address_string: $msg");
+        }
+    } else {
+        @addresses = Email::Address->parse($address_string);
+    }
+
+    return @addresses;

 
 }
 
 
 }
 

-# }}}

 
 sub DESTROY {
     my $self = shift;
 
 sub DESTROY {
     my $self = shift;

-    File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1);
+    File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1)
+        if $self->{'AttachmentDirs'};

 }
 
 
 }