]>
Commit | Line | Data |
---|---|---|
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 | ||
51 | package RT::Action::SendEmail; | |
52 | ||
53 | use strict; | |
54 | use warnings; | |
55 | ||
56 | use base qw(RT::Action); | |
57 | ||
58 | use RT::EmailParser; | |
59 | use RT::Interface::Email; | |
60 | use Email::Address; | |
61 | our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc); | |
62 | ||
63 | ||
64 | =head1 NAME | |
65 | ||
66 | RT::Action::SendEmail - An Action which users can use to send mail | |
67 | or can subclassed for more specialized mail sending behavior. | |
68 | RT::Action::AutoReply is a good example subclass. | |
69 | ||
70 | =head1 SYNOPSIS | |
71 | ||
72 | use base 'RT::Action::SendEmail'; | |
73 | ||
74 | =head1 DESCRIPTION | |
75 | ||
76 | Basically, you create another module RT::Action::YourAction which ISA | |
77 | RT::Action::SendEmail. | |
78 | ||
79 | =head1 METHODS | |
80 | ||
81 | =head2 CleanSlate | |
82 | ||
83 | Cleans class-wide options, like L</AttachTickets>. | |
84 | ||
85 | =cut | |
86 | ||
87 | sub CleanSlate { | |
88 | my $self = shift; | |
89 | $self->AttachTickets(undef); | |
90 | } | |
91 | ||
92 | =head2 Commit | |
93 | ||
94 | Sends the prepared message and writes outgoing record into DB if the feature is | |
95 | activated in the config. | |
96 | ||
97 | =cut | |
98 | ||
99 | sub Commit { | |
100 | my $self = shift; | |
101 | ||
86404187 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; | |
86404187 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); | |
86404187 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 | } |
86404187 MKG |
124 | $self->RecordOutgoingMailTransaction($message); |
125 | $self->RecordDeferredRecipients(); | |
126 | return 1; | |
84fb5b46 MKG |
127 | } |
128 | ||
129 | =head2 Prepare | |
130 | ||
131 | Builds an outgoing email we're going to send using scrip's template. | |
132 | ||
133 | =cut | |
134 | ||
135 | sub 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 | ||
226 | Returns an array of L<Email::Address> objects containing all the To: recipients for this notification | |
227 | ||
228 | =cut | |
229 | ||
230 | sub To { | |
231 | my $self = shift; | |
232 | return ( $self->AddressesFromHeader('To') ); | |
233 | } | |
234 | ||
235 | =head2 Cc | |
236 | ||
237 | Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification | |
238 | ||
239 | =cut | |
240 | ||
241 | sub Cc { | |
242 | my $self = shift; | |
243 | return ( $self->AddressesFromHeader('Cc') ); | |
244 | } | |
245 | ||
246 | =head2 Bcc | |
247 | ||
248 | Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification | |
249 | ||
250 | =cut | |
251 | ||
252 | sub Bcc { | |
253 | my $self = shift; | |
254 | return ( $self->AddressesFromHeader('Bcc') ); | |
255 | ||
256 | } | |
257 | ||
258 | sub 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 | ||
269 | sends the message using RT's preferred API. | |
270 | TODO: Break this out to a separate module | |
271 | ||
272 | =cut | |
273 | ||
274 | sub 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 | ||
323 | Takes any attachments to this transaction and attaches them to the message | |
324 | we're building. | |
325 | ||
326 | =cut | |
327 | ||
328 | sub 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 | ||
385 | Takes one attachment object of L<RT::Attachmment> class and attaches it to the message | |
386 | we're building. | |
387 | ||
388 | =cut | |
389 | ||
390 | sub 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 | |
400 | my $disp = ($attach->GetHeader('Content-Disposition') || '') | |
401 | =~ /^\s*(inline|attachment)/i ? $1 : undef; | |
402 | ||
403 | $MIMEObj->attach( | |
404 | Type => $attach->ContentType, | |
405 | Charset => $attach->OriginalEncoding, | |
406 | Data => $attach->OriginalContent, | |
407 | Disposition => $disp, # a false value defaults to inline in MIME::Entity | |
408 | Filename => $self->MIMEEncodeString( $attach->Filename ), | |
409 | 'RT-Attachment:' => $self->TicketObj->Id . "/" | |
410 | . $self->TransactionObj->Id . "/" | |
411 | . $attach->id, | |
412 | Encoding => '-SUGGEST', | |
413 | ); | |
414 | } | |
415 | ||
416 | =head2 AttachTickets [@IDs] | |
417 | ||
418 | Returns or set list of ticket's IDs that should be attached to an outgoing message. | |
419 | ||
420 | B<Note> this method works as a class method and setup things global, so you have to | |
421 | clean list by passing undef as argument. | |
422 | ||
423 | =cut | |
424 | ||
425 | { | |
426 | my $list = []; | |
427 | ||
428 | sub AttachTickets { | |
429 | my $self = shift; | |
430 | $list = [ grep defined, @_ ] if @_; | |
431 | return @$list; | |
432 | } | |
433 | } | |
434 | ||
435 | =head2 AddTickets | |
436 | ||
437 | Attaches tickets to the current message, list of tickets' ids get from | |
438 | L</AttachTickets> method. | |
439 | ||
440 | =cut | |
441 | ||
442 | sub AddTickets { | |
443 | my $self = shift; | |
444 | $self->AddTicket($_) foreach $self->AttachTickets; | |
445 | return; | |
446 | } | |
447 | ||
448 | =head2 AddTicket $ID | |
449 | ||
450 | Attaches a ticket with ID to the message. | |
451 | ||
452 | Each ticket is attached as multipart entity and all its messages and attachments | |
453 | are attached as sub entities in order of creation, but only if transaction type | |
454 | is Create or Correspond. | |
455 | ||
456 | =cut | |
457 | ||
458 | sub AddTicket { | |
459 | my $self = shift; | |
460 | my $tid = shift; | |
461 | ||
462 | my $attachs = RT::Attachments->new( $self->TransactionObj->CreatorObj ); | |
463 | my $txn_alias = $attachs->TransactionAlias; | |
464 | $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' ); | |
465 | $attachs->Limit( | |
466 | ALIAS => $txn_alias, | |
467 | FIELD => 'Type', | |
468 | VALUE => 'Correspond' | |
469 | ); | |
470 | $attachs->LimitByTicket($tid); | |
471 | $attachs->LimitNotEmpty; | |
472 | $attachs->OrderBy( FIELD => 'Created' ); | |
473 | ||
474 | my $ticket_mime = MIME::Entity->build( | |
475 | Type => 'multipart/mixed', | |
476 | Top => 0, | |
477 | Description => "ticket #$tid", | |
478 | ); | |
479 | while ( my $attachment = $attachs->Next ) { | |
480 | $self->AddAttachment( $attachment, $ticket_mime ); | |
481 | } | |
482 | if ( $ticket_mime->parts ) { | |
483 | my $email_mime = $self->TemplateObj->MIMEObj; | |
484 | $email_mime->make_multipart; | |
485 | $email_mime->add_part($ticket_mime); | |
486 | } | |
487 | return; | |
488 | } | |
489 | ||
490 | =head2 RecordOutgoingMailTransaction MIMEObj | |
491 | ||
492 | Record a transaction in RT with this outgoing message for future record-keeping purposes | |
493 | ||
494 | =cut | |
495 | ||
496 | sub RecordOutgoingMailTransaction { | |
497 | my $self = shift; | |
498 | my $MIMEObj = shift; | |
499 | ||
500 | my @parts = $MIMEObj->parts; | |
501 | my @attachments; | |
502 | my @keep; | |
503 | foreach my $part (@parts) { | |
504 | my $attach = $part->head->get('RT-Attachment'); | |
505 | if ($attach) { | |
506 | $RT::Logger->debug( | |
507 | "We found an attachment. we want to not record it."); | |
508 | push @attachments, $attach; | |
509 | } else { | |
510 | $RT::Logger->debug("We found a part. we want to record it."); | |
511 | push @keep, $part; | |
512 | } | |
513 | } | |
514 | $MIMEObj->parts( \@keep ); | |
515 | foreach my $attachment (@attachments) { | |
516 | $MIMEObj->head->add( 'RT-Attachment', $attachment ); | |
517 | } | |
518 | ||
519 | RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' ); | |
520 | ||
521 | my $transaction | |
522 | = RT::Transaction->new( $self->TransactionObj->CurrentUser ); | |
523 | ||
524 | # XXX: TODO -> Record attachments as references to things in the attachments table, maybe. | |
525 | ||
526 | my $type; | |
527 | if ( $self->TransactionObj->Type eq 'Comment' ) { | |
528 | $type = 'CommentEmailRecord'; | |
529 | } else { | |
530 | $type = 'EmailRecord'; | |
531 | } | |
532 | ||
533 | my $msgid = $MIMEObj->head->get('Message-ID'); | |
534 | chomp $msgid; | |
535 | ||
536 | my ( $id, $msg ) = $transaction->Create( | |
537 | Ticket => $self->TicketObj->Id, | |
538 | Type => $type, | |
539 | Data => $msgid, | |
540 | MIMEObj => $MIMEObj, | |
541 | ActivateScrips => 0 | |
542 | ); | |
543 | ||
544 | if ($id) { | |
545 | $self->{'OutgoingMailTransaction'} = $id; | |
546 | } else { | |
547 | $RT::Logger->warning( | |
548 | "Could not record outgoing message transaction: $msg"); | |
549 | } | |
550 | return $id; | |
551 | } | |
552 | ||
553 | =head2 SetRTSpecialHeaders | |
554 | ||
555 | This routine adds all the random headers that RT wants in a mail message | |
556 | that don't matter much to anybody else. | |
557 | ||
558 | =cut | |
559 | ||
560 | sub SetRTSpecialHeaders { | |
561 | my $self = shift; | |
562 | ||
563 | $self->SetSubject(); | |
564 | $self->SetSubjectToken(); | |
565 | $self->SetHeaderAsEncoding( 'Subject', | |
566 | RT->Config->Get('EmailOutputEncoding') ) | |
567 | if ( RT->Config->Get('EmailOutputEncoding') ); | |
568 | $self->SetReturnAddress(); | |
569 | $self->SetReferencesHeaders(); | |
570 | ||
571 | unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) { | |
572 | ||
573 | # Get Message-ID for this txn | |
574 | my $msgid = ""; | |
575 | if ( my $msg = $self->TransactionObj->Message->First ) { | |
576 | $msgid = $msg->GetHeader("RT-Message-ID") | |
577 | || $msg->GetHeader("Message-ID"); | |
578 | } | |
579 | ||
580 | # If there is one, and we can parse it, then base our Message-ID on it | |
581 | if ( $msgid | |
582 | and $msgid | |
583 | =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/ | |
584 | "<$1." . $self->TicketObj->id | |
585 | . "-" . $self->ScripObj->id | |
586 | . "-" . $self->ScripActionObj->{_Message_ID} | |
587 | . "@" . RT->Config->Get('Organization') . ">"/eg | |
588 | and $2 == $self->TicketObj->id | |
589 | ) | |
590 | { | |
591 | $self->SetHeader( "Message-ID" => $msgid ); | |
592 | } else { | |
593 | $self->SetHeader( | |
594 | 'Message-ID' => RT::Interface::Email::GenMessageId( | |
595 | Ticket => $self->TicketObj, | |
596 | Scrip => $self->ScripObj, | |
597 | ScripAction => $self->ScripActionObj | |
598 | ), | |
599 | ); | |
600 | } | |
601 | } | |
602 | ||
603 | if (my $precedence = RT->Config->Get('DefaultMailPrecedence') | |
604 | and !$self->TemplateObj->MIMEObj->head->get("Precedence") | |
605 | ) { | |
606 | $self->SetHeader( 'Precedence', $precedence ); | |
607 | } | |
608 | ||
609 | $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') ); | |
610 | $self->SetHeader( 'RT-Ticket', | |
611 | RT->Config->Get('rtname') . " #" . $self->TicketObj->id() ); | |
612 | $self->SetHeader( 'Managed-by', | |
613 | "RT $RT::VERSION (http://www.bestpractical.com/rt/)" ); | |
614 | ||
615 | # XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be | |
616 | # refactored into user's method. | |
617 | if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress | |
618 | and RT->Config->Get('UseOriginatorHeader') | |
619 | ) { | |
620 | $self->SetHeader( 'RT-Originator', $email ); | |
621 | } | |
622 | ||
623 | } | |
624 | ||
625 | ||
626 | sub DeferDigestRecipients { | |
627 | my $self = shift; | |
628 | $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id ); | |
629 | ||
630 | # The digest attribute will be an array of notifications that need to | |
631 | # be sent for this transaction. The array will have the following | |
632 | # format for its objects. | |
633 | # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc} | |
634 | # -> sent -> {true|false} | |
635 | # The "sent" flag will be used by the cron job to indicate that it has | |
636 | # run on this transaction. | |
637 | # In a perfect world we might move this hash construction to the | |
638 | # extension module itself. | |
639 | my $digest_hash = {}; | |
640 | ||
641 | foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) { | |
642 | # If we have a "PseudoTo", the "To" contains it, so we don't need to access it | |
643 | next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) ); | |
644 | $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) ); | |
645 | ||
646 | # Store the 'daily digest' folk in an array. | |
647 | my ( @send_now, @daily_digest, @weekly_digest, @suspended ); | |
648 | ||
649 | # Have to get the list of addresses directly from the MIME header | |
650 | # at this point. | |
651 | $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string ); | |
652 | foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) { | |
653 | next unless $rcpt; | |
654 | my $user_obj = RT::User->new(RT->SystemUser); | |
655 | $user_obj->LoadByEmail($rcpt); | |
656 | if ( ! $user_obj->id ) { | |
657 | # If there's an email address in here without an associated | |
658 | # RT user, pass it on through. | |
659 | $RT::Logger->debug( "User $rcpt is not associated with an RT user object. Send mail."); | |
660 | push( @send_now, $rcpt ); | |
661 | next; | |
662 | } | |
663 | ||
664 | my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || ''; | |
665 | $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt"); | |
666 | ||
667 | if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) } | |
668 | elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) } | |
669 | elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) } | |
670 | else { push( @send_now, $rcpt ) } | |
671 | } | |
672 | ||
673 | # Reset the relevant mail field. | |
674 | $RT::Logger->debug( "Removing deferred recipients from $mailfield: line"); | |
675 | if (@send_now) { | |
676 | $self->SetHeader( $mailfield, join( ', ', @send_now ) ); | |
677 | } else { # No recipients! Remove the header. | |
678 | $self->TemplateObj->MIMEObj->head->delete($mailfield); | |
679 | } | |
680 | ||
681 | # Push the deferred addresses into the appropriate field in | |
682 | # our attribute hash, with the appropriate mail header. | |
683 | $RT::Logger->debug( | |
684 | "Setting deferred recipients for attribute creation"); | |
685 | $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0} for (@daily_digest); | |
686 | $digest_hash->{'weekly'}->{$_} ={'header' => $mailfield, _sent => 0} for (@weekly_digest); | |
687 | $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 } for (@suspended); | |
688 | } | |
689 | ||
690 | if ( scalar keys %$digest_hash ) { | |
691 | ||
692 | # Save the hash so that we can add it as an attribute to the | |
693 | # outgoing email transaction. | |
694 | $self->{'Deferred'} = $digest_hash; | |
695 | } else { | |
696 | $RT::Logger->debug( "No recipients found for deferred delivery on " | |
697 | . "transaction #" | |
698 | . $self->TransactionObj->id ); | |
699 | } | |
700 | } | |
701 | ||
702 | ||
703 | ||
704 | sub RecordDeferredRecipients { | |
705 | my $self = shift; | |
706 | return unless exists $self->{'Deferred'}; | |
707 | ||
708 | my $txn_id = $self->{'OutgoingMailTransaction'}; | |
709 | return unless $txn_id; | |
710 | ||
711 | my $txn_obj = RT::Transaction->new( $self->CurrentUser ); | |
712 | $txn_obj->Load( $txn_id ); | |
713 | my( $ret, $msg ) = $txn_obj->AddAttribute( | |
714 | Name => 'DeferredRecipients', | |
715 | Content => $self->{'Deferred'} | |
716 | ); | |
717 | $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) | |
718 | unless $ret; | |
719 | ||
720 | return ($ret,$msg); | |
721 | } | |
722 | ||
723 | =head2 SquelchMailTo | |
724 | ||
725 | Returns list of the addresses to squelch on this transaction. | |
726 | ||
727 | =cut | |
728 | ||
729 | sub SquelchMailTo { | |
730 | my $self = shift; | |
731 | return map $_->Content, $self->TransactionObj->SquelchMailTo; | |
732 | } | |
733 | ||
734 | =head2 RemoveInappropriateRecipients | |
735 | ||
736 | Remove addresses that are RT addresses or that are on this transaction's blacklist | |
737 | ||
738 | =cut | |
739 | ||
740 | sub RemoveInappropriateRecipients { | |
741 | my $self = shift; | |
742 | ||
743 | my @blacklist = (); | |
744 | ||
745 | # If there are no recipients, don't try to send the message. | |
746 | # If the transaction has content and has the header RT-Squelch-Replies-To | |
747 | ||
748 | my $msgid = $self->TemplateObj->MIMEObj->head->get('Message-Id'); | |
749 | if ( my $attachment = $self->TransactionObj->Attachments->First ) { | |
750 | ||
751 | if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) { | |
752 | ||
753 | # What do we want to do with this? It's probably (?) a bounce | |
754 | # caused by one of the watcher addresses being broken. | |
755 | # Default ("true") is to redistribute, for historical reasons. | |
756 | ||
757 | if ( !RT->Config->Get('RedistributeAutoGeneratedMessages') ) { | |
758 | ||
759 | # Don't send to any watchers. | |
760 | @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS); | |
761 | $RT::Logger->info( $msgid | |
762 | . " The incoming message was autogenerated. " | |
763 | . "Not redistributing this message based on site configuration." | |
764 | ); | |
765 | } elsif ( RT->Config->Get('RedistributeAutoGeneratedMessages') eq | |
766 | 'privileged' ) | |
767 | { | |
768 | ||
769 | # Only send to "privileged" watchers. | |
770 | foreach my $type (@EMAIL_RECIPIENT_HEADERS) { | |
771 | foreach my $addr ( @{ $self->{$type} } ) { | |
772 | my $user = RT::User->new(RT->SystemUser); | |
773 | $user->LoadByEmail($addr); | |
774 | push @blacklist, $addr unless $user->id && $user->Privileged; | |
775 | } | |
776 | } | |
777 | $RT::Logger->info( $msgid | |
778 | . " The incoming message was autogenerated. " | |
779 | . "Not redistributing this message to unprivileged users based on site configuration." | |
780 | ); | |
781 | } | |
782 | } | |
783 | ||
784 | if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) { | |
785 | push @blacklist, split( /,/, $squelch ); | |
786 | } | |
787 | } | |
788 | ||
789 | # Let's grab the SquelchMailTo attributes and push those entries into the @blacklisted | |
790 | push @blacklist, map $_->Content, $self->TicketObj->SquelchMailTo, $self->TransactionObj->SquelchMailTo; | |
791 | ||
792 | # Cycle through the people we're sending to and pull out anyone on the | |
793 | # system blacklist | |
794 | ||
795 | # Trim leading and trailing spaces. | |
796 | @blacklist = map { RT::User->CanonicalizeEmailAddress( $_->address ) } | |
797 | Email::Address->parse( join ', ', grep defined, @blacklist ); | |
798 | ||
799 | foreach my $type (@EMAIL_RECIPIENT_HEADERS) { | |
800 | my @addrs; | |
801 | foreach my $addr ( @{ $self->{$type} } ) { | |
802 | ||
803 | # Weed out any RT addresses. We really don't want to talk to ourselves! | |
804 | # If we get a reply back, that means it's not an RT address | |
805 | if ( !RT::EmailParser->CullRTAddresses($addr) ) { | |
806 | $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); | |
807 | next; | |
808 | } | |
809 | if ( grep $addr eq $_, @blacklist ) { | |
810 | $RT::Logger->info( $msgid . "$addr was blacklisted for outbound mail on this transaction. Skipping"); | |
811 | next; | |
812 | } | |
813 | push @addrs, $addr; | |
814 | } | |
815 | foreach my $addr ( @{ $self->{'NoSquelch'}{$type} || [] } ) { | |
816 | # never send email to itself | |
817 | if ( !RT::EmailParser->CullRTAddresses($addr) ) { | |
818 | $RT::Logger->info( $msgid . "$addr appears to point to this RT instance. Skipping" ); | |
819 | next; | |
820 | } | |
821 | push @addrs, $addr; | |
822 | } | |
823 | @{ $self->{$type} } = @addrs; | |
824 | } | |
825 | } | |
826 | ||
827 | =head2 SetReturnAddress is_comment => BOOLEAN | |
828 | ||
829 | Calculate and set From and Reply-To headers based on the is_comment flag. | |
830 | ||
831 | =cut | |
832 | ||
833 | sub SetReturnAddress { | |
834 | ||
835 | my $self = shift; | |
836 | my %args = ( | |
837 | is_comment => 0, | |
838 | friendly_name => undef, | |
839 | @_ | |
840 | ); | |
841 | ||
842 | # From and Reply-To | |
843 | # $args{is_comment} should be set if the comment address is to be used. | |
844 | my $replyto; | |
845 | ||
846 | if ( $args{'is_comment'} ) { | |
847 | $replyto = $self->TicketObj->QueueObj->CommentAddress | |
848 | || RT->Config->Get('CommentAddress'); | |
849 | } else { | |
850 | $replyto = $self->TicketObj->QueueObj->CorrespondAddress | |
851 | || RT->Config->Get('CorrespondAddress'); | |
852 | } | |
853 | ||
854 | unless ( $self->TemplateObj->MIMEObj->head->get('From') ) { | |
855 | $self->SetFrom( %args, From => $replyto ); | |
856 | } | |
857 | ||
858 | unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) { | |
859 | $self->SetHeader( 'Reply-To', "$replyto" ); | |
860 | } | |
861 | ||
862 | } | |
863 | ||
864 | =head2 SetFrom ( From => emailaddress ) | |
865 | ||
866 | Set the From: address for outgoing email | |
867 | ||
868 | =cut | |
869 | ||
870 | sub SetFrom { | |
871 | my $self = shift; | |
872 | my %args = @_; | |
873 | ||
874 | if ( RT->Config->Get('UseFriendlyFromLine') ) { | |
875 | my $friendly_name = $self->GetFriendlyName(%args); | |
876 | $self->SetHeader( | |
877 | 'From', | |
878 | sprintf( | |
879 | RT->Config->Get('FriendlyFromLineFormat'), | |
880 | $self->MIMEEncodeString( | |
881 | $friendly_name, RT->Config->Get('EmailOutputEncoding') | |
882 | ), | |
883 | $args{From} | |
884 | ), | |
885 | ); | |
886 | } else { | |
887 | $self->SetHeader( 'From', $args{From} ); | |
888 | } | |
889 | } | |
890 | ||
891 | =head2 GetFriendlyName | |
892 | ||
893 | Calculate the proper Friendly Name based on the creator of the transaction | |
894 | ||
895 | =cut | |
896 | ||
897 | sub GetFriendlyName { | |
898 | my $self = shift; | |
899 | my %args = ( | |
900 | is_comment => 0, | |
901 | friendly_name => '', | |
902 | @_ | |
903 | ); | |
904 | my $friendly_name = $args{friendly_name}; | |
905 | ||
906 | unless ( $friendly_name ) { | |
907 | $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName; | |
908 | if ( $friendly_name =~ /^"(.*)"$/ ) { # a quoted string | |
909 | $friendly_name = $1; | |
910 | } | |
911 | } | |
912 | ||
913 | $friendly_name =~ s/"/\\"/g; | |
914 | return $friendly_name; | |
915 | ||
916 | } | |
917 | ||
918 | =head2 SetHeader FIELD, VALUE | |
919 | ||
920 | Set the FIELD of the current MIME object into VALUE. | |
921 | ||
922 | =cut | |
923 | ||
924 | sub SetHeader { | |
925 | my $self = shift; | |
926 | my $field = shift; | |
927 | my $val = shift; | |
928 | ||
929 | chomp $val; | |
930 | chomp $field; | |
931 | my $head = $self->TemplateObj->MIMEObj->head; | |
932 | $head->fold_length( $field, 10000 ); | |
933 | $head->replace( $field, $val ); | |
934 | return $head->get($field); | |
935 | } | |
936 | ||
937 | =head2 SetSubject | |
938 | ||
939 | This routine sets the subject. it does not add the rt tag. That gets done elsewhere | |
940 | If subject is already defined via template, it uses that. otherwise, it tries to get | |
941 | the transaction's subject. | |
942 | ||
943 | =cut | |
944 | ||
945 | sub SetSubject { | |
946 | my $self = shift; | |
947 | my $subject; | |
948 | ||
949 | if ( $self->TemplateObj->MIMEObj->head->get('Subject') ) { | |
950 | return (); | |
951 | } | |
952 | ||
953 | # don't use Transaction->Attachments because it caches | |
954 | # and anything which later calls ->Attachments will be hurt | |
955 | # by our RowsPerPage() call. caching is hard. | |
956 | my $message = RT::Attachments->new( $self->CurrentUser ); | |
957 | $message->Limit( FIELD => 'TransactionId', VALUE => $self->TransactionObj->id); | |
958 | $message->OrderBy( FIELD => 'id', ORDER => 'ASC' ); | |
959 | $message->RowsPerPage(1); | |
960 | ||
961 | if ( $self->{'Subject'} ) { | |
962 | $subject = $self->{'Subject'}; | |
963 | } elsif ( my $first = $message->First ) { | |
964 | my $tmp = $first->GetHeader('Subject'); | |
965 | $subject = defined $tmp ? $tmp : $self->TicketObj->Subject; | |
966 | } else { | |
967 | $subject = $self->TicketObj->Subject; | |
968 | } | |
969 | $subject = '' unless defined $subject; | |
970 | chomp $subject; | |
971 | ||
972 | $subject =~ s/(\r\n|\n|\s)/ /g; | |
973 | ||
974 | $self->SetHeader( 'Subject', $subject ); | |
975 | ||
976 | } | |
977 | ||
978 | =head2 SetSubjectToken | |
979 | ||
980 | This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. | |
981 | ||
982 | =cut | |
983 | ||
984 | sub SetSubjectToken { | |
985 | my $self = shift; | |
986 | ||
987 | my $head = $self->TemplateObj->MIMEObj->head; | |
988 | $head->replace( | |
989 | Subject => RT::Interface::Email::AddSubjectTag( | |
990 | Encode::decode_utf8( $head->get('Subject') ), | |
991 | $self->TicketObj, | |
992 | ), | |
993 | ); | |
994 | } | |
995 | ||
996 | =head2 SetReferencesHeaders | |
997 | ||
998 | Set References and In-Reply-To headers for this message. | |
999 | ||
1000 | =cut | |
1001 | ||
1002 | sub SetReferencesHeaders { | |
1003 | my $self = shift; | |
1004 | ||
1005 | my $top = $self->TransactionObj->Message->First; | |
1006 | unless ( $top ) { | |
1007 | $self->SetHeader( References => $self->PseudoReference ); | |
1008 | return (undef); | |
1009 | } | |
1010 | ||
1011 | my @in_reply_to = split( /\s+/m, $top->GetHeader('In-Reply-To') || '' ); | |
1012 | my @references = split( /\s+/m, $top->GetHeader('References') || '' ); | |
1013 | my @msgid = split( /\s+/m, $top->GetHeader('Message-ID') || '' ); | |
1014 | ||
1015 | # There are two main cases -- this transaction was created with | |
1016 | # the RT Web UI, and hence we want to *not* append its Message-ID | |
1017 | # to the References and In-Reply-To. OR it came from an outside | |
1018 | # source, and we should treat it as per the RFC | |
1019 | my $org = RT->Config->Get('Organization'); | |
1020 | if ( "@msgid" =~ /<(rt-.*?-\d+-\d+)\.(\d+)-0-0\@\Q$org\E>/ ) { | |
1021 | ||
1022 | # Make all references which are internal be to version which we | |
1023 | # have sent out | |
1024 | ||
1025 | for ( @references, @in_reply_to ) { | |
1026 | s/<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>$/ | |
1027 | "<$1." . $self->TicketObj->id . | |
1028 | "-" . $self->ScripObj->id . | |
1029 | "-" . $self->ScripActionObj->{_Message_ID} . | |
1030 | "@" . $org . ">"/eg | |
1031 | } | |
1032 | ||
1033 | # In reply to whatever the internal message was in reply to | |
1034 | $self->SetHeader( 'In-Reply-To', join( " ", (@in_reply_to) ) ); | |
1035 | ||
1036 | # Default the references to whatever we're in reply to | |
1037 | @references = @in_reply_to unless @references; | |
1038 | ||
1039 | # References are unchanged from internal | |
1040 | } else { | |
1041 | ||
1042 | # In reply to that message | |
1043 | $self->SetHeader( 'In-Reply-To', join( " ", (@msgid) ) ); | |
1044 | ||
1045 | # Default the references to whatever we're in reply to | |
1046 | @references = @in_reply_to unless @references; | |
1047 | ||
1048 | # Push that message onto the end of the references | |
1049 | push @references, @msgid; | |
1050 | } | |
1051 | ||
1052 | # Push pseudo-ref to the front | |
1053 | my $pseudo_ref = $self->PseudoReference; | |
1054 | @references = ( $pseudo_ref, grep { $_ ne $pseudo_ref } @references ); | |
1055 | ||
1056 | # If there are more than 10 references headers, remove all but the | |
1057 | # first four and the last six (Gotta keep this from growing | |
1058 | # forever) | |
1059 | splice( @references, 4, -6 ) if ( $#references >= 10 ); | |
1060 | ||
1061 | # Add on the references | |
1062 | $self->SetHeader( 'References', join( " ", @references ) ); | |
1063 | $self->TemplateObj->MIMEObj->head->fold_length( 'References', 80 ); | |
1064 | ||
1065 | } | |
1066 | ||
1067 | =head2 PseudoReference | |
1068 | ||
1069 | Returns a fake Message-ID: header for the ticket to allow a base level of threading | |
1070 | ||
1071 | =cut | |
1072 | ||
1073 | sub PseudoReference { | |
1074 | ||
1075 | my $self = shift; | |
1076 | my $pseudo_ref | |
1077 | = '<RT-Ticket-' | |
1078 | . $self->TicketObj->id . '@' | |
1079 | . RT->Config->Get('Organization') . '>'; | |
1080 | return $pseudo_ref; | |
1081 | } | |
1082 | ||
1083 | =head2 SetHeaderAsEncoding($field_name, $charset_encoding) | |
1084 | ||
1085 | This routine converts the field into specified charset encoding. | |
1086 | ||
1087 | =cut | |
1088 | ||
1089 | sub SetHeaderAsEncoding { | |
1090 | my $self = shift; | |
1091 | my ( $field, $enc ) = ( shift, shift ); | |
1092 | ||
1093 | my $head = $self->TemplateObj->MIMEObj->head; | |
1094 | ||
1095 | if ( lc($field) eq 'from' and RT->Config->Get('SMTPFrom') ) { | |
1096 | $head->replace( $field, RT->Config->Get('SMTPFrom') ); | |
1097 | return; | |
1098 | } | |
1099 | ||
1100 | my $value = $head->get( $field ); | |
1101 | $value = $self->MIMEEncodeString( $value, $enc ); | |
1102 | $head->replace( $field, $value ); | |
1103 | ||
1104 | } | |
1105 | ||
1106 | =head2 MIMEEncodeString | |
1107 | ||
1108 | Takes a perl string and optional encoding pass it over | |
1109 | L<RT::Interface::Email/EncodeToMIME>. | |
1110 | ||
1111 | Basicly encode a string using B encoding according to RFC2047. | |
1112 | ||
1113 | =cut | |
1114 | ||
1115 | sub MIMEEncodeString { | |
1116 | my $self = shift; | |
1117 | return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); | |
1118 | } | |
1119 | ||
1120 | RT::Base->_ImportOverlays(); | |
1121 | ||
1122 | 1; | |
1123 |