rt/lib/RT/EmailParser.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
   6 #                                          <sales@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
  58 use Email::Address;
  59 use MIME::Entity;
  60 use MIME::Head;
  61 use MIME::Parser;
  62 use File::Temp qw/tempdir/;
  63
  64 =head1 NAME
  65
  66   RT::EmailParser - helper functions for parsing parts from incoming
  67   email messages
  68
  69 =head1 SYNOPSIS
  70
  71
  72 =head1 DESCRIPTION
  73
  74
  75
  76
  77 =head1 METHODS
  78
  79 =head2 new
  80
  81 Returns a new RT::EmailParser object
  82
  83 =cut
  84
  85 sub new  {
  86   my $proto = shift;
  87   my $class = ref($proto) || $proto;
  88   my $self  = {};
  89   bless ($self, $class);
  90   return $self;
  91 }
  92
  93
  94 =head2 SmartParseMIMEEntityFromScalar Message => SCALAR_REF [, Decode => BOOL, Exact => BOOL ] }
  95
  96 Parse a message stored in a scalar from scalar_ref.
  97
  98 =cut
  99
 100 sub SmartParseMIMEEntityFromScalar {
 101     my $self = shift;
 102     my %args = ( Message => undef, Decode => 1, Exact => 0, @_ );
 103
 104     eval {
 105         my ( $fh, $temp_file );
 106         for ( 1 .. 10 ) {
 107
 108             # on NFS and NTFS, it is possible that tempfile() conflicts
 109             # with other processes, causing a race condition. we try to
 110             # accommodate this by pausing and retrying.
 111             last
 112               if ( $fh, $temp_file ) =
 113               eval { File::Temp::tempfile( undef, UNLINK => 0 ) };
 114             sleep 1;
 115         }
 116         if ($fh) {
 117
 118             #thank you, windows
 119             binmode $fh;
 120             $fh->autoflush(1);
 121             print $fh $args{'Message'};
 122             close($fh);
 123             if ( -f $temp_file ) {
 124
 125                 # We have to trust the temp file's name -- untaint it
 126                 $temp_file =~ /(.*)/;
 127                 my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} );
 128                 unlink($1);
 129                 return $entity;
 130             }
 131         }
 132     };
 133
 134     $self->RescueOutlook;
 135
 136     #If for some reason we weren't able to parse the message using a temp file
 137     # try it with a scalar
 138     if ( $@ || !$self->Entity ) {
 139         return $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'}, $args{'Exact'} );
 140     }
 141
 142 }
 143
 144
 145 =head2 ParseMIMEEntityFromSTDIN
 146
 147 Parse a message from standard input
 148
 149 =cut
 150
 151 sub ParseMIMEEntityFromSTDIN {
 152     my $self = shift;
 153     return $self->ParseMIMEEntityFromFileHandle(\*STDIN, @_);
 154 }
 155
 156 =head2 ParseMIMEEntityFromScalar  $message
 157
 158 Takes either a scalar or a reference to a scalar which contains a stringified MIME message.
 159 Parses it.
 160
 161 Returns true if it wins.
 162 Returns false if it loses.
 163
 164 =cut
 165
 166 sub ParseMIMEEntityFromScalar {
 167     my $self = shift;
 168     return $self->_ParseMIMEEntity( shift, 'parse_data', @_ );
 169 }
 170
 171 =head2 ParseMIMEEntityFromFilehandle *FH
 172
 173 Parses a mime entity from a filehandle passed in as an argument
 174
 175 =cut
 176
 177 sub ParseMIMEEntityFromFileHandle {
 178     my $self = shift;
 179     return $self->_ParseMIMEEntity( shift, 'parse', @_ );
 180 }
 181
 182 =head2 ParseMIMEEntityFromFile
 183
 184 Parses a mime entity from a filename passed in as an argument
 185
 186 =cut
 187
 188 sub ParseMIMEEntityFromFile {
 189     my $self = shift;
 190     return $self->_ParseMIMEEntity( shift, 'parse_open', @_ );
 191 }
 192
 193
 194 sub _ParseMIMEEntity {
 195     my $self = shift;
 196     my $message = shift;
 197     my $method = shift;
 198     my $postprocess = (@_ ? shift : 1);
 199     my $exact = shift;
 200
 201     # Create a new parser object:
 202     my $parser = MIME::Parser->new();
 203     $self->_SetupMIMEParser($parser);
 204     $parser->decode_bodies(0) if $exact;
 205
 206     # TODO: XXX 3.0 we really need to wrap this in an eval { }
 207     unless ( $self->{'entity'} = $parser->$method($message) ) {
 208         $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
 209         # Try again, this time without extracting nested messages
 210         $parser->extract_nested_messages(0);
 211         unless ( $self->{'entity'} = $parser->$method($message) ) {
 212             $RT::Logger->crit("couldn't parse MIME stream");
 213             return ( undef);
 214         }
 215     }
 216
 217     $self->_PostProcessNewEntity if $postprocess;
 218
 219     return $self->{'entity'};
 220 }
 221
 222 sub _DecodeBodies {
 223     my $self = shift;
 224     return unless $self->{'entity'};
 225
 226     my @parts = $self->{'entity'}->parts_DFS;
 227     $self->_DecodeBody($_) foreach @parts;
 228 }
 229
 230 sub _DecodeBody {
 231     my $self = shift;
 232     my $entity = shift;
 233
 234     my $old = $entity->bodyhandle or return;
 235     return unless $old->is_encoded;
 236
 237     require MIME::Decoder;
 238     my $encoding = $entity->head->mime_encoding;
 239     my $decoder = MIME::Decoder->new($encoding);
 240     unless ( $decoder ) {
 241         $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary");
 242         $old->is_encoded(0);
 243         return;
 244     }
 245
 246     require MIME::Body;
 247     # XXX: use InCore for now, but later must switch to files
 248     my $new = MIME::Body::InCore->new();
 249     $new->binmode(1);
 250     $new->is_encoded(0);
 251
 252     my $source = $old->open('r') or die "couldn't open body: $!";
 253     my $destination = $new->open('w') or die "couldn't open body: $!";
 254     {
 255         local $@;
 256         eval { $decoder->decode($source, $destination) };
 257         $RT::Logger->error($@) if $@;
 258     }
 259     $source->close or die "can't close: $!";
 260     $destination->close or die "can't close: $!";
 261
 262     $entity->bodyhandle( $new );
 263 }
 264
 265 =head2 _PostProcessNewEntity
 266
 267 cleans up and postprocesses a newly parsed MIME Entity
 268
 269 =cut
 270
 271 sub _PostProcessNewEntity {
 272     my $self = shift;
 273
 274     #Now we've got a parsed mime object.
 275
 276     # Unfold headers that are have embedded newlines
 277     #  Better do this before conversion or it will break
 278     #  with multiline encoded Subject (RFC2047) (fsck.com #5594)
 279     $self->Head->unfold;
 280
 281     # try to convert text parts into utf-8 charset
 282     RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');
 283 }
 284
 285 =head2 ParseCcAddressesFromHead HASHREF
 286
 287 Takes a hashref object containing QueueObj, Head and CurrentUser objects.
 288 Returns a list of all email addresses in the To and Cc
 289 headers b<except> the current Queue\'s email addresses, the CurrentUser\'s
 290 email address and anything that the RT->Config->Get('RTAddressRegexp') matches.
 291
 292 =cut
 293
 294 sub ParseCcAddressesFromHead {
 295     my $self = shift;
 296     my %args = (
 297         QueueObj    => undef,
 298         CurrentUser => undef,
 299         @_
 300     );
 301
 302     my (@Addresses);
 303
 304     my @ToObjs = Email::Address->parse( $self->Head->get('To') );
 305     my @CcObjs = Email::Address->parse( $self->Head->get('Cc') );
 306
 307     foreach my $AddrObj ( @ToObjs, @CcObjs ) {
 308         my $Address = $AddrObj->address;
 309         my $user = RT::User->new(RT->SystemUser);
 310         $Address = $user->CanonicalizeEmailAddress($Address);
 311         next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address;
 312         next if $self->IsRTAddress($Address);
 313
 314         push ( @Addresses, $Address );
 315     }
 316     return (@Addresses);
 317 }
 318
 319
 320 =head2 IsRTaddress ADDRESS
 321
 322 Takes a single parameter, an email address.
 323 Returns true if that address matches the C<RTAddressRegexp> config option.
 324 Returns false, otherwise.
 325
 326
 327 =cut
 328
 329 sub IsRTAddress {
 330     my $self = shift;
 331     my $address = shift;
 332
 333     if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) {
 334         return $address =~ /$address_re/i ? 1 : undef;
 335     }
 336
 337     # we don't warn here, but do in config check
 338     if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) {
 339         return 1 if lc $correspond_address eq lc $address;
 340     }
 341     if ( my $comment_address = RT->Config->Get('CommentAddress') ) {
 342         return 1 if lc $comment_address eq lc $address;
 343     }
 344
 345     my $queue = RT::Queue->new( RT->SystemUser );
 346     $queue->LoadByCols( CorrespondAddress => $address );
 347     return 1 if $queue->id;
 348
 349     $queue->LoadByCols( CommentAddress => $address );
 350     return 1 if $queue->id;
 351
 352     return undef;
 353 }
 354
 355
 356 =head2 CullRTAddresses ARRAY
 357
 358 Takes a single argument, an array of email addresses.
 359 Returns the same array with any IsRTAddress()es weeded out.
 360
 361
 362 =cut
 363
 364 sub CullRTAddresses {
 365     my $self = shift;
 366     my @addresses = (@_);
 367
 368     return grep { !$self->IsRTAddress($_) } @addresses;
 369 }
 370
 371
 372
 373
 374
 375 # LookupExternalUserInfo is a site-definable method for synchronizing
 376 # incoming users with an external data source.
 377 #
 378 # This routine takes a tuple of EmailAddress and FriendlyName
 379 #   EmailAddress is the user's email address, ususally taken from
 380 #       an email message's From: header.
 381 #   FriendlyName is a freeform string, ususally taken from the "comment"
 382 #       portion of an email message's From: header.
 383 #
 384 # If you define an AutoRejectRequest template, RT will use this
 385 # template for the rejection message.
 386
 387
 388 =head2 LookupExternalUserInfo
 389
 390  LookupExternalUserInfo is a site-definable method for synchronizing
 391  incoming users with an external data source.
 392
 393  This routine takes a tuple of EmailAddress and FriendlyName
 394     EmailAddress is the user's email address, ususally taken from
 395         an email message's From: header.
 396     FriendlyName is a freeform string, ususally taken from the "comment"
 397         portion of an email message's From: header.
 398
 399  It returns (FoundInExternalDatabase, ParamHash);
 400
 401    FoundInExternalDatabase must  be set to 1 before return if the user
 402    was found in the external database.
 403
 404    ParamHash is a Perl parameter hash which can contain at least the
 405    following fields. These fields are used to populate RT's users
 406    database when the user is created.
 407
 408     EmailAddress is the email address that RT should use for this user.
 409     Name is the 'Name' attribute RT should use for this user.
 410          'Name' is used for things like access control and user lookups.
 411     RealName is what RT should display as the user's name when displaying
 412          'friendly' names
 413
 414 =cut
 415
 416 sub LookupExternalUserInfo {
 417   my $self = shift;
 418   my $EmailAddress = shift;
 419   my $RealName = shift;
 420
 421   my $FoundInExternalDatabase = 1;
 422   my %params;
 423
 424   #Name is the RT username you want to use for this user.
 425   $params{'Name'} = $EmailAddress;
 426   $params{'EmailAddress'} = $EmailAddress;
 427   $params{'RealName'} = $RealName;
 428
 429   return ($FoundInExternalDatabase, %params);
 430 }
 431
 432 =head2 Head
 433
 434 Return the parsed head from this message
 435
 436 =cut
 437
 438 sub Head {
 439     my $self = shift;
 440     return $self->Entity->head;
 441 }
 442
 443 =head2 Entity
 444
 445 Return the parsed Entity from this message
 446
 447 =cut
 448
 449 sub Entity {
 450     my $self = shift;
 451     return $self->{'entity'};
 452 }
 453
 454
 455
 456 =head2 _SetupMIMEParser $parser
 457
 458 A private instance method which sets up a mime parser to do its job
 459
 460 =cut
 461
 462
 463     ## TODO: Does it make sense storing to disk at all?  After all, we
 464     ## need to put each msg as an in-core scalar before saving it to
 465     ## the database, don't we?
 466
 467     ## At the same time, we should make sure that we nuke attachments
 468     ## Over max size and return them
 469
 470 sub _SetupMIMEParser {
 471     my $self   = shift;
 472     my $parser = shift;
 473
 474     # Set up output directory for files; we use $RT::VarPath instead
 475     # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always
 476     # writable.
 477     my $tmpdir;
 478     if ( -w $RT::VarPath ) {
 479         $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 );
 480     } elsif (-w File::Spec->tmpdir) {
 481         $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
 482     } else {
 483         $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!");
 484     }
 485
 486     #If someone includes a message, extract it
 487     $parser->extract_nested_messages(1);
 488     $parser->extract_uuencode(1);    ### default is false
 489
 490     if ($tmpdir) {
 491         # If we got a writable tmpdir, write to disk
 492         push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir );
 493         $parser->output_dir($tmpdir);
 494         $parser->filer->ignore_filename(1);
 495
 496         # Set up the prefix for files with auto-generated names:
 497         $parser->output_prefix("part");
 498
 499         # From the MIME::Parser docs:
 500         # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope"
 501         # Turns out that the default is to recycle tempfiles
 502         # Temp files should never be recycled, especially when running under perl taint checking
 503
 504         $parser->tmp_recycling(0) if $parser->can('tmp_recycling');
 505     } else {
 506         # Otherwise, fall back to storing it in memory
 507         $parser->output_to_core(1);
 508         $parser->tmp_to_core(1);
 509         $parser->use_inner_files(1);
 510     }
 511
 512 }
 513
 514 =head2 ParseEmailAddress string
 515
 516 Returns a list of Email::Address objects
 517 Works around the bug that Email::Address 1.889 and earlier
 518 doesn't handle local-only email addresses (when users pass
 519 in just usernames on the RT system in fields that expect
 520 Email Addresses)
 521
 522 We don't handle the case of
 523 bob, fred@bestpractical.com
 524 because we don't want to fail parsing
 525 bob, "Falcone, Fred" <fred@bestpractical.com>
 526 The next release of Email::Address will have a new method
 527 we can use that removes the bandaid
 528
 529 =cut
 530
 531 sub ParseEmailAddress {
 532     my $self = shift;
 533     my $address_string = shift;
 534
 535     $address_string =~ s/^\s+|\s+$//g;
 536
 537     my @addresses;
 538     # if it looks like a username / local only email
 539     if ($address_string !~ /@/ && $address_string =~ /^\w+$/) {
 540         my $user = RT::User->new( RT->SystemUser );
 541         my ($id, $msg) = $user->Load($address_string);
 542         if ($id) {
 543             push @addresses, Email::Address->new($user->Name,$user->EmailAddress);
 544         } else {
 545             $RT::Logger->error("Unable to parse an email address from $address_string: $msg");
 546         }
 547     } else {
 548         @addresses = Email::Address->parse($address_string);
 549     }
 550
 551     return @addresses;
 552
 553 }
 554
 555 =head2 RescueOutlook
 556
 557 Outlook 2007/2010 have a bug when you write an email with the html format.
 558 it will send a 'multipart/alternative' with both 'text/plain' and 'text/html'
 559 in it.  it's cool to have a 'text/plain' part, but the problem is the part is
 560 not so right: all the "\n" in your main message will become "\n\n" :/
 561
 562 this method will fix this bug, i.e. replaces "\n\n" to "\n".
 563 return 1 if it does find the problem in the entity and get it fixed.
 564
 565 =cut
 566
 567
 568 sub RescueOutlook {
 569     my $self = shift;
 570     my $mime = $self->Entity();
 571     return unless $mime;
 572
 573     my $mailer = $mime->head->get('X-Mailer');
 574     # 12.0 is outlook 2007, 14.0 is 2010
 575     if ( $mailer && $mailer =~ /Microsoft(?:.*?)Outlook 1[2-4]\./ ) {
 576         my $text_part;
 577         if ( $mime->head->get('Content-Type') =~ m{multipart/mixed} ) {
 578             my $first = $mime->parts(0);
 579             if ( $first->head->get('Content-Type') =~ m{multipart/alternative} )
 580             {
 581                 my $inner_first = $first->parts(0);
 582                 if ( $inner_first->head->get('Content-Type') =~ m{text/plain} )
 583                 {
 584                     $text_part = $inner_first;
 585                 }
 586             }
 587         }
 588         elsif ( $mime->head->get('Content-Type') =~ m{multipart/alternative} ) {
 589             my $first = $mime->parts(0);
 590             if ( $first->head->get('Content-Type') =~ m{text/plain} ) {
 591                 $text_part = $first;
 592             }
 593         }
 594
 595         if ($text_part) {
 596
 597             # use the unencoded string
 598             my $content = $text_part->bodyhandle->as_string;
 599             if ( $content =~ s/\n\n/\n/g ) {
 600                 # only write only if we did change the content
 601                 if ( my $io = $text_part->open("w") ) {
 602                     $io->print($content);
 603                     $io->close;
 604                     return 1;
 605                 }
 606                 else {
 607                     $RT::Logger->error("can't write to body");
 608                 }
 609             }
 610         }
 611     }
 612     return;
 613 }
 614
 615
 616 sub DESTROY {
 617     my $self = shift;
 618     File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1)
 619         if $self->{'AttachmentDirs'};
 620 }
 621
 622
 623
 624 RT::Base->_ImportOverlays();
 625
 626 1;