|
| 1 | +From 80dbc85d1a78dd2ab85e3c0e325d38359d66e0dc Mon Sep 17 00:00:00 2001 |
| 2 | +From: pmqs <pmqs@cpan.org> |
| 3 | +Date: Sat, 16 May 2026 17:48:34 +0100 |
| 4 | +Subject: [PATCH] remove use of eval in globmapper. #73 |
| 5 | + |
| 6 | +Signed-off-by: Azure Linux Security Servicing Account <azurelinux-security@microsoft.com> |
| 7 | +Upstream-reference: https://github.com/pmqs/IO-Compress/commit/f2db247bf90d4cc7ee2710be384946081f3b4610.patch |
| 8 | +--- |
| 9 | + cpan/IO-Compress/lib/File/GlobMapper.pm | 52 ++++++++++++++++++++----- |
| 10 | + cpan/IO-Compress/t/globmapper.t | 52 ++++++++++++++++++++++++- |
| 11 | + 2 files changed, 94 insertions(+), 10 deletions(-) |
| 12 | + |
| 13 | +diff --git a/cpan/IO-Compress/lib/File/GlobMapper.pm b/cpan/IO-Compress/lib/File/GlobMapper.pm |
| 14 | +index f015b16..8936146 100644 |
| 15 | +--- a/cpan/IO-Compress/lib/File/GlobMapper.pm |
| 16 | ++++ b/cpan/IO-Compress/lib/File/GlobMapper.pm |
| 17 | +@@ -29,6 +29,11 @@ our ($VERSION, @EXPORT_OK); |
| 18 | + $VERSION = '1.001'; |
| 19 | + @EXPORT_OK = qw( globmap ); |
| 20 | + |
| 21 | ++our $BEGIN_DELIM = "\xFF"; |
| 22 | ++our $END_DELIM = "\xFE"; |
| 23 | ++our $BACKSLASH_ESC = "\xFD"; |
| 24 | ++our $HASH_ESC = "\xFC"; |
| 25 | ++our $STAR_ESC = "\xFB"; |
| 26 | + |
| 27 | + our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount); |
| 28 | + $noPreBS = '(?<!\\\)' ; # no preceding backslash |
| 29 | +@@ -310,14 +315,23 @@ sub _parseOutputGlob |
| 30 | + } |
| 31 | + |
| 32 | + my $noPreBS = '(?<!\\\)' ; # no preceding backslash |
| 33 | +- #warn "noPreBS = '$noPreBS'\n"; |
| 34 | ++ my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash |
| 35 | + |
| 36 | +- #$string =~ s/${noPreBS}\$(\d)/\${$1}/g; |
| 37 | +- $string =~ s/${noPreBS}#(\d)/\${$1}/g; |
| 38 | +- $string =~ s#${noPreBS}\*#\${inFile}#g; |
| 39 | +- $string = '"' . $string . '"'; |
| 40 | ++ # escape any use of the delimiter symbols |
| 41 | ++ # $string =~ s/(${BEGIN_DELIM}|${END_DELIM}|${BACKSLASH_ESC})/$1$1/g; |
| 42 | ++ |
| 43 | ++ # escape \# and \* |
| 44 | ++ $string =~ s/\\#/${HASH_ESC}/g; |
| 45 | ++ $string =~ s/\\\*/${STAR_ESC}/g; |
| 46 | ++ |
| 47 | ++ # Transform "#3" to BEGIN_DELIM 3 END_DELIM |
| 48 | ++ $string =~ s/${noPreESC}#(\d)/${BEGIN_DELIM}${1}${END_DELIM}/g; |
| 49 | ++ |
| 50 | ++ $string =~ s#\*#${BEGIN_DELIM}${END_DELIM}#g; |
| 51 | ++ |
| 52 | ++ # print "INPUT '$self->{InputPattern}'\n"; |
| 53 | ++ # print "OUTPUT '$self->{OutputGlob}' => '$string'\n"; |
| 54 | + |
| 55 | +- #print "OUTPUT '$self->{OutputGlob}' => '$string'\n"; |
| 56 | + $self->{OutputPattern} = $string ; |
| 57 | + |
| 58 | + return 1 ; |
| 59 | +@@ -335,11 +349,31 @@ sub _getFiles |
| 60 | + next if $inFiles{$inFile} ++ ; |
| 61 | + |
| 62 | + my $outFile = $inFile ; |
| 63 | ++ my @matches ; |
| 64 | ++ |
| 65 | ++ my $noPreESC = '(?<![${BEGIN_DELIM}])' ; # no preceding backslash |
| 66 | + |
| 67 | +- if ( $inFile =~ m/$self->{InputPattern}/ ) |
| 68 | ++ if (@matches = ($inFile =~ m/$self->{InputPattern}/ )) |
| 69 | + { |
| 70 | +- no warnings 'uninitialized'; |
| 71 | +- eval "\$outFile = $self->{OutputPattern};" ; |
| 72 | ++ $outFile = $self->{OutputPattern}; |
| 73 | ++ my $ix = 1; |
| 74 | ++ |
| 75 | ++ # get the filename glob |
| 76 | ++ $outFile =~ s/${noPreESC}${BEGIN_DELIM}${END_DELIM}/$inFile/g; |
| 77 | ++ |
| 78 | ++ # now each of the #1, #2,... |
| 79 | ++ for my $pattern (@matches) |
| 80 | ++ { |
| 81 | ++ $outFile =~ s/${noPreESC}${BEGIN_DELIM}${ix}${END_DELIM}/$pattern/g; |
| 82 | ++ |
| 83 | ++ ++ $ix; |
| 84 | ++ } |
| 85 | ++ |
| 86 | ++ # unescape |
| 87 | ++ $outFile =~ s/${BEGIN_DELIM}${BEGIN_DELIM}/${BEGIN_DELIM}/g; |
| 88 | ++ $outFile =~ s/${END_DELIM}${END_DELIM}/${END_DELIM}/g; |
| 89 | ++ $outFile =~ s/${HASH_ESC}/#/g; |
| 90 | ++ $outFile =~ s/${STAR_ESC}/*/g; |
| 91 | + |
| 92 | + if (defined $outInMapping{$outFile}) |
| 93 | + { |
| 94 | +diff --git a/cpan/IO-Compress/t/globmapper.t b/cpan/IO-Compress/t/globmapper.t |
| 95 | +index c97beb6..926b5e3 100644 |
| 96 | +--- a/cpan/IO-Compress/t/globmapper.t |
| 97 | ++++ b/cpan/IO-Compress/t/globmapper.t |
| 98 | +@@ -24,7 +24,7 @@ Perl $]" ) |
| 99 | + $extra = 1 |
| 100 | + if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
| 101 | + |
| 102 | +- plan tests => 68 + $extra ; |
| 103 | ++ plan tests => 76 + $extra ; |
| 104 | + |
| 105 | + use_ok('File::GlobMapper') ; |
| 106 | + } |
| 107 | +@@ -290,6 +290,56 @@ Perl $]" ) |
| 108 | + ], " got mapping"; |
| 109 | + } |
| 110 | + |
| 111 | ++{ |
| 112 | ++ title "check escaping"; |
| 113 | ++ |
| 114 | ++ my $tmpDir ;#= 'td'; |
| 115 | ++ my $lex = LexDir->new( $tmpDir ); |
| 116 | ++ |
| 117 | ++ my $BEGIN_DELIM = "\xFF"; |
| 118 | ++ my $END_DELIM = "\xFE"; |
| 119 | ++ |
| 120 | ++ #mkdir $tmpDir, 0777 ; |
| 121 | ++ |
| 122 | ++ touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; |
| 123 | ++ |
| 124 | ++ my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-${BEGIN_DELIM}#2-#1${END_DELIM}-X"); |
| 125 | ++ ok $map, " got map" |
| 126 | ++ or diag $File::GlobMapper::Error ; |
| 127 | ++ |
| 128 | ++ is @{ $map }, 3, " returned 3 maps"; |
| 129 | ++ is_deeply $map, |
| 130 | ++ [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-${BEGIN_DELIM}c1-a${END_DELIM}-X")], |
| 131 | ++ [map { "$tmpDir/$_" } ("abc2.tmp", "X-${BEGIN_DELIM}c2-a${END_DELIM}-X")], |
| 132 | ++ [map { "$tmpDir/$_" } ("abc3.tmp", "X-${BEGIN_DELIM}c3-a${END_DELIM}-X")], |
| 133 | ++ ], " got mapping"; |
| 134 | ++} |
| 135 | ++ |
| 136 | ++{ |
| 137 | ++ title "check backslash escaping"; |
| 138 | ++ |
| 139 | ++ my $tmpDir ;#= 'td'; |
| 140 | ++ my $lex = LexDir->new( $tmpDir ); |
| 141 | ++ |
| 142 | ++ my $BEGIN_DELIM = "\xFF"; |
| 143 | ++ my $END_DELIM = "\xFE"; |
| 144 | ++ |
| 145 | ++ #mkdir $tmpDir, 0777 ; |
| 146 | ++ |
| 147 | ++ touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; |
| 148 | ++ |
| 149 | ++ my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", $tmpDir . '/X-#2-\\#1\\*-X'); |
| 150 | ++ ok $map, " got map" |
| 151 | ++ or diag $File::GlobMapper::Error ; |
| 152 | ++ |
| 153 | ++ is @{ $map }, 3, " returned 3 maps"; |
| 154 | ++ is_deeply $map, |
| 155 | ++ [ [map { "$tmpDir/$_" } ("abc1.tmp", "X-c1-#1*-X")], |
| 156 | ++ [map { "$tmpDir/$_" } ("abc2.tmp", "X-c2-#1*-X")], |
| 157 | ++ [map { "$tmpDir/$_" } ("abc3.tmp", "X-c3-#1*-X")], |
| 158 | ++ ], " got mapping"; |
| 159 | ++} |
| 160 | ++ |
| 161 | + # TODO |
| 162 | + # test each of the wildcard metacharacters can be mapped to the output filename |
| 163 | + # |
| 164 | +-- |
| 165 | +2.45.4 |
| 166 | + |
0 commit comments