rt/lib/RT/Attachment_Overlay.pm

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