#
# COPYRIGHT:
#
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-# <jesse@bestpractical.com>
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
use RT::SavedSearches;
use URI qw();
+use RT::Interface::Web::Menu;
use RT::Interface::Web::Session;
use Digest::MD5 ();
use Encode qw();
+use List::MoreUtils qw();
+use JSON qw();
-# {{{ EscapeUTF8
+=head2 SquishedCSS $style
+
+=cut
+
+my %SQUISHED_CSS;
+sub SquishedCSS {
+ my $style = shift or die "need name";
+ return $SQUISHED_CSS{$style} if $SQUISHED_CSS{$style};
+ require RT::Squish::CSS;
+ my $css = RT::Squish::CSS->new( Style => $style );
+ $SQUISHED_CSS{ $css->Style } = $css;
+ return $css;
+}
+
+=head2 SquishedJS
+
+=cut
+
+my $SQUISHED_JS;
+sub SquishedJS {
+ return $SQUISHED_JS if $SQUISHED_JS;
+
+ require RT::Squish::JS;
+ my $js = RT::Squish::JS->new();
+ $SQUISHED_JS = $js;
+ return $js;
+}
+
+=head2 ClearSquished
+
+Removes the cached CSS and JS entries, forcing them to be regenerated
+on next use.
+
+=cut
+
+sub ClearSquished {
+ undef $SQUISHED_JS;
+ %SQUISHED_CSS = ();
+}
=head2 EscapeUTF8 SCALARREF
$$ref =~ s/'/'/g;
}
-# }}}
-# {{{ EscapeURI
=head2 EscapeURI SCALARREF
$$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
}
-# }}}
+=head2 EncodeJSON SCALAR
+
+Encodes the SCALAR to JSON and returns a JSON string. SCALAR may be a simple
+value or a reference.
-# {{{ WebCanonicalizeInfo
+=cut
+
+sub EncodeJSON {
+ JSON::to_json(shift, { utf8 => 1, allow_nonref => 1 });
+}
+
+sub _encode_surrogates {
+ my $uni = $_[0] - 0x10000;
+ return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
+}
+
+sub EscapeJS {
+ my $ref = shift;
+ return unless defined $$ref;
+
+ $$ref = "'" . join('',
+ map {
+ chr($_) =~ /[a-zA-Z0-9]/ ? chr($_) :
+ $_ <= 255 ? sprintf("\\x%02X", $_) :
+ $_ <= 65535 ? sprintf("\\u%04X", $_) :
+ sprintf("\\u%X\\u%X", _encode_surrogates($_))
+ } unpack('U*', $$ref))
+ . "'";
+}
=head2 WebCanonicalizeInfo();
return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'};
}
-# }}}
-# {{{ WebExternalAutoInfo
=head2 WebExternalAutoInfo($user);
return {%user_info};
}
-# }}}
sub HandleRequest {
my $ARGS = shift;
+ if (RT->Config->Get('DevelMode')) {
+ require Module::Refresh;
+ Module::Refresh->refresh;
+ }
+
$HTML::Mason::Commands::r->content_type("text/html; charset=utf-8");
$HTML::Mason::Commands::m->{'rt_base_time'} = [ Time::HiRes::gettimeofday() ];
# Roll back any dangling transactions from a previous failed connection
- $RT::Handle->ForceRollback() if $RT::Handle->TransactionDepth;
+ $RT::Handle->ForceRollback() if $RT::Handle and $RT::Handle->TransactionDepth;
MaybeEnableSQLStatementLog();
$HTML::Mason::Commands::m->autoflush( $HTML::Mason::Commands::m->request_comp->attr('AutoFlush') )
if ( $HTML::Mason::Commands::m->request_comp->attr_exists('AutoFlush') );
+ ValidateWebConfig();
+
DecodeARGS($ARGS);
+ local $HTML::Mason::Commands::DECODED_ARGS = $ARGS;
PreprocessTimeUpdates($ARGS);
+ InitializeMenu();
MaybeShowInstallModePage();
$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' );
+
+ MaybeRejectPrivateComponentRequest();
MaybeShowNoAuthPage($ARGS);
# 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();
- # If the user is logging in, let's authenticate
- if ( defined $ARGS->{user} && defined $ARGS->{pass} ) {
- AttemptPasswordAuthentication($ARGS);
- } else {
- # if no credentials then show him login page
- $HTML::Mason::Commands::m->comp( '/Elements/Login', %$ARGS );
- $HTML::Mason::Commands::m->abort;
+ # Authenticate if the user is trying to login via user/pass query args
+ my ($authed, $msg) = AttemptPasswordAuthentication($ARGS);
+
+ unless ($authed) {
+ my $m = $HTML::Mason::Commands::m;
+
+ # REST urls get a special 401 response
+ 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 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($ARGS, results => ($msg ? LoginError($msg) : undef));
+ }
}
}
+ MaybeShowInterstitialCSRFPage($ARGS);
+
# now it applies not only to home page, but any dashboard that can be used as a workspace
$HTML::Mason::Commands::session{'home_refresh_interval'} = $ARGS->{'HomeRefreshInterval'}
if ( $ARGS->{'HomeRefreshInterval'} );
$HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );
ShowRequestedPage($ARGS);
- LogRecordedSQLStatements();
+ LogRecordedSQLStatements(RequestData => {
+ Path => $HTML::Mason::Commands::m->request_path,
+ });
+
+ # Process per-page final cleanup callbacks
+ $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Final', CallbackPage => '/autohandler' );
+
+ $HTML::Mason::Commands::m->comp( '/Elements/Footer', %$ARGS )
+ unless $HTML::Mason::Commands::r->content_type
+ =~ qr<^(text|application)/(x-)?(css|javascript)>;
}
sub _ForceLogout {
}
+=head2 LoginError ERROR
+
+Pushes a login error into the Actions session store and returns the hash key.
+
+=cut
+
+sub LoginError {
+ my $new = shift;
+ my $key = Digest::MD5::md5_hex( rand(1024) );
+ push @{ $HTML::Mason::Commands::session{"Actions"}->{$key} ||= [] }, $new;
+ $HTML::Mason::Commands::session{'i'}++;
+ return $key;
+}
+
+=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
+the hash value.
+
+=cut
+
+sub SetNextPage {
+ 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} = $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 ARGSRef [HASH]
+
+Redirects to C</NoAuth/Login.html>, setting the value of L<IntuitNextPage> as
+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 $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);
+}
+
+=head2 TangentForLoginWithError ERROR
+
+Localizes the passed error message, stashes it with L<LoginError> and then
+calls L<TangentForLogin> with the appropriate results key.
+
+=cut
+
+sub TangentForLoginWithError {
+ my $ARGS = shift;
+ my $key = LoginError(HTML::Mason::Commands::loc(@_));
+ TangentForLogin( $ARGS, results => $key );
+}
+
+=head2 IntuitNextPage
+
+Attempt to figure out the path to which we should return the user after a
+tangent. The current request URL is used, or failing that, the C<WebURL>
+configuration variable.
+
+=cut
+
+sub IntuitNextPage {
+ my $req_uri;
+
+ # This includes any query parameters. Redirect will take care of making
+ # it an absolute URL.
+ if ($ENV{'REQUEST_URI'}) {
+ $req_uri = $ENV{'REQUEST_URI'};
+
+ # collapse multiple leading slashes so the first part doesn't look like
+ # a hostname of a schema-less URI
+ $req_uri =~ s{^/+}{/};
+ }
+
+ my $next = defined $req_uri ? $req_uri : RT->Config->Get('WebURL');
+
+ # sanitize $next
+ my $uri = URI->new($next);
+
+ # You get undef scheme with a relative uri like "/Search/Build.html"
+ unless (!defined($uri->scheme) || $uri->scheme eq 'http' || $uri->scheme eq 'https') {
+ $next = RT->Config->Get('WebURL');
+ }
+
+ # Make sure we're logging in to the same domain
+ # You can get an undef authority with a relative uri like "index.html"
+ my $uri_base_url = URI->new(RT->Config->Get('WebBaseURL'));
+ unless (!defined($uri->authority) || $uri->authority eq $uri_base_url->authority) {
+ $next = RT->Config->Get('WebURL');
+ }
+
+ return $next;
+}
+
=head2 MaybeShowInstallModePage
This function, called exclusively by RT's autohandler, dispatches
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();
return unless $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex');
+ # Don't show the login page to logged in users
+ Redirect(RT->Config->Get('WebURL'))
+ if $m->base_comp->path eq '/NoAuth/Login.html' and _UserLoggedIn();
+
# If it's a noauth file, don't ask for auth.
- SendSessionCookie();
$m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
$m->abort;
}
+=head2 MaybeRejectPrivateComponentRequest
+
+This function will reject calls to private components, like those under
+C</Elements>. If the requested path is a private component then we will
+abort with a C<403> error.
+
+=cut
+
+sub MaybeRejectPrivateComponentRequest {
+ my $m = $HTML::Mason::Commands::m;
+ my $path = $m->request_comp->path;
+
+ # We do not check for dhandler here, because requesting our dhandlers
+ # directly is okay. Mason will invoke the dhandler with a dhandler_arg of
+ # 'dhandler'.
+
+ if ($path =~ m{
+ / # leading slash
+ ( Elements |
+ _elements | # mobile UI
+ Callbacks |
+ Widgets |
+ autohandler | # requesting this directly is suspicious
+ l (_unsafe)? ) # loc component
+ ( $ | / ) # trailing slash or end of path
+ }xi
+ && $path !~ m{ /RTx/Statistics/\w+/Elements/Chart }xi
+ )
+ {
+ warn "rejecting private component $path\n";
+ $m->abort(403);
+ }
+
+ return;
+}
+
+sub InitializeMenu {
+ $HTML::Mason::Commands::m->notes('menu', RT::Interface::Web::Menu->new());
+ $HTML::Mason::Commands::m->notes('page-menu', RT::Interface::Web::Menu->new());
+ $HTML::Mason::Commands::m->notes('page-widgets', RT::Interface::Web::Menu->new());
+
+}
+
+
=head2 ShowRequestedPage \%ARGS
This function, called exclusively by RT's autohandler, dispatches
my $m = $HTML::Mason::Commands::m;
+ # Ensure that the cookie that we send is up-to-date, in case the
+ # session-id has been modified in any way
SendSessionCookie();
+ # precache all system level rights for the current user
+ $HTML::Mason::Commands::session{CurrentUser}->PrincipalObj->HasRights( Object => RT->System );
+
# If the user isn't privileged, they can only see SelfService
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 = 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);
if ( RT->Config->Get('WebExternalAuto') and not _UserLoggedIn() ) {
# Create users on-the-fly
- my $UserObj = RT::User->new($RT::SystemUser);
+ my $UserObj = RT::User->new(RT->SystemUser);
my ( $val, $msg ) = $UserObj->Create(
%{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
Name => $user,
# we failed to successfully create the user. abort abort abort.
delete $HTML::Mason::Commands::session{'CurrentUser'};
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc( 'Cannot create user: [_1]', $msg ) )
- if RT->Config->Get('WebFallbackToInternalAuth');;
- $m->abort();
+
+ if (RT->Config->Get('WebFallbackToInternalAuth')) {
+ TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg);
+ } else {
+ $m->abort();
+ }
}
}
if ( _UserLoggedIn() ) {
$m->callback( %$ARGS, CallbackName => 'ExternalAuthSuccessfulLogin', CallbackPage => '/autohandler' );
+ # It is possible that we did a redirect to the login page,
+ # if the external auth allows lack of auth through with no
+ # REMOTE_USER set, instead of forcing a "permission
+ # denied" message. Honor the $next.
+ Redirect($next) if $next;
+ # Unlike AttemptPasswordAuthentication below, we do not
+ # force a redirect to / if $next is not set -- otherwise,
+ # straight-up external auth would always redirect to /
+ # when you first hit it.
} else {
delete $HTML::Mason::Commands::session{'CurrentUser'};
$user = $orig_user;
- if ( RT->Config->Get('WebExternalOnly') ) {
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc('You are not an authorized user') );
- $m->abort();
+ 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)
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc('You are not an authorized user') );
- $m->abort();
+ TangentForLoginWithError($ARGS, 'You are not an authorized user');
}
} else {
}
sub AttemptPasswordAuthentication {
- my $ARGS = shift;
+ my $ARGS = shift;
+ return unless defined $ARGS->{user} && defined $ARGS->{pass};
+
my $user_obj = RT::CurrentUser->new();
$user_obj->Load( $ARGS->{user} );
unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) {
$RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
- $m->comp( '/Elements/Login', %$ARGS, Error => HTML::Mason::Commands::loc('Your username or password is incorrect'), );
$m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' );
- $m->abort;
+ return (0, HTML::Mason::Commands::loc('Your username or password is incorrect'));
}
+ else {
+ $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
+
+ # It's important to nab the next page from the session before we blow
+ # the session away
+ my $next = RemoveNextPage($ARGS->{'next'});
+ $next = $next->{'url'} if ref $next;
+
+ InstantiateNewSession();
+ $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
+
+ $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' );
+
+ # Really the only time we don't want to redirect here is if we were
+ # passed user and pass as query params in the URL.
+ if ($next) {
+ Redirect($next);
+ }
+ elsif ($ARGS->{'next'}) {
+ # Invalid hash, but still wants to go somewhere, take them to /
+ Redirect(RT->Config->Get('WebURL'));
+ }
- $RT::Logger->info("Successful login for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
- InstantiateNewSession();
- $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj;
- $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' );
+ return (1, HTML::Mason::Commands::loc('Logged in'));
+ }
}
=head2 LoadSessionFromCookie
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 );
sub InstantiateNewSession {
tied(%HTML::Mason::Commands::session)->delete if tied(%HTML::Mason::Commands::session);
tie %HTML::Mason::Commands::session, 'RT::Interface::Web::Session', undef;
+ SendSessionCookie();
}
sub SendSessionCookie {
my $cookie = CGI::Cookie->new(
- -name => _SessionCookieName(),
- -value => $HTML::Mason::Commands::session{_session_id},
- -path => RT->Config->Get('WebPath'),
- -secure => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 )
+ -name => _SessionCookieName(),
+ -value => $HTML::Mason::Commands::session{_session_id},
+ -path => RT->Config->Get('WebPath'),
+ -secure => ( RT->Config->Get('WebSecureCookies') ? 1 : 0 ),
+ -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ),
);
$HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string;
my $redir_to = shift;
untie $HTML::Mason::Commands::session;
my $uri = URI->new($redir_to);
- my $server_uri = URI->new( RT->Config->Get('WebURL') );
+ my $server_uri = URI->new( _NormalizeHost(RT->Config->Get('WebURL')) );
+
+ # Make relative URIs absolute from the server host and scheme
+ $uri->scheme($server_uri->scheme) if not defined $uri->scheme;
+ if (not defined $uri->host) {
+ $uri->host($server_uri->host);
+ $uri->port($server_uri->port);
+ }
# If the user is coming in via a non-canonical
# hostname, don't redirect them to the canonical host,
# it will just upset them (and invalidate their credentials)
- # don't do this if $RT::CanoniaclRedirectURLs is true
+ # don't do this if $RT::CanonicalizeRedirectURLs is true
if ( !RT->Config->Get('CanonicalizeRedirectURLs')
&& $uri->host eq $server_uri->host
&& $uri->port eq $server_uri->port )
}
# [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
- $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} );
+ $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'});
$uri->port( $ENV{'SERVER_PORT'} );
}
$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)
=cut
sub StaticFileHeaders {
- my $date = RT::Date->new($RT::SystemUser);
+ 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
# $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616;
}
+=head2 ComponentPathIsSafe PATH
+
+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<.>), 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{(?:^|/)\.} and $path !~ m{\0};
+}
+
=head2 PathIsSafe
Takes a C<< Path => path >> and returns a boolean indicating that
$type ||= "application/octet-stream";
}
$HTML::Mason::Commands::r->content_type($type);
- open my $fh, "<$file" or die "couldn't open file: $!";
+ open( my $fh, '<', $file ) or die "couldn't open file: $!";
binmode($fh);
{
local $/ = \16384;
close $fh;
}
+
+
+sub MobileClient {
+ 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|Mobile)/io && !$HTML::Mason::Commands::session{'NotMobile'}) {
+ return 1;
+} else {
+ return undef;
+}
+
+}
+
+
sub StripContent {
my %args = @_;
my $content = $args{Content};
# Check for plaintext sig
return '' if not $html and $content =~ /^(--)?\Q$sig\E$/;
- # Check for html-formatted sig
- RT::Interface::Web::EscapeUTF8( \$sig );
- return ''
- if $html
- and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
+ # Check for html-formatted sig; we don't use EscapeUTF8 here
+ # because we want to precisely match the escapting that FCKEditor
+ # uses.
+ $sig =~ s/&/&/g;
+ $sig =~ s/</</g;
+ $sig =~ s/>/>/g;
+ $sig =~ s/"/"/g;
+ $sig =~ s/'/'/g;
+ return '' if $html and $content =~ m{^(?:<p>)?(--)?\Q$sig\E(?:</p>)?$}s;
# Pass it through
return $return_content;
}
sub LogRecordedSQLStatements {
+ my %args = @_;
+
my $log_sql_statements = RT->Config->Get('StatementLog');
return unless ($log_sql_statements);
my @log = $RT::Handle->SQLStatementLog;
$RT::Handle->ClearSQLStatementLog;
+
+ $RT::Handle->AddRequestToHistory({
+ %{ $args{RequestData} },
+ Queries => \@log,
+ });
+
for my $stmt (@log) {
my ( $time, $sql, $bind, $duration ) = @{$stmt};
my @bind;
message => "SQL("
. sprintf( "%.6f", $duration )
. "s): $sql;"
- . ( @bind ? " [ bound values: @{[map{qq|'$_'|} @bind]} ]" : "" )
+ . ( @bind ? " [ bound values: @{[map{ defined $_ ? qq|'$_'| : 'undef'} @bind]} ]" : "" )
+ );
+ }
+
+}
+
+my $_has_validated_web_config = 0;
+sub ValidateWebConfig {
+ my $self = shift;
+
+ # do this once per server instance, not once per request
+ return if $_has_validated_web_config;
+ $_has_validated_web_config = 1;
+
+ 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 ( $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.");
+ }
+
+ 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.");
+ }
+
+ # 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.");
+ }
+}
+
+sub ComponentRoots {
+ my $self = shift;
+ my %args = ( Names => 0, @_ );
+ my @roots;
+ if (defined $HTML::Mason::Commands::m) {
+ @roots = $HTML::Mason::Commands::m->interp->comp_root_array;
+ } else {
+ @roots = (
+ [ local => $RT::MasonLocalComponentRoot ],
+ (map {[ "plugin-".$_->Name => $_->ComponentRoot ]} @{RT->Plugins}),
+ [ standard => $RT::MasonComponentRoot ]
);
}
+ @roots = map { $_->[1] } @roots unless $args{Names};
+ return @roots;
+}
+
+our %is_whitelisted_component = (
+ # The RSS feed embeds an auth token in the path, but query
+ # 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 bookmark a result page.
+ '/Search/Results.html' => 1,
+ '/Search/Simple.html' => 1,
+ '/m/tickets/search' => 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 {
+ my $comp = shift;
+ my $ARGS = shift;
+
+ return 1 if $is_whitelisted_component{$comp};
+
+ my %args = %{ $ARGS };
+
+ # If the user specifies a *correct* user and pass then they are
+ # golden. This acts on the presumption that external forms may
+ # hardcode a username and password -- if a malicious attacker knew
+ # both already, CSRF is the least of your problems.
+ my $AllowLoginCSRF = not RT->Config->Get('RestrictReferrerLogin');
+ if ($AllowLoginCSRF and defined($args{user}) and defined($args{pass})) {
+ my $user_obj = RT::CurrentUser->new();
+ $user_obj->Load($args{user});
+ return 1 if $user_obj->id && $user_obj->IsPassword($args{pass});
+
+ delete $args{user};
+ 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 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;
+
+ return 0;
+}
+
+sub IsRefererCSRFWhitelisted {
+ my $referer = _NormalizeHost(shift);
+ my $base_url = _NormalizeHost(RT->Config->Get('WebBaseURL'));
+ $base_url = $base_url->host_port;
+
+ my $configs;
+ for my $config ( $base_url, RT->Config->Get('ReferrerWhitelist') ) {
+ push @$configs,$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);
+}
+
+=head3 _NormalizeHost
+
+Takes a URI and creates a URI object that's been normalized
+to handle common problems such as localhost vs 127.0.0.1
+
+=cut
+
+sub _NormalizeHost {
+ my $s = shift;
+ $s = "http://$s" unless $s =~ /^http/i;
+ my $uri= URI->new($s);
+ $uri->host('127.0.0.1') if $uri->host eq 'localhost';
+
+ return $uri;
+
+}
+
+sub IsPossibleCSRF {
+ my $ARGS = shift;
+
+ # If first request on this session is to a REST endpoint, then
+ # whitelist the REST endpoints -- and explicitly deny non-REST
+ # endpoints. We do this because using a REST cookie in a browser
+ # would open the user to CSRF attacks to the REST endpoints.
+ my $path = $HTML::Mason::Commands::r->path_info;
+ $HTML::Mason::Commands::session{'REST'} = $path =~ m{^/+REST/\d+\.\d+(/|$)}
+ unless defined $HTML::Mason::Commands::session{'REST'};
+
+ if ($HTML::Mason::Commands::session{'REST'}) {
+ return 0 if $path =~ m{^/+REST/\d+\.\d+(/|$)};
+ my $why = <<EOT;
+This login session belongs to a REST client, and cannot be used to
+access non-REST interfaces of RT for security reasons.
+EOT
+ my $details = <<EOT;
+Please log out and back in to obtain a session for normal browsing. If
+you understand the security implications, disabling RT's CSRF protection
+will remove this restriction.
+EOT
+ chomp $details;
+ HTML::Mason::Commands::Abort( $why, Details => $details );
+ }
+
+ return 0 if IsCompCSRFWhitelisted(
+ $HTML::Mason::Commands::m->request_comp->path,
+ $ARGS
+ );
+
+ # if there is no Referer header then assume the worst
+ return (1,
+ "your browser did not supply a Referrer header", # loc
+ ) if !$ENV{HTTP_REFERER};
+
+ my ($whitelisted, $browser, $configs) = IsRefererCSRFWhitelisted($ENV{HTTP_REFERER});
+ return 0 if $whitelisted;
+
+ if ( @$configs > 1 ) {
+ return (1,
+ "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2]) or whitelisted hosts ([_3])", # loc
+ $browser->host_port,
+ shift @$configs,
+ join(', ', @$configs) );
+ }
+
+ return (1,
+ "the Referrer header supplied by your browser ([_1]) is not allowed by RT's configured hostname ([_2])", # loc
+ $browser->host_port,
+ $configs->[0]);
+}
+
+sub ExpandCSRFToken {
+ my $ARGS = shift;
+
+ my $token = delete $ARGS->{CSRF_Token};
+ return unless $token;
+
+ my $data = $HTML::Mason::Commands::session{'CSRF'}{$token};
+ return unless $data;
+ return unless $data->{path} eq $HTML::Mason::Commands::r->path_info;
+
+ my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj;
+ return unless $user->ValidateAuthString( $data->{auth}, $token );
+
+ %{$ARGS} = %{$data->{args}};
+ $HTML::Mason::Commands::DECODED_ARGS = $ARGS;
+
+ # We explicitly stored file attachments with the request, but not in
+ # the session yet, as that would itself be an attack. Put them into
+ # the session now, so they'll be visible.
+ if ($data->{attach}) {
+ my $filename = $data->{attach}{filename};
+ my $mime = $data->{attach}{mime};
+ $HTML::Mason::Commands::session{'Attachments'}{$filename}
+ = $mime;
+ }
+
+ return 1;
+}
+
+sub StoreRequestToken {
+ my $ARGS = shift;
+ my $token = Digest::MD5::md5_hex(time . {} . $$ . rand(1024));
+ my $user = $HTML::Mason::Commands::session{'CurrentUser'}->UserObj;
+ my $data = {
+ auth => $user->GenerateAuthString( $token ),
+ path => $HTML::Mason::Commands::r->path_info,
+ args => $ARGS,
+ };
+ if ($ARGS->{Attach}) {
+ my $attachment = HTML::Mason::Commands::MakeMIMEEntity( AttachmentFieldName => 'Attach' );
+ my $file_path = delete $ARGS->{'Attach'};
+ $data->{attach} = {
+ filename => Encode::decode_utf8("$file_path"),
+ mime => $attachment,
+ };
+ }
+
+ $HTML::Mason::Commands::session{'CSRF'}->{$token} = $data;
+ $HTML::Mason::Commands::session{'i'}++;
+ return $token;
+}
+
+sub MaybeShowInterstitialCSRFPage {
+ my $ARGS = shift;
+
+ return unless RT->Config->Get('RestrictReferrer');
+
+ # Deal with the form token provided by the interstitial, which lets
+ # browsers which never set referer headers still use RT, if
+ # painfully. This blows values into ARGS
+ return if ExpandCSRFToken($ARGS);
+
+ my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS);
+ return if !$is_csrf;
+
+ $RT::Logger->notice("Possible CSRF: ".RT::CurrentUser->new->loc($msg, @loc));
+
+ my $token = StoreRequestToken($ARGS);
+ $HTML::Mason::Commands::m->comp(
+ '/Elements/CSRF',
+ OriginalURL => RT->Config->Get('WebPath') . $HTML::Mason::Commands::r->path_info,
+ Reason => HTML::Mason::Commands::loc( $msg, @loc ),
+ Token => $token,
+ );
+ # 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/;
-# {{{ loc
+sub Menu {
+ return $HTML::Mason::Commands::m->notes('menu');
+}
+
+sub PageMenu {
+ return $HTML::Mason::Commands::m->notes('page-menu');
+}
+
+sub PageWidgets {
+ return $HTML::Mason::Commands::m->notes('page-widgets');
+}
+
+
=head2 loc ARRAY
}
}
-# }}}
-# {{{ loc_fuzzy
=head2 loc_fuzzy STRING
{
return ( $session{'CurrentUser'}->loc_fuzzy($msg) );
} else {
- my $u = RT::CurrentUser->new( $RT::SystemUser->Id );
+ my $u = RT::CurrentUser->new( RT->SystemUser->Id );
return ( $u->loc_fuzzy($msg) );
}
}
-# }}}
-# {{{ sub Abort
-# Error - calls Error and aborts
-sub Abort {
- my $why = shift;
- my %args = @_;
+# Error - calls Error and aborts
+sub Abort {
+ my $why = shift;
+ my %args = @_;
+
+ if ( $session{'ErrorDocument'}
+ && $session{'ErrorDocumentType'} )
+ {
+ $r->content_type( $session{'ErrorDocumentType'} );
+ $m->comp( $session{'ErrorDocument'}, Why => $why, %args );
+ $m->abort;
+ } else {
+ $m->comp( "/Elements/Error", Why => $why, %args );
+ $m->abort;
+ }
+}
+
+sub MaybeRedirectForResults {
+ my %args = (
+ Path => $HTML::Mason::Commands::m->request_comp->path,
+ Arguments => {},
+ Anchor => undef,
+ Actions => undef,
+ Force => 0,
+ @_
+ );
+ my $has_actions = $args{'Actions'} && grep( defined, @{ $args{'Actions'} } );
+ return unless $has_actions || $args{'Force'};
+
+ my %arguments = %{ $args{'Arguments'} };
+
+ if ( $has_actions ) {
+ my $key = Digest::MD5::md5_hex( rand(1024) );
+ push @{ $session{"Actions"}{ $key } ||= [] }, @{ $args{'Actions'} };
+ $session{'i'}++;
+ $arguments{'results'} = $key;
+ }
+
+ $args{'Path'} =~ s!^/+!!;
+ my $url = RT->Config->Get('WebURL') . $args{Path};
+
+ if ( keys %arguments ) {
+ $url .= '?'. $m->comp( '/Elements/QueryString', %arguments );
+ }
+ if ( $args{'Anchor'} ) {
+ $url .= "#". $args{'Anchor'};
+ }
+ return RT::Interface::Web::Redirect($url);
+}
+
+=head2 MaybeRedirectToApproval Path => 'path', Whitelist => REGEX, ARGSRef => HASHREF
+
+If the ticket specified by C<< $ARGSRef->{id} >> is an approval ticket,
+redirect to the approvals display page, preserving any arguments.
+
+C<Path>s matching C<Whitelist> are let through.
+
+This is a no-op if the C<ForceApprovalsView> option isn't enabled.
+
+=cut
+
+sub MaybeRedirectToApproval {
+ my %args = (
+ Path => $HTML::Mason::Commands::m->request_comp->path,
+ ARGSRef => {},
+ Whitelist => undef,
+ @_
+ );
+
+ return unless $ENV{REQUEST_METHOD} eq 'GET';
+
+ my $id = $args{ARGSRef}->{id};
- if ( $session{'ErrorDocument'}
- && $session{'ErrorDocumentType'} )
+ if ( $id
+ and RT->Config->Get('ForceApprovalsView')
+ and not $args{Path} =~ /$args{Whitelist}/)
{
- $r->content_type( $session{'ErrorDocumentType'} );
- $m->comp( $session{'ErrorDocument'}, Why => $why, %args );
- $m->abort;
- } else {
- $m->comp( "/Elements/Error", Why => $why, %args );
- $m->abort;
+ my $ticket = RT::Ticket->new( $session{'CurrentUser'} );
+ $ticket->Load($id);
+
+ if ($ticket and $ticket->id and lc($ticket->Type) eq 'approval') {
+ MaybeRedirectForResults(
+ Path => "/Approvals/Display.html",
+ Force => 1,
+ Anchor => $args{ARGSRef}->{Anchor},
+ Arguments => $args{ARGSRef},
+ );
+ }
}
}
-# }}}
-
-# {{{ sub CreateTicket
-
=head2 CreateTicket ARGS
Create a new ticket, using Mason's %ARGS. returns @results.
my (@Actions);
- my $Ticket = new RT::Ticket( $session{'CurrentUser'} );
+ my $Ticket = RT::Ticket->new( $session{'CurrentUser'} );
- my $Queue = new RT::Queue( $session{'CurrentUser'} );
+ my $Queue = RT::Queue->new( $session{'CurrentUser'} );
unless ( $Queue->Load( $ARGS{'Queue'} ) ) {
Abort('Queue not found');
}
my $due;
if ( defined $ARGS{'Due'} and $ARGS{'Due'} =~ /\S/ ) {
- $due = new RT::Date( $session{'CurrentUser'} );
+ $due = RT::Date->new( $session{'CurrentUser'} );
$due->Set( Format => 'unknown', Value => $ARGS{'Due'} );
}
my $starts;
if ( defined $ARGS{'Starts'} and $ARGS{'Starts'} =~ /\S/ ) {
- $starts = new RT::Date( $session{'CurrentUser'} );
+ $starts = RT::Date->new( $session{'CurrentUser'} );
$starts->Set( Format => 'unknown', Value => $ARGS{'Starts'} );
}
Cc => $ARGS{'Cc'},
Body => $sigless,
Type => $ARGS{'ContentType'},
+ Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
);
if ( $ARGS{'Attachments'} ) {
}
}
- foreach my $argument (qw(Encrypt Sign)) {
- $MIMEObj->head->add(
- "X-RT-$argument" => Encode::encode_utf8( $ARGS{$argument} )
- ) if defined $ARGS{$argument};
+ for my $argument (qw(Encrypt Sign)) {
+ $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 );
}
my %create_args = (
MIMEObj => $MIMEObj
);
- my @temp_squelch;
+ my @txn_squelch;
foreach my $type (qw(Requestor Cc AdminCc)) {
- push @temp_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
+ push @txn_squelch, map $_->address, Email::Address->parse( $create_args{$type} )
if grep $_ eq $type || $_ eq ( $type . 's' ), @{ $ARGS{'SkipNotification'} || [] };
-
- }
-
- if (@temp_squelch) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
}
+ $create_args{TransSquelchMailTo} = \@txn_squelch
+ if @txn_squelch;
if ( $ARGS{'AttachTickets'} ) {
require RT::Action::SendEmail;
my $cfid = $1;
my $cf = RT::CustomField->new( $session{'CurrentUser'} );
+ $cf->SetContextObject( $Queue );
$cf->Load($cfid);
unless ( $cf->id ) {
$RT::Logger->error( "Couldn't load custom field #" . $cfid );
}
-# }}}
-# {{{ sub LoadTicket - loads a ticket
=head2 LoadTicket id
return $Ticket;
}
-# }}}
-# {{{ sub ProcessUpdateMessage
=head2 ProcessUpdateMessage
return;
}
- if ( $args{ARGSRef}->{'UpdateSubject'} eq $args{'TicketObj'}->Subject ) {
+ if ( $args{ARGSRef}->{'UpdateSubject'} eq ($args{'TicketObj'}->Subject || '') ) {
$args{ARGSRef}->{'UpdateSubject'} = undef;
}
Subject => $args{ARGSRef}->{'UpdateSubject'},
Body => $args{ARGSRef}->{'UpdateContent'},
Type => $args{ARGSRef}->{'UpdateContentType'},
+ Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web',
);
- $Message->head->add( 'Message-ID' => Encode::encode_utf8(
+ $Message->head->replace( 'Message-ID' => Encode::encode_utf8(
RT::Interface::Email::GenMessageId( Ticket => $args{'TicketObj'} )
) );
my $old_txn = RT::Transaction->new( $session{'CurrentUser'} );
: ( $args{ARGSRef}->{'AttachTickets'} ) );
}
- my $bcc = $args{ARGSRef}->{'UpdateBcc'};
- my $cc = $args{ARGSRef}->{'UpdateCc'};
+ 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 = (
- CcMessageTo => $cc,
- BccMessageTo => $bcc,
- Sign => $args{ARGSRef}->{'Sign'},
- Encrypt => $args{ARGSRef}->{'Encrypt'},
+ Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ),
+ Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ),
MIMEObj => $Message,
- TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'}
+ TimeTaken => $args{ARGSRef}->{'UpdateTimeWorked'},
+ CustomFields => \%txn_customfields,
+ );
+
+ _ProcessUpdateMessageRecipients(
+ MessageArgs => \%message_args,
+ %args,
+ );
+
+ my @results;
+ if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
+ my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args);
+ push( @results, $Description );
+ $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
+ } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
+ my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args);
+ push( @results, $Description );
+ $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
+ } else {
+ push( @results,
+ loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
+ }
+ return @results;
+}
+
+sub _ProcessUpdateMessageRecipients {
+ my %args = (
+ ARGSRef => undef,
+ TicketObj => undef,
+ MessageArgs => undef,
+ @_,
);
- my @temp_squelch;
+ my $bcc = $args{ARGSRef}->{'UpdateBcc'};
+ my $cc = $args{ARGSRef}->{'UpdateCc'};
+
+ my $message_args = $args{MessageArgs};
+
+ $message_args->{CcMessageTo} = $cc;
+ $message_args->{BccMessageTo} = $bcc;
+
+ my @txn_squelch;
foreach my $type (qw(Cc AdminCc)) {
if (grep $_ eq $type || $_ eq ( $type . 's' ), @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
- push @temp_squelch, map $_->address, Email::Address->parse( $message_args{$type} );
- push @temp_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
- push @temp_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
+ push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{$type} );
+ push @txn_squelch, $args{TicketObj}->$type->MemberEmailAddresses;
+ push @txn_squelch, $args{TicketObj}->QueueObj->$type->MemberEmailAddresses;
}
}
if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) {
- push @temp_squelch, map $_->address, Email::Address->parse( $message_args{Requestor} );
- push @temp_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
+ push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} );
+ push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses;
}
- if (@temp_squelch) {
- require RT::Action::SendEmail;
- RT::Action::SendEmail->SquelchMailTo( RT::Action::SendEmail->SquelchMailTo, @temp_squelch );
- }
+ push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo};
+ $message_args->{SquelchMailTo} = \@txn_squelch
+ if @txn_squelch;
unless ( $args{'ARGSRef'}->{'UpdateIgnoreAddressCheckboxes'} ) {
foreach my $key ( keys %{ $args{ARGSRef} } ) {
my $var = ucfirst($1) . 'MessageTo';
my $value = $2;
- if ( $message_args{$var} ) {
- $message_args{$var} .= ", $value";
+ if ( $message_args->{$var} ) {
+ $message_args->{$var} .= ", $value";
} else {
- $message_args{$var} = $value;
+ $message_args->{$var} = $value;
}
}
}
+}
- my @results;
- if ( $args{ARGSRef}->{'UpdateType'} =~ /^(private|public)$/ ) {
- my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Comment(%message_args);
- push( @results, $Description );
- $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
- } elsif ( $args{ARGSRef}->{'UpdateType'} eq 'response' ) {
- my ( $Transaction, $Description, $Object ) = $args{TicketObj}->Correspond(%message_args);
- push( @results, $Description );
- $Object->UpdateCustomFields( ARGSRef => $args{ARGSRef} ) if $Object;
- } else {
- push( @results,
- loc("Update type was neither correspondence nor comment.") . " " . loc("Update not recorded.") );
+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'} || {} } };
}
- return @results;
-}
-# }}}
+ # store the uploaded attachment in session
+ if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} )
+ { # attachment?
+ my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' );
+
+ my $file_path = Encode::decode_utf8("$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'};
+ }
+}
-# {{{ sub MakeMIMEEntity
=head2 MakeMIMEEntity PARAMHASH
Body => undef,
AttachmentFieldName => undef,
Type => undef,
+ Interface => 'API',
@_,
);
my $Message = MIME::Entity->build(
Type => 'multipart/mixed',
+ "Message-Id" => Encode::encode_utf8( RT::Interface::Email::GenMessageId ),
+ "X-RT-Interface" => $args{Interface},
map { $_ => Encode::encode_utf8( $args{ $_} ) }
grep defined $args{$_}, qw(Subject From Cc)
);
if ( $args{'AttachmentFieldName'} ) {
my $cgi_object = $m->cgi_object;
-
- if ( my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} ) ) {
+ my $filehandle = $cgi_object->upload( $args{'AttachmentFieldName'} );
+ if ( defined $filehandle && length $filehandle ) {
my ( @content, $buffer );
while ( my $bytesread = read( $filehandle, $buffer, 4096 ) ) {
my $uploadinfo = $cgi_object->uploadInfo($filehandle);
- # Prefer the cached name first over CGI.pm stringification.
- my $filename = $RT::Mason::CGI::Filename;
- $filename = "$filehandle" unless defined $filename;
- $filename = Encode::encode_utf8( $filename );
+ my $filename = "$filehandle";
$filename =~ s{^.*[\\/]}{};
$Message->attach(
if ( !$args{'Subject'} && !( defined $args{'Body'} && length $args{'Body'} ) ) {
$Message->head->set( 'Subject' => $filename );
}
+
+ # Attachment parts really shouldn't get a Message-ID or "interface"
+ $Message->head->delete('Message-ID');
+ $Message->head->delete('X-RT-Interface');
}
}
}
-# }}}
-# {{{ sub ParseDateToISO
=head2 ParseDateToISO
return ( $date_obj->ISO );
}
-# }}}
-# {{{ sub ProcessACLChanges
sub ProcessACLChanges {
my $ARGSref = shift;
return (@results);
}
-# }}}
-# {{{ sub UpdateRecordObj
+=head2 ProcessACLs
+
+ProcessACLs expects values from a series of checkboxes that describe the full
+set of rights a principal should have on an object.
+
+It expects form inputs with names like SetRights-PrincipalId-ObjType-ObjId
+instead of with the prefixes Grant/RevokeRight. Each input should be an array
+listing the rights the principal should have, and ProcessACLs will modify the
+current rights to match. Additionally, the previously unused CheckACL input
+listing PrincipalId-ObjType-ObjId is now used to catch cases when all the
+rights are removed from a principal and as such no SetRights input is
+submitted.
+
+=cut
+
+sub ProcessACLs {
+ my $ARGSref = shift;
+ my (%state, @results);
+
+ my $CheckACL = $ARGSref->{'CheckACL'};
+ my @check = grep { defined } (ref $CheckACL eq 'ARRAY' ? @$CheckACL : $CheckACL);
+
+ # Check if we want to grant rights to a previously rights-less user
+ for my $type (qw(user group)) {
+ my $principal = _ParseACLNewPrincipal($ARGSref, $type)
+ or next;
+
+ unless ($principal->PrincipalId) {
+ push @results, loc("Couldn't load the specified principal");
+ next;
+ }
+
+ my $principal_id = $principal->PrincipalId;
+
+ # Turn our addprincipal rights spec into a real one
+ for my $arg (keys %$ARGSref) {
+ next unless $arg =~ /^SetRights-addprincipal-(.+?-\d+)$/;
+
+ my $tuple = "$principal_id-$1";
+ my $key = "SetRights-$tuple";
+
+ # If we have it already, that's odd, but merge them
+ if (grep { $_ eq $tuple } @check) {
+ $ARGSref->{$key} = [
+ (ref $ARGSref->{$key} eq 'ARRAY' ? @{$ARGSref->{$key}} : $ARGSref->{$key}),
+ (ref $ARGSref->{$arg} eq 'ARRAY' ? @{$ARGSref->{$arg}} : $ARGSref->{$arg}),
+ ];
+ } else {
+ $ARGSref->{$key} = $ARGSref->{$arg};
+ push @check, $tuple;
+ }
+ }
+ }
+
+ # Build our rights state for each Principal-Object tuple
+ foreach my $arg ( keys %$ARGSref ) {
+ next unless $arg =~ /^SetRights-(\d+-.+?-\d+)$/;
+
+ my $tuple = $1;
+ my $value = $ARGSref->{$arg};
+ my @rights = grep { $_ } (ref $value eq 'ARRAY' ? @$value : $value);
+ next unless @rights;
+
+ $state{$tuple} = { map { $_ => 1 } @rights };
+ }
+
+ foreach my $tuple (List::MoreUtils::uniq @check) {
+ next unless $tuple =~ /^(\d+)-(.+?)-(\d+)$/;
+
+ my ( $principal_id, $object_type, $object_id ) = ( $1, $2, $3 );
+
+ my $principal = RT::Principal->new( $session{'CurrentUser'} );
+ $principal->Load($principal_id);
+
+ my $obj;
+ if ( $object_type eq 'RT::System' ) {
+ $obj = $RT::System;
+ } elsif ( $RT::ACE::OBJECT_TYPES{$object_type} ) {
+ $obj = $object_type->new( $session{'CurrentUser'} );
+ $obj->Load($object_id);
+ unless ( $obj->id ) {
+ $RT::Logger->error("couldn't load $object_type #$object_id");
+ next;
+ }
+ } else {
+ $RT::Logger->error("object type '$object_type' is incorrect");
+ push( @results, loc("System Error") . ': ' . loc( "Rights could not be granted for [_1]", $object_type ) );
+ next;
+ }
+
+ my $acls = RT::ACL->new($session{'CurrentUser'});
+ $acls->LimitToObject( $obj );
+ $acls->LimitToPrincipal( Id => $principal_id );
+
+ while ( my $ace = $acls->Next ) {
+ my $right = $ace->RightName;
+
+ # Has right and should have right
+ next if delete $state{$tuple}->{$right};
+
+ # Has right and shouldn't have right
+ my ($val, $msg) = $principal->RevokeRight( Object => $obj, Right => $right );
+ push @results, $msg;
+ }
+
+ # For everything left, they don't have the right but they should
+ for my $right (keys %{ $state{$tuple} || {} }) {
+ delete $state{$tuple}->{$right};
+ my ($val, $msg) = $principal->GrantRight( Object => $obj, Right => $right );
+ push @results, $msg;
+ }
+
+ # Check our state for leftovers
+ if ( keys %{ $state{$tuple} || {} } ) {
+ my $missed = join '|', %{$state{$tuple} || {}};
+ $RT::Logger->warn(
+ "Uh-oh, it looks like we somehow missed a right in "
+ ."ProcessACLs. Here's what was leftover: $missed"
+ );
+ }
+ }
+
+ 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)
return (@results);
}
-# }}}
-# {{{ Sub ProcessCustomFieldUpdates
sub ProcessCustomFieldUpdates {
my %args = (
return (@results);
}
-# }}}
-# {{{ sub ProcessTicketBasics
=head2 ProcessTicketBasics ( TicketObj => $Ticket, ARGSRef => \%ARGS );
my $TicketObj = $args{'TicketObj'};
my $ARGSRef = $args{'ARGSRef'};
- # {{{ Set basic fields
+ my $OrigOwner = $TicketObj->Owner;
+
+ # Set basic fields
my @attribs = qw(
Subject
FinalPriority
Queue
);
- if ( $ARGSRef->{'Queue'} and ( $ARGSRef->{'Queue'} !~ /^(\d+)$/ ) ) {
- my $tempqueue = RT::Queue->new($RT::SystemUser);
- $tempqueue->Load( $ARGSRef->{'Queue'} );
- if ( $tempqueue->id ) {
- $ARGSRef->{'Queue'} = $tempqueue->id;
+ # Canonicalize Queue and Owner to their IDs if they aren't numeric
+ for my $field (qw(Queue Owner)) {
+ if ( $ARGSRef->{$field} and ( $ARGSRef->{$field} !~ /^(\d+)$/ ) ) {
+ my $class = $field eq 'Owner' ? "RT::User" : "RT::$field";
+ my $temp = $class->new(RT->SystemUser);
+ $temp->Load( $ARGSRef->{$field} );
+ if ( $temp->id ) {
+ $ARGSRef->{$field} = $temp->id;
+ }
}
}
);
# We special case owner changing, so we can use ForceOwnerChange
- if ( $ARGSRef->{'Owner'} && ( $TicketObj->Owner != $ARGSRef->{'Owner'} ) ) {
+ if ( $ARGSRef->{'Owner'}
+ && $ARGSRef->{'Owner'} !~ /\D/
+ && ( $OrigOwner != $ARGSRef->{'Owner'} ) ) {
my ($ChownType);
if ( $ARGSRef->{'ForceOwnerChange'} ) {
$ChownType = "Force";
- } else {
- $ChownType = "Give";
+ }
+ else {
+ $ChownType = "Set";
}
my ( $val, $msg ) = $TicketObj->SetOwner( $ARGSRef->{'Owner'}, $ChownType );
return (@results);
}
-# }}}
+sub ProcessTicketReminders {
+ my %args = (
+ TicketObj => undef,
+ ARGSRef => undef,
+ @_
+ );
+
+ my $Ticket = $args{'TicketObj'};
+ my $args = $args{'ARGSRef'};
+ my @results;
+
+ my $reminder_collection = $Ticket->Reminders->Collection;
+
+ if ( $args->{'update-reminders'} ) {
+ 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);
+ }
+ elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) {
+ $Ticket->Reminders->Open($reminder);
+ }
+
+ if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) {
+ $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ;
+ }
+
+ if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) {
+ $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ;
+ }
+
+ if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) {
+ my $DateObj = RT::Date->new( $session{'CurrentUser'} );
+ $DateObj->Set(
+ Format => 'unknown',
+ Value => $args->{ 'Reminder-Due-' . $reminder->id }
+ );
+ if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) {
+ $reminder->SetDue( $DateObj->ISO );
+ }
+ }
+ }
+ }
+
+ if ( $args->{'NewReminder-Subject'} ) {
+ my $due_obj = RT::Date->new( $session{'CurrentUser'} );
+ $due_obj->Set(
+ Format => 'unknown',
+ Value => $args->{'NewReminder-Due'}
+ );
+ my ( $add_id, $msg ) = $Ticket->Reminders->Add(
+ Subject => $args->{'NewReminder-Subject'},
+ Owner => $args->{'NewReminder-Owner'},
+ Due => $due_obj->ISO
+ );
+ if ( $add_id ) {
+ push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'});
+ }
+ else {
+ push @results, $msg;
+ }
+ }
+ return @results;
+}
sub ProcessTicketCustomFieldUpdates {
my %args = @_;
$ARGSRef->{"Object-RT::Ticket-$1"} = delete $ARGSRef->{$arg};
} elsif ( $arg =~ /^CustomField-(\d+-.*)/ ) {
$ARGSRef->{"Object-RT::Ticket--$1"} = delete $ARGSRef->{$arg};
+ } elsif ( $arg =~ /^Object-RT::Transaction-(\d*)-CustomField/ ) {
+ delete $ARGSRef->{$arg}; # don't try to update transaction fields
}
}
foreach my $cf ( keys %{ $custom_fields_to_mod{$class}{$id} } ) {
my $CustomFieldObj = RT::CustomField->new( $session{'CurrentUser'} );
+ $CustomFieldObj->SetContextObject($Object);
$CustomFieldObj->LoadById($cf);
unless ( $CustomFieldObj->id ) {
$RT::Logger->warning("Couldn't load custom field #$cf");
sub _ProcessObjectCustomFieldUpdates {
my %args = @_;
my $cf = $args{'CustomField'};
- my $cf_type = $cf->Type;
+ my $cf_type = $cf->Type || '';
# Remove blank Values since the magic field will take care of this. Sometimes
# the browser gives you a blank value which causes CFs to be processed twice
# skip category argument
next if $arg eq 'Category';
+ # and TimeUnits
+ next if $arg eq 'Value-TimeUnits';
+
# since http won't pass in a form element with a null value, we need
# to fake it
if ( $arg eq 'Values-Magic' ) {
# For Date Cfs, @values is empty when there is no changes (no datas in form input)
return @results if ( $cf->Type eq 'Date' && ! @values );
+ # For Date Cfs, @values is empty when there is no changes (no datas in form input)
+ return @results if ( $cf->Type =~ /^Date(?:Time)?$/ && ! @values );
+
$cf_values->RedoSearch;
while ( my $cf_value = $cf_values->Next ) {
next if $values_hash{ $cf_value->id };
return @results;
}
-# {{{ sub ProcessTicketWatchers
=head2 ProcessTicketWatchers ( TicketObj => $Ticket, ARGSRef => \%ARGS );
return (@results);
}
-# }}}
-# {{{ sub ProcessTicketDates
=head2 ProcessTicketDates ( TicketObj => $Ticket, ARGSRef => \%ARGS );
my (@results);
- # {{{ Set date fields
+ # Set date fields
my @date_fields = qw(
Told
Resolved
Starts
Started
Due
+ WillResolve
);
#Run through each field in this list. update the value if apropriate
return (@results);
}
-# }}}
-# {{{ sub ProcessTicketLinks
=head2 ProcessTicketLinks ( TicketObj => $Ticket, ARGSRef => \%ARGS );
return (@results);
}
-# }}}
sub ProcessRecordLinks {
my %args = (
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,
return $value;
}
+=head2 GetPrincipalsMap OBJECT, CATEGORIES
+
+Returns an array suitable for passing to /Admin/Elements/EditRights with the
+principal collections mapped from the categories given.
+
+=cut
+
+sub GetPrincipalsMap {
+ my $object = shift;
+ my @map;
+ for (@_) {
+ if (/System/) {
+ my $system = RT::Groups->new($session{'CurrentUser'});
+ $system->LimitToSystemInternalGroups();
+ $system->OrderBy( FIELD => 'Type', ORDER => 'ASC' );
+ push @map, [
+ 'System' => $system, # loc_left_pair
+ 'Type' => 1,
+ ];
+ }
+ elsif (/Groups/) {
+ my $groups = RT::Groups->new($session{'CurrentUser'});
+ $groups->LimitToUserDefinedGroups();
+ $groups->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+ # Only show groups who have rights granted on this object
+ $groups->WithGroupRight(
+ Right => '',
+ Object => $object,
+ IncludeSystemRights => 0,
+ IncludeSubgroupMembers => 0,
+ );
+
+ push @map, [
+ 'User Groups' => $groups, # loc_left_pair
+ 'Name' => 0
+ ];
+ }
+ elsif (/Roles/) {
+ my $roles = RT::Groups->new($session{'CurrentUser'});
+
+ if ($object->isa('RT::System')) {
+ $roles->LimitToRolesForSystem();
+ }
+ elsif ($object->isa('RT::Queue')) {
+ $roles->LimitToRolesForQueue($object->Id);
+ }
+ else {
+ $RT::Logger->warn("Skipping unknown object type ($object) for Role principals");
+ next;
+ }
+ $roles->OrderBy( FIELD => 'Type', ORDER => 'ASC' );
+ push @map, [
+ 'Roles' => $roles, # loc_left_pair
+ 'Type' => 1
+ ];
+ }
+ elsif (/Users/) {
+ my $Users = RT->PrivilegedUsers->UserMembersObj();
+ $Users->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+ # Only show users who have rights granted on this object
+ my $group_members = $Users->WhoHaveGroupRight(
+ Right => '',
+ Object => $object,
+ IncludeSystemRights => 0,
+ IncludeSubgroupMembers => 0,
+ );
+
+ # Limit to UserEquiv groups
+ my $groups = $Users->NewAlias('Groups');
+ $Users->Join(
+ ALIAS1 => $groups,
+ FIELD1 => 'id',
+ ALIAS2 => $group_members,
+ FIELD2 => 'GroupId'
+ );
+ $Users->Limit( ALIAS => $groups, FIELD => 'Domain', VALUE => 'ACLEquivalence' );
+ $Users->Limit( ALIAS => $groups, FIELD => 'Type', VALUE => 'UserEquiv' );
+
+
+ my $display = sub {
+ $m->scomp('/Elements/ShowUser', User => $_[0], NoEscape => 1)
+ };
+ push @map, [
+ 'Users' => $Users, # loc_left_pair
+ $display => 0
+ ];
+ }
+ }
+ return @map;
+}
+
=head2 _load_container_object ( $type, $id );
Instantiate container object for saving searches.
return ( _load_container_object( $obj_type, $obj_id ), $search_id );
}
-eval "require RT::Interface::Web_Vendor";
-die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Web_Vendor.pm} );
-eval "require RT::Interface::Web_Local";
-die $@ if ( $@ && $@ !~ qr{^Can't locate RT/Interface/Web_Local.pm} );
+=head2 ScrubHTML content
+
+Removes unsafe and undesired HTML from the passed content
+
+=cut
+
+my $SCRUBBER;
+sub ScrubHTML {
+ my $Content = shift;
+ $SCRUBBER = _NewScrubber() unless $SCRUBBER;
+
+ $Content = '' if !defined($Content);
+ return $SCRUBBER->scrub($Content);
+}
+
+=head2 _NewScrubber
+
+Returns a new L<HTML::Scrubber> object.
+
+If you need to be more lax about what HTML tags and attributes are allowed,
+create C</opt/rt4/local/lib/RT/Interface/Web_Local.pm> with something like the
+following:
+
+ package HTML::Mason::Commands;
+ # Let tables through
+ push @SCRUBBER_ALLOWED_TAGS, qw(TABLE THEAD TBODY TFOOT TR TD TH);
+ 1;
+
+=cut
+
+our @SCRUBBER_ALLOWED_TAGS = qw(
+ A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP STRIKE H1 H2 H3 H4 H5
+ H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO
+);
+
+our %SCRUBBER_ALLOWED_ATTRIBUTES = (
+ # Match http, https, ftp, mailto and relative urls
+ # XXX: we also scrub format strings with this module then allow simple config options
+ href => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|BaseURL|URL)__)}i,
+ face => 1,
+ size => 1,
+ target => 1,
+ style => qr{
+ ^(?:\s*
+ (?:(?:background-)?color: \s*
+ (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) | # rgb(d,d,d)
+ \#[a-f0-9]{3,6} | # #fff or #ffffff
+ [\w\-]+ # green, light-blue, etc.
+ ) |
+ text-align: \s* \w+ |
+ font-size: \s* [\w.\-]+ |
+ font-family: \s* [\w\s"',.\-]+ |
+ font-weight: \s* [\w\-]+ |
+
+ # MS Office styles, which are probably fine. If we don't, then any
+ # associated styles in the same attribute get stripped.
+ mso-[\w\-]+?: \s* [\w\s"',.\-]+
+ )\s* ;? \s*)
+ +$ # one or more of these allowed properties from here 'till sunset
+ }ix,
+ dir => qr/^(rtl|ltr)$/i,
+ lang => qr/^\w+(-\w+)?$/,
+);
+
+our %SCRUBBER_RULES = ();
+
+sub _NewScrubber {
+ require HTML::Scrubber;
+ my $scrubber = HTML::Scrubber->new();
+ $scrubber->default(
+ 0,
+ {
+ %SCRUBBER_ALLOWED_ATTRIBUTES,
+ '*' => 0, # require attributes be explicitly allowed
+ },
+ );
+ $scrubber->deny(qw[*]);
+ $scrubber->allow(@SCRUBBER_ALLOWED_TAGS);
+ $scrubber->rules(%SCRUBBER_RULES);
+
+ # Scrubbing comments is vital since IE conditional comments can contain
+ # arbitrary HTML and we'd pass it right on through.
+ $scrubber->comment(0);
+
+ return $scrubber;
+}
+
+=head2 JSON
+
+Redispatches to L<RT::Interface::Web/EncodeJSON>
+
+=cut
+
+sub JSON {
+ RT::Interface::Web::EncodeJSON(@_);
+}
+
+package RT::Interface::Web;
+RT::Base->_ImportOverlays();
1;
projects / freeside.git / blobdiff