|
Lines 24-32
use Modern::Perl;
Link Here
|
| 24 |
use open OUT=>':encoding(UTF-8)', ':std'; |
24 |
use open OUT=>':encoding(UTF-8)', ':std'; |
| 25 |
use utf8; |
25 |
use utf8; |
| 26 |
|
26 |
|
| 27 |
use Test::More tests => 21; |
27 |
use Test::More tests => 23; |
|
|
28 |
use Test::NoWarnings; |
| 28 |
use Text::CSV; |
29 |
use Text::CSV; |
| 29 |
use Text::CSV_XS; |
30 |
use Text::CSV_XS; |
|
|
31 |
use File::Find; |
| 30 |
|
32 |
|
| 31 |
sub pretty_line { |
33 |
sub pretty_line { |
| 32 |
my $max = 54; |
34 |
my $max = 54; |
|
Lines 82-84
foreach my $line (@$lines) {
Link Here
|
| 82 |
} |
84 |
} |
| 83 |
} |
85 |
} |
| 84 |
} |
86 |
} |
| 85 |
- |
87 |
|
|
|
88 |
# Test for CSV formula injection protection |
| 89 |
subtest 'CSV formula injection protection' => sub { |
| 90 |
my @csv_files; |
| 91 |
my @violations; |
| 92 |
|
| 93 |
# Find all Perl files that might use Text::CSV |
| 94 |
find( |
| 95 |
sub { |
| 96 |
return unless -f $_ && /\.pm$/; |
| 97 |
my $file = $File::Find::name; |
| 98 |
|
| 99 |
# Skip test files and this test file itself |
| 100 |
return if $file =~ m{/t/} || $file =~ m{/xt/}; |
| 101 |
|
| 102 |
open my $fh, '<', $_ or return; |
| 103 |
my $content = do { local $/; <$fh> }; |
| 104 |
close $fh; |
| 105 |
|
| 106 |
# Look for actual Text::CSV usage (not just dependency declarations) |
| 107 |
my @csv_usages = $content =~ /(?:use\s+Text::CSV|Text::CSV(?:_XS|::Encoded)?(?:\s*->|\s*\.\s*)new)/g; |
| 108 |
return unless @csv_usages; |
| 109 |
|
| 110 |
# Skip if it's just dependency metadata (like in PerlModules.pm) |
| 111 |
return if $content =~ /'Text::CSV[^']*'\s*=>\s*{[^}]*(?:required|min_ver|cur_ver)/; |
| 112 |
|
| 113 |
push @csv_files, $file; |
| 114 |
|
| 115 |
# Find all Text::CSV->new() calls and check each one |
| 116 |
my @new_calls = $content =~ /(Text::CSV(?:_XS|::Encoded)?(?:\s*->|\s*\.\s*)new\s*\([^)]*\))/g; |
| 117 |
my $has_unprotected = 0; |
| 118 |
|
| 119 |
for my $call (@new_calls) { |
| 120 |
|
| 121 |
# Check if this specific call has formula protection |
| 122 |
unless ( $call =~ /formula\s*=>\s*['"](?:empty|die|croak|diag)['"]/ |
| 123 |
|| $call =~ /formula\s*=>\s*[1-5]/ ) |
| 124 |
{ |
| 125 |
$has_unprotected = 1; |
| 126 |
last; |
| 127 |
} |
| 128 |
} |
| 129 |
|
| 130 |
if ($has_unprotected) { |
| 131 |
push @violations, $file; |
| 132 |
} |
| 133 |
}, |
| 134 |
'C4', 'Koha', |
| 135 |
'misc' |
| 136 |
); |
| 137 |
|
| 138 |
ok( scalar(@csv_files) > 0, "Found CSV usage in Koha modules" ); |
| 139 |
|
| 140 |
if (@violations) { |
| 141 |
diag("Files using Text::CSV without formula protection:"); |
| 142 |
diag(" $_") for @violations; |
| 143 |
diag(""); |
| 144 |
diag("CSV formula injection protection is required for security."); |
| 145 |
diag("Add 'formula => \"empty\"' to Text::CSV constructor options."); |
| 146 |
diag("Valid formula modes: 'empty' (recommended), 'die', 'croak', 'diag', or numeric 1-5"); |
| 147 |
} |
| 148 |
|
| 149 |
is( scalar(@violations), 0, "All Text::CSV usage includes formula injection protection" ); |
| 150 |
}; |