X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=rt%2Flib%2FRT%2FInterface%2FWeb.pm;h=409cbdc4591ef241f05cafef2d2b0dfdedf0f7e4;hb=9ecdd3410e3b41791e4d444a9c29157b5dbbe2bb;hp=7c9d578219f1db20d686d964dfbc7883926b4ac9;hpb=345d50ec6b65ace29bfaf4a7373d1dbec1d72831;p=freeside.git diff --git a/rt/lib/RT/Interface/Web.pm b/rt/lib/RT/Interface/Web.pm index 7c9d57821..409cbdc45 100644 --- a/rt/lib/RT/Interface/Web.pm +++ b/rt/lib/RT/Interface/Web.pm @@ -2,7 +2,7 @@ # # COPYRIGHT: # -# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC +# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC # # # (Except where explicitly superseded by other copyright notices) @@ -158,6 +158,25 @@ 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(); Different web servers set different environmental varibles. This @@ -234,13 +253,24 @@ sub HandleRequest { 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' ); @@ -256,6 +286,10 @@ sub HandleRequest { # 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(); @@ -266,25 +300,31 @@ sub HandleRequest { my $m = $HTML::Mason::Commands::m; # REST urls get a special 401 response - if ($m->request_comp->path =~ '^/REST/\d+\.\d+/') { + if ($m->request_comp->path =~ m{^/REST/\d+\.\d+/}) { $HTML::Mason::Commands::r->content_type("text/plain"); $m->error_format("text"); $m->out("RT/$RT::VERSION 401 Credentials required\n"); $m->out("\n$msg\n") if $msg; $m->abort; } - # Specially handle /index.html so that we get a nicer URL - elsif ( $m->request_comp->path eq '/index.html' ) { - my $next = SetNextPage(RT->Config->Get('WebURL')); - $m->comp('/NoAuth/Login.html', next => $next, actions => [$msg]); + # Specially handle /index.html and /m/index.html so that we get a nicer URL + elsif ( $m->request_comp->path =~ m{^(/m)?/index\.html$} ) { + my $mobile = $1 ? 1 : 0; + my $next = SetNextPage($ARGS); + $m->comp('/NoAuth/Login.html', + next => $next, + actions => [$msg], + mobile => $mobile); $m->abort; } else { - TangentForLogin(results => ($msg ? LoginError($msg) : undef)); + TangentForLogin($ARGS, results => ($msg ? LoginError($msg) : undef)); } } } + 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'} ); @@ -294,7 +334,7 @@ sub HandleRequest { ShowRequestedPage($ARGS); LogRecordedSQLStatements(RequestData => { - Path => $HTML::Mason::Commands::m->request_comp->path, + Path => $HTML::Mason::Commands::m->request_path, }); # Process per-page final cleanup callbacks @@ -333,7 +373,7 @@ sub LoginError { return $key; } -=head2 SetNextPage [PATH] +=head2 SetNextPage ARGSRef [PATH] Intuits and stashes the next page in the sesssion hash. If PATH is specified, uses that instead of the value of L. Returns @@ -342,27 +382,73 @@ the hash value. =cut sub SetNextPage { - my $next = shift || IntuitNextPage(); + my $ARGS = shift; + my $next = $_[0] ? $_[0] : IntuitNextPage(); my $hash = Digest::MD5::md5_hex($next . $$ . rand(1024)); + my $page = { url => $next }; + + # If an explicit URL was passed and we didn't IntuitNextPage, then + # IsPossibleCSRF below is almost certainly unrelated to the actual + # destination. Currently explicit next pages aren't used in RT, but the + # API is available. + if (not $_[0] and RT->Config->Get("RestrictReferrer")) { + # This isn't really CSRF, but the CSRF heuristics are useful for catching + # requests which may have unintended side-effects. + my ($is_csrf, $msg, @loc) = IsPossibleCSRF($ARGS); + if ($is_csrf) { + RT->Logger->notice( + "Marking original destination as having side-effects before redirecting for login.\n" + ."Request: $next\n" + ."Reason: " . HTML::Mason::Commands::loc($msg, @loc) + ); + $page->{'HasSideEffects'} = [$msg, @loc]; + } + } - $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $next; + $HTML::Mason::Commands::session{'NextPage'}->{$hash} = $page; $HTML::Mason::Commands::session{'i'}++; - - SendSessionCookie(); 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. -=head2 TangentForLogin [HASH] +=cut + +sub RemoveNextPage { + my $hash = shift || ""; + return delete $HTML::Mason::Commands::session{'NextPage'}->{$hash}; +} + +=head2 TangentForLogin ARGSRef [HASH] Redirects to C, setting the value of L as -the next page. Optionally takes a hash which is dumped into query params. +the next page. Takes a hashref of request %ARGS as the first parameter. +Optionally takes all other parameters as a hash which is dumped into query +params. =cut sub TangentForLogin { - my $hash = SetNextPage(); + my $ARGS = shift; + my $hash = SetNextPage($ARGS); my %query = (@_, next => $hash); + + $query{mobile} = 1 + if $HTML::Mason::Commands::m->request_comp->path =~ m{^/m(/|$)}; + my $login = RT->Config->Get('WebURL') . 'NoAuth/Login.html?'; $login .= $HTML::Mason::Commands::m->comp('/Elements/QueryString', %query); Redirect($login); @@ -376,8 +462,9 @@ calls L with the appropriate results key. =cut sub TangentForLoginWithError { - my $key = LoginError(HTML::Mason::Commands::loc(@_)); - TangentForLogin( results => $key ); + my $ARGS = shift; + my $key = LoginError(HTML::Mason::Commands::loc(@_)); + TangentForLogin( $ARGS, results => $key ); } =head2 IntuitNextPage @@ -436,7 +523,7 @@ sub MaybeShowInstallModePage { 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(); @@ -465,7 +552,6 @@ sub MaybeShowNoAuthPage { 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; } @@ -490,9 +576,10 @@ sub MaybeRejectPrivateComponentRequest { / # leading slash ( Elements | _elements | # mobile UI + Callbacks | Widgets | autohandler | # requesting this directly is suspicious - l ) # loc component + l (_unsafe)? ) # loc component ( $ | / ) # trailing slash or end of path }xi && $path !~ m{ /RTx/Statistics/\w+/Elements/Chart }xi @@ -526,18 +613,18 @@ sub ShowRequestedPage { 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 ); - InitializeMenu(); - - SendSessionCookie(); - # 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'} ); } @@ -578,7 +665,8 @@ sub AttemptExternalAuth { $user =~ s/^\Q$NodeName\E\\//i; } - my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''}; + my $next = RemoveNextPage($ARGS->{'next'}); + $next = $next->{'url'} if ref $next; InstantiateNewSession() unless _UserLoggedIn; $HTML::Mason::Commands::session{'CurrentUser'} = RT::CurrentUser->new(); $HTML::Mason::Commands::session{'CurrentUser'}->$load_method($user); @@ -617,7 +705,7 @@ sub AttemptExternalAuth { delete $HTML::Mason::Commands::session{'CurrentUser'}; if (RT->Config->Get('WebFallbackToInternalAuth')) { - TangentForLoginWithError('Cannot create user: [_1]', $msg); + TangentForLoginWithError($ARGS, 'Cannot create user: [_1]', $msg); } else { $m->abort(); } @@ -639,14 +727,14 @@ sub AttemptExternalAuth { delete $HTML::Mason::Commands::session{'CurrentUser'}; $user = $orig_user; - if ( RT->Config->Get('WebExternalOnly') ) { - TangentForLoginWithError('You are not an authorized user'); + unless ( RT->Config->Get('WebFallbackToInternalAuth') ) { + TangentForLoginWithError($ARGS, 'You are not an authorized user'); } } } elsif ( RT->Config->Get('WebFallbackToInternalAuth') ) { unless ( defined $HTML::Mason::Commands::session{'CurrentUser'} ) { # XXX unreachable due to prior defaulting in HandleRequest (check c34d108) - TangentForLoginWithError('You are not an authorized user'); + TangentForLoginWithError($ARGS, 'You are not an authorized user'); } } else { @@ -677,11 +765,11 @@ sub AttemptPasswordAuthentication { # It's important to nab the next page from the session before we blow # the session away - my $next = delete $HTML::Mason::Commands::session{'NextPage'}->{$ARGS->{'next'} || ''}; + my $next = RemoveNextPage($ARGS->{'next'}); + $next = $next->{'url'} if ref $next; InstantiateNewSession(); $HTML::Mason::Commands::session{'CurrentUser'} = $user_obj; - SendSessionCookie(); $m->callback( %$ARGS, CallbackName => 'SuccessfulLogin', CallbackPage => '/autohandler' ); @@ -718,7 +806,7 @@ sub 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 ); @@ -736,6 +824,7 @@ sub LoadSessionFromCookie { 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 { @@ -763,7 +852,7 @@ sub Redirect { 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; @@ -802,6 +891,38 @@ sub Redirect { $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) @@ -814,12 +935,12 @@ This routine could really use _accurate_ heuristics. (XXX TODO) sub StaticFileHeaders { my $date = RT::Date->new(RT->SystemUser); - # make cache public - $HTML::Mason::Commands::r->headers_out->{'Cache-Control'} = 'max-age=259200, public'; + # remove any cookie headers -- if it is cached publicly, it + # shouldn't include anyone's cookie! + delete $HTML::Mason::Commands::r->err_headers_out->{'Set-Cookie'}; # Expire things in a month. - $date->Set( Value => time + 30 * 24 * 60 * 60 ); - $HTML::Mason::Commands::r->headers_out->{'Expires'} = $date->RFC2616; + CacheControlExpiresHeaders( Time => 'forever' ); # if we set 'Last-Modified' then browser request a comp using 'If-Modified-Since' # request, but we don't handle it and generate full reply again @@ -828,6 +949,22 @@ sub StaticFileHeaders { # $HTML::Mason::Commands::r->headers_out->{'Last-Modified'} = $date->RFC2616; } +=head2 ComponentPathIsSafe PATH + +Takes C 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 @@ -930,7 +1067,7 @@ 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)/io && !$HTML::Mason::Commands::session{'NotMobile'}) { +if (($ENV{'HTTP_USER_AGENT'} || '') =~ /(?:hiptop|Blazer|Novarra|Vagabond|SonyEricsson|Symbian|NetFront|UP.Browser|UP.Link|Windows CE|MIDP|J2ME|DoCoMo|J-PHONE|PalmOS|PalmSource|iPhone|iPod|AvantGo|Nokia|Android|WebOS|S60|Mobile)/io && !$HTML::Mason::Commands::session{'NotMobile'}) { return 1; } else { return undef; @@ -1092,32 +1229,35 @@ sub ValidateWebConfig { return if $_has_validated_web_config; $_has_validated_web_config = 1; - if (!$ENV{'rt.explicit_port'} && $ENV{SERVER_PORT} != RT->Config->Get('WebPort')) { - $RT::Logger->warn("The actual SERVER_PORT ($ENV{SERVER_PORT}) does NOT match the configured WebPort ($RT::WebPort). Perhaps you should Set(\$WebPort, $ENV{SERVER_PORT}); in RT_SiteConfig.pm, otherwise your internal links may be broken."); - } - - if ($ENV{HTTP_HOST}) { - # match "example.com" or "example.com:80" - my ($host) = $ENV{HTTP_HOST} =~ /^(.*?)(:\d+)?$/; + my $port = $ENV{SERVER_PORT}; + my $host = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER} + || $ENV{HTTP_HOST} || $ENV{SERVER_NAME}; + ($host, $port) = ($1, $2) if $host =~ /^(.*?):(\d+)$/; - if ($host ne RT->Config->Get('WebDomain')) { - $RT::Logger->warn("The actual HTTP_HOST ($host) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, otherwise your internal links may be broken."); - } + if ( $port != RT->Config->Get('WebPort') and not $ENV{'rt.explicit_port'}) { + $RT::Logger->warn("The requested port ($port) does NOT match the configured WebPort ($RT::WebPort). " + ."Perhaps you should Set(\$WebPort, $port); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); } - else { - if ($ENV{SERVER_NAME} ne RT->Config->Get('WebDomain')) { - $RT::Logger->warn("The actual SERVER_NAME ($ENV{SERVER_NAME}) does NOT match the configured WebDomain ($RT::WebDomain). Perhaps you should Set(\$WebDomain, '$ENV{SERVER_NAME}'); in RT_SiteConfig.pm, otherwise your internal links may be broken."); - } + + if ( $host ne RT->Config->Get('WebDomain') ) { + $RT::Logger->warn("The requested host ($host) does NOT match the configured WebDomain ($RT::WebDomain). " + ."Perhaps you should Set(\$WebDomain, '$host'); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); } - #i don't understand how this was ever expected to work - # (even without our dum double // hack)?? - #if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath')) { - ( my $WebPath = RT->Config->Get('WebPath') ) =~ s(/+)(/)g; - ( my $script_name = $ENV{SCRIPT_NAME} ) =~ s(/+)(/)g; - my $script_name_prefix = substr($script_name, 0, length($WebPath)); - if ( $script_name_prefix ne $WebPath ) { - $RT::Logger->warn("The actual SCRIPT_NAME ($script_name) does NOT match the configured WebPath ($WebPath). Perhaps you should Set(\$WebPath, '$script_name_prefix'); in RT_SiteConfig.pm, otherwise your internal links may be broken."); + return; #next warning flooding our logs, doesn't seem applicable to our use + # (SCRIPT_NAME is the full path, WebPath is just the beginning) + #in vanilla RT does something eat the local part of SCRIPT_NAME 1st? + + # Unfortunately, there is no reliable way to get the _path_ that was + # requested at the proxy level; simply disable this warning if we're + # proxied and there's a mismatch. + my $proxied = $ENV{HTTP_X_FORWARDED_HOST} || $ENV{HTTP_X_FORWARDED_SERVER}; + if ($ENV{SCRIPT_NAME} ne RT->Config->Get('WebPath') and not $proxied) { + $RT::Logger->warn("The requested path ($ENV{SCRIPT_NAME}) does NOT match the configured WebPath ($RT::WebPath). " + ."Perhaps you should Set(\$WebPath, '$ENV{SCRIPT_NAME}'); in RT_SiteConfig.pm, " + ."otherwise your internal links may be broken."); } } @@ -1138,6 +1278,282 @@ sub ComponentRoots { 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 chart) or bookmark a result page. + '/Search/Results.html' => 1, + '/Search/Simple.html' => 1, + '/m/tickets/search' => 1, + '/Search/Chart.html' => 1, + + # This page takes Attachment and Transaction argument to figure + # out what to show, but it's read only and will deny information if you + # don't have ShowOutgoingEmail. + '/Ticket/ShowEmailRecord.html' => 1, +); + +# Components which are blacklisted from automatic, argument-based whitelisting. +# These pages are not idempotent when called with just an id. +our %is_blacklisted_component = ( + # Takes only id and toggles bookmark state + '/Helpers/Toggle/TicketBookmark' => 1, +); + +sub IsCompCSRFWhitelisted { + 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 = < $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/; @@ -1348,6 +1764,7 @@ sub CreateTicket { Cc => $ARGS{'Cc'}, Body => $sigless, Type => $ARGS{'ContentType'}, + Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', ); if ( $ARGS{'Attachments'} ) { @@ -1355,7 +1772,7 @@ sub CreateTicket { $RT::Logger->error("Couldn't make multipart message") if !$rv || $rv !~ /^(?:DONE|ALREADY)$/; - foreach ( values %{ $ARGS{'Attachments'} } ) { + foreach ( map $ARGS{Attachments}->{$_}, sort keys %{ $ARGS{'Attachments'} } ) { unless ($_) { $RT::Logger->error("Couldn't add empty attachemnt"); next; @@ -1364,9 +1781,8 @@ sub CreateTicket { } } - foreach my $argument (qw(Encrypt Sign)) { - $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ) - if defined $ARGS{$argument}; + for my $argument (qw(Encrypt Sign)) { + $MIMEObj->head->replace( "X-RT-$argument" => $ARGS{$argument} ? 1 : 0 ); } my %create_args = ( @@ -1418,6 +1834,7 @@ sub CreateTicket { 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 ); @@ -1523,6 +1940,9 @@ is true. =cut +# change from stock: if txn custom fields are set but there's no content +# or attachment, create a Touch txn instead of doing nothing + sub ProcessUpdateMessage { my %args = ( @@ -1546,14 +1966,33 @@ sub ProcessUpdateMessage { CurrentUser => $args{'TicketObj'}->CurrentUser, ); - # If, after stripping the signature, we have no message, move the - # UpdateTimeWorked into adjusted TimeWorked, so that a later - # ProcessBasics can deal -- then bail out. + my %txn_customfields; + + foreach my $key ( keys %{ $args{ARGSRef} } ) { + if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) { + next if $key =~ /(TimeUnits|Magic)$/; + $txn_customfields{$key} = $args{ARGSRef}->{$key}; + } + } + + # If, after stripping the signature, we have no message, create a + # Touch transaction if necessary if ( not $args{ARGSRef}->{'UpdateAttachments'} and not length $args{ARGSRef}->{'UpdateContent'} ) { - if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) { - $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + delete $args{ARGSRef}->{'UpdateTimeWorked'}; + #if ( $args{ARGSRef}->{'UpdateTimeWorked'} ) { + # $args{ARGSRef}->{TimeWorked} = $args{TicketObj}->TimeWorked + + # delete $args{ARGSRef}->{'UpdateTimeWorked'}; + # } + + my $timetaken = $args{ARGSRef}->{'UpdateTimeWorked'}; + if ( $timetaken or grep {length $_} values %txn_customfields ) { + my ( $Transaction, $Description, $Object ) = + $args{TicketObj}->Touch( + CustomFields => \%txn_customfields, + TimeTaken => $timetaken + ); + return $Description; } return; } @@ -1566,6 +2005,7 @@ sub ProcessUpdateMessage { Subject => $args{ARGSRef}->{'UpdateSubject'}, Body => $args{ARGSRef}->{'UpdateContent'}, Type => $args{ARGSRef}->{'UpdateContentType'}, + Interface => RT::Interface::Web::MobileClient() ? 'Mobile' : 'Web', ); $Message->head->replace( 'Message-ID' => Encode::encode_utf8( @@ -1587,7 +2027,8 @@ sub ProcessUpdateMessage { if ( $args{ARGSRef}->{'UpdateAttachments'} ) { $Message->make_multipart; - $Message->add_part($_) foreach values %{ $args{ARGSRef}->{'UpdateAttachments'} }; + $Message->add_part($_) foreach map $args{ARGSRef}->{UpdateAttachments}{$_}, + sort keys %{ $args{ARGSRef}->{'UpdateAttachments'} }; } if ( $args{ARGSRef}->{'AttachTickets'} ) { @@ -1598,14 +2039,6 @@ sub ProcessUpdateMessage { : ( $args{ARGSRef}->{'AttachTickets'} ) ); } - my %txn_customfields; - - foreach my $key ( keys %{ $args{ARGSRef} } ) { - if ( $key =~ /^(?:Object-RT::Transaction--)?CustomField-(\d+)/ ) { - $txn_customfields{$key} = $args{ARGSRef}->{$key}; - } - } - my %message_args = ( Sign => ( $args{ARGSRef}->{'Sign'} ? 1 : 0 ), Encrypt => ( $args{ARGSRef}->{'Encrypt'} ? 1 : 0 ), @@ -1662,7 +2095,6 @@ sub _ProcessUpdateMessageRecipients { if (grep $_ eq 'Requestor' || $_ eq 'Requestors', @{ $args{ARGSRef}->{'SkipNotification'} || [] }) { push @txn_squelch, map $_->address, Email::Address->parse( $message_args->{Requestor} ); push @txn_squelch, $args{TicketObj}->Requestors->MemberEmailAddresses; - } push @txn_squelch, @{$args{ARGSRef}{SquelchMailTo}} if $args{ARGSRef}{SquelchMailTo}; @@ -1684,6 +2116,39 @@ sub _ProcessUpdateMessageRecipients { } } +sub ProcessAttachments { + my %args = ( + ARGSRef => {}, + @_ + ); + + my $ARGSRef = $args{ARGSRef} || {}; + # deal with deleting uploaded attachments + foreach my $key ( keys %$ARGSRef ) { + if ( $key =~ m/^DeleteAttach-(.+)$/ ) { + delete $session{'Attachments'}{$1}; + } + $session{'Attachments'} = { %{ $session{'Attachments'} || {} } }; + } + + # store the uploaded attachment in session + if ( defined $ARGSRef->{'Attach'} && length $ARGSRef->{'Attach'} ) + { # attachment? + my $attachment = MakeMIMEEntity( AttachmentFieldName => 'Attach' ); + + 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'}; + } +} + + =head2 MakeMIMEEntity PARAMHASH Takes a paramhash Subject, Body and AttachmentFieldName. @@ -1704,11 +2169,13 @@ sub MakeMIMEEntity { Body => undef, AttachmentFieldName => undef, Type => undef, + Interface => 'API', @_, ); my $Message = MIME::Entity->build( Type => 'multipart/mixed', - "Message-Id" => RT::Interface::Email::GenMessageId, + "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) ); @@ -1750,8 +2217,9 @@ sub MakeMIMEEntity { $Message->head->set( 'Subject' => $filename ); } - # Attachment parts really shouldn't get a Message-ID + # Attachment parts really shouldn't get a Message-ID or "interface" $Message->head->delete('Message-ID'); + $Message->head->delete('X-RT-Interface'); } } @@ -1857,19 +2325,8 @@ sub ProcessACLs { # Check if we want to grant rights to a previously rights-less user for my $type (qw(user group)) { - my $key = "AddPrincipalForRights-$type"; - - next unless $ARGSref->{$key}; - - my $principal; - if ( $type eq 'user' ) { - $principal = RT::User->new( $session{'CurrentUser'} ); - $principal->LoadByCol( Name => $ARGSref->{$key} ); - } - else { - $principal = RT::Group->new( $session{'CurrentUser'} ); - $principal->LoadUserDefinedGroup( $ARGSref->{$key} ); - } + my $principal = _ParseACLNewPrincipal($ARGSref, $type) + or next; unless ($principal->PrincipalId) { push @results, loc("Couldn't load the specified principal"); @@ -1969,7 +2426,34 @@ sub ProcessACLs { return (@results); } +=head2 _ParseACLNewPrincipal +Takes a hashref of C<%ARGS> and a principal type (C or C). 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 or L 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) @@ -2144,19 +2628,25 @@ sub ProcessTicketReminders { if ( $args->{'update-reminders'} ) { while ( my $reminder = $reminder_collection->Next ) { - if ( $reminder->Status ne 'resolved' && $args->{ 'Complete-Reminder-' . $reminder->id } ) { - $Ticket->Reminders->Resolve($reminder); + my $resolve_status = $reminder->QueueObj->Lifecycle->ReminderStatusOnResolve; + if ( $reminder->Status ne $resolve_status && $args->{ 'Complete-Reminder-' . $reminder->id } ) { + my ($status, $msg) = $Ticket->Reminders->Resolve($reminder); + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); + } - elsif ( $reminder->Status eq 'resolved' && !$args->{ 'Complete-Reminder-' . $reminder->id } ) { - $Ticket->Reminders->Open($reminder); + elsif ( $reminder->Status eq $resolve_status && !$args->{ 'Complete-Reminder-' . $reminder->id } ) { + my ($status, $msg) = $Ticket->Reminders->Open($reminder); + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); } if ( exists( $args->{ 'Reminder-Subject-' . $reminder->id } ) && ( $reminder->Subject ne $args->{ 'Reminder-Subject-' . $reminder->id } )) { - $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ; + my ($status, $msg) = $reminder->SetSubject( $args->{ 'Reminder-Subject-' . $reminder->id } ) ; + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); } if ( exists( $args->{ 'Reminder-Owner-' . $reminder->id } ) && ( $reminder->Owner != $args->{ 'Reminder-Owner-' . $reminder->id } )) { - $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ; + my ($status, $msg) = $reminder->SetOwner( $args->{ 'Reminder-Owner-' . $reminder->id } , "Force" ) ; + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); } if ( exists( $args->{ 'Reminder-Due-' . $reminder->id } ) && $args->{ 'Reminder-Due-' . $reminder->id } ne '' ) { @@ -2166,7 +2656,8 @@ sub ProcessTicketReminders { Value => $args->{ 'Reminder-Due-' . $reminder->id } ); if ( defined $DateObj->Unix && $DateObj->Unix != $reminder->DueObj->Unix ) { - $reminder->SetDue( $DateObj->ISO ); + my ($status, $msg) = $reminder->SetDue( $DateObj->ISO ); + push @results, loc("Reminder #[_1]: [_2]", $reminder->id, $msg); } } } @@ -2178,12 +2669,17 @@ sub ProcessTicketReminders { Format => 'unknown', Value => $args->{'NewReminder-Due'} ); - my ( $add_id, $msg, $txnid ) = $Ticket->Reminders->Add( + my ( $add_id, $msg ) = $Ticket->Reminders->Add( Subject => $args->{'NewReminder-Subject'}, Owner => $args->{'NewReminder-Owner'}, Due => $due_obj->ISO ); - push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); + if ( $add_id ) { + push @results, loc("Reminder '[_1]' added", $args->{'NewReminder-Subject'}); + } + else { + push @results, $msg; + } } return @results; } @@ -2239,6 +2735,7 @@ sub ProcessObjectCustomFieldUpdates { 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"); @@ -2518,6 +3015,7 @@ sub ProcessTicketDates { Starts Started Due + WillResolve ); #Run through each field in this list. update the value if apropriate @@ -2645,6 +3143,24 @@ sub ProcessRecordLinks { 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, @@ -2681,7 +3197,8 @@ sub GetColumnMapEntry { } # complex things - elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.{(.+)}$/ ) { + elsif ( my ( $mainkey, $subkey ) = $args{'Name'} =~ /^(.*?)\.(.+)$/ ) { + $subkey =~ s/^\{(.*)\}$/$1/; return undef unless $args{'Map'}->{$mainkey}; return $args{'Map'}{$mainkey}{ $args{'Attribute'} } unless ref $args{'Map'}{$mainkey}{ $args{'Attribute'} } eq 'CODE'; @@ -2851,50 +3368,71 @@ sub ScrubHTML { =head2 _NewScrubber -Returns a new L object. Override this if you insist on -letting more HTML through. +Returns a new L object. + +If you need to be more lax about what HTML tags and attributes are allowed, +create C 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, { - '*' => 0, - id => 1, - class => 1, - # Match http, ftp and relative urls - # XXX: we also scrub format strings with this module then allow simple config options - href => qr{^(?:http:|ftp:|https:|/|__Web(?:Path|BaseURL|URL)__)}i, - 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, - } + %SCRUBBER_ALLOWED_ATTRIBUTES, + '*' => 0, # require attributes be explicitly allowed + }, ); $scrubber->deny(qw[*]); - $scrubber->allow( - 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] - ); + $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;