Mailer.pm 18.6 KB
Newer Older
Shawn M Moore's avatar
Shawn M Moore committed
1
2
3
4
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
5
# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
Kevin Falcone's avatar
Kevin Falcone committed
6
#                                          <sales@bestpractical.com>
Shawn M Moore's avatar
Shawn M Moore committed
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# 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
# from www.gnu.org.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (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.)
#
# 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.
#
# END BPS TAGGED BLOCK }}}
Kevin Falcone's avatar
Kevin Falcone committed
48

Shawn M Moore's avatar
Shawn M Moore committed
49
50
51
52
53
54
55
56
57
58
59
60
61
package RT::Dashboard::Mailer;
use strict;
use warnings;

use HTML::Mason;
use HTML::RewriteAttributes::Links;
use HTML::RewriteAttributes::Resources;
use MIME::Types;
use POSIX 'tzset';
use RT::Dashboard;
use RT::Interface::Web::Handler;
use RT::Interface::Web;
use File::Temp 'tempdir';
62
use HTML::Scrubber;
63
use URI::QueryParam;
Shawn M Moore's avatar
Shawn M Moore committed
64
65
66
67
68
69
70
71
72
73

sub MailDashboards {
    my $self = shift;
    my %args = (
        All    => 0,
        DryRun => 0,
        Time   => time,
        @_,
    );

74
    $RT::Logger->debug("Using time $args{Time} for dashboard generation");
Shawn M Moore's avatar
Shawn M Moore committed
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

    my $from = $self->GetFrom();
    $RT::Logger->debug("Sending email from $from");

    # look through each user for her subscriptions
    my $Users = RT::Users->new(RT->SystemUser);
    $Users->LimitToPrivileged;

    while (defined(my $user = $Users->Next)) {
        if ($user->PrincipalObj->Disabled) {
            $RT::Logger->debug("Skipping over " . $user->Name . " due to having a disabled account.");
            next;
        }

        my ($hour, $dow, $dom) = HourDowDomIn($args{Time}, $user->Timezone || RT->Config->Get('Timezone'));
        $hour .= ':00';
        $RT::Logger->debug("Checking ".$user->Name."'s subscriptions: hour $hour, dow $dow, dom $dom");

        my $currentuser = RT::CurrentUser->new;
        $currentuser->LoadByName($user->Name);

        # look through this user's subscriptions, are any supposed to be generated
        # right now?
        for my $subscription ($user->Attributes->Named('Subscription')) {
99
100
101
            next unless $self->IsSubscriptionReady(
                %args,
                Subscription => $subscription,
102
                User         => $user,
103
104
                LocalTime    => [$hour, $dow, $dom],
            );
Shawn M Moore's avatar
Shawn M Moore committed
105
106
107
108
109
110
111
112
113
114

            my $email = $subscription->SubValue('Recipient')
                     || $user->EmailAddress;

            eval {
                $self->SendDashboard(
                    %args,
                    CurrentUser  => $currentuser,
                    Email        => $email,
                    Subscription => $subscription,
115
                    From         => $from,
Shawn M Moore's avatar
Shawn M Moore committed
116
117
118
119
120
121
                )
            };
            if ( $@ ) {
                $RT::Logger->error("Caught exception: $@");
            }
            else {
122
123
124
                my $counter = $subscription->SubValue('Counter') || 0;
                $subscription->SetSubValues(Counter => $counter + 1)
                    unless $args{DryRun};
Shawn M Moore's avatar
Shawn M Moore committed
125
126
127
128
129
            }
        }
    }
}

130
131
132
133
134
sub IsSubscriptionReady {
    my $self = shift;
    my %args = (
        All          => 0,
        Subscription => undef,
135
        User         => undef,
136
137
138
139
140
141
142
143
144
145
146
147
148
149
        LocalTime    => [0, 0, 0],
        @_,
    );

    return 1 if $args{All};

    my $subscription  = $args{Subscription};

    my $counter       = $subscription->SubValue('Counter') || 0;

    my $sub_frequency = $subscription->SubValue('Frequency');
    my $sub_hour      = $subscription->SubValue('Hour');
    my $sub_dow       = $subscription->SubValue('Dow');
    my $sub_dom       = $subscription->SubValue('Dom');
150
    my $sub_fow       = $subscription->SubValue('Fow') || 1;
151
152
153

    my ($hour, $dow, $dom) = @{ $args{LocalTime} };

154
    $RT::Logger->debug("Checking against subscription " . $subscription->Id . " for " . $args{User}->Name . " with frequency $sub_frequency, hour $sub_hour, dow $sub_dow, dom $sub_dom, fow $sub_fow, counter $counter");
155
156
157
158
159
160
161
162
163
164
165

    return 0 if $sub_frequency eq 'never';

    # correct hour?
    return 0 if $sub_hour ne $hour;

    # all we need is the correct hour for daily dashboards
    return 1 if $sub_frequency eq 'daily';

    if ($sub_frequency eq 'weekly') {
        # correct day of week?
166
        return 0 if $sub_dow ne $dow;
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

        # does it match the "every N weeks" clause?
        return 1 if $counter % $sub_fow == 0;

        $subscription->SetSubValues(Counter => $counter + 1)
            unless $args{DryRun};
        return 0;
    }

    # if monthly, correct day of month?
    if ($sub_frequency eq 'monthly') {
        return $sub_dom == $dom;
    }

    # monday through friday
    if ($sub_frequency eq 'm-f') {
        return 0 if $dow eq 'Sunday' || $dow eq 'Saturday';
        return 1;
    }

187
188
    $RT::Logger->debug("Invalid subscription frequency $sub_frequency for " . $args{User}->Name);

189
190
191
192
    # unknown frequency type, bail out
    return 0;
}

Shawn M Moore's avatar
Shawn M Moore committed
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
sub GetFrom {
    RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
}

sub SendDashboard {
    my $self = shift;
    my %args = (
        CurrentUser  => undef,
        Email        => undef,
        Subscription => undef,
        DryRun       => 0,
        @_,
    );

    my $currentuser  = $args{CurrentUser};
    my $subscription = $args{Subscription};

    my $rows = $subscription->SubValue('Rows');

    my $DashboardId = $subscription->SubValue('DashboardId');

    my $dashboard = RT::Dashboard->new($currentuser);
    my ($ok, $msg) = $dashboard->LoadById($DashboardId);

    # failed to load dashboard. perhaps it was deleted or it changed privacy
    if (!$ok) {
        $RT::Logger->warning("Unable to load dashboard $DashboardId of subscription ".$subscription->Id." for user ".$currentuser->Name.": $msg");
220
221
222
        return $self->ObsoleteSubscription(
            %args,
            Subscription => $subscription,
Shawn M Moore's avatar
Shawn M Moore committed
223
224
225
        );
    }

226
    $RT::Logger->debug('Generating dashboard "'.$dashboard->Name.'" for user "'.$currentuser->Name.'":');
Shawn M Moore's avatar
Shawn M Moore committed
227
228
229
230
231
232
233
234
235

    if ($args{DryRun}) {
        print << "SUMMARY";
    Dashboard: @{[ $dashboard->Name ]}
    User:   @{[ $currentuser->Name ]} <$args{Email}>
SUMMARY
        return;
    }

236
237
238
    local $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
    local $HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;

Shawn M Moore's avatar
Shawn M Moore committed
239
240
241
242
243
244
    my $content = RunComponent(
        '/Dashboards/Render.html',
        id      => $dashboard->Id,
        Preview => 0,
    );

sunnavy's avatar
sunnavy committed
245
246
247
248
    if ( RT->Config->Get('EmailDashboardRemove') ) {
        for ( RT->Config->Get('EmailDashboardRemove') ) {
            $content =~ s/$_//g;
        }
Shawn M Moore's avatar
Shawn M Moore committed
249
250
    }

251
252
    $content = ScrubContent($content);

Shawn M Moore's avatar
Shawn M Moore committed
253
254
255
256
    $RT::Logger->debug("Got ".length($content)." characters of output.");

    $content = HTML::RewriteAttributes::Links->rewrite(
        $content,
257
        RT->Config->Get('WebURL') . 'Dashboards/Render.html',
Shawn M Moore's avatar
Shawn M Moore committed
258
259
260
261
262
263
264
265
266
    );

    $self->EmailDashboard(
        %args,
        Dashboard => $dashboard,
        Content   => $content,
    );
}

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
sub ObsoleteSubscription {
    my $self = shift;
    my %args = (
        From         => undef,
        To           => undef,
        Subscription => undef,
        CurrentUser  => undef,
        @_,
    );

    my $subscription = $args{Subscription};

    my $ok = RT::Interface::Email::SendEmailUsingTemplate(
        From      => $args{From},
        To        => $args{Email},
        Template  => 'Error: Missing dashboard',
        Arguments => {
            SubscriptionObj => $subscription,
        },
286
287
288
289
        ExtraHeaders => {
            'X-RT-Dashboard-Subscription-Id' => $subscription->Id,
            'X-RT-Dashboard-Id' => $subscription->SubValue('DashboardId'),
        },
290
291
292
293
294
295
    );

    # only delete the subscription if the email looks like it went through
    if ($ok) {
        my ($deleted, $msg) = $subscription->Delete();
        if ($deleted) {
296
            $RT::Logger->debug("Deleted an obsolete subscription: $msg");
297
298
299
300
301
302
303
304
305
306
        }
        else {
            $RT::Logger->warning("Unable to delete an obsolete subscription: $msg");
        }
    }
    else {
        $RT::Logger->warning("Unable to notify ".$args{CurrentUser}->Name." of an obsolete subscription");
    }
}

Shawn M Moore's avatar
Shawn M Moore committed
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
sub EmailDashboard {
    my $self = shift;
    my %args = (
        CurrentUser  => undef,
        Email        => undef,
        Dashboard    => undef,
        Subscription => undef,
        Content      => undef,
        @_,
    );

    my $subscription = $args{Subscription};
    my $dashboard    = $args{Dashboard};
    my $currentuser  = $args{CurrentUser};
    my $email        = $args{Email};

323
324
325
326
327
328
329
330
331
332
333
334
335
    my $frequency    = $subscription->SubValue('Frequency');

    my %frequency_lookup = (
        'm-f'     => 'Weekday', # loc
        'daily'   => 'Daily',   # loc
        'weekly'  => 'Weekly',  # loc
        'monthly' => 'Monthly', # loc
        'never'   => 'Never',   # loc
    );

    my $frequency_display = $frequency_lookup{$frequency}
                         || $frequency;

Shawn M Moore's avatar
Shawn M Moore committed
336
337
    my $subject = sprintf '[%s] ' .  RT->Config->Get('DashboardSubject'),
        RT->Config->Get('rtname'),
338
        $currentuser->loc($frequency_display),
Shawn M Moore's avatar
Shawn M Moore committed
339
340
341
342
        $dashboard->Name;

    my $entity = $self->BuildEmail(
        %args,
343
        To      => $email,
Shawn M Moore's avatar
Shawn M Moore committed
344
345
346
        Subject => $subject,
    );

347
348
    $entity->head->replace('X-RT-Dashboard-Id', $dashboard->Id);
    $entity->head->replace('X-RT-Dashboard-Subscription-Id', $subscription->Id);
349

350
    $RT::Logger->debug('Mailing dashboard "'.$dashboard->Name.'" to user '.$currentuser->Name." <$email>");
Shawn M Moore's avatar
Shawn M Moore committed
351
352

    my $ok = RT::Interface::Email::SendEmail(
353
        %{ RT->Config->Get('Crypt')->{'Dashboards'} || {} },
Shawn M Moore's avatar
Shawn M Moore committed
354
355
356
        Entity => $entity,
    );

357
358
359
360
    if (!$ok) {
        $RT::Logger->error("Failed to email dashboard to user ".$currentuser->Name." <$email>");
        return;
    }
Shawn M Moore's avatar
Shawn M Moore committed
361

362
    $RT::Logger->debug("Done sending dashboard to ".$currentuser->Name." <$email>");
Shawn M Moore's avatar
Shawn M Moore committed
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
}

sub BuildEmail {
    my $self = shift;
    my %args = (
        Content => undef,
        From    => undef,
        To      => undef,
        Subject => undef,
        @_,
    );

    my @parts;
    my %cid_of;

    my $content = HTML::RewriteAttributes::Resources->rewrite($args{Content}, sub {
            my $uri = shift;

            # already attached this object
            return "cid:$cid_of{$uri}" if $cid_of{$uri};

            my ($data, $filename, $mimetype, $encoding) = GetResource($uri);
385
386
387
            return $uri unless defined $data;

            $cid_of{$uri} = time() . $$ . int(rand(1e6));
Shawn M Moore's avatar
Shawn M Moore committed
388

389
390
391
392
393
394
395
396
            # Encode textual data in UTF-8, and downgrade (treat
            # codepoints as codepoints, and ensure the UTF-8 flag is
            # off) everything else.
            my @extra;
            if ( $mimetype =~ m{text/} ) {
                $data = Encode::encode( "UTF-8", $data );
                @extra = ( Charset => "UTF-8" );
            } else {
Shawn M Moore's avatar
Shawn M Moore committed
397
398
399
400
401
402
403
404
405
                utf8::downgrade( $data, 1 ) or $RT::Logger->warning("downgrade $data failed");
            }

            push @parts, MIME::Entity->build(
                Top          => 0,
                Data         => $data,
                Type         => $mimetype,
                Encoding     => $encoding,
                Disposition  => 'inline',
406
                Name         => RT::Interface::Email::EncodeToMIME( String => $filename ),
Shawn M Moore's avatar
Shawn M Moore committed
407
                'Content-Id' => $cid_of{$uri},
408
                @extra,
Shawn M Moore's avatar
Shawn M Moore committed
409
410
411
412
413
414
415
            );

            return "cid:$cid_of{$uri}";
        },
        inline_css => sub {
            my $uri = shift;
            my ($content) = GetResource($uri);
416
            return defined $content ? $content : "";
Shawn M Moore's avatar
Shawn M Moore committed
417
418
419
420
421
        },
        inline_imports => 1,
    );

    my $entity = MIME::Entity->build(
422
423
        From    => Encode::encode("UTF-8", $args{From}),
        To      => Encode::encode("UTF-8", $args{To}),
424
        Subject => RT::Interface::Email::EncodeToMIME( String => $args{Subject} ),
Shawn M Moore's avatar
Shawn M Moore committed
425
426
427
428
429
430
        Type    => "multipart/mixed",
    );

    $entity->attach(
        Type        => 'text/html',
        Charset     => 'UTF-8',
431
        Data        => Encode::encode("UTF-8", $content),
Shawn M Moore's avatar
Shawn M Moore committed
432
        Disposition => 'inline',
433
        Encoding    => "base64",
Shawn M Moore's avatar
Shawn M Moore committed
434
435
436
437
438
439
    );

    for my $part (@parts) {
        $entity->add_part($part);
    }

440
441
    $entity->make_singlepart;

Shawn M Moore's avatar
Shawn M Moore committed
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
    return $entity;
}

{
    my $mason;
    my $outbuf = '';
    my $data_dir = '';

    sub _mason {
        unless ($mason) {
            $RT::Logger->debug("Creating Mason object.");

            # user may not have permissions on the data directory, so create a
            # new one
            $data_dir = tempdir(CLEANUP => 1);

            $mason = HTML::Mason::Interp->new(
                RT::Interface::Web::Handler->DefaultHandlerArgs,
                out_method => \$outbuf,
                autohandler_name => '', # disable forced login and more
                data_dir => $data_dir,
            );
464
            $mason->set_escape( h => \&RT::Interface::Web::EscapeHTML );
465
466
            $mason->set_escape( u => \&RT::Interface::Web::EscapeURI  );
            $mason->set_escape( j => \&RT::Interface::Web::EscapeJS   );
Shawn M Moore's avatar
Shawn M Moore committed
467
468
469
470
471
472
473
474
475
476
477
478
        }
        return $mason;
    }

    sub RunComponent {
        _mason->exec(@_);
        my $ret = $outbuf;
        $outbuf = '';
        return $ret;
    }
}

479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
{
    my $scrubber;

    sub _scrubber {
        unless ($scrubber) {
            $scrubber = HTML::Scrubber->new;
            # Allow everything by default, except JS attributes ...
            $scrubber->default(
                1 => {
                    '*' => 1,
                    map { ("on$_" => 0) }
                         qw(blur change click dblclick error focus keydown keypress keyup load
                            mousedown mousemove mouseout mouseover mouseup reset select submit unload)
                }
            );
            # ... and <script>s
            $scrubber->deny('script');
        }
        return $scrubber;
    }

    sub ScrubContent {
        my $content = shift;
        return _scrubber->scrub($content);
    }
}

Shawn M Moore's avatar
Shawn M Moore committed
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
{
    my %cache;

    sub HourDowDomIn {
        my $now = shift;
        my $tz  = shift;

        my $key = "$now $tz";
        return @{$cache{$key}} if exists $cache{$key};

        my ($hour, $dow, $dom);

        {
            local $ENV{'TZ'} = $tz;
            ## Using POSIX::tzset fixes a bug where the TZ environment variable
            ## is cached.
            tzset();
            (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
        }
        tzset(); # return back previous value

        $hour = "0$hour"
            if length($hour) == 1;
        $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];

        return @{$cache{$key}} = ($hour, $dow, $dom);
    }
}

sub GetResource {
    my $uri = URI->new(shift);
537
    my ($content, $content_type, $filename, $mimetype, $encoding);
Shawn M Moore's avatar
Shawn M Moore committed
538

539
540
541
542
543
    # Avoid trying to inline any remote URIs.  We absolutified all URIs
    # using WebURL in SendDashboard() above, so choose the simpler match on
    # that rather than testing a bunch of URI accessors.
    my $WebURL = RT->Config->Get("WebURL");
    return unless $uri =~ /^\Q$WebURL/;
Shawn M Moore's avatar
Shawn M Moore committed
544

545
    $RT::Logger->debug("Getting resource $uri");
Shawn M Moore's avatar
Shawn M Moore committed
546
547
548
549
550
551
552
553
554
555

    # strip out the equivalent of WebURL, so we start at the correct /
    my $path = $uri->path;
    my $webpath = RT->Config->Get('WebPath');
    $path =~ s/^\Q$webpath//;

    # add a leading / if needed
    $path = "/$path"
        unless $path =~ m{^/};

556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
    # Try the static handler first for non-Mason CSS, JS, etc.
    my $res = RT::Interface::Web::Handler->GetStatic($path);
    if ($res->is_success) {
        RT->Logger->debug("Fetched '$path' from the static handler");
        $content      = $res->decoded_content;
        $content_type = $res->headers->content_type;
    } else {
        # Try it through Mason instead...
        $HTML::Mason::Commands::r->path_info($path);

        # grab the query arguments
        my %args = map { $_ => [ $uri->query_param($_) ] } $uri->query_param;
        # Convert empty and single element arrayrefs to a non-ref scalar
        @$_ < 2 and $_ = $_->[0]
            for values %args;

        $RT::Logger->debug("Running component '$path'");
        $content = RunComponent($path, %args);

        $content_type = $HTML::Mason::Commands::r->content_type;
Shawn M Moore's avatar
Shawn M Moore committed
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    }

    # guess at the filename from the component name
    $filename = $1 if $path =~ m{^.*/(.*?)$};

    # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
    ($mimetype, $encoding) = MIME::Types::by_suffix($filename);

    if ($content_type) {
        $mimetype = $content_type;

        # strip down to just a MIME type
        $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
    }

    #If all else fails then some conservative and general-purpose defaults are:
    $mimetype ||= 'application/octet-stream';
    $encoding ||= 'base64';

    $RT::Logger->debug("Resource $uri: length=".length($content)." filename='$filename' mimetype='$mimetype', encoding='$encoding'");

    return ($content, $filename, $mimetype, $encoding);
}


{
    package RT::Dashboard::FakeRequest;
    sub new { bless {}, shift }
604
605
606
    sub header_out { return undef }
    sub headers_out { wantarray ? () : {} }
    sub err_headers_out { wantarray ? () : {} }
Shawn M Moore's avatar
Shawn M Moore committed
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
    sub content_type {
        my $self = shift;
        $self->{content_type} = shift if @_;
        return $self->{content_type};
    }
    sub path_info {
        my $self = shift;
        $self->{path_info} = shift if @_;
        return $self->{path_info};
    }
}

RT::Base->_ImportOverlays();

1;