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