view release on metacpan or  search on metacpan

t/waf.t  view on Meta::CPAN

subtest 'XSS Sanitization' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'comment=<script>alert("xss")</script>',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	ok(!defined $params, 'XSS injection attempt blocked');
	is($info->status(), 403, 'Status set to 403 Forbidden');
};

subtest 'Directory Traversal Prevention' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'file=../../etc/passwd',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	ok(!defined $params, 'Directory traversal attempt blocked');
	is($info->status(), 403, 'Status set to 403 Forbidden');
};

subtest 'Upload Directory Validation' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'POST',
		CONTENT_TYPE => 'multipart/form-data; boundary=12345',
		CONTENT_LENGTH => 100,
		C_DOCUMENT_ROOT => $upload_dir,
	);
	# Invalid upload_dir (not absolute)
	$info = CGI::Info->new(upload_dir => 'tmp');
	$info->params();
	is($info->status(), 500, 'Invalid upload_dir rejected');
	# Valid upload_dir
	$info = CGI::Info->new(upload_dir => $upload_dir);
	local *STDIN;
	open STDIN, '<', \"--12345\nContent-Disposition: form-data; name=\"file\"; filename=\"test.txt\"\n\nContent\n--12345--";
	my $params = $info->params();
	if(defined $params && defined $params->{file}) {
		like($params->{file}, qr/test\.txt/, 'File uploaded to valid directory');
		my $uploaded = File::Spec->catfile($upload_dir, $params->{file});
		unlink $uploaded if -e $uploaded;
		unlink $params->{file} if -e $params->{file};
	} else {
		pass('Upload skipped or params undef on this platform');
	}
};

subtest 'Parameter Sanitization' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'GET',
		QUERY_STRING => 'key%00=evil%00data&value=valid+data',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	is($params->{key}, 'evildata', 'NUL bytes in key removed');
	is($params->{value}, 'valid data', 'Spaces correctly decoded');
};

subtest 'Max Upload Size Enforcement' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD => 'POST',
		CONTENT_TYPE => 'application/x-www-form-urlencoded',
		CONTENT_LENGTH => 1024 * 1024 * 600,	# 600MB
	);
	$info = CGI::Info->new(max_upload => 500 * 1024);	# 500KB
	$info->params();
	is($info->status(), 413, 'Status set to 413 Payload Too Large');
};

subtest 'Command Line Parameters' => sub {
	local @ARGV = ('--mobile', 'param1=value1', 'param2=value2');
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	is_deeply(
		$params,
		{ param1 => 'value1', param2 => 'value2' },
		'Command line parameters parsed correctly'
	);
	ok($info->is_mobile, 'Mobile flag set from command line');
};

# ============================================================
# Additional WAF tests — patterns not covered above
# ============================================================

subtest 'SQL Injection: OR...AND without quotes (vwf.log pattern)' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'entry=-4346%22+OR+1749%3D1749+AND+%22dgiO%22%3D%22dgiO',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	ok(!defined $params, 'OR...AND injection without single quotes blocked');
	is($info->status(), 403, 'Status 403 on OR...AND injection');
};

subtest 'SQL Injection: AND 1=1' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => 'id=1%20AND%201%3D1',
	);
	$info = new_ok('CGI::Info');
	my $params = $info->params();
	ok(!defined $params, 'AND 1=1 injection blocked');
	is($info->status(), 403, 'Status 403 on AND 1=1');
};

subtest 'SQL Injection: UNION SELECT' => sub {
	local %ENV = (
		GATEWAY_INTERFACE => 'CGI/1.1',
		REQUEST_METHOD    => 'GET',
		QUERY_STRING      => "id=1%27%20UNION%20SELECT%20username%2Cpassword%20FROM%20users--",
	);