+sub StaticRoots {
+ my $self = shift;
+ my @static = (
+ $RT::LocalStaticPath,
+ (map { $_->StaticDir } @{RT->Plugins}),
+ $RT::StaticPath,
+ );
+ return grep { $_ and -d $_ } @static;
+}
+
+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,
+ '/User/Search.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,
+);
+
+# Whitelist arguments that do not indicate an effectful request.
+our @GLOBAL_WHITELISTED_ARGS = (
+ # For example, "id" is acceptable because that is how RT retrieves a
+ # record.
+ 'id',
+
+ # If they have a results= from MaybeRedirectForResults, that's also fine.
+ '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
+ '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.
+ 'NotMobile',
+);
+
+our %WHITELISTED_COMPONENT_ARGS = (
+ # SavedSearchLoad - This happens when you middle-(or ⌘ )-click "Edit" for a saved search on
+ # the homepage. It's not going to do any damage
+ # NewQuery - This is simply to clear the search query
+ '/Search/Build.html' => ['SavedSearchLoad','NewQuery'],
+ # Happens if you try and reply to a message in the ticket history or click a number
+ # of options on a tickets Action menu
+ '/Ticket/Update.html' => ['QuoteTransaction', 'Action', 'DefaultStatus'],
+ # Action->Extract Article on a ticket's menu
+ '/Articles/Article/ExtractIntoClass.html' => ['Ticket'],
+);
+
+# 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};
+
+ if ( my %csrf_config = RT->Config->Get('ReferrerComponents') ) {
+ my $value = $csrf_config{$comp};
+ if ( ref $value eq 'ARRAY' ) {
+ delete $args{$_} for @$value;
+ return %args ? 0 : 1;
+ }
+ else {
+ return $value ? 1 : 0;
+ }
+ }
+
+ return AreCompCSRFParametersWhitelisted($comp, \%args);
+}
+
+sub AreCompCSRFParametersWhitelisted {
+ my $sub = shift;
+ my $ARGS = shift;
+
+ my %leftover_args = %{ $ARGS };
+
+ # Join global whitelist and component-specific whitelist
+ my @whitelisted_args = (@GLOBAL_WHITELISTED_ARGS, @{ $WHITELISTED_COMPONENT_ARGS{$sub} || [] });
+
+ for my $arg (@whitelisted_args) {
+ delete $leftover_args{$arg};
+ }
+
+ # If there are no arguments, then it's likely to be an idempotent
+ # request, which are not susceptible to CSRF
+ return !%leftover_args;
+}
+
+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'}{$ARGS->{'Token'}||''}{$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'};
+
+ # This needs to be decoded because the value is a reference;
+ # hence it was not decoded along with all of the standard
+ # arguments in DecodeARGS
+ $data->{attach} = {
+ filename => Encode::decode("UTF-8", "$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 "";
+}
+
+=head2 RewriteInlineImages PARAMHASH
+
+Turns C<< <img src="cid:..."> >> elements in HTML into working images pointing
+back to RT's stored copy.
+
+Takes the following parameters:
+
+=over 4
+
+=item Content
+
+Scalar ref of the HTML content to rewrite. Modified in place to support the
+most common use-case.
+
+=item Attachment
+
+The L<RT::Attachment> object from which the Content originates.
+
+=item Related (optional)
+
+Array ref of related L<RT::Attachment> objects to use for C<Content-ID> matching.
+
+Defaults to the result of the C<Siblings> method on the passed Attachment.
+
+=item AttachmentPath (optional)
+
+The base path to use when rewriting C<src> attributes.
+
+Defaults to C< $WebPath/Ticket/Attachment >
+
+=back
+
+In scalar context, returns the number of elements rewritten.
+
+In list content, returns the attachments IDs referred to by the rewritten <img>
+elements, in the order found. There may be duplicates.
+
+=cut
+
+sub RewriteInlineImages {
+ my %args = (
+ Content => undef,
+ Attachment => undef,
+ Related => undef,
+ AttachmentPath => RT->Config->Get('WebPath')."/Ticket/Attachment",
+ @_
+ );
+
+ return unless defined $args{Content}
+ and ref $args{Content} eq 'SCALAR'
+ and defined $args{Attachment};
+
+ my $related_part = $args{Attachment}->Closest("multipart/related")
+ or return;
+
+ $args{Related} ||= $related_part->Children->ItemsArrayRef;
+ return unless @{$args{Related}};
+
+ my $content = $args{'Content'};
+ my @rewritten;
+
+ require HTML::RewriteAttributes::Resources;
+ $$content = HTML::RewriteAttributes::Resources->rewrite($$content, sub {
+ my $cid = shift;
+ my %meta = @_;
+ return $cid unless lc $meta{tag} eq 'img'
+ and lc $meta{attr} eq 'src'
+ and $cid =~ s/^cid://i;
+
+ for my $attach (@{$args{Related}}) {
+ if (($attach->GetHeader('Content-ID') || '') =~ /^(<)?\Q$cid\E(?(1)>)$/) {
+ push @rewritten, $attach->Id;
+ return "$args{AttachmentPath}/" . $attach->TransactionId . '/' . $attach->Id;
+ }
+ }
+
+ # No attachments means this is a bogus CID. Just pass it through.
+ RT->Logger->debug(qq[Found bogus inline image src="cid:$cid"]);
+ return "cid:$cid";
+ });
+ return @rewritten;
+}
+
+=head2 GetCustomFieldInputName(CustomField => $cf_object, Object => $object, Grouping => $grouping_name)
+
+Returns the standard custom field input name; this is complementary to
+L</_ParseObjectCustomFieldArgs>. Takes the following arguments:
+
+=over
+
+=item CustomField => I<L<RT::CustomField> object>
+
+Required.
+
+=item Object => I<object>
+
+The object that the custom field is applied to; optional. If omitted,
+defaults to a new object of the appropriate class for the custom field.
+
+=item Grouping => I<CF grouping>
+
+The grouping that the custom field is being rendered in. Groupings
+allow a custom field to appear in more than one location per form.
+
+=back
+
+=cut
+
+sub GetCustomFieldInputName {
+ my %args = (
+ CustomField => undef,
+ Object => undef,
+ Grouping => undef,
+ @_,
+ );
+
+ my $name = GetCustomFieldInputNamePrefix(%args);
+
+ if ( $args{CustomField}->Type eq 'Select' ) {
+ if ( $args{CustomField}->RenderType eq 'List' and $args{CustomField}->SingleValue ) {
+ $name .= 'Value';
+ }
+ else {
+ $name .= 'Values';
+ }
+ }
+ elsif ( $args{CustomField}->Type =~ /^(?:Binary|Image)$/ ) {
+ $name .= 'Upload';
+ }
+ elsif ( $args{CustomField}->Type =~ /^(?:Date|DateTime|Text|Wikitext)$/ ) {
+ $name .= 'Values';
+ }
+ else {
+ if ( $args{CustomField}->SingleValue ) {
+ $name .= 'Value';
+ }
+ else {
+ $name .= 'Values';
+ }
+ }
+
+ return $name;
+}
+
+=head2 GetCustomFieldInputNamePrefix(CustomField => $cf_object, Object => $object, Grouping => $grouping_name)
+
+Returns the standard custom field input name prefix(without "Value" or alike suffix)
+
+=cut
+
+sub GetCustomFieldInputNamePrefix {
+ my %args = (
+ CustomField => undef,
+ Object => undef,
+ Grouping => undef,
+ @_,
+ );
+
+ my $prefix = join '-', 'Object', ref( $args{Object} ) || $args{CustomField}->ObjectTypeFromLookupType,
+ ( $args{Object} && $args{Object}->id ? $args{Object}->id : '' ),
+ 'CustomField' . ( $args{Grouping} ? ":$args{Grouping}" : '' ),
+ $args{CustomField}->id, '';
+
+ return $prefix;
+}
+