Perl 安全模式

Perl 安全模式 是做什么的？

针对 Perl 应用程序的全面安全指南，涵盖输入验证、注入预防和安全编码实践。

何时激活

• 在 Perl 应用程序中处理用户输入时
• 构建 Perl Web 应用程序（CGI、Mojolicious、Dancer2、Catalyst）时
• 审核 Perl 代码中的安全漏洞时
• 使用用户提供的路径执行文件操作时
• 从 Perl 执行系统命令时
• 编写 DBI 数据库查询时

工作原理

从感知污染的输入边界开始，然后向外扩展：验证并清洗输入，保持文件系统和进程执行受限，并在所有地方使用参数化的 DBI 查询。下面的示例展示了此技能期望你在将接触用户输入、shell 或网络的 Perl 代码交付之前应用的默认安全做法。

污染模式

Perl 的污染模式 (-T) 会追踪来自外部来源的数据，并阻止其在未经显式验证的情况下用于不安全的操作。

启用污染模式

#!/usr/bin/perl -T
use v5.36;

# 已污染：任何来自程序外部的数据
my $input    = $ARGV[0];        # 已污染
my $env_path = $ENV{PATH};      # 已污染
my $form     = <STDIN>;         # 已污染
my $query    = $ENV{QUERY_STRING}; # 已污染

# 尽早清理 PATH（污染模式下必需）
$ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

清洗模式

use v5.36;

# 好：使用特定的正则表达式进行验证和清洗
sub untaint_username($input) {
    if ($input =~ /^([a-zA-Z0-9_]{3,30})$/) {
        return $1;  # $1 是未污染的
    }
    die "无效的用户名：必须为 3-30 个字母数字字符\n";
}

# 好：验证并清洗文件路径
sub untaint_filename($input) {
    if ($input =~ m{^([a-zA-Z0-9._-]+)$}) {
        return $1;
    }
    die "无效的文件名：包含不安全的字符\n";
}

# 不好：过于宽松的清洗（违背了目的）
sub bad_untaint($input) {
    $input =~ /^(.*)$/s;
    return $1;  # 接受任何内容 — 毫无意义
}

输入验证

白名单优先于黑名单

use v5.36;

# 好：白名单 — 精确定义允许的内容
sub validate_sort_field($field) {
    my %allowed = map { $_ => 1 } qw(name email created_at updated_at);
    die "无效的排序字段：$field\n" unless $allowed{$field};
    return $field;
}

# 好：使用特定模式进行验证
sub validate_email($email) {
    if ($email =~ /^([a-zA-Z0-9._%+-]+\@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,})$/) {
        return $1;
    }
    die "无效的电子邮件地址\n";
}

sub validate_integer($input) {
    if ($input =~ /^(-?\d{1,10})$/) {
        return $1 + 0;  # 强制转换为数字
    }
    die "无效的整数\n";
}

# 不好：黑名单 — 总是不完整
sub bad_validate($input) {
    die "无效" if $input =~ /[<>"';&|]/;  # 会遗漏编码后的攻击
    return $input;
}

长度约束

use v5.36;

sub validate_comment($text) {
    die "评论为必填项\n"        unless length($text) > 0;
    die "评论超过 10000 个字符\n" if length($text) > 10_000;
    return $text;
}

安全的正则表达式

ReDoS 预防

灾难性回溯发生在重叠模式上使用嵌套量词时。

use v5.36;

# 不好：容易受 ReDoS 攻击（指数级回溯）
my $bad_re = qr/^(a+)+$/;           # 嵌套量词
my $bad_re2 = qr/^([a-zA-Z]+)*$/;   # 字符类上的嵌套量词
my $bad_re3 = qr/^(.*?,){10,}$/;    # 重复的贪婪/懒惰组合

# 好：重写，避免嵌套
my $good_re = qr/^a+$/;             # 单一量词
my $good_re2 = qr/^[a-zA-Z]+$/;     # 字符类上的单一量词

# 好：使用占有量词或原子分组来阻止回溯
my $safe_re = qr/^[a-zA-Z]++$/;             # 占有量词（5.10+）
my $safe_re2 = qr/^(?>a+)$/;                # 原子分组

# 好：对不可信模式强制执行超时
use POSIX qw(alarm);
sub safe_match($string, $pattern, $timeout = 2) {
    my $matched;
    eval {
        local $SIG{ALRM} = sub { die "正则表达式超时\n" };
        alarm($timeout);
        $matched = $string =~ $pattern;
        alarm(0);
    };
    alarm(0);
    die $@ if $@;
    return $matched;
}

安全的文件操作

三参数打开

use v5.36;

# 好：三参数打开，词法文件句柄，检查返回值
sub read_file($path) {
    open my $fh, '<:encoding(UTF-8)', $path
        or die "无法打开 '$path'：$!\n";
    local $/;
    my $content = <$fh>;
    close $fh;
    return $content;
}

# 不好：使用用户数据的双参数打开（命令注入）
sub bad_read($path) {
    open my $fh, $path;        # 如果 $path = "|rm -rf /"，则会执行命令！
    open my $fh, "< $path";   # Shell 元字符注入
}

TOCTOU 防护和路径遍历

use v5.36;
use Fcntl qw(:DEFAULT :flock);
use File::Spec;
use Cwd qw(realpath);

# 原子文件创建
sub create_file_safe($path) {
    sysopen(my $fh, $path, O_WRONLY | O_CREAT | O_EXCL, 0600)
        or die "无法创建 '$path'：$!\n";
    return $fh;
}

# 验证路径保持在允许的目录内
sub safe_path($base_dir, $user_path) {
    my $real = realpath(File::Spec->catfile($base_dir, $user_path))
        // die "路径不存在\n";
    my $base_real = realpath($base_dir)
        // die "基础目录不存在\n";
    die "路径遍历被阻止\n" unless $real =~ /^\Q$base_real\E(?:\/|\z)/;
    return $real;
}

对临时文件使用 File::Temp（tempfile(UNLINK => 1)），并使用 flock(LOCK_EX) 来防止竞态条件。

安全的进程执行

列表形式的 system 和 exec

use v5.36;

# 好：列表形式 — 无 shell 插值
sub run_command(@cmd) {
    system(@cmd) == 0
        or die "命令失败：@cmd\n";
}

run_command('grep', '-r', $user_pattern, '/var/log/app/');

# 好：使用 IPC::Run3 安全捕获输出
use IPC::Run3;
sub capture_output(@cmd) {
    my ($stdout, $stderr);
    run3(\@cmd, \undef, \$stdout, \$stderr);
    if ($?) {
        die "命令失败 (退出码 $?)：$stderr\n";
    }
    return $stdout;
}

# 不好：字符串形式 — shell 注入！
sub bad_search($pattern) {
    system("grep -r '$pattern' /var/log/app/");  # 如果 $pattern = "'; rm -rf / #"
}

# 不好：带插值的反引号
my $output = `ls $user_dir`;   # Shell 注入风险

另外，使用 Capture::Tiny 可以安全地从外部命令捕获 stdout/stderr。

SQL 注入预防

DBI 占位符

use v5.36;
use DBI;

my $dbh = DBI->connect($dsn, $user, $pass, {
    RaiseError => 1,
    PrintError => 0,
    AutoCommit => 1,
});

# 好：参数化查询 — 始终使用占位符
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({});
}

# 不好：SQL 中的字符串插值（SQLi 漏洞！）
sub bad_find($dbh, $email) {
    my $sth = $dbh->prepare("SELECT * FROM users WHERE email = '$email'");
    # 如果 $email = "' OR 1=1 --"，则会返回所有用户
    $sth->execute;
    return $sth->fetchrow_hashref;
}

动态列白名单

use v5.36;

# 好：根据白名单验证列名
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 "无效的列：$column\n"    unless $allowed_cols{$column};
    die "无效的排序方向：$direction\n" unless $allowed_dirs{uc $direction};

    my $sth = $dbh->prepare("SELECT * FROM users ORDER BY $column $direction");
    $sth->execute;
    return $sth->fetchall_arrayref({});
}

# 不好：直接插值用户选择的列
sub bad_order($dbh, $column) {
    $dbh->prepare("SELECT * FROM users ORDER BY $column");  # SQLi!
}

DBIx::Class（ORM 安全）

use v5.36;

# DBIx::Class 生成安全的参数化查询
my @users = $schema->resultset('User')->search({
    status => 'active',
    email  => { -like => '%@example.com' },
}, {
    order_by => { -asc => 'name' },
    rows     => 50,
});

Web 安全

XSS 预防

use v5.36;
use HTML::Entities qw(encode_entities);
use URI::Escape qw(uri_escape_utf8);

# 好：为 HTML 上下文编码输出
sub safe_html($user_input) {
    return encode_entities($user_input);
}

# 好：为 URL 上下文编码
sub safe_url_param($value) {
    return uri_escape_utf8($value);
}

# 好：为 JSON 上下文编码
use JSON::MaybeXS qw(encode_json);
sub safe_json($data) {
    return encode_json($data);  # 处理转义
}

# 模板自动转义（Mojolicious）
# <%= $user_input %>   — 自动转义（安全）
# <%== $raw_html %>    — 原始输出（危险，仅适用于受信任的内容）

# 模板自动转义（Template Toolkit）
# [% user_input | html %]  — 显式 HTML 编码

# 不好：HTML 中的原始输出
sub bad_html($input) {
    print "<div>$input</div>";  # 如果 $input 包含 <script>，则 XSS
}

CSRF 保护

use v5.36;
use Crypt::URandom qw(urandom);
use MIME::Base64 qw(encode_base64url);

sub generate_csrf_token() {
    return encode_base64url(urandom(32));
}

验证令牌时使用常量时间比较。大多数 Web 框架（Mojolicious、Dancer2、Catalyst）都提供内置的 CSRF 保护 — 优先使用它们而不是自己手动实现。

会话和报头安全

use v5.36;

# Mojolicious 会话 + 报头
$app->secrets(['长随机密钥-定期轮换']);
$app->sessions->secure(1);          # 仅 HTTPS
$app->sessions->samesite('Lax');

$app->hook(after_dispatch => sub ($c) {
    $c->res->headers->header('X-Content-Type-Options' => 'nosniff');
    $c->res->headers->header('X-Frame-Options'        => 'DENY');
    $c->res->headers->header('Content-Security-Policy' => "default-src 'self'");
    $c->res->headers->header('Strict-Transport-Security' => 'max-age=31536000; includeSubDomains');
});

输出编码

始终根据上下文对输出进行编码：HTML 使用 HTML::Entities::encode_entities()，URL 使用 URI::Escape::uri_escape_utf8()，JSON 使用 JSON::MaybeXS::encode_json()。

CPAN 模块安全

• 在 cpanfile 中锁定版本：requires 'DBI', '== 1.643';
• 优先使用维护中的模块：查看 MetaCPAN 上的最新版本
• 最小化依赖：每个依赖都是一个攻击面

安全工具

perlcritic 安全策略

# .perlcriticrc — 以安全为中心的配置
severity = 3
theme = security + core

# 要求三参数打开
[InputOutput::RequireThreeArgOpen]
severity = 5

# 要求检查系统调用
[InputOutput::RequireCheckedSyscalls]
functions = :builtins
severity = 4

# 禁止字符串 eval
[BuiltinFunctions::ProhibitStringyEval]
severity = 5

# 禁止反引号操作符
[InputOutput::ProhibitBacktickOperators]
severity = 4

# 要求在 CGI 中检查污染
[Modules::RequireTaintChecking]
severity = 5

# 禁止双参数打开
[InputOutput::ProhibitTwoArgOpen]
severity = 5

# 禁止裸字文件句柄
[InputOutput::ProhibitBarewordFileHandles]
severity = 5

运行 perlcritic

# 检查一个文件
perlcritic --severity 3 --theme security lib/MyApp/Handler.pm

# 检查整个项目
perlcritic --severity 3 --theme security lib/

# CI 集成
perlcritic --severity 4 --theme security --quiet lib/ || exit 1

快速安全检查清单

检查项	要验证的内容
污染模式	CGI/Web 脚本上的 -T 标志
输入验证	白名单模式，长度限制
文件操作	三参数打开，路径遍历检查
进程执行	列表形式的 system，无 shell 插值
SQL 查询	DBI 占位符，绝不插值
HTML 输出	encode_entities()，模板自动转义
CSRF 令牌	生成并在状态变更请求上验证
会话配置	安全、HttpOnly、SameSite Cookie
HTTP 报头	CSP、X-Frame-Options、HSTS
依赖项	锁定版本，已审计的模块
正则表达式安全	无嵌套量词，锚定模式
错误消息	不向用户泄漏堆栈跟踪或路径

反模式

# 1. 使用用户数据的双参数打开（命令注入）
open my $fh, $user_input;               # 严重漏洞

# 2. 字符串形式的 system（shell 注入）
system("convert $user_file output.png"); # 严重漏洞

# 3. SQL 字符串插值
$dbh->do("DELETE FROM users WHERE id = $id");  # SQLi

# 4. 使用用户输入的 eval（代码注入）
eval $user_code;                         # 远程代码执行

# 5. 不进行清理就信任 $ENV
my $path = $ENV{UPLOAD_DIR};             # 可能被篡改
system("ls $path");                      # 双重漏洞

# 6. 未经验证就禁用污染
($input) = $input =~ /(.*)/s;           # 懒惰清洗 — 违背目的

# 7. HTML 中的原始用户数据
print "<div>欢迎，$username!</div>";  # XSS

# 8. 未经验证的重定向
print $cgi->redirect($user_url);         # 开放重定向

记住：Perl 的灵活性很强大，但需要自律。对面向 Web 的代码使用污染模式，使用白名单验证所有输入，对每个查询使用 DBI 占位符，并根据上下文对所有输出进行编码。深度防御 — 永远不要依赖单一的安全层。