rt/lib/RT/Attachment.pm

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