--- name: perl-security description: Comprehensive Perl security covering taint mode, input validation, safe process execution, DBI parameterized queries, web security (XSS/SQLi/CSRF), and perlcritic security policies. origin: ECC --- # Perl Security Patterns Comprehensive security guidelines for Perl applications covering input validation, injection prevention, and secure coding practices. ## When to Activate - Handling user input in Perl applications - Building Perl web applications (CGI, Mojolicious, Dancer2, Catalyst) - Reviewing Perl code for security vulnerabilities - Performing file operations with user-supplied paths - Executing system commands from Perl - Writing DBI database queries ## Taint Mode Perl's taint mode (`-T`) tracks data from external sources and prevents it from being used in unsafe operations without explicit validation. ### Enabling Taint Mode ```perl #!/usr/bin/perl -T use v5.36; # Tainted: anything from outside the program my $input = $ARGV[0]; # Tainted my $env_path = $ENV{PATH}; # Tainted my $form = ; # Tainted my $query = $ENV{QUERY_STRING}; # Tainted # Sanitize PATH early (required in taint mode) $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin'; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; ``` ### Untainting Pattern ```perl use v5.36; # Good: Validate and untaint with a specific regex sub untaint_username($input) { if ($input =~ /^([a-zA-Z0-9_]{3,30})$/) { return $1; # $1 is untainted } die "Invalid username: must be 3-30 alphanumeric characters\n"; } # Good: Validate and untaint a file path sub untaint_filename($input) { if ($input =~ m{^([a-zA-Z0-9._-]+)$}) { return $1; } die "Invalid filename: contains unsafe characters\n"; } # Bad: Overly permissive untainting (defeats the purpose) sub bad_untaint($input) { $input =~ /^(.*)$/s; return $1; # Accepts ANYTHING — pointless } ``` ## Input Validation ### Allowlist Over Blocklist ```perl use v5.36; # Good: Allowlist — define exactly what's permitted sub validate_sort_field($field) { my %allowed = map { $_ => 1 } qw(name email created_at updated_at); die "Invalid sort field: $field\n" unless $allowed{$field}; return $field; } # Good: Validate with specific patterns sub validate_email($email) { if ($email =~ /^([a-zA-Z0-9._%+-]+\@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,})$/) { return $1; } die "Invalid email address\n"; } sub validate_integer($input) { if ($input =~ /^(-?\d{1,10})$/) { return $1 + 0; # Coerce to number } die "Invalid integer\n"; } # Bad: Blocklist — always incomplete sub bad_validate($input) { die "Invalid" if $input =~ /[<>"';&|]/; # Misses encoded attacks return $input; } ``` ### Length Constraints ```perl use v5.36; sub validate_comment($text) { die "Comment is required\n" unless length($text) > 0; die "Comment exceeds 10000 chars\n" if length($text) > 10_000; return $text; } ``` ## Safe Regular Expressions ### ReDoS Prevention Catastrophic backtracking occurs with nested quantifiers on overlapping patterns. ```perl use v5.36; # Bad: Vulnerable to ReDoS (exponential backtracking) my $bad_re = qr/^(a+)+$/; # Nested quantifiers my $bad_re2 = qr/^([a-zA-Z]+)*$/; # Nested quantifiers on class my $bad_re3 = qr/^(.*?,){10,}$/; # Repeated greedy/lazy combo # Good: Rewrite without nesting my $good_re = qr/^a+$/; # Single quantifier my $good_re2 = qr/^[a-zA-Z]+$/; # Single quantifier on class # Good: Use possessive quantifiers or atomic groups to prevent backtracking my $safe_re = qr/^[a-zA-Z]++$/; # Possessive (5.10+) my $safe_re2 = qr/^(?>a+)$/; # Atomic group # Good: Enforce timeout on untrusted patterns use POSIX qw(alarm); sub safe_match($string, $pattern, $timeout = 2) { my $matched; eval { local $SIG{ALRM} = sub { die "Regex timeout\n" }; alarm($timeout); $matched = $string =~ $pattern; alarm(0); }; alarm(0); die $@ if $@; return $matched; } ``` ## Safe File Operations ### Three-Argument Open ```perl use v5.36; # Good: Three-arg open, lexical filehandle, check return sub read_file($path) { open my $fh, '<:encoding(UTF-8)', $path or die "Cannot open '$path': $!\n"; local $/; my $content = <$fh>; close $fh; return $content; } # Bad: Two-arg open with user data (command injection) sub bad_read($path) { open my $fh, $path; # If $path = "|rm -rf /", runs command! open my $fh, "< $path"; # Shell metacharacter injection } ``` ### TOCTOU Prevention and Path Traversal ```perl use v5.36; use Fcntl qw(:DEFAULT :flock); use File::Spec; use Cwd qw(realpath); # Atomic file creation sub create_file_safe($path) { sysopen(my $fh, $path, O_WRONLY | O_CREAT | O_EXCL, 0600) or die "Cannot create '$path': $!\n"; return $fh; } # Validate path stays within allowed directory sub safe_path($base_dir, $user_path) { my $real = realpath(File::Spec->catfile($base_dir, $user_path)) // die "Path does not exist\n"; my $base_real = realpath($base_dir) // die "Base dir does not exist\n"; die "Path traversal blocked\n" unless $real =~ /^\Q$base_real\E/; return $real; } ``` Use `File::Temp` for temporary files (`tempfile(UNLINK => 1)`) and `flock(LOCK_EX)` to prevent race conditions. ## Safe Process Execution ### List-Form system and exec ```perl use v5.36; # Good: List form — no shell interpolation sub run_command(@cmd) { system(@cmd) == 0 or die "Command failed: @cmd\n"; } run_command('grep', '-r', $user_pattern, '/var/log/app/'); # Good: Capture output safely with IPC::Run3 use IPC::Run3; sub capture_output(@cmd) { my ($stdout, $stderr); run3(\@cmd, \undef, \$stdout, \$stderr); if ($?) { die "Command failed (exit $?): $stderr\n"; } return $stdout; } # Bad: String form — shell injection! sub bad_search($pattern) { system("grep -r '$pattern' /var/log/app/"); # If $pattern = "'; rm -rf / #" } # Bad: Backticks with interpolation my $output = `ls $user_dir`; # Shell injection risk ``` Also use `Capture::Tiny` for capturing stdout/stderr from external commands safely. ## SQL Injection Prevention ### DBI Placeholders ```perl use v5.36; use DBI; my $dbh = DBI->connect($dsn, $user, $pass, { RaiseError => 1, PrintError => 0, AutoCommit => 1, }); # Good: Parameterized queries — always use placeholders sub find_user($dbh, $email) { my $sth = $dbh->prepare('SELECT * FROM users WHERE email = ?'); $sth->execute($email); return $sth->fetchrow_hashref; } sub search_users($dbh, $name, $status) { my $sth = $dbh->prepare( 'SELECT * FROM users WHERE name LIKE ? AND status = ? ORDER BY name' ); $sth->execute("%$name%", $status); return $sth->fetchall_arrayref({}); } # Bad: String interpolation in SQL (SQLi vulnerability!) sub bad_find($dbh, $email) { my $sth = $dbh->prepare("SELECT * FROM users WHERE email = '$email'"); # If $email = "' OR 1=1 --", returns all users $sth->execute; return $sth->fetchrow_hashref; } ``` ### Dynamic Column Allowlists ```perl use v5.36; # Good: Validate column names against an allowlist sub order_by($dbh, $column, $direction) { my %allowed_cols = map { $_ => 1 } qw(name email created_at); my %allowed_dirs = map { $_ => 1 } qw(ASC DESC); die "Invalid column: $column\n" unless $allowed_cols{$column}; die "Invalid direction: $direction\n" unless $allowed_dirs{uc $direction}; my $sth = $dbh->prepare("SELECT * FROM users ORDER BY $column $direction"); $sth->execute; return $sth->fetchall_arrayref({}); } # Bad: Directly interpolating user-chosen column sub bad_order($dbh, $column) { $dbh->prepare("SELECT * FROM users ORDER BY $column"); # SQLi! } ``` ### DBIx::Class (ORM Safety) ```perl use v5.36; # DBIx::Class generates safe parameterized queries my @users = $schema->resultset('User')->search({ status => 'active', email => { -like => '%@example.com' }, }, { order_by => { -asc => 'name' }, rows => 50, }); ``` ## Web Security ### XSS Prevention ```perl use v5.36; use HTML::Entities qw(encode_entities); use URI::Escape qw(uri_escape_utf8); # Good: Encode output for HTML context sub safe_html($user_input) { return encode_entities($user_input); } # Good: Encode for URL context sub safe_url_param($value) { return uri_escape_utf8($value); } # Good: Encode for JSON context use JSON::MaybeXS qw(encode_json); sub safe_json($data) { return encode_json($data); # Handles escaping } # Template auto-escaping (Mojolicious) # <%= $user_input %> — auto-escaped (safe) # <%== $raw_html %> — raw output (dangerous, use only for trusted content) # Template auto-escaping (Template Toolkit) # [% user_input | html %] — explicit HTML encoding # Bad: Raw output in HTML sub bad_html($input) { print "
$input
"; # XSS if $input contains