rt/lib/RT/Attachment_Overlay.pm

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