view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

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

t/edge_cases.t  view on Meta::CPAN

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

t/waf.t  view on Meta::CPAN

};

subtest 'WAF: %00 NUL byte in value stripped' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'data=hello%2500world',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	# %2500 URL-decodes to literal %00 (percent-zero-zero).
	# The fix applies the %00 strip a second time after URL-decoding,
	# so %2500 -> %00 -> '' and the value becomes 'helloworld'.
	if(defined $params && defined $params->{data}) {
		unlike($params->{data}, qr/\x00/, 'NUL byte not present after fix');
		unlike($params->{data}, qr/%00/,  'literal %00 stripped after URL-decode');
	} else {
		pass('params blocked or value empty after strip (acceptable)');
	}
};