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