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     my $self = shift;
 293     my %args = (
 294         QueueObj    => undef,
 295         CurrentUser => undef,
 296         @_
 297     );
 298
 299     my (@Addresses);
 300
 301     my @ToObjs = Email::Address->parse( $self->Head->get('To') );
 302     my @CcObjs = Email::Address->parse( $self->Head->get('Cc') );
 303
 304     foreach my $AddrObj ( @ToObjs, @CcObjs ) {
 305         my $Address = $AddrObj->address;
 306         my $user = RT::User->new($RT::SystemUser);
 307         $Address = $user->CanonicalizeEmailAddress($Address);
 308         next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address;
 309         next if $self->IsRTAddress($Address);
 310
 311         push ( @Addresses, $Address );
 312     }
 313     return (@Addresses);
 314 }
 315
 316
 317 =head2 IsRTaddress ADDRESS
 318
 319 Takes a single parameter, an email address.
 320 Returns true if that address matches the C<RTAddressRegexp> config option.
 321 Returns false, otherwise.
 322
 323
 324 =cut
 325
 326 sub IsRTAddress {
 327     my $self = shift;
 328     my $address = shift;
 329
 330     if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) {
 331         return $address =~ /$address_re/i ? 1 : undef;
 332     }
 333
 334     # we don't warn here, but do in config check
 335     if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) {
 336         return 1 if lc $correspond_address eq lc $address;
 337     }
 338     if ( my $comment_address = RT->Config->Get('CommentAddress') ) {
 339         return 1 if lc $comment_address eq lc $address;
 340     }
 341
 342     my $queue = RT::Queue->new( $RT::SystemUser );
 343     $queue->LoadByCols( CorrespondAddress => $address );
 344     return 1 if $queue->id;
 345
 346     $queue->LoadByCols( CommentAddress => $address );
 347     return 1 if $queue->id;
 348
 349     return undef;
 350 }
 351
 352
 353 =head2 CullRTAddresses ARRAY
 354
 355 Takes a single argument, an array of email addresses.
 356 Returns the same array with any IsRTAddress()es weeded out.
 357
 358
 359 =cut
 360
 361 sub CullRTAddresses {
 362     my $self = shift;
 363     my @addresses= (@_);
 364     my @addrlist;
 365
 366     foreach my $addr( @addresses ) {
 367                                  # We use the class instead of the instance
 368                                  # because sloppy code calls this method
 369                                  # without a $self
 370       push (@addrlist, $addr)    unless RT::EmailParser->IsRTAddress($addr);
 371     }
 372     return (@addrlist);
 373 }
 374
 375
 376
 377
 378
 379 # LookupExternalUserInfo is a site-definable method for synchronizing
 380 # incoming users with an external data source.
 381 #
 382 # This routine takes a tuple of EmailAddress and FriendlyName
 383 #   EmailAddress is the user's email address, ususally taken from
 384 #       an email message's From: header.
 385 #   FriendlyName is a freeform string, ususally taken from the "comment"
 386 #       portion of an email message's From: header.
 387 #
 388 # If you define an AutoRejectRequest template, RT will use this
 389 # template for the rejection message.
 390
 391
 392 =head2 LookupExternalUserInfo
 393
 394  LookupExternalUserInfo is a site-definable method for synchronizing
 395  incoming users with an external data source.
 396
 397  This routine takes a tuple of EmailAddress and FriendlyName
 398     EmailAddress is the user's email address, ususally taken from
 399         an email message's From: header.
 400     FriendlyName is a freeform string, ususally taken from the "comment"
 401         portion of an email message's From: header.
 402
 403  It returns (FoundInExternalDatabase, ParamHash);
 404
 405    FoundInExternalDatabase must  be set to 1 before return if the user
 406    was found in the external database.
 407
 408    ParamHash is a Perl parameter hash which can contain at least the
 409    following fields. These fields are used to populate RT's users
 410    database when the user is created.
 411
 412     EmailAddress is the email address that RT should use for this user.
 413     Name is the 'Name' attribute RT should use for this user.
 414          'Name' is used for things like access control and user lookups.
 415     RealName is what RT should display as the user's name when displaying
 416          'friendly' names
 417
 418 =cut
 419
 420 sub LookupExternalUserInfo {
 421   my $self = shift;
 422   my $EmailAddress = shift;
 423   my $RealName = shift;
 424
 425   my $FoundInExternalDatabase = 1;
 426   my %params;
 427
 428   #Name is the RT username you want to use for this user.
 429   $params{'Name'} = $EmailAddress;
 430   $params{'EmailAddress'} = $EmailAddress;
 431   $params{'RealName'} = $RealName;
 432
 433   # See RT's contributed code for examples.
 434   # http://www.fsck.com/pub/rt/contrib/
 435   return ($FoundInExternalDatabase, %params);
 436 }
 437
 438 =head2 Head
 439
 440 Return the parsed head from this message
 441
 442 =cut
 443
 444 sub Head {
 445     my $self = shift;
 446     return $self->Entity->head;
 447 }
 448
 449 =head2 Entity
 450
 451 Return the parsed Entity from this message
 452
 453 =cut
 454
 455 sub Entity {
 456     my $self = shift;
 457     return $self->{'entity'};
 458 }
 459
 460
 461
 462 =head2 _SetupMIMEParser $parser
 463
 464 A private instance method which sets up a mime parser to do its job
 465
 466 =cut
 467
 468
 469     ## TODO: Does it make sense storing to disk at all?  After all, we
 470     ## need to put each msg as an in-core scalar before saving it to
 471     ## the database, don't we?
 472
 473     ## At the same time, we should make sure that we nuke attachments
 474     ## Over max size and return them
 475
 476 sub _SetupMIMEParser {
 477     my $self   = shift;
 478     my $parser = shift;
 479
 480     # Set up output directory for files; we use $RT::VarPath instead
 481     # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always
 482     # writable.
 483     my $tmpdir;
 484     if ( -w $RT::VarPath ) {
 485         $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 );
 486     } elsif (-w File::Spec->tmpdir) {
 487         $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
 488     } else {
 489         $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!");
 490     }
 491
 492     #If someone includes a message, extract it
 493     $parser->extract_nested_messages(1);
 494     $parser->extract_uuencode(1);    ### default is false
 495
 496     if ($tmpdir) {
 497         # If we got a writable tmpdir, write to disk
 498         push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir );
 499         $parser->output_dir($tmpdir);
 500         $parser->filer->ignore_filename(1);
 501
 502         # Set up the prefix for files with auto-generated names:
 503         $parser->output_prefix("part");
 504
 505         # From the MIME::Parser docs:
 506         # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope"
 507         # Turns out that the default is to recycle tempfiles
 508         # Temp files should never be recycled, especially when running under perl taint checking
 509
 510         $parser->tmp_recycling(0) if $parser->can('tmp_recycling');
 511     } else {
 512         # Otherwise, fall back to storing it in memory
 513         $parser->output_to_core(1);
 514         $parser->tmp_to_core(1);
 515         $parser->use_inner_files(1);
 516     }
 517
 518 }
 519
 520 =head2 ParseEmailAddress string
 521
 522 Returns a list of Email::Address objects
 523 Works around the bug that Email::Address 1.889 and earlier
 524 doesn't handle local-only email addresses (when users pass
 525 in just usernames on the RT system in fields that expect
 526 Email Addresses)
 527
 528 We don't handle the case of
 529 bob, fred@bestpractical.com
 530 because we don't want to fail parsing
 531 bob, "Falcone, Fred" <fred@bestpractical.com>
 532 The next release of Email::Address will have a new method
 533 we can use that removes the bandaid
 534
 535 =cut
 536
 537 sub ParseEmailAddress {
 538     my $self = shift;
 539     my $address_string = shift;
 540
 541     $address_string =~ s/^\s+|\s+$//g;
 542
 543     my @addresses;
 544     # if it looks like a username / local only email
 545     if ($address_string !~ /@/ && $address_string =~ /^\w+$/) {
 546         my $user = RT::User->new( $RT::SystemUser );
 547         my ($id, $msg) = $user->Load($address_string);
 548         if ($id) {
 549             push @addresses, Email::Address->new($user->Name,$user->EmailAddress);
 550         } else {
 551             $RT::Logger->error("Unable to parse an email address from $address_string: $msg");
 552         }
 553     } else {
 554         @addresses = Email::Address->parse($address_string);
 555     }
 556
 557     return @addresses;
 558
 559 }
 560
 561
 562 sub DESTROY {
 563     my $self = shift;
 564     File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1)
 565         if $self->{'AttachmentDirs'};
 566 }
 567
 568
 569
 570 eval "require RT::EmailParser_Vendor";
 571 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Vendor.pm});
 572 eval "require RT::EmailParser_Local";
 573 die $@ if ($@ && $@ !~ qr{^Can't locate RT/EmailParser_Local.pm});
 574
 575 1;