+=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,
+ }
+}
+
+