# BEGIN BPS TAGGED BLOCK {{{
-#
+#
# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
-# <jesse@bestpractical.com>
-#
+#
+# This software is Copyright (c) 1996-2018 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.
-#
+#
# 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/copyleft/gpl.html.
-#
-#
+# 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
# 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 }}}
-# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
-# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
-#
-# !! DO NOT EDIT THIS FILE !!
#
+# END BPS TAGGED BLOCK }}}
+
+=head1 SYNOPSIS
+
+ use RT::Attachment;
+
+=head1 DESCRIPTION
+
+This module should never be instantiated directly by client code. it's an internal
+module which should only be instantiated through exported APIs in Ticket, Queue and other
+similar objects.
+
+=head1 METHODS
+
+
+
+=cut
+
+
+package RT::Attachment;
+use base 'RT::Record';
+
+sub Table {'Attachments'}
+
+
+
use strict;
+use warnings;
+
+
+use RT::Transaction;
+use MIME::Base64;
+use MIME::QuotedPrint;
+use MIME::Body;
+use RT::Util 'mime_recommended_filename';
+use URI;
+
+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, },
+ };
+}
+=head2 Create
-=head1 NAME
+Create a new attachment. Takes a paramhash:
+
+ 'Attachment' Should be a single MIME body with optional subparts
+ 'Parent' is an optional id of the parent attachment
+ 'TransactionId' is the mandatory id of the transaction this attachment is associated with.;
-RT::Attachment
+=cut
+sub Create {
+ my $self = shift;
+ my %args = ( id => 0,
+ TransactionId => 0,
+ Parent => 0,
+ Attachment => undef,
+ @_ );
+
+ # For ease of reference
+ my $Attachment = $args{'Attachment'};
+
+ # 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
+ $Attachment->make_singlepart;
+
+ my $head = $Attachment->head;
+
+ # Get the subject
+ my $Subject = Encode::decode( 'UTF-8', $head->get( 'subject' ) );
+ $Subject = '' unless defined $Subject;
+ chomp $Subject;
+
+ #Get the Message-ID
+ my $MessageId = Encode::decode( "UTF-8", $head->get( 'Message-ID' ) );
+ defined($MessageId) or $MessageId = '';
+ chomp ($MessageId);
+ $MessageId =~ s/^<(.*?)>$/$1/o;
+
+ #Get the filename
+ my $Filename = mime_recommended_filename($Attachment);
+
+ # remove path part.
+ $Filename =~ s!.*/!! if $Filename;
+
+ my $content;
+ unless ( $head->get('Content-Length') ) {
+ my $length = 0;
+ $length = length $Attachment->bodyhandle->as_string
+ if defined $Attachment->bodyhandle;
+ $head->replace( 'Content-Length' => Encode::encode( "UTF-8", $length ) );
+ }
+ $head = $head->as_string;
+
+ # MIME::Head doesn't support perl strings well and can return
+ # octets which later will be double encoded in low-level code
+ $head = Encode::decode( 'UTF-8', $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 => $args{'Parent'},
+ ContentType => $Attachment->mime_type,
+ Headers => $head,
+ MessageId => $MessageId,
+ Subject => $Subject,
+ );
+
+ unless ($id) {
+ $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr);
+ my $txn = RT::Transaction->new($self->CurrentUser);
+ $txn->Load($args{'TransactionId'});
+ if ( $txn->id ) {
+ $txn->Object->_NewTransaction( Type => 'AttachmentError', ActivateScrips => 0, Data => $Filename );
+ }
+ return ($id);
+ }
+
+ foreach my $part ( $Attachment->parts ) {
+ my $SubAttachment = RT::Attachment->new( $self->CurrentUser );
+ my ($id) = $SubAttachment->Create(
+ TransactionId => $args{'TransactionId'},
+ Parent => $id,
+ Attachment => $part,
+ );
+ unless ($id) {
+ $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
+ return ($id);
+ }
+ }
+ return ($id);
+ }
+
+ #If it's not multipart
+ else {
+
+ my ( $encoding, $type, $note_args );
+ ( $encoding, $content, $type, $Filename, $note_args ) =
+ $self->_EncodeLOB( $Attachment->bodyhandle->as_string, $Attachment->mime_type, $Filename, );
+
+ my $id = $self->SUPER::Create(
+ TransactionId => $args{'TransactionId'},
+ ContentType => $type,
+ ContentEncoding => $encoding,
+ Parent => $args{'Parent'},
+ Headers => $head,
+ Subject => $Subject,
+ Content => $content,
+ Filename => $Filename,
+ MessageId => $MessageId,
+ );
+
+ if ($id) {
+ if ($note_args) {
+ $self->TransactionObj->Object->_NewTransaction( %$note_args );
+ }
+ }
+ else {
+ $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr);
+ my $txn = RT::Transaction->new($self->CurrentUser);
+ $txn->Load($args{'TransactionId'});
+ if ( $txn->id ) {
+ $txn->Object->_NewTransaction( Type => 'AttachmentError', ActivateScrips => 0, Data => $Filename );
+ }
+ }
+ return $id;
+ }
+}
-=head1 SYNOPSIS
+=head2 TransactionObj
-=head1 DESCRIPTION
+Returns the transaction object asscoiated with this attachment.
-=head1 METHODS
+=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};
+}
+
+=head2 ParentObj
+
+Returns a parent's L<RT::Attachment> object if this attachment
+has a parent, otherwise returns undef.
=cut
-package RT::Attachment;
-use RT::Record;
+sub ParentObj {
+ my $self = shift;
+ return undef unless $self->Parent;
+
+ my $parent = RT::Attachment->new( $self->CurrentUser );
+ $parent->LoadById( $self->Parent );
+ return $parent;
+}
+
+=head2 Closest
+
+Takes a MIME type as a string or regex. Returns an L<RT::Attachment> object
+for the nearest containing part with a matching L</ContentType>. Strings must
+match exactly and all matches are done case insensitively. Strings ending in a
+C</> must only match the first part of the MIME type. For example:
+
+ # Find the nearest multipart/* container
+ my $container = $attachment->Closest("multipart/");
+
+Returns undef if no such object is found.
+
+=cut
+
+sub Closest {
+ my $self = shift;
+ my $type = shift;
+ my $part = $self->ParentObj or return undef;
+
+ $type = qr/^\Q$type\E$/
+ unless ref $type eq "REGEX";
+
+ while (lc($part->ContentType) !~ $type) {
+ $part = $part->ParentObj or last;
+ }
+
+ return ($part and $part->id) ? $part : undef;
+}
+=head2 Children
-use vars qw( @ISA );
-@ISA= qw( RT::Record );
+Returns an L<RT::Attachments> object which is preloaded with
+all attachments objects with this attachment's Id as their
+C<Parent>.
-sub _Init {
- my $self = shift;
+=cut
- $self->Table('Attachments');
- $self->SUPER::_Init(@_);
+sub Children {
+ my $self = shift;
+
+ my $kids = RT::Attachments->new( $self->CurrentUser );
+ $kids->ChildrenOf( $self->Id );
+ return($kids);
}
+=head2 Siblings
+Returns an L<RT::Attachments> object containing all the attachments sharing
+the same immediate parent as the current object, excluding the current
+attachment itself.
+If the current attachment is a top-level part (i.e. Parent == 0) then a
+guaranteed empty L<RT::Attachments> object is returned.
+=cut
-=head2 Create PARAMHASH
+sub Siblings {
+ my $self = shift;
+ my $siblings = RT::Attachments->new( $self->CurrentUser );
+ if ($self->Parent) {
+ $siblings->ChildrenOf( $self->Parent );
+ $siblings->Limit( FIELD => 'id', OPERATOR => '!=', VALUE => $self->Id );
+ } else {
+ # Ensure emptiness
+ $siblings->Limit( SUBCLAUSE => 'empty', FIELD => 'id', VALUE => 0 );
+ }
+ return $siblings;
+}
-Create takes a hash of values and creates a row in the database:
+=head2 Content
- int(11) 'TransactionId'.
- int(11) 'Parent'.
- varchar(160) 'MessageId'.
- varchar(255) 'Subject'.
- varchar(255) 'Filename'.
- varchar(80) 'ContentType'.
- varchar(80) 'ContentEncoding'.
- longtext 'Content'.
- longtext 'Headers'.
+Returns the attachment's content. if it's base64 encoded, decode it
+before returning it.
=cut
+sub Content {
+ my $self = shift;
+ return $self->_DecodeLOB(
+ $self->GetHeader('Content-Type'), # Includes charset, unlike ->ContentType
+ $self->ContentEncoding,
+ $self->_Value('Content', decode_utf8 => 0),
+ );
+}
+=head2 OriginalContent
+Returns the attachment's content as octets before RT's mangling.
+Generally this just means restoring text content back to its
+original encoding.
-sub Create {
+If the attachment has a C<message/*> Content-Type, its children attachments
+are reconstructed and returned as a string.
+
+=cut
+
+sub OriginalContent {
my $self = shift;
- my %args = (
- TransactionId => '0',
- Parent => '0',
- MessageId => '',
- Subject => '',
- Filename => '',
- ContentType => '',
- ContentEncoding => '',
- Content => '',
- Headers => '',
-
- @_);
- $self->SUPER::Create(
- TransactionId => $args{'TransactionId'},
- Parent => $args{'Parent'},
- MessageId => $args{'MessageId'},
- Subject => $args{'Subject'},
- Filename => $args{'Filename'},
- ContentType => $args{'ContentType'},
- ContentEncoding => $args{'ContentEncoding'},
- Content => $args{'Content'},
- Headers => $args{'Headers'},
-);
+ # message/* content types represent raw messages. Since we break them
+ # apart when they come in, we'll reconstruct their child attachments when
+ # you ask for the OriginalContent of the message/ part.
+ if ($self->IsMessageContentType) {
+ # There shouldn't be more than one "subpart" to a message/* attachment
+ my $child = $self->Children->First;
+ return $self->Content unless $child and $child->id;
+ return $child->ContentAsMIME(Children => 1)->as_string;
+ }
+
+ return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType);
+
+ my $content = $self->_DecodeLOB(
+ "application/octet-stream", # Force _DecodeLOB to not decode to characters
+ $self->ContentEncoding,
+ $self->_Value('Content', decode_utf8 => 0),
+ );
+
+ my $entity = MIME::Entity->new();
+ $entity->head->add("Content-Type", $self->GetHeader("Content-Type"));
+ $entity->bodyhandle( MIME::Body::Scalar->new( $content ) );
+ my $from = RT::I18N::_FindOrGuessCharset($entity);
+ $from = 'utf-8' if not $from or not Encode::find_encoding($from);
+
+ my $to = RT::I18N::_CanonicalizeCharset(
+ $self->OriginalEncoding || 'utf-8'
+ );
+
+ local $@;
+ eval { Encode::from_to($content, $from => $to) };
+ if ($@) {
+ $RT::Logger->error("Could not convert attachment from $from to $to: ".$@);
+ }
+ return $content;
}
+=head2 OriginalEncoding
+
+Returns the attachment's original encoding.
+
+=cut
+
+sub OriginalEncoding {
+ my $self = shift;
+ return $self->GetHeader('X-RT-Original-Encoding');
+}
+
+=head2 ContentLength
+
+Returns length of L</Content> in bytes.
+
+=cut
+
+sub ContentLength {
+ my $self = shift;
+
+ return undef unless $self->TransactionObj->CurrentUserCanSee;
+
+ my $len = $self->GetHeader('Content-Length');
+ unless ( defined $len ) {
+ use bytes;
+ no warnings 'uninitialized';
+ $len = length($self->Content) || 0;
+ $self->SetHeader('Content-Length' => $len);
+ }
+ return $len;
+}
+
+=head2 FriendlyContentLength
+
+Returns L</ContentLength> in bytes, kilobytes, or megabytes as most
+appropriate. The size is suffixed with C<MiB>, C<KiB>, or C<B> and the returned
+string is localized.
+
+Returns the empty string if the L</ContentLength> is 0 or undefined.
+
+=cut
+
+sub FriendlyContentLength {
+ my $self = shift;
+ my $size = $self->ContentLength;
+ return '' unless $size;
+
+ my $res = '';
+ if ( $size > 1024*1024 ) {
+ $res = $self->loc( "[_1]MiB", int( $size / 1024 / 102.4 ) / 10 );
+ }
+ elsif ( $size > 1024 ) {
+ $res = $self->loc( "[_1]KiB", int( $size / 102.4 ) / 10 );
+ }
+ else {
+ $res = $self->loc( "[_1]B", $size );
+ }
+ return $res;
+}
+
+=head2 ContentAsMIME [Children => 1]
+
+Returns MIME entity built from this attachment.
+
+If the optional parameter C<Children> is set to a true value, the children are
+recursively added to the entity.
+
+=cut
+
+sub _EncodeHeaderToMIME {
+ my ( $self, $header_name, $header_val ) = @_;
+ if ($header_name =~ /^Content-/i) {
+ my $params = MIME::Field::ParamVal->parse_params($header_val);
+ $header_val = delete $params->{'_'};
+ foreach my $key ( sort keys %$params ) {
+ my $value = $params->{$key};
+ if ( $value =~ /[^\x00-\x7f]/ ) { # check for non-ASCII
+ $value = q{UTF-8''} . URI->new(
+ Encode::encode('UTF-8', $value)
+ );
+ $value =~ s/(["\\])/\\$1/g;
+ $header_val .= qq{; ${key}*="$value"};
+ }
+ else {
+ $header_val .= qq{; $key="$value"};
+ }
+ }
+ }
+ elsif ( $header_name =~ /^(?:Resent-)?(?:To|From|B?Cc|Sender|Reply-To)$/i ) {
+ my @addresses = RT::EmailParser->ParseEmailAddress( $header_val );
+ foreach my $address ( @addresses ) {
+ foreach my $field (qw(phrase comment)) {
+ my $v = $address->$field() or next;
+ $v = RT::Interface::Email::EncodeToMIME( String => $v );
+ $address->$field($v);
+ }
+ }
+ $header_val = join ', ', map $_->format, @addresses;
+ }
+ else {
+ $header_val = RT::Interface::Email::EncodeToMIME(
+ String => $header_val
+ );
+ }
+ return $header_val;
+}
+
+sub ContentAsMIME {
+ my $self = shift;
+ my %opts = (
+ Children => 0,
+ @_
+ );
+
+ my $entity = MIME::Entity->new();
+ foreach my $header ($self->SplitHeaders) {
+ my ($h_key, $h_val) = split /:/, $header, 2;
+ $entity->head->add(
+ $h_key, $self->_EncodeHeaderToMIME($h_key, $h_val)
+ );
+ }
+
+ if ($entity->is_multipart) {
+ if ($opts{'Children'} and not $self->IsMessageContentType) {
+ my $children = $self->Children;
+ while (my $child = $children->Next) {
+ $entity->add_part( $child->ContentAsMIME(%opts) );
+ }
+ }
+ } else {
+ # since we want to return original content, let's use original encoding
+ $entity->head->mime_attr(
+ "Content-Type.charset" => $self->OriginalEncoding )
+ if $self->OriginalEncoding;
+
+ $entity->bodyhandle(
+ MIME::Body::Scalar->new( $self->OriginalContent )
+ );
+ }
+
+ return $entity;
+}
+
+=head2 IsMessageContentType
+
+Returns a boolean indicating if the Content-Type of this attachment is a
+C<message/> subtype.
+
+=cut
+
+sub IsMessageContentType {
+ my $self = shift;
+ return $self->ContentType =~ m{^\s*message/}i ? 1 : 0;
+}
+
+=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
+
+our @ADDRESS_HEADERS = qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc);
+
+sub Addresses {
+ my $self = shift;
+
+ my %data = ();
+ my $current_user_address = lc($self->CurrentUser->EmailAddress || '');
+ foreach my $hdr (@ADDRESS_HEADERS) {
+ 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 = "";
+ 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;
+}
+
+=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.
+
+=cut
+
+sub 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.
+
+This is not protection using quoted printable or base64 encoding.
+
+=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.
+
+=cut
+
+sub GetHeader {
+ my $self = shift;
+ my $tag = shift;
+ 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;
+}
+
+=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+/i;
+ $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 = $self->_CanonicalizeHeaderValue($value);
+ $newheader .= "$tag: $value\n";
+ }
+ return $self->__Set( Field => 'Headers', Value => $newheader);
+}
+
+=head2 SetHeader ( 'Tag', 'Value' )
+
+Replace or add a Header to the attachment's headers.
+
+=cut
+
+sub SetHeader {
+ my $self = shift;
+ my $tag = shift;
+ my $value = $self->_CanonicalizeHeaderValue(shift);
+
+ my $replaced = 0;
+ my $newheader = '';
+ foreach my $line ( $self->_SplitHeaders ) {
+ if ( $line =~ /^\Q$tag\E:\s+/i ) {
+ # replace first instance, skip all the rest
+ unless ($replaced) {
+ $newheader .= "$tag: $value\n";
+ $replaced = 1;
+ }
+ } else {
+ $newheader .= "$line\n";
+ }
+ }
+
+ $newheader .= "$tag: $value\n" unless $replaced;
+ $self->__Set( Field => 'Headers', Value => $newheader);
+}
+
+sub _CanonicalizeHeaderValue {
+ my $self = shift;
+ my $value = shift;
+
+ $value = '' unless defined $value;
+ $value =~ s/\s+$//s;
+ $value =~ s/\r*\n/\n /g;
+
+ return $value;
+}
+
+=head2 SplitHeaders
+
+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.
+
+
+=cut
+
+sub _SplitHeaders {
+ my $self = shift;
+ my $headers = (shift || $self->_Value('Headers'));
+ my @headers;
+ # XXX TODO: splitting on \n\w is _wrong_ as it treats \n[ as a valid
+ # continuation, which it isn't. The correct split pattern, per RFC 2822,
+ # is /\n(?=[^ \t]|\z)/. That is, only "\n " or "\n\t" is a valid
+ # continuation. Older values of X-RT-GnuPG-Status contain invalid
+ # continuations and rely on this bogus split pattern, however, so it is
+ # left as-is for now.
+ for (split(/\n(?=\w|\z)/,$headers)) {
+ push @headers, $_;
+
+ }
+ return(@headers);
+}
+
+
+sub Encrypt {
+ 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('Cryptography is disabled'))
+ unless RT->Config->Get('Crypt')->{'Enable'};
+ return (0, $self->loc('Attachments encryption is disabled'))
+ unless RT->Config->Get('Crypt')->{'AllowEncryptDataInDB'};
+
+ my $type = $self->ContentType;
+ if ( $type =~ /^x-application-rt\/[^-]+-encrypted/i ) {
+ return (1, $self->loc('Already encrypted'));
+ } elsif ( $type =~ /^multipart\//i ) {
+ return (1, $self->loc('No need to encrypt'));
+ }
+
+ 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->GetKeysInfo( Key => $address, Type => 'private' );
+ next if $res{'exit_code'} || !$res{'info'};
+ %res = RT::Crypt->GetKeysForEncryption( $address );
+ next if $res{'exit_code'} || !$res{'info'};
+ $encrypt_for = $address;
+ }
+ unless ( $encrypt_for ) {
+ return (0, $self->loc('No key suitable for encryption'));
+ }
+
+ my $content = $self->Content;
+ my %res = RT::Crypt->SignEncryptContent(
+ Content => \$content,
+ Sign => 0,
+ Encrypt => 1,
+ Recipients => [ $encrypt_for ],
+ );
+ if ( $res{'exit_code'} ) {
+ return (0, $self->loc('Encryption error; contact the 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));
+ }
+
+ $type = qq{x-application-rt\/$res{'Protocol'}-encrypted; original-type="$type"};
+ $self->__Set( Field => 'ContentType', Value => $type );
+ $self->SetHeader( 'Content-Type' => $type );
+
+ 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('Cryptography is disabled'))
+ unless RT->Config->Get('Crypt')->{'Enable'};
+
+ my $type = $self->ContentType;
+ my $protocol;
+ if ( $type =~ /^x-application-rt\/([^-]+)-encrypted/i ) {
+ $protocol = $1;
+ $protocol =~ s/gpg/gnupg/; # backwards compatibility
+ ($type) = ($type =~ /original-type="(.*)"/i);
+ $type ||= 'application/octet-stream';
+ } else {
+ return (1, $self->loc('Is not encrypted'));
+ }
+
+ my $queue = $txn->TicketObj->QueueObj;
+ my @addresses =
+ $queue->CorrespondAddress,
+ $queue->CommentAddress,
+ RT->Config->Get('CorrespondAddress'),
+ RT->Config->Get('CommentAddress')
+ ;
+
+ my $content = $self->Content;
+ my %res = RT::Crypt->DecryptContent(
+ Protocol => $protocol,
+ Content => \$content,
+ Recipients => \@addresses,
+ );
+ if ( $res{'exit_code'} ) {
+ return (0, $self->loc('Decryption error; contact the 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));
+ }
+ $self->__Set( Field => 'ContentType', Value => $type );
+ $self->SetHeader( 'Content-Type' => $type );
+
+ 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, @_ );
+}
+
+# Attachments don't change; by adding this cache config directive,
+# we don't lose pathalogically on long tickets.
+sub _CacheConfig {
+ {
+ 'cache_for_sec' => 180,
+ }
+}
+
+
=head2 id
-Returns the current value of id.
+Returns the current value of id.
(In the database, id is stored as int(11).)
=head2 TransactionId
-Returns the current value of TransactionId.
+Returns the current value of TransactionId.
(In the database, TransactionId is stored as int(11).)
=head2 SetTransactionId VALUE
-Set TransactionId to VALUE.
+Set TransactionId to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, TransactionId will be stored as a int(11).)
=head2 Parent
-Returns the current value of Parent.
+Returns the current value of Parent.
(In the database, Parent is stored as int(11).)
=head2 SetParent VALUE
-Set Parent to VALUE.
+Set Parent to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, Parent will be stored as a int(11).)
=head2 MessageId
-Returns the current value of MessageId.
+Returns the current value of MessageId.
(In the database, MessageId is stored as varchar(160).)
=head2 SetMessageId VALUE
-Set MessageId to VALUE.
+Set MessageId to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, MessageId will be stored as a varchar(160).)
=head2 Subject
-Returns the current value of Subject.
+Returns the current value of Subject.
(In the database, Subject is stored as varchar(255).)
=head2 SetSubject VALUE
-Set Subject to VALUE.
+Set Subject to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, Subject will be stored as a varchar(255).)
=head2 Filename
-Returns the current value of Filename.
+Returns the current value of Filename.
(In the database, Filename is stored as varchar(255).)
=head2 SetFilename VALUE
-Set Filename to VALUE.
+Set Filename to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, Filename will be stored as a varchar(255).)
=head2 ContentType
-Returns the current value of ContentType.
+Returns the current value of ContentType.
(In the database, ContentType is stored as varchar(80).)
=head2 SetContentType VALUE
-Set ContentType to VALUE.
+Set ContentType to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, ContentType will be stored as a varchar(80).)
=head2 ContentEncoding
-Returns the current value of ContentEncoding.
+Returns the current value of ContentEncoding.
(In the database, ContentEncoding is stored as varchar(80).)
=head2 SetContentEncoding VALUE
-Set ContentEncoding to VALUE.
+Set ContentEncoding to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, ContentEncoding will be stored as a varchar(80).)
=head2 Content
-Returns the current value of Content.
-(In the database, Content is stored as longtext.)
+Returns the current value of Content.
+(In the database, Content is stored as longblob.)
=head2 SetContent VALUE
-Set Content to VALUE.
+Set Content to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Content will be stored as a longtext.)
+(In the database, Content will be stored as a longblob.)
=cut
=head2 Headers
-Returns the current value of Headers.
+Returns the current value of Headers.
(In the database, Headers is stored as longtext.)
=head2 SetHeaders VALUE
-Set Headers to VALUE.
+Set Headers to VALUE.
Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
(In the database, Headers will be stored as a longtext.)
=head2 Creator
-Returns the current value of Creator.
+Returns the current value of Creator.
(In the database, Creator is stored as int(11).)
=head2 Created
-Returns the current value of Created.
+Returns the current value of Created.
(In the database, Created is stored as datetime.)
sub _CoreAccessible {
{
-
+
id =>
- {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
- TransactionId =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Parent =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- MessageId =>
- {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''},
- Subject =>
- {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
- Filename =>
- {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
- ContentType =>
- {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
- ContentEncoding =>
- {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
- Content =>
- {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''},
- Headers =>
- {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''},
- Creator =>
- {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Created =>
- {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
+ {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
+ TransactionId =>
+ {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
+ Parent =>
+ {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
+ MessageId =>
+ {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''},
+ Subject =>
+ {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
+ Filename =>
+ {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
+ ContentType =>
+ {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
+ ContentEncoding =>
+ {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''},
+ Content =>
+ {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longblob', default => ''},
+ Headers =>
+ {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''},
+ Creator =>
+ {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
+ Created =>
+ {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
}
};
+sub FindDependencies {
+ my $self = shift;
+ my ($walker, $deps) = @_;
- eval "require RT::Attachment_Overlay";
- if ($@ && $@ !~ qr{^Can't locate RT/Attachment_Overlay.pm}) {
- die $@;
- };
-
- eval "require RT::Attachment_Vendor";
- if ($@ && $@ !~ qr{^Can't locate RT/Attachment_Vendor.pm}) {
- die $@;
- };
-
- eval "require RT::Attachment_Local";
- if ($@ && $@ !~ qr{^Can't locate RT/Attachment_Local.pm}) {
- die $@;
- };
-
-
-
-
-=head1 SEE ALSO
-
-This class allows "overlay" methods to be placed
-into the following files _Overlay is for a System overlay by the original author,
-_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
-
-These overlay files can contain new subs or subs to replace existing subs in this module.
-
-Each of these files should begin with the line
-
- no warnings qw(redefine);
-
-so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
-
-RT::Attachment_Overlay, RT::Attachment_Vendor, RT::Attachment_Local
+ $self->SUPER::FindDependencies($walker, $deps);
+ $deps->Add( out => $self->TransactionObj );
+}
-=cut
+sub __DependsOn {
+ my $self = shift;
+ my %args = (
+ Shredder => undef,
+ Dependencies => undef,
+ @_,
+ );
+ my $deps = $args{'Dependencies'};
+ my $list = [];
+
+ # Nested attachments
+ my $objs = RT::Attachments->new( $self->CurrentUser );
+ $objs->Limit(
+ FIELD => 'Parent',
+ OPERATOR => '=',
+ VALUE => $self->Id
+ );
+ $objs->Limit(
+ FIELD => 'id',
+ OPERATOR => '!=',
+ VALUE => $self->Id
+ );
+ push( @$list, $objs );
+
+ $deps->_PushDependencies(
+ BaseObject => $self,
+ Flags => RT::Shredder::Constants::DEPENDS_ON,
+ TargetObjects => $list,
+ Shredder => $args{'Shredder'}
+ );
+ return $self->SUPER::__DependsOn( %args );
+}
+RT::Base->_ImportOverlays();
1;
projects / freeside.git / blobdiff