View | Details | Raw Unified | Return to bug 40579
Collapse All | Expand All

(-)a/xt/author/Text_CSV_Various.t (-2 / +67 lines)
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
};

Return to bug 40579