3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
5 # (Except where explictly superceded by other copyright notices)
7 # This work is made available to you under the terms of Version 2 of
8 # the GNU General Public License. A copy of that license should have
9 # been provided with this software, but in any event can be snarfed
12 # This work is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # Unless otherwise specified, all modifications, corrections or
18 # extensions to this work which alter its source code become the
19 # property of Best Practical Solutions, LLC when submitted for
20 # inclusion in the work.
24 package RT::EmailParser;
27 use base qw/RT::Base/;
34 use File::Temp qw/tempdir/;
38 RT::EmailParser - helper functions for parsing parts from incoming
49 ok(require RT::EmailParser);
63 my $class = ref($proto) || $proto;
65 bless ($self, $class);
77 $RT::Logger->debug( $val . "\n" );
79 print STDERR "$val\n";
89 # {{{ sub CheckForLoops
94 my $head = $self->Head;
96 #If this instance of RT sent it our, we don't want to take it in
97 my $RTLoop = $head->get("X-RT-Loop-Prevention") || "";
98 chomp($RTLoop); #remove that newline
99 if ( $RTLoop =~ /^\Q$RT::rtname\E/o ) {
103 # TODO: We might not trap the case where RT instance A sends a mail
104 # to RT instance B which sends a mail to ...
110 # {{{ sub CheckForSuspiciousSender
112 sub CheckForSuspiciousSender {
115 #if it's from a postmaster or mailer daemon, it's likely a bounce.
117 #TODO: better algorithms needed here - there is no standards for
118 #bounces, so it's very difficult to separate them from anything
119 #else. At the other hand, the Return-To address is only ment to be
120 #used as an error channel, we might want to put up a separate
121 #Return-To address which is treated differently.
123 #TODO: search through the whole email and find the right Ticket ID.
125 my ( $From, $junk ) = $self->ParseSenderAddressFromHead();
127 if ( ( $From =~ /^mailer-daemon/i ) or ( $From =~ /^postmaster/i ) ) {
138 # {{{ sub CheckForAutoGenerated
139 sub CheckForAutoGenerated {
141 my $head = $self->Head;
143 my $Precedence = $head->get("Precedence") || "";
144 if ( $Precedence =~ /^(bulk|junk)/i ) {
154 # {{{ sub ParseMIMEEntityFromSTDIN
156 sub ParseMIMEEntityFromSTDIN {
158 return $self->ParseMIMEEntityFromFileHandle(\*STDIN);
163 =head2 ParseMIMEEntityFromScalar $message
165 Takes either a scalar or a reference to a scalr which contains a stringified MIME message.
168 Returns true if it wins.
169 Returns false if it loses.
174 sub ParseMIMEEntityFromScalar {
178 $self->_DoParse('parse_data', $message);
182 # {{{ ParseMIMEEntityFromFilehandle *FH
184 =head2 ParseMIMEEntityFromFilehandle *FH
186 Parses a mime entity from a filehandle passed in as an argument
190 sub ParseMIMEEntityFromFileHandle {
192 my $filehandle = shift;
194 $self->_DoParse('parse', $filehandle);
200 # {{{ ParseMIMEEntityFromFile
202 =head2 ParseMIMEEntityFromFile
204 Parses a mime entity from a filename passed in as an argument
208 sub ParseMIMEEntityFromFile {
212 $self->_DoParse('parse_open', $file);
219 =head2 _DoParse PARSEMETHOD CONTENT
222 A helper for the various parsers to turn around and do the dispatch to the actual parser
231 # Create a new parser object:
233 my $parser = MIME::Parser->new();
234 $self->_SetupMIMEParser($parser);
237 # TODO: XXX 3.0 we really need to wrap this in an eval { }
239 unless ( $self->{'entity'} = $parser->$method($file) ) {
241 # Try again, this time without extracting nested messages
242 $parser->extract_nested_messages(0);
243 unless ( $self->{'entity'} = $parser->$method($file) ) {
244 $RT::Logger->crit("couldn't parse MIME stream");
248 $self->_PostProcessNewEntity();
255 # {{{ _PostProcessNewEntity
257 =head2 _PostProcessNewEntity
259 cleans up and postprocesses a newly parsed MIME Entity
263 sub _PostProcessNewEntity {
266 #Now we've got a parsed mime object.
268 # try to convert text parts into utf-8 charset
269 RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');
272 # Unfold headers that are have embedded newlines
280 # {{{ sub ParseTicketId
287 if ( $Subject =~ s/\[\Q$RT::rtname\E\s+\#(\d+)\s*\]//i ) {
289 $RT::Logger->debug("Found a ticket ID. It's $id");
301 # {{{ ParseCcAddressesFromHead
303 =head2 ParseCcAddressesFromHead HASHREF
305 Takes a hashref object containing QueueObj, Head and CurrentUser objects.
306 Returns a list of all email addresses in the To and Cc
307 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
308 email address and anything that the $RTAddressRegexp matches.
312 sub ParseCcAddressesFromHead {
318 CurrentUser => undef,
324 my @ToObjs = Mail::Address->parse( $self->Head->get('To') );
325 my @CcObjs = Mail::Address->parse( $self->Head->get('Cc') );
327 foreach my $AddrObj ( @ToObjs, @CcObjs ) {
328 my $Address = $AddrObj->address;
329 my $user = RT::User->new($RT::SystemUser);
330 $Address = $user->CanonicalizeEmailAddress($Address);
331 next if ( $args{'CurrentUser'}->EmailAddress =~ /^$Address$/i );
332 next if ( $args{'QueueObj'}->CorrespondAddress =~ /^$Address$/i );
333 next if ( $args{'QueueObj'}->CommentAddress =~ /^$Address$/i );
334 next if ( IsRTAddress($Address) );
336 push ( @Addresses, $Address );
343 # {{{ ParseSenderAdddressFromHead
345 =head2 ParseSenderAddressFromHead
347 Takes a MIME::Header object. Returns a tuple: (user@host, friendly name)
348 of the From (evaluated in order of Reply-To:, From:, Sender)
352 sub ParseSenderAddressFromHead {
355 #Figure out who's sending this message.
356 my $From = $self->Head->get('Reply-To')
357 || $self->Head->get('From')
358 || $self->Head->get('Sender');
359 return ( $self->ParseAddressFromHeader($From) );
364 # {{{ ParseErrorsToAdddressFromHead
366 =head2 ParseErrorsToAddressFromHead
368 Takes a MIME::Header object. Return a single value : user@host
369 of the From (evaluated in order of Errors-To:,Reply-To:, From:, Sender)
373 sub ParseErrorsToAddressFromHead {
376 #Figure out who's sending this message.
378 foreach my $header ( 'Errors-To', 'Reply-To', 'From', 'Sender' ) {
380 # If there's a header of that name
381 my $headerobj = $self->Head->get($header);
383 my ( $addr, $name ) = $self->ParseAddressFromHeader($headerobj);
385 # If it's got actual useful content...
386 return ($addr) if ($addr);
393 # {{{ ParseAddressFromHeader
395 =head2 ParseAddressFromHeader ADDRESS
397 Takes an address from $self->Head->get('Line') and returns a tuple: user@host, friendly name
401 sub ParseAddressFromHeader {
405 my @Addresses = Mail::Address->parse($Addr);
407 my $AddrObj = $Addresses[0];
409 unless ( ref($AddrObj) ) {
410 return ( undef, undef );
413 my $Name = ( $AddrObj->phrase || $AddrObj->comment || $AddrObj->address );
415 #Lets take the from and load a user object.
416 my $Address = $AddrObj->address;
418 return ( $Address, $Name );
425 =item IsRTaddress ADDRESS
427 Takes a single parameter, an email address.
428 Returns true if that address matches the $RTAddressRegexp.
429 Returns false, otherwise.
433 is(RT::EmailParser::IsRTAddress("","rt\@example.com"),1, "Regexp matched rt address" );
434 is(RT::EmailParser::IsRTAddress("","frt\@example.com"),undef, "Regexp didn't match non-rt address" );
444 # Example: the following rule would tell RT not to Cc
445 # "tickets@noc.example.com"
446 if ( defined($RT::RTAddressRegexp) &&
447 $address =~ /$RT::RTAddressRegexp/ ) {
457 # {{{ CullRTAddresses
459 =item CullRTAddresses ARRAY
461 Takes a single argument, an array of email addresses.
462 Returns the same array with any IsRTAddress()es weeded out.
466 @before = ("rt\@example.com", "frt\@example.com");
467 @after = ("frt\@example.com");
468 ok(eq_array(RT::EmailParser::CullRTAddresses("",@before),@after), "CullRTAddresses only culls RT addresses");
474 sub CullRTAddresses {
479 foreach my $addr( @addresses ) {
480 push (@addrlist, $addr) unless IsRTAddress("", $addr);
488 # {{{ LookupExternalUserInfo
491 # LookupExternalUserInfo is a site-definable method for synchronizing
492 # incoming users with an external data source.
494 # This routine takes a tuple of EmailAddress and FriendlyName
495 # EmailAddress is the user's email address, ususally taken from
496 # an email message's From: header.
497 # FriendlyName is a freeform string, ususally taken from the "comment"
498 # portion of an email message's From: header.
500 # If you define an AutoRejectRequest template, RT will use this
501 # template for the rejection message.
504 =item LookupExternalUserInfo
506 LookupExternalUserInfo is a site-definable method for synchronizing
507 incoming users with an external data source.
509 This routine takes a tuple of EmailAddress and FriendlyName
510 EmailAddress is the user's email address, ususally taken from
511 an email message's From: header.
512 FriendlyName is a freeform string, ususally taken from the "comment"
513 portion of an email message's From: header.
515 It returns (FoundInExternalDatabase, ParamHash);
517 FoundInExternalDatabase must be set to 1 before return if the user was
518 found in the external database.
520 ParamHash is a Perl parameter hash which can contain at least the following
521 fields. These fields are used to populate RT's users database when the user
524 EmailAddress is the email address that RT should use for this user.
525 Name is the 'Name' attribute RT should use for this user.
526 'Name' is used for things like access control and user lookups.
527 RealName is what RT should display as the user's name when displaying
532 sub LookupExternalUserInfo {
534 my $EmailAddress = shift;
535 my $RealName = shift;
537 my $FoundInExternalDatabase = 1;
540 #Name is the RT username you want to use for this user.
541 $params{'Name'} = $EmailAddress;
542 $params{'EmailAddress'} = $EmailAddress;
543 $params{'RealName'} = $RealName;
545 # See RT's contributed code for examples.
546 # http://www.fsck.com/pub/rt/contrib/
547 return ($FoundInExternalDatabase, %params);
552 # {{{ Accessor methods for parsed email messages
556 Return the parsed head from this message
562 return $self->Entity->head;
567 Return the parsed Entity from this message
573 return $self->{'entity'};
577 # {{{ _SetupMIMEParser
579 =head2 _SetupMIMEParser $parser
581 A private instance method which sets up a mime parser to do its job
586 ## TODO: Does it make sense storing to disk at all? After all, we
587 ## need to put each msg as an in-core scalar before saving it to
588 ## the database, don't we?
590 ## At the same time, we should make sure that we nuke attachments
591 ## Over max size and return them
593 sub _SetupMIMEParser {
597 # Set up output directory for files:
599 my $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
600 push ( @{ $self->{'AttachmentDirs'} }, $tmpdir );
601 $parser->output_dir($tmpdir);
602 $parser->filer->ignore_filename(1);
604 #If someone includes a message, extract it
605 $parser->extract_nested_messages(1);
607 $parser->extract_uuencode(1); ### default is false
609 # Set up the prefix for files with auto-generated names:
610 $parser->output_prefix("part");
612 # do _not_ store each msg as in-core scalar;
614 $parser->output_to_core(0);
621 File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1);
626 eval "require RT::EmailParser_Vendor";
627 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Vendor.pm});
628 eval "require RT::EmailParser_Local";
629 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Local.pm});