]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
403d7b0b | 5 | # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@bestpractical.com> |
7 | # | |
8 | # (Except where explicitly superseded by other copyright notices) | |
9 | # | |
10 | # | |
11 | # LICENSE: | |
12 | # | |
13 | # This work is made available to you under the terms of Version 2 of | |
14 | # the GNU General Public License. A copy of that license should have | |
15 | # been provided with this software, but in any event can be snarfed | |
16 | # from www.gnu.org. | |
17 | # | |
18 | # This work is distributed in the hope that it will be useful, but | |
19 | # WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 | # General Public License for more details. | |
22 | # | |
23 | # You should have received a copy of the GNU General Public License | |
24 | # along with this program; if not, write to the Free Software | |
25 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
26 | # 02110-1301 or visit their web page on the internet at | |
27 | # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. | |
28 | # | |
29 | # | |
30 | # CONTRIBUTION SUBMISSION POLICY: | |
31 | # | |
32 | # (The following paragraph is not intended to limit the rights granted | |
33 | # to you to modify and distribute this software under the terms of | |
34 | # the GNU General Public License and is only of importance to you if | |
35 | # you choose to contribute your changes and enhancements to the | |
36 | # community by submitting them to Best Practical Solutions, LLC.) | |
37 | # | |
38 | # By intentionally submitting any modifications, corrections or | |
39 | # derivatives to this work, or any other work intended for use with | |
40 | # Request Tracker, to Best Practical Solutions, LLC, you confirm that | |
41 | # you are the copyright holder for those contributions and you grant | |
42 | # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, | |
43 | # royalty-free, perpetual, license to use, copy, create derivative | |
44 | # works based on those contributions, and sublicense and distribute | |
45 | # those contributions and any derivatives thereof. | |
46 | # | |
47 | # END BPS TAGGED BLOCK }}} | |
48 | ||
49 | =head1 SYNOPSIS | |
50 | ||
51 | use RT::Attachment; | |
52 | ||
53 | =head1 DESCRIPTION | |
54 | ||
55 | This module should never be instantiated directly by client code. it's an internal | |
56 | module which should only be instantiated through exported APIs in Ticket, Queue and other | |
57 | similar objects. | |
58 | ||
59 | =head1 METHODS | |
60 | ||
61 | ||
62 | ||
63 | =cut | |
64 | ||
65 | ||
66 | package RT::Attachment; | |
67 | use base 'RT::Record'; | |
68 | ||
69 | sub Table {'Attachments'} | |
70 | ||
71 | ||
72 | ||
73 | ||
74 | use strict; | |
75 | use warnings; | |
76 | ||
77 | ||
78 | use RT::Transaction; | |
79 | use MIME::Base64; | |
80 | use MIME::QuotedPrint; | |
81 | use MIME::Body; | |
82 | use RT::Util 'mime_recommended_filename'; | |
83 | ||
84 | sub _OverlayAccessible { | |
85 | { | |
86 | TransactionId => { 'read'=>1, 'public'=>1, 'write' => 0 }, | |
87 | MessageId => { 'read'=>1, 'write' => 0 }, | |
88 | Parent => { 'read'=>1, 'write' => 0 }, | |
89 | ContentType => { 'read'=>1, 'write' => 0 }, | |
90 | Subject => { 'read'=>1, 'write' => 0 }, | |
91 | Content => { 'read'=>1, 'write' => 0 }, | |
92 | ContentEncoding => { 'read'=>1, 'write' => 0 }, | |
93 | Headers => { 'read'=>1, 'write' => 0 }, | |
94 | Filename => { 'read'=>1, 'write' => 0 }, | |
95 | Creator => { 'read'=>1, 'auto'=>1, }, | |
96 | Created => { 'read'=>1, 'auto'=>1, }, | |
97 | }; | |
98 | } | |
99 | ||
100 | =head2 Create | |
101 | ||
102 | Create a new attachment. Takes a paramhash: | |
103 | ||
104 | 'Attachment' Should be a single MIME body with optional subparts | |
105 | 'Parent' is an optional id of the parent attachment | |
106 | 'TransactionId' is the mandatory id of the transaction this attachment is associated with.; | |
107 | ||
108 | =cut | |
109 | ||
110 | sub Create { | |
111 | my $self = shift; | |
112 | my %args = ( id => 0, | |
113 | TransactionId => 0, | |
114 | Parent => 0, | |
115 | Attachment => undef, | |
116 | @_ ); | |
117 | ||
118 | # For ease of reference | |
119 | my $Attachment = $args{'Attachment'}; | |
120 | ||
121 | # if we didn't specify a ticket, we need to bail | |
122 | unless ( $args{'TransactionId'} ) { | |
123 | $RT::Logger->crit( "RT::Attachment->Create couldn't, as you didn't specify a transaction" ); | |
124 | return (0); | |
125 | } | |
126 | ||
127 | # If we possibly can, collapse it to a singlepart | |
128 | $Attachment->make_singlepart; | |
129 | ||
130 | # Get the subject | |
131 | my $Subject = $Attachment->head->get( 'subject', 0 ); | |
132 | $Subject = '' unless defined $Subject; | |
133 | chomp $Subject; | |
134 | utf8::decode( $Subject ) unless utf8::is_utf8( $Subject ); | |
135 | ||
136 | #Get the Message-ID | |
137 | my $MessageId = $Attachment->head->get( 'Message-ID', 0 ); | |
138 | defined($MessageId) or $MessageId = ''; | |
139 | chomp ($MessageId); | |
140 | $MessageId =~ s/^<(.*?)>$/$1/o; | |
141 | ||
142 | #Get the filename | |
143 | ||
144 | my $Filename = mime_recommended_filename($Attachment); | |
145 | ||
146 | # remove path part. | |
147 | $Filename =~ s!.*/!! if $Filename; | |
148 | ||
149 | # MIME::Head doesn't support perl strings well and can return | |
150 | # octets which later will be double encoded in low-level code | |
151 | my $head = $Attachment->head->as_string; | |
152 | utf8::decode( $head ) unless utf8::is_utf8( $head ); | |
153 | ||
154 | # If a message has no bodyhandle, that means that it has subparts (or appears to) | |
155 | # and we should act accordingly. | |
156 | unless ( defined $Attachment->bodyhandle ) { | |
157 | my ($id) = $self->SUPER::Create( | |
158 | TransactionId => $args{'TransactionId'}, | |
159 | Parent => $args{'Parent'}, | |
160 | ContentType => $Attachment->mime_type, | |
161 | Headers => $head, | |
162 | MessageId => $MessageId, | |
163 | Subject => $Subject, | |
164 | ); | |
165 | ||
166 | unless ($id) { | |
167 | $RT::Logger->crit("Attachment insert failed - ". $RT::Handle->dbh->errstr); | |
168 | } | |
169 | ||
170 | foreach my $part ( $Attachment->parts ) { | |
171 | my $SubAttachment = RT::Attachment->new( $self->CurrentUser ); | |
172 | my ($id) = $SubAttachment->Create( | |
173 | TransactionId => $args{'TransactionId'}, | |
174 | Parent => $id, | |
175 | Attachment => $part, | |
176 | ); | |
177 | unless ($id) { | |
178 | $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); | |
179 | } | |
180 | } | |
181 | return ($id); | |
182 | } | |
183 | ||
184 | #If it's not multipart | |
185 | else { | |
186 | ||
187 | my ($ContentEncoding, $Body, $ContentType, $Filename) = $self->_EncodeLOB( | |
188 | $Attachment->bodyhandle->as_string, | |
189 | $Attachment->mime_type, | |
190 | $Filename | |
191 | ); | |
192 | ||
193 | my $id = $self->SUPER::Create( | |
194 | TransactionId => $args{'TransactionId'}, | |
195 | ContentType => $ContentType, | |
196 | ContentEncoding => $ContentEncoding, | |
197 | Parent => $args{'Parent'}, | |
198 | Headers => $head, | |
199 | Subject => $Subject, | |
200 | Content => $Body, | |
201 | Filename => $Filename, | |
202 | MessageId => $MessageId, | |
203 | ); | |
204 | ||
205 | unless ($id) { | |
206 | $RT::Logger->crit("Attachment insert failed: ". $RT::Handle->dbh->errstr); | |
207 | } | |
208 | return $id; | |
209 | } | |
210 | } | |
211 | ||
212 | =head2 Import | |
213 | ||
214 | Create an attachment exactly as specified in the named parameters. | |
215 | ||
216 | =cut | |
217 | ||
218 | sub Import { | |
219 | my $self = shift; | |
220 | my %args = ( ContentEncoding => 'none', @_ ); | |
221 | ||
222 | ( $args{'ContentEncoding'}, $args{'Content'} ) = | |
223 | $self->_EncodeLOB( $args{'Content'}, $args{'MimeType'} ); | |
224 | ||
225 | return ( $self->SUPER::Create(%args) ); | |
226 | } | |
227 | ||
228 | =head2 TransactionObj | |
229 | ||
230 | Returns the transaction object asscoiated with this attachment. | |
231 | ||
232 | =cut | |
233 | ||
234 | sub TransactionObj { | |
235 | my $self = shift; | |
236 | ||
237 | unless ( $self->{_TransactionObj} ) { | |
238 | $self->{_TransactionObj} = RT::Transaction->new( $self->CurrentUser ); | |
239 | $self->{_TransactionObj}->Load( $self->TransactionId ); | |
240 | } | |
241 | ||
242 | unless ($self->{_TransactionObj}->Id) { | |
243 | $RT::Logger->crit( "Attachment ". $self->id | |
244 | ." can't find transaction ". $self->TransactionId | |
245 | ." which it is ostensibly part of. That's bad"); | |
246 | } | |
247 | return $self->{_TransactionObj}; | |
248 | } | |
249 | ||
250 | =head2 ParentObj | |
251 | ||
252 | Returns a parent's L<RT::Attachment> object if this attachment | |
253 | has a parent, otherwise returns undef. | |
254 | ||
255 | =cut | |
256 | ||
257 | sub ParentObj { | |
258 | my $self = shift; | |
259 | return undef unless $self->Parent; | |
260 | ||
261 | my $parent = RT::Attachment->new( $self->CurrentUser ); | |
262 | $parent->LoadById( $self->Parent ); | |
263 | return $parent; | |
264 | } | |
265 | ||
266 | =head2 Children | |
267 | ||
268 | Returns an L<RT::Attachments> object which is preloaded with | |
403d7b0b | 269 | all attachments objects with this attachment's Id as their |
84fb5b46 MKG |
270 | C<Parent>. |
271 | ||
272 | =cut | |
273 | ||
274 | sub Children { | |
275 | my $self = shift; | |
276 | ||
277 | my $kids = RT::Attachments->new( $self->CurrentUser ); | |
278 | $kids->ChildrenOf( $self->Id ); | |
279 | return($kids); | |
280 | } | |
281 | ||
282 | =head2 Content | |
283 | ||
284 | Returns the attachment's content. if it's base64 encoded, decode it | |
285 | before returning it. | |
286 | ||
287 | =cut | |
288 | ||
289 | sub Content { | |
290 | my $self = shift; | |
291 | return $self->_DecodeLOB( | |
292 | $self->ContentType, | |
293 | $self->ContentEncoding, | |
294 | $self->_Value('Content', decode_utf8 => 0), | |
295 | ); | |
296 | } | |
297 | ||
298 | =head2 OriginalContent | |
299 | ||
300 | Returns the attachment's content as octets before RT's mangling. | |
301 | Generally this just means restoring text content back to its | |
302 | original encoding. | |
303 | ||
304 | If the attachment has a C<message/*> Content-Type, its children attachments | |
305 | are reconstructed and returned as a string. | |
306 | ||
307 | =cut | |
308 | ||
309 | sub OriginalContent { | |
310 | my $self = shift; | |
311 | ||
312 | # message/* content types represent raw messages. Since we break them | |
313 | # apart when they come in, we'll reconstruct their child attachments when | |
314 | # you ask for the OriginalContent of the message/ part. | |
315 | if ($self->IsMessageContentType) { | |
316 | # There shouldn't be more than one "subpart" to a message/* attachment | |
317 | my $child = $self->Children->First; | |
318 | return $self->Content unless $child and $child->id; | |
319 | return $child->ContentAsMIME(Children => 1)->as_string; | |
320 | } | |
321 | ||
322 | return $self->Content unless RT::I18N::IsTextualContentType($self->ContentType); | |
323 | my $enc = $self->OriginalEncoding; | |
324 | ||
325 | my $content; | |
326 | if ( !$self->ContentEncoding || $self->ContentEncoding eq 'none' ) { | |
327 | $content = $self->_Value('Content', decode_utf8 => 0); | |
328 | } elsif ( $self->ContentEncoding eq 'base64' ) { | |
329 | $content = MIME::Base64::decode_base64($self->_Value('Content', decode_utf8 => 0)); | |
330 | } elsif ( $self->ContentEncoding eq 'quoted-printable' ) { | |
331 | $content = MIME::QuotedPrint::decode($self->_Value('Content', decode_utf8 => 0)); | |
332 | } else { | |
333 | return( $self->loc("Unknown ContentEncoding [_1]", $self->ContentEncoding)); | |
334 | } | |
335 | ||
336 | # Turn *off* the SvUTF8 bits here so decode_utf8 and from_to below can work. | |
337 | local $@; | |
338 | Encode::_utf8_off($content); | |
339 | ||
340 | if (!$enc || $enc eq '' || $enc eq 'utf8' || $enc eq 'utf-8') { | |
341 | # If we somehow fail to do the decode, at least push out the raw bits | |
342 | eval { return( Encode::decode_utf8($content)) } || return ($content); | |
343 | } | |
344 | ||
345 | eval { Encode::from_to($content, 'utf8' => $enc) } if $enc; | |
346 | if ($@) { | |
347 | $RT::Logger->error("Could not convert attachment from assumed utf8 to '$enc' :".$@); | |
348 | } | |
349 | return $content; | |
350 | } | |
351 | ||
352 | =head2 OriginalEncoding | |
353 | ||
354 | Returns the attachment's original encoding. | |
355 | ||
356 | =cut | |
357 | ||
358 | sub OriginalEncoding { | |
359 | my $self = shift; | |
360 | return $self->GetHeader('X-RT-Original-Encoding'); | |
361 | } | |
362 | ||
363 | =head2 ContentLength | |
364 | ||
365 | Returns length of L</Content> in bytes. | |
366 | ||
367 | =cut | |
368 | ||
369 | sub ContentLength { | |
370 | my $self = shift; | |
371 | ||
372 | return undef unless $self->TransactionObj->CurrentUserCanSee; | |
373 | ||
374 | my $len = $self->GetHeader('Content-Length'); | |
375 | unless ( defined $len ) { | |
376 | use bytes; | |
377 | no warnings 'uninitialized'; | |
378 | $len = length($self->Content) || 0; | |
379 | $self->SetHeader('Content-Length' => $len); | |
380 | } | |
381 | return $len; | |
382 | } | |
383 | ||
384 | =head2 Quote | |
385 | ||
386 | =cut | |
387 | ||
388 | sub Quote { | |
389 | my $self=shift; | |
390 | my %args=(Reply=>undef, # Prefilled reply (i.e. from the KB/FAQ system) | |
391 | @_); | |
392 | ||
393 | my ($quoted_content, $body, $headers); | |
394 | my $max=0; | |
395 | ||
396 | # TODO: Handle Multipart/Mixed (eventually fix the link in the | |
397 | # ShowHistory web template?) | |
398 | if (RT::I18N::IsTextualContentType($self->ContentType)) { | |
399 | $body=$self->Content; | |
400 | ||
401 | # Do we need any preformatting (wrapping, that is) of the message? | |
402 | ||
403 | # Remove quoted signature. | |
404 | $body =~ s/\n-- \n(.*)$//s; | |
405 | ||
406 | # What's the longest line like? | |
407 | foreach (split (/\n/,$body)) { | |
408 | $max=length if ( length > $max); | |
409 | } | |
410 | ||
411 | if ($max>76) { | |
412 | require Text::Wrapper; | |
413 | my $wrapper = Text::Wrapper->new | |
414 | ( | |
415 | columns => 70, | |
416 | body_start => ($max > 70*3 ? ' ' : ''), | |
417 | par_start => '' | |
418 | ); | |
419 | $body=$wrapper->wrap($body); | |
420 | } | |
421 | ||
422 | $body =~ s/^/> /gm; | |
423 | ||
424 | $body = '[' . $self->TransactionObj->CreatorObj->Name() . ' - ' . $self->TransactionObj->CreatedAsString() | |
425 | . "]:\n\n" | |
426 | . $body . "\n\n"; | |
427 | ||
428 | } else { | |
429 | $body = "[Non-text message not quoted]\n\n"; | |
430 | } | |
431 | ||
432 | $max=60 if $max<60; | |
433 | $max=70 if $max>78; | |
434 | $max+=2; | |
435 | ||
436 | return (\$body, $max); | |
437 | } | |
438 | ||
439 | =head2 ContentAsMIME [Children => 1] | |
440 | ||
441 | Returns MIME entity built from this attachment. | |
442 | ||
443 | If the optional parameter C<Children> is set to a true value, the children are | |
444 | recursively added to the entity. | |
445 | ||
446 | =cut | |
447 | ||
448 | sub ContentAsMIME { | |
449 | my $self = shift; | |
450 | my %opts = ( | |
451 | Children => 0, | |
452 | @_ | |
453 | ); | |
454 | ||
455 | my $entity = MIME::Entity->new(); | |
456 | foreach my $header ($self->SplitHeaders) { | |
457 | my ($h_key, $h_val) = split /:/, $header, 2; | |
458 | $entity->head->add( $h_key, RT::Interface::Email::EncodeToMIME( String => $h_val ) ); | |
459 | } | |
460 | ||
461 | # since we want to return original content, let's use original encoding | |
462 | $entity->head->mime_attr( | |
463 | "Content-Type.charset" => $self->OriginalEncoding ) | |
464 | if $self->OriginalEncoding; | |
465 | ||
466 | $entity->bodyhandle( | |
467 | MIME::Body::Scalar->new( $self->OriginalContent ) | |
468 | ); | |
469 | ||
470 | if ($opts{'Children'} and not $self->IsMessageContentType) { | |
471 | my $children = $self->Children; | |
472 | while (my $child = $children->Next) { | |
473 | $entity->make_multipart unless $entity->is_multipart; | |
474 | $entity->add_part( $child->ContentAsMIME(%opts) ); | |
475 | } | |
476 | } | |
477 | ||
478 | return $entity; | |
479 | } | |
480 | ||
481 | =head2 IsMessageContentType | |
482 | ||
483 | Returns a boolean indicating if the Content-Type of this attachment is a | |
484 | C<message/> subtype. | |
485 | ||
486 | =cut | |
487 | ||
488 | sub IsMessageContentType { | |
489 | my $self = shift; | |
490 | return $self->ContentType =~ m{^\s*message/}i ? 1 : 0; | |
491 | } | |
492 | ||
493 | =head2 Addresses | |
494 | ||
495 | Returns a hashref of all addresses related to this attachment. | |
496 | The keys of the hash are C<From>, C<To>, C<Cc>, C<Bcc>, C<RT-Send-Cc> | |
497 | and C<RT-Send-Bcc>. The values are references to lists of | |
498 | L<Email::Address> objects. | |
499 | ||
500 | =cut | |
501 | ||
c36a7e1d MKG |
502 | our @ADDRESS_HEADERS = qw(From To Cc Bcc RT-Send-Cc RT-Send-Bcc); |
503 | ||
84fb5b46 MKG |
504 | sub Addresses { |
505 | my $self = shift; | |
506 | ||
507 | my %data = (); | |
508 | my $current_user_address = lc $self->CurrentUser->EmailAddress; | |
c36a7e1d | 509 | foreach my $hdr (@ADDRESS_HEADERS) { |
84fb5b46 MKG |
510 | my @Addresses; |
511 | my $line = $self->GetHeader($hdr); | |
512 | ||
513 | foreach my $AddrObj ( Email::Address->parse( $line )) { | |
514 | my $address = $AddrObj->address; | |
515 | $address = lc RT::User->CanonicalizeEmailAddress($address); | |
516 | next if $current_user_address eq $address; | |
517 | next if RT::EmailParser->IsRTAddress($address); | |
518 | push @Addresses, $AddrObj ; | |
519 | } | |
520 | $data{$hdr} = \@Addresses; | |
521 | } | |
522 | return \%data; | |
523 | } | |
524 | ||
525 | =head2 NiceHeaders | |
526 | ||
527 | Returns a multi-line string of the To, From, Cc, Date and Subject headers. | |
528 | ||
529 | =cut | |
530 | ||
531 | sub NiceHeaders { | |
532 | my $self = shift; | |
533 | my $hdrs = ""; | |
534 | my @hdrs = $self->_SplitHeaders; | |
535 | while (my $str = shift @hdrs) { | |
536 | next unless $str =~ /^(To|From|RT-Send-Cc|Cc|Bcc|Date|Subject):/i; | |
537 | $hdrs .= $str . "\n"; | |
538 | $hdrs .= shift( @hdrs ) . "\n" while ($hdrs[0] =~ /^[ \t]+/); | |
539 | } | |
540 | return $hdrs; | |
541 | } | |
542 | ||
543 | =head2 Headers | |
544 | ||
545 | Returns this object's headers as a string. This method specifically | |
546 | removes the RT-Send-Bcc: header, so as to never reveal to whom RT sent a Bcc. | |
547 | We need to record the RT-Send-Cc and RT-Send-Bcc values so that we can actually send | |
548 | out mail. The mailing rules are separated from the ticket update code by | |
549 | an abstraction barrier that makes it impossible to pass this data directly. | |
550 | ||
551 | =cut | |
552 | ||
553 | sub Headers { | |
554 | return join("\n", $_[0]->SplitHeaders); | |
555 | } | |
556 | ||
557 | =head2 EncodedHeaders | |
558 | ||
559 | Takes encoding as argument and returns the attachment's headers as octets in encoded | |
560 | using the encoding. | |
561 | ||
562 | This is not protection using quoted printable or base64 encoding. | |
563 | ||
564 | =cut | |
565 | ||
566 | sub EncodedHeaders { | |
567 | my $self = shift; | |
568 | my $encoding = shift || 'utf8'; | |
569 | return Encode::encode( $encoding, $self->Headers ); | |
570 | } | |
571 | ||
572 | =head2 GetHeader $TAG | |
573 | ||
574 | Returns the value of the header Tag as a string. This bypasses the weeding out | |
575 | done in Headers() above. | |
576 | ||
577 | =cut | |
578 | ||
579 | sub GetHeader { | |
580 | my $self = shift; | |
581 | my $tag = shift; | |
582 | foreach my $line ($self->_SplitHeaders) { | |
583 | next unless $line =~ /^\Q$tag\E:\s+(.*)$/si; | |
584 | ||
585 | #if we find the header, return its value | |
586 | return ($1); | |
587 | } | |
588 | ||
589 | # we found no header. return an empty string | |
590 | return undef; | |
591 | } | |
592 | ||
593 | =head2 DelHeader $TAG | |
594 | ||
595 | Delete a field from the attachment's headers. | |
596 | ||
597 | =cut | |
598 | ||
599 | sub DelHeader { | |
600 | my $self = shift; | |
601 | my $tag = shift; | |
602 | ||
603 | my $newheader = ''; | |
604 | foreach my $line ($self->_SplitHeaders) { | |
dab09ea8 MKG |
605 | next if $line =~ /^\Q$tag\E:\s+/i; |
606 | $newheader .= "$line\n"; | |
84fb5b46 MKG |
607 | } |
608 | return $self->__Set( Field => 'Headers', Value => $newheader); | |
609 | } | |
610 | ||
611 | =head2 AddHeader $TAG, $VALUE, ... | |
612 | ||
613 | Add one or many fields to the attachment's headers. | |
614 | ||
615 | =cut | |
616 | ||
617 | sub AddHeader { | |
618 | my $self = shift; | |
619 | ||
620 | my $newheader = $self->__Value( 'Headers' ); | |
621 | while ( my ($tag, $value) = splice @_, 0, 2 ) { | |
dab09ea8 | 622 | $value = $self->_CanonicalizeHeaderValue($value); |
84fb5b46 MKG |
623 | $newheader .= "$tag: $value\n"; |
624 | } | |
625 | return $self->__Set( Field => 'Headers', Value => $newheader); | |
626 | } | |
627 | ||
628 | =head2 SetHeader ( 'Tag', 'Value' ) | |
629 | ||
630 | Replace or add a Header to the attachment's headers. | |
631 | ||
632 | =cut | |
633 | ||
634 | sub SetHeader { | |
dab09ea8 MKG |
635 | my $self = shift; |
636 | my $tag = shift; | |
637 | my $value = $self->_CanonicalizeHeaderValue(shift); | |
84fb5b46 | 638 | |
dab09ea8 | 639 | my $replaced = 0; |
84fb5b46 | 640 | my $newheader = ''; |
dab09ea8 MKG |
641 | foreach my $line ( $self->_SplitHeaders ) { |
642 | if ( $line =~ /^\Q$tag\E:\s+/i ) { | |
643 | # replace first instance, skip all the rest | |
644 | unless ($replaced) { | |
645 | $newheader .= "$tag: $value\n"; | |
646 | $replaced = 1; | |
647 | } | |
648 | } else { | |
649 | $newheader .= "$line\n"; | |
84fb5b46 | 650 | } |
84fb5b46 MKG |
651 | } |
652 | ||
dab09ea8 | 653 | $newheader .= "$tag: $value\n" unless $replaced; |
84fb5b46 MKG |
654 | $self->__Set( Field => 'Headers', Value => $newheader); |
655 | } | |
656 | ||
dab09ea8 MKG |
657 | sub _CanonicalizeHeaderValue { |
658 | my $self = shift; | |
659 | my $value = shift; | |
660 | ||
661 | $value = '' unless defined $value; | |
662 | $value =~ s/\s+$//s; | |
663 | $value =~ s/\r*\n/\n /g; | |
664 | ||
665 | return $value; | |
666 | } | |
667 | ||
84fb5b46 MKG |
668 | =head2 SplitHeaders |
669 | ||
670 | Returns an array of this attachment object's headers, with one header | |
671 | per array entry. Multiple lines are folded. | |
672 | ||
673 | B<Never> returns C<RT-Send-Bcc> field. | |
674 | ||
675 | =cut | |
676 | ||
677 | sub SplitHeaders { | |
678 | my $self = shift; | |
679 | return (grep !/^RT-Send-Bcc/i, $self->_SplitHeaders(@_) ); | |
680 | } | |
681 | ||
682 | =head2 _SplitHeaders | |
683 | ||
684 | Returns an array of this attachment object's headers, with one header | |
685 | per array entry. multiple lines are folded. | |
686 | ||
687 | ||
688 | =cut | |
689 | ||
690 | sub _SplitHeaders { | |
691 | my $self = shift; | |
692 | my $headers = (shift || $self->_Value('Headers')); | |
693 | my @headers; | |
dab09ea8 MKG |
694 | # XXX TODO: splitting on \n\w is _wrong_ as it treats \n[ as a valid |
695 | # continuation, which it isn't. The correct split pattern, per RFC 2822, | |
696 | # is /\n(?=[^ \t]|\z)/. That is, only "\n " or "\n\t" is a valid | |
697 | # continuation. Older values of X-RT-GnuPG-Status contain invalid | |
698 | # continuations and rely on this bogus split pattern, however, so it is | |
699 | # left as-is for now. | |
84fb5b46 MKG |
700 | for (split(/\n(?=\w|\z)/,$headers)) { |
701 | push @headers, $_; | |
702 | ||
703 | } | |
704 | return(@headers); | |
705 | } | |
706 | ||
707 | ||
708 | sub Encrypt { | |
709 | my $self = shift; | |
710 | ||
711 | my $txn = $self->TransactionObj; | |
712 | return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; | |
713 | return (0, $self->loc('Permission Denied')) | |
714 | unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); | |
715 | return (0, $self->loc('GnuPG integration is disabled')) | |
716 | unless RT->Config->Get('GnuPG')->{'Enable'}; | |
717 | return (0, $self->loc('Attachments encryption is disabled')) | |
718 | unless RT->Config->Get('GnuPG')->{'AllowEncryptDataInDB'}; | |
719 | ||
720 | require RT::Crypt::GnuPG; | |
721 | ||
722 | my $type = $self->ContentType; | |
723 | if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { | |
724 | return (1, $self->loc('Already encrypted')); | |
725 | } elsif ( $type =~ /^multipart\//i ) { | |
726 | return (1, $self->loc('No need to encrypt')); | |
727 | } else { | |
728 | $type = qq{x-application-rt\/gpg-encrypted; original-type="$type"}; | |
729 | } | |
730 | ||
731 | my $queue = $txn->TicketObj->QueueObj; | |
732 | my $encrypt_for; | |
733 | foreach my $address ( grep $_, | |
734 | $queue->CorrespondAddress, | |
735 | $queue->CommentAddress, | |
736 | RT->Config->Get('CorrespondAddress'), | |
737 | RT->Config->Get('CommentAddress'), | |
738 | ) { | |
739 | my %res = RT::Crypt::GnuPG::GetKeysInfo( $address, 'private' ); | |
740 | next if $res{'exit_code'} || !$res{'info'}; | |
741 | %res = RT::Crypt::GnuPG::GetKeysForEncryption( $address ); | |
742 | next if $res{'exit_code'} || !$res{'info'}; | |
743 | $encrypt_for = $address; | |
744 | } | |
745 | unless ( $encrypt_for ) { | |
746 | return (0, $self->loc('No key suitable for encryption')); | |
747 | } | |
748 | ||
749 | $self->__Set( Field => 'ContentType', Value => $type ); | |
750 | $self->SetHeader( 'Content-Type' => $type ); | |
751 | ||
752 | my $content = $self->Content; | |
753 | my %res = RT::Crypt::GnuPG::SignEncryptContent( | |
754 | Content => \$content, | |
755 | Sign => 0, | |
756 | Encrypt => 1, | |
757 | Recipients => [ $encrypt_for ], | |
758 | ); | |
759 | if ( $res{'exit_code'} ) { | |
760 | return (0, $self->loc('GnuPG error. Contact with administrator')); | |
761 | } | |
762 | ||
763 | my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); | |
764 | unless ( $status ) { | |
765 | return ($status, $self->loc("Couldn't replace content with encrypted data: [_1]", $msg)); | |
766 | } | |
767 | return (1, $self->loc('Successfuly encrypted data')); | |
768 | } | |
769 | ||
770 | sub Decrypt { | |
771 | my $self = shift; | |
772 | ||
773 | my $txn = $self->TransactionObj; | |
774 | return (0, $self->loc('Permission Denied')) unless $txn->CurrentUserCanSee; | |
775 | return (0, $self->loc('Permission Denied')) | |
776 | unless $txn->TicketObj->CurrentUserHasRight('ModifyTicket'); | |
777 | return (0, $self->loc('GnuPG integration is disabled')) | |
778 | unless RT->Config->Get('GnuPG')->{'Enable'}; | |
779 | ||
780 | require RT::Crypt::GnuPG; | |
781 | ||
782 | my $type = $self->ContentType; | |
783 | if ( $type =~ /^x-application-rt\/gpg-encrypted/i ) { | |
784 | ($type) = ($type =~ /original-type="(.*)"/i); | |
785 | $type ||= 'application/octet-stream'; | |
786 | } else { | |
787 | return (1, $self->loc('Is not encrypted')); | |
788 | } | |
789 | $self->__Set( Field => 'ContentType', Value => $type ); | |
790 | $self->SetHeader( 'Content-Type' => $type ); | |
791 | ||
792 | my $content = $self->Content; | |
793 | my %res = RT::Crypt::GnuPG::DecryptContent( Content => \$content, ); | |
794 | if ( $res{'exit_code'} ) { | |
795 | return (0, $self->loc('GnuPG error. Contact with administrator')); | |
796 | } | |
797 | ||
798 | my ($status, $msg) = $self->__Set( Field => 'Content', Value => $content ); | |
799 | unless ( $status ) { | |
800 | return ($status, $self->loc("Couldn't replace content with decrypted data: [_1]", $msg)); | |
801 | } | |
802 | return (1, $self->loc('Successfuly decrypted data')); | |
803 | } | |
804 | ||
805 | =head2 _Value | |
806 | ||
807 | Takes the name of a table column. | |
808 | Returns its value as a string, if the user passes an ACL check | |
809 | ||
810 | =cut | |
811 | ||
812 | sub _Value { | |
813 | my $self = shift; | |
814 | my $field = shift; | |
815 | ||
816 | #if the field is public, return it. | |
817 | if ( $self->_Accessible( $field, 'public' ) ) { | |
818 | return ( $self->__Value( $field, @_ ) ); | |
819 | } | |
820 | ||
821 | return undef unless $self->TransactionObj->CurrentUserCanSee; | |
822 | return $self->__Value( $field, @_ ); | |
823 | } | |
824 | ||
825 | # Transactions don't change. by adding this cache congif directiove, | |
826 | # we don't lose pathalogically on long tickets. | |
827 | sub _CacheConfig { | |
828 | { | |
829 | 'cache_p' => 1, | |
830 | 'fast_update_p' => 1, | |
831 | 'cache_for_sec' => 180, | |
832 | } | |
833 | } | |
834 | ||
835 | ||
836 | ||
837 | ||
838 | =head2 id | |
839 | ||
840 | Returns the current value of id. | |
841 | (In the database, id is stored as int(11).) | |
842 | ||
843 | ||
844 | =cut | |
845 | ||
846 | ||
847 | =head2 TransactionId | |
848 | ||
849 | Returns the current value of TransactionId. | |
850 | (In the database, TransactionId is stored as int(11).) | |
851 | ||
852 | ||
853 | ||
854 | =head2 SetTransactionId VALUE | |
855 | ||
856 | ||
857 | Set TransactionId to VALUE. | |
858 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
859 | (In the database, TransactionId will be stored as a int(11).) | |
860 | ||
861 | ||
862 | =cut | |
863 | ||
864 | ||
865 | =head2 Parent | |
866 | ||
867 | Returns the current value of Parent. | |
868 | (In the database, Parent is stored as int(11).) | |
869 | ||
870 | ||
871 | ||
872 | =head2 SetParent VALUE | |
873 | ||
874 | ||
875 | Set Parent to VALUE. | |
876 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
877 | (In the database, Parent will be stored as a int(11).) | |
878 | ||
879 | ||
880 | =cut | |
881 | ||
882 | ||
883 | =head2 MessageId | |
884 | ||
885 | Returns the current value of MessageId. | |
886 | (In the database, MessageId is stored as varchar(160).) | |
887 | ||
888 | ||
889 | ||
890 | =head2 SetMessageId VALUE | |
891 | ||
892 | ||
893 | Set MessageId to VALUE. | |
894 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
895 | (In the database, MessageId will be stored as a varchar(160).) | |
896 | ||
897 | ||
898 | =cut | |
899 | ||
900 | ||
901 | =head2 Subject | |
902 | ||
903 | Returns the current value of Subject. | |
904 | (In the database, Subject is stored as varchar(255).) | |
905 | ||
906 | ||
907 | ||
908 | =head2 SetSubject VALUE | |
909 | ||
910 | ||
911 | Set Subject to VALUE. | |
912 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
913 | (In the database, Subject will be stored as a varchar(255).) | |
914 | ||
915 | ||
916 | =cut | |
917 | ||
918 | ||
919 | =head2 Filename | |
920 | ||
921 | Returns the current value of Filename. | |
922 | (In the database, Filename is stored as varchar(255).) | |
923 | ||
924 | ||
925 | ||
926 | =head2 SetFilename VALUE | |
927 | ||
928 | ||
929 | Set Filename to VALUE. | |
930 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
931 | (In the database, Filename will be stored as a varchar(255).) | |
932 | ||
933 | ||
934 | =cut | |
935 | ||
936 | ||
937 | =head2 ContentType | |
938 | ||
939 | Returns the current value of ContentType. | |
940 | (In the database, ContentType is stored as varchar(80).) | |
941 | ||
942 | ||
943 | ||
944 | =head2 SetContentType VALUE | |
945 | ||
946 | ||
947 | Set ContentType to VALUE. | |
948 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
949 | (In the database, ContentType will be stored as a varchar(80).) | |
950 | ||
951 | ||
952 | =cut | |
953 | ||
954 | ||
955 | =head2 ContentEncoding | |
956 | ||
957 | Returns the current value of ContentEncoding. | |
958 | (In the database, ContentEncoding is stored as varchar(80).) | |
959 | ||
960 | ||
961 | ||
962 | =head2 SetContentEncoding VALUE | |
963 | ||
964 | ||
965 | Set ContentEncoding to VALUE. | |
966 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
967 | (In the database, ContentEncoding will be stored as a varchar(80).) | |
968 | ||
969 | ||
970 | =cut | |
971 | ||
972 | ||
973 | =head2 Content | |
974 | ||
975 | Returns the current value of Content. | |
976 | (In the database, Content is stored as longblob.) | |
977 | ||
978 | ||
979 | ||
980 | =head2 SetContent VALUE | |
981 | ||
982 | ||
983 | Set Content to VALUE. | |
984 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
985 | (In the database, Content will be stored as a longblob.) | |
986 | ||
987 | ||
988 | =cut | |
989 | ||
990 | ||
991 | =head2 Headers | |
992 | ||
993 | Returns the current value of Headers. | |
994 | (In the database, Headers is stored as longtext.) | |
995 | ||
996 | ||
997 | ||
998 | =head2 SetHeaders VALUE | |
999 | ||
1000 | ||
1001 | Set Headers to VALUE. | |
1002 | Returns (1, 'Status message') on success and (0, 'Error Message') on failure. | |
1003 | (In the database, Headers will be stored as a longtext.) | |
1004 | ||
1005 | ||
1006 | =cut | |
1007 | ||
1008 | ||
1009 | =head2 Creator | |
1010 | ||
1011 | Returns the current value of Creator. | |
1012 | (In the database, Creator is stored as int(11).) | |
1013 | ||
1014 | ||
1015 | =cut | |
1016 | ||
1017 | ||
1018 | =head2 Created | |
1019 | ||
1020 | Returns the current value of Created. | |
1021 | (In the database, Created is stored as datetime.) | |
1022 | ||
1023 | ||
1024 | =cut | |
1025 | ||
1026 | ||
1027 | ||
1028 | sub _CoreAccessible { | |
1029 | { | |
1030 | ||
1031 | id => | |
1032 | {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, | |
1033 | TransactionId => | |
1034 | {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''}, | |
1035 | Parent => | |
1036 | {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, | |
1037 | MessageId => | |
1038 | {read => 1, write => 1, sql_type => 12, length => 160, is_blob => 0, is_numeric => 0, type => 'varchar(160)', default => ''}, | |
1039 | Subject => | |
1040 | {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, | |
1041 | Filename => | |
1042 | {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''}, | |
1043 | ContentType => | |
1044 | {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''}, | |
1045 | ContentEncoding => | |
1046 | {read => 1, write => 1, sql_type => 12, length => 80, is_blob => 0, is_numeric => 0, type => 'varchar(80)', default => ''}, | |
1047 | Content => | |
1048 | {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longblob', default => ''}, | |
1049 | Headers => | |
1050 | {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'longtext', default => ''}, | |
1051 | Creator => | |
1052 | {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'}, | |
1053 | Created => | |
1054 | {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''}, | |
1055 | ||
1056 | } | |
1057 | }; | |
1058 | ||
1059 | RT::Base->_ImportOverlays(); | |
1060 | ||
1061 | 1; |