Master to 4.2.8
[usit-rt.git] / lib / RT / Attachment.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
320f0092 5# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
84fb5b46
MKG
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
55This module should never be instantiated directly by client code. it's an internal
56module which should only be instantiated through exported APIs in Ticket, Queue and other
57similar objects.
58
59=head1 METHODS
60
61
62
63=cut
64
65
66package RT::Attachment;
67use base 'RT::Record';
68
69sub Table {'Attachments'}
70
71
72
73
74use strict;
75use warnings;
76
77
78use RT::Transaction;
79use MIME::Base64;
80use MIME::QuotedPrint;
81use MIME::Body;
82use RT::Util 'mime_recommended_filename';
83
84sub _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
102Create 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
110sub 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
af59614d
MKG
130 my $head = $Attachment->head;
131
84fb5b46 132 # Get the subject
c33a4027 133 my $Subject = Encode::decode( 'UTF-8', $head->get( 'subject' ) );
84fb5b46
MKG
134 $Subject = '' unless defined $Subject;
135 chomp $Subject;
84fb5b46
MKG
136
137 #Get the Message-ID
c33a4027 138 my $MessageId = Encode::decode( "UTF-8", $head->get( 'Message-ID' ) );
84fb5b46
MKG
139 defined($MessageId) or $MessageId = '';
140 chomp ($MessageId);
141 $MessageId =~ s/^<(.*?)>$/$1/o;
142
143 #Get the filename
84fb5b46
MKG
144 my $Filename = mime_recommended_filename($Attachment);
145
146 # remove path part.
147 $Filename =~ s!.*/!! if $Filename;
148
af59614d
MKG
149 my $content;
150 unless ( $head->get('Content-Length') ) {
151 my $length = 0;
c33a4027
MKG
152 $length = length $Attachment->bodyhandle->as_string
153 if defined $Attachment->bodyhandle;
154 $head->replace( 'Content-Length' => Encode::encode( "UTF-8", $length ) );
af59614d
MKG
155 }
156 $head = $head->as_string;
157
84fb5b46
MKG
158 # MIME::Head doesn't support perl strings well and can return
159 # octets which later will be double encoded in low-level code
c33a4027 160 $head = Encode::decode( 'UTF-8', $head );
84fb5b46
MKG
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);
af59614d 176 return ($id);
84fb5b46
MKG
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);
af59614d 188 return ($id);
84fb5b46
MKG
189 }
190 }
191 return ($id);
192 }
193
194 #If it's not multipart
195 else {
196
c33a4027
MKG
197 my ( $encoding, $type, $note_args );
198 ( $encoding, $content, $type, $Filename, $note_args ) =
199 $self->_EncodeLOB( $Attachment->bodyhandle->as_string, $Attachment->mime_type, $Filename, );
84fb5b46
MKG
200
201 my $id = $self->SUPER::Create(
202 TransactionId => $args{'TransactionId'},
af59614d
MKG
203 ContentType => $type,
204 ContentEncoding => $encoding,
84fb5b46
MKG
205 Parent => $args{'Parent'},
206 Headers => $head,
207 Subject => $Subject,
af59614d 208 Content => $content,
84fb5b46
MKG
209 Filename => $Filename,
210 MessageId => $MessageId,
211 );
212
c33a4027
MKG
213 if ($id) {
214 if ($note_args) {
215 $self->TransactionObj->Object->_NewTransaction( %$note_args );
216 }
217 }
218 else {
84fb5b46
MKG
219 $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
220 }
221 return $id;
222 }
223}
224
84fb5b46
MKG
225=head2 TransactionObj
226
227Returns the transaction object asscoiated with this attachment.
228
229=cut
230
231sub 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
249Returns a parent's L<RT::Attachment> object if this attachment
250has a parent, otherwise returns undef.
251
252=cut
253
254sub 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
af59614d
MKG
263=head2 Closest
264
265Takes a MIME type as a string or regex. Returns an L<RT::Attachment> object
266for the nearest containing part with a matching L</ContentType>. Strings must
267match exactly and all matches are done case insensitively. Strings ending in a
268C</> 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
273Returns undef if no such object is found.
274
275=cut
276
277sub 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
84fb5b46
MKG
292=head2 Children
293
294Returns an L<RT::Attachments> object which is preloaded with
403d7b0b 295all attachments objects with this attachment's Id as their
84fb5b46
MKG
296C<Parent>.
297
298=cut
299
300sub Children {
301 my $self = shift;
302
303 my $kids = RT::Attachments->new( $self->CurrentUser );
304 $kids->ChildrenOf( $self->Id );
305 return($kids);
306}
307
af59614d
MKG
308=head2 Siblings
309
310Returns an L<RT::Attachments> object containing all the attachments sharing
311the same immediate parent as the current object, excluding the current
312attachment itself.
313
314If the current attachment is a top-level part (i.e. Parent == 0) then a
315guaranteed empty L<RT::Attachments> object is returned.
316
317=cut
318
319sub 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
84fb5b46
MKG
332=head2 Content
333
334Returns the attachment's content. if it's base64 encoded, decode it
335before returning it.
336
337=cut
338
339sub Content {
340 my $self = shift;
341 return $self->_DecodeLOB(
c33a4027 342 $self->GetHeader('Content-Type'), # Includes charset, unlike ->ContentType
84fb5b46
MKG
343 $self->ContentEncoding,
344 $self->_Value('Content', decode_utf8 => 0),
345 );
346}
347
348=head2 OriginalContent
349
350Returns the attachment's content as octets before RT's mangling.
351Generally this just means restoring text content back to its
352original encoding.
353
354If the attachment has a C<message/*> Content-Type, its children attachments
355are reconstructed and returned as a string.
356
357=cut
358
359sub 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);
84fb5b46
MKG
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
c33a4027
MKG
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);
84fb5b46 390
c33a4027
MKG
391 my $to = RT::I18N::_CanonicalizeCharset(
392 $self->OriginalEncoding || 'utf-8'
393 );
84fb5b46 394
c33a4027
MKG
395 local $@;
396 eval { Encode::from_to($content, $from => $to) };
84fb5b46 397 if ($@) {
c33a4027 398 $RT::Logger->error("Could not convert attachment from $from to $to: ".$@);
84fb5b46
MKG
399 }
400 return $content;
401}
402
403=head2 OriginalEncoding
404
405Returns the attachment's original encoding.
406
407=cut
408
409sub OriginalEncoding {
410 my $self = shift;
411 return $self->GetHeader('X-RT-Original-Encoding');
412}
413
414=head2 ContentLength
415
416Returns length of L</Content> in bytes.
417
418=cut
419
420sub 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
af59614d 435=head2 FriendlyContentLength
84fb5b46 436
af59614d 437Returns L</ContentLength> in bytes, kilobytes, or megabytes as most
c33a4027 438appropriate. The size is suffixed with C<MiB>, C<KiB>, or C<B> and the returned
af59614d 439string is localized.
84fb5b46 440
af59614d 441Returns the empty string if the L</ContentLength> is 0 or undefined.
84fb5b46 442
af59614d 443=cut
84fb5b46 444
af59614d
MKG
445sub FriendlyContentLength {
446 my $self = shift;
447 my $size = $self->ContentLength;
448 return '' unless $size;
84fb5b46 449
af59614d
MKG
450 my $res = '';
451 if ( $size > 1024*1024 ) {
c33a4027 452 $res = $self->loc( "[_1]MiB", int( $size / 1024 / 102.4 ) / 10 );
84fb5b46 453 }
af59614d 454 elsif ( $size > 1024 ) {
c33a4027 455 $res = $self->loc( "[_1]KiB", int( $size / 102.4 ) / 10 );
af59614d
MKG
456 }
457 else {
c33a4027 458 $res = $self->loc( "[_1]B", $size );
af59614d
MKG
459 }
460 return $res;
84fb5b46
MKG
461}
462
463=head2 ContentAsMIME [Children => 1]
464
465Returns MIME entity built from this attachment.
466
467If the optional parameter C<Children> is set to a true value, the children are
468recursively added to the entity.
469
470=cut
471
472sub 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
507Returns a boolean indicating if the Content-Type of this attachment is a
508C<message/> subtype.
509
510=cut
511
512sub IsMessageContentType {
513 my $self = shift;
514 return $self->ContentType =~ m{^\s*message/}i ? 1 : 0;
515}
516
517=head2 Addresses
518
519Returns a hashref of all addresses related to this attachment.
520The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc>
521and C<RT-Send-Bcc>. The values are references to lists of
522L<Email::Address> objects.
523
524=cut
525
c36a7e1d
MKG
526our @ADDRESS_HEADERS = qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc);
527
84fb5b46
MKG
528sub Addresses {
529 my $self = shift;
530
531 my %data = ();
c33a4027 532 my $current_user_address = lc($self->CurrentUser->EmailAddress || '');
c36a7e1d 533 foreach my $hdr (@ADDRESS_HEADERS) {
84fb5b46
MKG
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
551Returns a multi-line string of the To, From, Cc, Date and Subject headers.
552
553=cut
554
555sub NiceHeaders {
556 my $self = shift;
557 my $hdrs = "";
558 my @hdrs = $self->_SplitHeaders;
559 while (my $str = shift @hdrs) {
af59614d
MKG
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]+/);
84fb5b46
MKG
563 }
564 return $hdrs;
565}
566
567=head2 Headers
568
569Returns this object's headers as a string. This method specifically
570removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc.
571We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send
572out mail. The mailing rules are separated from the ticket update code by
573an abstraction barrier that makes it impossible to pass this data directly.
574
575=cut
576
577sub Headers {
578 return join("\n", $_[0]->SplitHeaders);
579}
580
581=head2 EncodedHeaders
582
583Takes encoding as argument and returns the attachment's headers as octets in encoded
584using the encoding.
585
586This is not protection using quoted printable or base64 encoding.
587
588=cut
589
590sub EncodedHeaders {
591 my $self = shift;
592 my $encoding = shift || 'utf8';
593 return Encode::encode( $encoding, $self->Headers );
594}
595
596=head2 GetHeader $TAG
597
598Returns the value of the header Tag as a string. This bypasses the weeding out
599done in Headers() above.
600
601=cut
602
603sub 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
619Delete a field from the attachment's headers.
620
621=cut
622
623sub DelHeader {
624 my $self = shift;
625 my $tag = shift;
626
627 my $newheader = '';
628 foreach my $line ($self->_SplitHeaders) {
dab09ea8
MKG
629 next if $line =~ /^\Q$tag\E:\s+/i;
630 $newheader .= "$line\n";
84fb5b46
MKG
631 }
632 return $self->__Set( Field => 'Headers', Value => $newheader);
633}
634
635=head2 AddHeader $TAG, $VALUE, ...
636
637Add one or many fields to the attachment's headers.
638
639=cut
640
641sub AddHeader {
642 my $self = shift;
643
644 my $newheader = $self->__Value( 'Headers' );
645 while ( my ($tag, $value) = splice @_, 0, 2 ) {
dab09ea8 646 $value = $self->_CanonicalizeHeaderValue($value);
84fb5b46
MKG
647 $newheader .= "$tag: $value\n";
648 }
649 return $self->__Set( Field => 'Headers', Value => $newheader);
650}
651
652=head2 SetHeader ( 'Tag', 'Value' )
653
654Replace or add a Header to the attachment's headers.
655
656=cut
657
658sub SetHeader {
dab09ea8
MKG
659 my $self = shift;
660 my $tag = shift;
661 my $value = $self->_CanonicalizeHeaderValue(shift);
84fb5b46 662
dab09ea8 663 my $replaced = 0;
84fb5b46 664 my $newheader = '';
dab09ea8
MKG
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";
84fb5b46 674 }
84fb5b46
MKG
675 }
676
dab09ea8 677 $newheader .= "$tag: $value\n" unless $replaced;
84fb5b46
MKG
678 $self->__Set( Field => 'Headers', Value => $newheader);
679}
680
dab09ea8
MKG
681sub _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
84fb5b46
MKG
692=head2 SplitHeaders
693
694Returns an array of this attachment object's headers, with one header
695per array entry. Multiple lines are folded.
696
697B<Never> returns C<RT-Send-Bcc> field.
698
699=cut
700
701sub SplitHeaders {
702 my $self = shift;
703 return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) );
704}
705
706=head2 _SplitHeaders
707
708Returns an array of this attachment object's headers, with one header
709per array entry. multiple lines are folded.
710
711
712=cut
713
714sub _SplitHeaders {
715 my $self = shift;
716 my $headers = (shift || $self->_Value('Headers'));
717 my @headers;
dab09ea8
MKG
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.
84fb5b46
MKG
724 for (split(/\n(?=\w|\z)/,$headers)) {
725 push @headers, $_;
726
727 }
728 return(@headers);
729}
730
731
732sub 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');
af59614d
MKG
739 return (0, $self->loc('Cryptography is disabled'))
740 unless RT->Config->Get('Crypt')->{'Enable'};
84fb5b46 741 return (0, $self->loc('Attachments encryption is disabled'))
af59614d 742 unless RT->Config->Get('Crypt')->{'AllowEncryptDataInDB'};
84fb5b46
MKG
743
744 my $type = $self->ContentType;
af59614d 745 if ( $type =~ /^x-application-rt\/[^-]+-encrypted/i ) {
84fb5b46
MKG
746 return (1, $self->loc('Already encrypted'));
747 } elsif ( $type =~ /^multipart\//i ) {
748 return (1, $self->loc('No need to encrypt'));
84fb5b46
MKG
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 ) {
af59614d 759 my %res = RT::Crypt->GetKeysInfo( Key => $address, Type => 'private' );
84fb5b46 760 next if $res{'exit_code'} || !$res{'info'};
af59614d 761 %res = RT::Crypt->GetKeysForEncryption( $address );
84fb5b46
MKG
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
84fb5b46 769 my $content = $self->Content;
af59614d 770 my %res = RT::Crypt->SignEncryptContent(
84fb5b46
MKG
771 Content => \$content,
772 Sign => 0,
773 Encrypt => 1,
774 Recipients => [ $encrypt_for ],
775 );
776 if ( $res{'exit_code'} ) {
af59614d 777 return (0, $self->loc('Encryption error; contact the administrator'));
84fb5b46
MKG
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 }
af59614d
MKG
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
84fb5b46
MKG
789 return (1, $self->loc('Successfuly encrypted data'));
790}
791
792sub 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');
af59614d
MKG
799 return (0, $self->loc('Cryptography is disabled'))
800 unless RT->Config->Get('Crypt')->{'Enable'};
84fb5b46
MKG
801
802 my $type = $self->ContentType;
af59614d
MKG
803 my $protocol;
804 if ( $type =~ /^x-application-rt\/([^-]+)-encrypted/i ) {
805 $protocol = $1;
806 $protocol =~ s/gpg/gnupg/; # backwards compatibility
84fb5b46
MKG
807 ($type) = ($type =~ /original-type="(.*)"/i);
808 $type ||= 'application/octet-stream';
809 } else {
810 return (1, $self->loc('Is not encrypted'));
811 }
af59614d
MKG
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 ;
84fb5b46
MKG
820
821 my $content = $self->Content;
af59614d
MKG
822 my %res = RT::Crypt->DecryptContent(
823 Protocol => $protocol,
824 Content => \$content,
825 Recipients => \@addresses,
826 );
84fb5b46 827 if ( $res{'exit_code'} ) {
af59614d 828 return (0, $self->loc('Decryption error; contact the administrator'));
84fb5b46
MKG
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 }
af59614d
MKG
835 $self->__Set( Field => 'ContentType', Value => $type );
836 $self->SetHeader( 'Content-Type' => $type );
837
84fb5b46
MKG
838 return (1, $self->loc('Successfuly decrypted data'));
839}
840
841=head2 _Value
842
843Takes the name of a table column.
844Returns its value as a string, if the user passes an ACL check
845
846=cut
847
848sub _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.
863sub _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
876Returns 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
885Returns the current value of TransactionId.
886(In the database, TransactionId is stored as int(11).)
887
888
889
890=head2 SetTransactionId VALUE
891
892
893Set TransactionId to VALUE.
894Returns (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
903Returns the current value of Parent.
904(In the database, Parent is stored as int(11).)
905
906
907
908=head2 SetParent VALUE
909
910
911Set Parent to VALUE.
912Returns (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
921Returns the current value of MessageId.
922(In the database, MessageId is stored as varchar(160).)
923
924
925
926=head2 SetMessageId VALUE
927
928
929Set MessageId to VALUE.
930Returns (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
939Returns the current value of Subject.
940(In the database, Subject is stored as varchar(255).)
941
942
943
944=head2 SetSubject VALUE
945
946
947Set Subject to VALUE.
948Returns (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
957Returns the current value of Filename.
958(In the database, Filename is stored as varchar(255).)
959
960
961
962=head2 SetFilename VALUE
963
964
965Set Filename to VALUE.
966Returns (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
975Returns the current value of ContentType.
976(In the database, ContentType is stored as varchar(80).)
977
978
979
980=head2 SetContentType VALUE
981
982
983Set ContentType to VALUE.
984Returns (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
993Returns the current value of ContentEncoding.
994(In the database, ContentEncoding is stored as varchar(80).)
995
996
997
998=head2 SetContentEncoding VALUE
999
1000
1001Set ContentEncoding to VALUE.
1002Returns (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
1011Returns the current value of Content.
1012(In the database, Content is stored as longblob.)
1013
1014
1015
1016=head2 SetContent VALUE
1017
1018
1019Set Content to VALUE.
1020Returns (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
1029Returns the current value of Headers.
1030(In the database, Headers is stored as longtext.)
1031
1032
1033
1034=head2 SetHeaders VALUE
1035
1036
1037Set Headers to VALUE.
1038Returns (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
1047Returns 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
1056Returns the current value of Created.
1057(In the database, Created is stored as datetime.)
1058
1059
1060=cut
1061
1062
1063
1064sub _CoreAccessible {
1065 {
1066
1067 id =>
af59614d 1068 {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
84fb5b46 1069 TransactionId =>
af59614d 1070 {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
84fb5b46 1071 Parent =>
af59614d 1072 {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1073 MessageId =>
af59614d 1074 {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''},
84fb5b46 1075 Subject =>
af59614d 1076 {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
84fb5b46 1077 Filename =>
af59614d 1078 {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
84fb5b46 1079 ContentType =>
af59614d 1080 {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
84fb5b46 1081 ContentEncoding =>
af59614d 1082 {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
84fb5b46 1083 Content =>
af59614d 1084 {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longblob', default => ''},
84fb5b46 1085 Headers =>
af59614d 1086 {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''},
84fb5b46 1087 Creator =>
af59614d 1088 {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1089 Created =>
af59614d 1090 {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
84fb5b46
MKG
1091
1092 }
1093};
1094
af59614d
MKG
1095sub FindDependencies {
1096 my $self = shift;
1097 my ($walker, $deps) = @_;
1098
1099 $self->SUPER::FindDependencies($walker, $deps);
1100 $deps->Add( out => $self->TransactionObj );
1101}
1102
84fb5b46
MKG
1103RT::Base->_ImportOverlays();
1104
11051;