SendEmail.pm 35 KB
Newer Older
1
# BEGIN BPS TAGGED BLOCK {{{
Jesse Vincent's avatar
Jesse Vincent committed
2
#
3
# COPYRIGHT:
Jesse Vincent's avatar
Jesse Vincent committed
4
#
5
# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
Kevin Falcone's avatar
Kevin Falcone committed
6
#                                          <sales@bestpractical.com>
Jesse Vincent's avatar
Jesse Vincent committed
7
#
8
# (Except where explicitly superseded by other copyright notices)
Jesse Vincent's avatar
Jesse Vincent committed
9
10
#
#
11
# LICENSE:
Jesse Vincent's avatar
Jesse Vincent committed
12
#
13
14
15
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
16
# from www.gnu.org.
Jesse Vincent's avatar
Jesse Vincent committed
17
#
18
19
20
21
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
Jesse Vincent's avatar
Jesse Vincent committed
22
#
23
24
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
Jesse Vincent's avatar
Jesse Vincent committed
25
26
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
Ruslan Zakirov's avatar
Ruslan Zakirov committed
27
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
Jesse Vincent's avatar
Jesse Vincent committed
28
29
#
#
30
# CONTRIBUTION SUBMISSION POLICY:
Jesse Vincent's avatar
Jesse Vincent committed
31
#
32
33
34
35
36
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
Jesse Vincent's avatar
Jesse Vincent committed
37
#
38
39
40
41
42
43
44
45
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
Jesse Vincent's avatar
Jesse Vincent committed
46
#
47
# END BPS TAGGED BLOCK }}}
48

49
# Portions Copyright 2000 Tobias Brox <tobix@cpan.org>
50

51
package RT::Action::SendEmail;
Tobias Brox's avatar
Tobias Brox committed
52

53
use strict;
Ruslan Zakirov's avatar
minor    
Ruslan Zakirov committed
54
55
use warnings;

56
use base qw(RT::Action);
57

Jesse Vincent's avatar
Jesse Vincent committed
58
use RT::EmailParser;
Alex Vandiver's avatar
Alex Vandiver committed
59
use RT::Interface::Email;
Emmanuel Lacour's avatar
Emmanuel Lacour committed
60
use Email::Address;
61
62
our @EMAIL_RECIPIENT_HEADERS = qw(To Cc Bcc);

63

64
65
=head1 NAME

66
67
68
RT::Action::SendEmail - An Action which users can use to send mail 
or can subclassed for more specialized mail sending behavior. 
RT::Action::AutoReply is a good example subclass.
69
70

=head1 SYNOPSIS
71

72
  use base 'RT::Action::SendEmail';
73
74
75
76
77
78

=head1 DESCRIPTION

Basically, you create another module RT::Action::YourAction which ISA
RT::Action::SendEmail.

Ruslan Zakirov's avatar
Ruslan Zakirov committed
79
=head1 METHODS
Jesse Vincent's avatar
Jesse Vincent committed
80

81
=head2 CleanSlate
Jesse Vincent's avatar
Jesse Vincent committed
82

83
Cleans class-wide options, like L</AttachTickets>.
84

85
=cut
86

Ruslan Zakirov's avatar
Ruslan Zakirov committed
87
88
sub CleanSlate {
    my $self = shift;
Jesse Vincent's avatar
Jesse Vincent committed
89
    $self->AttachTickets(undef);
Ruslan Zakirov's avatar
Ruslan Zakirov committed
90
}
91

Ruslan Zakirov's avatar
Ruslan Zakirov committed
92
=head2 Commit
93

Ruslan Zakirov's avatar
Ruslan Zakirov committed
94
95
Sends the prepared message and writes outgoing record into DB if the feature is
activated in the config.
96

97
=cut
98

99
sub Commit {
100
    my $self = shift;
101

102
103
104
105
    return abs $self->SendMessage( $self->TemplateObj->MIMEObj )
        unless RT->Config->Get('RecordOutgoingEmail');

    $self->DeferDigestRecipients();
106
107
108
    my $message = $self->TemplateObj->MIMEObj;

    my $orig_message;
109
110
111
112
    $orig_message = $message->dup if RT::Interface::Email::WillSignEncrypt(
        Attachment => $self->TransactionObj->Attachments->First,
        Ticket     => $self->TicketObj,
    );
113

Jesse Vincent's avatar
Jesse Vincent committed
114
    my ($ret) = $self->SendMessage($message);
115
    return abs( $ret ) if $ret <= 0;
116

117
118
119
120
121
122
    if ($orig_message) {
        $message->attach(
            Type        => 'application/x-rt-original-message',
            Disposition => 'inline',
            Data        => $orig_message->as_string,
        );
123
    }
124
125
126
    $self->RecordOutgoingMailTransaction($message);
    $self->RecordDeferredRecipients();
    return 1;
127
}
128

Ruslan Zakirov's avatar
Ruslan Zakirov committed
129
=head2 Prepare
130

Ruslan Zakirov's avatar
Ruslan Zakirov committed
131
132
133
Builds an outgoing email we're going to send using scrip's template.

=cut
134

135
136
sub Prepare {
    my $self = shift;
137

138
139
140
141
142
143
144
145
146
    unless ( $self->TemplateObj->MIMEObj ) {
        my ( $result, $message ) = $self->TemplateObj->Parse(
            Argument       => $self->Argument,
            TicketObj      => $self->TicketObj,
            TransactionObj => $self->TransactionObj
        );
        if ( !$result ) {
            return (undef);
        }
147
    }
148

149
    my $MIMEObj = $self->TemplateObj->MIMEObj;
150

151
152
153
    # Header
    $self->SetRTSpecialHeaders();

154
    my %seen;
155
    foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
Jesse Vincent's avatar
Jesse Vincent committed
156
157
158
        @{ $self->{$type} }
            = grep defined && length && !$seen{ lc $_ }++,
            @{ $self->{$type} };
159
160
    }

161
162
    $self->RemoveInappropriateRecipients();

163
    # Go add all the Tos, Ccs and Bccs that we need to to the message to
164
    # make it happy, but only if we actually have values in those arrays.
165

Jesse Vincent's avatar
Jesse Vincent committed
166
167
# TODO: We should be pulling the recipients out of the template and shove them into To, Cc and Bcc

168
    for my $header (@EMAIL_RECIPIENT_HEADERS) {
169

170
171
172
173
174
        $self->SetHeader( $header, join( ', ', @{ $self->{$header} } ) )
          if (!$MIMEObj->head->get($header)
            && $self->{$header}
            && @{ $self->{$header} } );
    }
Ruslan Zakirov's avatar
:retab    
Ruslan Zakirov committed
175
    # PseudoTo (fake to headers) shouldn't get matched for message recipients.
Alex Vandiver's avatar
Alex Vandiver committed
176
    # If we don't have any 'To' header (but do have other recipients), drop in
177
    # the pseudo-to header.
Jesse Vincent's avatar
Jesse Vincent committed
178
179
180
181
182
    $self->SetHeader( 'To', join( ', ', @{ $self->{'PseudoTo'} } ) )
        if $self->{'PseudoTo'}
            && @{ $self->{'PseudoTo'} }
            && !$MIMEObj->head->get('To')
            && ( $MIMEObj->head->get('Cc') or $MIMEObj->head->get('Bcc') );
Jesse Vincent's avatar
Jesse Vincent committed
183

184
    # For security reasons, we only send out textual mails.
185
186
    foreach my $part ( grep !$_->is_multipart, $MIMEObj->parts_DFS ) {
        my $type = $part->mime_type || 'text/plain';
Jesse Vincent's avatar
Jesse Vincent committed
187
        $type = 'text/plain' unless RT::I18N::IsTextualContentType($type);
188
        $part->head->mime_attr( "Content-Type" => $type );
sunnavy's avatar
sunnavy committed
189
        # utf-8 here is for _FindOrGuessCharset in I18N.pm
190
        # it's not the final charset/encoding sent
sunnavy's avatar
sunnavy committed
191
        $part->head->mime_attr( "Content-Type.charset" => 'utf-8' );
192
193
    }

194
195
196
197
198
199
    RT::I18N::SetMIMEEntityToEncoding(
        Entity        => $MIMEObj,
        Encoding      => RT->Config->Get('EmailOutputEncoding'),
        PreserveWords => 1,
        IsOut         => 1,
    );
Jesse Vincent's avatar
Jesse Vincent committed
200
201

    # Build up a MIME::Entity that looks like the original message.
202
    $self->AddAttachments if ( $MIMEObj->head->get('RT-Attach-Message')
203
                               && ( $MIMEObj->head->get('RT-Attach-Message') !~ /^(n|no|0|off|false)$/i ) );
204
205

    $self->AddTickets;
206

207
    my $attachment = $self->TransactionObj->Attachments->First;
Jesse Vincent's avatar
Jesse Vincent committed
208
209
210
211
212
213
214
    if ($attachment
        && !(
               $attachment->GetHeader('X-RT-Encrypt')
            || $self->TicketObj->QueueObj->Encrypt
        )
        )
    {
215
        $attachment->SetHeader( 'X-RT-Encrypt' => 1 )
Jesse Vincent's avatar
Jesse Vincent committed
216
217
            if ( $attachment->GetHeader("X-RT-Incoming-Encryption") || '' ) eq
            'Success';
218
    }
219

220
    return 1;
221
}
222

223
224
=head2 To

Emmanuel Lacour's avatar
Emmanuel Lacour committed
225
Returns an array of L<Email::Address> objects containing all the To: recipients for this notification
226
227
228
229
230

=cut

sub To {
    my $self = shift;
231
    return ( $self->AddressesFromHeader('To') );
232
233
234
235
}

=head2 Cc

Emmanuel Lacour's avatar
Emmanuel Lacour committed
236
Returns an array of L<Email::Address> objects containing all the Cc: recipients for this notification
237
238
239

=cut

Jesse Vincent's avatar
Jesse Vincent committed
240
sub Cc {
241
    my $self = shift;
242
    return ( $self->AddressesFromHeader('Cc') );
243
244
245
246
}

=head2 Bcc

Emmanuel Lacour's avatar
Emmanuel Lacour committed
247
Returns an array of L<Email::Address> objects containing all the Bcc: recipients for this notification
248
249
250
251
252

=cut

sub Bcc {
    my $self = shift;
253
    return ( $self->AddressesFromHeader('Bcc') );
254
255
256

}

257
sub AddressesFromHeader {
Jesse Vincent's avatar
Jesse Vincent committed
258
259
    my $self      = shift;
    my $field     = shift;
260
    my $header    = Encode::decode("UTF-8",$self->TemplateObj->MIMEObj->head->get($field));
Emmanuel Lacour's avatar
Emmanuel Lacour committed
261
    my @addresses = Email::Address->parse($header);
262
263
264
265

    return (@addresses);
}

266
267
268
=head2 SendMessage MIMEObj

sends the message using RT's preferred API.
269
TODO: Break this out to a separate module
270
271
272
273

=cut

sub SendMessage {
Jesse Vincent's avatar
Jesse Vincent committed
274

Tara Andrews's avatar
Tara Andrews committed
275
276
    # DO NOT SHIFT @_ in this subroutine.  It breaks Hook::LexWrap's
    # ability to pass @_ to a 'post' routine.
277
    my ( $self, $MIMEObj ) = @_;
278

279
    my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
280
    chomp $msgid;
281

Jesse Vincent's avatar
Jesse Vincent committed
282
    $self->ScripActionObj->{_Message_ID}++;
Jesse Vincent's avatar
Jesse Vincent committed
283

284
    $RT::Logger->info( $msgid . " #"
Jesse Vincent's avatar
Jesse Vincent committed
285
286
287
            . $self->TicketObj->id . "/"
            . $self->TransactionObj->id
            . " - Scrip "
288
            . ($self->ScripObj->id || '#rule'). " "
Jesse Vincent's avatar
Jesse Vincent committed
289
            . ( $self->ScripObj->Description || '' ) );
290

291
    my $status = RT::Interface::Email::SendEmail(
Jesse Vincent's avatar
Jesse Vincent committed
292
293
        Entity      => $MIMEObj,
        Ticket      => $self->TicketObj,
294
        Transaction => $self->TransactionObj,
295
    );
296
297

     
Ruslan Zakirov's avatar
:retab    
Ruslan Zakirov committed
298
    return $status unless ($status > 0 || exists $self->{'Deferred'});
299

Ruslan Zakirov's avatar
Ruslan Zakirov committed
300
    my $success = $msgid . " sent ";
301
    foreach (@EMAIL_RECIPIENT_HEADERS) {
302
        my $recipients = Encode::decode( "UTF-8", $MIMEObj->head->get($_) );
Jesse Vincent's avatar
Jesse Vincent committed
303
        $success .= " $_: " . $recipients if $recipients;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
304
    }
Ruslan Zakirov's avatar
:retab    
Ruslan Zakirov committed
305

306
307
    if( exists $self->{'Deferred'} ) {
        for (qw(daily weekly susp)) {
Ruslan Zakirov's avatar
:retab    
Ruslan Zakirov committed
308
309
            $success .= "\nBatched email $_ for: ". join(", ", keys %{ $self->{'Deferred'}{ $_ } } )
                if exists $self->{'Deferred'}{ $_ };
310
311
312
        }
    }

Ruslan Zakirov's avatar
Ruslan Zakirov committed
313
    $success =~ s/\n//g;
314

315
316
317
318
319
    $RT::Logger->info($success);

    return (1);
}

320
321
322
323
324
325
326
327
328
329
330
331
332
333
=head2 AddAttachments

Takes any attachments to this transaction and attaches them to the message
we're building.

=cut

sub AddAttachments {
    my $self = shift;

    my $MIMEObj = $self->TemplateObj->MIMEObj;

    $MIMEObj->head->delete('RT-Attach-Message');

334
    my $attachments = RT::Attachments->new( RT->SystemUser );
335
336
337
338
    $attachments->Limit(
        FIELD => 'TransactionId',
        VALUE => $self->TransactionObj->Id
    );
Jesse Vincent's avatar
Jesse Vincent committed
339

340
341
    # Don't attach anything blank
    $attachments->LimitNotEmpty;
Jesse Vincent's avatar
Jesse Vincent committed
342
    $attachments->OrderBy( FIELD => 'id' );
343

344
    # We want to make sure that we don't include the attachment that's
Jesse Vincent's avatar
Jesse Vincent committed
345
346
    # being used as the "Content" of this message" unless that attachment's
    # content type is not like text/...
347
    my $transaction_content_obj = $self->TransactionObj->ContentObj;
Jesse Vincent's avatar
Jesse Vincent committed
348
349

    if (   $transaction_content_obj
Jesse Vincent's avatar
Jesse Vincent committed
350
        && $transaction_content_obj->ContentType =~ m{text/}i )
351
    {
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
        # If this was part of a multipart/alternative, skip all of the kids
        my $parent = $transaction_content_obj->ParentObj;
        if ($parent and $parent->Id and $parent->ContentType eq "multipart/alternative") {
            $attachments->Limit(
                ENTRYAGGREGATOR => 'AND',
                FIELD           => 'parent',
                OPERATOR        => '!=',
                VALUE           => $parent->Id,
            );
        } else {
            $attachments->Limit(
                ENTRYAGGREGATOR => 'AND',
                FIELD           => 'id',
                OPERATOR        => '!=',
                VALUE           => $transaction_content_obj->Id,
            );
        }
369
    }
370
371

    # attach any of this transaction's attachments
372
    my $seen_attachment = 0;
373
    while ( my $attach = $attachments->Next ) {
Jesse Vincent's avatar
Jesse Vincent committed
374
375
        if ( !$seen_attachment ) {
            $MIMEObj->make_multipart( 'mixed', Force => 1 );
376
377
            $seen_attachment = 1;
        }
Jesse Vincent's avatar
Jesse Vincent committed
378
        $self->AddAttachment($attach);
379
380
381
    }
}

Ruslan Zakirov's avatar
Ruslan Zakirov committed
382
383
=head2 AddAttachment $attachment

384
Takes one attachment object of L<RT::Attachment> class and attaches it to the message
Ruslan Zakirov's avatar
Ruslan Zakirov committed
385
386
387
388
389
we're building.

=cut

sub AddAttachment {
Jesse Vincent's avatar
Jesse Vincent committed
390
391
    my $self    = shift;
    my $attach  = shift;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
392
393
    my $MIMEObj = shift || $self->TemplateObj->MIMEObj;

394
395
396
397
    # $attach->TransactionObj may not always be $self->TransactionObj
    return unless $attach->Id
              and $attach->TransactionObj->CurrentUserCanSee;

398
    # ->attach expects just the disposition type; extract it if we have the header
399
    # or default to "attachment"
400
    my $disp = ($attach->GetHeader('Content-Disposition') || '')
401
                    =~ /^\s*(inline|attachment)/i ? $1 : "attachment";
402

Ruslan Zakirov's avatar
Ruslan Zakirov committed
403
    $MIMEObj->attach(
404
405
406
        Type        => $attach->ContentType,
        Charset     => $attach->OriginalEncoding,
        Data        => $attach->OriginalContent,
407
        Disposition => $disp,
408
        Filename    => $self->MIMEEncodeString( $attach->Filename ),
409
        Id          => $attach->GetHeader('Content-ID'),
Jesse Vincent's avatar
Jesse Vincent committed
410
411
412
        'RT-Attachment:' => $self->TicketObj->Id . "/"
            . $self->TransactionObj->Id . "/"
            . $attach->id,
Ruslan Zakirov's avatar
Ruslan Zakirov committed
413
414
415
416
        Encoding => '-SUGGEST',
    );
}

417
418
419
420
421
422
423
424
425
426
427
=head2 AttachTickets [@IDs]

Returns or set list of ticket's IDs that should be attached to an outgoing message.

B<Note> this method works as a class method and setup things global, so you have to
clean list by passing undef as argument.

=cut

{
    my $list = [];
Jesse Vincent's avatar
Jesse Vincent committed
428

429
430
431
432
    sub AttachTickets {
        my $self = shift;
        $list = [ grep defined, @_ ] if @_;
        return @$list;
433
    }
434
435
436
437
438
439
}

=head2 AddTickets

Attaches tickets to the current message, list of tickets' ids get from
L</AttachTickets> method.
440

441
442
443
444
445
446
=cut

sub AddTickets {
    my $self = shift;
    $self->AddTicket($_) foreach $self->AttachTickets;
    return;
447
448
}

449
=head2 AddTicket $ID
450

451
452
453
454
455
456
457
458
459
Attaches a ticket with ID to the message.

Each ticket is attached as multipart entity and all its messages and attachments
are attached as sub entities in order of creation, but only if transaction type
is Create or Correspond.

=cut

sub AddTicket {
Ruslan Zakirov's avatar
Ruslan Zakirov committed
460
    my $self = shift;
Jesse Vincent's avatar
Jesse Vincent committed
461
    my $tid  = shift;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
462

463
    my $attachs   = RT::Attachments->new( $self->TransactionObj->CreatorObj );
464
465
    my $txn_alias = $attachs->TransactionAlias;
    $attachs->Limit( ALIAS => $txn_alias, FIELD => 'Type', VALUE => 'Create' );
Jesse Vincent's avatar
Jesse Vincent committed
466
467
468
469
470
471
    $attachs->Limit(
        ALIAS => $txn_alias,
        FIELD => 'Type',
        VALUE => 'Correspond'
    );
    $attachs->LimitByTicket($tid);
Ruslan Zakirov's avatar
Ruslan Zakirov committed
472
473
474
475
    $attachs->LimitNotEmpty;
    $attachs->OrderBy( FIELD => 'Created' );

    my $ticket_mime = MIME::Entity->build(
Jesse Vincent's avatar
Jesse Vincent committed
476
477
        Type        => 'multipart/mixed',
        Top         => 0,
Ruslan Zakirov's avatar
Ruslan Zakirov committed
478
479
480
481
482
483
484
485
        Description => "ticket #$tid",
    );
    while ( my $attachment = $attachs->Next ) {
        $self->AddAttachment( $attachment, $ticket_mime );
    }
    if ( $ticket_mime->parts ) {
        my $email_mime = $self->TemplateObj->MIMEObj;
        $email_mime->make_multipart;
Jesse Vincent's avatar
Jesse Vincent committed
486
        $email_mime->add_part($ticket_mime);
Ruslan Zakirov's avatar
Ruslan Zakirov committed
487
488
489
    }
    return;
}
490

491
492
493
494
495
496
497
=head2 RecordOutgoingMailTransaction MIMEObj

Record a transaction in RT with this outgoing message for future record-keeping purposes

=cut

sub RecordOutgoingMailTransaction {
Jesse Vincent's avatar
Jesse Vincent committed
498
    my $self    = shift;
499
    my $MIMEObj = shift;
500
501
502
503
504
505
506

    my @parts = $MIMEObj->parts;
    my @attachments;
    my @keep;
    foreach my $part (@parts) {
        my $attach = $part->head->get('RT-Attachment');
        if ($attach) {
Jesse Vincent's avatar
Jesse Vincent committed
507
508
            $RT::Logger->debug(
                "We found an attachment. we want to not record it.");
509
510
511
512
513
514
            push @attachments, $attach;
        } else {
            $RT::Logger->debug("We found a part. we want to record it.");
            push @keep, $part;
        }
    }
Jesse Vincent's avatar
Jesse Vincent committed
515
    $MIMEObj->parts( \@keep );
516
    foreach my $attachment (@attachments) {
Jesse Vincent's avatar
Jesse Vincent committed
517
        $MIMEObj->head->add( 'RT-Attachment', $attachment );
518
    }
519
520
521

    RT::I18N::SetMIMEEntityToEncoding( $MIMEObj, 'utf-8', 'mime_words_ok' );

Jesse Vincent's avatar
Jesse Vincent committed
522
523
    my $transaction
        = RT::Transaction->new( $self->TransactionObj->CurrentUser );
524

Jesse Vincent's avatar
Jesse Vincent committed
525
# XXX: TODO -> Record attachments as references to things in the attachments table, maybe.
526

527
    my $type;
Jesse Vincent's avatar
Jesse Vincent committed
528
    if ( $self->TransactionObj->Type eq 'Comment' ) {
529
530
531
532
533
        $type = 'CommentEmailRecord';
    } else {
        $type = 'EmailRecord';
    }

534
    my $msgid = Encode::decode( "UTF-8", $MIMEObj->head->get('Message-ID') );
Jesse Vincent's avatar
Jesse Vincent committed
535
    chomp $msgid;
536

537
538
539
    my ( $id, $msg ) = $transaction->Create(
        Ticket         => $self->TicketObj->Id,
        Type           => $type,
Jesse Vincent's avatar
Jesse Vincent committed
540
        Data           => $msgid,
541
542
543
        MIMEObj        => $MIMEObj,
        ActivateScrips => 0
    );
544

Jesse Vincent's avatar
Jesse Vincent committed
545
    if ($id) {
Ruslan Zakirov's avatar
Ruslan Zakirov committed
546
        $self->{'OutgoingMailTransaction'} = $id;
547
    } else {
Jesse Vincent's avatar
Jesse Vincent committed
548
549
        $RT::Logger->warning(
            "Could not record outgoing message transaction: $msg");
550
    }
551
    return $id;
552
553
}

554
555
556
557
558
559
=head2 SetRTSpecialHeaders 

This routine adds all the random headers that RT wants in a mail message
that don't matter much to anybody else.

=cut
560

561
sub SetRTSpecialHeaders {
562
    my $self = shift;
563

564
565
    $self->SetSubject();
    $self->SetSubjectToken();
Jesse Vincent's avatar
Jesse Vincent committed
566
567
568
    $self->SetHeaderAsEncoding( 'Subject',
        RT->Config->Get('EmailOutputEncoding') )
        if ( RT->Config->Get('EmailOutputEncoding') );
569
    $self->SetReturnAddress();
570
    $self->SetReferencesHeaders();
571

Jesse Vincent's avatar
Jesse Vincent committed
572
573
574
575
576
577
578
579
580
581
582
583
584
    unless ( $self->TemplateObj->MIMEObj->head->get('Message-ID') ) {

        # Get Message-ID for this txn
        my $msgid = "";
        if ( my $msg = $self->TransactionObj->Message->First ) {
            $msgid = $msg->GetHeader("RT-Message-ID")
                || $msg->GetHeader("Message-ID");
        }

        # If there is one, and we can parse it, then base our Message-ID on it
        if (    $msgid
            and $msgid
            =~ s/<(rt-.*?-\d+-\d+)\.(\d+)-\d+-\d+\@\QRT->Config->Get('Organization')\E>$/
Jesse Vincent's avatar
Jesse Vincent committed
585
586
587
                         "<$1." . $self->TicketObj->id
                          . "-" . $self->ScripObj->id
                          . "-" . $self->ScripActionObj->{_Message_ID}
588
                          . "@" . RT->Config->Get('Organization') . ">"/eg
Jesse Vincent's avatar
Jesse Vincent committed
589
590
591
592
593
594
595
596
597
598
599
600
601
            and $2 == $self->TicketObj->id
            )
        {
            $self->SetHeader( "Message-ID" => $msgid );
        } else {
            $self->SetHeader(
                'Message-ID' => RT::Interface::Email::GenMessageId(
                    Ticket      => $self->TicketObj,
                    Scrip       => $self->ScripObj,
                    ScripAction => $self->ScripActionObj
                ),
            );
        }
Jesse Vincent's avatar
Jesse Vincent committed
602
    }
603

604
    $self->SetHeader( 'X-RT-Loop-Prevention', RT->Config->Get('rtname') );
605
    $self->SetHeader( 'X-RT-Ticket',
606
        RT->Config->Get('rtname') . " #" . $self->TicketObj->id() );
607
    $self->SetHeader( 'X-Managed-by',
608
609
        "RT $RT::VERSION (http://www.bestpractical.com/rt/)" );

Jesse Vincent's avatar
Jesse Vincent committed
610
611
# XXX, TODO: use /ShowUser/ShowUserEntry(or something like that) when it would be
#            refactored into user's method.
612
    if ( my $email = $self->TransactionObj->CreatorObj->EmailAddress
613
614
         and RT->Config->Get('UseOriginatorHeader')
    ) {
615
        $self->SetHeader( 'X-RT-Originator', $email );
CL Sung's avatar
CL Sung committed
616
    }
617

618
}
619

620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636

sub DeferDigestRecipients {
    my $self = shift;
    $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );

    # The digest attribute will be an array of notifications that need to
    # be sent for this transaction.  The array will have the following
    # format for its objects.
    # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
    #                                     -> sent -> {true|false}
    # The "sent" flag will be used by the cron job to indicate that it has
    # run on this transaction.
    # In a perfect world we might move this hash construction to the
    # extension module itself.
    my $digest_hash = {};

    foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
Emmanuel Lacour's avatar
Emmanuel Lacour committed
637
638
        # If we have a "PseudoTo", the "To" contains it, so we don't need to access it
        next if ( ( $self->{'PseudoTo'} && @{ $self->{'PseudoTo'} } ) && ( $mailfield eq 'To' ) );
639
640
641
642
643
644
645
        $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );

        # Store the 'daily digest' folk in an array.
        my ( @send_now, @daily_digest, @weekly_digest, @suspended );

        # Have to get the list of addresses directly from the MIME header
        # at this point.
646
        $RT::Logger->debug( Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->as_string ) );
647
648
        foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
            next unless $rcpt;
649
            my $user_obj = RT::User->new(RT->SystemUser);
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
            $user_obj->LoadByEmail($rcpt);
            if  ( ! $user_obj->id ) {
                # If there's an email address in here without an associated
                # RT user, pass it on through.
                $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
                push( @send_now, $rcpt );
                next;
            }

            my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
            $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");

            if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
            elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
            elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
            else { push( @send_now, $rcpt ) }
        }

        # Reset the relevant mail field.
        $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
        if (@send_now) {
            $self->SetHeader( $mailfield, join( ', ', @send_now ) );
        } else {    # No recipients!  Remove the header.
            $self->TemplateObj->MIMEObj->head->delete($mailfield);
        }

        # Push the deferred addresses into the appropriate field in
        # our attribute hash, with the appropriate mail header.
        $RT::Logger->debug(
            "Setting deferred recipients for attribute creation");
        $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
        $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
        $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
    }

    if ( scalar keys %$digest_hash ) {

        # Save the hash so that we can add it as an attribute to the
        # outgoing email transaction.
        $self->{'Deferred'} = $digest_hash;
    } else {
        $RT::Logger->debug( "No recipients found for deferred delivery on "
                . "transaction #"
                . $self->TransactionObj->id );
    }
}


    
Ruslan Zakirov's avatar
:retab    
Ruslan Zakirov committed
699
700
sub RecordDeferredRecipients {
    my $self = shift;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
701
702
    return unless exists $self->{'Deferred'};

Ruslan Zakirov's avatar
:retab    
Ruslan Zakirov committed
703
704
705
706
707
708
709
710
711
712
713
714
715
    my $txn_id = $self->{'OutgoingMailTransaction'};
    return unless $txn_id;

    my $txn_obj = RT::Transaction->new( $self->CurrentUser );
    $txn_obj->Load( $txn_id );
    my( $ret, $msg ) = $txn_obj->AddAttribute(
        Name => 'DeferredRecipients',
        Content => $self->{'Deferred'}
    );
    $RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) 
        unless $ret;

    return ($ret,$msg);
716
717
}

718
=head2 SquelchMailTo
719

720
Returns list of the addresses to squelch on this transaction.
Ruslan Zakirov's avatar
Ruslan Zakirov committed
721
722
723

=cut

724
725
726
sub SquelchMailTo {
    my $self = shift;
    return map $_->Content, $self->TransactionObj->SquelchMailTo;
Ruslan Zakirov's avatar
Ruslan Zakirov committed
727
}
728

729
730
731
=head2 RemoveInappropriateRecipients

Remove addresses that are RT addresses or that are on this transaction's blacklist
732
733

=cut
734

735
my %squelch_reasons = (
736
737
    'not privileged'
        => "because autogenerated messages are configured to only be sent to privileged users (RedistributeAutoGeneratedMessages)",
738
739
740
    'squelch:attachment'
        => "by RT-Squelch-Replies-To header in the incoming message",
    'squelch:transaction'
741
        => "by notification checkboxes for this transaction",
742
    'squelch:ticket'
743
        => "by notification checkboxes on this ticket's People page",
744
745
746
);


747
sub RemoveInappropriateRecipients {
748
    my $self = shift;
749

750
    my %blacklist = ();
751

752
753
    # If there are no recipients, don't try to send the message.
    # If the transaction has content and has the header RT-Squelch-Replies-To
754

755
    my $msgid = Encode::decode( "UTF-8", $self->TemplateObj->MIMEObj->head->get('Message-Id') );
756
757
    chomp $msgid;

758
    if ( my $attachment = $self->TransactionObj->Attachments->First ) {
759
760

        if ( $attachment->GetHeader('RT-DetectedAutoGenerated') ) {
Jesse Vincent's avatar
Jesse Vincent committed
761
762
763
764
765

            # What do we want to do with this? It's probably (?) a bounce
            # caused by one of the watcher addresses being broken.
            # Default ("true") is to redistribute, for historical reasons.

766
767
768
            my $redistribute = RT->Config->Get('RedistributeAutoGeneratedMessages');

            if ( !$redistribute ) {
Jesse Vincent's avatar
Jesse Vincent committed
769

Jesse Vincent's avatar
Jesse Vincent committed
770
                # Don't send to any watchers.
771
                @{ $self->{$_} } = () for (@EMAIL_RECIPIENT_HEADERS);
772
773
                $RT::Logger->info( $msgid
                        . " The incoming message was autogenerated. "
774
                        . "Not redistributing this message based on site configuration."
775
                );
776
            } elsif ( $redistribute eq 'privileged' ) {
Jesse Vincent's avatar
Jesse Vincent committed
777
778

                # Only send to "privileged" watchers.
779
                foreach my $type (@EMAIL_RECIPIENT_HEADERS) {
Jesse Vincent's avatar
Jesse Vincent committed
780
                    foreach my $addr ( @{ $self->{$type} } ) {
781
                        my $user = RT::User->new(RT->SystemUser);
Jesse Vincent's avatar
Jesse Vincent committed
782
                        $user->LoadByEmail($addr);
783
784
                        $blacklist{ $addr } ||= 'not privileged'
                            unless $user->id && $user->Privileged;
Jesse Vincent's avatar
Jesse Vincent committed
785
786
                    }
                }
787
788
                $RT::Logger->info( $msgid
                        . " The incoming message was autogenerated. "
789
                        . "Not redistributing this message to unprivileged users based on site configuration."
790
                );
Jesse Vincent's avatar
Jesse Vincent committed
791
792
793
            }
        }

794
        if ( my $squelch = $attachment->GetHeader('RT-Squelch-Replies-To') ) {
795
796
            $blacklist{ $_->address } ||= 'squelch:attachment'
                foreach Email::Address->parse( $squelch );
797
798
        }
    }
799

800
801
802
803
804
805
806
807
808
809
810
811
812
813
    # Let's grab the SquelchMailTo attributes and push those entries
    # into the blacklisted
    $blacklist{ $_->Content } ||= 'squelch:transaction'
        foreach $self->TransactionObj->SquelchMailTo;
    $blacklist{ $_->Content } ||= 'squelch:ticket'
        foreach $self->TicketObj->SquelchMailTo;

    # canonicalize emails
    foreach my $address ( keys %blacklist ) {
        my $reason = delete $blacklist{ $address };
        $blacklist{ lc $_ } = $reason
            foreach map RT::User->CanonicalizeEmailAddress( $_->address ),
            Email::Address->parse( $address );
    }
814

815
816
817
818
819
820
821
    $self->RecipientFilter(
        Callback => sub {
            return unless RT::EmailParser->IsRTAddress( $_[0] );
            return "$_[0] appears to point to this RT instance. Skipping";
        },
        All => 1,
    );
822

823
824
825
826
827
828
    $self->RecipientFilter(
        Callback => sub {
            return unless $blacklist{ lc $_[0] };
            return "$_[0] is blacklisted $squelch_reasons{ $blacklist{ lc $_[0] } }. Skipping";
        },
    );
829

830

831
832
    # Cycle through the people we're sending to and pull out anyone that meets any of the callbacks
    for my $type (@EMAIL_RECIPIENT_HEADERS) {
833
834
        my @addrs;

835
836
837
838
839
840
841
      ADDRESS:
        for my $addr ( @{ $self->{$type} } ) {
            for my $filter ( map {$_->{Callback}} @{$self->{RecipientFilter}} ) {
                my $skip = $filter->($addr);
                next unless $skip;
                $RT::Logger->info( "$msgid $skip" );
                next ADDRESS;
842
843
            }
            push @addrs, $addr;
Jesse Vincent's avatar
Jesse Vincent committed
844
        }
845
846
847
848
849
850
851
852

      NOSQUELCH_ADDRESS:
        for my $addr ( @{ $self->{NoSquelch}{$type} } ) {
            for my $filter ( map {$_->{Callback}} grep {$_->{All}} @{$self->{RecipientFilter}} ) {
                my $skip = $filter->($addr);
                next unless $skip;
                $RT::Logger->info( "$msgid $skip" );
                next NOSQUELCH_ADDRESS;
853
854
855
            }
            push @addrs, $addr;
        }
856

857
        @{ $self->{$type} } = @addrs;
858
859
    }
}
860

861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
=head2 RecipientFilter Callback => SUB, [All => 1]

Registers a filter to be applied to addresses by
L<RemoveInappropriateRecipients>.  The C<Callback> will be called with
one address at a time, and should return false if the address should
receive mail, or a message explaining why it should not be.  Passing a
true value for C<All> will cause the filter to also be applied to
NoSquelch (one-time Cc and Bcc) recipients as well.

=cut

sub RecipientFilter {
    my $self = shift;
    push @{ $self->{RecipientFilter}}, {@_};
}

877
878
879
880
881
882
=head2 SetReturnAddress is_comment => BOOLEAN

Calculate and set From and Reply-To headers based on the is_comment flag.

=cut

883
884
sub SetReturnAddress {

885
    my $self = shift;
886
887
    my %args = (
        is_comment => 0,
sunnavy's avatar
sunnavy committed
888
        friendly_name => undef,
889
890
        @_
    );
891
892
893
894
895
896
897

    # From and Reply-To
    # $args{is_comment} should be set if the comment address is to be used.
    my $replyto;

    if ( $args{'is_comment'} ) {
        $replyto = $self->TicketObj->QueueObj->CommentAddress
Jesse Vincent's avatar
Jesse Vincent committed
898
899
            || RT->Config->Get('CommentAddress');
    } else {
900
        $replyto = $self->TicketObj->QueueObj->CorrespondAddress
Jesse Vincent's avatar
Jesse Vincent committed
901
            || RT->Config->Get('CorrespondAddress');
902
903
904
    }

    unless ( $self->TemplateObj->MIMEObj->head->get('From') ) {
905
906
        $self->SetFrom( %args, From => $replyto );
    }
sunnavy's avatar
sunnavy committed
907

908
909
910
    unless ( $self->TemplateObj->MIMEObj->head->get('Reply-To') ) {
        $self->SetHeader( 'Reply-To', "$replyto" );
    }
911

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
}

=head2 SetFrom ( From => emailaddress )

Set the From: address for outgoing email

=cut

sub SetFrom {
    my $self = shift;
    my %args = @_;

    if ( RT->Config->Get('UseFriendlyFromLine') ) {
        my $friendly_name = $self->GetFriendlyName(%args);
        $self->SetHeader(
            'From',
            sprintf(
                RT->Config->Get('FriendlyFromLineFormat'),
                $self->MIMEEncodeString(
                    $friendly_name, RT->Config->Get('EmailOutputEncoding')
932
                ),
933
934
935
936
937
                $args{From}
            ),
        );
    } else {
        $self->SetHeader( 'From', $args{From} );
938
    }
939
}
940

941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
=head2 GetFriendlyName

Calculate the proper Friendly Name based on the creator of the transaction

=cut

sub GetFriendlyName {
    my $self = shift;
    my %args = (
        is_comment => 0,
        friendly_name => '',
        @_
    );
    my $friendly_name = $args{friendly_name};

    unless ( $friendly_name ) {
        $friendly_name = $self->TransactionObj->CreatorObj->FriendlyName;
        if ( $friendly_name =~ /^"(.*)"$/ ) {    # a quoted string
            $friendly_name = $1;
        }
961
962
    }

963
964
965
    $friendly_name =~ s/"/\\"/g;
    return $friendly_name;

966
}
967

968
969
=head2 SetHeader FIELD, VALUE

970
971
Set the FIELD of the current MIME object into VALUE, which should be in
characters, not bytes.  Returns the new header, in bytes.
972
973
974

=cut

975
sub SetHeader {
976
977
978
979
980
981
    my $self  = shift;
    my $field = shift;
    my $val   = shift;

    chomp $val;
    chomp $field;
Ruslan Zakirov's avatar
minor    
Ruslan Zakirov committed
982
983
    my $head = $self->TemplateObj->MIMEObj->head;
    $head->fold_length( $field, 10000 );
984
    $head->replace( $field, Encode::encode( "UTF-8", $val ) );
Ruslan Zakirov's avatar
minor    
Ruslan Zakirov committed
985
    return $head->get($field);
Jesse Vincent's avatar