rt/lib/RT/Attachment_Overlay.pm

   1 # BEGIN LICENSE BLOCK
   2 #
   3 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
   4 #
   5 # (Except where explictly superceded by other copyright notices)
   6 #
   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
  10 # from www.gnu.org.
  11 #
  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.
  16 #
  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.
  21 #
  22 #
  23 # END LICENSE BLOCK
  24 =head1 SYNOPSIS
  25
  26   use RT::Attachment;
  27
  28
  29 =head1 DESCRIPTION
  30
  31 This module should never be instantiated directly by client code. it's an internal
  32 module which should only be instantiated through exported APIs in Ticket, Queue and other
  33 similar objects.
  34
  35
  36 =head1 METHODS
  37
  38
  39 =begin testing
  40
  41 ok (require RT::Attachment);
  42
  43 =end testing
  44
  45 =cut
  46
  47 use strict;
  48 no warnings qw(redefine);
  49
  50 use MIME::Base64;
  51 use MIME::QuotedPrint;
  52
  53 # {{{ sub _ClassAccessible
  54 sub _ClassAccessible {
  55     {
  56     TransactionId   => { 'read'=>1, 'public'=>1, },
  57     MessageId       => { 'read'=>1, },
  58     Parent          => { 'read'=>1, },
  59     ContentType     => { 'read'=>1, },
  60     Subject         => { 'read'=>1, },
  61     Content         => { 'read'=>1, },
  62     ContentEncoding => { 'read'=>1, },
  63     Headers         => { 'read'=>1, },
  64     Filename        => { 'read'=>1, },
  65     Creator         => { 'read'=>1, 'auto'=>1, },
  66     Created         => { 'read'=>1, 'auto'=>1, },
  67   };
  68 }
  69 # }}}
  70
  71 # {{{ sub TransactionObj
  72
  73 =head2 TransactionObj
  74
  75 Returns the transaction object asscoiated with this attachment.
  76
  77 =cut
  78
  79 sub TransactionObj {
  80     require RT::Transaction;
  81     my $self=shift;
  82     unless (exists $self->{_TransactionObj}) {
  83         $self->{_TransactionObj}=RT::Transaction->new($self->CurrentUser);
  84         $self->{_TransactionObj}->Load($self->TransactionId);
  85     }
  86     return $self->{_TransactionObj};
  87 }
  88
  89 # }}}
  90
  91 # {{{ sub Create
  92
  93 =head2 Create
  94
  95 Create a new attachment. Takes a paramhash:
  96
  97     'Attachment' Should be a single MIME body with optional subparts
  98     'Parent' is an optional Parent RT::Attachment object
  99     'TransactionId' is the mandatory id of the Transaction this attachment is associated with.;
 100
 101 =cut
 102
 103 sub Create {
 104     my $self = shift;
 105     my ($id);
 106     my %args = ( id            => 0,
 107                  TransactionId => 0,
 108                  Parent        => 0,
 109                  Attachment    => undef,
 110                  @_ );
 111
 112     #For ease of reference
 113     my $Attachment = $args{'Attachment'};
 114
 115             #if we didn't specify a ticket, we need to bail
 116             if ( $args{'TransactionId'} == 0 ) {
 117         $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction\n" );
 118         return (0);
 119
 120     }
 121
 122     #If we possibly can, collapse it to a singlepart
 123     $Attachment->make_singlepart;
 124
 125     #Get the subject
 126     my $Subject = $Attachment->head->get( 'subject', 0 );
 127     defined($Subject) or $Subject = '';
 128     chomp($Subject);
 129
 130     #Get the filename
 131     my $Filename = $Attachment->head->recommended_filename || eval {
 132         ${ $Attachment->head->{mail_hdr_hash}{'Content-Disposition'}[0] }
 133             =~ /^.*\bfilename="(.*)"$/ ? $1 : ''
 134     };
 135
 136     # If a message has no bodyhandle, that means that it has subparts (or appears to)
 137     # and we should act accordingly.
 138     unless ( defined $Attachment->bodyhandle ) {
 139         $id = $self->SUPER::Create(
 140             TransactionId => $args{'TransactionId'},
 141             Parent        => 0,
 142             ContentType   => $Attachment->mime_type,
 143             Headers => $Attachment->head->as_string,
 144             Subject => $Subject);
 145
 146         foreach my $part ( $Attachment->parts ) {
 147             my $SubAttachment = new RT::Attachment( $self->CurrentUser );
 148             $SubAttachment->Create(
 149                 TransactionId => $args{'TransactionId'},
 150                 Parent        => $id,
 151                 Attachment    => $part,
 152                 ContentType   => $Attachment->mime_type,
 153                 Headers       => $Attachment->head->as_string(),
 154
 155             );
 156         }
 157         return ($id);
 158     }
 159
 160     #If it's not multipart
 161     else {
 162
 163         my $ContentEncoding = 'none';
 164
 165         my $Body = $Attachment->bodyhandle->as_string;
 166
 167         #get the max attachment length from RT
 168         my $MaxSize = $RT::MaxAttachmentSize;
 169
 170         #if the current attachment contains nulls and the
 171         #database doesn't support embedded nulls
 172
 173         if ( $RT::AlwaysUseBase64 or
 174              ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
 175
 176             # set a flag telling us to mimencode the attachment
 177             $ContentEncoding = 'base64';
 178
 179             #cut the max attchment size by 25% (for mime-encoding overhead.
 180             $RT::Logger->debug("Max size is $MaxSize\n");
 181             $MaxSize = $MaxSize * 3 / 4;
 182         # Some databases (postgres) can't handle non-utf8 data
 183         } elsif (    !$RT::Handle->BinarySafeBLOBs
 184                   && $Attachment->mime_type !~ /text\/plain/gi
 185                   && !Encode::is_utf8( $Body, 1 ) ) {
 186               $ContentEncoding = 'quoted-printable';
 187         }
 188
 189         #if the attachment is larger than the maximum size
 190         if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
 191
 192             # if we're supposed to truncate large attachments
 193             if ($RT::TruncateLongAttachments) {
 194
 195                 # truncate the attachment to that length.
 196                 $Body = substr( $Body, 0, $MaxSize );
 197
 198             }
 199
 200             # elsif we're supposed to drop large attachments on the floor,
 201             elsif ($RT::DropLongAttachments) {
 202
 203                 # drop the attachment on the floor
 204                 $RT::Logger->info( "$self: Dropped an attachment of size " . length($Body) . "\n" . "It started: " . substr( $Body, 0, 60 ) . "\n" );
 205                 return (undef);
 206             }
 207         }
 208
 209         # if we need to mimencode the attachment
 210         if ( $ContentEncoding eq 'base64' ) {
 211
 212             # base64 encode the attachment
 213             Encode::_utf8_off($Body);
 214             $Body = MIME::Base64::encode_base64($Body);
 215
 216         } elsif ($ContentEncoding eq 'quoted-printable') {
 217             Encode::_utf8_off($Body);
 218             $Body = MIME::QuotedPrint::encode($Body);
 219         }
 220
 221
 222         my $id = $self->SUPER::Create( TransactionId => $args{'TransactionId'},
 223                                        ContentType   => $Attachment->mime_type,
 224                                        ContentEncoding => $ContentEncoding,
 225                                        Parent          => $args{'Parent'},
 226                                        Headers       =>  $Attachment->head->as_string,
 227                                        Subject       =>  $Subject,
 228                                        Content         => $Body,
 229                                        Filename => $Filename, );
 230         return ($id);
 231     }
 232 }
 233
 234 # }}}
 235
 236
 237 =head2 Import
 238
 239 Create an attachment exactly as specified in the named parameters.
 240
 241 =cut
 242
 243
 244 sub Import {
 245     my $self = shift;
 246     my %args = ( ContentEncoding => 'none',
 247
 248                  @_ );
 249     return($self->SUPER::Create(@_));
 250 }
 251
 252 # {{{ sub Content
 253
 254 =head2 Content
 255
 256 Returns the attachment's content. if it's base64 encoded, decode it
 257 before returning it.
 258
 259 =cut
 260
 261 sub Content {
 262   my $self = shift;
 263   my $decode_utf8 = (($self->ContentType eq 'text/plain') ? 1 : 0);
 264
 265   if ( $self->ContentEncoding eq 'none' || ! $self->ContentEncoding ) {
 266       return $self->_Value(
 267           'Content',
 268           decode_utf8 => $decode_utf8,
 269       );
 270   } elsif ( $self->ContentEncoding eq 'base64' ) {
 271       return ( $decode_utf8
 272         ? Encode::decode_utf8(MIME::Base64::decode_base64($self->_Value('Content')))
 273         : MIME::Base64::decode_base64($self->_Value('Content'))
 274       );
 275   } elsif ( $self->ContentEncoding eq 'quoted-printable' ) {
 276       return ( $decode_utf8
 277         ? Encode::decode_utf8(MIME::QuotedPrint::decode($self->_Value('Content')))
 278         : MIME::QuotedPrint::decode($self->_Value('Content'))
 279       );
 280   } else {
 281       return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
 282   }
 283 }
 284
 285
 286 # }}}
 287
 288
 289 # {{{ sub OriginalContent
 290
 291 =head2 OriginalContent
 292
 293 Returns the attachment's content as octets before RT's mangling.
 294 Currently, this just means restoring text/plain content back to its
 295 original encoding.
 296
 297 =cut
 298
 299 sub OriginalContent {
 300   my $self = shift;
 301
 302   return $self->Content unless $self->ContentType eq 'text/plain';
 303   my $enc = $self->OriginalEncoding;
 304
 305   my $content;
 306   if ( $self->ContentEncoding eq 'none' || ! $self->ContentEncoding ) {
 307       $content = $self->_Value('Content', decode_utf8 => 0);
 308   } elsif ( $self->ContentEncoding eq 'base64' ) {
 309       $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0));
 310   } elsif ( $self->ContentEncoding eq 'quoted-printable' ) {
 311       return MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0));
 312   } else {
 313       return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
 314   }
 315
 316   # Encode::_utf8_on($content);
 317   if (!$enc || $enc eq '' ||  $enc eq 'utf8' || $enc eq 'utf-8') {
 318     # If we somehow fail to do the decode, at least push out the raw bits
 319     eval {return( Encode::decode_utf8($content))} || return ($content);
 320   }
 321
 322   eval { Encode::from_to($content, 'utf8' => $enc);};
 323   if ($@) {
 324         $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@);
 325   }
 326   return $content;
 327 }
 328
 329 # }}}
 330
 331
 332 # {{{ sub OriginalEncoding
 333
 334 =head2 OriginalEncoding
 335
 336 Returns the attachment's original encoding.
 337
 338 =cut
 339
 340 sub OriginalEncoding {
 341   my $self = shift;
 342   return $self->GetHeader('X-RT-Original-Encoding');
 343 }
 344
 345 # }}}
 346
 347 # {{{ sub Children
 348
 349 =head2 Children
 350
 351   Returns an RT::Attachments object which is preloaded with all Attachments objects with this Attachment\'s Id as their 'Parent'
 352
 353 =cut
 354
 355 sub Children {
 356     my $self = shift;
 357
 358     my $kids = new RT::Attachments($self->CurrentUser);
 359     $kids->ChildrenOf($self->Id);
 360     return($kids);
 361 }
 362
 363 # }}}
 364
 365 # {{{ UTILITIES
 366
 367 # {{{ sub Quote
 368
 369
 370
 371 sub Quote {
 372     my $self=shift;
 373     my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system)
 374               @_);
 375
 376     my ($quoted_content, $body, $headers);
 377     my $max=0;
 378
 379     # TODO: Handle Multipart/Mixed (eventually fix the link in the
 380     # ShowHistory web template?)
 381     if ($self->ContentType =~ m{^(text/plain|message)}i) {
 382         $body=$self->Content;
 383
 384         # Do we need any preformatting (wrapping, that is) of the message?
 385
 386         # Remove quoted signature.
 387         $body =~ s/\n-- \n(.*)$//s;
 388
 389         # What's the longest line like?
 390         foreach (split (/\n/,$body)) {
 391             $max=length if ( length > $max);
 392         }
 393
 394         if ($max>76) {
 395             require Text::Wrapper;
 396             my $wrapper=new Text::Wrapper
 397                 (
 398                  columns => 70,
 399                  body_start => ($max > 70*3 ? '   ' : ''),
 400                  par_start => ''
 401                  );
 402             $body=$wrapper->wrap($body);
 403         }
 404
 405         $body =~ s/^/> /gm;
 406
 407         $body = '[' . $self->TransactionObj->CreatorObj->Name() . ' - ' . $self->TransactionObj->CreatedAsString()
 408                     . "]:\n\n"
 409                 . $body . "\n\n";
 410
 411     } else {
 412         $body = "[Non-text message not quoted]\n\n";
 413     }
 414
 415     $max=60 if $max<60;
 416     $max=70 if $max>78;
 417     $max+=2;
 418
 419     return (\$body, $max);
 420 }
 421 # }}}
 422
 423 # {{{ sub NiceHeaders - pulls out only the most relevant headers
 424
 425 =head2 NiceHeaders
 426
 427 Returns the To, From, Cc, Date and Subject headers.
 428
 429 It is a known issue that this breaks if any of these headers are not
 430 properly unfolded.
 431
 432 =cut
 433
 434 sub NiceHeaders {
 435     my $self = shift;
 436     my $hdrs = "";
 437     my @hdrs = split(/\n/,$self->Headers);
 438     while (my $str = shift @hdrs) {
 439             next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Date|Subject): /i;
 440             $hdrs .= $str . "\n";
 441             $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/);
 442     }
 443     return $hdrs;
 444 }
 445 # }}}
 446
 447 # {{{ sub Headers
 448
 449 =head2 Headers
 450
 451 Returns this object's headers as a string.  This method specifically
 452 removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc.
 453 We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send
 454 out mail. (The mailing rules are separated from the ticket update code by
 455 an abstraction barrier that makes it impossible to pass this data directly
 456
 457 =cut
 458
 459 sub Headers {
 460     my $self = shift;
 461     my $hdrs="";
 462     for ($self->_SplitHeaders) {
 463             $hdrs.="$_\n" unless /^(RT-Send-Bcc):/i
 464     }
 465     return $hdrs;
 466 }
 467
 468
 469 # }}}
 470
 471 # {{{ sub GetHeader
 472
 473 =head2 GetHeader ( 'Tag')
 474
 475 Returns the value of the header Tag as a string. This bypasses the weeding out
 476 done in Headers() above.
 477
 478 =cut
 479
 480 sub GetHeader {
 481     my $self = shift;
 482     my $tag = shift;
 483     foreach my $line ($self->_SplitHeaders) {
 484         if ($line =~ /^\Q$tag\E:\s+(.*)$/si) { #if we find the header, return its value
 485             return ($1);
 486         }
 487     }
 488
 489     # we found no header. return an empty string
 490     return undef;
 491 }
 492 # }}}
 493
 494 # {{{ sub SetHeader
 495
 496 =head2 SetHeader ( 'Tag', 'Value' )
 497
 498 Replace or add a Header to the attachment's headers.
 499
 500 =cut
 501
 502 sub SetHeader {
 503     my $self = shift;
 504     my $tag = shift;
 505     my $newheader = '';
 506
 507     foreach my $line ($self->_SplitHeaders) {
 508         if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) {
 509             $newheader .= "$tag: $_[0]\n";
 510             undef $tag;
 511         }
 512         else {
 513             $newheader .= "$line\n";
 514         }
 515     }
 516
 517     $newheader .= "$tag: $_[0]\n" if defined $tag;
 518     $self->__Set( Field => 'Headers', Value => $newheader);
 519 }
 520 # }}}
 521
 522 # {{{ sub _Value
 523
 524 =head2 _Value
 525
 526 Takes the name of a table column.
 527 Returns its value as a string, if the user passes an ACL check
 528
 529 =cut
 530
 531 sub _Value  {
 532
 533     my $self = shift;
 534     my $field = shift;
 535
 536
 537     #if the field is public, return it.
 538     if ($self->_Accessible($field, 'public')) {
 539         #$RT::Logger->debug("Skipping ACL check for $field\n");
 540         return($self->__Value($field, @_));
 541
 542     }
 543
 544     #If it's a comment, we need to be extra special careful
 545     elsif ( (($self->TransactionObj->CurrentUserHasRight('ShowTicketComments')) and
 546              ($self->TransactionObj->Type eq 'Comment') )  or
 547             ($self->TransactionObj->CurrentUserHasRight('ShowTicket'))) {
 548                 return($self->__Value($field, @_));
 549     }
 550     #if they ain't got rights to see, don't let em
 551     else {
 552             return(undef);
 553         }
 554
 555
 556 }
 557
 558 # }}}
 559
 560 =head2 _SplitHeaders
 561
 562 Returns an array of this attachment object's headers, with one header
 563 per array entry. multiple lines are folded
 564
 565 =begin testing
 566
 567 my $test1 = "From: jesse";
 568 my @headers = RT::Attachment->_SplitHeaders($test1);
 569 is ($#headers, 0, $test1 );
 570
 571 my $test2 = qq{From: jesse
 572 To: bobby
 573 Subject: foo
 574 };
 575
 576 @headers = RT::Attachment->_SplitHeaders($test2);
 577 is ($#headers, 2, "testing a bunch of singline multiple headers" );
 578
 579
 580 my $test3 = qq{From: jesse
 581 To: bobby,
 582  Suzie,
 583     Sally,
 584     Joey: bizzy,
 585 Subject: foo
 586 };
 587
 588 @headers = RT::Attachment->_SplitHeaders($test3);
 589 is ($#headers, 2, "testing a bunch of singline multiple headers" );
 590
 591
 592 =end testing
 593
 594 =cut
 595
 596 sub _SplitHeaders {
 597     my $self = shift;
 598     my $headers = (shift || $self->SUPER::Headers());
 599     my @headers;
 600     for (split(/\n(?=\w|\z)/,$headers)) {
 601         push @headers, $_;
 602
 603     }
 604     return(@headers);
 605 }
 606
 607
 608 sub ContentLength {
 609     my $self = shift;
 610
 611     unless ( (($self->TransactionObj->CurrentUserHasRight('ShowTicketComments')) and
 612              ($self->TransactionObj->Type eq 'Comment') )  or
 613             ($self->TransactionObj->CurrentUserHasRight('ShowTicket'))) {
 614         return undef;
 615     }
 616
 617     if (my $len = $self->GetHeader('Content-Length')) {
 618         return $len;
 619     }
 620
 621     {
 622         use bytes;
 623         my $len = length($self->Content);
 624         $self->SetHeader('Content-Length' => $len);
 625         return $len;
 626     }
 627 }
 628
 629 # }}}
 630
 631 # Transactions don't change. by adding this cache congif directiove, we don't lose pathalogically on long tickets.
 632 sub _CacheConfig {
 633     {
 634         'cache_p'         => 1,
 635           'fast_update_p' => 1,
 636           'cache_for_sec' => 180,
 637     }
 638 }
 639
 640 1;