lib/RT/Dashboard/Mailer.pm

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