rt/lib/RT/Attachment_Overlay.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2011 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
  68 use strict;
  69 no warnings qw(redefine);
  70
  71 use RT::Transaction;
  72 use MIME::Base64;
  73 use MIME::QuotedPrint;
  74
  75 sub _OverlayAccessible {
  76   {
  77     TransactionId   => { 'read'=>1, 'public'=>1, 'write' => 0 },
  78     MessageId       => { 'read'=>1, 'write' => 0 },
  79     Parent          => { 'read'=>1, 'write' => 0 },
  80     ContentType     => { 'read'=>1, 'write' => 0 },
  81     Subject         => { 'read'=>1, 'write' => 0 },
  82     Content         => { 'read'=>1, 'write' => 0 },
  83     ContentEncoding => { 'read'=>1, 'write' => 0 },
  84     Headers         => { 'read'=>1, 'write' => 0 },
  85     Filename        => { 'read'=>1, 'write' => 0 },
  86     Creator         => { 'read'=>1, 'auto'=>1, },
  87     Created         => { 'read'=>1, 'auto'=>1, },
  88   };
  89 }
  90
  91 =head2 Create
  92
  93 Create a new attachment. Takes a paramhash:
  94
  95     'Attachment' Should be a single MIME body with optional subparts
  96     'Parent' is an optional id of the parent attachment
  97     'TransactionId' is the mandatory id of the transaction this attachment is associated with.;
  98
  99 =cut
 100
 101 sub Create {
 102     my $self = shift;
 103     my %args = ( id            => 0,
 104                  TransactionId => 0,
 105                  Parent        => 0,
 106                  Attachment    => undef,
 107                  @_ );
 108
 109     # For ease of reference
 110     my $Attachment = $args{'Attachment'};
 111
 112     # if we didn't specify a ticket, we need to bail
 113     unless ( $args{'TransactionId'} ) {
 114         $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction" );
 115         return (0);
 116     }
 117
 118     # If we possibly can, collapse it to a singlepart
 119     $Attachment->make_singlepart;
 120
 121     # Get the subject
 122     my $Subject = $Attachment->head->get( 'subject', 0 );
 123     $Subject = '' unless defined $Subject;
 124     chomp $Subject;
 125     utf8::decode( $Subject ) unless utf8::is_utf8( $Subject );
 126
 127     #Get the Message-ID
 128     my $MessageId = $Attachment->head->get( 'Message-ID', 0 );
 129     defined($MessageId) or $MessageId = '';
 130     chomp ($MessageId);
 131     $MessageId =~ s/^<(.*?)>$/$1/o;
 132
 133     #Get the filename
 134     my $Filename = $Attachment->head->recommended_filename;
 135     # remove path part.
 136     $Filename =~ s!.*/!! if $Filename;
 137
 138     # MIME::Head doesn't support perl strings well and can return
 139     # octets which later will be double encoded in low-level code
 140     my $head = $Attachment->head->as_string;
 141     utf8::decode( $head ) unless utf8::is_utf8( $head );
 142
 143     # If a message has no bodyhandle, that means that it has subparts (or appears to)
 144     # and we should act accordingly.
 145     unless ( defined $Attachment->bodyhandle ) {
 146         my ($id) = $self->SUPER::Create(
 147             TransactionId => $args{'TransactionId'},
 148             Parent        => $args{'Parent'},
 149             ContentType   => $Attachment->mime_type,
 150             Headers       => $head,
 151             MessageId     => $MessageId,
 152             Subject       => $Subject,
 153         );
 154
 155         unless ($id) {
 156             $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr);
 157         }
 158
 159         foreach my $part ( $Attachment->parts ) {
 160             my $SubAttachment = new RT::Attachment( $self->CurrentUser );
 161             my ($id) = $SubAttachment->Create(
 162                 TransactionId => $args{'TransactionId'},
 163                 Parent        => $id,
 164                 Attachment    => $part,
 165             );
 166             unless ($id) {
 167                 $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
 168             }
 169         }
 170         return ($id);
 171     }
 172
 173     #If it's not multipart
 174     else {
 175
 176         my ($ContentEncoding, $Body) = $self->_EncodeLOB(
 177             $Attachment->bodyhandle->as_string,
 178             $Attachment->mime_type
 179         );
 180
 181         my $id = $self->SUPER::Create(
 182             TransactionId   => $args{'TransactionId'},
 183             ContentType     => $Attachment->mime_type,
 184             ContentEncoding => $ContentEncoding,
 185             Parent          => $args{'Parent'},
 186             Headers         => $head,
 187             Subject         => $Subject,
 188             Content         => $Body,
 189             Filename        => $Filename,
 190             MessageId       => $MessageId,
 191         );
 192
 193         unless ($id) {
 194             $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
 195         }
 196         return $id;
 197     }
 198 }
 199
 200 =head2 Import
 201
 202 Create an attachment exactly as specified in the named parameters.
 203
 204 =cut
 205
 206 sub Import {
 207     my $self = shift;
 208     my %args = ( ContentEncoding => 'none', @_ );
 209
 210     ( $args{'ContentEncoding'}, $args{'Content'} ) =
 211         $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} );
 212
 213     return ( $self->SUPER::Create(%args) );
 214 }
 215
 216 =head2 TransactionObj
 217
 218 Returns the transaction object asscoiated with this attachment.
 219
 220 =cut
 221
 222 sub TransactionObj {
 223     my $self = shift;
 224
 225     unless ( $self->{_TransactionObj} ) {
 226         $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser );
 227         $self->{_TransactionObj}->Load( $self->TransactionId );
 228     }
 229
 230     unless ($self->{_TransactionObj}->Id) {
 231         $RT::Logger->crit(  "Attachment ". $self->id
 232                            ." can't find transaction ". $self->TransactionId
 233                            ." which it is ostensibly part of. That's bad");
 234     }
 235     return $self->{_TransactionObj};
 236 }
 237
 238 =head2 ParentObj
 239
 240 Returns a parent's L<RT::Attachment> object if this attachment
 241 has a parent, otherwise returns undef.
 242
 243 =cut
 244
 245 sub ParentObj {
 246     my $self = shift;
 247     return undef unless $self->Parent;
 248
 249     my $parent = RT::Attachment->new( $self->CurrentUser );
 250     $parent->LoadById( $self->Parent );
 251     return $parent;
 252 }
 253
 254 =head2 Children
 255
 256 Returns an L<RT::Attachments> object which is preloaded with
 257 all attachments objects with this attachment\'s Id as their
 258 C<Parent>.
 259
 260 =cut
 261
 262 sub Children {
 263     my $self = shift;
 264
 265     my $kids = RT::Attachments->new( $self->CurrentUser );
 266     $kids->ChildrenOf( $self->Id );
 267     return($kids);
 268 }
 269
 270 =head2 Content
 271
 272 Returns the attachment's content. if it's base64 encoded, decode it
 273 before returning it.
 274
 275 =cut
 276
 277 sub Content {
 278     my $self = shift;
 279     return $self->_DecodeLOB(
 280         $self->ContentType,
 281         $self->ContentEncoding,
 282         $self->_Value('Content', decode_utf8 => 0),
 283     );
 284 }
 285
 286 =head2 OriginalContent
 287
 288 Returns the attachment's content as octets before RT's mangling.
 289 Currently, this just means restoring text content back to its
 290 original encoding.
 291
 292 =cut
 293
 294 sub OriginalContent {
 295     my $self = shift;
 296
 297     return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType);
 298     my $enc = $self->OriginalEncoding;
 299
 300     my $content;
 301     if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) {
 302         $content = $self->_Value('Content', decode_utf8 => 0);
 303     } elsif ( $self->ContentEncoding eq 'base64' ) {
 304         $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0));
 305     } elsif ( $self->ContentEncoding eq 'quoted-printable' ) {
 306         $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0));
 307     } else {
 308         return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
 309     }
 310
 311     # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work.
 312     local $@;
 313     Encode::_utf8_off($content);
 314
 315     if (!$enc || $enc eq '' ||  $enc eq 'utf8' || $enc eq 'utf-8') {
 316         # If we somehow fail to do the decode, at least push out the raw bits
 317         eval { return( Encode::decode_utf8($content)) } || return ($content);
 318     }
 319
 320     eval { Encode::from_to($content, 'utf8' => $enc) } if $enc;
 321     if ($@) {
 322         $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@);
 323     }
 324     return $content;
 325 }
 326
 327 =head2 OriginalEncoding
 328
 329 Returns the attachment's original encoding.
 330
 331 =cut
 332
 333 sub OriginalEncoding {
 334     my $self = shift;
 335     return $self->GetHeader('X-RT-Original-Encoding');
 336 }
 337
 338 =head2 ContentLength
 339
 340 Returns length of L</Content> in bytes.
 341
 342 =cut
 343
 344 sub ContentLength {
 345     my $self = shift;
 346
 347     return undef unless $self->TransactionObj->CurrentUserCanSee;
 348
 349     my $len = $self->GetHeader('Content-Length');
 350     unless ( defined $len ) {
 351         use bytes;
 352         no warnings 'uninitialized';
 353         $len = length($self->Content);
 354         $self->SetHeader('Content-Length' => $len);
 355     }
 356     return $len;
 357 }
 358
 359 =head2 Quote
 360
 361 =cut
 362
 363 sub Quote {
 364     my $self=shift;
 365     my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system)
 366               @_);
 367
 368     my ($quoted_content, $body, $headers);
 369     my $max=0;
 370
 371     # TODO: Handle Multipart/Mixed (eventually fix the link in the
 372     # ShowHistory web template?)
 373     if (RT::I18N::IsTextualContentType($self->ContentType)) {
 374         $body=$self->Content;
 375
 376         # Do we need any preformatting (wrapping, that is) of the message?
 377
 378         # Remove quoted signature.
 379         $body =~ s/\n-- \n(.*)$//s;
 380
 381         # What's the longest line like?
 382         foreach (split (/\n/,$body)) {
 383             $max=length if ( length > $max);
 384         }
 385
 386         if ($max>76) {
 387             require Text::Wrapper;
 388             my $wrapper=new Text::Wrapper
 389                 (
 390                  columns => 70,
 391                  body_start => ($max > 70*3 ? '   ' : ''),
 392                  par_start => ''
 393                  );
 394             $body=$wrapper->wrap($body);
 395         }
 396
 397         $body =~ s/^/> /gm;
 398
 399         $body = '[' . $self->TransactionObj->CreatorObj->Name() . ' - ' . $self->TransactionObj->CreatedAsString()
 400                     . "]:\n\n"
 401                 . $body . "\n\n";
 402
 403     } else {
 404         $body = "[Non-text message not quoted]\n\n";
 405     }
 406
 407     $max=60 if $max<60;
 408     $max=70 if $max>78;
 409     $max+=2;
 410
 411     return (\$body, $max);
 412 }
 413
 414 =head2 ContentAsMIME
 415
 416 Returns MIME entity built from this attachment.
 417
 418 =cut
 419
 420 sub ContentAsMIME {
 421     my $self = shift;
 422
 423     my $entity = new MIME::Entity;
 424     foreach my $header ($self->SplitHeaders) {
 425         my ($h_key, $h_val) = split /:/, $header, 2;
 426         $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) );
 427     }
 428
 429     # since we want to return original content, let's use original encoding
 430     $entity->head->mime_attr(
 431         "Content-Type.charset" => $self->OriginalEncoding )
 432       if $self->OriginalEncoding;
 433
 434     use MIME::Body;
 435     $entity->bodyhandle(
 436         MIME::Body::Scalar->new( $self->OriginalContent )
 437     );
 438
 439     return $entity;
 440 }
 441
 442
 443 =head2 Addresses
 444
 445 Returns a hashref of all addresses related to this attachment.
 446 The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc>
 447 and C<RT-Send-Bcc>. The values are references to lists of
 448 L<Email::Address> objects.
 449
 450 =cut
 451
 452 sub Addresses {
 453     my $self = shift;
 454
 455     my %data = ();
 456     my $current_user_address = lc $self->CurrentUser->EmailAddress;
 457     foreach my $hdr (qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc)) {
 458         my @Addresses;
 459         my $line = $self->GetHeader($hdr);
 460
 461         foreach my $AddrObj ( Email::Address->parse( $line )) {
 462             my $address = $AddrObj->address;
 463             $address = lc RT::User->CanonicalizeEmailAddress($address);
 464             next if $current_user_address eq $address;
 465             next if RT::EmailParser->IsRTAddress($address);
 466             push @Addresses, $AddrObj ;
 467         }
 468         $data{$hdr} = \@Addresses;
 469     }
 470     return \%data;
 471 }
 472
 473 =head2 NiceHeaders
 474
 475 Returns a multi-line string of the To, From, Cc, Date and Subject headers.
 476
 477 =cut
 478
 479 sub NiceHeaders {
 480     my $self = shift;
 481     my $hdrs = "";
 482     my @hdrs = $self->_SplitHeaders;
 483     while (my $str = shift @hdrs) {
 484             next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i;
 485             $hdrs .= $str . "\n";
 486             $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/);
 487     }
 488     return $hdrs;
 489 }
 490
 491 =head2 Headers
 492
 493 Returns this object's headers as a string.  This method specifically
 494 removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc.
 495 We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send
 496 out mail. The mailing rules are separated from the ticket update code by
 497 an abstraction barrier that makes it impossible to pass this data directly.
 498
 499 =cut
 500
 501 sub Headers {
 502     return join("\n", $_[0]->SplitHeaders);
 503 }
 504
 505 =head2 EncodedHeaders
 506
 507 Takes encoding as argument and returns the attachment's headers as octets in encoded
 508 using the encoding.
 509
 510 This is not protection using quoted printable or base64 encoding.
 511
 512 =cut
 513
 514 sub EncodedHeaders {
 515     my $self = shift;
 516     my $encoding = shift || 'utf8';
 517     return Encode::encode( $encoding, $self->Headers );
 518 }
 519
 520 =head2 GetHeader $TAG
 521
 522 Returns the value of the header Tag as a string. This bypasses the weeding out
 523 done in Headers() above.
 524
 525 =cut
 526
 527 sub GetHeader {
 528     my $self = shift;
 529     my $tag = shift;
 530     foreach my $line ($self->_SplitHeaders) {
 531         next unless $line =~ /^\Q$tag\E:\s+(.*)$/si;
 532
 533         #if we find the header, return its value
 534         return ($1);
 535     }
 536
 537     # we found no header. return an empty string
 538     return undef;
 539 }
 540
 541 =head2 DelHeader $TAG
 542
 543 Delete a field from the attachment's headers.
 544
 545 =cut
 546
 547 sub DelHeader {
 548     my $self = shift;
 549     my $tag = shift;
 550
 551     my $newheader = '';
 552     foreach my $line ($self->_SplitHeaders) {
 553         next if $line =~ /^\Q$tag\E:\s+/i;
 554         $newheader .= "$line\n";
 555     }
 556     return $self->__Set( Field => 'Headers', Value => $newheader);
 557 }
 558
 559 =head2 AddHeader $TAG, $VALUE, ...
 560
 561 Add one or many fields to the attachment's headers.
 562
 563 =cut
 564
 565 sub AddHeader {
 566     my $self = shift;
 567
 568     my $newheader = $self->__Value( 'Headers' );
 569     while ( my ($tag, $value) = splice @_, 0, 2 ) {
 570         $value = $self->_CanonicalizeHeaderValue($value);
 571         $newheader .= "$tag: $value\n";
 572     }
 573     return $self->__Set( Field => 'Headers', Value => $newheader);
 574 }
 575
 576 =head2 SetHeader ( 'Tag', 'Value' )
 577
 578 Replace or add a Header to the attachment's headers.
 579
 580 =cut
 581
 582 sub SetHeader {
 583     my $self  = shift;
 584     my $tag   = shift;
 585     my $value = $self->_CanonicalizeHeaderValue(shift);
 586
 587     my $replaced  = 0;
 588     my $newheader = '';
 589     foreach my $line ( $self->_SplitHeaders ) {
 590         if ( $line =~ /^\Q$tag\E:\s+/i ) {
 591             # replace first instance, skip all the rest
 592             unless ($replaced) {
 593                 $newheader .= "$tag: $value\n";
 594                 $replaced = 1;
 595             }
 596         } else {
 597             $newheader .= "$line\n";
 598         }
 599     }
 600
 601     $newheader .= "$tag: $value\n" unless $replaced;
 602     $self->__Set( Field => 'Headers', Value => $newheader);
 603 }
 604
 605 sub _CanonicalizeHeaderValue {
 606     my $self  = shift;
 607     my $value = shift;
 608
 609     $value = '' unless defined $value;
 610     $value =~ s/\s+$//s;
 611     $value =~ s/\r*\n/\n /g;
 612
 613     return $value;
 614 }
 615
 616 =head2 SplitHeaders
 617
 618 Returns an array of this attachment object's headers, with one header
 619 per array entry. Multiple lines are folded.
 620
 621 B<Never> returns C<RT-Send-Bcc> field.
 622
 623 =cut
 624
 625 sub SplitHeaders {
 626     my $self = shift;
 627     return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) );
 628 }
 629
 630 =head2 _SplitHeaders
 631
 632 Returns an array of this attachment object's headers, with one header
 633 per array entry. multiple lines are folded.
 634
 635
 636 =cut
 637
 638 sub _SplitHeaders {
 639     my $self = shift;
 640     my $headers = (shift || $self->SUPER::Headers());
 641     my @headers;
 642     # XXX TODO: splitting on \n\w is _wrong_ as it treats \n[ as a valid
 643     # continuation, which it isn't.  The correct split pattern, per RFC 2822,
 644     # is /\n(?=[^ \t]|\z)/.  That is, only "\n " or "\n\t" is a valid
 645     # continuation.  Older values of X-RT-GnuPG-Status contain invalid
 646     # continuations and rely on this bogus split pattern, however, so it is
 647     # left as-is for now.
 648     for (split(/\n(?=\w|\z)/,$headers)) {
 649         push @headers, $_;
 650
 651     }
 652     return(@headers);
 653 }
 654
 655
 656 sub Encrypt {
 657     my $self = shift;
 658
 659     my $txn = $self->TransactionObj;
 660     return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee;
 661     return (0, $self->loc('Permission Denied'))
 662         unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket');
 663     return (0, $self->loc('GnuPG integration is disabled'))
 664         unless RT->Config->Get('GnuPG')->{'Enable'};
 665     return (0, $self->loc('Attachments encryption is disabled'))
 666         unless RT->Config->Get('GnuPG')->{'AllowEncryptDataInDB'};
 667
 668     require RT::Crypt::GnuPG;
 669
 670     my $type = $self->ContentType;
 671     if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) {
 672         return (1, $self->loc('Already encrypted'));
 673     } elsif ( $type =~ /^multipart\//i ) {
 674         return (1, $self->loc('No need to encrypt'));
 675     } else {
 676         $type = qq{x-application-rt\/gpg-encrypted; original-type="$type"};
 677     }
 678
 679     my $queue = $txn->TicketObj->QueueObj;
 680     my $encrypt_for;
 681     foreach my $address ( grep $_,
 682         $queue->CorrespondAddress,
 683         $queue->CommentAddress,
 684         RT->Config->Get('CorrespondAddress'),
 685         RT->Config->Get('CommentAddress'),
 686     ) {
 687         my %res = RT::Crypt::GnuPG::GetKeysInfo( $address, 'private' );
 688         next if $res{'exit_code'} || !$res{'info'};
 689         %res = RT::Crypt::GnuPG::GetKeysForEncryption( $address );
 690         next if $res{'exit_code'} || !$res{'info'};
 691         $encrypt_for = $address;
 692     }
 693     unless ( $encrypt_for ) {
 694         return (0, $self->loc('No key suitable for encryption'));
 695     }
 696
 697     $self->__Set( Field => 'ContentType', Value => $type );
 698     $self->SetHeader( 'Content-Type' => $type );
 699
 700     my $content = $self->Content;
 701     my %res = RT::Crypt::GnuPG::SignEncryptContent(
 702         Content => \$content,
 703         Sign => 0,
 704         Encrypt => 1,
 705         Recipients => [ $encrypt_for ],
 706     );
 707     if ( $res{'exit_code'} ) {
 708         return (0, $self->loc('GnuPG error. Contact with administrator'));
 709     }
 710
 711     my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content );
 712     unless ( $status ) {
 713         return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg));
 714     }
 715     return (1, $self->loc('Successfuly encrypted data'));
 716 }
 717
 718 sub Decrypt {
 719     my $self = shift;
 720
 721     my $txn = $self->TransactionObj;
 722     return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee;
 723     return (0, $self->loc('Permission Denied'))
 724         unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket');
 725     return (0, $self->loc('GnuPG integration is disabled'))
 726         unless RT->Config->Get('GnuPG')->{'Enable'};
 727
 728     require RT::Crypt::GnuPG;
 729
 730     my $type = $self->ContentType;
 731     if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) {
 732         ($type) = ($type =~ /original-type="(.*)"/i);
 733         $type ||= 'application/octeat-stream';
 734     } else {
 735         return (1, $self->loc('Is not encrypted'));
 736     }
 737     $self->__Set( Field => 'ContentType', Value => $type );
 738     $self->SetHeader( 'Content-Type' => $type );
 739
 740     my $content = $self->Content;
 741     my %res = RT::Crypt::GnuPG::DecryptContent( Content => \$content, );
 742     if ( $res{'exit_code'} ) {
 743         return (0, $self->loc('GnuPG error. Contact with administrator'));
 744     }
 745
 746     my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content );
 747     unless ( $status ) {
 748         return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg));
 749     }
 750     return (1, $self->loc('Successfuly decrypted data'));
 751 }
 752
 753 =head2 _Value
 754
 755 Takes the name of a table column.
 756 Returns its value as a string, if the user passes an ACL check
 757
 758 =cut
 759
 760 sub _Value {
 761     my $self  = shift;
 762     my $field = shift;
 763
 764     #if the field is public, return it.
 765     if ( $self->_Accessible( $field, 'public' ) ) {
 766         return ( $self->__Value( $field, @_ ) );
 767     }
 768
 769     return undef unless $self->TransactionObj->CurrentUserCanSee;
 770     return $self->__Value( $field, @_ );
 771 }
 772
 773 # Transactions don't change. by adding this cache congif directiove,
 774 # we don't lose pathalogically on long tickets.
 775 sub _CacheConfig {
 776     {
 777         'cache_p'       => 1,
 778         'fast_update_p' => 1,
 779         'cache_for_sec' => 180,
 780     }
 781 }
 782
 783 1;