diff options
author | Branislav ZahradnĂk <happy.barney@gmail.com> | 2020-11-14 12:43:53 +0100 |
---|---|---|
committer | Olaf Alders <olaf@wundersolutions.com> | 2022-10-06 12:43:34 -0400 |
commit | 1a4ed66802f26c15cccd66c0b5d489cf9f3e3ba4 (patch) | |
tree | af746531ddbcc272a224a2f3575d3e4ea59c6572 | |
parent | a7b6af5abc646eabe7e57d6049d0ce672f87eeec (diff) | |
download | uri-1a4ed66802f26c15cccd66c0b5d489cf9f3e3ba4.tar.gz |
Improve escaping of unwanted characters
Fixes #74
-rw-r--r-- | lib/URI/Escape.pm | 9 | ||||
-rw-r--r-- | t/escape.t | 56 |
2 files changed, 63 insertions, 2 deletions
diff --git a/lib/URI/Escape.pm b/lib/URI/Escape.pm index d434488..cec5d56 100644 --- a/lib/URI/Escape.pm +++ b/lib/URI/Escape.pm @@ -163,7 +163,14 @@ sub uri_escape { if (defined $patn){ unless (exists $subst{$patn}) { # Because we can't compile the regex we fake it with a cached sub - (my $tmp = $patn) =~ s,/,\\/,g; + my @parts = $patn =~ m/( + (?: ^ \^? -? ) + | (?: .-. ) + | (?: \[:[^:]+:\] ) + | . + )/gx; + + my $tmp = join '', shift @parts, map { length > 1 ? $_ : quotemeta } @parts; eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }"; Carp::croak("uri_escape: $@") if $@; } @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 12; +use Test::More tests => 21; use URI::Escape qw( %escapes uri_escape uri_escape_utf8 uri_unescape ); @@ -19,6 +19,60 @@ is uri_unescape("%7Cabc%e5"), "|abcĺ"; is_deeply [uri_unescape("%40A%42", "CDE", "F%47H")], [qw(@AB CDE FGH)]; +is + uri_escape ('/', '/'), + '%2F', + 'it should accept slash in unwanted characters', + ; + +is + uri_escape ('][', ']['), + '%5D%5B', + 'it should accept regex char group terminator in unwanted characters', + ; + +is + uri_escape ('[]\\', '][\\'), + '%5B%5D%5C', + 'it should accept regex escape character at the end of unwanted characters', + ; + +is + uri_escape ('[]\\${}', '][\\${`kill -0 -1`}'), + '%5B%5D%5C%24%7B%7D', + 'it should recognize scalar interpolation injection in unwanted characters', + ; + +is + uri_escape ('[]\\@{}', '][\\@{`kill -0 -1`}'), + '%5B%5D%5C%40%7B%7D', + 'it should recognize array interpolation injection in unwanted characters', + ; + +is + uri_escape ('[]\\%{}', '][\\%{`kill -0 -1`}'), + '%5B%5D%5C%25%7B%7D', + 'it should recognize hash interpolation injection in unwanted characters', + ; + +is + uri_escape ('a-b', '-bc'), + 'a%2D%62', + 'it should recognize leading minus', + ; + +is + uri_escape ('a-b', '^-bc'), + '%61-b', + 'it should recognize leading ^-' + ; + +is + uri_escape ('a-b-1', '[:alpha:][:digit:]'), + '%61-%62-%31', + 'it should recognize character groups' + ; + is $escapes{"%"}, "%25"; is uri_escape_utf8("|abcĺ"), "%7Cabc%C3%A5"; |