rt/lib/RT/Dashboard/Mailer.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2014 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 package RT::Dashboard::Mailer;
  50 use strict;
  51 use warnings;
  52
  53 use HTML::Mason;
  54 use HTML::RewriteAttributes::Links;
  55 use HTML::RewriteAttributes::Resources;
  56 use MIME::Types;
  57 use POSIX 'tzset';
  58 use RT::Dashboard;
  59 use RT::Interface::Web::Handler;
  60 use RT::Interface::Web;
  61 use File::Temp 'tempdir';
  62 use HTML::Scrubber;
  63
  64 sub MailDashboards {
  65     my $self = shift;
  66     my %args = (
  67         All    => 0,
  68         DryRun => 0,
  69         Time   => time,
  70         @_,
  71     );
  72
  73     $RT::Logger->debug("Using time $args{Time} for dashboard generation");
  74
  75     my $from = $self->GetFrom();
  76     $RT::Logger->debug("Sending email from $from");
  77
  78     # look through each user for her subscriptions
  79     my $Users = RT::Users->new(RT->SystemUser);
  80     $Users->LimitToPrivileged;
  81
  82     while (defined(my $user = $Users->Next)) {
  83         if ($user->PrincipalObj->Disabled) {
  84             $RT::Logger->debug("Skipping over " . $user->Name . " due to having a disabled account.");
  85             next;
  86         }
  87
  88         my ($hour, $dow, $dom) = HourDowDomIn($args{Time}, $user->Timezone || RT->Config->Get('Timezone'));
  89         $hour .= ':00';
  90         $RT::Logger->debug("Checking ".$user->Name."'s subscriptions: hour $hour, dow $dow, dom $dom");
  91
  92         my $currentuser = RT::CurrentUser->new;
  93         $currentuser->LoadByName($user->Name);
  94
  95         # look through this user's subscriptions, are any supposed to be generated
  96         # right now?
  97         for my $subscription ($user->Attributes->Named('Subscription')) {
  98             next unless $self->IsSubscriptionReady(
  99                 %args,
 100                 Subscription => $subscription,
 101                 User         => $user,
 102                 LocalTime    => [$hour, $dow, $dom],
 103             );
 104
 105             my $email = $subscription->SubValue('Recipient')
 106                      || $user->EmailAddress;
 107
 108             eval {
 109                 $self->SendDashboard(
 110                     %args,
 111                     CurrentUser  => $currentuser,
 112                     Email        => $email,
 113                     Subscription => $subscription,
 114                     From         => $from,
 115                 )
 116             };
 117             if ( $@ ) {
 118                 $RT::Logger->error("Caught exception: $@");
 119             }
 120             else {
 121                 my $counter = $subscription->SubValue('Counter') || 0;
 122                 $subscription->SetSubValues(Counter => $counter + 1)
 123                     unless $args{DryRun};
 124             }
 125         }
 126     }
 127 }
 128
 129 sub IsSubscriptionReady {
 130     my $self = shift;
 131     my %args = (
 132         All          => 0,
 133         Subscription => undef,
 134         User         => undef,
 135         LocalTime    => [0, 0, 0],
 136         @_,
 137     );
 138
 139     return 1 if $args{All};
 140
 141     my $subscription  = $args{Subscription};
 142
 143     my $counter       = $subscription->SubValue('Counter') || 0;
 144
 145     my $sub_frequency = $subscription->SubValue('Frequency');
 146     my $sub_hour      = $subscription->SubValue('Hour');
 147     my $sub_dow       = $subscription->SubValue('Dow');
 148     my $sub_dom       = $subscription->SubValue('Dom');
 149     my $sub_fow       = $subscription->SubValue('Fow') || 1;
 150
 151     my ($hour, $dow, $dom) = @{ $args{LocalTime} };
 152
 153     $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");
 154
 155     return 0 if $sub_frequency eq 'never';
 156
 157     # correct hour?
 158     return 0 if $sub_hour ne $hour;
 159
 160     # all we need is the correct hour for daily dashboards
 161     return 1 if $sub_frequency eq 'daily';
 162
 163     if ($sub_frequency eq 'weekly') {
 164         # correct day of week?
 165         return 0 if $sub_dow ne $dow;
 166
 167         # does it match the "every N weeks" clause?
 168         return 1 if $counter % $sub_fow == 0;
 169
 170         $subscription->SetSubValues(Counter => $counter + 1)
 171             unless $args{DryRun};
 172         return 0;
 173     }
 174
 175     # if monthly, correct day of month?
 176     if ($sub_frequency eq 'monthly') {
 177         return $sub_dom == $dom;
 178     }
 179
 180     # monday through friday
 181     if ($sub_frequency eq 'm-f') {
 182         return 0 if $dow eq 'Sunday' || $dow eq 'Saturday';
 183         return 1;
 184     }
 185
 186     $RT::Logger->debug("Invalid subscription frequency $sub_frequency for " . $args{User}->Name);
 187
 188     # unknown frequency type, bail out
 189     return 0;
 190 }
 191
 192 sub GetFrom {
 193     RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
 194 }
 195
 196 sub SendDashboard {
 197     my $self = shift;
 198     my %args = (
 199         CurrentUser  => undef,
 200         Email        => undef,
 201         Subscription => undef,
 202         DryRun       => 0,
 203         @_,
 204     );
 205
 206     my $currentuser  = $args{CurrentUser};
 207     my $subscription = $args{Subscription};
 208
 209     my $rows = $subscription->SubValue('Rows');
 210
 211     my $DashboardId = $subscription->SubValue('DashboardId');
 212
 213     my $dashboard = RT::Dashboard->new($currentuser);
 214     my ($ok, $msg) = $dashboard->LoadById($DashboardId);
 215
 216     # failed to load dashboard. perhaps it was deleted or it changed privacy
 217     if (!$ok) {
 218         $RT::Logger->warning("Unable to load dashboard $DashboardId of subscription ".$subscription->Id." for user ".$currentuser->Name.": $msg");
 219         return $self->ObsoleteSubscription(
 220             %args,
 221             Subscription => $subscription,
 222         );
 223     }
 224
 225     $RT::Logger->debug('Generating dashboard "'.$dashboard->Name.'" for user "'.$currentuser->Name.'":');
 226
 227     if ($args{DryRun}) {
 228         print << "SUMMARY";
 229     Dashboard: @{[ $dashboard->Name ]}
 230     User:   @{[ $currentuser->Name ]} <$args{Email}>
 231 SUMMARY
 232         return;
 233     }
 234
 235     local $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
 236     local $HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
 237
 238     my $content = RunComponent(
 239         '/Dashboards/Render.html',
 240         id      => $dashboard->Id,
 241         Preview => 0,
 242     );
 243
 244     if ( RT->Config->Get('EmailDashboardRemove') ) {
 245         for ( RT->Config->Get('EmailDashboardRemove') ) {
 246             $content =~ s/$_//g;
 247         }
 248     }
 249
 250     $content = ScrubContent($content);
 251
 252     $RT::Logger->debug("Got ".length($content)." characters of output.");
 253
 254     $content = HTML::RewriteAttributes::Links->rewrite(
 255         $content,
 256         RT->Config->Get('WebURL') . 'Dashboards/Render.html',
 257     );
 258
 259     $self->EmailDashboard(
 260         %args,
 261         Dashboard => $dashboard,
 262         Content   => $content,
 263     );
 264 }
 265
 266 sub ObsoleteSubscription {
 267     my $self = shift;
 268     my %args = (
 269         From         => undef,
 270         To           => undef,
 271         Subscription => undef,
 272         CurrentUser  => undef,
 273         @_,
 274     );
 275
 276     my $subscription = $args{Subscription};
 277
 278     my $ok = RT::Interface::Email::SendEmailUsingTemplate(
 279         From      => $args{From},
 280         To        => $args{Email},
 281         Template  => 'Error: Missing dashboard',
 282         Arguments => {
 283             SubscriptionObj => $subscription,
 284         },
 285         ExtraHeaders => {
 286             'X-RT-Dashboard-Subscription-Id' => $subscription->Id,
 287             'X-RT-Dashboard-Id' => $subscription->SubValue('DashboardId'),
 288         },
 289     );
 290
 291     # only delete the subscription if the email looks like it went through
 292     if ($ok) {
 293         my ($deleted, $msg) = $subscription->Delete();
 294         if ($deleted) {
 295             $RT::Logger->debug("Deleted an obsolete subscription: $msg");
 296         }
 297         else {
 298             $RT::Logger->warning("Unable to delete an obsolete subscription: $msg");
 299         }
 300     }
 301     else {
 302         $RT::Logger->warning("Unable to notify ".$args{CurrentUser}->Name." of an obsolete subscription");
 303     }
 304 }
 305
 306 sub EmailDashboard {
 307     my $self = shift;
 308     my %args = (
 309         CurrentUser  => undef,
 310         Email        => undef,
 311         Dashboard    => undef,
 312         Subscription => undef,
 313         Content      => undef,
 314         @_,
 315     );
 316
 317     my $subscription = $args{Subscription};
 318     my $dashboard    = $args{Dashboard};
 319     my $currentuser  = $args{CurrentUser};
 320     my $email        = $args{Email};
 321
 322     my $frequency    = $subscription->SubValue('Frequency');
 323
 324     my %frequency_lookup = (
 325         'm-f'     => 'Weekday', # loc
 326         'daily'   => 'Daily',   # loc
 327         'weekly'  => 'Weekly',  # loc
 328         'monthly' => 'Monthly', # loc
 329         'never'   => 'Never',   # loc
 330     );
 331
 332     my $frequency_display = $frequency_lookup{$frequency}
 333                          || $frequency;
 334
 335     my $subject = sprintf '[%s] ' .  RT->Config->Get('DashboardSubject'),
 336         RT->Config->Get('rtname'),
 337         $currentuser->loc($frequency_display),
 338         $dashboard->Name;
 339
 340     my $entity = $self->BuildEmail(
 341         %args,
 342         To      => $email,
 343         Subject => $subject,
 344     );
 345
 346     $entity->head->replace('X-RT-Dashboard-Id', $dashboard->Id);
 347     $entity->head->replace('X-RT-Dashboard-Subscription-Id', $subscription->Id);
 348
 349     $RT::Logger->debug('Mailing dashboard "'.$dashboard->Name.'" to user '.$currentuser->Name." <$email>");
 350
 351     my $ok = RT::Interface::Email::SendEmail(
 352         Entity => $entity,
 353     );
 354
 355     if (!$ok) {
 356         $RT::Logger->error("Failed to email dashboard to user ".$currentuser->Name." <$email>");
 357         return;
 358     }
 359
 360     $RT::Logger->debug("Done sending dashboard to ".$currentuser->Name." <$email>");
 361 }
 362
 363 sub BuildEmail {
 364     my $self = shift;
 365     my %args = (
 366         Content => undef,
 367         From    => undef,
 368         To      => undef,
 369         Subject => undef,
 370         @_,
 371     );
 372
 373     my @parts;
 374     my %cid_of;
 375
 376     my $content = HTML::RewriteAttributes::Resources->rewrite($args{Content}, sub {
 377             my $uri = shift;
 378
 379             # already attached this object
 380             return "cid:$cid_of{$uri}" if $cid_of{$uri};
 381
 382             $cid_of{$uri} = time() . $$ . int(rand(1e6));
 383             my ($data, $filename, $mimetype, $encoding) = GetResource($uri);
 384
 385             # downgrade non-text strings, because all strings are utf8 by
 386             # default, which is wrong for non-text strings.
 387             if ( $mimetype !~ m{text/} ) {
 388                 utf8::downgrade( $data, 1 ) or $RT::Logger->warning("downgrade $data failed");
 389             }
 390
 391             push @parts, MIME::Entity->build(
 392                 Top          => 0,
 393                 Data         => $data,
 394                 Type         => $mimetype,
 395                 Encoding     => $encoding,
 396                 Disposition  => 'inline',
 397                 Name         => RT::Interface::Email::EncodeToMIME( String => $filename ),
 398                 'Content-Id' => $cid_of{$uri},
 399             );
 400
 401             return "cid:$cid_of{$uri}";
 402         },
 403         inline_css => sub {
 404             my $uri = shift;
 405             my ($content) = GetResource($uri);
 406             return $content;
 407         },
 408         inline_imports => 1,
 409     );
 410
 411     my $entity = MIME::Entity->build(
 412         From    => Encode::encode_utf8($args{From}),
 413         To      => Encode::encode_utf8($args{To}),
 414         Subject => RT::Interface::Email::EncodeToMIME( String => $args{Subject} ),
 415         Type    => "multipart/mixed",
 416     );
 417
 418     $entity->attach(
 419         Data        => Encode::encode_utf8($content),
 420         Type        => 'text/html',
 421         Charset     => 'UTF-8',
 422         Disposition => 'inline',
 423         Encoding    => "base64",
 424     );
 425
 426     for my $part (@parts) {
 427         $entity->add_part($part);
 428     }
 429
 430     $entity->make_singlepart;
 431
 432     return $entity;
 433 }
 434
 435 {
 436     my $mason;
 437     my $outbuf = '';
 438     my $data_dir = '';
 439
 440     sub _mason {
 441         unless ($mason) {
 442             $RT::Logger->debug("Creating Mason object.");
 443
 444             # user may not have permissions on the data directory, so create a
 445             # new one
 446             $data_dir = tempdir(CLEANUP => 1);
 447
 448             $mason = HTML::Mason::Interp->new(
 449                 RT::Interface::Web::Handler->DefaultHandlerArgs,
 450                 out_method => \$outbuf,
 451                 autohandler_name => '', # disable forced login and more
 452                 data_dir => $data_dir,
 453             );
 454             $mason->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
 455             $mason->set_escape( u => \&RT::Interface::Web::EscapeURI  );
 456             $mason->set_escape( j => \&RT::Interface::Web::EscapeJS   );
 457         }
 458         return $mason;
 459     }
 460
 461     sub RunComponent {
 462         _mason->exec(@_);
 463         my $ret = $outbuf;
 464         $outbuf = '';
 465         return $ret;
 466     }
 467 }
 468
 469 {
 470     my $scrubber;
 471
 472     sub _scrubber {
 473         unless ($scrubber) {
 474             $scrubber = HTML::Scrubber->new;
 475             # Allow everything by default, except JS attributes ...
 476             $scrubber->default(
 477                 1 => {
 478                     '*' => 1,
 479                     map { ("on$_" => 0) }
 480                          qw(blur change click dblclick error focus keydown keypress keyup load
 481                             mousedown mousemove mouseout mouseover mouseup reset select submit unload)
 482                 }
 483             );
 484             # ... and <script>s
 485             $scrubber->deny('script');
 486         }
 487         return $scrubber;
 488     }
 489
 490     sub ScrubContent {
 491         my $content = shift;
 492         return _scrubber->scrub($content);
 493     }
 494 }
 495
 496 {
 497     my %cache;
 498
 499     sub HourDowDomIn {
 500         my $now = shift;
 501         my $tz  = shift;
 502
 503         my $key = "$now $tz";
 504         return @{$cache{$key}} if exists $cache{$key};
 505
 506         my ($hour, $dow, $dom);
 507
 508         {
 509             local $ENV{'TZ'} = $tz;
 510             ## Using POSIX::tzset fixes a bug where the TZ environment variable
 511             ## is cached.
 512             tzset();
 513             (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
 514         }
 515         tzset(); # return back previous value
 516
 517         $hour = "0$hour"
 518             if length($hour) == 1;
 519         $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
 520
 521         return @{$cache{$key}} = ($hour, $dow, $dom);
 522     }
 523 }
 524
 525 sub GetResource {
 526     my $uri = URI->new(shift);
 527     my ($content, $filename, $mimetype, $encoding);
 528
 529     $RT::Logger->debug("Getting resource $uri");
 530
 531     # strip out the equivalent of WebURL, so we start at the correct /
 532     my $path = $uri->path;
 533     my $webpath = RT->Config->Get('WebPath');
 534     $path =~ s/^\Q$webpath//;
 535
 536     # add a leading / if needed
 537     $path = "/$path"
 538         unless $path =~ m{^/};
 539
 540     $HTML::Mason::Commands::r->path_info($path);
 541
 542     # grab the query arguments
 543     my %args;
 544     for (split /&/, ($uri->query||'')) {
 545         my ($k, $v) = /^(.*?)=(.*)$/
 546             or die "Unable to parse query parameter '$_'";
 547
 548         for ($k, $v) { s/%(..)/chr hex $1/ge }
 549
 550         # no value yet, simple key=value
 551         if (!exists $args{$k}) {
 552             $args{$k} = $v;
 553         }
 554         # already have key=value, need to upgrade it to key=[value1, value2]
 555         elsif (!ref($args{$k})) {
 556             $args{$k} = [$args{$k}, $v];
 557         }
 558         # already key=[value1, value2], just add the new value
 559         else {
 560             push @{ $args{$k} }, $v;
 561         }
 562     }
 563
 564     $RT::Logger->debug("Running component '$path'");
 565     $content = RunComponent($path, %args);
 566
 567     # guess at the filename from the component name
 568     $filename = $1 if $path =~ m{^.*/(.*?)$};
 569
 570     # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
 571     ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
 572
 573     my $content_type = $HTML::Mason::Commands::r->content_type;
 574     if ($content_type) {
 575         $mimetype = $content_type;
 576
 577         # strip down to just a MIME type
 578         $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
 579     }
 580
 581     #If all else fails then some conservative and general-purpose defaults are:
 582     $mimetype ||= 'application/octet-stream';
 583     $encoding ||= 'base64';
 584
 585     $RT::Logger->debug("Resource $uri: length=".length($content)." filename='$filename' mimetype='$mimetype', encoding='$encoding'");
 586
 587     return ($content, $filename, $mimetype, $encoding);
 588 }
 589
 590
 591 {
 592     package RT::Dashboard::FakeRequest;
 593     sub new { bless {}, shift }
 594     sub header_out { return undef }
 595     sub headers_out { wantarray ? () : {} }
 596     sub err_headers_out { wantarray ? () : {} }
 597     sub content_type {
 598         my $self = shift;
 599         $self->{content_type} = shift if @_;
 600         return $self->{content_type};
 601     }
 602     sub path_info {
 603         my $self = shift;
 604         $self->{path_info} = shift if @_;
 605         return $self->{path_info};
 606     }
 607 }
 608
 609 RT::Base->_ImportOverlays();
 610
 611 1;
 612