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