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

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

Return to bug 40579