diff options
Diffstat (limited to 'rt/lib/RT/EmailParser.pm')
-rw-r--r-- | rt/lib/RT/EmailParser.pm | 634 |
1 files changed, 0 insertions, 634 deletions
diff --git a/rt/lib/RT/EmailParser.pm b/rt/lib/RT/EmailParser.pm deleted file mode 100644 index 3a99e5a..0000000 --- a/rt/lib/RT/EmailParser.pm +++ /dev/null @@ -1,634 +0,0 @@ -# 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; |