--- /dev/null
+#!@PERL@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
+# <jesse@bestpractical.com>
+#
+# (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 }}}
+use strict;
+use warnings;
+
+# fix lib paths, some may be relative
+BEGIN {
+ require File::Spec;
+ my @libs = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
+ my $bin_path;
+
+ for my $lib (@libs) {
+ unless ( File::Spec->file_name_is_absolute($lib) ) {
+ unless ($bin_path) {
+ if ( File::Spec->file_name_is_absolute(__FILE__) ) {
+ $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
+ }
+ else {
+ require FindBin;
+ no warnings "once";
+ $bin_path = $FindBin::Bin;
+ }
+ }
+ $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
+ }
+ unshift @INC, $lib;
+ }
+
+}
+
+use RT;
+use RT::Interface::Web;
+use RT::Interface::Web::Handler;
+use RT::Dashboard;
+use RT::Interface::CLI qw{ CleanEnv loc };
+
+use Getopt::Long;
+use HTML::Mason;
+use HTML::RewriteAttributes::Resources;
+use HTML::RewriteAttributes::Links;
+use MIME::Types;
+use POSIX 'tzset';
+use File::Temp 'tempdir';
+
+# Clean out all the nasties from the environment
+CleanEnv();
+
+# Load the config file
+RT::LoadConfig();
+
+# Connect to the database and get RT::SystemUser and RT::Nobody loaded
+RT::Init();
+
+$HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
+
+no warnings 'once';
+
+# Read in the options
+my %opts;
+GetOptions( \%opts,
+ "help", "dryrun", "verbose", "debug", "epoch=i", "all", "skip-acl"
+);
+
+if ($opts{'help'}) {
+ require Pod::Usage;
+ import Pod::Usage;
+ pod2usage(-message => "RT Email Dashboards\n", -verbose => 1);
+ exit 1;
+}
+
+# helper functions
+sub verbose { print loc(@_), "\n" if $opts{debug} || $opts{verbose}; 1 }
+sub debug { print loc(@_), "\n" if $opts{debug}; 1 }
+sub error { $RT::Logger->error(loc(@_)); verbose(@_); 1 }
+sub warning { $RT::Logger->warning(loc(@_)); verbose(@_); 1 }
+
+my $now = $opts{epoch} || time;
+verbose "Using time [_1]", scalar localtime($now);
+
+my $from = get_from();
+debug "Sending email from [_1]", $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) {
+ debug "Skipping over "
+ . $user->Name
+ . " due to having a disabled account.";
+ next;
+ }
+
+ my ($hour, $dow, $dom) = hour_dow_dom_in($user->Timezone || RT->Config->Get('Timezone'));
+ $hour .= ':00';
+ debug "Checking [_1]'s subscriptions: hour [_2], dow [_3], dom [_4]",
+ $user->Name, $hour, $dow, $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')) {
+ my $counter = $subscription->SubValue('Counter') || 0;
+
+ if (!$opts{all}) {
+ debug "Checking against subscription with frequency [_1], hour [_2], dow [_3], dom [_4]",
+ $subscription->SubValue('Frequency'), $subscription->SubValue('Hour'),
+ $subscription->SubValue('Dow'), $subscription->SubValue('Dom');
+
+ next if $subscription->SubValue('Frequency') eq 'never';
+
+ # correct hour?
+ next if $subscription->SubValue('Hour') ne $hour;
+
+ # if weekly, correct day of week?
+ if ( $subscription->SubValue('Frequency') eq 'weekly' ) {
+ next if $subscription->SubValue('Dow') ne $dow;
+ my $fow = $subscription->SubValue('Fow') || 1;
+ if ( $counter % $fow ) {
+ $subscription->SetSubValues( Counter => $counter + 1 )
+ unless $opts{'dryrun'};
+ next;
+ }
+ }
+
+ # if monthly, correct day of month?
+ elsif ($subscription->SubValue('Frequency') eq 'monthly') {
+ next if $subscription->SubValue('Dom') != $dom;
+ }
+
+ elsif ($subscription->SubValue('Frequency') eq 'm-f') {
+ next if $dow eq 'Sunday' || $dow eq 'Saturday';
+ }
+ }
+
+ my $email = $subscription->SubValue('Recipient')
+ || $user->EmailAddress;
+
+ eval { send_dashboard($currentuser, $email, $subscription) };
+ if ( $@ ) {
+ error 'Caught exception: ' . $@;
+ }
+ else {
+ $subscription->SetSubValues(
+ Counter => $counter + 1 )
+ unless $opts{'dryrun'};
+ }
+ }
+}
+
+sub send_dashboard {
+ my ($currentuser, $email, $subscription) = @_;
+
+ my $rows = $subscription->SubValue('Rows');
+
+ my $dashboard = RT::Dashboard->new($currentuser);
+
+ my ($ok, $msg) = $dashboard->LoadById($subscription->SubValue('DashboardId'));
+
+ # failed to load dashboard. perhaps it was deleted or it changed privacy
+ if (!$ok) {
+ warning "Unable to load dashboard [_1] of subscription [_2] for user [_3]: [_4]",
+ $subscription->SubValue('DashboardId'),
+ $subscription->Id,
+ $currentuser->Name,
+ $msg;
+
+ my $ok = RT::Interface::Email::SendEmailUsingTemplate(
+ From => $from,
+ To => $email,
+ Template => 'Error: Missing dashboard',
+ Arguments => {
+ SubscriptionObj => $subscription,
+ },
+ );
+
+ # only delete the subscription if the email looks like it went through
+ if ($ok) {
+ my ($deleted, $msg) = $subscription->Delete();
+ if ($deleted) {
+ verbose("Deleted an obsolete subscription: [_1]", $msg);
+ }
+ else {
+ warning("Unable to delete an obsolete subscription: [_1]", $msg);
+ }
+ }
+ else {
+ warning("Unable to notify [_1] of an obsolete subscription", $currentuser->Name);
+ }
+
+ return;
+ }
+
+ verbose 'Creating dashboard "[_1]" for user "[_2]":',
+ $dashboard->Name,
+ $currentuser->Name;
+
+ if ($opts{'dryrun'}) {
+ print << "SUMMARY";
+ Dashboard: @{[ $dashboard->Name ]}
+ User: @{[ $currentuser->Name ]} <$email>
+SUMMARY
+ return;
+ }
+
+ $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
+ my $contents = run_component(
+ '/Dashboards/Render.html',
+ id => $dashboard->Id,
+ Preview => 0,
+ );
+
+ for (@{ RT->Config->Get('EmailDashboardRemove') || [] }) {
+ $contents =~ s/$_//g;
+ }
+
+ debug "Got [_1] characters of output.", length $contents;
+
+ $contents = HTML::RewriteAttributes::Links->rewrite(
+ $contents,
+ RT->Config->Get('WebURL') . '/Dashboards/Render.html',
+ );
+
+ email_dashboard($currentuser, $email, $dashboard, $subscription, $contents);
+}
+
+sub email_dashboard {
+ my ($currentuser, $email, $dashboard, $subscription, $content) = @_;
+
+ verbose 'Sending dashboard "[_1]" to user [_2] <[_3]>',
+ $dashboard->Name,
+ $currentuser->Name,
+ $email;
+
+ my $subject = sprintf '[%s] ' . RT->Config->Get('DashboardSubject'),
+ RT->Config->Get('rtname'),
+ ucfirst($subscription->SubValue('Frequency')),
+ $dashboard->Name;
+
+ my $entity = build_email($content, $from, $email, $subject);
+
+ my $ok = RT::Interface::Email::SendEmail(
+ Entity => $entity,
+ );
+
+ debug "Done sending dashboard to [_1] <[_2]>",
+ $currentuser->Name, $email
+ and return if $ok;
+
+ error 'Failed to email dashboard to user [_1] <[_2]>',
+ $currentuser->Name, $email;
+}
+
+sub build_email {
+ my ($content, $from, $to, $subject) = @_;
+ my @parts;
+ my %cid_of;
+
+ $content = HTML::RewriteAttributes::Resources->rewrite($content, sub {
+ my $uri = shift;
+
+ # already attached this object
+ return "cid:$cid_of{$uri}" if $cid_of{$uri};
+
+ $cid_of{$uri} = time() . $$ . int(rand(1e6));
+ my ($data, $filename, $mimetype, $encoding) = get_resource($uri);
+
+ # downgrade non-text strings, because all strings are utf8 by
+ # default, which is wrong for non-text strings.
+ if ( $mimetype !~ m{text/} ) {
+ utf8::downgrade( $data, 1 ) or warning "downgrade $data failed";
+ }
+
+ push @parts, MIME::Entity->build(
+ Top => 0,
+ Data => $data,
+ Type => $mimetype,
+ Encoding => $encoding,
+ Disposition => 'inline',
+ Name => $filename,
+ 'Content-Id' => $cid_of{$uri},
+ );
+
+ return "cid:$cid_of{$uri}";
+ },
+ inline_css => sub {
+ my $uri = shift;
+ my ($content) = get_resource($uri);
+ return $content;
+ },
+ inline_imports => 1,
+ );
+
+ my $entity = MIME::Entity->build(
+ From => $from,
+ To => $to,
+ Subject => $subject,
+ Type => "multipart/mixed",
+ );
+
+ $entity->attach(
+ Data => Encode::encode_utf8($content),
+ Type => 'text/html',
+ Charset => 'UTF-8',
+ Disposition => 'inline',
+ );
+
+ for my $part (@parts) {
+ $entity->add_part($part);
+ }
+
+ return $entity;
+}
+
+sub get_from {
+ RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
+}
+
+{
+ my $mason;
+ my $outbuf = '';
+ my $data_dir = '';
+
+ sub mason {
+ unless ($mason) {
+ 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,
+ );
+ }
+ return $mason;
+ }
+
+ sub run_component {
+ mason->exec(@_);
+ my $ret = $outbuf;
+ $outbuf = '';
+ return $ret;
+ }
+}
+
+{
+ my %cache;
+
+ sub hour_dow_dom_in {
+ my $tz = shift;
+ return @{$cache{$tz}} if exists $cache{$tz};
+
+ 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{$tz}} = ($hour, $dow, $dom);
+ }
+}
+
+sub get_resource {
+ my $uri = URI->new(shift);
+ my ($content, $filename, $mimetype, $encoding);
+
+ verbose "Getting resource [_1]", $uri;
+
+ # 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{^/};
+
+ # grab the query arguments
+ my %args;
+ for (split /&/, ($uri->query||'')) {
+ my ($k, $v) = /^(.*?)=(.*)$/
+ or die "Unable to parse query parameter '$_'";
+
+ for ($k, $v) { s/%(..)/chr hex $1/ge }
+
+ # no value yet, simple key=value
+ if (!exists $args{$k}) {
+ $args{$k} = $v;
+ }
+ # already have key=value, need to upgrade it to key=[value1, value2]
+ elsif (!ref($args{$k})) {
+ $args{$k} = [$args{$k}, $v];
+ }
+ # already key=[value1, value2], just add the new value
+ else {
+ push @{ $args{$k} }, $v;
+ }
+ }
+
+ debug "Running component '[_1]'", $path;
+ $content = run_component($path, %args);
+
+ # 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);
+
+ my $content_type = $HTML::Mason::Commands::r->content_type;
+ 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';
+
+ debug "Resource [_1]: length=[_2] filename='[_3]' mimetype='[_4]', encoding='[_5]'",
+ $uri,
+ length($content),
+ $filename,
+ $mimetype,
+ $encoding;
+
+ return ($content, $filename, $mimetype, $encoding);
+}
+
+package RT::Dashboard::FakeRequest;
+sub new { bless {}, shift }
+sub header_out { shift }
+sub headers_out { shift }
+sub content_type {
+ my $self = shift;
+ $self->{content_type} = shift if @_;
+ return $self->{content_type};
+}
+
+=head1 NAME
+
+rt-email-dashboards - Send email dashboards
+
+=head1 SYNOPSIS
+
+ /opt/rt3/local/sbin/rt-email-dashboards [options]
+
+=head1 DESCRIPTION
+
+This tool will send users email based on how they have subscribed to
+dashboards. A dashboard is a set of saved searches, the subscription controls
+how often that dashboard is sent and how it's displayed.
+
+Each subscription has an hour, and possibly day of week or day of month. These
+are taken to be in the user's timezone if available, UTC otherwise.
+
+=head1 SETUP
+
+You'll need to have cron run this script every hour. Here's an example crontab
+entry to do this.
+
+ 0 * * * * @PERL@ /opt/rt3/local/sbin/rt-email-dashboards
+
+This will run the script every hour on the hour. This may need some further
+tweaking to be run as the correct user.
+
+=head1 OPTIONS
+
+This tool supports a few options. Most are for debugging.
+
+=over 8
+
+=item --help
+
+Display this documentation
+
+=item --dryrun
+
+Figure out which dashboards would be sent, but don't actually generate them
+
+=item --epoch SECONDS
+
+Instead of using the current time to figure out which dashboards should be
+sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
+be Oct 12 19:06:58 GMT 2007).
+
+=item --verbose
+
+Print out some tracing information (such as which dashboards are being
+generated and sent out)
+
+=item --debug
+
+Print out more tracing information (such as each user and subscription that is
+being considered)
+
+=item --all
+
+Ignore subscription frequency when considering each dashboard (should only be
+used with --dryrun)
+
+=back
+
+=cut
+
projects / freeside.git / blobdiff