rt/sbin/rt-email-dashboards.in

   1 #!@PERL@
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2011 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         }
 388         return $mason;
 389     }
 390
 391     sub run_component {
 392         mason->exec(@_);
 393         my $ret = $outbuf;
 394         $outbuf = '';
 395         return $ret;
 396     }
 397 }
 398
 399 {
 400     my %cache;
 401
 402     sub hour_dow_dom_in {
 403         my $tz = shift;
 404         return @{$cache{$tz}} if exists $cache{$tz};
 405
 406         my ($hour, $dow, $dom);
 407
 408         {
 409             local $ENV{'TZ'} = $tz;
 410             ## Using POSIX::tzset fixes a bug where the TZ environment variable
 411             ## is cached.
 412             tzset();
 413             (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
 414         }
 415         tzset(); # return back previous value
 416
 417         $hour = "0$hour"
 418             if length($hour) == 1;
 419         $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
 420
 421         return @{$cache{$tz}} = ($hour, $dow, $dom);
 422     }
 423 }
 424
 425 sub get_resource {
 426     my $uri = URI->new(shift);
 427     my ($content, $filename, $mimetype, $encoding);
 428
 429     verbose "Getting resource [_1]", $uri;
 430
 431     # strip out the equivalent of WebURL, so we start at the correct /
 432     my $path = $uri->path;
 433     my $webpath = RT->Config->Get('WebPath');
 434     $path =~ s/^\Q$webpath//;
 435
 436     # add a leading / if needed
 437     $path = "/$path"
 438         unless $path =~ m{^/};
 439
 440     # grab the query arguments
 441     my %args;
 442     for (split /&/, ($uri->query||'')) {
 443         my ($k, $v) = /^(.*?)=(.*)$/
 444             or die "Unable to parse query parameter '$_'";
 445
 446         for ($k, $v) { s/%(..)/chr hex $1/ge }
 447
 448         # no value yet, simple key=value
 449         if (!exists $args{$k}) {
 450             $args{$k} = $v;
 451         }
 452         # already have key=value, need to upgrade it to key=[value1, value2]
 453         elsif (!ref($args{$k})) {
 454             $args{$k} = [$args{$k}, $v];
 455         }
 456         # already key=[value1, value2], just add the new value
 457         else {
 458             push @{ $args{$k} }, $v;
 459         }
 460     }
 461
 462     debug "Running component '[_1]'", $path;
 463     $content = run_component($path, %args);
 464
 465     # guess at the filename from the component name
 466     $filename = $1 if $path =~ m{^.*/(.*?)$};
 467
 468     # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
 469     ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
 470
 471     my $content_type = $HTML::Mason::Commands::r->content_type;
 472     if ($content_type) {
 473         $mimetype = $content_type;
 474
 475         # strip down to just a MIME type
 476         $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
 477     }
 478
 479     #If all else fails then some conservative and general-purpose defaults are:
 480     $mimetype ||= 'application/octet-stream';
 481     $encoding ||= 'base64';
 482
 483     debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'",
 484         $uri,
 485         length($content),
 486         $filename,
 487         $mimetype,
 488         $encoding;
 489
 490     return ($content, $filename, $mimetype, $encoding);
 491 }
 492
 493 package RT::Dashboard::FakeRequest;
 494 sub new { bless {}, shift }
 495 sub header_out { shift }
 496 sub headers_out { shift }
 497 sub content_type {
 498     my $self = shift;
 499     $self->{content_type} = shift if @_;
 500     return $self->{content_type};
 501 }
 502
 503 =head1 NAME
 504
 505 rt-email-dashboards - Send email dashboards
 506
 507 =head1 SYNOPSIS
 508
 509     /opt/rt3/local/sbin/rt-email-dashboards [options]
 510
 511 =head1 DESCRIPTION
 512
 513 This tool will send users email based on how they have subscribed to
 514 dashboards. A dashboard is a set of saved searches, the subscription controls
 515 how often that dashboard is sent and how it's displayed.
 516
 517 Each subscription has an hour, and possibly day of week or day of month. These
 518 are taken to be in the user's timezone if available, UTC otherwise.
 519
 520 =head1 SETUP
 521
 522 You'll need to have cron run this script every hour. Here's an example crontab
 523 entry to do this.
 524
 525     0 * * * * @PERL@ /opt/rt3/local/sbin/rt-email-dashboards
 526
 527 This will run the script every hour on the hour. This may need some further
 528 tweaking to be run as the correct user.
 529
 530 =head1 OPTIONS
 531
 532 This tool supports a few options. Most are for debugging.
 533
 534 =over 8
 535
 536 =item --help
 537
 538 Display this documentation
 539
 540 =item --dryrun
 541
 542 Figure out which dashboards would be sent, but don't actually generate them
 543
 544 =item --epoch SECONDS
 545
 546 Instead of using the current time to figure out which dashboards should be
 547 sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
 548 be Oct 12 19:06:58 GMT 2007).
 549
 550 =item --verbose
 551
 552 Print out some tracing information (such as which dashboards are being
 553 generated and sent out)
 554
 555 =item --debug
 556
 557 Print out more tracing information (such as each user and subscription that is
 558 being considered)
 559
 560 =item --all
 561
 562 Ignore subscription frequency when considering each dashboard (should only be
 563 used with --dryrun)
 564
 565 =back
 566
 567 =cut
 568