X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FAttachment_Overlay.pm;h=e2707a7cea6cdf2a2df5532cc7f42517b3734800;hb=e70abd21bab68b23488f7ef1ee2e693a3b365691;hp=7ab6d0ae96f2c109f9bb1ffb65e51f9ddc5a9875;hpb=2dfda73eeb3eae2d4f894099754794ef07d060dd;p=freeside.git diff --git a/rt/lib/RT/Attachment_Overlay.pm b/rt/lib/RT/Attachment_Overlay.pm index 7ab6d0ae9..e2707a7ce 100644 --- a/rt/lib/RT/Attachment_Overlay.pm +++ b/rt/lib/RT/Attachment_Overlay.pm @@ -1,8 +1,8 @@ # BEGIN BPS TAGGED BLOCK {{{ # # COPYRIGHT: -# -# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC +# +# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -45,10 +45,10 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} -=head1 SYNOPSIS - use RT::Attachment; +=head1 SYNOPSIS + use RT::Attachment; =head1 DESCRIPTION @@ -56,15 +56,9 @@ This module should never be instantiated directly by client code. it's an intern module which should only be instantiated through exported APIs in Ticket, Queue and other similar objects. - =head1 METHODS -=begin testing - -ok (require RT::Attachment); - -=end testing =cut @@ -74,13 +68,12 @@ package RT::Attachment; use strict; no warnings qw(redefine); +use RT::Transaction; use MIME::Base64; use MIME::QuotedPrint; - -# {{{ sub _OverlayAccessible sub _OverlayAccessible { - { + { TransactionId => { 'read'=>1, 'public'=>1, 'write' => 0 }, MessageId => { 'read'=>1, 'write' => 0 }, Parent => { 'read'=>1, 'write' => 0 }, @@ -94,32 +87,6 @@ sub _OverlayAccessible { Created => { 'read'=>1, 'auto'=>1, }, }; } -# }}} - -# {{{ sub TransactionObj - -=head2 TransactionObj - -Returns the transaction object asscoiated with this attachment. - -=cut - -sub TransactionObj { - require RT::Transaction; - my $self=shift; - unless (exists $self->{_TransactionObj}) { - $self->{_TransactionObj}=RT::Transaction->new($self->CurrentUser); - $self->{_TransactionObj}->Load($self->TransactionId); - } - unless ($self->{_TransactionObj}->Id) { - $RT::Logger->crit("Attachment ".$self->id." can't find transaction ".$self->TransactionId." which it is ostensibly part of. That's bad"); - } - return $self->{_TransactionObj}; -} - -# }}} - -# {{{ sub Create =head2 Create @@ -139,49 +106,52 @@ sub Create { Attachment => undef, @_ ); - #For ease of reference + # For ease of reference my $Attachment = $args{'Attachment'}; - #if we didn't specify a ticket, we need to bail - if ( $args{'TransactionId'} == 0 ) { - $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction\n" ); + # if we didn't specify a ticket, we need to bail + unless ( $args{'TransactionId'} ) { + $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction" ); return (0); - } - #If we possibly can, collapse it to a singlepart + # If we possibly can, collapse it to a singlepart $Attachment->make_singlepart; - #Get the subject + # Get the subject my $Subject = $Attachment->head->get( 'subject', 0 ); - defined($Subject) or $Subject = ''; - chomp($Subject); + $Subject = '' unless defined $Subject; + chomp $Subject; + utf8::decode( $Subject ) unless utf8::is_utf8( $Subject ); #Get the Message-ID my $MessageId = $Attachment->head->get( 'Message-ID', 0 ); defined($MessageId) or $MessageId = ''; chomp ($MessageId); - $MessageId =~ s/^<(.*)>$/$1/go; - + $MessageId =~ s/^<(.*?)>$/$1/o; #Get the filename my $Filename = $Attachment->head->recommended_filename; + # MIME::Head doesn't support perl strings well and can return + # octets which later will be double encoded in low-level code + my $head = $Attachment->head->as_string; + utf8::decode( $head ) unless utf8::is_utf8( $head ); + # If a message has no bodyhandle, that means that it has subparts (or appears to) # and we should act accordingly. unless ( defined $Attachment->bodyhandle ) { - - my $id = $self->SUPER::Create( + my ($id) = $self->SUPER::Create( TransactionId => $args{'TransactionId'}, - Parent => 0, + Parent => $args{'Parent'}, ContentType => $Attachment->mime_type, - Headers => $Attachment->head->as_string, + Headers => $head, MessageId => $MessageId, - Subject => $Subject + Subject => $Subject, ); - + unless ($id) { - $RT::Logger->crit("Attachment insert failed - ".$RT::Handle->dbh->errstr); + $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr); } foreach my $part ( $Attachment->parts ) { @@ -192,7 +162,7 @@ sub Create { Attachment => $part, ); unless ($id) { - $RT::Logger->crit("Attachment insert failed - ".$RT::Handle->dbh->errstr); + $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); } } return ($id); @@ -201,69 +171,115 @@ sub Create { #If it's not multipart else { - my ($ContentEncoding, $Body) = $self->_EncodeLOB( $Attachment->bodyhandle->as_string, - $Attachment->mime_type - ); + my ($ContentEncoding, $Body) = $self->_EncodeLOB( + $Attachment->bodyhandle->as_string, + $Attachment->mime_type + ); + my $id = $self->SUPER::Create( TransactionId => $args{'TransactionId'}, ContentType => $Attachment->mime_type, ContentEncoding => $ContentEncoding, Parent => $args{'Parent'}, - Headers => $Attachment->head->as_string, + Headers => $head, Subject => $Subject, Content => $Body, Filename => $Filename, MessageId => $MessageId, ); + unless ($id) { - $RT::Logger->crit("Attachment insert failed - ".$RT::Handle->dbh->errstr); + $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); } - - return ($id); + return $id; } } -# }}} - - =head2 Import Create an attachment exactly as specified in the named parameters. =cut - sub Import { my $self = shift; - my %args = ( ContentEncoding => 'none', + my %args = ( ContentEncoding => 'none', @_ ); - @_ ); + ( $args{'ContentEncoding'}, $args{'Content'} ) = + $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} ); + return ( $self->SUPER::Create(%args) ); +} - ($args{'ContentEncoding'}, $args{'Content'}) = $self->_EncodeLOB($args{'Content'}, $args{'MimeType'}); +=head2 TransactionObj - return($self->SUPER::Create(%args)); +Returns the transaction object asscoiated with this attachment. + +=cut + +sub TransactionObj { + my $self = shift; + + unless ( $self->{_TransactionObj} ) { + $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser ); + $self->{_TransactionObj}->Load( $self->TransactionId ); + } + + unless ($self->{_TransactionObj}->Id) { + $RT::Logger->crit( "Attachment ". $self->id + ." can't find transaction ". $self->TransactionId + ." which it is ostensibly part of. That's bad"); + } + return $self->{_TransactionObj}; } -# {{{ sub Content +=head2 ParentObj -=head2 Content +Returns a parent's L object if this attachment +has a parent, otherwise returns undef. -Returns the attachment's content. if it's base64 encoded, decode it -before returning it. +=cut + +sub ParentObj { + my $self = shift; + return undef unless $self->Parent; + + my $parent = RT::Attachment->new( $self->CurrentUser ); + $parent->LoadById( $self->Parent ); + return $parent; +} + +=head2 Children + +Returns an L object which is preloaded with +all attachments objects with this attachment\'s Id as their +C. =cut -sub Content { - my $self = shift; - $self->_DecodeLOB($self->ContentType, $self->ContentEncoding, $self->_Value('Content', decode_utf8 => 0)); +sub Children { + my $self = shift; + + my $kids = RT::Attachments->new( $self->CurrentUser ); + $kids->ChildrenOf( $self->Id ); + return($kids); } +=head2 Content -# }}} +Returns the attachment's content. if it's base64 encoded, decode it +before returning it. +=cut -# {{{ sub OriginalContent +sub Content { + my $self = shift; + return $self->_DecodeLOB( + $self->ContentType, + $self->ContentEncoding, + $self->_Value('Content', decode_utf8 => 0), + ); +} =head2 OriginalContent @@ -274,43 +290,37 @@ original encoding. =cut sub OriginalContent { - my $self = shift; - - return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); - - my $enc = $self->OriginalEncoding; - - my $content; - if ( $self->ContentEncoding eq 'none' || ! $self->ContentEncoding ) { - $content = $self->_Value('Content', decode_utf8 => 0); - } elsif ( $self->ContentEncoding eq 'base64' ) { - $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0)); - } elsif ( $self->ContentEncoding eq 'quoted-printable' ) { - $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0)); - } else { - return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); - } - - # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. - local $@; - Encode::_utf8_off($content); - - if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { - # If we somehow fail to do the decode, at least push out the raw bits - eval {return( Encode::decode_utf8($content))} || return ($content); - } - - eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; - if ($@) { - $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); - } - return $content; -} + my $self = shift; -# }}} + return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); + my $enc = $self->OriginalEncoding; + my $content; + if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) { + $content = $self->_Value('Content', decode_utf8 => 0); + } elsif ( $self->ContentEncoding eq 'base64' ) { + $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0)); + } elsif ( $self->ContentEncoding eq 'quoted-printable' ) { + $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0)); + } else { + return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); + } + + # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. + local $@; + Encode::_utf8_off($content); -# {{{ sub OriginalEncoding + if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { + # If we somehow fail to do the decode, at least push out the raw bits + eval { return( Encode::decode_utf8($content)) } || return ($content); + } + + eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; + if ($@) { + $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); + } + return $content; +} =head2 OriginalEncoding @@ -319,35 +329,34 @@ Returns the attachment's original encoding. =cut sub OriginalEncoding { - my $self = shift; - return $self->GetHeader('X-RT-Original-Encoding'); + my $self = shift; + return $self->GetHeader('X-RT-Original-Encoding'); } -# }}} - -# {{{ sub Children - -=head2 Children +=head2 ContentLength - Returns an RT::Attachments object which is preloaded with all Attachments objects with this Attachment\'s Id as their 'Parent' +Returns length of L in bytes. =cut -sub Children { +sub ContentLength { my $self = shift; - - my $kids = new RT::Attachments($self->CurrentUser); - $kids->ChildrenOf($self->Id); - return($kids); -} - -# }}} -# {{{ UTILITIES + return undef unless $self->TransactionObj->CurrentUserCanSee; -# {{{ sub Quote + my $len = $self->GetHeader('Content-Length'); + unless ( defined $len ) { + use bytes; + no warnings 'uninitialized'; + $len = length($self->Content); + $self->SetHeader('Content-Length' => $len); + } + return $len; +} +=head2 Quote +=cut sub Quote { my $self=shift; @@ -399,9 +408,60 @@ sub Quote { return (\$body, $max); } -# }}} -# {{{ sub NiceHeaders - pulls out only the most relevant headers +=head2 ContentAsMIME + +Returns MIME entity built from this attachment. + +=cut + +sub ContentAsMIME { + my $self = shift; + + my $entity = new MIME::Entity; + foreach my $header ($self->SplitHeaders) { + my ($h_key, $h_val) = split /:/, $header, 2; + $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) ); + } + + use MIME::Body; + $entity->bodyhandle( + MIME::Body::Scalar->new( $self->OriginalContent ) + ); + + return $entity; +} + + +=head2 Addresses + +Returns a hashref of all addresses related to this attachment. +The keys of the hash are C, C, C, C, C +and C. The values are references to lists of +L objects. + +=cut + +sub Addresses { + my $self = shift; + + my %data = (); + my $current_user_address = lc $self->CurrentUser->EmailAddress; + foreach my $hdr (qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc)) { + my @Addresses; + my $line = $self->GetHeader($hdr); + + foreach my $AddrObj ( Email::Address->parse( $line )) { + my $address = $AddrObj->address; + $address = lc RT::User->CanonicalizeEmailAddress($address); + next if $current_user_address eq $address; + next if RT::EmailParser->IsRTAddress($address); + push @Addresses, $AddrObj ; + } + $data{$hdr} = \@Addresses; + } + return \%data; +} =head2 NiceHeaders @@ -420,34 +480,37 @@ sub NiceHeaders { } return $hdrs; } -# }}} - -# {{{ sub Headers =head2 Headers Returns this object's headers as a string. This method specifically removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc. We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send -out mail. (The mailing rules are separated from the ticket update code by -an abstraction barrier that makes it impossible to pass this data directly +out mail. The mailing rules are separated from the ticket update code by +an abstraction barrier that makes it impossible to pass this data directly. =cut sub Headers { - my $self = shift; - my $hdrs=""; - my @headers = grep { !/^RT-Send-Bcc/i } $self->_SplitHeaders; - return join("\n",@headers); - + return join("\n", $_[0]->SplitHeaders); } +=head2 EncodedHeaders -# }}} +Takes encoding as argument and returns the attachment's headers as octets in encoded +using the encoding. -# {{{ sub GetHeader +This is not protection using quoted printable or base64 encoding. -=head2 GetHeader ( 'Tag') +=cut + +sub EncodedHeaders { + my $self = shift; + my $encoding = shift || 'utf8'; + return Encode::encode( $encoding, $self->Headers ); +} + +=head2 GetHeader $TAG Returns the value of the header Tag as a string. This bypasses the weeding out done in Headers() above. @@ -458,17 +521,52 @@ sub GetHeader { my $self = shift; my $tag = shift; foreach my $line ($self->_SplitHeaders) { - if ($line =~ /^\Q$tag\E:\s+(.*)$/si) { #if we find the header, return its value - return ($1); - } + next unless $line =~ /^\Q$tag\E:\s+(.*)$/si; + + #if we find the header, return its value + return ($1); } # we found no header. return an empty string return undef; } -# }}} -# {{{ sub SetHeader +=head2 DelHeader $TAG + +Delete a field from the attachment's headers. + +=cut + +sub DelHeader { + my $self = shift; + my $tag = shift; + + my $newheader = ''; + foreach my $line ($self->_SplitHeaders) { + next if $line =~ /^\Q$tag\E:\s+(.*)$/is; + $newheader .= "$line\n"; + } + return $self->__Set( Field => 'Headers', Value => $newheader); +} + +=head2 AddHeader $TAG, $VALUE, ... + +Add one or many fields to the attachment's headers. + +=cut + +sub AddHeader { + my $self = shift; + + my $newheader = $self->__Value( 'Headers' ); + while ( my ($tag, $value) = splice @_, 0, 2 ) { + $value = '' unless defined $value; + $value =~ s/\s+$//s; + $value =~ s/\r+\n/\n /g; + $newheader .= "$tag: $value\n"; + } + return $self->__Set( Field => 'Headers', Value => $newheader); +} =head2 SetHeader ( 'Tag', 'Value' ) @@ -479,8 +577,8 @@ Replace or add a Header to the attachment's headers. sub SetHeader { my $self = shift; my $tag = shift; - my $newheader = ''; + my $newheader = ''; foreach my $line ($self->_SplitHeaders) { if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) { $newheader .= "$tag: $_[0]\n"; @@ -494,80 +592,26 @@ sub SetHeader { $newheader .= "$tag: $_[0]\n" if defined $tag; $self->__Set( Field => 'Headers', Value => $newheader); } -# }}} -# {{{ sub _Value +=head2 SplitHeaders -=head2 _Value +Returns an array of this attachment object's headers, with one header +per array entry. Multiple lines are folded. -Takes the name of a table column. -Returns its value as a string, if the user passes an ACL check +B returns C field. =cut -sub _Value { - - my $self = shift; - my $field = shift; - - #if the field is public, return it. - if ( $self->_Accessible( $field, 'public' ) ) { - return ( $self->__Value( $field, @_ ) ); - } - - #If it's a comment, we need to be extra special careful - elsif ( $self->TransactionObj->Type =~ /^Comment/ ) { - if ( $self->TransactionObj->CurrentUserHasRight('ShowTicketComments') ) - { - return ( $self->__Value( $field, @_ ) ); - } - } - elsif ( $self->TransactionObj->CurrentUserHasRight('ShowTicket') ) { - return ( $self->__Value( $field, @_ ) ); - } - - #if they ain't got rights to see, don't let em - else { - return (undef); - } - +sub SplitHeaders { + my $self = shift; + return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) ); } -# }}} - =head2 _SplitHeaders Returns an array of this attachment object's headers, with one header per array entry. multiple lines are folded. -=begin testing - -my $test1 = "From: jesse"; -my @headers = RT::Attachment->_SplitHeaders($test1); -is ($#headers, 0, $test1 ); - -my $test2 = qq{From: jesse -To: bobby -Subject: foo -}; - -@headers = RT::Attachment->_SplitHeaders($test2); -is ($#headers, 2, "testing a bunch of singline multiple headers" ); - - -my $test3 = qq{From: jesse -To: bobby, - Suzie, - Sally, - Joey: bizzy, -Subject: foo -}; - -@headers = RT::Attachment->_SplitHeaders($test3); -is ($#headers, 2, "testing a bunch of singline multiple headers" ); - - -=end testing =cut @@ -583,35 +627,130 @@ sub _SplitHeaders { } -sub ContentLength { +sub Encrypt { my $self = shift; - unless ( (($self->TransactionObj->CurrentUserHasRight('ShowTicketComments')) and - ($self->TransactionObj->Type eq 'Comment') ) or - ($self->TransactionObj->CurrentUserHasRight('ShowTicket'))) { - return undef; + my $txn = $self->TransactionObj; + return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; + return (0, $self->loc('Permission Denied')) + unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); + return (0, $self->loc('GnuPG integration is disabled')) + unless RT->Config->Get('GnuPG')->{'Enable'}; + return (0, $self->loc('Attachments encryption is disabled')) + unless RT->Config->Get('GnuPG')->{'AllowEncryptDataInDB'}; + + require RT::Crypt::GnuPG; + + my $type = $self->ContentType; + if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { + return (1, $self->loc('Already encrypted')); + } elsif ( $type =~ /^multipart\//i ) { + return (1, $self->loc('No need to encrypt')); + } else { + $type = qq{x-application-rt\/gpg-encrypted; original-type="$type"}; } - if (my $len = $self->GetHeader('Content-Length')) { - return $len; + my $queue = $txn->TicketObj->QueueObj; + my $encrypt_for; + foreach my $address ( grep $_, + $queue->CorrespondAddress, + $queue->CommentAddress, + RT->Config->Get('CorrespondAddress'), + RT->Config->Get('CommentAddress'), + ) { + my %res = RT::Crypt::GnuPG::GetKeysInfo( $address, 'private' ); + next if $res{'exit_code'} || !$res{'info'}; + %res = RT::Crypt::GnuPG::GetKeysForEncryption( $address ); + next if $res{'exit_code'} || !$res{'info'}; + $encrypt_for = $address; + } + unless ( $encrypt_for ) { + return (0, $self->loc('No key suitable for encryption')); } - { - use bytes; - my $len = length($self->Content); - $self->SetHeader('Content-Length' => $len); - return $len; + $self->__Set( Field => 'ContentType', Value => $type ); + $self->SetHeader( 'Content-Type' => $type ); + + my $content = $self->Content; + my %res = RT::Crypt::GnuPG::SignEncryptContent( + Content => \$content, + Sign => 0, + Encrypt => 1, + Recipients => [ $encrypt_for ], + ); + if ( $res{'exit_code'} ) { + return (0, $self->loc('GnuPG error. Contact with administrator')); } + + my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); + unless ( $status ) { + return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg)); + } + return (1, $self->loc('Successfuly encrypted data')); } -# }}} +sub Decrypt { + my $self = shift; + + my $txn = $self->TransactionObj; + return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; + return (0, $self->loc('Permission Denied')) + unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); + return (0, $self->loc('GnuPG integration is disabled')) + unless RT->Config->Get('GnuPG')->{'Enable'}; + + require RT::Crypt::GnuPG; + + my $type = $self->ContentType; + if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { + ($type) = ($type =~ /original-type="(.*)"/i); + $type ||= 'application/octeat-stream'; + } else { + return (1, $self->loc('Is not encrypted')); + } + $self->__Set( Field => 'ContentType', Value => $type ); + $self->SetHeader( 'Content-Type' => $type ); + + my $content = $self->Content; + my %res = RT::Crypt::GnuPG::DecryptContent( Content => \$content, ); + if ( $res{'exit_code'} ) { + return (0, $self->loc('GnuPG error. Contact with administrator')); + } + + my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); + unless ( $status ) { + return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg)); + } + return (1, $self->loc('Successfuly decrypted data')); +} + +=head2 _Value + +Takes the name of a table column. +Returns its value as a string, if the user passes an ACL check + +=cut + +sub _Value { + my $self = shift; + my $field = shift; + + #if the field is public, return it. + if ( $self->_Accessible( $field, 'public' ) ) { + return ( $self->__Value( $field, @_ ) ); + } + + return undef unless $self->TransactionObj->CurrentUserCanSee; + return $self->__Value( $field, @_ ); +} -# Transactions don't change. by adding this cache congif directiove, we don't lose pathalogically on long tickets. +# Transactions don't change. by adding this cache congif directiove, +# we don't lose pathalogically on long tickets. sub _CacheConfig { { - 'cache_p' => 1, - 'fast_update_p' => 1, - 'cache_for_sec' => 180, + 'cache_p' => 1, + 'fast_update_p' => 1, + 'cache_for_sec' => 180, } }