1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
6 # <jesse@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
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
66 package RT::Attachment;
69 no warnings qw(redefine);
73 use MIME::QuotedPrint;
75 sub _OverlayAccessible {
77 TransactionId => { 'read'=>1, 'public'=>1, 'write' => 0 },
78 MessageId => { 'read'=>1, 'write' => 0 },
79 Parent => { 'read'=>1, 'write' => 0 },
80 ContentType => { 'read'=>1, 'write' => 0 },
81 Subject => { 'read'=>1, 'write' => 0 },
82 Content => { 'read'=>1, 'write' => 0 },
83 ContentEncoding => { 'read'=>1, 'write' => 0 },
84 Headers => { 'read'=>1, 'write' => 0 },
85 Filename => { 'read'=>1, 'write' => 0 },
86 Creator => { 'read'=>1, 'auto'=>1, },
87 Created => { 'read'=>1, 'auto'=>1, },
93 Create a new attachment. Takes a paramhash:
95 'Attachment' Should be a single MIME body with optional subparts
96 'Parent' is an optional id of the parent attachment
97 'TransactionId' is the mandatory id of the transaction this attachment is associated with.;
103 my %args = ( id => 0,
109 # For ease of reference
110 my $Attachment = $args{'Attachment'};
112 # if we didn't specify a ticket, we need to bail
113 unless ( $args{'TransactionId'} ) {
114 $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction" );
118 # If we possibly can, collapse it to a singlepart
119 $Attachment->make_singlepart;
122 my $Subject = $Attachment->head->get( 'subject', 0 );
123 $Subject = '' unless defined $Subject;
125 utf8::decode( $Subject ) unless utf8::is_utf8( $Subject );
128 my $MessageId = $Attachment->head->get( 'Message-ID', 0 );
129 defined($MessageId) or $MessageId = '';
131 $MessageId =~ s/^<(.*?)>$/$1/o;
134 my $Filename = $Attachment->head->recommended_filename;
136 # MIME::Head doesn't support perl strings well and can return
137 # octets which later will be double encoded in low-level code
138 my $head = $Attachment->head->as_string;
139 utf8::decode( $head ) unless utf8::is_utf8( $head );
141 # If a message has no bodyhandle, that means that it has subparts (or appears to)
142 # and we should act accordingly.
143 unless ( defined $Attachment->bodyhandle ) {
144 my ($id) = $self->SUPER::Create(
145 TransactionId => $args{'TransactionId'},
146 Parent => $args{'Parent'},
147 ContentType => $Attachment->mime_type,
149 MessageId => $MessageId,
154 $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr);
157 foreach my $part ( $Attachment->parts ) {
158 my $SubAttachment = new RT::Attachment( $self->CurrentUser );
159 my ($id) = $SubAttachment->Create(
160 TransactionId => $args{'TransactionId'},
165 $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
171 #If it's not multipart
174 my ($ContentEncoding, $Body) = $self->_EncodeLOB(
175 $Attachment->bodyhandle->as_string,
176 $Attachment->mime_type
179 my $id = $self->SUPER::Create(
180 TransactionId => $args{'TransactionId'},
181 ContentType => $Attachment->mime_type,
182 ContentEncoding => $ContentEncoding,
183 Parent => $args{'Parent'},
187 Filename => $Filename,
188 MessageId => $MessageId,
192 $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
200 Create an attachment exactly as specified in the named parameters.
206 my %args = ( ContentEncoding => 'none', @_ );
208 ( $args{'ContentEncoding'}, $args{'Content'} ) =
209 $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} );
211 return ( $self->SUPER::Create(%args) );
214 =head2 TransactionObj
216 Returns the transaction object asscoiated with this attachment.
223 unless ( $self->{_TransactionObj} ) {
224 $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser );
225 $self->{_TransactionObj}->Load( $self->TransactionId );
228 unless ($self->{_TransactionObj}->Id) {
229 $RT::Logger->crit( "Attachment ". $self->id
230 ." can't find transaction ". $self->TransactionId
231 ." which it is ostensibly part of. That's bad");
233 return $self->{_TransactionObj};
238 Returns a parent's L<RT::Attachment> object if this attachment
239 has a parent, otherwise returns undef.
245 return undef unless $self->Parent;
247 my $parent = RT::Attachment->new( $self->CurrentUser );
248 $parent->LoadById( $self->Parent );
254 Returns an L<RT::Attachments> object which is preloaded with
255 all attachments objects with this attachment\'s Id as their
263 my $kids = RT::Attachments->new( $self->CurrentUser );
264 $kids->ChildrenOf( $self->Id );
270 Returns the attachment's content. if it's base64 encoded, decode it
277 return $self->_DecodeLOB(
279 $self->ContentEncoding,
280 $self->_Value('Content', decode_utf8 => 0),
284 =head2 OriginalContent
286 Returns the attachment's content as octets before RT's mangling.
287 Currently, this just means restoring text content back to its
292 sub OriginalContent {
295 return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType);
296 my $enc = $self->OriginalEncoding;
299 if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) {
300 $content = $self->_Value('Content', decode_utf8 => 0);
301 } elsif ( $self->ContentEncoding eq 'base64' ) {
302 $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0));
303 } elsif ( $self->ContentEncoding eq 'quoted-printable' ) {
304 $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0));
306 return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
309 # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work.
311 Encode::_utf8_off($content);
313 if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') {
314 # If we somehow fail to do the decode, at least push out the raw bits
315 eval { return( Encode::decode_utf8($content)) } || return ($content);
318 eval { Encode::from_to($content, 'utf8' => $enc) } if $enc;
320 $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@);
325 =head2 OriginalEncoding
327 Returns the attachment's original encoding.
331 sub OriginalEncoding {
333 return $self->GetHeader('X-RT-Original-Encoding');
338 Returns length of L</Content> in bytes.
345 return undef unless $self->TransactionObj->CurrentUserCanSee;
347 my $len = $self->GetHeader('Content-Length');
348 unless ( defined $len ) {
350 no warnings 'uninitialized';
351 $len = length($self->Content);
352 $self->SetHeader('Content-Length' => $len);
363 my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system)
366 my ($quoted_content, $body, $headers);
369 # TODO: Handle Multipart/Mixed (eventually fix the link in the
370 # ShowHistory web template?)
371 if (RT::I18N::IsTextualContentType($self->ContentType)) {
372 $body=$self->Content;
374 # Do we need any preformatting (wrapping, that is) of the message?
376 # Remove quoted signature.
377 $body =~ s/\n-- \n(.*)$//s;
379 # What's the longest line like?
380 foreach (split (/\n/,$body)) {
381 $max=length if ( length > $max);
385 require Text::Wrapper;
386 my $wrapper=new Text::Wrapper
389 body_start => ($max > 70*3 ? ' ' : ''),
392 $body=$wrapper->wrap($body);
397 $body = '[' . $self->TransactionObj->CreatorObj->Name() . ' - ' . $self->TransactionObj->CreatedAsString()
402 $body = "[Non-text message not quoted]\n\n";
409 return (\$body, $max);
414 Returns MIME entity built from this attachment.
421 my $entity = new MIME::Entity;
422 foreach my $header ($self->SplitHeaders) {
423 my ($h_key, $h_val) = split /:/, $header, 2;
424 $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) );
429 MIME::Body::Scalar->new( $self->OriginalContent )
438 Returns a hashref of all addresses related to this attachment.
439 The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc>
440 and C<RT-Send-Bcc>. The values are references to lists of
441 L<Email::Address> objects.
449 my $current_user_address = lc $self->CurrentUser->EmailAddress;
450 foreach my $hdr (qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc)) {
452 my $line = $self->GetHeader($hdr);
454 foreach my $AddrObj ( Email::Address->parse( $line )) {
455 my $address = $AddrObj->address;
456 $address = lc RT::User->CanonicalizeEmailAddress($address);
457 next if $current_user_address eq $address;
458 next if RT::EmailParser->IsRTAddress($address);
459 push @Addresses, $AddrObj ;
461 $data{$hdr} = \@Addresses;
468 Returns a multi-line string of the To, From, Cc, Date and Subject headers.
475 my @hdrs = $self->_SplitHeaders;
476 while (my $str = shift @hdrs) {
477 next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i;
478 $hdrs .= $str . "\n";
479 $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/);
486 Returns this object's headers as a string. This method specifically
487 removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc.
488 We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send
489 out mail. The mailing rules are separated from the ticket update code by
490 an abstraction barrier that makes it impossible to pass this data directly.
495 return join("\n", $_[0]->SplitHeaders);
498 =head2 EncodedHeaders
500 Takes encoding as argument and returns the attachment's headers as octets in encoded
503 This is not protection using quoted printable or base64 encoding.
509 my $encoding = shift || 'utf8';
510 return Encode::encode( $encoding, $self->Headers );
513 =head2 GetHeader $TAG
515 Returns the value of the header Tag as a string. This bypasses the weeding out
516 done in Headers() above.
523 foreach my $line ($self->_SplitHeaders) {
524 next unless $line =~ /^\Q$tag\E:\s+(.*)$/si;
526 #if we find the header, return its value
530 # we found no header. return an empty string
534 =head2 DelHeader $TAG
536 Delete a field from the attachment's headers.
545 foreach my $line ($self->_SplitHeaders) {
546 next if $line =~ /^\Q$tag\E:\s+(.*)$/is;
547 $newheader .= "$line\n";
549 return $self->__Set( Field => 'Headers', Value => $newheader);
552 =head2 AddHeader $TAG, $VALUE, ...
554 Add one or many fields to the attachment's headers.
561 my $newheader = $self->__Value( 'Headers' );
562 while ( my ($tag, $value) = splice @_, 0, 2 ) {
563 $value = '' unless defined $value;
565 $value =~ s/\r+\n/\n /g;
566 $newheader .= "$tag: $value\n";
568 return $self->__Set( Field => 'Headers', Value => $newheader);
571 =head2 SetHeader ( 'Tag', 'Value' )
573 Replace or add a Header to the attachment's headers.
582 foreach my $line ($self->_SplitHeaders) {
583 if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) {
584 $newheader .= "$tag: $_[0]\n";
588 $newheader .= "$line\n";
592 $newheader .= "$tag: $_[0]\n" if defined $tag;
593 $self->__Set( Field => 'Headers', Value => $newheader);
598 Returns an array of this attachment object's headers, with one header
599 per array entry. Multiple lines are folded.
601 B<Never> returns C<RT-Send-Bcc> field.
607 return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) );
612 Returns an array of this attachment object's headers, with one header
613 per array entry. multiple lines are folded.
620 my $headers = (shift || $self->SUPER::Headers());
622 for (split(/\n(?=\w|\z)/,$headers)) {
633 my $txn = $self->TransactionObj;
634 return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee;
635 return (0, $self->loc('Permission Denied'))
636 unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket');
637 return (0, $self->loc('GnuPG integration is disabled'))
638 unless RT->Config->Get('GnuPG')->{'Enable'};
639 return (0, $self->loc('Attachments encryption is disabled'))
640 unless RT->Config->Get('GnuPG')->{'AllowEncryptDataInDB'};
642 require RT::Crypt::GnuPG;
644 my $type = $self->ContentType;
645 if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) {
646 return (1, $self->loc('Already encrypted'));
647 } elsif ( $type =~ /^multipart\//i ) {
648 return (1, $self->loc('No need to encrypt'));
650 $type = qq{x-application-rt\/gpg-encrypted; original-type="$type"};
653 my $queue = $txn->TicketObj->QueueObj;
655 foreach my $address ( grep $_,
656 $queue->CorrespondAddress,
657 $queue->CommentAddress,
658 RT->Config->Get('CorrespondAddress'),
659 RT->Config->Get('CommentAddress'),
661 my %res = RT::Crypt::GnuPG::GetKeysInfo( $address, 'private' );
662 next if $res{'exit_code'} || !$res{'info'};
663 %res = RT::Crypt::GnuPG::GetKeysForEncryption( $address );
664 next if $res{'exit_code'} || !$res{'info'};
665 $encrypt_for = $address;
667 unless ( $encrypt_for ) {
668 return (0, $self->loc('No key suitable for encryption'));
671 $self->__Set( Field => 'ContentType', Value => $type );
672 $self->SetHeader( 'Content-Type' => $type );
674 my $content = $self->Content;
675 my %res = RT::Crypt::GnuPG::SignEncryptContent(
676 Content => \$content,
679 Recipients => [ $encrypt_for ],
681 if ( $res{'exit_code'} ) {
682 return (0, $self->loc('GnuPG error. Contact with administrator'));
685 my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content );
687 return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg));
689 return (1, $self->loc('Successfuly encrypted data'));
695 my $txn = $self->TransactionObj;
696 return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee;
697 return (0, $self->loc('Permission Denied'))
698 unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket');
699 return (0, $self->loc('GnuPG integration is disabled'))
700 unless RT->Config->Get('GnuPG')->{'Enable'};
702 require RT::Crypt::GnuPG;
704 my $type = $self->ContentType;
705 if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) {
706 ($type) = ($type =~ /original-type="(.*)"/i);
707 $type ||= 'application/octeat-stream';
709 return (1, $self->loc('Is not encrypted'));
711 $self->__Set( Field => 'ContentType', Value => $type );
712 $self->SetHeader( 'Content-Type' => $type );
714 my $content = $self->Content;
715 my %res = RT::Crypt::GnuPG::DecryptContent( Content => \$content, );
716 if ( $res{'exit_code'} ) {
717 return (0, $self->loc('GnuPG error. Contact with administrator'));
720 my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content );
722 return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg));
724 return (1, $self->loc('Successfuly decrypted data'));
729 Takes the name of a table column.
730 Returns its value as a string, if the user passes an ACL check
738 #if the field is public, return it.
739 if ( $self->_Accessible( $field, 'public' ) ) {
740 return ( $self->__Value( $field, @_ ) );
743 return undef unless $self->TransactionObj->CurrentUserCanSee;
744 return $self->__Value( $field, @_ );
747 # Transactions don't change. by adding this cache congif directiove,
748 # we don't lose pathalogically on long tickets.
752 'fast_update_p' => 1,
753 'cache_for_sec' => 180,