]>
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 | ||
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 | ||
147 | Builds an outgoing email we're going to send using scrip's template. | |
148 | ||
149 | =cut | |
150 | ||
151 | sub 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 | ||
242 | Returns an array of L<Email::Address> objects containing all the To: recipients for this notification | |
243 | ||
244 | =cut | |
245 | ||
246 | sub To { | |
247 | my $self = shift; | |
248 | return ( $self->AddressesFromHeader('To') ); | |
249 | } | |
250 | ||
251 | =head2 Cc | |
252 | ||
253 | Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification | |
254 | ||
255 | =cut | |
256 | ||
257 | sub Cc { | |
258 | my $self = shift; | |
259 | return ( $self->AddressesFromHeader('Cc') ); | |
260 | } | |
261 | ||
262 | =head2 Bcc | |
263 | ||
264 | Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification | |
265 | ||
266 | =cut | |
267 | ||
268 | sub Bcc { | |
269 | my $self = shift; | |
270 | return ( $self->AddressesFromHeader('Bcc') ); | |
271 | ||
272 | } | |
273 | ||
274 | sub 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 | ||
285 | sends the message using RT's preferred API. | |
286 | TODO: Break this out to a separate module | |
287 | ||
288 | =cut | |
289 | ||
290 | sub 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 | ||
339 | Takes any attachments to this transaction and attaches them to the message | |
340 | we're building. | |
341 | ||
342 | =cut | |
343 | ||
344 | sub 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 | ||
401 | Takes one attachment object of L<RT::Attachmment> class and attaches it to the message | |
402 | we're building. | |
403 | ||
404 | =cut | |
405 | ||
406 | sub 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 | ||
434 | Returns or set list of ticket's IDs that should be attached to an outgoing message. | |
435 | ||
436 | B<Note> this method works as a class method and setup things global, so you have to | |
437 | clean 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 | ||
453 | Attaches tickets to the current message, list of tickets' ids get from | |
454 | L</AttachTickets> method. | |
455 | ||
456 | =cut | |
457 | ||
458 | sub AddTickets { | |
459 | my $self = shift; | |
460 | $self->AddTicket($_) foreach $self->AttachTickets; | |
461 | return; | |
462 | } | |
463 | ||
464 | =head2 AddTicket $ID | |
465 | ||
466 | Attaches a ticket with ID to the message. | |
467 | ||
468 | Each ticket is attached as multipart entity and all its messages and attachments | |
469 | are attached as sub entities in order of creation, but only if transaction type | |
470 | is Create or Correspond. | |
471 | ||
472 | =cut | |
473 | ||
474 | sub 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 | ||
508 | Record a transaction in RT with this outgoing message for future record-keeping purposes | |
509 | ||
510 | =cut | |
511 | ||
512 | sub 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 | ||
571 | This routine adds all the random headers that RT wants in a mail message | |
572 | that don't matter much to anybody else. | |
573 | ||
574 | =cut | |
575 | ||
576 | sub 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 | ||
642 | sub 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 | ||
720 | sub 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 | ||
741 | Returns list of the addresses to squelch on this transaction. | |
742 | ||
743 | =cut | |
744 | ||
745 | sub SquelchMailTo { | |
746 | my $self = shift; | |
747 | return map $_->Content, $self->TransactionObj->SquelchMailTo; | |
748 | } | |
749 | ||
750 | =head2 RemoveInappropriateRecipients | |
751 | ||
752 | Remove addresses that are RT addresses or that are on this transaction's blacklist | |
753 | ||
754 | =cut | |
755 | ||
756 | sub 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 | ||
845 | Calculate and set From and Reply-To headers based on the is_comment flag. | |
846 | ||
847 | =cut | |
848 | ||
849 | sub 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 | ||
882 | Set the From: address for outgoing email | |
883 | ||
884 | =cut | |
885 | ||
886 | sub 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 | ||
909 | Calculate the proper Friendly Name based on the creator of the transaction | |
910 | ||
911 | =cut | |
912 | ||
913 | sub 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 | ||
936 | Set the FIELD of the current MIME object into VALUE. | |
937 | ||
938 | =cut | |
939 | ||
940 | sub 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 | ||
955 | This routine sets the subject. it does not add the rt tag. That gets done elsewhere | |
956 | If subject is already defined via template, it uses that. otherwise, it tries to get | |
957 | the transaction's subject. | |
958 | ||
959 | =cut | |
960 | ||
961 | sub 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 | ||
996 | This routine fixes the RT tag in the subject. It's unlikely that you want to overwrite this. | |
997 | ||
998 | =cut | |
999 | ||
1000 | sub 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 | ||
1014 | Set References and In-Reply-To headers for this message. | |
1015 | ||
1016 | =cut | |
1017 | ||
1018 | sub 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 | ||
1085 | Returns a fake Message-ID: header for the ticket to allow a base level of threading | |
1086 | ||
1087 | =cut | |
1088 | ||
1089 | sub 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 | ||
1101 | This routine converts the field into specified charset encoding. | |
1102 | ||
1103 | =cut | |
1104 | ||
1105 | sub 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 | ||
1124 | Takes a perl string and optional encoding pass it over | |
1125 | L<RT::Interface::Email/EncodeToMIME>. | |
1126 | ||
1127 | Basicly encode a string using B encoding according to RFC2047. | |
1128 | ||
1129 | =cut | |
1130 | ||
1131 | sub MIMEEncodeString { | |
1132 | my $self = shift; | |
1133 | return RT::Interface::Email::EncodeToMIME( String => $_[0], Charset => $_[1] ); | |
1134 | } | |
1135 | ||
1136 | RT::Base->_ImportOverlays(); | |
1137 | ||
1138 | 1; | |
1139 |