projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
This commit was generated by cvs2svn to compensate for changes in r4407,
[freeside.git] / rt / lib / RT / EmailParser.pm
diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm
index bba4d7e..3a99e5a 100644 (file)
--- a/rt/lib/RT/EmailParser.pm
+++ b/rt/lib/RT/EmailParser.pm
@@ -1,8 +1,14 @@
-# BEGIN LICENSE BLOCK
+# BEGIN BPS TAGGED BLOCK {{{
 # 
 # 
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
+# COPYRIGHT:
+#  
+# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC 
+#                                          <jesse@bestpractical.com>
 # 
 # 
-# (Except where explictly superceded by other copyright notices)
+# (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
 # 
 # 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
@@ -14,13 +20,29 @@
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
 # 
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
 # 
-# 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.
+# 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 LICENSE BLOCK
+# END BPS TAGGED BLOCK }}}
 package RT::EmailParser;
 
 
 package RT::EmailParser;
 
 
@@ -35,7 +57,8 @@ use File::Temp qw/tempdir/;
 
 =head1 NAME
 
 
 =head1 NAME
 
-  RT::Interface::CLI - helper functions for creating a commandline RT interface
+  RT::EmailParser - helper functions for parsing parts from incoming
+  email messages
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
@@ -54,6 +77,7 @@ ok(require RT::EmailParser);
 
 =head2 new
 
 
 =head2 new
 
+Returns a new RT::EmailParser object
 
 =cut
 
 
 =cut
 
@@ -66,99 +90,76 @@ sub new  {
 }
 
 
 }
 
 
+# {{{ sub SmartParseMIMEEntityFromScalar
 
 
-# {{{ 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);
-}
+=head2 SmartParseMIMEEntityFromScalar { Message => SCALAR_REF, Decode => BOOL }
 
 
-# }}}
+Parse a message stored in a scalar from scalar_ref
 
 
-# {{{ sub CheckForSuspiciousSender
+=cut
 
 
-sub CheckForSuspiciousSender {
+sub SmartParseMIMEEntityFromScalar {
     my $self = shift;
     my $self = shift;
+    my %args = ( Message => undef, Decode => 1, @_ );
 
 
-    #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 ( $fh, $temp_file );
+    eval {
 
 
-    my ( $From, $junk ) = $self->ParseSenderAddressFromHead();
+        for ( 1 .. 10 ) {
 
 
-    if ( ( $From =~ /^mailer-daemon/i ) or ( $From =~ /^postmaster/i ) ) {
-        return (1);
+            # on NFS and NTFS, it is possible that tempfile() conflicts
+            # with other processes, causing a race condition. we try to
+            # accommodate this by pausing and retrying.
+            last
+              if ( $fh, $temp_file ) =
+              eval { File::Temp::tempfile( undef, UNLINK => 0 ) };
+            sleep 1;
+        }
+        if ($fh) {
+
+            #thank you, windows                      
+            binmode $fh;
+            $fh->autoflush(1);
+            print $fh $args{'Message'};
+            close($fh);
+            if ( -f $temp_file ) {
+
+                # We have to trust the temp file's name -- untaint it
+                $temp_file =~ /(.*)/;
+                $self->ParseMIMEEntityFromFile( $1, $args{'Decode'} );
+                unlink($1);
+            }
+        }
+    };
 
 
+    #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 (undef);
-
 }
 
 # }}}
 
 }
 
 # }}}
 
-# {{{ sub CheckForAutoGenerated
-sub CheckForAutoGenerated {
-    my $self = shift;
-    my $head = $self->Head;
+# {{{ sub ParseMIMEEntityFromSTDIN
 
 
-    my $Precedence = $head->get("Precedence") || "";
-    if ( $Precedence =~ /^(bulk|junk)/i ) {
-        return (1);
-    }
-    else {
-        return (undef);
-    }
-}
+=head2 ParseMIMEEntityFromSTDIN
 
 
-# }}}
+Parse a message from standard input
 
 
-# {{{ sub ParseMIMEEntityFromSTDIN
+=cut
 
 sub ParseMIMEEntityFromSTDIN {
     my $self = shift;
 
 sub ParseMIMEEntityFromSTDIN {
     my $self = shift;
-    return $self->ParseMIMEEntityFromFileHandle(\*STDIN);
+    my $postprocess = (@_ ? shift : 1);
+    return $self->ParseMIMEEntityFromFileHandle(\*STDIN, $postprocess);
 }
 
 # }}}
 
 }
 
 # }}}
 
+# {{{ ParseMIMEEntityFromScalar
+
 =head2 ParseMIMEEntityFromScalar  $message
 
 Takes either a scalar or a reference to a scalr which contains a stringified MIME message.
 =head2 ParseMIMEEntityFromScalar  $message
 
 Takes either a scalar or a reference to a scalr which contains a stringified MIME message.
@@ -167,17 +168,17 @@ Parses it.
 Returns true if it wins.
 Returns false if it loses.
 
 Returns true if it wins.
 Returns false if it loses.
 
-
 =cut
 
 sub ParseMIMEEntityFromScalar {
     my $self = shift;
     my $message = shift;
 =cut
 
 sub ParseMIMEEntityFromScalar {
     my $self = shift;
     my $message = shift;
-
-    $self->_DoParse('parse_data', $message);
-
+    my $postprocess = (@_ ? shift : 1);
+    $self->_ParseMIMEEntity($message,'parse_data', $postprocess);
 }
 
 }
 
+# }}}
+
 # {{{ ParseMIMEEntityFromFilehandle *FH
 
 =head2 ParseMIMEEntityFromFilehandle *FH
 # {{{ ParseMIMEEntityFromFilehandle *FH
 
 =head2 ParseMIMEEntityFromFilehandle *FH
@@ -189,9 +190,8 @@ Parses a mime entity from a filehandle passed in as an argument
 sub ParseMIMEEntityFromFileHandle {
     my $self = shift;
     my $filehandle = shift;
 sub ParseMIMEEntityFromFileHandle {
     my $self = shift;
     my $filehandle = shift;
-
-    $self->_DoParse('parse', $filehandle);
-
+    my $postprocess = (@_ ? shift : 1);
+    $self->_ParseMIMEEntity($filehandle,'parse', $postprocess);
 }
 
 # }}}
 }
 
 # }}}
@@ -206,27 +206,19 @@ 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 $file = shift;
-    $self->_DoParse('parse_open', $file);
+    my $postprocess = (@_ ? shift : 1);
+    $self->_ParseMIMEEntity($file,'parse_open',$postprocess);
 }
 
 # }}}
 
 }
 
 # }}}
 
-# {{{ _DoParse 
-
-=head2 _DoParse PARSEMETHOD CONTENT
-
-
-A helper for the various parsers to turn around and do the dispatch to the actual parser
-
-=cut
-
-sub _DoParse {
+# {{{ _ParseMIMEEntity
+sub _ParseMIMEEntity {
     my $self = shift;
     my $self = shift;
+    my $message = shift;
     my $method = shift;
     my $method = shift;
-    my $file = shift;
-
+    my $postprocess = shift;
     # Create a new parser object:
 
     my $parser = MIME::Parser->new();
     # Create a new parser object:
 
     my $parser = MIME::Parser->new();
@@ -234,23 +226,23 @@ sub _DoParse {
 
 
     # TODO: XXX 3.0 we really need to wrap this in an eval { }
 
 
     # TODO: XXX 3.0 we really need to wrap this in an eval { }
-
-    unless ( $self->{'entity'} = $parser->$method($file) ) {
-
+    unless ( $self->{'entity'} = $parser->$method($message) ) {
+        $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
         # Try again, this time without extracting nested messages
         $parser->extract_nested_messages(0);
         # Try again, this time without extracting nested messages
         $parser->extract_nested_messages(0);
-        unless ( $self->{'entity'} = $parser->$method($file) ) {
+        unless ( $self->{'entity'} = $parser->$method($message) ) {
             $RT::Logger->crit("couldn't parse MIME stream");
             return ( undef);
         }
     }
             $RT::Logger->crit("couldn't parse MIME stream");
             return ( undef);
         }
     }
-    $self->_PostProcessNewEntity();
-    return (1);
+    if ($postprocess) {
+    $self->_PostProcessNewEntity() ;
+    }
+
 }
 
 # }}}
 
 }
 
 # }}}
 
-
 # {{{ _PostProcessNewEntity 
 
 =head2 _PostProcessNewEntity
 # {{{ _PostProcessNewEntity 
 
 =head2 _PostProcessNewEntity
@@ -264,238 +256,37 @@ 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;
 
 
-}
-
-# }}}
+    # try to convert text parts into utf-8 charset
+    RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');
 
 
-# {{{ 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);
-    }
 }
 
 # }}}
 
 }
 
 # }}}
 
-# {{{ sub MailError 
-
-=head2 MailError { }
-
-
-# TODO this doesn't belong here.
-# TODO doc this
-
-
-=cut
-
+# {{{ sub ParseTicketId 
 
 
-sub MailError {
+sub ParseTicketId {
     my $self = shift;
     my $self = shift;
+    $RT::Logger->warnings("RT::EmailParser->ParseTicketId deprecated. You should be using RT::Interface::Email");
 
 
-    my %args = (
-        To          => $RT::OwnerEmail,
-        Bcc         => undef,
-        From        => $RT::CorrespondAddress,
-        Subject     => 'There has been an error',
-        Explanation => 'Unexplained error',
-        MIMEObj     => undef,
-        LogLevel    => 'crit',
-        @_
-    );
-
-    $RT::Logger->log(
-        level   => $args{'LogLevel'},
-        message => $args{'Explanation'}
-    );
-    my $entity = MIME::Entity->build(
-        Type                   => "multipart/mixed",
-        From                   => $args{'From'},
-        Bcc                    => $args{'Bcc'},
-        To                     => $args{'To'},
-        Subject                => $args{'Subject'},
-        'X-RT-Loop-Prevention' => $RT::rtname,
-    );
-
-    $entity->attach( Data => $args{'Explanation'} . "\n" );
-
-    my $mimeobj = $args{'MIMEObj'};
-    $mimeobj->sync_headers();
-    $entity->add_part($mimeobj);
-
-    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 );
-    }
+    require RT::Interface::Email;
+    RT::Interface::Email::ParseTicketId(@_);
 }
 
 # }}}
 
 
 
 }
 
 # }}}
 
 
 
-# {{{ sub GetCurrentUser 
-
-sub GetCurrentUser {
-    my $self     = shift;
-    my $ErrorsTo = shift;
-
-    my %UserInfo = ();
-
-    #Suck the address of the sender out of the header
-    my ( $Address, $Name ) = $self->ParseSenderAddressFromHead();
-
-    my $tempuser = RT::User->new($RT::SystemUser);
-
-    #This will apply local address canonicalization rules
-    $Address = $tempuser->CanonicalizeEmailAddress($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;
-    ( $UserFoundInExternalDatabase, %UserInfo ) =
-      $self->LookupExternalUserInfo( $Address, $Name );
-
-    $Address  = $UserInfo{'EmailAddress'};
-    $Username = $UserInfo{'Name'};
-
-    #Get us a currentuser object to work with. 
-    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::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     => $self->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  => $self->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  => $self->Entity,
-                   LogLevel => 'crit' );
-
-        }
-    }
-
-    return ($CurrentUser);
-
-}
-
-# }}}
-
-
 # {{{ ParseCcAddressesFromHead 
 
 =head2 ParseCcAddressesFromHead HASHREF
 # {{{ ParseCcAddressesFromHead 
 
 =head2 ParseCcAddressesFromHead HASHREF
@@ -526,10 +317,10 @@ sub ParseCcAddressesFromHead {
         my $Address = $AddrObj->address;
         my $user = RT::User->new($RT::SystemUser);
         $Address = $user->CanonicalizeEmailAddress($Address);
         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 ( lc $args{'QueueObj'}->CorrespondAddress eq lc $Address );
+        next if ( lc $args{'QueueObj'}->CommentAddress    eq lc $Address );
+        next if ( $self->IsRTAddress($Address) );
 
         push ( @Addresses, $Address );
     }
 
         push ( @Addresses, $Address );
     }
@@ -600,6 +391,8 @@ sub ParseAddressFromHeader {
     my $self = shift;
     my $Addr = shift;
 
     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];
     my @Addresses = Mail::Address->parse($Addr);
 
     my $AddrObj = $Addresses[0];
@@ -620,7 +413,7 @@ sub ParseAddressFromHeader {
 
 # {{{ IsRTAddress
 
 
 # {{{ IsRTAddress
 
-=item IsRTaddress ADDRESS
+=head2 IsRTaddress ADDRESS
 
 Takes a single parameter, an email address. 
 Returns true if that address matches the $RTAddressRegexp.  
 
 Takes a single parameter, an email address. 
 Returns true if that address matches the $RTAddressRegexp.  
@@ -654,7 +447,7 @@ sub IsRTAddress {
 
 # {{{ CullRTAddresses
 
 
 # {{{ CullRTAddresses
 
-=item CullRTAddresses ARRAY
+=head2 CullRTAddresses ARRAY
 
 Takes a single argument, an array of email addresses.
 Returns the same array with any IsRTAddress()es weeded out.
 
 Takes a single argument, an array of email addresses.
 Returns the same array with any IsRTAddress()es weeded out.
@@ -675,7 +468,10 @@ 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);
 }
@@ -699,7 +495,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. 
@@ -712,12 +508,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. 
@@ -772,6 +568,7 @@ sub Entity {
 }
 
 # }}}
 }
 
 # }}}
+
 # {{{ _SetupMIMEParser 
 
 =head2 _SetupMIMEParser $parser
 # {{{ _SetupMIMEParser 
 
 =head2 _SetupMIMEParser $parser
@@ -789,19 +586,20 @@ A private instance method which sets up a mime parser to do its job
     ## Over max size and return them
 
 sub _SetupMIMEParser {
     ## Over max size and return them
 
 sub _SetupMIMEParser {
-    my $self = shift;
+    my $self   = shift;
     my $parser = shift;
     my $parser = shift;
-    my $AttachmentDir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
-
+    
     # Set up output directory for files:
     # Set up output directory for files:
-    $parser->output_dir("$AttachmentDir");
-    $parser->filer->ignore_filename(1);
 
 
+    my $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
+    push ( @{ $self->{'AttachmentDirs'} }, $tmpdir );
+    $parser->output_dir($tmpdir);
+    $parser->filer->ignore_filename(1);
 
     #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");
 
     # Set up the prefix for files with auto-generated names:
     $parser->output_prefix("part");
@@ -809,9 +607,25 @@ sub _SetupMIMEParser {
     # do _not_ store each msg as in-core scalar;
 
     $parser->output_to_core(0);
     # do _not_ store each msg as in-core scalar;
 
     $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
+    
+    $parser->tmp_recycling(0);
+
 }
 }
+
 # }}}
 
 # }}}
 
+sub DESTROY {
+    my $self = shift;
+    File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1);
+}
+
+
+
 eval "require RT::EmailParser_Vendor";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Vendor.pm});
 eval "require RT::EmailParser_Local";
 eval "require RT::EmailParser_Vendor";
 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Vendor.pm});
 eval "require RT::EmailParser_Local";
Freeside billing, trouble ticketing, network monitoring and provisioning