rt/lib/RT/Attachment_Overlay.pm

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