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
|
