Master -> 4.0.5-5
[usit-rt.git] / lib / RT / Action / SendEmail.pm
CommitLineData
84fb5b46
MKG
1# BEGIN BPS TAGGED BLOCK {{{
2#
3# COPYRIGHT:
4#
5# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
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# Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
50
51package RT::Action::SendEmail;
52
53use strict;
54use warnings;
55
56use base qw(RT::Action);
57
58use RT::EmailParser;
59use RT::Interface::Email;
60use Email::Address;
61our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);
62
63
64=head1 NAME
65
66RT::Action::SendEmail - An Action which users can use to send mail
67or can subclassed for more specialized mail sending behavior.
68RT::Action::AutoReply is a good example subclass.
69
70=head1 SYNOPSIS
71
72 use base 'RT::Action::SendEmail';
73
74=head1 DESCRIPTION
75
76Basically, you create another module RT::Action::YourAction which ISA
77RT::Action::SendEmail.
78
79=head1 METHODS
80
81=head2 CleanSlate
82
83Cleans class-wide options, like L</AttachTickets>.
84
85=cut
86
87sub CleanSlate {
88 my $self = shift;
89 $self->AttachTickets(undef);
90}
91
92=head2 Commit
93
94Sends the prepared message and writes outgoing record into DB if the feature is
95activated in the config.
96
97=cut
98
99sub Commit {
100 my $self = shift;
101
102 $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail');
103 my $message = $self->TemplateObj->MIMEObj;
104
105 my $orig_message;
106 if ( RT->Config->Get('RecordOutgoingEmail')
107 && RT->Config->Get('GnuPG')->{'Enable'} )
108 {
109
110 # it's hacky, but we should know if we're going to crypt things
111 my $attachment = $self->TransactionObj->Attachments->First;
112
113 my %crypt;
114 foreach my $argument (qw(Sign Encrypt)) {
115 if ( $attachment
116 && defined $attachment->GetHeader("X-RT-$argument") )
117 {
118 $crypt{$argument} = $attachment->GetHeader("X-RT-$argument");
119 } else {
120 $crypt{$argument} = $self->TicketObj->QueueObj->$argument();
121 }
122 }
123 if ( $crypt{'Sign'} || $crypt{'Encrypt'} ) {
124 $orig_message = $message->dup;
125 }
126 }
127
128 my ($ret) = $self->SendMessage($message);
129 if ( $ret > 0 && RT->Config->Get('RecordOutgoingEmail') ) {
130 if ($orig_message) {
131 $message->attach(
132 Type => 'application/x-rt-original-message',
133 Disposition => 'inline',
134 Data => $orig_message->as_string,
135 );
136 }
137 $self->RecordOutgoingMailTransaction($message);
138 $self->RecordDeferredRecipients();
139 }
140
141
142 return ( abs $ret );
143}
144
145=head2 Prepare
146
147Builds an outgoing email we're going to send using scrip's template.
148
149=cut
150
151sub Prepare {
152 my $self = shift;
153
154 my ( $result, $message ) = $self->TemplateObj->Parse(
155 Argument => $self->Argument,
156 TicketObj => $self->TicketObj,
157 TransactionObj => $self->TransactionObj
158 );
159 if ( !$result ) {
160 return (undef);
161 }
162
163 my $MIMEObj = $self->TemplateObj->MIMEObj;
164
165 # Header
166 $self->SetRTSpecialHeaders();
167
168 my %seen;
169 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
170 @{ $self->{$type} }
171 = grep defined && length && !$seen{ lc $_ }++,
172 @{ $self->{$type} };
173 }
174
175 $self->RemoveInappropriateRecipients();
176
177 # Go add all the Tos, Ccs and Bccs that we need to to the message to
178 # make it happy, but only if we actually have values in those arrays.
179
180# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc
181
182 for my $header (@EMAIL_RECIPIENT_HEADERS) {
183
184 $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
185 if (!$MIMEObj->head->get($header)
186 && $self->{$header}
187 && @{ $self->{$header} } );
188 }
189 # PseudoTo (fake to headers) shouldn't get matched for message recipients.
190 # If we don't have any 'To' header (but do have other recipients), drop in
191 # the pseudo-to header.
192 $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
193 if $self->{'PseudoTo'}
194 && @{ $self->{'PseudoTo'} }
195 && !$MIMEObj->head->get('To')
196 && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
197
198 # We should never have to set the MIME-Version header
199 $self->SetHeader( 'MIME-Version', '1.0' );
200
201 # fsck.com #5959: Since RT sends 8bit mail, we should say so.
202 $self->SetHeader( 'Content-Transfer-Encoding', '8bit' );
203
204 # For security reasons, we only send out textual mails.
205 foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
206 my $type = $part->mime_type || 'text/plain';
207 $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
208 $part->head->mime_attr( "Content-Type" => $type );
209 # utf-8 here is for _FindOrGuessCharset in I18N.pm
210 # it's not the final charset/encoding sent
211 $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
212 }
213
214 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj,
215 RT->Config->Get('EmailOutputEncoding'),
216 'mime_words_ok', );
217
218 # Build up a MIME::Entity that looks like the original message.
219 $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
220 && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
221
222 $self->AddTickets;
223
224 my $attachment = $self->TransactionObj->Attachments->First;
225 if ($attachment
226 && !(
227 $attachment->GetHeader('X-RT-Encrypt')
228 || $self->TicketObj->QueueObj->Encrypt
229 )
230 )
231 {
232 $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
233 if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
234 'Success';
235 }
236
237 return $result;
238}
239
240=head2 To
241
242Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
243
244=cut
245
246sub To {
247 my $self = shift;
248 return ( $self->AddressesFromHeader('To') );
249}
250
251=head2 Cc
252
253Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
254
255=cut
256
257sub Cc {
258 my $self = shift;
259 return ( $self->AddressesFromHeader('Cc') );
260}
261
262=head2 Bcc
263
264Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
265
266=cut
267
268sub Bcc {
269 my $self = shift;
270 return ( $self->AddressesFromHeader('Bcc') );
271
272}
273
274sub AddressesFromHeader {
275 my $self = shift;
276 my $field = shift;
277 my $header = $self->TemplateObj->MIMEObj->head->get($field);
278 my @addresses = Email::Address->parse($header);
279
280 return (@addresses);
281}
282
283=head2 SendMessage MIMEObj
284
285sends the message using RT's preferred API.
286TODO: Break this out to a separate module
287
288=cut
289
290sub SendMessage {
291
292 # DO NOT SHIFT @_ in this subroutine. It breaks Hook::LexWrap's
293 # ability to pass @_ to a 'post' routine.
294 my ( $self, $MIMEObj ) = @_;
295
296 my $msgid = $MIMEObj->head->get('Message-ID');
297 chomp $msgid;
298
299 $self->ScripActionObj->{_Message_ID}++;
300
301 $RT::Logger->info( $msgid . " #"
302 . $self->TicketObj->id . "/"
303 . $self->TransactionObj->id
304 . " - Scrip "
305 . ($self->ScripObj->id || '#rule'). " "
306 . ( $self->ScripObj->Description || '' ) );
307
308 my $status = RT::Interface::Email::SendEmail(
309 Entity => $MIMEObj,
310 Ticket => $self->TicketObj,
311 Transaction => $self->TransactionObj,
312 );
313
314
315 return $status unless ($status > 0 || exists $self->{'Deferred'});
316
317 my $success = $msgid . " sent ";
318 foreach (@EMAIL_RECIPIENT_HEADERS) {
319 my $recipients = $MIMEObj->head->get($_);
320 $success .= " $_: " . $recipients if $recipients;
321 }
322
323 if( exists $self->{'Deferred'} ) {
324 for (qw(daily weekly susp)) {
325 $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
326 if exists $self->{'Deferred'}{ $_ };
327 }
328 }
329
330 $success =~ s/\n//g;
331
332 $RT::Logger->info($success);
333
334 return (1);
335}
336
337=head2 AddAttachments
338
339Takes any attachments to this transaction and attaches them to the message
340we're building.
341
342=cut
343
344sub AddAttachments {
345 my $self = shift;
346
347 my $MIMEObj = $self->TemplateObj->MIMEObj;
348
349 $MIMEObj->head->delete('RT-Attach-Message');
350
35ef43cf 351 my $attachments = RT::Attachments->new( RT->SystemUser );
84fb5b46
MKG
352 $attachments->Limit(
353 FIELD => 'TransactionId',
354 VALUE => $self->TransactionObj->Id
355 );
356
357 # Don't attach anything blank
358 $attachments->LimitNotEmpty;
359 $attachments->OrderBy( FIELD => 'id' );
360
361 # We want to make sure that we don't include the attachment that's
362 # being used as the "Content" of this message" unless that attachment's
363 # content type is not like text/...
364 my $transaction_content_obj = $self->TransactionObj->ContentObj;
365
366 if ( $transaction_content_obj
367 && $transaction_content_obj->ContentType =~ m{text/}i )
368 {
369 # If this was part of a multipart/alternative, skip all of the kids
370 my $parent = $transaction_content_obj->ParentObj;
371 if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
372 $attachments->Limit(
373 ENTRYAGGREGATOR => 'AND',
374 FIELD => 'parent',
375 OPERATOR => '!=',
376 VALUE => $parent->Id,
377 );
378 } else {
379 $attachments->Limit(
380 ENTRYAGGREGATOR => 'AND',
381 FIELD => 'id',
382 OPERATOR => '!=',
383 VALUE => $transaction_content_obj->Id,
384 );
385 }
386 }
387
388 # attach any of this transaction's attachments
389 my $seen_attachment = 0;
390 while ( my $attach = $attachments->Next ) {
391 if ( !$seen_attachment ) {
392 $MIMEObj->make_multipart( 'mixed', Force => 1 );
393 $seen_attachment = 1;
394 }
395 $self->AddAttachment($attach);
396 }
397}
398
399=head2 AddAttachment $attachment
400
401Takes one attachment object of L<RT::Attachmment> class and attaches it to the message
402we're building.
403
404=cut
405
406sub AddAttachment {
407 my $self = shift;
408 my $attach = shift;
409 my $MIMEObj = shift || $self->TemplateObj->MIMEObj;
410
411 # $attach->TransactionObj may not always be $self->TransactionObj
412 return unless $attach->Id
413 and $attach->TransactionObj->CurrentUserCanSee;
414
415 # ->attach expects just the disposition type; extract it if we have the header
416 my $disp = ($attach->GetHeader('Content-Disposition') || '')
417 =~ /^\s*(inline|attachment)/i ? $1 : undef;
418
419 $MIMEObj->attach(
420 Type => $attach->ContentType,
421 Charset => $attach->OriginalEncoding,
422 Data => $attach->OriginalContent,
423 Disposition => $disp, # a false value defaults to inline in MIME::Entity
424 Filename => $self->MIMEEncodeString( $attach->Filename ),
425 'RT-Attachment:' => $self->TicketObj->Id . "/"
426 . $self->TransactionObj->Id . "/"
427 . $attach->id,
428 Encoding => '-SUGGEST',
429 );
430}
431
432=head2 AttachTickets [@IDs]
433
434Returns or set list of ticket's IDs that should be attached to an outgoing message.
435
436B<Note> this method works as a class method and setup things global, so you have to
437clean list by passing undef as argument.
438
439=cut
440
441{
442 my $list = [];
443
444 sub AttachTickets {
445 my $self = shift;
446 $list = [ grep defined, @_ ] if @_;
447 return @$list;
448 }
449}
450
451=head2 AddTickets
452
453Attaches tickets to the current message, list of tickets' ids get from
454L</AttachTickets> method.
455
456=cut
457
458sub AddTickets {
459 my $self = shift;
460 $self->AddTicket($_) foreach $self->AttachTickets;
461 return;
462}
463
464=head2 AddTicket $ID
465
466Attaches a ticket with ID to the message.
467
468Each ticket is attached as multipart entity and all its messages and attachments
469are attached as sub entities in order of creation, but only if transaction type
470is Create or Correspond.
471
472=cut
473
474sub AddTicket {
475 my $self = shift;
476 my $tid = shift;
477
478 my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj );
479 my $txn_alias = $attachs->TransactionAlias;
480 $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
481 $attachs->Limit(
482 ALIAS => $txn_alias,
483 FIELD => 'Type',
484 VALUE => 'Correspond'
485 );
486 $attachs->LimitByTicket($tid);
487 $attachs->LimitNotEmpty;
488 $attachs->OrderBy( FIELD => 'Created' );
489
490 my $ticket_mime = MIME::Entity->build(
491 Type => 'multipart/mixed',
492 Top => 0,
493 Description => "ticket #$tid",
494 );
495 while ( my $attachment = $attachs->Next ) {
496 $self->AddAttachment( $attachment, $ticket_mime );
497 }
498 if ( $ticket_mime->parts ) {
499 my $email_mime = $self->TemplateObj->MIMEObj;
500 $email_mime->make_multipart;
501 $email_mime->add_part($ticket_mime);
502 }
503 return;
504}
505
506=head2 RecordOutgoingMailTransaction MIMEObj
507
508Record a transaction in RT with this outgoing message for future record-keeping purposes
509
510=cut
511
512sub RecordOutgoingMailTransaction {
513 my $self = shift;
514 my $MIMEObj = shift;
515
516 my @parts = $MIMEObj->parts;
517 my @attachments;
518 my @keep;
519 foreach my $part (@parts) {
520 my $attach = $part->head->get('RT-Attachment');
521 if ($attach) {
522 $RT::Logger->debug(
523 "We found an attachment. we want to not record it.");
524 push @attachments, $attach;
525 } else {
526 $RT::Logger->debug("We found a part. we want to record it.");
527 push @keep, $part;
528 }
529 }
530 $MIMEObj->parts( \@keep );
531 foreach my $attachment (@attachments) {
532 $MIMEObj->head->add( 'RT-Attachment', $attachment );
533 }
534
535 RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );
536
537 my $transaction
538 = RT::Transaction->new( $self->TransactionObj->CurrentUser );
539
540# XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
541
542 my $type;
543 if ( $self->TransactionObj->Type eq 'Comment' ) {
544 $type = 'CommentEmailRecord';
545 } else {
546 $type = 'EmailRecord';
547 }
548
549 my $msgid = $MIMEObj->head->get('Message-ID');
550 chomp $msgid;
551
552 my ( $id, $msg ) = $transaction->Create(
553 Ticket => $self->TicketObj->Id,
554 Type => $type,
555 Data => $msgid,
556 MIMEObj => $MIMEObj,
557 ActivateScrips => 0
558 );
559
560 if ($id) {
561 $self->{'OutgoingMailTransaction'} = $id;
562 } else {
563 $RT::Logger->warning(
564 "Could not record outgoing message transaction: $msg");
565 }
566 return $id;
567}
568
569=head2 SetRTSpecialHeaders
570
571This routine adds all the random headers that RT wants in a mail message
572that don't matter much to anybody else.
573
574=cut
575
576sub SetRTSpecialHeaders {
577 my $self = shift;
578
579 $self->SetSubject();
580 $self->SetSubjectToken();
581 $self->SetHeaderAsEncoding( 'Subject',
582 RT->Config->Get('EmailOutputEncoding') )
583 if ( RT->Config->Get('EmailOutputEncoding') );
584 $self->SetReturnAddress();
585 $self->SetReferencesHeaders();
586
587 unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {
588
589 # Get Message-ID for this txn
590 my $msgid = "";
591 if ( my $msg = $self->TransactionObj->Message->First ) {
592 $msgid = $msg->GetHeader("RT-Message-ID")
593 || $msg->GetHeader("Message-ID");
594 }
595
596 # If there is one, and we can parse it, then base our Message-ID on it
597 if ( $msgid
598 and $msgid
599 =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
600 "<$1." . $self->TicketObj->id
601 . "-" . $self->ScripObj->id
602 . "-" . $self->ScripActionObj->{_Message_ID}
603 . "@" . RT->Config->Get('Organization') . ">"/eg
604 and $2 == $self->TicketObj->id
605 )
606 {
607 $self->SetHeader( "Message-ID" => $msgid );
608 } else {
609 $self->SetHeader(
610 'Message-ID' => RT::Interface::Email::GenMessageId(
611 Ticket => $self->TicketObj,
612 Scrip => $self->ScripObj,
613 ScripAction => $self->ScripActionObj
614 ),
615 );
616 }
617 }
618
619 if (my $precedence = RT->Config->Get('DefaultMailPrecedence')
620 and !$self->TemplateObj->MIMEObj->head->get("Precedence")
621 ) {
622 $self->SetHeader( 'Precedence', $precedence );
623 }
624
625 $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
626 $self->SetHeader( 'RT-Ticket',
627 RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
628 $self->SetHeader( 'Managed-by',
629 "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );
630
631# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
632# refactored into user's method.
633 if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
634 and RT->Config->Get('UseOriginatorHeader')
635 ) {
636 $self->SetHeader( 'RT-Originator', $email );
637 }
638
639}
640
641
642sub DeferDigestRecipients {
643 my $self = shift;
644 $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
645
646 # The digest attribute will be an array of notifications that need to
647 # be sent for this transaction. The array will have the following
648 # format for its objects.
649 # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
650 # -> sent -> {true|false}
651 # The "sent" flag will be used by the cron job to indicate that it has
652 # run on this transaction.
653 # In a perfect world we might move this hash construction to the
654 # extension module itself.
655 my $digest_hash = {};
656
657 foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
658 # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
659 next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
660 $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
661
662 # Store the 'daily digest' folk in an array.
663 my ( @send_now, @daily_digest, @weekly_digest, @suspended );
664
665 # Have to get the list of addresses directly from the MIME header
666 # at this point.
667 $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
668 foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
669 next unless $rcpt;
670 my $user_obj = RT::User->new(RT->SystemUser);
671 $user_obj->LoadByEmail($rcpt);
672 if ( ! $user_obj->id ) {
673 # If there's an email address in here without an associated
674 # RT user, pass it on through.
675 $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail.");
676 push( @send_now, $rcpt );
677 next;
678 }
679
680 my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
681 $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
682
683 if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
684 elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
685 elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
686 else { push( @send_now, $rcpt ) }
687 }
688
689 # Reset the relevant mail field.
690 $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
691 if (@send_now) {
692 $self->SetHeader( $mailfield, join( ', ', @send_now ) );
693 } else { # No recipients! Remove the header.
694 $self->TemplateObj->MIMEObj->head->delete($mailfield);
695 }
696
697 # Push the deferred addresses into the appropriate field in
698 # our attribute hash, with the appropriate mail header.
699 $RT::Logger->debug(
700 "Setting deferred recipients for attribute creation");
701 $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest);
702 $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest);
703 $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended);
704 }
705
706 if ( scalar keys %$digest_hash ) {
707
708 # Save the hash so that we can add it as an attribute to the
709 # outgoing email transaction.
710 $self->{'Deferred'} = $digest_hash;
711 } else {
712 $RT::Logger->debug( "No recipients found for deferred delivery on "
713 . "transaction #"
714 . $self->TransactionObj->id );
715 }
716}
717
718
719
720sub RecordDeferredRecipients {
721 my $self = shift;
722 return unless exists $self->{'Deferred'};
723
724 my $txn_id = $self->{'OutgoingMailTransaction'};
725 return unless $txn_id;
726
727 my $txn_obj = RT::Transaction->new( $self->CurrentUser );
728 $txn_obj->Load( $txn_id );
729 my( $ret, $msg ) = $txn_obj->AddAttribute(
730 Name => 'DeferredRecipients',
731 Content => $self->{'Deferred'}
732 );
733 $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" )
734 unless $ret;
735
736 return ($ret,$msg);
737}
738
739=head2 SquelchMailTo
740
741Returns list of the addresses to squelch on this transaction.
742
743=cut
744
745sub SquelchMailTo {
746 my $self = shift;
747 return map $_->Content, $self->TransactionObj->SquelchMailTo;
748}
749
750=head2 RemoveInappropriateRecipients
751
752Remove addresses that are RT addresses or that are on this transaction's blacklist
753
754=cut
755
756sub RemoveInappropriateRecipients {
757 my $self = shift;
758
759 my @blacklist = ();
760
761 # If there are no recipients, don't try to send the message.
762 # If the transaction has content and has the header RT-Squelch-Replies-To
763
764 my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id');
765 if ( my $attachment = $self->TransactionObj->Attachments->First ) {
766
767 if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
768
769 # What do we want to do with this? It's probably (?) a bounce
770 # caused by one of the watcher addresses being broken.
771 # Default ("true") is to redistribute, for historical reasons.
772
773 if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) {
774
775 # Don't send to any watchers.
776 @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
777 $RT::Logger->info( $msgid
778 . " The incoming message was autogenerated. "
779 . "Not redistributing this message based on site configuration."
780 );
781 } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq
782 'privileged' )
783 {
784
785 # Only send to "privileged" watchers.
786 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
787 foreach my $addr ( @{ $self->{$type} } ) {
788 my $user = RT::User->new(RT->SystemUser);
789 $user->LoadByEmail($addr);
790 push @blacklist, $addr unless $user->id && $user->Privileged;
791 }
792 }
793 $RT::Logger->info( $msgid
794 . " The incoming message was autogenerated. "
795 . "Not redistributing this message to unprivileged users based on site configuration."
796 );
797 }
798 }
799
800 if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
801 push @blacklist, split( /,/, $squelch );
802 }
803 }
804
805 # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted
806 push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo;
807
808 # Cycle through the people we're sending to and pull out anyone on the
809 # system blacklist
810
811 # Trim leading and trailing spaces.
812 @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) }
813 Email::Address->parse( join ', ', grep defined, @blacklist );
814
815 foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
816 my @addrs;
817 foreach my $addr ( @{ $self->{$type} } ) {
818
819 # Weed out any RT addresses. We really don't want to talk to ourselves!
820 # If we get a reply back, that means it's not an RT address
821 if ( !RT::EmailParser->CullRTAddresses($addr) ) {
822 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
823 next;
824 }
825 if ( grep $addr eq $_, @blacklist ) {
826 $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping");
827 next;
828 }
829 push @addrs, $addr;
830 }
831 foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) {
832 # never send email to itself
833 if ( !RT::EmailParser->CullRTAddresses($addr) ) {
834 $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" );
835 next;
836 }
837 push @addrs, $addr;
838 }
839 @{ $self->{$type} } = @addrs;
840 }
841}
842
843=head2 SetReturnAddress is_comment => BOOLEAN
844
845Calculate and set From and Reply-To headers based on the is_comment flag.
846
847=cut
848
849sub SetReturnAddress {
850
851 my $self = shift;
852 my %args = (
853 is_comment => 0,
854 friendly_name => undef,
855 @_
856 );
857
858 # From and Reply-To
859 # $args{is_comment} should be set if the comment address is to be used.
860 my $replyto;
861
862 if ( $args{'is_comment'} ) {
863 $replyto = $self->TicketObj->QueueObj->CommentAddress
864 || RT->Config->Get('CommentAddress');
865 } else {
866 $replyto = $self->TicketObj->QueueObj->CorrespondAddress
867 || RT->Config->Get('CorrespondAddress');
868 }
869
870 unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
871 $self->SetFrom( %args, From => $replyto );
872 }
873
874 unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
875 $self->SetHeader( 'Reply-To', "$replyto" );
876 }
877
878}
879
880=head2 SetFrom ( From => emailaddress )
881
882Set the From: address for outgoing email
883
884=cut
885
886sub SetFrom {
887 my $self = shift;
888 my %args = @_;
889
890 if ( RT->Config->Get('UseFriendlyFromLine') ) {
891 my $friendly_name = $self->GetFriendlyName(%args);
892 $self->SetHeader(
893 'From',
894 sprintf(
895 RT->Config->Get('FriendlyFromLineFormat'),
896 $self->MIMEEncodeString(
897 $friendly_name, RT->Config->Get('EmailOutputEncoding')
898 ),
899 $args{From}
900 ),
901 );
902 } else {
903 $self->SetHeader( 'From', $args{From} );
904 }
905}
906
907=head2 GetFriendlyName
908
909Calculate the proper Friendly Name based on the creator of the transaction
910
911=cut
912
913sub GetFriendlyName {
914 my $self = shift;
915 my %args = (
916 is_comment => 0,
917 friendly_name => '',
918 @_
919 );
920 my $friendly_name = $args{friendly_name};
921
922 unless ( $friendly_name ) {
923 $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
924 if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string
925 $friendly_name = $1;
926 }
927 }
928
929 $friendly_name =~ s/"/\\"/g;
930 return $friendly_name;
931
932}
933
934=head2 SetHeader FIELD, VALUE
935
936Set the FIELD of the current MIME object into VALUE.
937
938=cut
939
940sub SetHeader {
941 my $self = shift;
942 my $field = shift;
943 my $val = shift;
944
945 chomp $val;
946 chomp $field;
947 my $head = $self->TemplateObj->MIMEObj->head;
948 $head->fold_length( $field, 10000 );
949 $head->replace( $field, $val );
950 return $head->get($field);
951}
952
953=head2 SetSubject
954
955This routine sets the subject. it does not add the rt tag. That gets done elsewhere
956If subject is already defined via template, it uses that. otherwise, it tries to get
957the transaction's subject.
958
959=cut
960
961sub SetSubject {
962 my $self = shift;
963 my $subject;
964
965 if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) {
966 return ();
967 }
968
969 # don't use Transaction->Attachments because it caches
970 # and anything which later calls ->Attachments will be hurt
971 # by our RowsPerPage() call. caching is hard.
972 my $message = RT::Attachments->new( $self->CurrentUser );
973 $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id);
974 $message->OrderBy( FIELD => 'id', ORDER => 'ASC' );
975 $message->RowsPerPage(1);
976
977 if ( $self->{'Subject'} ) {
978 $subject = $self->{'Subject'};
979 } elsif ( my $first = $message->First ) {
980 my $tmp = $first->GetHeader('Subject');
981 $subject = defined $tmp ? $tmp : $self->TicketObj->Subject;
982 } else {
983 $subject = $self->TicketObj->Subject;
984 }
985 $subject = '' unless defined $subject;
986 chomp $subject;
987
988 $subject =~ s/(\r\n|\n|\s)/ /g;
989
990 $self->SetHeader( 'Subject', $subject );
991
992}
993
994=head2 SetSubjectToken
995
996This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this.
997
998=cut
999
1000sub SetSubjectToken {
1001 my $self = shift;
1002
1003 my $head = $self->TemplateObj->MIMEObj->head;
1004 $head->replace(
1005 Subject => RT::Interface::Email::AddSubjectTag(
1006 Encode::decode_utf8( $head->get('Subject') ),
1007 $self->TicketObj,
1008 ),
1009 );
1010}
1011
1012=head2 SetReferencesHeaders
1013
1014Set References and In-Reply-To headers for this message.
1015
1016=cut
1017
1018sub SetReferencesHeaders {
1019 my $self = shift;
1020
1021 my $top = $self->TransactionObj->Message->First;
1022 unless ( $top ) {
1023 $self->SetHeader( References => $self->PseudoReference );
1024 return (undef);
1025 }
1026
1027 my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' );
1028 my @references = split( /\s+/m, $top->GetHeader('References') || '' );
1029 my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' );
1030
1031 # There are two main cases -- this transaction was created with
1032 # the RT Web UI, and hence we want to *not* append its Message-ID
1033 # to the References and In-Reply-To. OR it came from an outside
1034 # source, and we should treat it as per the RFC
1035 my $org = RT->Config->Get('Organization');
1036 if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) {
1037
1038 # Make all references which are internal be to version which we
1039 # have sent out
1040
1041 for ( @references, @in_reply_to ) {
1042 s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/
1043 "<$1." . $self->TicketObj->id .
1044 "-" . $self->ScripObj->id .
1045 "-" . $self->ScripActionObj->{_Message_ID} .
1046 "@" . $org . ">"/eg
1047 }
1048
1049 # In reply to whatever the internal message was in reply to
1050 $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) );
1051
1052 # Default the references to whatever we're in reply to
1053 @references = @in_reply_to unless @references;
1054
1055 # References are unchanged from internal
1056 } else {
1057
1058 # In reply to that message
1059 $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) );
1060
1061 # Default the references to whatever we're in reply to
1062 @references = @in_reply_to unless @references;
1063
1064 # Push that message onto the end of the references
1065 push @references, @msgid;
1066 }
1067
1068 # Push pseudo-ref to the front
1069 my $pseudo_ref = $self->PseudoReference;
1070 @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references );
1071
1072 # If there are more than 10 references headers, remove all but the
1073 # first four and the last six (Gotta keep this from growing
1074 # forever)
1075 splice( @references, 4, -6 ) if ( $#references >= 10 );
1076
1077 # Add on the references
1078 $self->SetHeader( 'References', join( " ", @references ) );
1079 $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 );
1080
1081}
1082
1083=head2 PseudoReference
1084
1085Returns a fake Message-ID: header for the ticket to allow a base level of threading
1086
1087=cut
1088
1089sub PseudoReference {
1090
1091 my $self = shift;
1092 my $pseudo_ref
1093 = '<RT-Ticket-'
1094 . $self->TicketObj->id . '@'
1095 . RT->Config->Get('Organization') . '>';
1096 return $pseudo_ref;
1097}
1098
1099=head2 SetHeaderAsEncoding($field_name, $charset_encoding)
1100
1101This routine converts the field into specified charset encoding.
1102
1103=cut
1104
1105sub SetHeaderAsEncoding {
1106 my $self = shift;
1107 my ( $field, $enc ) = ( shift, shift );
1108
1109 my $head = $self->TemplateObj->MIMEObj->head;
1110
1111 if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) {
1112 $head->replace( $field, RT->Config->Get('SMTPFrom') );
1113 return;
1114 }
1115
1116 my $value = $head->get( $field );
1117 $value = $self->MIMEEncodeString( $value, $enc );
1118 $head->replace( $field, $value );
1119
1120}
1121
1122=head2 MIMEEncodeString
1123
1124Takes a perl string and optional encoding pass it over
1125L<RT::Interface::Email/EncodeToMIME>.
1126
1127Basicly encode a string using B encoding according to RFC2047.
1128
1129=cut
1130
1131sub MIMEEncodeString {
1132 my $self = shift;
1133 return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] );
1134}
1135
1136RT::Base->_ImportOverlays();
1137
11381;
1139