TimeWorked-like custom fields, RT#11168
[freeside.git] / rt / lib / RT / Attachment_Overlay.pm
index d31aa75..45a5ab6 100644 (file)
@@ -1,30 +1,54 @@
-# BEGIN LICENSE BLOCK
-# 
-# Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
-# 
-# (Except where explictly superceded by other copyright notices)
-# 
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
-# Unless otherwise specified, all modifications, corrections or
-# extensions to this work which alter its source code become the
-# property of Best Practical Solutions, LLC when submitted for
-# inclusion in the work.
-# 
-# 
-# END LICENSE BLOCK
-=head1 SYNOPSIS
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
 
-  use RT::Attachment;
+=head1 SYNOPSIS
 
+    use RT::Attachment;
 
 =head1 DESCRIPTION
 
@@ -32,125 +56,116 @@ 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);
+=cut
 
-=end testing
 
-=cut
+package RT::Attachment;
 
 use strict;
 no warnings qw(redefine);
 
+use RT::Transaction;
 use MIME::Base64;
 use MIME::QuotedPrint;
 
-# {{{ sub _ClassAccessible 
-sub _ClassAccessible {
-    {
-    TransactionId   => { 'read'=>1, 'public'=>1, },
-    MessageId       => { 'read'=>1, },
-    Parent          => { 'read'=>1, },
-    ContentType     => { 'read'=>1, },
-    Subject         => { 'read'=>1, },
-    Content         => { 'read'=>1, },
-    ContentEncoding => { 'read'=>1, },
-    Headers         => { 'read'=>1, },
-    Filename        => { 'read'=>1, },
+sub _OverlayAccessible {
+  {
+    TransactionId   => { 'read'=>1, 'public'=>1, 'write' => 0 },
+    MessageId       => { 'read'=>1, 'write' => 0 },
+    Parent          => { 'read'=>1, 'write' => 0 },
+    ContentType     => { 'read'=>1, 'write' => 0 },
+    Subject         => { 'read'=>1, 'write' => 0 },
+    Content         => { 'read'=>1, 'write' => 0 },
+    ContentEncoding => { 'read'=>1, 'write' => 0 },
+    Headers         => { 'read'=>1, 'write' => 0 },
+    Filename        => { 'read'=>1, 'write' => 0 },
     Creator         => { 'read'=>1, 'auto'=>1, },
     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);
-    }
-    return $self->{_TransactionObj};
-}
-
-# }}}
-
-# {{{ sub Create 
 
 =head2 Create
 
 Create a new attachment. Takes a paramhash:
     
     'Attachment' Should be a single MIME body with optional subparts
-    'Parent' is an optional Parent RT::Attachment object
-    'TransactionId' is the mandatory id of the Transaction this attachment is associated with.;
+    'Parent' is an optional id of the parent attachment
+    'TransactionId' is the mandatory id of the transaction this attachment is associated with.;
 
 =cut
 
 sub Create {
     my $self = shift;
-    my ($id);
     my %args = ( id            => 0,
                  TransactionId => 0,
                  Parent        => 0,
                  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 filename
-    my $Filename = $Attachment->head->recommended_filename || eval {
-       ${ $Attachment->head->{mail_hdr_hash}{'Content-Disposition'}[0] }
-           =~ /^.*\bfilename="(.*)"$/ ? $1 : ''
-    };
+    #Get the Message-ID
+    my $MessageId = $Attachment->head->get( 'Message-ID', 0 );
+    defined($MessageId) or $MessageId = '';
+    chomp ($MessageId);
+    $MessageId =~ s/^<(.*?)>$/$1/o;
 
-    if ( $Attachment->parts ) {
-        $id = $self->SUPER::Create(
+    #Get the filename
+    my $Filename = $Attachment->head->recommended_filename;
+    # remove path part. 
+    $Filename =~ s!.*/!! if $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(
             TransactionId => $args{'TransactionId'},
-            Parent        => 0,
+            Parent        => $args{'Parent'},
             ContentType   => $Attachment->mime_type,
-            Headers => $Attachment->head->as_string,
-            Subject => $Subject);
+            Headers       => $head,
+            MessageId     => $MessageId,
+            Subject       => $Subject,
+        );
+
+        unless ($id) {
+            $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr);
+        }
 
         foreach my $part ( $Attachment->parts ) {
             my $SubAttachment = new RT::Attachment( $self->CurrentUser );
-            $SubAttachment->Create(
+            my ($id) = $SubAttachment->Create(
                 TransactionId => $args{'TransactionId'},
                 Parent        => $id,
                 Attachment    => $part,
-                ContentType   => $Attachment->mime_type,
-                Headers       => $Attachment->head->as_string(),
-
             );
+            unless ($id) {
+                $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
+            }
         }
         return ($id);
     }
@@ -158,94 +173,100 @@ sub Create {
     #If it's not multipart
     else {
 
-        my $ContentEncoding = 'none';
+        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         => $head,
+            Subject         => $Subject,
+            Content         => $Body,
+            Filename        => $Filename,
+            MessageId       => $MessageId,
+        );
+
+        unless ($id) {
+            $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
+        }
+        return $id;
+    }
+}
 
-        my $Body = $Attachment->bodyhandle->as_string;
+=head2 Import
 
-        #get the max attachment length from RT
-        my $MaxSize = $RT::MaxAttachmentSize;
+Create an attachment exactly as specified in the named parameters.
 
-        #if the current attachment contains nulls and the 
-        #database doesn't support embedded nulls
+=cut
 
-        if ( $RT::AlwaysUseBase64 or
-            ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
+sub Import {
+    my $self = shift;
+    my %args = ( ContentEncoding => 'none', @_ );
 
-            # set a flag telling us to mimencode the attachment
-            $ContentEncoding = 'base64';
+    ( $args{'ContentEncoding'}, $args{'Content'} ) =
+        $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} );
 
-            #cut the max attchment size by 25% (for mime-encoding overhead.
-            $RT::Logger->debug("Max size is $MaxSize\n");
-            $MaxSize = $MaxSize * 3 / 4;
-        # Some databases (postgres) can't handle non-utf8 data 
-        } elsif (    !$RT::Handle->BinarySafeBLOBs
-                  && $Attachment->mime_type !~ /text\/plain/gi
-                  && !Encode::is_utf8( $Body, 1 ) ) {
-              $ContentEncoding = 'quoted-printable';
-        }
+    return ( $self->SUPER::Create(%args) );
+}
 
-        #if the attachment is larger than the maximum size
-        if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
+=head2 TransactionObj
 
-            # if we're supposed to truncate large attachments
-            if ($RT::TruncateLongAttachments) {
+Returns the transaction object asscoiated with this attachment.
 
-                # truncate the attachment to that length.
-                $Body = substr( $Body, 0, $MaxSize );
+=cut
 
-            }
+sub TransactionObj {
+    my $self = shift;
 
-            # elsif we're supposed to drop large attachments on the floor,
-            elsif ($RT::DropLongAttachments) {
+    unless ( $self->{_TransactionObj} ) {
+        $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser );
+        $self->{_TransactionObj}->Load( $self->TransactionId );
+    }
 
-                # drop the attachment on the floor
-                $RT::Logger->info( "$self: Dropped an attachment of size " . length($Body) . "\n" . "It started: " . substr( $Body, 0, 60 ) . "\n" );
-                return (undef);
-            }
-        }
+    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};
+}
 
-        # if we need to mimencode the attachment
-        if ( $ContentEncoding eq 'base64' ) {
+=head2 ParentObj
 
-            # base64 encode the attachment
-            Encode::_utf8_off($Body);
-            $Body = MIME::Base64::encode_base64($Body);
+Returns a parent's L<RT::Attachment> object if this attachment
+has a parent, otherwise returns undef.
 
-        } elsif ($ContentEncoding eq 'quoted-printable') {
-                   Encode::_utf8_off($Body);
-            $Body = MIME::QuotedPrint::encode($Body);
-        }
+=cut
 
+sub ParentObj {
+    my $self = shift;
+    return undef unless $self->Parent;
 
-        my $id = $self->SUPER::Create( TransactionId => $args{'TransactionId'},
-                                       ContentType   => $Attachment->mime_type,
-                                       ContentEncoding => $ContentEncoding,
-                                       Parent          => $args{'Parent'},
-                                       Headers       =>  $Attachment->head->as_string, 
-                                       Subject       =>  $Subject,
-                                       Content         => $Body,
-                                       Filename => $Filename, );
-        return ($id);
-    }
+    my $parent = RT::Attachment->new( $self->CurrentUser );
+    $parent->LoadById( $self->Parent );
+    return $parent;
 }
 
-# }}}
-
+=head2 Children
 
-=head2 Import
-
-Create an attachment exactly as specified in the named parameters.
+Returns an L<RT::Attachments> object which is preloaded with
+all attachments objects with this attachment\'s Id as their
+C<Parent>.
 
 =cut
 
-
-sub Import {
+sub Children {
     my $self = shift;
-    return($self->SUPER::Create(@_));
+    
+    my $kids = RT::Attachments->new( $self->CurrentUser );
+    $kids->ChildrenOf( $self->Id );
+    return($kids);
 }
 
-# {{{ sub Content
-
 =head2 Content
 
 Returns the attachment's content. if it's base64 encoded, decode it 
@@ -254,73 +275,54 @@ before returning it.
 =cut
 
 sub Content {
-  my $self = shift;
-  my $decode_utf8 = (($self->ContentType eq 'text/plain') ? 1 : 0);
-
-  if ( $self->ContentEncoding eq 'none' || ! $self->ContentEncoding ) {
-      return $self->_Value(
-         'Content',
-         decode_utf8 => $decode_utf8,
-      );
-  } elsif ( $self->ContentEncoding eq 'base64' ) {
-      return ( $decode_utf8
-        ? Encode::decode_utf8(MIME::Base64::decode_base64($self->_Value('Content')))
-        : MIME::Base64::decode_base64($self->_Value('Content'))
-      );
-  } elsif ( $self->ContentEncoding eq 'quoted-printable' ) {
-      return ( $decode_utf8
-        ? Encode::decode_utf8(MIME::QuotedPrint::decode($self->_Value('Content')))
-        : MIME::QuotedPrint::decode($self->_Value('Content'))
-      );
-  } else {
-      return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
-  }
+    my $self = shift;
+    return $self->_DecodeLOB(
+        $self->ContentType,
+        $self->ContentEncoding,
+        $self->_Value('Content', decode_utf8 => 0),
+    );
 }
 
-
-# }}}
-
-
-# {{{ sub OriginalContent
-
 =head2 OriginalContent
 
 Returns the attachment's content as octets before RT's mangling.
-Currently, this just means restoring text/plain content back to its
+Currently, this just means restoring text content back to its
 original encoding.
 
 =cut
 
 sub OriginalContent {
-  my $self = shift;
-
-  return $self->Content unless $self->ContentType eq 'text/plain';
-  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' ) {
-      return MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0));
-  } else {
-      return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding));
-  }
-
-  # Encode::_utf8_on($content);
-  if (!$enc or $enc eq 'utf8' or $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);
-  }
-  Encode::from_to($content, 'utf8' => $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
 
@@ -329,35 +331,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');
 }
 
-# }}}
+=head2 ContentLength
 
-# {{{ sub Children
-
-=head2 Children
-
-  Returns an RT::Attachments object which is preloaded with all Attachments objects with this Attachment\'s Id as their 'Parent'
+Returns length of L</Content> 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;
@@ -369,7 +370,7 @@ sub Quote {
 
     # TODO: Handle Multipart/Mixed (eventually fix the link in the
     # ShowHistory web template?)
-    if ($self->ContentType =~ m{^(text/plain|message)}i) {
+    if (RT::I18N::IsTextualContentType($self->ContentType)) {
        $body=$self->Content;
 
        # Do we need any preformatting (wrapping, that is) of the message?
@@ -409,56 +410,114 @@ sub Quote {
 
     return (\$body, $max);
 }
-# }}}
 
-# {{{ sub NiceHeaders - pulls out only the most relevant headers
+=head2 ContentAsMIME
 
-=head2 NiceHeaders
+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 ) );
+    }
+    
+    # since we want to return original content, let's use original encoding
+    $entity->head->mime_attr(
+        "Content-Type.charset" => $self->OriginalEncoding )
+      if $self->OriginalEncoding;
+
+    use MIME::Body;
+    $entity->bodyhandle(
+        MIME::Body::Scalar->new( $self->OriginalContent )
+    );
 
-Returns the To, From, Cc, Date and Subject headers.
+    return $entity;
+}
 
-It is a known issue that this breaks if any of these headers are not
-properly unfolded.
+
+=head2 Addresses
+
+Returns a hashref of all addresses related to this attachment.
+The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc>
+and C<RT-Send-Bcc>. The values are references to lists of
+L<Email::Address> 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
+
+Returns a multi-line string of the To, From, Cc, Date and Subject headers.
 
 =cut
 
 sub NiceHeaders {
-    my $self=shift;
-    my $hdrs="";
-    for (split(/\n/,$self->Headers)) {
-           $hdrs.="$_\n" if /^(To|From|RT-Send-Cc|Cc|Date|Subject): /i
+    my $self = shift;
+    my $hdrs = "";
+    my @hdrs = $self->_SplitHeaders;
+    while (my $str = shift @hdrs) {
+           next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i;
+           $hdrs .= $str . "\n";
+           $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/);
     }
     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 seperated 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="";
-    for (split(/\n/,$self->SUPER::Headers)) {
-           $hdrs.="$_\n" unless /^(RT-Send-Bcc): /i
-    }
-    return $hdrs;
+    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.
@@ -468,18 +527,53 @@ done in Headers() above.
 sub GetHeader {
     my $self = shift;
     my $tag = shift;
-    foreach my $line (split(/\n/,$self->SUPER::Headers)) {
-        if ($line =~ /^\Q$tag\E:\s+(.*)$/i) { #if we find the header, return its value
-            return ($1);
-        }
+    foreach my $line ($self->_SplitHeaders) {
+        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' )
 
@@ -490,9 +584,9 @@ Replace or add a Header to the attachment's headers.
 sub SetHeader {
     my $self = shift;
     my $tag = shift;
-    my $newheader = '';
 
-    foreach my $line (split(/\n/,$self->SUPER::Headers)) {
+    my $newheader = '';
+    foreach my $line ($self->_SplitHeaders) {
         if (defined $tag and $line =~ /^\Q$tag\E:\s+(.*)$/i) {
            $newheader .= "$tag: $_[0]\n";
            undef $tag;
@@ -505,67 +599,166 @@ 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.
+
+B<Never> returns C<RT-Send-Bcc> field.
+
+=cut
+
+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.
 
-Takes the name of a table column.
-Returns its value as a string, if the user passes an ACL check
 
 =cut
 
-sub _Value  {
+sub _SplitHeaders {
+    my $self = shift;
+    my $headers = (shift || $self->SUPER::Headers());
+    my @headers;
+    for (split(/\n(?=\w|\z)/,$headers)) {
+        push @headers, $_;
+
+    }
+    return(@headers);
+}
+
 
+sub Encrypt {
     my $self = shift;
-    my $field = shift;
-    
-    
-    #if the field is public, return it.
-    if ($self->_Accessible($field, 'public')) {
-       #$RT::Logger->debug("Skipping ACL check for $field\n");
-       return($self->__Value($field, @_));
-       
+
+    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 it's a comment, we need to be extra special careful
-    elsif ( (($self->TransactionObj->CurrentUserHasRight('ShowTicketComments')) and
-            ($self->TransactionObj->Type eq 'Comment') )  or
-           ($self->TransactionObj->CurrentUserHasRight('ShowTicket'))) {
-               return($self->__Value($field, @_));
+
+    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'));
     }
-    #if they ain't got rights to see, don't let em
-    else {
-           return(undef);
-       }
-       
-    
-}
 
-# }}}
+    $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'));
+    }
 
-sub ContentLength {
+    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;
 
-    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'};
+
+    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 );
 
-    if (my $len = $self->GetHeader('Content-Length')) {
-       return $len;
+    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'));
     }
 
-    {
-       use bytes;
-       my $len = length($self->Content);
-       $self->SetHeader('Content-Length' => $len);
-       return $len;
+    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.
+sub _CacheConfig {
+    {
+        'cache_p'       => 1,
+        'fast_update_p' => 1,
+        'cache_for_sec' => 180,
+    }
+}
 
 1;