view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

    # while still exercising the long-input path.
    my $long_val            = ('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789' x 100);
    $ENV{QUERY_STRING}      = "note=$long_val";

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    # Should either parse it or return undef cleanly — must not die
    ok(!$@, 'does not die on very long param value');
    ok($info->status() != 500, 'no 500 status on long value');
};

subtest 'query string: very large number of parameters' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = join('&', map { "k$_=v$_" } 1..500);

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die with 500 parameters');
    ok(!defined($p) || ref($p) eq 'HASH', 'returns undef or hashref');
};

subtest 'query string: empty key=value pairs' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = '&&&=&=value&key=';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on empty/degenerate key=value pairs');
};

subtest 'query string: only ampersands' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = '&&&&&';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on query string of only ampersands');
};

subtest 'query string: key with no equals sign' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'justkey&other=val';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on key with no equals sign');
};

# ============================================================
# 2. URL encoding edge cases
# ============================================================

subtest 'URL encoding: double-encoded percent signs' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'val=%2525';    # %25 => %, so %2525 => %25

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

subtest 'URL encoding: incomplete percent sequence at end' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'val=hello%2';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on truncated percent sequence');
};

subtest 'URL encoding: NUL byte poison attempts' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'key%00=value&other=val%00ue';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on NUL byte poison in query string');
    # If parsed, NUL bytes must not appear in keys or values
    if(defined $p) {
        for my $k (keys %{$p}) {
            unlike($k,       qr/\x00/, "NUL stripped from key '$k'");
            unlike($p->{$k}, qr/\x00/, "NUL stripped from value of '$k'");
        }
    }
};

subtest 'URL encoding: %00 encoded NUL in key name' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'GET';
    $ENV{QUERY_STRING}      = 'ke%00y=value';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on NUL in key');
    # key with embedded NUL should either be dropped or have NUL removed
    if(defined $p) {
        ok(!exists $p->{"ke\x00y"}, 'key with NUL byte not stored raw');
    }
};

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