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