rt/lib/RT/EmailParser.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 package RT::EmailParser;
  50
  51
  52 use base qw/RT::Base/;
  53
  54 use strict;
  55 use warnings;
  56
  57 use Email::Address;
  58 use MIME::Entity;
  59 use MIME::Head;
  60 use MIME::Parser;
  61 use File::Temp qw/tempdir/;
  62
  63 =head1 NAME
  64
  65   RT::EmailParser - helper functions for parsing parts from incoming
  66   email messages
  67
  68 =head1 SYNOPSIS
  69
  70
  71 =head1 DESCRIPTION
  72
  73
  74
  75
  76 =head1 METHODS
  77
  78 =head2 new
  79
  80 Returns a new RT::EmailParser object
  81
  82 =cut
  83
  84 sub new  {
  85   my $proto = shift;
  86   my $class = ref($proto) || $proto;
  87   my $self  = {};
  88   bless ($self, $class);
  89   return $self;
  90 }
  91
  92
  93 =head2 SmartParseMIMEEntityFromScalar Message => SCALAR_REF [, Decode => BOOL, Exact => BOOL ] }
  94
  95 Parse a message stored in a scalar from scalar_ref.
  96
  97 =cut
  98
  99 sub SmartParseMIMEEntityFromScalar {
 100     my $self = shift;
 101     my %args = ( Message => undef, Decode => 1, Exact => 0, @_ );
 102
 103     eval {
 104         my ( $fh, $temp_file );
 105         for ( 1 .. 10 ) {
 106
 107             # on NFS and NTFS, it is possible that tempfile() conflicts
 108             # with other processes, causing a race condition. we try to
 109             # accommodate this by pausing and retrying.
 110             last
 111               if ( $fh, $temp_file ) =
 112               eval { File::Temp::tempfile( undef, UNLINK => 0 ) };
 113             sleep 1;
 114         }
 115         if ($fh) {
 116
 117             #thank you, windows
 118             binmode $fh;
 119             $fh->autoflush(1);
 120             print $fh $args{'Message'};
 121             close($fh);
 122             if ( -f $temp_file ) {
 123
 124                 # We have to trust the temp file's name -- untaint it
 125                 $temp_file =~ /(.*)/;
 126                 my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} );
 127                 unlink($1);
 128                 return $entity;
 129             }
 130         }
 131     };
 132
 133     #If for some reason we weren't able to parse the message using a temp file
 134     # try it with a scalar
 135     if ( $@ || !$self->Entity ) {
 136         return $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'}, $args{'Exact'} );
 137     }
 138
 139 }
 140
 141
 142 =head2 ParseMIMEEntityFromSTDIN
 143
 144 Parse a message from standard input
 145
 146 =cut
 147
 148 sub ParseMIMEEntityFromSTDIN {
 149     my $self = shift;
 150     return $self->ParseMIMEEntityFromFileHandle(\*STDIN, @_);
 151 }
 152
 153 =head2 ParseMIMEEntityFromScalar  $message
 154
 155 Takes either a scalar or a reference to a scalar which contains a stringified MIME message.
 156 Parses it.
 157
 158 Returns true if it wins.
 159 Returns false if it loses.
 160
 161 =cut
 162
 163 sub ParseMIMEEntityFromScalar {
 164     my $self = shift;
 165     return $self->_ParseMIMEEntity( shift, 'parse_data', @_ );
 166 }
 167
 168 =head2 ParseMIMEEntityFromFilehandle *FH
 169
 170 Parses a mime entity from a filehandle passed in as an argument
 171
 172 =cut
 173
 174 sub ParseMIMEEntityFromFileHandle {
 175     my $self = shift;
 176     return $self->_ParseMIMEEntity( shift, 'parse', @_ );
 177 }
 178
 179 =head2 ParseMIMEEntityFromFile
 180
 181 Parses a mime entity from a filename passed in as an argument
 182
 183 =cut
 184
 185 sub ParseMIMEEntityFromFile {
 186     my $self = shift;
 187     return $self->_ParseMIMEEntity( shift, 'parse_open', @_ );
 188 }
 189
 190
 191 sub _ParseMIMEEntity {
 192     my $self = shift;
 193     my $message = shift;
 194     my $method = shift;
 195     my $postprocess = (@_ ? shift : 1);
 196     my $exact = shift;
 197
 198     # Create a new parser object:
 199     my $parser = MIME::Parser->new();
 200     $self->_SetupMIMEParser($parser);
 201     $parser->decode_bodies(0) if $exact;
 202
 203     # TODO: XXX 3.0 we really need to wrap this in an eval { }
 204     unless ( $self->{'entity'} = $parser->$method($message) ) {
 205         $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
 206         # Try again, this time without extracting nested messages
 207         $parser->extract_nested_messages(0);
 208         unless ( $self->{'entity'} = $parser->$method($message) ) {
 209             $RT::Logger->crit("couldn't parse MIME stream");
 210             return ( undef);
 211         }
 212     }
 213
 214     $self->_PostProcessNewEntity if $postprocess;
 215
 216     return $self->{'entity'};
 217 }
 218
 219 sub _DecodeBodies {
 220     my $self = shift;
 221     return unless $self->{'entity'};
 222
 223     my @parts = $self->{'entity'}->parts_DFS;
 224     $self->_DecodeBody($_) foreach @parts;
 225 }
 226
 227 sub _DecodeBody {
 228     my $self = shift;
 229     my $entity = shift;
 230
 231     my $old = $entity->bodyhandle or return;
 232     return unless $old->is_encoded;
 233
 234     require MIME::Decoder;
 235     my $encoding = $entity->head->mime_encoding;
 236     my $decoder = new MIME::Decoder $encoding;
 237     unless ( $decoder ) {
 238         $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary");
 239         $old->is_encoded(0);
 240         return;
 241     }
 242
 243     require MIME::Body;
 244     # XXX: use InCore for now, but later must switch to files
 245     my $new = new MIME::Body::InCore;
 246     $new->binmode(1);
 247     $new->is_encoded(0);
 248
 249     my $source = $old->open('r') or die "couldn't open body: $!";
 250     my $destination = $new->open('w') or die "couldn't open body: $!";
 251     {
 252         local $@;
 253         eval { $decoder->decode($source, $destination) };
 254         $RT::Logger->error($@) if $@;
 255     }
 256     $source->close or die "can't close: $!";
 257     $destination->close or die "can't close: $!";
 258
 259     $entity->bodyhandle( $new );
 260 }
 261
 262 =head2 _PostProcessNewEntity
 263
 264 cleans up and postprocesses a newly parsed MIME Entity
 265
 266 =cut
 267
 268 sub _PostProcessNewEntity {
 269     my $self = shift;
 270
 271     #Now we've got a parsed mime object.
 272
 273     # Unfold headers that are have embedded newlines
 274     #  Better do this before conversion or it will break
 275     #  with multiline encoded Subject (RFC2047) (fsck.com #5594)
 276     $self->Head->unfold;
 277
 278     # try to convert text parts into utf-8 charset
 279     RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');
 280 }
 281
 282 =head2 ParseCcAddressesFromHead HASHREF
 283
 284 Takes a hashref object containing QueueObj, Head and CurrentUser objects.
 285 Returns a list of all email addresses in the To and Cc
 286 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
 287 email address and anything that the RT->Config->Get('RTAddressRegexp') matches.
 288
 289 =cut
 290
 291 sub ParseCcAddressesFromHead {
 292
 293     my $self = shift;
 294
 295     my %args = (
 296         QueueObj    => undef,
 297         CurrentUser => undef,
 298         @_
 299     );
 300
 301     my (@Addresses);
 302
 303     my @ToObjs = Email::Address->parse( $self->Head->get('To') );
 304     my @CcObjs = Email::Address->parse( $self->Head->get('Cc') );
 305
 306     foreach my $AddrObj ( @ToObjs, @CcObjs ) {
 307         my $Address = $AddrObj->address;
 308         my $user = RT::User->new($RT::SystemUser);
 309         $Address = $user->CanonicalizeEmailAddress($Address);
 310         next if ( lc $args{'CurrentUser'}->EmailAddress   eq lc $Address );
 311         next if ( lc $args{'QueueObj'}->CorrespondAddress eq lc $Address );
 312         next if ( lc $args{'QueueObj'}->CommentAddress    eq lc $Address );
 313         next if ( $self->IsRTAddress($Address) );
 314
 315         push ( @Addresses, $Address );
 316     }
 317     return (@Addresses);
 318 }
 319
 320
 321
 322
 323 =head2 IsRTaddress ADDRESS
 324
 325 Takes a single parameter, an email address.
 326 Returns true if that address matches the C<RTAddressRegexp> config option.
 327 Returns false, otherwise.
 328
 329
 330 =cut
 331
 332 sub IsRTAddress {
 333     my $self = shift;
 334     my $address = shift;
 335
 336     # Example: the following rule would tell RT not to Cc
 337     #   "tickets@noc.example.com"
 338     my $address_re = RT->Config->Get('RTAddressRegexp');
 339     if ( defined $address_re && $address =~ /$address_re/i ) {
 340         return 1;
 341     }
 342     return undef;
 343 }
 344
 345
 346
 347
 348 =head2 CullRTAddresses ARRAY
 349
 350 Takes a single argument, an array of email addresses.
 351 Returns the same array with any IsRTAddress()es weeded out.
 352
 353
 354 =cut
 355
 356 sub CullRTAddresses {
 357     my $self = shift;
 358     my @addresses= (@_);
 359     my @addrlist;
 360
 361     foreach my $addr( @addresses ) {
 362                                  # We use the class instead of the instance
 363                                  # because sloppy code calls this method
 364                                  # without a $self
 365       push (@addrlist, $addr)    unless RT::EmailParser->IsRTAddress($addr);
 366     }
 367     return (@addrlist);
 368 }
 369
 370
 371
 372
 373
 374 # LookupExternalUserInfo is a site-definable method for synchronizing
 375 # incoming users with an external data source.
 376 #
 377 # This routine takes a tuple of EmailAddress and FriendlyName
 378 #   EmailAddress is the user's email address, ususally taken from
 379 #       an email message's From: header.
 380 #   FriendlyName is a freeform string, ususally taken from the "comment"
 381 #       portion of an email message's From: header.
 382 #
 383 # If you define an AutoRejectRequest template, RT will use this
 384 # template for the rejection message.
 385
 386
 387 =head2 LookupExternalUserInfo
 388
 389  LookupExternalUserInfo is a site-definable method for synchronizing
 390  incoming users with an external data source.
 391
 392  This routine takes a tuple of EmailAddress and FriendlyName
 393     EmailAddress is the user's email address, ususally taken from
 394         an email message's From: header.
 395     FriendlyName is a freeform string, ususally taken from the "comment"
 396         portion of an email message's From: header.
 397
 398  It returns (FoundInExternalDatabase, ParamHash);
 399
 400    FoundInExternalDatabase must  be set to 1 before return if the user
 401    was found in the external database.
 402
 403    ParamHash is a Perl parameter hash which can contain at least the
 404    following fields. These fields are used to populate RT's users
 405    database when the user is created.
 406
 407     EmailAddress is the email address that RT should use for this user.
 408     Name is the 'Name' attribute RT should use for this user.
 409          'Name' is used for things like access control and user lookups.
 410     RealName is what RT should display as the user's name when displaying
 411          'friendly' names
 412
 413 =cut
 414
 415 sub LookupExternalUserInfo {
 416   my $self = shift;
 417   my $EmailAddress = shift;
 418   my $RealName = shift;
 419
 420   my $FoundInExternalDatabase = 1;
 421   my %params;
 422
 423   #Name is the RT username you want to use for this user.
 424   $params{'Name'} = $EmailAddress;
 425   $params{'EmailAddress'} = $EmailAddress;
 426   $params{'RealName'} = $RealName;
 427
 428   # See RT's contributed code for examples.
 429   # http://www.fsck.com/pub/rt/contrib/
 430   return ($FoundInExternalDatabase, %params);
 431 }
 432
 433 =head2 Head
 434
 435 Return the parsed head from this message
 436
 437 =cut
 438
 439 sub Head {
 440     my $self = shift;
 441     return $self->Entity->head;
 442 }
 443
 444 =head2 Entity
 445
 446 Return the parsed Entity from this message
 447
 448 =cut
 449
 450 sub Entity {
 451     my $self = shift;
 452     return $self->{'entity'};
 453 }
 454
 455
 456
 457 =head2 _SetupMIMEParser $parser
 458
 459 A private instance method which sets up a mime parser to do its job
 460
 461 =cut
 462
 463
 464     ## TODO: Does it make sense storing to disk at all?  After all, we
 465     ## need to put each msg as an in-core scalar before saving it to
 466     ## the database, don't we?
 467
 468     ## At the same time, we should make sure that we nuke attachments
 469     ## Over max size and return them
 470
 471 sub _SetupMIMEParser {
 472     my $self   = shift;
 473     my $parser = shift;
 474
 475     # Set up output directory for files; we use $RT::VarPath instead
 476     # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always
 477     # writable.
 478     my $tmpdir;
 479     if ( -w $RT::VarPath ) {
 480         $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 );
 481     } elsif (-w File::Spec->tmpdir) {
 482         $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
 483     } else {
 484         $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!");
 485     }
 486
 487     #If someone includes a message, extract it
 488     $parser->extract_nested_messages(1);
 489     $parser->extract_uuencode(1);    ### default is false
 490
 491     if ($tmpdir) {
 492         # If we got a writable tmpdir, write to disk
 493         push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir );
 494         $parser->output_dir($tmpdir);
 495         $parser->filer->ignore_filename(1);
 496
 497         # Set up the prefix for files with auto-generated names:
 498         $parser->output_prefix("part");
 499
 500         # From the MIME::Parser docs:
 501         # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope"
 502         # Turns out that the default is to recycle tempfiles
 503         # Temp files should never be recycled, especially when running under perl taint checking
 504
 505         $parser->tmp_recycling(0) if $parser->can('tmp_recycling');
 506     } else {
 507         # Otherwise, fall back to storing it in memory
 508         $parser->output_to_core(1);
 509         $parser->tmp_to_core(1);
 510         $parser->use_inner_files(1);
 511     }
 512
 513 }
 514
 515 =head2 ParseEmailAddress string
 516
 517 Returns a list of Email::Address objects
 518 Works around the bug that Email::Address 1.889 and earlier
 519 doesn't handle local-only email addresses (when users pass
 520 in just usernames on the RT system in fields that expect
 521 Email Addresses)
 522
 523 We don't handle the case of
 524 bob, fred@bestpractical.com
 525 because we don't want to fail parsing
 526 bob, "Falcone, Fred" <fred@bestpractical.com>
 527 The next release of Email::Address will have a new method
 528 we can use that removes the bandaid
 529
 530 =cut
 531
 532 sub ParseEmailAddress {
 533     my $self = shift;
 534     my $address_string = shift;
 535
 536     $address_string =~ s/^\s+|\s+$//g;
 537
 538     my @addresses;
 539     # if it looks like a username / local only email
 540     if ($address_string !~ /@/ && $address_string =~ /^\w+$/) {
 541         my $user = RT::User->new( $RT::SystemUser );
 542         my ($id, $msg) = $user->Load($address_string);
 543         if ($id) {
 544             push @addresses, Email::Address->new($user->Name,$user->EmailAddress);
 545         } else {
 546             $RT::Logger->error("Unable to parse an email address from $address_string: $msg");
 547         }
 548     } else {
 549         @addresses = Email::Address->parse($address_string);
 550     }
 551
 552     return @addresses;
 553
 554 }
 555
 556
 557 sub DESTROY {
 558     my $self = shift;
 559     File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1)
 560         if $self->{'AttachmentDirs'};
 561 }
 562
 563
 564
 565 eval "require RT::EmailParser_Vendor";
 566 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Vendor.pm});
 567 eval "require RT::EmailParser_Local";
 568 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Local.pm});
 569
 570 1;