Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / Attachment.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
403d7b0b 5# This software is Copyright (c) 1996-2013 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
af59614d 133 my $Subject = $head->get( 'subject', 0 );
84fb5b46
MKG
134 $Subject = '' unless defined $Subject;
135 chomp $Subject;
136 utf8::decode( $Subject ) unless utf8::is_utf8( $Subject );
137
138 #Get the Message-ID
af59614d 139 my $MessageId = $head->get( 'Message-ID', 0 );
84fb5b46
MKG
140 defined($MessageId) or $MessageId = '';
141 chomp ($MessageId);
142 $MessageId =~ s/^<(.*?)>$/$1/o;
143
144 #Get the filename
84fb5b46
MKG
145 my $Filename = mime_recommended_filename($Attachment);
146
147 # remove path part.
148 $Filename =~ s!.*/!! if $Filename;
149
af59614d
MKG
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
84fb5b46
MKG
162 # MIME::Head doesn't support perl strings well and can return
163 # octets which later will be double encoded in low-level code
84fb5b46
MKG
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);
af59614d 180 return ($id);
84fb5b46
MKG
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);
af59614d 192 return ($id);
84fb5b46
MKG
193 }
194 }
195 return ($id);
196 }
197
198 #If it's not multipart
199 else {
200
af59614d
MKG
201 my ($encoding, $type);
202 ($encoding, $content, $type, $Filename) = $self->_EncodeLOB(
84fb5b46
MKG
203 $Attachment->bodyhandle->as_string,
204 $Attachment->mime_type,
205 $Filename
206 );
207
208 my $id = $self->SUPER::Create(
209 TransactionId => $args{'TransactionId'},
af59614d
MKG
210 ContentType => $type,
211 ContentEncoding => $encoding,
84fb5b46
MKG
212 Parent => $args{'Parent'},
213 Headers => $head,
214 Subject => $Subject,
af59614d 215 Content => $content,
84fb5b46
MKG
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
84fb5b46
MKG
227=head2 TransactionObj
228
229Returns the transaction object asscoiated with this attachment.
230
231=cut
232
233sub 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
251Returns a parent's L<RT::Attachment> object if this attachment
252has a parent, otherwise returns undef.
253
254=cut
255
256sub 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
af59614d
MKG
265=head2 Closest
266
267Takes a MIME type as a string or regex. Returns an L<RT::Attachment> object
268for the nearest containing part with a matching L</ContentType>. Strings must
269match exactly and all matches are done case insensitively. Strings ending in a
270C</> 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
275Returns undef if no such object is found.
276
277=cut
278
279sub 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
84fb5b46
MKG
294=head2 Children
295
296Returns an L<RT::Attachments> object which is preloaded with
403d7b0b 297all attachments objects with this attachment's Id as their
84fb5b46
MKG
298C<Parent>.
299
300=cut
301
302sub Children {
303 my $self = shift;
304
305 my $kids = RT::Attachments->new( $self->CurrentUser );
306 $kids->ChildrenOf( $self->Id );
307 return($kids);
308}
309
af59614d
MKG
310=head2 Siblings
311
312Returns an L<RT::Attachments> object containing all the attachments sharing
313the same immediate parent as the current object, excluding the current
314attachment itself.
315
316If the current attachment is a top-level part (i.e. Parent == 0) then a
317guaranteed empty L<RT::Attachments> object is returned.
318
319=cut
320
321sub 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
84fb5b46
MKG
334=head2 Content
335
336Returns the attachment's content. if it's base64 encoded, decode it
337before returning it.
338
339=cut
340
341sub 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
352Returns the attachment's content as octets before RT's mangling.
353Generally this just means restoring text content back to its
354original encoding.
355
356If the attachment has a C<message/*> Content-Type, its children attachments
357are reconstructed and returned as a string.
358
359=cut
360
361sub 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
406Returns the attachment's original encoding.
407
408=cut
409
410sub OriginalEncoding {
411 my $self = shift;
412 return $self->GetHeader('X-RT-Original-Encoding');
413}
414
415=head2 ContentLength
416
417Returns length of L</Content> in bytes.
418
419=cut
420
421sub 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
af59614d 436=head2 FriendlyContentLength
84fb5b46 437
af59614d
MKG
438Returns L</ContentLength> in bytes, kilobytes, or megabytes as most
439appropriate. The size is suffixed with C<M>, C<k>, and C<b> and the returned
440string is localized.
84fb5b46 441
af59614d 442Returns the empty string if the L</ContentLength> is 0 or undefined.
84fb5b46 443
af59614d 444=cut
84fb5b46 445
af59614d
MKG
446sub FriendlyContentLength {
447 my $self = shift;
448 my $size = $self->ContentLength;
449 return '' unless $size;
84fb5b46 450
af59614d
MKG
451 my $res = '';
452 if ( $size > 1024*1024 ) {
453 $res = $self->loc( "[_1]M", int( $size / 1024 / 102.4 ) / 10 );
84fb5b46 454 }
af59614d
MKG
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;
84fb5b46
MKG
462}
463
464=head2 ContentAsMIME [Children => 1]
465
466Returns MIME entity built from this attachment.
467
468If the optional parameter C<Children> is set to a true value, the children are
469recursively added to the entity.
470
471=cut
472
473sub 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
508Returns a boolean indicating if the Content-Type of this attachment is a
509C<message/> subtype.
510
511=cut
512
513sub IsMessageContentType {
514 my $self = shift;
515 return $self->ContentType =~ m{^\s*message/}i ? 1 : 0;
516}
517
518=head2 Addresses
519
520Returns a hashref of all addresses related to this attachment.
521The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc>
522and C<RT-Send-Bcc>. The values are references to lists of
523L<Email::Address> objects.
524
525=cut
526
c36a7e1d
MKG
527our @ADDRESS_HEADERS = qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc);
528
84fb5b46
MKG
529sub Addresses {
530 my $self = shift;
531
532 my %data = ();
533 my $current_user_address = lc $self->CurrentUser->EmailAddress;
c36a7e1d 534 foreach my $hdr (@ADDRESS_HEADERS) {
84fb5b46
MKG
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
552Returns a multi-line string of the To, From, Cc, Date and Subject headers.
553
554=cut
555
556sub NiceHeaders {
557 my $self = shift;
558 my $hdrs = "";
559 my @hdrs = $self->_SplitHeaders;
560 while (my $str = shift @hdrs) {
af59614d
MKG
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]+/);
84fb5b46
MKG
564 }
565 return $hdrs;
566}
567
568=head2 Headers
569
570Returns this object's headers as a string. This method specifically
571removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc.
572We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send
573out mail. The mailing rules are separated from the ticket update code by
574an abstraction barrier that makes it impossible to pass this data directly.
575
576=cut
577
578sub Headers {
579 return join("\n", $_[0]->SplitHeaders);
580}
581
582=head2 EncodedHeaders
583
584Takes encoding as argument and returns the attachment's headers as octets in encoded
585using the encoding.
586
587This is not protection using quoted printable or base64 encoding.
588
589=cut
590
591sub EncodedHeaders {
592 my $self = shift;
593 my $encoding = shift || 'utf8';
594 return Encode::encode( $encoding, $self->Headers );
595}
596
597=head2 GetHeader $TAG
598
599Returns the value of the header Tag as a string. This bypasses the weeding out
600done in Headers() above.
601
602=cut
603
604sub 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
620Delete a field from the attachment's headers.
621
622=cut
623
624sub DelHeader {
625 my $self = shift;
626 my $tag = shift;
627
628 my $newheader = '';
629 foreach my $line ($self->_SplitHeaders) {
dab09ea8
MKG
630 next if $line =~ /^\Q$tag\E:\s+/i;
631 $newheader .= "$line\n";
84fb5b46
MKG
632 }
633 return $self->__Set( Field => 'Headers', Value => $newheader);
634}
635
636=head2 AddHeader $TAG, $VALUE, ...
637
638Add one or many fields to the attachment's headers.
639
640=cut
641
642sub AddHeader {
643 my $self = shift;
644
645 my $newheader = $self->__Value( 'Headers' );
646 while ( my ($tag, $value) = splice @_, 0, 2 ) {
dab09ea8 647 $value = $self->_CanonicalizeHeaderValue($value);
84fb5b46
MKG
648 $newheader .= "$tag: $value\n";
649 }
650 return $self->__Set( Field => 'Headers', Value => $newheader);
651}
652
653=head2 SetHeader ( 'Tag', 'Value' )
654
655Replace or add a Header to the attachment's headers.
656
657=cut
658
659sub SetHeader {
dab09ea8
MKG
660 my $self = shift;
661 my $tag = shift;
662 my $value = $self->_CanonicalizeHeaderValue(shift);
84fb5b46 663
dab09ea8 664 my $replaced = 0;
84fb5b46 665 my $newheader = '';
dab09ea8
MKG
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";
84fb5b46 675 }
84fb5b46
MKG
676 }
677
dab09ea8 678 $newheader .= "$tag: $value\n" unless $replaced;
84fb5b46
MKG
679 $self->__Set( Field => 'Headers', Value => $newheader);
680}
681
dab09ea8
MKG
682sub _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
84fb5b46
MKG
693=head2 SplitHeaders
694
695Returns an array of this attachment object's headers, with one header
696per array entry. Multiple lines are folded.
697
698B<Never> returns C<RT-Send-Bcc> field.
699
700=cut
701
702sub SplitHeaders {
703 my $self = shift;
704 return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) );
705}
706
707=head2 _SplitHeaders
708
709Returns an array of this attachment object's headers, with one header
710per array entry. multiple lines are folded.
711
712
713=cut
714
715sub _SplitHeaders {
716 my $self = shift;
717 my $headers = (shift || $self->_Value('Headers'));
718 my @headers;
dab09ea8
MKG
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.
84fb5b46
MKG
725 for (split(/\n(?=\w|\z)/,$headers)) {
726 push @headers, $_;
727
728 }
729 return(@headers);
730}
731
732
733sub 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');
af59614d
MKG
740 return (0, $self->loc('Cryptography is disabled'))
741 unless RT->Config->Get('Crypt')->{'Enable'};
84fb5b46 742 return (0, $self->loc('Attachments encryption is disabled'))
af59614d 743 unless RT->Config->Get('Crypt')->{'AllowEncryptDataInDB'};
84fb5b46
MKG
744
745 my $type = $self->ContentType;
af59614d 746 if ( $type =~ /^x-application-rt\/[^-]+-encrypted/i ) {
84fb5b46
MKG
747 return (1, $self->loc('Already encrypted'));
748 } elsif ( $type =~ /^multipart\//i ) {
749 return (1, $self->loc('No need to encrypt'));
84fb5b46
MKG
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 ) {
af59614d 760 my %res = RT::Crypt->GetKeysInfo( Key => $address, Type => 'private' );
84fb5b46 761 next if $res{'exit_code'} || !$res{'info'};
af59614d 762 %res = RT::Crypt->GetKeysForEncryption( $address );
84fb5b46
MKG
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
84fb5b46 770 my $content = $self->Content;
af59614d 771 my %res = RT::Crypt->SignEncryptContent(
84fb5b46
MKG
772 Content => \$content,
773 Sign => 0,
774 Encrypt => 1,
775 Recipients => [ $encrypt_for ],
776 );
777 if ( $res{'exit_code'} ) {
af59614d 778 return (0, $self->loc('Encryption error; contact the administrator'));
84fb5b46
MKG
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 }
af59614d
MKG
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
84fb5b46
MKG
790 return (1, $self->loc('Successfuly encrypted data'));
791}
792
793sub 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');
af59614d
MKG
800 return (0, $self->loc('Cryptography is disabled'))
801 unless RT->Config->Get('Crypt')->{'Enable'};
84fb5b46
MKG
802
803 my $type = $self->ContentType;
af59614d
MKG
804 my $protocol;
805 if ( $type =~ /^x-application-rt\/([^-]+)-encrypted/i ) {
806 $protocol = $1;
807 $protocol =~ s/gpg/gnupg/; # backwards compatibility
84fb5b46
MKG
808 ($type) = ($type =~ /original-type="(.*)"/i);
809 $type ||= 'application/octet-stream';
810 } else {
811 return (1, $self->loc('Is not encrypted'));
812 }
af59614d
MKG
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 ;
84fb5b46
MKG
821
822 my $content = $self->Content;
af59614d
MKG
823 my %res = RT::Crypt->DecryptContent(
824 Protocol => $protocol,
825 Content => \$content,
826 Recipients => \@addresses,
827 );
84fb5b46 828 if ( $res{'exit_code'} ) {
af59614d 829 return (0, $self->loc('Decryption error; contact the administrator'));
84fb5b46
MKG
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 }
af59614d
MKG
836 $self->__Set( Field => 'ContentType', Value => $type );
837 $self->SetHeader( 'Content-Type' => $type );
838
84fb5b46
MKG
839 return (1, $self->loc('Successfuly decrypted data'));
840}
841
842=head2 _Value
843
844Takes the name of a table column.
845Returns its value as a string, if the user passes an ACL check
846
847=cut
848
849sub _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.
864sub _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
877Returns 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
886Returns the current value of TransactionId.
887(In the database, TransactionId is stored as int(11).)
888
889
890
891=head2 SetTransactionId VALUE
892
893
894Set TransactionId to VALUE.
895Returns (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
904Returns the current value of Parent.
905(In the database, Parent is stored as int(11).)
906
907
908
909=head2 SetParent VALUE
910
911
912Set Parent to VALUE.
913Returns (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
922Returns the current value of MessageId.
923(In the database, MessageId is stored as varchar(160).)
924
925
926
927=head2 SetMessageId VALUE
928
929
930Set MessageId to VALUE.
931Returns (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
940Returns the current value of Subject.
941(In the database, Subject is stored as varchar(255).)
942
943
944
945=head2 SetSubject VALUE
946
947
948Set Subject to VALUE.
949Returns (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
958Returns the current value of Filename.
959(In the database, Filename is stored as varchar(255).)
960
961
962
963=head2 SetFilename VALUE
964
965
966Set Filename to VALUE.
967Returns (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
976Returns the current value of ContentType.
977(In the database, ContentType is stored as varchar(80).)
978
979
980
981=head2 SetContentType VALUE
982
983
984Set ContentType to VALUE.
985Returns (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
994Returns the current value of ContentEncoding.
995(In the database, ContentEncoding is stored as varchar(80).)
996
997
998
999=head2 SetContentEncoding VALUE
1000
1001
1002Set ContentEncoding to VALUE.
1003Returns (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
1012Returns the current value of Content.
1013(In the database, Content is stored as longblob.)
1014
1015
1016
1017=head2 SetContent VALUE
1018
1019
1020Set Content to VALUE.
1021Returns (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
1030Returns the current value of Headers.
1031(In the database, Headers is stored as longtext.)
1032
1033
1034
1035=head2 SetHeaders VALUE
1036
1037
1038Set Headers to VALUE.
1039Returns (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
1048Returns 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
1057Returns the current value of Created.
1058(In the database, Created is stored as datetime.)
1059
1060
1061=cut
1062
1063
1064
1065sub _CoreAccessible {
1066 {
1067
1068 id =>
af59614d 1069 {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
84fb5b46 1070 TransactionId =>
af59614d 1071 {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
84fb5b46 1072 Parent =>
af59614d 1073 {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1074 MessageId =>
af59614d 1075 {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''},
84fb5b46 1076 Subject =>
af59614d 1077 {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
84fb5b46 1078 Filename =>
af59614d 1079 {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
84fb5b46 1080 ContentType =>
af59614d 1081 {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
84fb5b46 1082 ContentEncoding =>
af59614d 1083 {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
84fb5b46 1084 Content =>
af59614d 1085 {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longblob', default => ''},
84fb5b46 1086 Headers =>
af59614d 1087 {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''},
84fb5b46 1088 Creator =>
af59614d 1089 {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
84fb5b46 1090 Created =>
af59614d 1091 {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
84fb5b46
MKG
1092
1093 }
1094};
1095
af59614d
MKG
1096sub FindDependencies {
1097 my $self = shift;
1098 my ($walker, $deps) = @_;
1099
1100 $self->SUPER::FindDependencies($walker, $deps);
1101 $deps->Add( out => $self->TransactionObj );
1102}
1103
84fb5b46
MKG
1104RT::Base->_ImportOverlays();
1105
11061;