rt/sbin/rt-email-dashboards.in

   1 #!@PERL@
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
   7 #                                          <sales@bestpractical.com>
   8 #
   9 # (Except where explicitly superseded by other copyright notices)
  10 #
  11 #
  12 # LICENSE:
  13 #
  14 # This work is made available to you under the terms of Version 2 of
  15 # the GNU General Public License. A copy of that license should have
  16 # been provided with this software, but in any event can be snarfed
  17 # from www.gnu.org.
  18 #
  19 # This work is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program; if not, write to the Free Software
  26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27 # 02110-1301 or visit their web page on the internet at
  28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  29 #
  30 #
  31 # CONTRIBUTION SUBMISSION POLICY:
  32 #
  33 # (The following paragraph is not intended to limit the rights granted
  34 # to you to modify and distribute this software under the terms of
  35 # the GNU General Public License and is only of importance to you if
  36 # you choose to contribute your changes and enhancements to the
  37 # community by submitting them to Best Practical Solutions, LLC.)
  38 #
  39 # By intentionally submitting any modifications, corrections or
  40 # derivatives to this work, or any other work intended for use with
  41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  42 # you are the copyright holder for those contributions and you grant
  43 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  44 # royalty-free, perpetual, license to use, copy, create derivative
  45 # works based on those contributions, and sublicense and distribute
  46 # those contributions and any derivatives thereof.
  47 #
  48 # END BPS TAGGED BLOCK }}}
  49 use strict;
  50 use warnings;
  51
  52 # fix lib paths, some may be relative
  53 BEGIN {
  54     require File::Spec;
  55     my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
  56     my $bin_path;
  57
  58     for my $lib (@libs) {
  59         unless ( File::Spec->file_name_is_absolute($lib) ) {
  60             unless ($bin_path) {
  61                 if ( File::Spec->file_name_is_absolute(__FILE__) ) {
  62                     $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
  63                 }
  64                 else {
  65                     require FindBin;
  66                     no warnings "once";
  67                     $bin_path = $FindBin::Bin;
  68                 }
  69             }
  70             $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
  71         }
  72         unshift @INC, $lib;
  73     }
  74
  75 }
  76
  77 use RT;
  78 use RT::Interface::CLI qw{ CleanEnv loc };
  79
  80 use Getopt::Long;
  81 use HTML::Mason;
  82 use HTML::RewriteAttributes::Resources;
  83 use HTML::RewriteAttributes::Links;
  84 use MIME::Types;
  85 use POSIX 'tzset';
  86 use File::Temp 'tempdir';
  87
  88 # Clean out all the nasties from the environment
  89 CleanEnv();
  90
  91 # Load the config file
  92 RT::LoadConfig();
  93
  94 # Connect to the database and get RT::SystemUser and RT::Nobody loaded
  95 RT::Init();
  96
  97 require RT::Interface::Web;
  98 require RT::Interface::Web::Handler;
  99 require RT::Dashboard;
 100 $HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
 101
 102 no warnings 'once';
 103
 104 # Read in the options
 105 my %opts;
 106 GetOptions( \%opts,
 107     "help", "dryrun", "verbose", "debug", "epoch=i", "all", "skip-acl"
 108 );
 109
 110 if ($opts{'help'}) {
 111     require Pod::Usage;
 112     import Pod::Usage;
 113     pod2usage(-message => "RT Email Dashboards\n", -verbose => 1);
 114     exit 1;
 115 }
 116
 117 # helper functions
 118 sub verbose  { print loc(@_), "\n" if $opts{debug} || $opts{verbose}; 1 }
 119 sub debug    { print loc(@_), "\n" if $opts{debug}; 1 }
 120 sub error    { $RT::Logger->error(loc(@_)); verbose(@_); 1 }
 121 sub warning  { $RT::Logger->warning(loc(@_)); verbose(@_); 1 }
 122
 123 my $now = $opts{epoch} || time;
 124 verbose "Using time [_1]", scalar localtime($now);
 125
 126 my $from = get_from();
 127 debug "Sending email from [_1]", $from;
 128
 129 # look through each user for her subscriptions
 130 my $Users = RT::Users->new($RT::SystemUser);
 131 $Users->LimitToPrivileged;
 132
 133 while (defined(my $user = $Users->Next)) {
 134     if ($user->PrincipalObj->Disabled) {
 135         debug "Skipping over "
 136             . $user->Name
 137             . " due to having a disabled account.";
 138         next;
 139     }
 140
 141     my ($hour, $dow, $dom) = hour_dow_dom_in($user->Timezone || RT->Config->Get('Timezone'));
 142     $hour .= ':00';
 143     debug "Checking [_1]'s subscriptions: hour [_2], dow [_3], dom [_4]",
 144           $user->Name, $hour, $dow, $dom;
 145
 146     my $currentuser = RT::CurrentUser->new;
 147     $currentuser->LoadByName($user->Name);
 148
 149     # look through this user's subscriptions, are any supposed to be generated
 150     # right now?
 151     for my $subscription ($user->Attributes->Named('Subscription')) {
 152         my $counter = $subscription->SubValue('Counter') || 0;
 153
 154         if (!$opts{all}) {
 155             debug "Checking against subscription with frequency [_1], hour [_2], dow [_3], dom [_4]",
 156                 $subscription->SubValue('Frequency'), $subscription->SubValue('Hour'),
 157                 $subscription->SubValue('Dow'), $subscription->SubValue('Dom');
 158
 159             next if $subscription->SubValue('Frequency') eq 'never';
 160
 161             # correct hour?
 162             next if $subscription->SubValue('Hour') ne $hour;
 163
 164             # if weekly, correct day of week?
 165             if ( $subscription->SubValue('Frequency') eq 'weekly' ) {
 166                 next if $subscription->SubValue('Dow') ne $dow;
 167                 my $fow       = $subscription->SubValue('Fow') || 1;
 168                 if ( $counter % $fow ) {
 169                     $subscription->SetSubValues( Counter => $counter + 1 )
 170                       unless $opts{'dryrun'};
 171                     next;
 172                 }
 173             }
 174
 175             # if monthly, correct day of month?
 176             elsif ($subscription->SubValue('Frequency') eq 'monthly') {
 177                 next if $subscription->SubValue('Dom') != $dom;
 178             }
 179
 180             elsif ($subscription->SubValue('Frequency') eq 'm-f') {
 181                 next if $dow eq 'Sunday' || $dow eq 'Saturday';
 182             }
 183         }
 184
 185         my $email = $subscription->SubValue('Recipient')
 186                  || $user->EmailAddress;
 187
 188         eval { send_dashboard($currentuser, $email, $subscription) };
 189         if ( $@ ) {
 190             error 'Caught exception: ' . $@;
 191         }
 192         else {
 193             $subscription->SetSubValues(
 194                 Counter => $counter + 1 )
 195               unless $opts{'dryrun'};
 196         }
 197     }
 198 }
 199
 200 sub send_dashboard {
 201     my ($currentuser, $email, $subscription) = @_;
 202
 203     my $rows = $subscription->SubValue('Rows');
 204
 205     my $dashboard = RT::Dashboard->new($currentuser);
 206
 207     my ($ok, $msg) = $dashboard->LoadById($subscription->SubValue('DashboardId'));
 208
 209     # failed to load dashboard. perhaps it was deleted or it changed privacy
 210     if (!$ok) {
 211         warning "Unable to load dashboard [_1] of subscription [_2] for user [_3]: [_4]",
 212             $subscription->SubValue('DashboardId'),
 213             $subscription->Id,
 214             $currentuser->Name,
 215             $msg;
 216
 217         my $ok = RT::Interface::Email::SendEmailUsingTemplate(
 218             From      => $from,
 219             To        => $email,
 220             Template  => 'Error: Missing dashboard',
 221             Arguments => {
 222                 SubscriptionObj => $subscription,
 223             },
 224         );
 225
 226         # only delete the subscription if the email looks like it went through
 227         if ($ok) {
 228             my ($deleted, $msg) = $subscription->Delete();
 229             if ($deleted) {
 230                 verbose("Deleted an obsolete subscription: [_1]", $msg);
 231             }
 232             else {
 233                 warning("Unable to delete an obsolete subscription: [_1]", $msg);
 234             }
 235         }
 236         else {
 237             warning("Unable to notify [_1] of an obsolete subscription", $currentuser->Name);
 238         }
 239
 240         return;
 241     }
 242
 243     verbose 'Creating dashboard "[_1]" for user "[_2]":',
 244             $dashboard->Name,
 245             $currentuser->Name;
 246
 247     if ($opts{'dryrun'}) {
 248         print << "SUMMARY";
 249     Dashboard: @{[ $dashboard->Name ]}
 250     User:   @{[ $currentuser->Name ]} <$email>
 251 SUMMARY
 252         return;
 253     }
 254
 255     $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
 256     my $contents = run_component(
 257         '/Dashboards/Render.html',
 258         id      => $dashboard->Id,
 259         Preview => 0,
 260     );
 261
 262     for (@{ RT->Config->Get('EmailDashboardRemove') || [] }) {
 263         $contents =~ s/$_//g;
 264     }
 265
 266     debug "Got [_1] characters of output.", length $contents;
 267
 268     $contents = HTML::RewriteAttributes::Links->rewrite(
 269         $contents,
 270         RT->Config->Get('WebURL') . '/Dashboards/Render.html',
 271     );
 272
 273     email_dashboard($currentuser, $email, $dashboard, $subscription, $contents);
 274 }
 275
 276 sub email_dashboard {
 277     my ($currentuser, $email, $dashboard, $subscription, $content) = @_;
 278
 279     verbose 'Sending dashboard "[_1]" to user [_2] <[_3]>',
 280             $dashboard->Name,
 281             $currentuser->Name,
 282             $email;
 283
 284     my $subject = sprintf '[%s] ' .  RT->Config->Get('DashboardSubject'),
 285         RT->Config->Get('rtname'),
 286         ucfirst($subscription->SubValue('Frequency')),
 287         $dashboard->Name;
 288
 289     my $entity = build_email($content, $from, $email, $subject);
 290
 291     my $ok = RT::Interface::Email::SendEmail(
 292         Entity => $entity,
 293     );
 294
 295     debug "Done sending dashboard to [_1] <[_2]>",
 296           $currentuser->Name, $email
 297               and return if $ok;
 298
 299     error 'Failed to email dashboard to user [_1] <[_2]>',
 300           $currentuser->Name, $email;
 301 }
 302
 303 sub build_email {
 304     my ($content, $from, $to, $subject) = @_;
 305     my @parts;
 306     my %cid_of;
 307
 308     $content = HTML::RewriteAttributes::Resources->rewrite($content, sub {
 309             my $uri = shift;
 310
 311             # already attached this object
 312             return "cid:$cid_of{$uri}" if $cid_of{$uri};
 313
 314             $cid_of{$uri} = time() . $$ . int(rand(1e6));
 315             my ($data, $filename, $mimetype, $encoding) = get_resource($uri);
 316
 317             # downgrade non-text strings, because all strings are utf8 by
 318             # default, which is wrong for non-text strings.
 319             if ( $mimetype !~ m{text/} ) {
 320                 utf8::downgrade( $data, 1 ) or warning "downgrade $data failed";
 321             }
 322
 323             push @parts, MIME::Entity->build(
 324                 Top          => 0,
 325                 Data         => $data,
 326                 Type         => $mimetype,
 327                 Encoding     => $encoding,
 328                 Disposition  => 'inline',
 329                 Name         => $filename,
 330                 'Content-Id' => $cid_of{$uri},
 331             );
 332
 333             return "cid:$cid_of{$uri}";
 334         },
 335         inline_css => sub {
 336             my $uri = shift;
 337             my ($content) = get_resource($uri);
 338             return $content;
 339         },
 340         inline_imports => 1,
 341     );
 342
 343     my $entity = MIME::Entity->build(
 344         From    => $from,
 345         To      => $to,
 346         Subject => $subject,
 347         Type    => "multipart/mixed",
 348     );
 349
 350     $entity->attach(
 351         Data        => Encode::encode_utf8($content),
 352         Type        => 'text/html',
 353         Charset     => 'UTF-8',
 354         Disposition => 'inline',
 355     );
 356
 357     for my $part (@parts) {
 358         $entity->add_part($part);
 359     }
 360
 361     return $entity;
 362 }
 363
 364 sub get_from {
 365     RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
 366 }
 367
 368 {
 369     my $mason;
 370     my $outbuf = '';
 371     my $data_dir = '';
 372
 373     sub mason {
 374         unless ($mason) {
 375             debug "Creating Mason object.";
 376
 377             # user may not have permissions on the data directory, so create a
 378             # new one
 379             $data_dir = tempdir(CLEANUP => 1);
 380
 381             $mason = HTML::Mason::Interp->new(
 382                 RT::Interface::Web::Handler->DefaultHandlerArgs,
 383                 out_method => \$outbuf,
 384                 autohandler_name => '', # disable forced login and more
 385                 data_dir => $data_dir,
 386             );
 387             $mason->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
 388             $mason->set_escape( u => \&RT::Interface::Web::EscapeURI  );
 389             $mason->set_escape( j => \&RT::Interface::Web::EscapeJS   );
 390         }
 391         return $mason;
 392     }
 393
 394     sub run_component {
 395         mason->exec(@_);
 396         my $ret = $outbuf;
 397         $outbuf = '';
 398         return $ret;
 399     }
 400 }
 401
 402 {
 403     my %cache;
 404
 405     sub hour_dow_dom_in {
 406         my $tz = shift;
 407         return @{$cache{$tz}} if exists $cache{$tz};
 408
 409         my ($hour, $dow, $dom);
 410
 411         {
 412             local $ENV{'TZ'} = $tz;
 413             ## Using POSIX::tzset fixes a bug where the TZ environment variable
 414             ## is cached.
 415             tzset();
 416             (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
 417         }
 418         tzset(); # return back previous value
 419
 420         $hour = "0$hour"
 421             if length($hour) == 1;
 422         $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
 423
 424         return @{$cache{$tz}} = ($hour, $dow, $dom);
 425     }
 426 }
 427
 428 sub get_resource {
 429     my $uri = URI->new(shift);
 430     my ($content, $filename, $mimetype, $encoding);
 431
 432     verbose "Getting resource [_1]", $uri;
 433
 434     # strip out the equivalent of WebURL, so we start at the correct /
 435     my $path = $uri->path;
 436     my $webpath = RT->Config->Get('WebPath');
 437     $path =~ s/^\Q$webpath//;
 438
 439     # add a leading / if needed
 440     $path = "/$path"
 441         unless $path =~ m{^/};
 442
 443     # grab the query arguments
 444     my %args;
 445     for (split /&/, ($uri->query||'')) {
 446         my ($k, $v) = /^(.*?)=(.*)$/
 447             or die "Unable to parse query parameter '$_'";
 448
 449         for ($k, $v) { s/%(..)/chr hex $1/ge }
 450
 451         # no value yet, simple key=value
 452         if (!exists $args{$k}) {
 453             $args{$k} = $v;
 454         }
 455         # already have key=value, need to upgrade it to key=[value1, value2]
 456         elsif (!ref($args{$k})) {
 457             $args{$k} = [$args{$k}, $v];
 458         }
 459         # already key=[value1, value2], just add the new value
 460         else {
 461             push @{ $args{$k} }, $v;
 462         }
 463     }
 464
 465     debug "Running component '[_1]'", $path;
 466     $content = run_component($path, %args);
 467
 468     # guess at the filename from the component name
 469     $filename = $1 if $path =~ m{^.*/(.*?)$};
 470
 471     # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
 472     ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
 473
 474     my $content_type = $HTML::Mason::Commands::r->content_type;
 475     if ($content_type) {
 476         $mimetype = $content_type;
 477
 478         # strip down to just a MIME type
 479         $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
 480     }
 481
 482     #If all else fails then some conservative and general-purpose defaults are:
 483     $mimetype ||= 'application/octet-stream';
 484     $encoding ||= 'base64';
 485
 486     debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'",
 487         $uri,
 488         length($content),
 489         $filename,
 490         $mimetype,
 491         $encoding;
 492
 493     return ($content, $filename, $mimetype, $encoding);
 494 }
 495
 496 package RT::Dashboard::FakeRequest;
 497 sub new { bless {}, shift }
 498 sub header_out { shift }
 499 sub headers_out { shift }
 500 sub content_type {
 501     my $self = shift;
 502     $self->{content_type} = shift if @_;
 503     return $self->{content_type};
 504 }
 505
 506 =head1 NAME
 507
 508 rt-email-dashboards - Send email dashboards
 509
 510 =head1 SYNOPSIS
 511
 512     /opt/rt3/local/sbin/rt-email-dashboards [options]
 513
 514 =head1 DESCRIPTION
 515
 516 This tool will send users email based on how they have subscribed to
 517 dashboards. A dashboard is a set of saved searches, the subscription controls
 518 how often that dashboard is sent and how it's displayed.
 519
 520 Each subscription has an hour, and possibly day of week or day of month. These
 521 are taken to be in the user's timezone if available, UTC otherwise.
 522
 523 =head1 SETUP
 524
 525 You'll need to have cron run this script every hour. Here's an example crontab
 526 entry to do this.
 527
 528     0 * * * * @PERL@ /opt/rt3/local/sbin/rt-email-dashboards
 529
 530 This will run the script every hour on the hour. This may need some further
 531 tweaking to be run as the correct user.
 532
 533 =head1 OPTIONS
 534
 535 This tool supports a few options. Most are for debugging.
 536
 537 =over 8
 538
 539 =item --help
 540
 541 Display this documentation
 542
 543 =item --dryrun
 544
 545 Figure out which dashboards would be sent, but don't actually generate them
 546
 547 =item --epoch SECONDS
 548
 549 Instead of using the current time to figure out which dashboards should be
 550 sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
 551 be Oct 12 19:06:58 GMT 2007).
 552
 553 =item --verbose
 554
 555 Print out some tracing information (such as which dashboards are being
 556 generated and sent out)
 557
 558 =item --debug
 559
 560 Print out more tracing information (such as each user and subscription that is
 561 being considered)
 562
 563 =item --all
 564
 565 Ignore subscription frequency when considering each dashboard (should only be
 566 used with --dryrun)
 567
 568 =back
 569
 570 =cut
 571