+## This is a library of static subs to be used by the Mason web
+## interface to RT
+
+=head1 NAME
+
+RT::Interface::Web
+
+
+=cut
+
+use strict;
+use warnings;
+
+package RT::Interface::Web;
+
+use RT::SavedSearches;
+use URI qw();
+use RT::Interface::Web::Menu;
+use RT::Interface::Web::Session;
+use Digest::MD5 ();
+use List::MoreUtils qw();
+use JSON qw();
+use Plack::Util;
+
+=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 JSFiles
+
+=cut
+
+sub JSFiles {
+ return qw{
+ jquery-1.9.1.min.js
+ jquery_noconflict.js
+ jquery-ui-1.10.0.custom.min.js
+ jquery-ui-timepicker-addon.js
+ jquery-ui-patch-datepicker.js
+ jquery.modal.min.js
+ jquery.modal-defaults.js
+ jquery.cookie.js
+ titlebox-state.js
+ i18n.js
+ util.js
+ autocomplete.js
+ jquery.event.hover-1.0.js
+ superfish.js
+ supersubs.js
+ jquery.supposition.js
+ history-folding.js
+ cascaded.js
+ forms.js
+ event-registration.js
+ late.js
+ /static/RichText/ckeditor.js
+ }, RT->Config->Get('JSFiles');
+}
+
+=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 EscapeHTML SCALARREF
+
+does a css-busting but minimalist escaping of whatever html you're passing in.
+
+=cut
+
+sub EscapeHTML {
+ my $ref = shift;
+ return unless defined $$ref;
+
+ $$ref =~ s/&/&/g;
+ $$ref =~ s/</</g;
+ $$ref =~ s/>/>/g;
+ $$ref =~ s/\(/(/g;
+ $$ref =~ s/\)/)/g;
+ $$ref =~ s/"/"/g;
+ $$ref =~ s/'/'/g;
+}
+
+# Back-compat
+# XXX: Remove in 4.4
+sub EscapeUTF8 {
+ RT->Deprecated(
+ Instead => "EscapeHTML",
+ Remove => "4.4",
+ );
+ EscapeHTML(@_);
+}
+
+=head2 EscapeURI SCALARREF
+
+Escapes URI component according to RFC2396
+
+=cut
+
+sub EscapeURI {
+ my $ref = shift;
+ return unless defined $$ref;
+
+ use bytes;
+ $$ref =~ s/([^a-zA-Z0-9_.!~*'()-])/uc sprintf("%%%02X", ord($1))/eg;
+}
+
+=head2 EncodeJSON SCALAR
+
+Encodes the SCALAR to JSON and returns a JSON Unicode (B<not> UTF-8) string.
+SCALAR may be a simple value or a reference.
+
+=cut
+
+sub EncodeJSON {
+ my $s = JSON::to_json(shift, { allow_nonref => 1 });
+ $s =~ s{/}{\\/}g;
+ return $s;
+}
+
+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();
+
+Different web servers set different environmental varibles. This
+function must return something suitable for REMOTE_USER. By default,
+just downcase $ENV{'REMOTE_USER'}
+
+=cut
+
+sub WebCanonicalizeInfo {
+ return $ENV{'REMOTE_USER'} ? lc $ENV{'REMOTE_USER'} : $ENV{'REMOTE_USER'};
+}
+
+
+
+=head2 WebRemoteUserAutocreateInfo($user);
+
+Returns a hash of user attributes, used when WebRemoteUserAutocreate is set.
+
+=cut
+
+sub WebRemoteUserAutocreateInfo {
+ my $user = shift;
+
+ my %user_info;
+
+ # default to making Privileged users, even if they specify
+ # some other default Attributes
+ if ( !$RT::UserAutocreateDefaultsOnLogin
+ || ( ref($RT::UserAutocreateDefaultsOnLogin) && not exists $RT::UserAutocreateDefaultsOnLogin->{Privileged} ) )
+ {
+ $user_info{'Privileged'} = 1;
+ }
+
+ # Populate fields with information from Unix /etc/passwd
+ my ( $comments, $realname ) = ( getpwnam($user) )[ 5, 6 ];
+ $user_info{'Comments'} = $comments if defined $comments;
+ $user_info{'RealName'} = $realname if defined $realname;
+
+ # and return the wad of stuff
+ 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 and $RT::Handle->TransactionDepth;
+
+ MaybeEnableSQLStatementLog();
+
+ # avoid reentrancy, as suggested by masonbook
+ local *HTML::Mason::Commands::session unless $HTML::Mason::Commands::m->is_subrequest;
+
+ $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();
+
+ 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);
+
+ AttemptExternalAuth($ARGS) if RT->Config->Get('WebRemoteUserContinuous') or not _UserLoggedIn();
+
+ _ForceLogout() unless _UserLoggedIn();
+
+ # 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();
+
+ # 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; charset=utf-8");
+ $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'} );
+
+ # Process per-page global callbacks
+ $HTML::Mason::Commands::m->callback( %$ARGS, CallbackName => 'Default', CallbackPage => '/autohandler' );
+
+ ShowRequestedPage($ARGS);
+ 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 {
+
+ delete $HTML::Mason::Commands::session{'CurrentUser'};
+}
+
+sub _UserLoggedIn {
+ if ( $HTML::Mason::Commands::session{CurrentUser} && $HTML::Mason::Commands::session{'CurrentUser'}->id ) {
+ return 1;
+ } else {
+ return undef;
+ }
+
+}
+
+=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 $login = TangentForLoginURL(@_);
+ Redirect( RT->Config->Get('WebBaseURL') . $login );
+}
+
+=head2 TangentForLoginURL [HASH]
+
+Returns a URL suitable for tangenting for login. Optionally takes a hash which
+is dumped into query params.
+
+=cut
+
+sub TangentForLoginURL {
+ 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('WebPath') . '/NoAuth/Login.html?';
+ $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query);
+ return $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
+a request to RT's Installation workflow, only if Install Mode is enabled in the configuration file.
+
+If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler
+
+=cut
+
+sub MaybeShowInstallModePage {
+ return unless RT->InstallMode;
+
+ my $m = $HTML::Mason::Commands::m;
+ if ( $m->base_comp->path =~ RT->Config->Get('WebNoAuthRegex') ) {
+ $m->call_next();
+ } elsif ( $m->request_comp->path !~ m{^(/+)Install/} ) {
+ RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "Install/index.html" );
+ } else {
+ $m->call_next();
+ }
+ $m->abort();
+}
+
+=head2 MaybeShowNoAuthPage \%ARGS
+
+This function, called exclusively by RT's autohandler, dispatches
+a request to the page a user requested (but only if it matches the "noauth" regex.
+
+If it serves a page, it stops mason processing. Otherwise, mason just keeps running through the autohandler
+
+=cut
+
+sub MaybeShowNoAuthPage {
+ my $ARGS = shift;
+
+ my $m = $HTML::Mason::Commands::m;
+
+ 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.
+ $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
+a request to the page a user requested (making sure that unpriviled users
+can only see self-service pages.
+
+=cut
+
+sub ShowRequestedPage {
+ my $ARGS = shift;
+
+ 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 =~ m{^(/+)Ticket/Display.html} && $ARGS->{'id'} ) {
+ RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/Display.html?id=" . $ARGS->{'id'} );
+ }
+
+ # otherwise, drop the user at the SelfService default page
+ elsif ( $m->base_comp->path !~ RT->Config->Get('SelfServiceRegex') ) {
+ RT::Interface::Web::Redirect( RT->Config->Get('WebURL') . "SelfService/" );
+ }
+
+ # if user is in SelfService dir let him do anything
+ else {
+ $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
+ }
+ } else {
+ $m->comp( { base_comp => $m->request_comp }, $m->fetch_next, %$ARGS );
+ }
+
+}
+
+sub AttemptExternalAuth {
+ my $ARGS = shift;
+
+ return unless ( RT->Config->Get('WebRemoteUserAuth') );
+
+ my $user = $ARGS->{user};
+ my $m = $HTML::Mason::Commands::m;
+
+ my $logged_in_external_user = _UserLoggedIn() && $HTML::Mason::Commands::session{'WebExternallyAuthed'};
+
+ # If RT is configured for external auth, let's go through and get REMOTE_USER
+
+ # Do we actually have a REMOTE_USER or equivalent? We only check auth if
+ # 1) we have no logged in user, or 2) we have a user who is externally
+ # authed. If we have a logged in user who is internally authed, don't
+ # check remote user otherwise we may log them out.
+ if (RT::Interface::Web::WebCanonicalizeInfo()
+ and (not _UserLoggedIn() or $logged_in_external_user) )
+ {
+ $user = RT::Interface::Web::WebCanonicalizeInfo();
+ my $load_method = RT->Config->Get('WebRemoteUserGecos') ? 'LoadByGecos' : 'Load';
+
+ 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('WebRemoteUserAutocreate') and not _UserLoggedIn() ) {
+
+ # Create users on-the-fly
+ my $UserObj = RT::User->new(RT->SystemUser);
+ my ( $val, $msg ) = $UserObj->Create(
+ %{ ref RT->Config->Get('UserAutocreateDefaultsOnLogin') ? RT->Config->Get('UserAutocreateDefaultsOnLogin') : {} },
+ Name => $user,
+ Gecos => $user,
+ );
+
+ if ($val) {
+
+ # now get user specific information, to better create our user.
+ my $new_user_info = RT::Interface::Web::WebRemoteUserAutocreateInfo($user);
+
+ # set the attributes that have been defined.
+ foreach my $attribute ( $UserObj->WritableAttributes, qw(Privileged Disabled) ) {
+ $m->callback(
+ Attribute => $attribute,
+ User => $user,
+ UserInfo => $new_user_info,
+ CallbackName => 'NewUser',
+ CallbackPage => '/autohandler'
+ );
+ my $method = "Set$attribute";
+ $UserObj->$method( $new_user_info->{$attribute} ) if defined $new_user_info->{$attribute};
+ }
+ $HTML::Mason::Commands::session{'CurrentUser'}->Load($user);
+ } else {
+ RT->Logger->error("Couldn't auto-create user '$user' when attempting WebRemoteUser: $msg");
+ AbortExternalAuth( Error => "UserAutocreateDefaultsOnLogin" );
+ }
+ }
+
+ if ( _UserLoggedIn() ) {
+ $HTML::Mason::Commands::session{'WebExternallyAuthed'} = 1;
+ $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 {
+ # Couldn't auth with the REMOTE_USER provided because an RT
+ # user doesn't exist and we're configured not to create one.
+ RT->Logger->error("Couldn't find internal user for '$user' when attempting WebRemoteUser and RT is not configured for auto-creation. Refer to `perldoc $RT::BasePath/docs/authentication.pod` if you want to allow auto-creation.");
+ AbortExternalAuth(
+ Error => "NoInternalUser",
+ User => $user,
+ );
+ }
+ }
+ elsif ($logged_in_external_user) {
+ # The logged in external user was deauthed by the auth system and we
+ # should kick them out.
+ AbortExternalAuth( Error => "Deauthorized" );
+ }
+ elsif (not RT->Config->Get('WebFallbackToRTLogin')) {
+ # Abort if we don't want to fallback internally
+ AbortExternalAuth( Error => "NoRemoteUser" );
+ }
+}
+
+sub AbortExternalAuth {
+ my %args = @_;
+ my $error = $args{Error} ? "/Errors/WebRemoteUser/$args{Error}" : undef;
+ my $m = $HTML::Mason::Commands::m;
+ my $r = $HTML::Mason::Commands::r;
+
+ _ForceLogout();
+
+ # Clear the decks, not that we should have partial content.
+ $m->clear_buffer;
+
+ $r->status(403);
+ $m->comp($error, %args)
+ if $error and $m->comp_exists($error);
+
+ # Return a 403 Forbidden or we may fallback to a login page with no form
+ $m->abort(403);
+}
+
+sub AttemptPasswordAuthentication {
+ my $ARGS = shift;
+ return unless defined $ARGS->{user} && defined $ARGS->{pass};
+
+ my $user_obj = RT::CurrentUser->new();
+ $user_obj->Load( $ARGS->{user} );
+
+ my $m = $HTML::Mason::Commands::m;
+
+ unless ( $user_obj->id && $user_obj->IsPassword( $ARGS->{pass} ) ) {
+ $RT::Logger->error("FAILED LOGIN for @{[$ARGS->{user}]} from $ENV{'REMOTE_ADDR'}");
+ $m->callback( %$ARGS, CallbackName => 'FailedLogin', CallbackPage => '/autohandler' );
+ 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', RedirectTo => \$next );
+
+ # 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'));
+ }
+
+ return (1, HTML::Mason::Commands::loc('Logged in'));
+ }
+}
+
+=head2 LoadSessionFromCookie
+
+Load or setup a session cookie for the current user.
+
+=cut
+
+sub _SessionCookieName {
+ my $cookiename = "RT_SID_" . RT->Config->Get('rtname');
+ $cookiename .= "." . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'};
+ return $cookiename;
+}
+
+sub LoadSessionFromCookie {
+
+ my %cookies = CGI::Cookie->fetch;
+ my $cookiename = _SessionCookieName();
+ 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 ) {
+ InstantiateNewSession();
+ }
+ if ( int RT->Config->Get('AutoLogoff') ) {
+ my $now = int( time / 60 );
+ my $last_update = $HTML::Mason::Commands::session{'_session_last_update'} || 0;
+
+ if ( $last_update && ( $now - $last_update - RT->Config->Get('AutoLogoff') ) > 0 ) {
+ InstantiateNewSession();
+ }
+
+ # save session on each request when AutoLogoff is turned on
+ $HTML::Mason::Commands::session{'_session_last_update'} = $now if $now != $last_update;
+ }
+}
+
+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 ),
+ -httponly => ( RT->Config->Get('WebHttpOnlyCookies') ? 1 : 0 ),
+ );
+
+ $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'} = $cookie->as_string;
+}
+
+=head2 GetWebURLFromRequest
+
+People may use different web urls instead of C<$WebURL> in config.
+Return the web url current user is using.
+
+=cut
+
+sub GetWebURLFromRequest {
+
+ my $uri = URI->new( RT->Config->Get('WebURL') );
+
+ if ( defined $ENV{HTTPS} and $ENV{'HTTPS'} eq 'on' ) {
+ $uri->scheme('https');
+ }
+ else {
+ $uri->scheme('http');
+ }
+
+ # [rt3.fsck.com #12716] Apache recommends use of $SERVER_HOST
+ $uri->host( $ENV{'SERVER_HOST'} || $ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} );
+ $uri->port( $ENV{'SERVER_PORT'} );
+ return "$uri"; # stringify to be consistent with WebURL in config
+}
+
+=head2 Redirect URL
+
+This routine ells the current user's browser to redirect to URL.
+Additionally, it unties the user's currently active session, helping to avoid
+A bug in Apache::Session 1.81 and earlier which clobbers sessions if we try to use
+a cached DBI statement handle twice at the same time.
+
+=cut
+
+sub Redirect {
+ my $redir_to = shift;
+ untie $HTML::Mason::Commands::session;
+ my $uri = URI->new($redir_to);
+ 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::CanonicalizeRedirectURLs is true
+ if ( !RT->Config->Get('CanonicalizeRedirectURLs')
+ && $uri->host eq $server_uri->host
+ && $uri->port eq $server_uri->port )
+ {
+ my $env_uri = URI->new(GetWebURLFromRequest());
+ $uri->scheme($env_uri->scheme);
+ $uri->host($env_uri->host);
+ $uri->port($env_uri->port);
+ }
+
+ # not sure why, but on some systems without this call mason doesn't
+ # set status to 302, but 200 instead and people see blank pages
+ $HTML::Mason::Commands::r->status(302);
+
+ # Perlbal expects a status message, but Mason's default redirect status
+ # doesn't provide one. See also rt.cpan.org #36689.
+ $HTML::Mason::Commands::m->redirect( $uri->canonical, "302 Found" );
+
+ $HTML::Mason::Commands::m->abort;
+}
+
+=head2 GetStaticHeaders
+
+return an arrayref of Headers (currently, Cache-Control and Expires).
+
+=cut
+
+sub GetStaticHeaders {
+ 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'
+ ;
+
+ my $expires = RT::Date->new(RT->SystemUser);
+ $expires->SetToNow;
+ $expires->AddSeconds( $args{Time} ) if $args{Time};
+
+ return [
+ Expires => $expires->RFC2616,
+ 'Cache-Control' => $CacheControl,
+ ];
+}
+
+=head2 CacheControlExpiresHeaders
+
+set both Cache-Control and Expires http headers
+
+=cut
+
+sub CacheControlExpiresHeaders {
+ Plack::Util::header_iter( GetStaticHeaders(@_), sub {
+ my ( $key, $val ) = @_;
+ $HTML::Mason::Commands::r->headers_out->{$key} = $val;
+ } );
+}
+
+=head2 StaticFileHeaders
+
+Send the browser a few headers to try to get it to (somewhat agressively)
+cache RT's static Javascript and CSS files.
+
+This routine could really use _accurate_ heuristics. (XXX TODO)
+
+=cut
+
+sub StaticFileHeaders {
+ # 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.
+ CacheControlExpiresHeaders( Time => 'forever' );
+}
+
+=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
+the path is safely within RT's control or not. The path I<must> be
+relative.
+
+This function does not consult the filesystem at all; it is merely
+a logical sanity checking of the path. This explicitly does not handle
+symlinks; if you have symlinks in RT's webroot pointing outside of it,
+then we assume you know what you are doing.
+
+=cut
+
+sub PathIsSafe {
+ my $self = shift;
+ my %args = @_;
+ my $path = $args{Path};
+
+ # Get File::Spec to clean up extra /s, ./, etc
+ my $cleaned_up = File::Spec->canonpath($path);
+
+ if (!defined($cleaned_up)) {
+ $RT::Logger->info("Rejecting path that canonpath doesn't understand: $path");
+ return 0;
+ }
+
+ # Forbid too many ..s. We can't just sum then check because
+ # "../foo/bar/baz" should be illegal even though it has more
+ # downdirs than updirs. So as soon as we get a negative score
+ # (which means "breaking out" of the top level) we reject the path.
+
+ my @components = split '/', $cleaned_up;
+ my $score = 0;
+ for my $component (@components) {
+ if ($component eq '..') {
+ $score--;
+ if ($score < 0) {
+ $RT::Logger->info("Rejecting unsafe path: $path");
+ return 0;
+ }
+ }
+ elsif ($component eq '.' || $component eq '') {
+ # these two have no effect on $score
+ }
+ else {
+ $score++;
+ }
+ }
+
+ return 1;
+}
+
+=head2 SendStaticFile
+
+Takes a File => path and a Type => Content-type
+
+If Type isn't provided and File is an image, it will
+figure out a sane Content-type, otherwise it will
+send application/octet-stream
+
+Will set caching headers using StaticFileHeaders
+
+=cut
+
+sub SendStaticFile {
+ my $self = shift;
+ my %args = @_;
+ my $file = $args{File};
+ my $type = $args{Type};
+ my $relfile = $args{RelativeFile};
+
+ if (defined($relfile) && !$self->PathIsSafe(Path => $relfile)) {
+ $HTML::Mason::Commands::r->status(400);
+ $HTML::Mason::Commands::m->abort;
+ }
+
+ $self->StaticFileHeaders();
+
+ unless ($type) {
+ if ( $file =~ /\.(gif|png|jpe?g)$/i ) {
+ $type = "image/$1";
+ $type =~ s/jpg/jpeg/gi;
+ }
+ $type ||= "application/octet-stream";
+ }
+ $HTML::Mason::Commands::r->content_type($type);
+ open( my $fh, '<', $file ) or die "couldn't open file: $!";
+ binmode($fh);
+ {
+ local $/ = \16384;
+ $HTML::Mason::Commands::m->out($_) while (<$fh>);
+ $HTML::Mason::Commands::m->flush_buffer;
+ }
+ 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};
+ return '' unless $content;
+
+ # Make the content have no 'weird' newlines in it
+ $content =~ s/\r+\n/\n/g;
+
+ my $return_content = $content;
+
+ my $html = $args{ContentType} && $args{ContentType} eq "text/html";
+ my $sigonly = $args{StripSignature};
+
+ # massage content to easily detect if there's any real content
+ $content =~ s/\s+//g; # yes! remove all the spaces
+ if ( $html ) {
+ # remove html version of spaces and newlines
+ $content =~ s! !!g;
+ $content =~ s!<br/?>!!g;
+ }
+
+ # Filter empty content when type is text/html
+ return '' if $html && $content !~ /\S/;
+
+ # If we aren't supposed to strip the sig, just bail now.
+ return $return_content unless $sigonly;
+
+ # Find the signature
+ my $sig = $args{'CurrentUser'}->UserObj->Signature || '';
+ $sig =~ s/\s+//g;
+
+ # Check for plaintext sig
+ return '' if not $html and $content =~ /^(--)?\Q$sig\E$/;
+
+ # Check for html-formatted sig; we don't use EscapeHTML 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 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::decode( 'UTF-8', $_, Encode::FB_PERLQQ )
+ : ( $type eq 'ARRAY' )
+ ? [ map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } @$_ ]
+ : ( $type eq 'HASH' )
+ ? { map { ref($_) ? $_ : Encode::decode( 'UTF-8', $_, Encode::FB_PERLQQ ) } %$_ }
+ : $_
+ } %$ARGS;
+}
+
+sub PreprocessTimeUpdates {
+ my $ARGS = shift;
+
+ # This code canonicalizes time inputs in hours into minutes
+ foreach my $field ( keys %$ARGS ) {
+ next unless $field =~ /^(.*)-TimeUnits$/i && $ARGS->{$1};
+ my $local = $1;
+ $ARGS->{$local} =~ s{\b (?: (\d+) \s+ )? (\d+)/(\d+) \b}
+ {($1 || 0) + $3 ? $2 / $3 : 0}xe;
+ if ( $ARGS->{$field} && $ARGS->{$field} =~ /hours/i ) {
+ $ARGS->{$local} *= 60;
+ }
+ delete $ARGS->{$field};
+ }