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