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

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

Return to bug 40579