diff options
Diffstat (limited to 'rt/lib/RT/EmailParser.pm')
-rw-r--r-- | rt/lib/RT/EmailParser.pm | 634 |
1 files changed, 634 insertions, 0 deletions
diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm new file mode 100644 index 000000000..3a99e5a5e --- /dev/null +++ b/rt/lib/RT/EmailParser.pm @@ -0,0 +1,634 @@ +# 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::EmailParser; + + +use base qw/RT::Base/; + +use strict; +use Mail::Address; +use MIME::Entity; +use MIME::Head; +use MIME::Parser; +use File::Temp qw/tempdir/; + +=head1 NAME + + RT::EmailParser - helper functions for parsing parts from incoming + email messages + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=begin testing + +ok(require RT::EmailParser); + +=end testing + + +=head1 METHODS + +=head2 new + +Returns a new RT::EmailParser object + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + return $self; +} + + +# {{{ sub SmartParseMIMEEntityFromScalar + +=head2 SmartParseMIMEEntityFromScalar { Message => SCALAR_REF, Decode => BOOL } + +Parse a message stored in a scalar from scalar_ref + +=cut + +sub SmartParseMIMEEntityFromScalar { + my $self = shift; + my %args = ( Message => undef, Decode => 1, @_ ); + + my ( $fh, $temp_file ); + eval { + + for ( 1 .. 10 ) { + + # 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'} ); + } + +} + +# }}} + +# {{{ sub ParseMIMEEntityFromSTDIN + +=head2 ParseMIMEEntityFromSTDIN + +Parse a message from standard input + +=cut + +sub ParseMIMEEntityFromSTDIN { + my $self = shift; + 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. +Parses it. + +Returns true if it wins. +Returns false if it loses. + +=cut + +sub ParseMIMEEntityFromScalar { + my $self = shift; + my $message = shift; + my $postprocess = (@_ ? shift : 1); + $self->_ParseMIMEEntity($message,'parse_data', $postprocess); +} + +# }}} + +# {{{ ParseMIMEEntityFromFilehandle *FH + +=head2 ParseMIMEEntityFromFilehandle *FH + +Parses a mime entity from a filehandle passed in as an argument + +=cut + +sub ParseMIMEEntityFromFileHandle { + my $self = shift; + my $filehandle = shift; + my $postprocess = (@_ ? shift : 1); + $self->_ParseMIMEEntity($filehandle,'parse', $postprocess); +} + +# }}} + +# {{{ ParseMIMEEntityFromFile + +=head2 ParseMIMEEntityFromFile + +Parses a mime entity from a filename passed in as an argument + +=cut + +sub ParseMIMEEntityFromFile { + my $self = shift; + my $file = shift; + my $postprocess = (@_ ? shift : 1); + $self->_ParseMIMEEntity($file,'parse_open',$postprocess); +} + +# }}} + +# {{{ _ParseMIMEEntity +sub _ParseMIMEEntity { + my $self = shift; + my $message = shift; + my $method = shift; + my $postprocess = shift; + # Create a new parser object: + + my $parser = MIME::Parser->new(); + $self->_SetupMIMEParser($parser); + + + # TODO: XXX 3.0 we really need to wrap this in an eval { } + 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); + unless ( $self->{'entity'} = $parser->$method($message) ) { + $RT::Logger->crit("couldn't parse MIME stream"); + return ( undef); + } + } + if ($postprocess) { + $self->_PostProcessNewEntity() ; + } + +} + +# }}} + +# {{{ _PostProcessNewEntity + +=head2 _PostProcessNewEntity + +cleans up and postprocesses a newly parsed MIME Entity + +=cut + +sub _PostProcessNewEntity { + my $self = shift; + + #Now we've got a parsed mime object. + + # 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; + + + # try to convert text parts into utf-8 charset + RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8'); + + + + +} + +# }}} + +# {{{ sub ParseTicketId + +sub ParseTicketId { + my $self = shift; + $RT::Logger->warnings("RT::EmailParser->ParseTicketId deprecated. You should be using RT::Interface::Email"); + + require RT::Interface::Email; + RT::Interface::Email::ParseTicketId(@_); +} + +# }}} + + + +# {{{ 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 +email address and anything that the $RTAddressRegexp matches. + +=cut + +sub ParseCcAddressesFromHead { + + my $self = shift; + + my %args = ( + QueueObj => undef, + CurrentUser => undef, + @_ + ); + + my (@Addresses); + + my @ToObjs = Mail::Address->parse( $self->Head->get('To') ); + my @CcObjs = Mail::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); + 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 ); + } + 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 + +=head2 IsRTaddress ADDRESS + +Takes a single parameter, an email address. +Returns true if that address matches the $RTAddressRegexp. +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 + +sub IsRTAddress { + 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); + } +} + +# }}} + + +# {{{ CullRTAddresses + +=head2 CullRTAddresses ARRAY + +Takes a single argument, an array of email addresses. +Returns the same array with any IsRTAddress()es weeded out. + +=begin testing + +@before = ("rt\@example.com", "frt\@example.com"); +@after = ("frt\@example.com"); +ok(eq_array(RT::EmailParser::CullRTAddresses("",@before),@after), "CullRTAddresses only culls RT addresses"); + +=end testing + +=cut + +sub CullRTAddresses { + my $self = shift; + my @addresses= (@_); + my @addrlist; + + foreach my $addr( @addresses ) { + # 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); +} + +# }}} + + +# {{{ LookupExternalUserInfo + + +# LookupExternalUserInfo is a site-definable method for synchronizing +# incoming users with an external data source. +# +# This routine takes a tuple of EmailAddress and FriendlyName +# EmailAddress is the user's email address, ususally taken from +# an email message's From: header. +# FriendlyName is a freeform string, ususally taken from the "comment" +# portion of an email message's From: header. +# +# If you define an AutoRejectRequest template, RT will use this +# template for the rejection message. + + +=head2 LookupExternalUserInfo + + LookupExternalUserInfo is a site-definable method for synchronizing + incoming users with an external data source. + + This routine takes a tuple of EmailAddress and FriendlyName + EmailAddress is the user's email address, ususally taken from + an email message's From: header. + FriendlyName is a freeform string, ususally taken from the "comment" + portion of an email message's From: header. + + It returns (FoundInExternalDatabase, ParamHash); + + 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. + + EmailAddress is the email address that RT should use for this user. + Name is the 'Name' attribute RT should use for this user. + 'Name' is used for things like access control and user lookups. + RealName is what RT should display as the user's name when displaying + 'friendly' names + +=cut + +sub LookupExternalUserInfo { + my $self = shift; + my $EmailAddress = shift; + my $RealName = shift; + + my $FoundInExternalDatabase = 1; + my %params; + + #Name is the RT username you want to use for this user. + $params{'Name'} = $EmailAddress; + $params{'EmailAddress'} = $EmailAddress; + $params{'RealName'} = $RealName; + + # See RT's contributed code for examples. + # http://www.fsck.com/pub/rt/contrib/ + return ($FoundInExternalDatabase, %params); +} + +# }}} + +# {{{ Accessor methods for parsed email messages + +=head2 Head + +Return the parsed head from this message + +=cut + +sub Head { + my $self = shift; + return $self->Entity->head; +} + +=head2 Entity + +Return the parsed Entity from this message + +=cut + +sub Entity { + my $self = shift; + return $self->{'entity'}; +} + +# }}} + +# {{{ _SetupMIMEParser + +=head2 _SetupMIMEParser $parser + +A private instance method which sets up a mime parser to do its job + +=cut + + + ## 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? + + ## At the same time, we should make sure that we nuke attachments + ## Over max size and return them + +sub _SetupMIMEParser { + 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); + + #If someone includes a message, extract it + $parser->extract_nested_messages(1); + + $parser->extract_uuencode(1); ### default is false + + # Set up the prefix for files with auto-generated names: + $parser->output_prefix("part"); + + # 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"; +die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Local.pm}); + +1; |