+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@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 = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- 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::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();
-
-require RT::Interface::Web;
-require RT::Interface::Web::Handler;
-require RT::Dashboard;
-$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,
- );
- $mason->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
- $mason->interp->set_escape( u => \&RT::Interface::Web::EscapeURI );
- $mason->interp->set_escape( j => \&RT::Interface::Web::EscapeJS );
- }
- 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 * * * * /usr/bin/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