test: add encoded protocol XSS regression tests for links/images

lib/MarkdownParser.pm

@@ -379,10 +379,22 @@ s/\x01F$i\x02/<$part->{tag}>@{[escape_html($part->{content})]}<\/$part->{tag}>/;
 
 sub is_safe_url {
     my ($url) = @_;
-    return 0 if $url =~ /^\s*javascript:/i;
+    my $normalized = $url // '';
-    return 0 if $url =~ /^\s*data:/i;
+
-    return 0 if $url =~ /^\s*vbscript:/i;
+    $normalized =~ s/^\s+//;
-    return 0 if $url =~ /^\s*file:/i;
+    $normalized =~ s/\s+$//;
+    $normalized =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg
+      while $normalized =~ /%[0-9A-Fa-f]{2}/;
+    $normalized =~ s/&#x([0-9A-Fa-f]+);?/chr(hex($1))/eg;
+    $normalized =~ s/&#(\d+);?/chr($1)/eg;
+
+    if ( $normalized =~ /^([a-z][a-z0-9+\-.]*):/i ) {
+        my $scheme = lc $1;
+        return 1
+          if $scheme eq 'http' || $scheme eq 'https' || $scheme eq 'mailto';
+        return 0;
+    }
+
     return 1;
 }
 
@@ -397,4 +409,3 @@ sub escape_html {
 }
 
 1;
-

t/04-links-images.t

@@ -2,7 +2,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 8;
+use Test::More tests => 10;
 use MarkdownParser;
 
 my $parser = MarkdownParser->new();
@@ -37,8 +37,14 @@ is(
     "<p>Click me</p>\n",
     "Data protocol blocked in links"
 );
+is(
+    $parser->parse("[Click me](javascript&#x3A;alert('XSS'))"),
+    "<p>Click me</p>\n",
+    "Encoded JavaScript protocol blocked in links"
+);
 is( $parser->parse("![Image](javascript:alert('XSS'))"),
     "<p>Image</p>\n", "JavaScript protocol blocked in images" );
 is( $parser->parse("![Image](file:///etc/passwd)"),
     "<p>Image</p>\n", "File protocol blocked in images" );
-
+is( $parser->parse("![Image](javascript:%2f%2falert('XSS'))"),
+    "<p>Image</p>\n", "Encoded JavaScript protocol blocked in images" );