view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

subtest 'URL encoding: Unicode sequences via percent encoding' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    # %C3%A9 = UTF-8 for é
    $ENV{QUERY_STRING}      = 'name=caf%C3%A9';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on UTF-8 encoded unicode in value');
};

subtest 'URL encoding: plus signs as spaces' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'msg=hello+world&empty=+';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on plus-encoded spaces');
    if(defined $p && defined $p->{msg}) {
        is($p->{msg}, 'hello world', 'plus decoded to space');
    }
};

# ============================================================
# 3. WAF: boundary and near-miss attack patterns
# ============================================================

subtest 'WAF: SQL keyword in value without injection pattern (should pass)' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    # "SELECT" alone in a value is not a SQL injection
    $ENV{QUERY_STRING}      = 'action=SELECT_item';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on SQL keyword in non-attack context');
    ok($info->status() != 403, 'status not 403 for benign SQL-like value');
};

subtest 'WAF: Unicode look-alike SQL injection characters' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    # Unicode fullwidth apostrophe U+FF07, not ASCII single-quote
    $ENV{QUERY_STRING}      = encode('UTF-8', "name=O\x{FF07}Brien");

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on Unicode look-alike apostrophe');
};

subtest 'WAF: deeply nested HTML not treated as XSS (no angle brackets)' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'desc=bold+and+italic+text';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on HTML-like words without brackets');
    ok($info->status() != 403, 'not blocked as XSS without angle brackets');
};

subtest 'WAF: FBCLID with double-dash (mentioned in source comment)' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'fbclid=AQHk--sometoken123';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on FBCLID with double-dash');
    # Facebook FBCLID with "--" should not be blocked per source comment
    ok($info->status() != 403, 'FBCLID with -- not blocked as SQL injection');
};

subtest 'WAF: multiline value (CR/LF injection)' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'hdr=value%0D%0AX-Injected%3A+evil';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on CRLF injection attempt');
    if(defined $p && defined $p->{hdr}) {
        unlike($p->{hdr}, qr/[\r\n]/, 'CR/LF stripped from injected header');
    }
};

subtest 'WAF: SQL injection via User-Agent header' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'x=1';
    $ENV{HTTP_USER_AGENT}   = 'Mozilla/5.0 SELECT foo AND bar FROM users';
    $ENV{REMOTE_ADDR}       = '1.2.3.4';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on SQL injection in User-Agent');
    is($info->status(), 403, 'status 403 on SQL injection in User-Agent');
};

subtest 'WAF: maximum length SQL injection attempt' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    # Long SQL injection padded with junk
    my $payload = "id=" . ('A' x 1000) . "'%20OR%201=1--";
    $ENV{QUERY_STRING}      = $payload;

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on long SQL injection attempt');
    is($info->status(), 403, 'long SQL injection blocked with 403');