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