Perl Security

#!/usr/bin/perl -Tuse 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;
# Good: 特定の正規表現でバリデートしてアンテイントsub untaint_username($input) {    if ($input =~ /^([a-zA-Z0-9_]{3,30})$/) {        return $1;  # $1はアンテイントされている    }    die "Invalid username: must be 3-30 alphanumeric characters\n";}
# Good: ファイルパスをバリデートしてアンテイントsub untaint_filename($input) {    if ($input =~ m{^([a-zA-Z0-9._-]+)$}) {        return $1;    }    die "Invalid filename: contains unsafe characters\n";}
# Bad: 過度に許可的なアンテイント（目的を無効化する）sub bad_untaint($input) {    $input =~ /^(.*)$/s;    return $1;  # 何でも受け入れる — 無意味}

use v5.36;
# Good: アローリスト — 許可されるものを正確に定義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: 特定のパターンでバリデート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;  # 数値に強制変換    }    die "Invalid integer\n";}
# Bad: ブロックリスト — 常に不完全sub bad_validate($input) {    die "Invalid" if $input =~ /[<>"';&|]/;  # エンコードされた攻撃を見逃す    return $input;}

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;}

use v5.36;
# Bad: ReDoSに脆弱（指数的バックトラッキング）my $bad_re = qr/^(a+)+$/;           # ネストされた量詞my $bad_re2 = qr/^([a-zA-Z]+)*$/;   # クラスにネストされた量詞my $bad_re3 = qr/^(.*?,){10,}$/;    # 繰り返される貪欲/怠惰な組み合わせ
# Good: ネストなしで書き直すmy $good_re = qr/^a+$/;             # 単一の量詞my $good_re2 = qr/^[a-zA-Z]+$/;     # クラスに単一の量詞
# Good: バックトラッキングを防ぐためにpossessive量詞またはアトミックグループを使用my $safe_re = qr/^[a-zA-Z]++$/;             # Possessive (5.10+)my $safe_re2 = qr/^(?>a+)$/;                # アトミックグループ
# Good: 信頼されていないパターンにタイムアウトを適用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;}

use v5.36;
# Good: 3引数open、レキシカルファイルハンドル、戻り値チェック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: ユーザーデータを使った2引数open（コマンドインジェクション）sub bad_read($path) {    open my $fh, $path;        # $pathが"|rm -rf /"なら、コマンドを実行！    open my $fh, "< $path";   # シェルメタキャラクターインジェクション}

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 "Cannot create '$path': $!\n";    return $fh;}
# パスが許可されたディレクトリ内に留まることをバリデート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 v5.36;
# Good: リスト形式 — シェル補間なしsub run_command(@cmd) {    system(@cmd) == 0        or die "Command failed: @cmd\n";}
run_command('grep', '-r', $user_pattern, '/var/log/app/');
# Good: 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: 文字列形式 — シェルインジェクション！sub bad_search($pattern) {    system("grep -r '$pattern' /var/log/app/");  # $patternが"'; rm -rf / #"なら}
# Bad: 補間のあるバッククォートmy $output = `ls $user_dir`;   # シェルインジェクションリスク

use v5.36;use DBI;
my $dbh = DBI->connect($dsn, $user, $pass, {    RaiseError => 1,    PrintError => 0,    AutoCommit => 1,});
# Good: パラメータ化クエリ — 常にプレースホルダーを使用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: 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;
# Good: アローリストに対してカラム名をバリデート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: ユーザー選択カラムを直接補間sub bad_order($dbh, $column) {    $dbh->prepare("SELECT * FROM users ORDER BY $column");  # SQLi！}

use v5.36;
# DBIx::Classは安全なパラメータ化クエリを生成するmy @users = $schema->resultset('User')->search({    status => 'active',    email  => { -like => '%@example.com' },}, {    order_by => { -asc => 'name' },    rows     => 50,});

use v5.36;use HTML::Entities qw(encode_entities);use URI::Escape qw(uri_escape_utf8);
# Good: HTMLコンテキスト用に出力をエンコードsub safe_html($user_input) {    return encode_entities($user_input);}
# Good: URLコンテキスト用にエンコードsub safe_url_param($value) {    return uri_escape_utf8($value);}
# Good: 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エンコード
# Bad: HTMLの生の出力sub bad_html($input) {    print "<div>$input</div>";  # $inputが<script>を含む場合XSS}

use v5.36;use Crypt::URandom qw(urandom);use MIME::Base64 qw(encode_base64url);
sub generate_csrf_token() {    return encode_base64url(urandom(32));}

use v5.36;
# Mojolicousセッション + ヘッダー$app->secrets(['long-random-secret-rotated-regularly']);$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');});

# 1. ユーザーデータを使った2引数open（コマンドインジェクション）open my $fh, $user_input;               # CRITICAL脆弱性
# 2. 文字列形式のsystem（シェルインジェクション）system("convert $user_file output.png"); # CRITICAL脆弱性
# 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>Welcome, $username!</div>";  # XSS
# 8. 未バリデートのリダイレクトprint $cgi->redirect($user_url);         # オープンリダイレクト