1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
|
From: IKEDA Soji <ikeda@conversion.co.jp>
Date: Thu, 12 Jan 2023 14:57:23 +0900
Subject: Handler for style attribute is vulnerable to ReDoS
Origin: https://github.com/clintongormley/perl-html-stripscripts/pull/4/commits/3c50e79986bf95728c741f1bc92b61275c30ff54
Bug: https://github.com/clintongormley/perl-html-stripscripts/issues/3
Bug-Debian: https://bugs.debian.org/1029400
Bug-Debian-Security: https://security-tracker.debian.org/tracker/CVE-2023-24038
---
lib/HTML/StripScripts.pm | 64 ++++++++++++++++++++++++++++++----------
1 file changed, 48 insertions(+), 16 deletions(-)
diff --git a/lib/HTML/StripScripts.pm b/lib/HTML/StripScripts.pm
index 3d79c07b75ad..614946f04ab7 100644
--- a/lib/HTML/StripScripts.pm
+++ b/lib/HTML/StripScripts.pm
@@ -1598,23 +1598,55 @@ sub _hss_attval_style {
my @clean = ();
# Split on semicolon, making a reasonable attempt to ignore
- # semicolons inside doublequotes or singlequotes.
- while ( $attrval =~ s{^((?:[^;'"]|'[^']*'|"[^"]*")+)}{} ) {
- my $elt = $1;
- $attrval =~ s/^;//;
-
- if ( $elt =~ m|^\s*([\w\-]+)\s*:\s*(.+?)\s*$|s ) {
- my ( $key, $val ) = ( lc $1, $2 );
-
- my $value_class = $filter->{_hssStyle}{$key};
- next unless defined $value_class;
- my $sub = $filter->{_hssAttVal}{$value_class};
- next unless defined $sub;
-
- my $cleanval = &{$sub}( $filter, 'style-psuedo-tag', $key, $val );
- if ( defined $cleanval ) {
- push @clean, "$key:$val";
+ # semicolons inside doublequotes, singlequotes or parentheses.
+ my $rule = '';
+ my $paren = 0;
+ pos $attrval = 0;
+ while (
+ $attrval =~ m{
+ \G
+ (?:
+ ( [^;'"()]+ | ' [^']* ' | " [^"]* " )
+ | ( [(] )
+ | ( [)] )
+ | ( [;] )
+ | \z
+ )
+ }cgx
+ ) {
+ if (defined $1) {
+ $rule .= $1;
+ next;
+ } elsif ($2) {
+ $rule .= $2;
+ $paren++;
+ next;
+ } elsif ($3) {
+ $rule .= $3;
+ $paren--;
+ last if $paren < 0; # unbalanced parentheses
+ next;
+ } elsif ($4) {
+ if (0 < $paren) { # allow semicolons within parentheses
+ $rule .= $4;
+ next;
}
+ } else {
+ last if $paren != 0; # unbalanced parentheses
+ }
+
+ $rule =~ s/\A\s+//;
+ $rule =~ s/\s+\z//;
+ my ($key, $val) = split /\s*:\s*/, $rule, 2;
+ $rule = '';
+
+ next unless defined $val;
+ $key =~ s/\A([-\w]+)\z/lc $1/e
+ or next;
+ my $sub = $filter->{_hssAttVal}{$filter->{_hssStyle}{$key} || ''}
+ or next;
+ if (defined $sub->($filter, 'style-psuedo-tag', $key, $val)) {
+ push @clean, "$key:$val";
}
}
--
2.39.0
|