view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'num=4';
	my $p = CGI::Info->new()->params(allow => {
		num => sub { ($_[1] % 2) == 0 }
	});
	ok(defined $p && defined $p->{num}, 'coderef returning true passes');
};

subtest 'params() - allow: coderef validator excludes falsy return' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'num=3';
	my $p = CGI::Info->new()->params(allow => {
		num => sub { ($_[1] % 2) == 0 }
	});
	ok(!defined($p) || !defined($p->{num}),
		'coderef returning false excludes param');
};

subtest 'params() - allow: coderef receives key, value, object' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'x=hello';
	my ($got_key, $got_val, $got_obj);
	CGI::Info->new()->params(allow => {
		x => sub {
			($got_key, $got_val, $got_obj) = @_;
			return 1;
		}
	});
	is($got_key, 'x',	   'coderef receives key as first arg');
	is($got_val, 'hello',   'coderef receives value as second arg');
	isa_ok($got_obj, 'CGI::Info', 'coderef receives CGI::Info as third arg');
};

subtest 'params() - allow: Params::Validate::Strict schema passes valid' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'age=25';
	my $p = CGI::Info->new()->params(allow => {
		age => { type => 'integer', min => 0, max => 150 }
	});
	ok(defined $p && defined $p->{age}, 'valid value passes schema');
};

subtest 'params() - allow: Params::Validate::Strict schema blocks invalid' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'age=999';
	my $info = CGI::Info->new();
	my $p	= $info->params(allow => {
		age => { type => 'integer', min => 0, max => 150 }
	});
	ok(!defined($p) || !defined($p->{age}),
		'out-of-range value blocked by schema');
};

subtest 'params() - blocks SQL injection, returns undef, status 403' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = "id=1'%20OR%201=1";
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'SQL injection attempt returns undef');
	is($info->status(), 403, 'status 403 on SQL injection');
};

subtest 'params() - blocks XSS injection, returns undef, status 403' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'q=%3Cscript%3Ealert(1)%3C%2Fscript%3E';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'XSS attempt returns undef');
	is($info->status(), 403, 'status 403 on XSS');
};

subtest 'params() - blocks directory traversal, status 403' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'file=../../etc/passwd';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'directory traversal returns undef');
	is($info->status(), 403, 'status 403 on directory traversal');
};

subtest 'params() - blocks mustleak attack, status 403' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'GET';
	$ENV{QUERY_STRING}	  = 'x=mustleak.com/probe';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'mustleak attack returns undef');
	is($info->status(), 403, 'status 403 on mustleak');
};

subtest 'params() - POST: missing CONTENT_LENGTH => undef + status 411' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'POST';
	my $info = CGI::Info->new();
	ok(!defined $info->params(), 'POST without CONTENT_LENGTH returns undef');
	is($info->status(), 411, 'status 411 on missing CONTENT_LENGTH');
};

subtest 'params() - POST: oversized body => undef + status 413' => sub {
	reset_env();
	$ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
	$ENV{REQUEST_METHOD}	= 'POST';
	$ENV{CONTENT_LENGTH}	= 999_999_999;
	my $info = CGI::Info->new(max_upload_size => 100);
	ok(!defined $info->params(), 'oversized POST returns undef');
	is($info->status(), 413, 'status 413 on oversized body');
};