--- 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 ## How It Works Start with taint-aware input boundaries, then move outward: validate and untaint inputs, keep filesystem and process execution constrained, and use parameterized DBI queries everywhere. The examples below show the safe defaults this skill expects you to apply before shipping Perl code that touches user input, the shell, or the network. ## 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(?:\/|\z)/; 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