1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
49 package RT::Dashboard::Mailer;
54 use HTML::RewriteAttributes::Links;
55 use HTML::RewriteAttributes::Resources;
59 use RT::Interface::Web::Handler;
60 use RT::Interface::Web;
61 use File::Temp 'tempdir';
73 $RT::Logger->debug("Using time $args{Time} for dashboard generation");
75 my $from = $self->GetFrom();
76 $RT::Logger->debug("Sending email from $from");
78 # look through each user for her subscriptions
79 my $Users = RT::Users->new(RT->SystemUser);
80 $Users->LimitToPrivileged;
82 while (defined(my $user = $Users->Next)) {
83 if ($user->PrincipalObj->Disabled) {
84 $RT::Logger->debug("Skipping over " . $user->Name . " due to having a disabled account.");
88 my ($hour, $dow, $dom) = HourDowDomIn($args{Time}, $user->Timezone || RT->Config->Get('Timezone'));
90 $RT::Logger->debug("Checking ".$user->Name."'s subscriptions: hour $hour, dow $dow, dom $dom");
92 my $currentuser = RT::CurrentUser->new;
93 $currentuser->LoadByName($user->Name);
95 # look through this user's subscriptions, are any supposed to be generated
97 for my $subscription ($user->Attributes->Named('Subscription')) {
98 next unless $self->IsSubscriptionReady(
100 Subscription => $subscription,
102 LocalTime => [$hour, $dow, $dom],
105 my $email = $subscription->SubValue('Recipient')
106 || $user->EmailAddress;
109 $self->SendDashboard(
111 CurrentUser => $currentuser,
113 Subscription => $subscription,
118 $RT::Logger->error("Caught exception: $@");
121 my $counter = $subscription->SubValue('Counter') || 0;
122 $subscription->SetSubValues(Counter => $counter + 1)
123 unless $args{DryRun};
129 sub IsSubscriptionReady {
133 Subscription => undef,
135 LocalTime => [0, 0, 0],
139 return 1 if $args{All};
141 my $subscription = $args{Subscription};
143 my $counter = $subscription->SubValue('Counter') || 0;
145 my $sub_frequency = $subscription->SubValue('Frequency');
146 my $sub_hour = $subscription->SubValue('Hour');
147 my $sub_dow = $subscription->SubValue('Dow');
148 my $sub_dom = $subscription->SubValue('Dom');
149 my $sub_fow = $subscription->SubValue('Fow') || 1;
151 my ($hour, $dow, $dom) = @{ $args{LocalTime} };
153 $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");
155 return 0 if $sub_frequency eq 'never';
158 return 0 if $sub_hour ne $hour;
160 # all we need is the correct hour for daily dashboards
161 return 1 if $sub_frequency eq 'daily';
163 if ($sub_frequency eq 'weekly') {
164 # correct day of week?
165 return 0 if $sub_dow ne $dow;
167 # does it match the "every N weeks" clause?
168 return 1 if $counter % $sub_fow == 0;
170 $subscription->SetSubValues(Counter => $counter + 1)
171 unless $args{DryRun};
175 # if monthly, correct day of month?
176 if ($sub_frequency eq 'monthly') {
177 return $sub_dom == $dom;
180 # monday through friday
181 if ($sub_frequency eq 'm-f') {
182 return 0 if $dow eq 'Sunday' || $dow eq 'Saturday';
186 $RT::Logger->debug("Invalid subscription frequency $sub_frequency for " . $args{User}->Name);
188 # unknown frequency type, bail out
193 RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
199 CurrentUser => undef,
201 Subscription => undef,
206 my $currentuser = $args{CurrentUser};
207 my $subscription = $args{Subscription};
209 my $rows = $subscription->SubValue('Rows');
211 my $DashboardId = $subscription->SubValue('DashboardId');
213 my $dashboard = RT::Dashboard->new($currentuser);
214 my ($ok, $msg) = $dashboard->LoadById($DashboardId);
216 # failed to load dashboard. perhaps it was deleted or it changed privacy
218 $RT::Logger->warning("Unable to load dashboard $DashboardId of subscription ".$subscription->Id." for user ".$currentuser->Name.": $msg");
219 return $self->ObsoleteSubscription(
221 Subscription => $subscription,
225 $RT::Logger->debug('Generating dashboard "'.$dashboard->Name.'" for user "'.$currentuser->Name.'":');
229 Dashboard: @{[ $dashboard->Name ]}
230 User: @{[ $currentuser->Name ]} <$args{Email}>
235 local $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
236 local $HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
238 my $content = RunComponent(
239 '/Dashboards/Render.html',
240 id => $dashboard->Id,
244 if ( RT->Config->Get('EmailDashboardRemove') ) {
245 for ( RT->Config->Get('EmailDashboardRemove') ) {
250 $content = ScrubContent($content);
252 $RT::Logger->debug("Got ".length($content)." characters of output.");
254 $content = HTML::RewriteAttributes::Links->rewrite(
256 RT->Config->Get('WebURL') . 'Dashboards/Render.html',
259 $self->EmailDashboard(
261 Dashboard => $dashboard,
266 sub ObsoleteSubscription {
271 Subscription => undef,
272 CurrentUser => undef,
276 my $subscription = $args{Subscription};
278 my $ok = RT::Interface::Email::SendEmailUsingTemplate(
281 Template => 'Error: Missing dashboard',
283 SubscriptionObj => $subscription,
286 'X-RT-Dashboard-Subscription-Id' => $subscription->Id,
287 'X-RT-Dashboard-Id' => $subscription->SubValue('DashboardId'),
291 # only delete the subscription if the email looks like it went through
293 my ($deleted, $msg) = $subscription->Delete();
295 $RT::Logger->debug("Deleted an obsolete subscription: $msg");
298 $RT::Logger->warning("Unable to delete an obsolete subscription: $msg");
302 $RT::Logger->warning("Unable to notify ".$args{CurrentUser}->Name." of an obsolete subscription");
309 CurrentUser => undef,
312 Subscription => undef,
317 my $subscription = $args{Subscription};
318 my $dashboard = $args{Dashboard};
319 my $currentuser = $args{CurrentUser};
320 my $email = $args{Email};
322 my $frequency = $subscription->SubValue('Frequency');
324 my %frequency_lookup = (
325 'm-f' => 'Weekday', # loc
326 'daily' => 'Daily', # loc
327 'weekly' => 'Weekly', # loc
328 'monthly' => 'Monthly', # loc
329 'never' => 'Never', # loc
332 my $frequency_display = $frequency_lookup{$frequency}
335 my $subject = sprintf '[%s] ' . RT->Config->Get('DashboardSubject'),
336 RT->Config->Get('rtname'),
337 $currentuser->loc($frequency_display),
340 my $entity = $self->BuildEmail(
346 $entity->head->replace('X-RT-Dashboard-Id', $dashboard->Id);
347 $entity->head->replace('X-RT-Dashboard-Subscription-Id', $subscription->Id);
349 $RT::Logger->debug('Mailing dashboard "'.$dashboard->Name.'" to user '.$currentuser->Name." <$email>");
351 my $ok = RT::Interface::Email::SendEmail(
356 $RT::Logger->error("Failed to email dashboard to user ".$currentuser->Name." <$email>");
360 $RT::Logger->debug("Done sending dashboard to ".$currentuser->Name." <$email>");
376 my $content = HTML::RewriteAttributes::Resources->rewrite($args{Content}, sub {
379 # already attached this object
380 return "cid:$cid_of{$uri}" if $cid_of{$uri};
382 $cid_of{$uri} = time() . $$ . int(rand(1e6));
383 my ($data, $filename, $mimetype, $encoding) = GetResource($uri);
385 # Encode textual data in UTF-8, and downgrade (treat
386 # codepoints as codepoints, and ensure the UTF-8 flag is
387 # off) everything else.
389 if ( $mimetype =~ m{text/} ) {
390 $data = Encode::encode( "UTF-8", $data );
391 @extra = ( Charset => "UTF-8" );
393 utf8::downgrade( $data, 1 ) or $RT::Logger->warning("downgrade $data failed");
396 push @parts, MIME::Entity->build(
400 Encoding => $encoding,
401 Disposition => 'inline',
402 Name => RT::Interface::Email::EncodeToMIME( String => $filename ),
403 'Content-Id' => $cid_of{$uri},
407 return "cid:$cid_of{$uri}";
411 my ($content) = GetResource($uri);
417 my $entity = MIME::Entity->build(
418 From => Encode::encode("UTF-8", $args{From}),
419 To => Encode::encode("UTF-8", $args{To}),
420 Subject => RT::Interface::Email::EncodeToMIME( String => $args{Subject} ),
421 Type => "multipart/mixed",
427 Data => Encode::encode("UTF-8", $content),
428 Disposition => 'inline',
429 Encoding => "base64",
432 for my $part (@parts) {
433 $entity->add_part($part);
436 $entity->make_singlepart;
448 $RT::Logger->debug("Creating Mason object.");
450 # user may not have permissions on the data directory, so create a
452 $data_dir = tempdir(CLEANUP => 1);
454 $mason = HTML::Mason::Interp->new(
455 RT::Interface::Web::Handler->DefaultHandlerArgs,
456 out_method => \$outbuf,
457 autohandler_name => '', # disable forced login and more
458 data_dir => $data_dir,
460 $mason->set_escape( h => \&RT::Interface::Web::EscapeUTF8 );
461 $mason->set_escape( u => \&RT::Interface::Web::EscapeURI );
462 $mason->set_escape( j => \&RT::Interface::Web::EscapeJS );
480 $scrubber = HTML::Scrubber->new;
481 # Allow everything by default, except JS attributes ...
485 map { ("on$_" => 0) }
486 qw(blur change click dblclick error focus keydown keypress keyup load
487 mousedown mousemove mouseout mouseover mouseup reset select submit unload)
491 $scrubber->deny('script');
498 return _scrubber->scrub($content);
509 my $key = "$now $tz";
510 return @{$cache{$key}} if exists $cache{$key};
512 my ($hour, $dow, $dom);
515 local $ENV{'TZ'} = $tz;
516 ## Using POSIX::tzset fixes a bug where the TZ environment variable
519 (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
521 tzset(); # return back previous value
524 if length($hour) == 1;
525 $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
527 return @{$cache{$key}} = ($hour, $dow, $dom);
532 my $uri = URI->new(shift);
533 my ($content, $filename, $mimetype, $encoding);
535 $RT::Logger->debug("Getting resource $uri");
537 # strip out the equivalent of WebURL, so we start at the correct /
538 my $path = $uri->path;
539 my $webpath = RT->Config->Get('WebPath');
540 $path =~ s/^\Q$webpath//;
542 # add a leading / if needed
544 unless $path =~ m{^/};
546 $HTML::Mason::Commands::r->path_info($path);
548 # grab the query arguments
550 for (split /&/, ($uri->query||'')) {
551 my ($k, $v) = /^(.*?)=(.*)$/
552 or die "Unable to parse query parameter '$_'";
554 for ($k, $v) { s/%(..)/chr hex $1/ge }
556 # Decode from bytes to characters
557 $_ = Encode::decode( "UTF-8", $_ ) for $k, $v;
559 # no value yet, simple key=value
560 if (!exists $args{$k}) {
563 # already have key=value, need to upgrade it to key=[value1, value2]
564 elsif (!ref($args{$k})) {
565 $args{$k} = [$args{$k}, $v];
567 # already key=[value1, value2], just add the new value
569 push @{ $args{$k} }, $v;
573 $RT::Logger->debug("Running component '$path'");
574 $content = RunComponent($path, %args);
576 # guess at the filename from the component name
577 $filename = $1 if $path =~ m{^.*/(.*?)$};
579 # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
580 ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
582 my $content_type = $HTML::Mason::Commands::r->content_type;
584 $mimetype = $content_type;
586 # strip down to just a MIME type
587 $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
590 #If all else fails then some conservative and general-purpose defaults are:
591 $mimetype ||= 'application/octet-stream';
592 $encoding ||= 'base64';
594 $RT::Logger->debug("Resource $uri: length=".length($content)." filename='$filename' mimetype='$mimetype', encoding='$encoding'");
596 return ($content, $filename, $mimetype, $encoding);
601 package RT::Dashboard::FakeRequest;
602 sub new { bless {}, shift }
603 sub header_out { return undef }
604 sub headers_out { wantarray ? () : {} }
605 sub err_headers_out { wantarray ? () : {} }
608 $self->{content_type} = shift if @_;
609 return $self->{content_type};
613 $self->{path_info} = shift if @_;
614 return $self->{path_info};
618 RT::Base->_ImportOverlays();