view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

		"en&& rm -rf /",
	);
	for my $payload (@payloads) {
		local %ENV = (
			HTTP_ACCEPT_LANGUAGE => $payload,
			REMOTE_ADDR          => $IP{LOOPBACK},
		);
		my @warnings;
		Test::Mockingbird::mock('CGI::Lingua', '_warn',
			sub { push @warnings, $_[1] });
		my $l = _obj([$LANG{EN}]);
		$l->language();
		ok((grep { ref($_) ? $_->{warning} =~ /invalid/i : /invalid/i } @warnings),
			"Shell metachar payload '$payload' is rejected");
		Test::Mockingbird::restore_all();
		_block_network();
	}
};

subtest 'HTTP_ACCEPT_LANGUAGE: SQL injection payload rejected' => sub {
	# Single-quote is not in the allowed class.
	local %ENV = (
		HTTP_ACCEPT_LANGUAGE => "en' OR '1'='1",
		REMOTE_ADDR          => $IP{LOOPBACK},
	);
	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	$l->language();
	ok((grep { ref($_) ? $_->{warning} =~ /invalid/i : /invalid/i } @warnings),
		"SQL injection payload is rejected");
	Test::Mockingbird::restore_all();
	_block_network();
};

subtest 'HTTP_ACCEPT_LANGUAGE: newline embedded in header is rejected (log-injection guard)' => sub {
	# \n IS in \s, which is in the character class, so a naive test might
	# accept it.  However the `/a` flag combined with $ (end-anchor without
	# /m) means that the character-class capture must consume the ENTIRE string
	# (including the second line).  The colon in "X-Header: value" is NOT in
	# the class, so multi-line injection payloads are rejected.
	local %ENV = (
		HTTP_ACCEPT_LANGUAGE => "en\nX-Injected-Header: value",
		REMOTE_ADDR          => $IP{LOOPBACK},
	);
	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	$l->language();
	ok((grep { ref($_) ? $_->{warning} =~ /invalid/i : /invalid/i } @warnings),
		'Header-injection payload with colon is rejected');
	Test::Mockingbird::restore_all();
	_block_network();
};

subtest 'HTTP_ACCEPT_LANGUAGE: Unicode content rejected by /a flag' => sub {
	# The /a flag restricts \w, \d, \s to ASCII-only, blocking multi-byte
	# Unicode that would otherwise match [A-Za-z0-9].
	# Setting Unicode in %ENV produces a "Wide character in setenv" warning on
	# some platforms; suppress it so the test is portable.
	local %ENV = (REMOTE_ADDR => $IP{LOOPBACK});
	{ local $SIG{__WARN__} = sub {};
	  $ENV{HTTP_ACCEPT_LANGUAGE} = "zh-\x{4e2d}\x{6587}" }    # zh-中文

	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	$l->language();
	ok((grep { ref($_) ? $_->{warning} =~ /invalid/i : /invalid/i } @warnings),
		'Unicode in Accept-Language is rejected (ASCII-only mode)');
	Test::Mockingbird::restore_all();
	_block_network();
};

# ═══════════════════════════════════════════════════════════════════════════════
# SECTION 3: REMOTE_ADDR injection and boundary conditions
#
# Strategy: probe the IP-validation regex
#   IPv4: /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/a
#   IPv6: /^([0-9a-fA-F:]{2,39})$/a
# and the subsequent Data::Validate::IP checks.
# ═══════════════════════════════════════════════════════════════════════════════

subtest 'REMOTE_ADDR: command injection rejected before any geo lookup' => sub {
	# The semicolon is not in either IP regex, so this is blocked at the
	# untaint step — no geo module or shell is ever called.
	local %ENV = (REMOTE_ADDR => '8.8.8.8;rm -rf /');
	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	my $cc = $l->country();
	ok(!defined $cc, 'Command-injection REMOTE_ADDR returns undef');
	ok((grep { ref($_) ? $_->{warning} =~ /valid IP/i : /valid IP/i } @warnings),
		'_warn fired for injection attempt in REMOTE_ADDR');
	Test::Mockingbird::restore_all();
	_block_network();
};

subtest 'REMOTE_ADDR: path traversal rejected' => sub {
	local %ENV = (REMOTE_ADDR => '../etc/passwd');
	my $l = _obj([$LANG{EN}]);
	ok(!defined $l->country(), 'Path traversal REMOTE_ADDR returns undef');
};

subtest 'REMOTE_ADDR: out-of-range octet handled by Data::Validate::IP' => sub {
	# "999.1.1.1" matches \d{1,3} (each octet can be 1-3 digits) but
	# Data::Validate::IP::is_ipv4 rejects octets > 255.
	local %ENV = (REMOTE_ADDR => '999.1.1.1');
	my @warnings;
	Test::Mockingbird::mock('CGI::Lingua', '_warn',
		sub { push @warnings, $_[1] });
	my $l = _obj([$LANG{EN}]);
	my $cc = $l->country();
	ok(!defined $cc,
		'Out-of-range octet address returns undef');
	Test::Mockingbird::restore_all();
	_block_network();