view release on metacpan or  search on metacpan

t/params.t  view on Meta::CPAN

	ok(defined($p{country}));
	ok($p{country} eq '44');
	ok($p{datafile} =~ /^hello.txt_.+/);
	$filename = File::Spec->catfile($tmpdir, $p{datafile});
	ok(!-e $filename);
	ok(!-r $filename);
	close $fin;

	$ENV{'CONTENT_TYPE'} = 'Multipart/form-data; boundary=-----xyz';
	$input = <<'EOF';
-------xyz
Content-Disposition: form-data; name="country"

44
-------xyz
Content-Disposition: form-data; name="datafile"; filename="../../../passwd"
Content-Type: text/plain

Hello, World

-------xyz--
EOF
	open ($fin, '<', \$input);
	local *STDIN = $fin;
	$script_path = $i->script_path();
	CGI::Info->reset();	# Force stdin re-read
	$i = new_ok('CGI::Info' => [
		upload_dir => $tmpdir
	]);
	eval { %p = $i->params() };
	ok($@ =~ /Disallowing invalid filename/);
	ok(defined($p{country}));
	ok($p{country} eq '44');
	ok($p{datafile} =~ /^hello.txt_.+/);
	$filename = File::Spec->catfile($tmpdir, $p{datafile});
	ok(!-e $filename);
	ok(!-r $filename);
	close $fin;

	$ENV{'REQUEST_METHOD'} = 'DELETE';
	$ENV{'QUERY_STRING'} = 'laleh=tulip';
	$i = new_ok('CGI::Info');
	eval { %p = $i->params() };
	cmp_ok(scalar(keys(%p)), '==', 0, 'params: DELETE mode is not supported');
	cmp_ok($i->status(), '==', 405, 'params: DELETE sets HTTP status to 405');

	# Check params are read from command line arguments for testing scripts
	delete $ENV{'GATEWAY_INTERFACE'};
	delete $ENV{'REQUEST_METHOD'};
	delete $ENV{'QUERY_STRING'};
	@ARGV = ('foo=bar', 'fred=wilma' );
	$i = new_ok('CGI::Info');
	%p = %{$i->params(logger => MyLogger->new())};
	ok($p{fred} eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');
	ok(!$i->is_mobile());

	@ARGV= ('file=/../../../../etc/passwd%00');
	$i = new_ok('CGI::Info');
	dies_ok { %p = %{$i->params()} };	# Warns because logger isn't set
	like($@, qr/Blocked directory traversal attack/);
	diag(Data::Dumper->new([$i->messages()])->Dump()) if($ENV{'TEST_VERBOSE'});
	like(
		$i->messages()->[1]->{'message'},
		qr/^Blocked directory traversal attack for 'file'/,
		'Warning generated for disallowed parameter'
	);
	cmp_ok($i->messages()->[1]->{'level'}, 'eq', 'warn');
	like($i->messages_as_string(), qr/Blocked directory traversal attack/, 'messages_as_string works');

	@ARGV= ('file=/etc/passwd%00');
	$i = new_ok('CGI::Info');
	lives_ok { %p = %{$i->params()}; };
	like($p{'file'}, qr/passwd$/, 'strip NUL byte poison');

	@ARGV = ('--mobile', 'foo=bar', 'fred=wilma' );
	$i = new_ok('CGI::Info');
	%p = %{$i->params()};
	ok($p{fred} eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');
	ok($i->is_mobile());

	@ARGV = ('--tablet', 'foo=bar', 'fred=wilma' );
	$i = new_ok('CGI::Info');
	%p = %{$i->params()};
	ok($p{fred} eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');
	ok(!$i->is_mobile());
	ok($i->is_tablet());

	@ARGV = ('--search-engine', 'foo=bar', 'fred=wilma' );
	$i = new_ok('CGI::Info');
	%p = %{$i->params()};
	ok($p{fred} eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');
	ok(!$i->is_mobile());
	ok($i->is_search_engine());

	@ARGV = ('--robot', 'foo=bar', 'fred=wilma' );
	$i = new_ok('CGI::Info');
	%p = %{$i->params()};
	ok($p{fred} eq 'wilma');
	ok($i->as_string() eq 'foo=bar; fred=wilma');
	ok(!$i->is_mobile());
	ok(!$i->is_search_engine());
	ok($i->is_robot());
	ok($i->status() == 200);

	eval {
		$i->reset();
	};

	ok($@ =~ /Reset is a class method/);

	delete $ENV{'CONTENT_TYPE'};
	delete $ENV{'CONTENT_LENGTH'};
	$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
	$ENV{'REQUEST_METHOD'} = 'GET';

	# Test that a message about SQL injection is logged
	{
		local $ENV{'QUERY_STRING'} = 'nan=lost&redir=-8717%22%20OR%208224%3D6013--%20ETLn';
		local $ENV{'REMOTE_ADDR'} = '127.0.0.1';
		my $mess = 'mess is undefined';

		{
			package MockLogger;

			sub new { bless { }, shift }
			sub trace { }
			sub debug { }
			sub warn { shift; $mess = (ref($_[0]) eq 'ARRAY') ? join(' ', @{$_[0]}) : join(' ' , @_) }
		}

		my $info = new_ok('CGI::Info');
		my $params = $info->params(logger => MockLogger->new());
		like($mess, qr/SQL injection attempt blocked/, 'Correct message when blocking SQL injection');

		cmp_ok($info->status(), '==', 403, 'SQL injection causes HTTP code 403');
	}

	$ENV{'QUERY_STRING'} = 'country=/etc/passwd&page=by_location';
	$i = new_ok('CGI::Info');

	my $allow = {
		'entry' => undef,
		'country' => qr/^[A-Z\s]+$/i,	# Must start with a letter
		'county' => qr/^[A-Z\s]+$/i,
		'string' => undef,
		'page' => 'by_location',
		'lang' => qr/^[A-Z]{2}/i,
	};

	my %params = %{$i->params({ allow => $allow })};

	cmp_ok($params{'page'}, 'eq', 'by_location', 'allow lets through legal parameters');
	is($params{'country'}, undef, 'allow blocks illegal parameters');
	cmp_ok($i->status(), '==', 422, 'HTTP Unprocessable Content');
}