#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2015 Best Practical Solutions, LLC
# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
use RT::Interface::Web::Menu;
use RT::Interface::Web::Session;
use Digest::MD5 ();
-use Encode qw();
use List::MoreUtils qw();
use JSON qw();
$HTML::Mason::Commands::m->comp( '/Elements/SetupSessionCookie', %$ARGS );
SendSessionCookie();
- $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new() unless _UserLoggedIn();
+
+ if ( _UserLoggedIn() ) {
+ # make user info up to date
+ $HTML::Mason::Commands::session{'CurrentUser'}
+ ->Load( $HTML::Mason::Commands::session{'CurrentUser'}->id );
+ undef $HTML::Mason::Commands::session{'CurrentUser'}->{'LangHandle'};
+ }
+ else {
+ $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
+ }
# Process session-related callbacks before any auth attempts
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Session', CallbackPage => '/autohandler' );
# Process per-page authentication callbacks
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Auth', CallbackPage => '/autohandler' );
+ if ( $ARGS->{'NotMobile'} ) {
+ $HTML::Mason::Commands::session{'NotMobile'} = 1;
+ }
+
unless ( _UserLoggedIn() ) {
_ForceLogout();
my $m = $HTML::Mason::Commands::m;
# REST urls get a special 401 response
- if ($m->request_comp->path =~ '^/REST/\d+\.\d+/') {
+ if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) {
$HTML::Mason::Commands::r->content_type("text/plain");
$m->error_format("text");
$m->out("RT/$RT::VERSION 401 Credentials required\n");
$m->out("\n$msg\n") if $msg;
$m->abort;
}
- # Specially handle /index.html so that we get a nicer URL
- elsif ( $m->request_comp->path eq '/index.html' ) {
- my $next = SetNextPage(RT->Config->Get('WebURL'));
- $m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]);
+ # Specially handle /index.html and /m/index.html so that we get a nicer URL
+ elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) {
+ my $mobile = $1 ? 1 : 0;
+ my $next = SetNextPage($ARGS);
+ $m->comp('/NoAuth/Login.html',
+ next => $next,
+ actions => [$msg],
+ mobile => $mobile);
$m->abort;
}
else {
- TangentForLogin(results => ($msg ? LoginError($msg) : undef));
+ TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef));
}
}
}
ShowRequestedPage($ARGS);
LogRecordedSQLStatements(RequestData => {
- Path => $HTML::Mason::Commands::m->request_comp->path,
+ Path => $HTML::Mason::Commands::m->request_path,
});
# Process per-page final cleanup callbacks
return $key;
}
-=head2 SetNextPage [PATH]
+=head2 SetNextPage ARGSRef [PATH]
Intuits and stashes the next page in the sesssion hash. If PATH is
specified, uses that instead of the value of L<IntuitNextPage()>. Returns
=cut
sub SetNextPage {
- my $next = shift || IntuitNextPage();
+ my $ARGS = shift;
+ my $next = $_[0] ? $_[0] : IntuitNextPage();
my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024));
+ my $page = { url => $next };
+
+ # If an explicit URL was passed and we didn't IntuitNextPage, then
+ # IsPossibleCSRF below is almost certainly unrelated to the actual
+ # destination. Currently explicit next pages aren't used in RT, but the
+ # API is available.
+ if (not $_[0] and RT->Config->Get("RestrictReferrer")) {
+ # This isn't really CSRF, but the CSRF heuristics are useful for catching
+ # requests which may have unintended side-effects.
+ my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
+ if ($is_csrf) {
+ RT->Logger->notice(
+ "Marking original destination as having side-effects before redirecting for login.\n"
+ ."Request: $next\n"
+ ."Reason: " . HTML::Mason::Commands::loc($msg, @loc)
+ );
+ $page->{'HasSideEffects'} = [$msg, @loc];
+ }
+ }
- $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $next;
+ $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page;
$HTML::Mason::Commands::session{'i'}++;
return $hash;
}
+=head2 FetchNextPage HASHKEY
+
+Returns the stashed next page hashref for the given hash.
+
+=cut
+
+sub FetchNextPage {
+ my $hash = shift || "";
+ return $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
+
+=head2 RemoveNextPage HASHKEY
+
+Removes the stashed next page for the given hash and returns it.
+
+=cut
+
+sub RemoveNextPage {
+ my $hash = shift || "";
+ return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash};
+}
-=head2 TangentForLogin [HASH]
+=head2 TangentForLogin ARGSRef [HASH]
Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
-the next page. Optionally takes a hash which is dumped into query params.
+the next page. Takes a hashref of request %ARGS as the first parameter.
+Optionally takes all other parameters as a hash which is dumped into query
+params.
=cut
sub TangentForLogin {
- my $hash = SetNextPage();
+ my $ARGS = shift;
+ my $hash = SetNextPage($ARGS);
my %query = (@_, next => $hash);
+
+ $query{mobile} = 1
+ if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)};
+
my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?';
$login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
Redirect($login);
=cut
sub TangentForLoginWithError {
- my $key = LoginError(HTML::Mason::Commands::loc(@_));
- TangentForLogin( results => $key );
+ my $ARGS = shift;
+ my $key = LoginError(HTML::Mason::Commands::loc(@_));
+ TangentForLogin( $ARGS, results => $key );
}
=head2 IntuitNextPage
my $m = $HTML::Mason::Commands::m;
if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) {
$m->call_next();
- } elsif ( $m->request_comp->path !~ '^(/+)Install/' ) {
+ } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) {
RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" );
} else {
$m->call_next();
/ # leading slash
( Elements |
_elements | # mobile UI
+ Callbacks |
Widgets |
autohandler | # requesting this directly is suspicious
l (_unsafe)? ) # loc component
unless ( $HTML::Mason::Commands::session{'CurrentUser'}->Privileged ) {
# if the user is trying to access a ticket, redirect them
- if ( $m->request_comp->path =~ '^(/+)Ticket/Display.html' && $ARGS->{'id'} ) {
+ if ( $m->request_comp->path =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) {
RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} );
}
$user =~ s/^\Q$NodeName\E\\//i;
}
- my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+ my $next = RemoveNextPage($ARGS->{'next'});
+ $next = $next->{'url'} if ref $next;
InstantiateNewSession() unless _UserLoggedIn;
$HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new();
$HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user);
delete $HTML::Mason::Commands::session{'CurrentUser'};
if (RT->Config->Get('WebFallbackToInternalAuth')) {
- TangentForLoginWithError('Cannot create user: [_1]', $msg);
+ TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg);
} else {
$m->abort();
}
delete $HTML::Mason::Commands::session{'CurrentUser'};
$user = $orig_user;
- if ( RT->Config->Get('WebExternalOnly') ) {
- TangentForLoginWithError('You are not an authorized user');
+ unless ( RT->Config->Get('WebFallbackToInternalAuth') ) {
+ TangentForLoginWithError($ARGS, 'You are not an authorized user');
}
}
} elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) {
unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) {
# XXX unreachable due to prior defaulting in HandleRequest (check c34d108)
- TangentForLoginWithError('You are not an authorized user');
+ TangentForLoginWithError($ARGS, 'You are not an authorized user');
}
} else {
# It's important to nab the next page from the session before we blow
# the session away
- my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''};
+ my $next = RemoveNextPage($ARGS->{'next'});
+ $next = $next->{'url'} if ref $next;
InstantiateNewSession();
$HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
my $SessionCookie = ( $cookies{$cookiename} ? $cookies{$cookiename}->value : undef );
tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', $SessionCookie;
unless ( $SessionCookie && $HTML::Mason::Commands::session{'_session_id'} eq $SessionCookie ) {
- undef $cookies{$cookiename};
+ InstantiateNewSession();
}
if ( int RT->Config->Get('AutoLogoff') ) {
my $now = int( time / 60 );
$HTML::Mason::Commands::m->abort;
}
+=head2 CacheControlExpiresHeaders
+
+set both Cache-Control and Expires http headers
+
+=cut
+
+sub CacheControlExpiresHeaders {
+ my %args = @_;
+
+ my $Visibility = 'private';
+ if ( ! defined $args{Time} ) {
+ $args{Time} = 0;
+ } elsif ( $args{Time} eq 'no-cache' ) {
+ $args{Time} = 0;
+ } elsif ( $args{Time} eq 'forever' ) {
+ $args{Time} = 30 * 24 * 60 * 60;
+ $Visibility = 'public';
+ }
+
+ my $CacheControl = $args{Time}
+ ? sprintf "max-age=%d, %s", $args{Time}, $Visibility
+ : 'no-cache'
+ ;
+ $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = $CacheControl;
+
+ my $expires = RT::Date->new(RT->SystemUser);
+ $expires->SetToNow;
+ $expires->AddSeconds( $args{Time} ) if $args{Time};
+
+ $HTML::Mason::Commands::r->headers_out->{'Expires'} = $expires->RFC2616;
+}
+
=head2 StaticFileHeaders
Send the browser a few headers to try to get it to (somewhat agressively)
sub StaticFileHeaders {
my $date = RT::Date->new(RT->SystemUser);
- # make cache public
- $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public';
-
# remove any cookie headers -- if it is cached publicly, it
# shouldn't include anyone's cookie!
delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'};
# Expire things in a month.
- $date->Set( Value => time + 30 * 24 * 60 * 60 );
- $HTML::Mason::Commands::r->headers_out->{'Expires'} = $date->RFC2616;
+ CacheControlExpiresHeaders( Time => 'forever' );
# if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since'
# request, but we don't handle it and generate full reply again
Takes C<PATH> and returns a boolean indicating that the user-specified partial
component path is safe.
-Currently "safe" means that the path does not start with a dot (C<.>) and does
-not contain a slash-dot C</.>.
+Currently "safe" means that the path does not start with a dot (C<.>), does
+not contain a slash-dot C</.>, and does not contain any nulls.
=cut
sub ComponentPathIsSafe {
my $self = shift;
my $path = shift;
- return $path !~ m{(?:^|/)\.};
+ return($path !~ m{(?:^|/)\.} and $path !~ m{\0});
}
=head2 PathIsSafe
my $self = shift;
-if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60)/io && !$HTML::Mason::Commands::session{'NotMobile'}) {
+if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60|Mobile)/io && !$HTML::Mason::Commands::session{'NotMobile'}) {
return 1;
} else {
return undef;
sub DecodeARGS {
my $ARGS = shift;
+ # Later in the code we use
+ # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
+ # instead of $m->call_next to avoid problems with UTF8 keys in
+ # arguments. Specifically, the call_next method pass through
+ # original arguments, which are still the encoded bytes, not
+ # characters. "{ base_comp => $m->request_comp }" is copied from
+ # mason's source to get the same results as we get from call_next
+ # method; this feature is not documented.
%{$ARGS} = map {
# if they've passed multiple values, they'll be an array. if they've
# passed just one, a scalar whatever they are, mark them as utf8
my $type = ref($_);
( !$type )
- ? Encode::is_utf8($_)
- ? $_
- : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ )
+ ? Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ )
: ( $type eq 'ARRAY' )
- ? [ map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
- @$_ ]
+ ? [ map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } @$_ ]
: ( $type eq 'HASH' )
- ? { map { ( ref($_) or Encode::is_utf8($_) ) ? $_ : Encode::decode( 'UTF-8' => $_, Encode::FB_PERLQQ ) }
- %$_ }
+ ? { map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } %$_ }
: $_
} %$ARGS;
}
sub PreprocessTimeUpdates {
my $ARGS = shift;
- # Later in the code we use
- # $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %ARGS );
- # instead of $m->call_next to avoid problems with UTF8 keys in arguments.
- # The call_next method pass through original arguments and if you have
- # an argument with unicode key then in a next component you'll get two
- # records in the args hash: one with key without UTF8 flag and another
- # with the flag, which may result into errors. "{ base_comp => $m->request_comp }"
- # is copied from mason's source to get the same results as we get from
- # call_next method, this feature is not documented, so we just leave it
- # here to avoid possible side effects.
-
# This code canonicalizes time inputs in hours into minutes
foreach my $field ( keys %$ARGS ) {
next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1};
return if $_has_validated_web_config;
$_has_validated_web_config = 1;
- if (!$ENV{'rt.explicit_port'} && $ENV{SERVER_PORT} != RT->Config->Get('WebPort')) {
- $RT::Logger->warn("The actual SERVER_PORT ($ENV{SERVER_PORT}) does NOT match the configured WebPort ($RT::WebPort). Perhaps you should Set(\$WebPort, $ENV{SERVER_PORT}); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
- }
-
- if ($ENV{HTTP_HOST}) {
- # match "example.com" or "example.com:80"
- my ($host) = $ENV{HTTP_HOST} =~ /^(.*?)(:\d+)?$/;
+ my $port = $ENV{SERVER_PORT};
+ my $host = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER}
+ || $ENV{HTTP_HOST} || $ENV{SERVER_NAME};
+ ($host, $port) = ($1, $2) if $host =~ /^(.*?):(\d+)$/;
- if ($host ne RT->Config->Get('WebDomain')) {
- $RT::Logger->warn("The actual HTTP_HOST ($host) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
- }
+ if ( $port != RT->Config->Get('WebPort') and not $ENV{'rt.explicit_port'}) {
+ $RT::Logger->warn("The requested port ($port) does NOT match the configured WebPort ($RT::WebPort). "
+ ."Perhaps you should Set(\$WebPort, $port); in RT_SiteConfig.pm, "
+ ."otherwise your internal links may be broken.");
}
- else {
- if ($ENV{SERVER_NAME} ne RT->Config->Get('WebDomain')) {
- $RT::Logger->warn("The actual SERVER_NAME ($ENV{SERVER_NAME}) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$ENV{SERVER_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
- }
+
+ if ( $host ne RT->Config->Get('WebDomain') ) {
+ $RT::Logger->warn("The requested host ($host) does NOT match the configured WebDomain ($RT::WebDomain). "
+ ."Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, "
+ ."otherwise your internal links may be broken.");
}
- #i don't understand how this was ever expected to work
- # (even without our dum double // hack)??
- #if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath')) {
- ( my $WebPath = RT->Config->Get('WebPath') ) =~ s(/+)(/)g;
- ( my $script_name = $ENV{SCRIPT_NAME} ) =~ s(/+)(/)g;
- my $script_name_prefix = substr($script_name, 0, length($WebPath));
- if ( $script_name_prefix ne $WebPath ) {
- $RT::Logger->warn("The actual SCRIPT_NAME ($script_name) does NOT match the configured WebPath ($WebPath). Perhaps you should Set(\$WebPath, '$script_name_prefix'); in RT_SiteConfig.pm, otherwise your internal links may be broken.");
+ return; #next warning flooding our logs, doesn't seem applicable to our use
+ # (SCRIPT_NAME is the full path, WebPath is just the beginning)
+ #in vanilla RT does something eat the local part of SCRIPT_NAME 1st?
+
+ # Unfortunately, there is no reliable way to get the _path_ that was
+ # requested at the proxy level; simply disable this warning if we're
+ # proxied and there's a mismatch.
+ my $proxied = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER};
+ if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath') and not $proxied) {
+ $RT::Logger->warn("The requested path ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). "
+ ."Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, "
+ ."otherwise your internal links may be broken.");
}
}
# information for the search. Because it's a straight-up read, in
# addition to embedding its own auth, it's fine.
'/NoAuth/rss/dhandler' => 1,
+
+ # While these can be used for denial-of-service against RT
+ # (construct a very inefficient query and trick lots of users into
+ # running them against RT) it's incredibly useful to be able to link
+ # to a search result (or chart) or bookmark a result page.
+ '/Search/Results.html' => 1,
+ '/Search/Simple.html' => 1,
+ '/m/tickets/search' => 1,
+ '/Search/Chart.html' => 1,
+
+ # This page takes Attachment and Transaction argument to figure
+ # out what to show, but it's read only and will deny information if you
+ # don't have ShowOutgoingEmail.
+ '/Ticket/ShowEmailRecord.html' => 1,
+);
+
+# Components which are blacklisted from automatic, argument-based whitelisting.
+# These pages are not idempotent when called with just an id.
+our %is_blacklisted_component = (
+ # Takes only id and toggles bookmark state
+ '/Helpers/Toggle/TicketBookmark' => 1,
);
sub IsCompCSRFWhitelisted {
delete $args{pass};
}
+ # Some pages aren't idempotent even with safe args like id; blacklist
+ # them from the automatic whitelisting below.
+ return 0 if $is_blacklisted_component{$comp};
+
# Eliminate arguments that do not indicate an effectful request.
# For example, "id" is acceptable because that is how RT retrieves a
# record.
delete $args{id};
- # If they have a valid results= from MaybeRedirectForResults, that's
- # also fine.
- delete $args{results} if $args{results}
- and $HTML::Mason::Commands::session{"Actions"}->{$args{results}};
+ # If they have a results= from MaybeRedirectForResults, that's also fine.
+ delete $args{results};
# The homepage refresh, which uses the Refresh header, doesn't send
# a referer in most browsers; whitelist the one parameter it reloads
# with, HomeRefreshInterval, which is safe
delete $args{HomeRefreshInterval};
+ # The NotMobile flag is fine for any page; it's only used to toggle a flag
+ # in the session related to which interface you get.
+ delete $args{NotMobile};
+
# If there are no arguments, then it's likely to be an idempotent
# request, which are not susceptible to CSRF
return 1 if !%args;
my $configs;
for my $config ( $base_url, RT->Config->Get('ReferrerWhitelist') ) {
push @$configs,$config;
- return 1 if $referer->host_port eq $config;
+
+ my $host_port = $referer->host_port;
+ if ($config =~ /\*/) {
+ # Turn a literal * into a domain component or partial component match.
+ # Refer to http://tools.ietf.org/html/rfc2818#page-5
+ my $regex = join "[a-zA-Z0-9\-]*",
+ map { quotemeta($_) }
+ split /\*/, $config;
+
+ return 1 if $host_port =~ /^$regex$/i;
+ } else {
+ return 1 if $host_port eq $config;
+ }
}
return (0,$referer,$configs);
if ($ARGS->{Attach}) {
my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' );
my $file_path = delete $ARGS->{'Attach'};
+
+ # This needs to be decoded because the value is a reference;
+ # hence it was not decoded along with all of the standard
+ # arguments in DecodeARGS
$data->{attach} = {
- filename => Encode::decode_utf8("$file_path"),
+ filename => Encode::decode("UTF-8", "$file_path"),
mime => $attachment,
};
}
# Calls abort, never gets here
}
+our @POTENTIAL_PAGE_ACTIONS = (
+ qr'/Ticket/Create.html' => "create a ticket", # loc
+ qr'/Ticket/' => "update a ticket", # loc
+ qr'/Admin/' => "modify RT's configuration", # loc
+ qr'/Approval/' => "update an approval", # loc
+ qr'/Articles/' => "update an article", # loc
+ qr'/Dashboards/' => "modify a dashboard", # loc
+ qr'/m/ticket/' => "update a ticket", # loc
+ qr'Prefs' => "modify your preferences", # loc
+ qr'/Search/' => "modify or access a search", # loc
+ qr'/SelfService/Create' => "create a ticket", # loc
+ qr'/SelfService/' => "update a ticket", # loc
+);
+
+sub PotentialPageAction {
+ my $page = shift;
+ my @potentials = @POTENTIAL_PAGE_ACTIONS;
+ while (my ($pattern, $result) = splice @potentials, 0, 2) {
+ return HTML::Mason::Commands::loc($result)
+ if $page =~ $pattern;
+ }
+ return "";
+}
+
package HTML::Mason::Commands;
use vars qw/$r $m %session/;
Cc => $ARGS{'Cc'},
Body => $sigless,
Type => $ARGS{'ContentType'},
+ Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
);
if ( $ARGS{'Attachments'} ) {
$RT::Logger->error("Couldn't make multipart message")
if !$rv || $rv !~ /^(?:DONE|ALREADY)$/;
- foreach ( values %{ $ARGS{'Attachments'} } ) {
+ foreach ( map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} } ) {
unless ($_) {
$RT::Logger->error("Couldn't add empty attachemnt");
next;
}
}
- foreach my $argument (qw(Encrypt Sign)) {
- $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 )
- if defined $ARGS{$argument};
+ for my $argument (qw(Encrypt Sign)) {
+ $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
}
my %create_args = (
=cut
+# change from stock: if txn custom fields are set but there's no content
+# or attachment, create a Touch txn instead of doing nothing
+
sub ProcessUpdateMessage {
my %args = (
CurrentUser => $args{'TicketObj'}->CurrentUser,
);
- # If, after stripping the signature, we have no message, move the
- # UpdateTimeWorked into adjusted TimeWorked, so that a later
- # ProcessBasics can deal -- then bail out.
+ my %txn_customfields;
+
+ foreach my $key ( keys %{ $args{ARGSRef} } ) {
+ if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
+ next if $key =~ /(TimeUnits|Magic)$/;
+ $txn_customfields{$key} = $args{ARGSRef}->{$key};
+ }
+ }
+
+ # If, after stripping the signature, we have no message, create a
+ # Touch transaction if necessary
if ( not $args{ARGSRef}->{'UpdateAttachments'}
and not length $args{ARGSRef}->{'UpdateContent'} )
{
- if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
- $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + delete $args{ARGSRef}->{'UpdateTimeWorked'};
+ #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) {
+ # $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked +
+ # delete $args{ARGSRef}->{'UpdateTimeWorked'};
+ # }
+
+ my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'};
+ if ( $timetaken or grep {length $_} values %txn_customfields ) {
+ my ( $Transaction, $Description, $Object ) =
+ $args{TicketObj}->Touch(
+ CustomFields => \%txn_customfields,
+ TimeTaken => $timetaken
+ );
+ return $Description;
}
return;
}
Subject => $args{ARGSRef}->{'UpdateSubject'},
Body => $args{ARGSRef}->{'UpdateContent'},
Type => $args{ARGSRef}->{'UpdateContentType'},
+ Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
);
- $Message->head->replace( 'Message-ID' => Encode::encode_utf8(
+ $Message->head->replace( 'Message-ID' => Encode::encode( "UTF-8",
RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
) );
my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
if ( $args{ARGSRef}->{'UpdateAttachments'} ) {
$Message->make_multipart;
- $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} };
+ $Message->add_part($_) foreach map $args{ARGSRef}->{UpdateAttachments}{$_},
+ sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} };
}
if ( $args{ARGSRef}->{'AttachTickets'} ) {
: ( $args{ARGSRef}->{'AttachTickets'} ) );
}
- my %txn_customfields;
-
- foreach my $key ( keys %{ $args{ARGSRef} } ) {
- if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) {
- $txn_customfields{$key} = $args{ARGSRef}->{$key};
- }
- }
-
my %message_args = (
Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ),
Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ),
if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} );
push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
-
}
push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo};
}
}
+sub ProcessAttachments {
+ my %args = (
+ ARGSRef => {},
+ @_
+ );
+
+ my $ARGSRef = $args{ARGSRef} || {};
+ # deal with deleting uploaded attachments
+ foreach my $key ( keys %$ARGSRef ) {
+ if ( $key =~ m/^DeleteAttach-(.+)$/ ) {
+ delete $session{'Attachments'}{$1};
+ }
+ $session{'Attachments'} = { %{ $session{'Attachments'} || {} } };
+ }
+
+ # store the uploaded attachment in session
+ if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} )
+ { # attachment?
+ my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' );
+
+ # This needs to be decoded because the value is a reference;
+ # hence it was not decoded along with all of the standard
+ # arguments in DecodeARGS
+ my $file_path = Encode::decode("UTF-8", "$ARGSRef->{'Attach'}");
+ $session{'Attachments'} =
+ { %{ $session{'Attachments'} || {} }, $file_path => $attachment, };
+ }
+
+ # delete temporary storage entry to make WebUI clean
+ unless ( keys %{ $session{'Attachments'} } and $ARGSRef->{'UpdateAttach'} )
+ {
+ delete $session{'Attachments'};
+ }
+}
+
+
=head2 MakeMIMEEntity PARAMHASH
Takes a paramhash Subject, Body and AttachmentFieldName.
Body => undef,
AttachmentFieldName => undef,
Type => undef,
+ Interface => 'API',
@_,
);
my $Message = MIME::Entity->build(
Type => 'multipart/mixed',
- "Message-Id" => RT::Interface::Email::GenMessageId,
- map { $_ => Encode::encode_utf8( $args{ $_} ) }
+ "Message-Id" => Encode::encode( "UTF-8", RT::Interface::Email::GenMessageId ),
+ "X-RT-Interface" => $args{Interface},
+ map { $_ => Encode::encode( "UTF-8", $args{ $_} ) }
grep defined $args{$_}, qw(Subject From Cc)
);
$Message->attach(
Type => $args{'Type'} || 'text/plain',
Charset => 'UTF-8',
- Data => $args{'Body'},
+ Data => Encode::encode( "UTF-8", $args{'Body'} ),
);
}
my $uploadinfo = $cgi_object->uploadInfo($filehandle);
- my $filename = "$filehandle";
+ my $filename = Encode::decode("UTF-8","$filehandle");
$filename =~ s{^.*[\\/]}{};
$Message->attach(
Type => $uploadinfo->{'Content-Type'},
- Filename => $filename,
- Data => \@content,
+ Filename => Encode::encode("UTF-8",$filename),
+ Data => \@content, # Bytes, as read directly from the file, above
);
if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
- $Message->head->set( 'Subject' => $filename );
+ $Message->head->set( 'Subject' => Encode::encode( "UTF-8", $filename ) );
}
- # Attachment parts really shouldn't get a Message-ID
+ # Attachment parts really shouldn't get a Message-ID or "interface"
$Message->head->delete('Message-ID');
+ $Message->head->delete('X-RT-Interface');
}
}
# Check if we want to grant rights to a previously rights-less user
for my $type (qw(user group)) {
- my $key = "AddPrincipalForRights-$type";
-
- next unless $ARGSref->{$key};
-
- my $principal;
- if ( $type eq 'user' ) {
- $principal = RT::User->new( $session{'CurrentUser'} );
- $principal->LoadByCol( Name => $ARGSref->{$key} );
- }
- else {
- $principal = RT::Group->new( $session{'CurrentUser'} );
- $principal->LoadUserDefinedGroup( $ARGSref->{$key} );
- }
+ my $principal = _ParseACLNewPrincipal($ARGSref, $type)
+ or next;
unless ($principal->PrincipalId) {
push @results, loc("Couldn't load the specified principal");
return (@results);
}
+=head2 _ParseACLNewPrincipal
+
+Takes a hashref of C<%ARGS> and a principal type (C<user> or C<group>). Looks
+for the presence of rights being added on a principal of the specified type,
+and returns undef if no new principal is being granted rights. Otherwise loads
+up an L<RT::User> or L<RT::Group> object and returns it. Note that the object
+may not be successfully loaded, and you should check C<->id> yourself.
+
+=cut
+sub _ParseACLNewPrincipal {
+ my $ARGSref = shift;
+ my $type = lc shift;
+ my $key = "AddPrincipalForRights-$type";
+
+ return unless $ARGSref->{$key};
+
+ my $principal;
+ if ( $type eq 'user' ) {
+ $principal = RT::User->new( $session{'CurrentUser'} );
+ $principal->LoadByCol( Name => $ARGSref->{$key} );
+ }
+ elsif ( $type eq 'group' ) {
+ $principal = RT::Group->new( $session{'CurrentUser'} );
+ $principal->LoadUserDefinedGroup( $ARGSref->{$key} );
+ }
+ return $principal;
+}
=head2 UpdateRecordObj ( ARGSRef => \%ARGS, Object => RT::Record, AttributesRef => \@attribs)
while ( my $reminder = $reminder_collection->Next ) {
my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve;
if ( $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) {
- $Ticket->Reminders->Resolve($reminder);
+ my ($status, $msg) = $Ticket->Reminders->Resolve($reminder);
+ push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
+
}
elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) {
- $Ticket->Reminders->Open($reminder);
+ my ($status, $msg) = $Ticket->Reminders->Open($reminder);
+ push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
}
if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) {
- $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+ my ($status, $msg) = $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+ push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
}
if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) {
- $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+ my ($status, $msg) = $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+ push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
}
if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) {
Value => $args->{ 'Reminder-Due-' . $reminder->id }
);
if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) {
- $reminder->SetDue( $DateObj->ISO );
+ my ($status, $msg) = $reminder->SetDue( $DateObj->ISO );
+ push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg);
}
}
}
Format => 'unknown',
Value => $args->{'NewReminder-Due'}
);
- my ( $add_id, $msg, $txnid ) = $Ticket->Reminders->Add(
+ my ( $add_id, $msg ) = $Ticket->Reminders->Add(
Subject => $args->{'NewReminder-Subject'},
Owner => $args->{'NewReminder-Owner'},
Due => $due_obj->ISO
);
- push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+ if ( $add_id ) {
+ push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+ }
+ else {
+ push @results, $msg;
+ }
}
return @results;
}
Starts
Started
Due
+ WillResolve
);
#Run through each field in this list. update the value if apropriate
return (@results);
}
+=head2 ProcessTransactionSquelching
+
+Takes a hashref of the submitted form arguments, C<%ARGS>.
+
+Returns a hash of squelched addresses.
+
+=cut
+
+sub ProcessTransactionSquelching {
+ my $args = shift;
+ my %checked = map { $_ => 1 } grep { defined }
+ ( ref $args->{'TxnSendMailTo'} eq "ARRAY" ? @{$args->{'TxnSendMailTo'}} :
+ defined $args->{'TxnSendMailTo'} ? ($args->{'TxnSendMailTo'}) :
+ () );
+ my %squelched = map { $_ => 1 } grep { not $checked{$_} } split /,/, ($args->{'TxnRecipients'}||'');
+ return %squelched;
+}
+
=head2 _UploadedFile ( $arg );
Takes a CGI parameter name; if a file is uploaded under that name,
}
# complex things
- elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.{(.+)}$/ ) {
+ elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.(.+)$/ ) {
+ $subkey =~ s/^\{(.*)\}$/$1/;
return undef unless $args{'Map'}->{$mainkey};
return $args{'Map'}{$mainkey}{ $args{'Attribute'} }
unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE';
);
our %SCRUBBER_ALLOWED_ATTRIBUTES = (
- # Match http, ftp and relative urls
+ # Match http, https, ftp, mailto and relative urls
# XXX: we also scrub format strings with this module then allow simple config options
- href => qr{^(?:http:|ftp:|https:|/|__Web(?:Path|BaseURL|URL)__)}i,
+ href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i,
face => 1,
size => 1,
target => 1,
projects / freeside.git / blobdiff