view release on metacpan or  search on metacpan

t/waf.t  view on Meta::CPAN

		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'action=SELECT_item&menu=dropdown',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	ok(defined $params,                    'SELECT_ prefix not blocked');
	is($params->{action}, 'SELECT_item',   'SELECT_ value passed through');
	is($info->status(), 200,               'status 200 for benign SELECT_ value');
};

subtest 'WAF: false positive — email address with equals in base64' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'token=abc123def456ghi789%3D%3D',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	# Base64 padding == does not contain injection chars alongside it
	ok(defined $params, 'base64-padded token not blocked');
	is($info->status(), 200, 'status 200 for base64 token');
};

subtest 'WAF: SQL injection blocked on is_robot() SQL UA' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'x=clean',
		HTTP_USER_AGENT   => 'bot/1.0 AND 1=1',
		REMOTE_ADDR       => '1.2.3.4',
	);
	$info = new_ok('CGI::Info');
	ok($info->is_robot(), 'SQL-injecting UA flagged as robot');
	is($info->status(), 403, 'Status 403 on SQL injection in UA via is_robot');
};

subtest 'WAF: NUL byte in value stripped, not stored' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'data=hello%00world',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	if(defined $params && defined $params->{data}) {
		unlike($params->{data}, qr/\x00/, 'NUL byte stripped from value');
	} else {
		pass('params blocked or value empty after NUL strip (acceptable)');
	}
};

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

subtest 'WAF: HTML comment injection stripped' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'note=hello<!--+evil+-->world',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	if(defined $params && defined $params->{note}) {
		unlike($params->{note}, qr/<!--/, 'HTML comment open stripped');
		unlike($params->{note}, qr/-->/, 'HTML comment close stripped');
	} else {
		pass('params blocked or stripped (acceptable)');
	}
};

subtest 'WAF: clean request after attack does not persist 403 status' => sub {
	# First request: attack
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => "x=1'%20OR%201=1",
	);
	CGI::Info->reset();
	my $bad = CGI::Info->new();
	$bad->params();
	is($bad->status(), 403, 'Attack request sets 403');

	# Second request: clean (fresh object)
	CGI::Info->reset();
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'name=Alice',
	);
	my $good = CGI::Info->new();
	my $p = $good->params();
	ok(defined $p, 'Clean request after attack returns params');
	is($good->status(), 200, 'Clean request after attack has 200 status');
};

done_testing();