lib/RT/Attachment.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2014 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 =head1 SYNOPSIS
  50
  51     use RT::Attachment;
  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 =head1 METHODS
  60
  61
  62
  63 =cut
  64
  65
  66 package RT::Attachment;
  67 use base 'RT::Record';
  68
  69 sub Table {'Attachments'}
  70
  71
  72
  73
  74 use strict;
  75 use warnings;
  76
  77
  78 use RT::Transaction;
  79 use MIME::Base64;
  80 use MIME::QuotedPrint;
  81 use MIME::Body;
  82 use RT::Util 'mime_recommended_filename';
  83
  84 sub _OverlayAccessible {
  85   {
  86     TransactionId   => { 'read'=>1, 'public'=>1, 'write' => 0 },
  87     MessageId       => { 'read'=>1, 'write' => 0 },
  88     Parent          => { 'read'=>1, 'write' => 0 },
  89     ContentType     => { 'read'=>1, 'write' => 0 },
  90     Subject         => { 'read'=>1, 'write' => 0 },
  91     Content         => { 'read'=>1, 'write' => 0 },
  92     ContentEncoding => { 'read'=>1, 'write' => 0 },
  93     Headers         => { 'read'=>1, 'write' => 0 },
  94     Filename        => { 'read'=>1, 'write' => 0 },
  95     Creator         => { 'read'=>1, 'auto'=>1, },
  96     Created         => { 'read'=>1, 'auto'=>1, },
  97   };
  98 }
  99
 100 =head2 Create
 101
 102 Create a new attachment. Takes a paramhash:
 103
 104     'Attachment' Should be a single MIME body with optional subparts
 105     'Parent' is an optional id of the parent attachment
 106     'TransactionId' is the mandatory id of the transaction this attachment is associated with.;
 107
 108 =cut
 109
 110 sub Create {
 111     my $self = shift;
 112     my %args = ( id            => 0,
 113                  TransactionId => 0,
 114                  Parent        => 0,
 115                  Attachment    => undef,
 116                  @_ );
 117
 118     # For ease of reference
 119     my $Attachment = $args{'Attachment'};
 120
 121     # if we didn't specify a ticket, we need to bail
 122     unless ( $args{'TransactionId'} ) {
 123         $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction" );
 124         return (0);
 125     }
 126
 127     # If we possibly can, collapse it to a singlepart
 128     $Attachment->make_singlepart;
 129
 130     my $head = $Attachment->head;
 131
 132     # Get the subject
 133     my $Subject = Encode::decode( 'UTF-8', $head->get( 'subject' ) );
 134     $Subject = '' unless defined $Subject;
 135     chomp $Subject;
 136
 137     #Get the Message-ID
 138     my $MessageId = Encode::decode( "UTF-8", $head->get( 'Message-ID' ) );
 139     defined($MessageId) or $MessageId = '';
 140     chomp ($MessageId);
 141     $MessageId =~ s/^<(.*?)>$/$1/o;
 142
 143     #Get the filename
 144     my $Filename = mime_recommended_filename($Attachment);
 145
 146     # remove path part.
 147     $Filename =~ s!.*/!! if $Filename;
 148
 149     my $content;
 150     unless ( $head->get('Content-Length') ) {
 151         my $length = 0;
 152         $length = length $Attachment->bodyhandle->as_string
 153             if defined $Attachment->bodyhandle;
 154         $head->replace( 'Content-Length' => Encode::encode( "UTF-8", $length ) );
 155     }
 156     $head = $head->as_string;
 157
 158     # MIME::Head doesn't support perl strings well and can return
 159     # octets which later will be double encoded in low-level code
 160     $head = Encode::decode( 'UTF-8', $head );
 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         my ($id) = $self->SUPER::Create(
 166             TransactionId => $args{'TransactionId'},
 167             Parent        => $args{'Parent'},
 168             ContentType   => $Attachment->mime_type,
 169             Headers       => $head,
 170             MessageId     => $MessageId,
 171             Subject       => $Subject,
 172         );
 173
 174         unless ($id) {
 175             $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr);
 176             return ($id);
 177         }
 178
 179         foreach my $part ( $Attachment->parts ) {
 180             my $SubAttachment = RT::Attachment->new( $self->CurrentUser );
 181             my ($id) = $SubAttachment->Create(
 182                 TransactionId => $args{'TransactionId'},
 183                 Parent        => $id,
 184                 Attachment    => $part,
 185             );
 186             unless ($id) {
 187                 $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
 188                 return ($id);
 189             }
 190         }
 191         return ($id);
 192     }
 193
 194     #If it's not multipart
 195     else {
 196
 197         my ( $encoding, $type, $note_args );
 198         ( $encoding, $content, $type, $Filename, $note_args ) =
 199                 $self->_EncodeLOB( $Attachment->bodyhandle->as_string, $Attachment->mime_type, $Filename, );
 200
 201         my $id = $self->SUPER::Create(
 202             TransactionId   => $args{'TransactionId'},
 203             ContentType     => $type,
 204             ContentEncoding => $encoding,
 205             Parent          => $args{'Parent'},
 206             Headers         => $head,
 207             Subject         => $Subject,
 208             Content         => $content,
 209             Filename        => $Filename,
 210             MessageId       => $MessageId,
 211         );
 212
 213         if ($id) {
 214             if ($note_args) {
 215                 $self->TransactionObj->Object->_NewTransaction( %$note_args );
 216             }
 217         }
 218         else {
 219             $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
 220         }
 221         return $id;
 222     }
 223 }
 224
 225 =head2 TransactionObj
 226
 227 Returns the transaction object asscoiated with this attachment.
 228
 229 =cut
 230
 231 sub TransactionObj {
 232     my $self = shift;
 233
 234     unless ( $self->{_TransactionObj} ) {
 235         $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser );
 236         $self->{_TransactionObj}->Load( $self->TransactionId );
 237     }
 238
 239     unless ($self->{_TransactionObj}->Id) {
 240         $RT::Logger->crit(  "Attachment ". $self->id
 241                            ." can't find transaction ". $self->TransactionId
 242                            ." which it is ostensibly part of. That's bad");
 243     }
 244     return $self->{_TransactionObj};
 245 }
 246
 247 =head2 ParentObj
 248
 249 Returns a parent's L<RT::Attachment> object if this attachment
 250 has a parent, otherwise returns undef.
 251
 252 =cut
 253
 254 sub ParentObj {
 255     my $self = shift;
 256     return undef unless $self->Parent;
 257
 258     my $parent = RT::Attachment->new( $self->CurrentUser );
 259     $parent->LoadById( $self->Parent );
 260     return $parent;
 261 }
 262
 263 =head2 Closest
 264
 265 Takes a MIME type as a string or regex.  Returns an L<RT::Attachment> object
 266 for the nearest containing part with a matching L</ContentType>.  Strings must
 267 match exactly and all matches are done case insensitively.  Strings ending in a
 268 C</> must only match the first part of the MIME type.  For example:
 269
 270     # Find the nearest multipart/* container
 271     my $container = $attachment->Closest("multipart/");
 272
 273 Returns undef if no such object is found.
 274
 275 =cut
 276
 277 sub Closest {
 278     my $self = shift;
 279     my $type = shift;
 280     my $part = $self->ParentObj or return undef;
 281
 282     $type = qr/^\Q$type\E$/
 283         unless ref $type eq "REGEX";
 284
 285     while (lc($part->ContentType) !~ $type) {
 286         $part = $part->ParentObj or last;
 287     }
 288
 289     return ($part and $part->id) ? $part : undef;
 290 }
 291
 292 =head2 Children
 293
 294 Returns an L<RT::Attachments> object which is preloaded with
 295 all attachments objects with this attachment's Id as their
 296 C<Parent>.
 297
 298 =cut
 299
 300 sub Children {
 301     my $self = shift;
 302
 303     my $kids = RT::Attachments->new( $self->CurrentUser );
 304     $kids->ChildrenOf( $self->Id );
 305     return($kids);
 306 }
 307
 308 =head2 Siblings
 309
 310 Returns an L<RT::Attachments> object containing all the attachments sharing
 311 the same immediate parent as the current object, excluding the current
 312 attachment itself.
 313
 314 If the current attachment is a top-level part (i.e. Parent == 0) then a
 315 guaranteed empty L<RT::Attachments> object is returned.
 316
 317 =cut
 318
 319 sub Siblings {
 320     my $self = shift;
 321     my $siblings = RT::Attachments->new( $self->CurrentUser );
 322     if ($self->Parent) {
 323         $siblings->ChildrenOf( $self->Parent );
 324         $siblings->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id );
 325     } else {
 326         # Ensure emptiness
 327         $siblings->Limit( SUBCLAUSE => 'empty', FIELD => 'id', VALUE => 0 );
 328     }
 329     return $siblings;
 330 }
 331
 332 =head2 Content
 333
 334 Returns the attachment's content. if it's base64 encoded, decode it
 335 before returning it.
 336
 337 =cut
 338
 339 sub Content {
 340     my $self = shift;
 341     return $self->_DecodeLOB(
 342         $self->GetHeader('Content-Type'),  # Includes charset, unlike ->ContentType
 343         $self->ContentEncoding,
 344         $self->_Value('Content', decode_utf8 => 0),
 345     );
 346 }
 347
 348 =head2 OriginalContent
 349
 350 Returns the attachment's content as octets before RT's mangling.
 351 Generally this just means restoring text content back to its
 352 original encoding.
 353
 354 If the attachment has a C<message/*> Content-Type, its children attachments
 355 are reconstructed and returned as a string.
 356
 357 =cut
 358
 359 sub OriginalContent {
 360     my $self = shift;
 361
 362     # message/* content types represent raw messages.  Since we break them
 363     # apart when they come in, we'll reconstruct their child attachments when
 364     # you ask for the OriginalContent of the message/ part.
 365     if ($self->IsMessageContentType) {
 366         # There shouldn't be more than one "subpart" to a message/* attachment
 367         my $child = $self->Children->First;
 368         return $self->Content unless $child and $child->id;
 369         return $child->ContentAsMIME(Children => 1)->as_string;
 370     }
 371
 372     return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType);
 373
 374     my $content;
 375     if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) {
 376         $content = $self->_Value('Content', decode_utf8 => 0);
 377     } elsif ( $self->ContentEncoding eq 'base64' ) {
 378         $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0));
 379     } elsif ( $self->ContentEncoding eq 'quoted-printable' ) {
 380         $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0));
 381     } else {
 382         return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
 383     }
 384
 385     my $entity = MIME::Entity->new();
 386     $entity->head->add("Content-Type", $self->GetHeader("Content-Type"));
 387     $entity->bodyhandle( MIME::Body::Scalar->new( $content ) );
 388     my $from = RT::I18N::_FindOrGuessCharset($entity);
 389     $from = 'utf-8' if not $from or not Encode::find_encoding($from);
 390
 391     my $to = RT::I18N::_CanonicalizeCharset(
 392         $self->OriginalEncoding || 'utf-8'
 393     );
 394
 395     local $@;
 396     eval { Encode::from_to($content, $from => $to) };
 397     if ($@) {
 398         $RT::Logger->error("Could not convert attachment from $from to $to: ".$@);
 399     }
 400     return $content;
 401 }
 402
 403 =head2 OriginalEncoding
 404
 405 Returns the attachment's original encoding.
 406
 407 =cut
 408
 409 sub OriginalEncoding {
 410     my $self = shift;
 411     return $self->GetHeader('X-RT-Original-Encoding');
 412 }
 413
 414 =head2 ContentLength
 415
 416 Returns length of L</Content> in bytes.
 417
 418 =cut
 419
 420 sub ContentLength {
 421     my $self = shift;
 422
 423     return undef unless $self->TransactionObj->CurrentUserCanSee;
 424
 425     my $len = $self->GetHeader('Content-Length');
 426     unless ( defined $len ) {
 427         use bytes;
 428         no warnings 'uninitialized';
 429         $len = length($self->Content) || 0;
 430         $self->SetHeader('Content-Length' => $len);
 431     }
 432     return $len;
 433 }
 434
 435 =head2 FriendlyContentLength
 436
 437 Returns L</ContentLength> in bytes, kilobytes, or megabytes as most
 438 appropriate.  The size is suffixed with C<MiB>, C<KiB>, or C<B> and the returned
 439 string is localized.
 440
 441 Returns the empty string if the L</ContentLength> is 0 or undefined.
 442
 443 =cut
 444
 445 sub FriendlyContentLength {
 446     my $self = shift;
 447     my $size = $self->ContentLength;
 448     return '' unless $size;
 449
 450     my $res = '';
 451     if ( $size > 1024*1024 ) {
 452         $res = $self->loc( "[_1]MiB", int( $size / 1024 / 102.4 ) / 10 );
 453     }
 454     elsif ( $size > 1024 ) {
 455         $res = $self->loc( "[_1]KiB", int( $size / 102.4 ) / 10 );
 456     }
 457     else {
 458         $res = $self->loc( "[_1]B", $size );
 459     }
 460     return $res;
 461 }
 462
 463 =head2 ContentAsMIME [Children => 1]
 464
 465 Returns MIME entity built from this attachment.
 466
 467 If the optional parameter C<Children> is set to a true value, the children are
 468 recursively added to the entity.
 469
 470 =cut
 471
 472 sub ContentAsMIME {
 473     my $self = shift;
 474     my %opts = (
 475         Children => 0,
 476         @_
 477     );
 478
 479     my $entity = MIME::Entity->new();
 480     foreach my $header ($self->SplitHeaders) {
 481         my ($h_key, $h_val) = split /:/, $header, 2;
 482         $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) );
 483     }
 484
 485     # since we want to return original content, let's use original encoding
 486     $entity->head->mime_attr(
 487         "Content-Type.charset" => $self->OriginalEncoding )
 488       if $self->OriginalEncoding;
 489
 490     $entity->bodyhandle(
 491         MIME::Body::Scalar->new( $self->OriginalContent )
 492     );
 493
 494     if ($opts{'Children'} and not $self->IsMessageContentType) {
 495         my $children = $self->Children;
 496         while (my $child = $children->Next) {
 497             $entity->make_multipart unless $entity->is_multipart;
 498             $entity->add_part( $child->ContentAsMIME(%opts) );
 499         }
 500     }
 501
 502     return $entity;
 503 }
 504
 505 =head2 IsMessageContentType
 506
 507 Returns a boolean indicating if the Content-Type of this attachment is a
 508 C<message/> subtype.
 509
 510 =cut
 511
 512 sub IsMessageContentType {
 513     my $self = shift;
 514     return $self->ContentType =~ m{^\s*message/}i ? 1 : 0;
 515 }
 516
 517 =head2 Addresses
 518
 519 Returns a hashref of all addresses related to this attachment.
 520 The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc>
 521 and C<RT-Send-Bcc>. The values are references to lists of
 522 L<Email::Address> objects.
 523
 524 =cut
 525
 526 our @ADDRESS_HEADERS = qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc);
 527
 528 sub Addresses {
 529     my $self = shift;
 530
 531     my %data = ();
 532     my $current_user_address = lc($self->CurrentUser->EmailAddress || '');
 533     foreach my $hdr (@ADDRESS_HEADERS) {
 534         my @Addresses;
 535         my $line = $self->GetHeader($hdr);
 536
 537         foreach my $AddrObj ( Email::Address->parse( $line )) {
 538             my $address = $AddrObj->address;
 539             $address = lc RT::User->CanonicalizeEmailAddress($address);
 540             next if $current_user_address eq $address;
 541             next if RT::EmailParser->IsRTAddress($address);
 542             push @Addresses, $AddrObj ;
 543         }
 544         $data{$hdr} = \@Addresses;
 545     }
 546     return \%data;
 547 }
 548
 549 =head2 NiceHeaders
 550
 551 Returns a multi-line string of the To, From, Cc, Date and Subject headers.
 552
 553 =cut
 554
 555 sub NiceHeaders {
 556     my $self = shift;
 557     my $hdrs = "";
 558     my @hdrs = $self->_SplitHeaders;
 559     while (my $str = shift @hdrs) {
 560         next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i;
 561         $hdrs .= $str . "\n";
 562         $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/);
 563     }
 564     return $hdrs;
 565 }
 566
 567 =head2 Headers
 568
 569 Returns this object's headers as a string.  This method specifically
 570 removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc.
 571 We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send
 572 out mail. The mailing rules are separated from the ticket update code by
 573 an abstraction barrier that makes it impossible to pass this data directly.
 574
 575 =cut
 576
 577 sub Headers {
 578     return join("\n", $_[0]->SplitHeaders);
 579 }
 580
 581 =head2 EncodedHeaders
 582
 583 Takes encoding as argument and returns the attachment's headers as octets in encoded
 584 using the encoding.
 585
 586 This is not protection using quoted printable or base64 encoding.
 587
 588 =cut
 589
 590 sub EncodedHeaders {
 591     my $self = shift;
 592     my $encoding = shift || 'utf8';
 593     return Encode::encode( $encoding, $self->Headers );
 594 }
 595
 596 =head2 GetHeader $TAG
 597
 598 Returns the value of the header Tag as a string. This bypasses the weeding out
 599 done in Headers() above.
 600
 601 =cut
 602
 603 sub GetHeader {
 604     my $self = shift;
 605     my $tag = shift;
 606     foreach my $line ($self->_SplitHeaders) {
 607         next unless $line =~ /^\Q$tag\E:\s+(.*)$/si;
 608
 609         #if we find the header, return its value
 610         return ($1);
 611     }
 612
 613     # we found no header. return an empty string
 614     return undef;
 615 }
 616
 617 =head2 DelHeader $TAG
 618
 619 Delete a field from the attachment's headers.
 620
 621 =cut
 622
 623 sub DelHeader {
 624     my $self = shift;
 625     my $tag = shift;
 626
 627     my $newheader = '';
 628     foreach my $line ($self->_SplitHeaders) {
 629         next if $line =~ /^\Q$tag\E:\s+/i;
 630         $newheader .= "$line\n";
 631     }
 632     return $self->__Set( Field => 'Headers', Value => $newheader);
 633 }
 634
 635 =head2 AddHeader $TAG, $VALUE, ...
 636
 637 Add one or many fields to the attachment's headers.
 638
 639 =cut
 640
 641 sub AddHeader {
 642     my $self = shift;
 643
 644     my $newheader = $self->__Value( 'Headers' );
 645     while ( my ($tag, $value) = splice @_, 0, 2 ) {
 646         $value = $self->_CanonicalizeHeaderValue($value);
 647         $newheader .= "$tag: $value\n";
 648     }
 649     return $self->__Set( Field => 'Headers', Value => $newheader);
 650 }
 651
 652 =head2 SetHeader ( 'Tag', 'Value' )
 653
 654 Replace or add a Header to the attachment's headers.
 655
 656 =cut
 657
 658 sub SetHeader {
 659     my $self  = shift;
 660     my $tag   = shift;
 661     my $value = $self->_CanonicalizeHeaderValue(shift);
 662
 663     my $replaced  = 0;
 664     my $newheader = '';
 665     foreach my $line ( $self->_SplitHeaders ) {
 666         if ( $line =~ /^\Q$tag\E:\s+/i ) {
 667             # replace first instance, skip all the rest
 668             unless ($replaced) {
 669                 $newheader .= "$tag: $value\n";
 670                 $replaced = 1;
 671             }
 672         } else {
 673             $newheader .= "$line\n";
 674         }
 675     }
 676
 677     $newheader .= "$tag: $value\n" unless $replaced;
 678     $self->__Set( Field => 'Headers', Value => $newheader);
 679 }
 680
 681 sub _CanonicalizeHeaderValue {
 682     my $self  = shift;
 683     my $value = shift;
 684
 685     $value = '' unless defined $value;
 686     $value =~ s/\s+$//s;
 687     $value =~ s/\r*\n/\n /g;
 688
 689     return $value;
 690 }
 691
 692 =head2 SplitHeaders
 693
 694 Returns an array of this attachment object's headers, with one header
 695 per array entry. Multiple lines are folded.
 696
 697 B<Never> returns C<RT-Send-Bcc> field.
 698
 699 =cut
 700
 701 sub SplitHeaders {
 702     my $self = shift;
 703     return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) );
 704 }
 705
 706 =head2 _SplitHeaders
 707
 708 Returns an array of this attachment object's headers, with one header
 709 per array entry. multiple lines are folded.
 710
 711
 712 =cut
 713
 714 sub _SplitHeaders {
 715     my $self = shift;
 716     my $headers = (shift || $self->_Value('Headers'));
 717     my @headers;
 718     # XXX TODO: splitting on \n\w is _wrong_ as it treats \n[ as a valid
 719     # continuation, which it isn't.  The correct split pattern, per RFC 2822,
 720     # is /\n(?=[^ \t]|\z)/.  That is, only "\n " or "\n\t" is a valid
 721     # continuation.  Older values of X-RT-GnuPG-Status contain invalid
 722     # continuations and rely on this bogus split pattern, however, so it is
 723     # left as-is for now.
 724     for (split(/\n(?=\w|\z)/,$headers)) {
 725         push @headers, $_;
 726
 727     }
 728     return(@headers);
 729 }
 730
 731
 732 sub Encrypt {
 733     my $self = shift;
 734
 735     my $txn = $self->TransactionObj;
 736     return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee;
 737     return (0, $self->loc('Permission Denied'))
 738         unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket');
 739     return (0, $self->loc('Cryptography is disabled'))
 740         unless RT->Config->Get('Crypt')->{'Enable'};
 741     return (0, $self->loc('Attachments encryption is disabled'))
 742         unless RT->Config->Get('Crypt')->{'AllowEncryptDataInDB'};
 743
 744     my $type = $self->ContentType;
 745     if ( $type =~ /^x-application-rt\/[^-]+-encrypted/i ) {
 746         return (1, $self->loc('Already encrypted'));
 747     } elsif ( $type =~ /^multipart\//i ) {
 748         return (1, $self->loc('No need to encrypt'));
 749     }
 750
 751     my $queue = $txn->TicketObj->QueueObj;
 752     my $encrypt_for;
 753     foreach my $address ( grep $_,
 754         $queue->CorrespondAddress,
 755         $queue->CommentAddress,
 756         RT->Config->Get('CorrespondAddress'),
 757         RT->Config->Get('CommentAddress'),
 758     ) {
 759         my %res = RT::Crypt->GetKeysInfo( Key => $address, Type => 'private' );
 760         next if $res{'exit_code'} || !$res{'info'};
 761         %res = RT::Crypt->GetKeysForEncryption( $address );
 762         next if $res{'exit_code'} || !$res{'info'};
 763         $encrypt_for = $address;
 764     }
 765     unless ( $encrypt_for ) {
 766         return (0, $self->loc('No key suitable for encryption'));
 767     }
 768
 769     my $content = $self->Content;
 770     my %res = RT::Crypt->SignEncryptContent(
 771         Content => \$content,
 772         Sign => 0,
 773         Encrypt => 1,
 774         Recipients => [ $encrypt_for ],
 775     );
 776     if ( $res{'exit_code'} ) {
 777         return (0, $self->loc('Encryption error; contact the administrator'));
 778     }
 779
 780     my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content );
 781     unless ( $status ) {
 782         return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg));
 783     }
 784
 785     $type = qq{x-application-rt\/$res{'Protocol'}-encrypted; original-type="$type"};
 786     $self->__Set( Field => 'ContentType', Value => $type );
 787     $self->SetHeader( 'Content-Type' => $type );
 788
 789     return (1, $self->loc('Successfuly encrypted data'));
 790 }
 791
 792 sub Decrypt {
 793     my $self = shift;
 794
 795     my $txn = $self->TransactionObj;
 796     return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee;
 797     return (0, $self->loc('Permission Denied'))
 798         unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket');
 799     return (0, $self->loc('Cryptography is disabled'))
 800         unless RT->Config->Get('Crypt')->{'Enable'};
 801
 802     my $type = $self->ContentType;
 803     my $protocol;
 804     if ( $type =~ /^x-application-rt\/([^-]+)-encrypted/i ) {
 805         $protocol = $1;
 806         $protocol =~ s/gpg/gnupg/; # backwards compatibility
 807         ($type) = ($type =~ /original-type="(.*)"/i);
 808         $type ||= 'application/octet-stream';
 809     } else {
 810         return (1, $self->loc('Is not encrypted'));
 811     }
 812
 813     my $queue = $txn->TicketObj->QueueObj;
 814     my @addresses =
 815         $queue->CorrespondAddress,
 816         $queue->CommentAddress,
 817         RT->Config->Get('CorrespondAddress'),
 818         RT->Config->Get('CommentAddress')
 819     ;
 820
 821     my $content = $self->Content;
 822     my %res = RT::Crypt->DecryptContent(
 823         Protocol => $protocol,
 824         Content => \$content,
 825         Recipients => \@addresses,
 826     );
 827     if ( $res{'exit_code'} ) {
 828         return (0, $self->loc('Decryption error; contact the administrator'));
 829     }
 830
 831     my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content );
 832     unless ( $status ) {
 833         return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg));
 834     }
 835     $self->__Set( Field => 'ContentType', Value => $type );
 836     $self->SetHeader( 'Content-Type' => $type );
 837
 838     return (1, $self->loc('Successfuly decrypted data'));
 839 }
 840
 841 =head2 _Value
 842
 843 Takes the name of a table column.
 844 Returns its value as a string, if the user passes an ACL check
 845
 846 =cut
 847
 848 sub _Value {
 849     my $self  = shift;
 850     my $field = shift;
 851
 852     #if the field is public, return it.
 853     if ( $self->_Accessible( $field, 'public' ) ) {
 854         return ( $self->__Value( $field, @_ ) );
 855     }
 856
 857     return undef unless $self->TransactionObj->CurrentUserCanSee;
 858     return $self->__Value( $field, @_ );
 859 }
 860
 861 # Transactions don't change. by adding this cache congif directiove,
 862 # we don't lose pathalogically on long tickets.
 863 sub _CacheConfig {
 864     {
 865         'cache_p'       => 1,
 866         'fast_update_p' => 1,
 867         'cache_for_sec' => 180,
 868     }
 869 }
 870
 871
 872
 873
 874 =head2 id
 875
 876 Returns the current value of id.
 877 (In the database, id is stored as int(11).)
 878
 879
 880 =cut
 881
 882
 883 =head2 TransactionId
 884
 885 Returns the current value of TransactionId.
 886 (In the database, TransactionId is stored as int(11).)
 887
 888
 889
 890 =head2 SetTransactionId VALUE
 891
 892
 893 Set TransactionId to VALUE.
 894 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 895 (In the database, TransactionId will be stored as a int(11).)
 896
 897
 898 =cut
 899
 900
 901 =head2 Parent
 902
 903 Returns the current value of Parent.
 904 (In the database, Parent is stored as int(11).)
 905
 906
 907
 908 =head2 SetParent VALUE
 909
 910
 911 Set Parent to VALUE.
 912 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 913 (In the database, Parent will be stored as a int(11).)
 914
 915
 916 =cut
 917
 918
 919 =head2 MessageId
 920
 921 Returns the current value of MessageId.
 922 (In the database, MessageId is stored as varchar(160).)
 923
 924
 925
 926 =head2 SetMessageId VALUE
 927
 928
 929 Set MessageId to VALUE.
 930 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 931 (In the database, MessageId will be stored as a varchar(160).)
 932
 933
 934 =cut
 935
 936
 937 =head2 Subject
 938
 939 Returns the current value of Subject.
 940 (In the database, Subject is stored as varchar(255).)
 941
 942
 943
 944 =head2 SetSubject VALUE
 945
 946
 947 Set Subject to VALUE.
 948 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 949 (In the database, Subject will be stored as a varchar(255).)
 950
 951
 952 =cut
 953
 954
 955 =head2 Filename
 956
 957 Returns the current value of Filename.
 958 (In the database, Filename is stored as varchar(255).)
 959
 960
 961
 962 =head2 SetFilename VALUE
 963
 964
 965 Set Filename to VALUE.
 966 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 967 (In the database, Filename will be stored as a varchar(255).)
 968
 969
 970 =cut
 971
 972
 973 =head2 ContentType
 974
 975 Returns the current value of ContentType.
 976 (In the database, ContentType is stored as varchar(80).)
 977
 978
 979
 980 =head2 SetContentType VALUE
 981
 982
 983 Set ContentType to VALUE.
 984 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 985 (In the database, ContentType will be stored as a varchar(80).)
 986
 987
 988 =cut
 989
 990
 991 =head2 ContentEncoding
 992
 993 Returns the current value of ContentEncoding.
 994 (In the database, ContentEncoding is stored as varchar(80).)
 995
 996
 997
 998 =head2 SetContentEncoding VALUE
 999
1000
1001 Set ContentEncoding to VALUE.
1002 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1003 (In the database, ContentEncoding will be stored as a varchar(80).)
1004
1005
1006 =cut
1007
1008
1009 =head2 Content
1010
1011 Returns the current value of Content.
1012 (In the database, Content is stored as longblob.)
1013
1014
1015
1016 =head2 SetContent VALUE
1017
1018
1019 Set Content to VALUE.
1020 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1021 (In the database, Content will be stored as a longblob.)
1022
1023
1024 =cut
1025
1026
1027 =head2 Headers
1028
1029 Returns the current value of Headers.
1030 (In the database, Headers is stored as longtext.)
1031
1032
1033
1034 =head2 SetHeaders VALUE
1035
1036
1037 Set Headers to VALUE.
1038 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1039 (In the database, Headers will be stored as a longtext.)
1040
1041
1042 =cut
1043
1044
1045 =head2 Creator
1046
1047 Returns the current value of Creator.
1048 (In the database, Creator is stored as int(11).)
1049
1050
1051 =cut
1052
1053
1054 =head2 Created
1055
1056 Returns the current value of Created.
1057 (In the database, Created is stored as datetime.)
1058
1059
1060 =cut
1061
1062
1063
1064 sub _CoreAccessible {
1065     {
1066
1067         id =>
1068                 {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1069         TransactionId =>
1070                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
1071         Parent =>
1072                 {read => 1, write => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1073         MessageId =>
1074                 {read => 1, write => 1, sql_type => 12, length => 160,  is_blob => 0,  is_numeric => 0,  type => 'varchar(160)', default => ''},
1075         Subject =>
1076                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1077         Filename =>
1078                 {read => 1, write => 1, sql_type => 12, length => 255,  is_blob => 0,  is_numeric => 0,  type => 'varchar(255)', default => ''},
1079         ContentType =>
1080                 {read => 1, write => 1, sql_type => 12, length => 80,  is_blob => 0,  is_numeric => 0,  type => 'varchar(80)', default => ''},
1081         ContentEncoding =>
1082                 {read => 1, write => 1, sql_type => 12, length => 80,  is_blob => 0,  is_numeric => 0,  type => 'varchar(80)', default => ''},
1083         Content =>
1084                 {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'longblob', default => ''},
1085         Headers =>
1086                 {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'longtext', default => ''},
1087         Creator =>
1088                 {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
1089         Created =>
1090                 {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
1091
1092  }
1093 };
1094
1095 sub FindDependencies {
1096     my $self = shift;
1097     my ($walker, $deps) = @_;
1098
1099     $self->SUPER::FindDependencies($walker, $deps);
1100     $deps->Add( out => $self->TransactionObj );
1101 }
1102
1103 RT::Base->_ImportOverlays();
1104
1105 1;