view release on metacpan or  search on metacpan

t/path.t  view on Meta::CPAN

#     127.x.x.x                       -> 0            [C]
#     0.0.0.0                         -> 0            [D]
#     ::1                             -> 0            [E]
#   Hostname (not IP): return 1       -> 1            [F]
#   Dotted-quad, inet_aton fails      -> 1            [G]
#   Private ranges:
#     10/8                            -> 0            [H]
#     172.16/12                       -> 0            [I]
#     192.168/16                      -> 0            [J]
#     169.254/16 (link-local)         -> 0            [K]
#     100.64/10 (CGNAT)               -> 0            [L]
#   Public IP (8.8.8.8)               -> 1            [M]
# ======================================================================

subtest '_is_safe_url path-A: no https?:// protocol -> 0' => sub {
	ok !$IS_SAFE->('ftp://example.com'), 'path A: ftp:// is not safe (blocked)';
};

subtest '_is_safe_url path-B: localhost -> 0' => sub {
	ok !$IS_SAFE->('http://localhost/api'), 'path B: localhost blocked';
};

subtest '_is_safe_url path-C: 127.x.x.x -> 0' => sub {
	ok !$IS_SAFE->('http://127.0.0.1/'), 'path C: 127.0.0.1 blocked';
	ok !$IS_SAFE->('http://127.255.255.255/'), 'path C: 127.x.x.x upper bound blocked';
};

subtest '_is_safe_url path-D: 0.0.0.0 -> 0' => sub {
	ok !$IS_SAFE->('http://0.0.0.0/'), 'path D: 0.0.0.0 blocked';
};

subtest '_is_safe_url path-E: ::1 (IPv6 loopback) -> 0' => sub {
	ok !$IS_SAFE->('http://::1/'), 'path E: ::1 blocked';
};

subtest '_is_safe_url path-F: hostname (not IP) -> 1 (allowed)' => sub {
	ok $IS_SAFE->('https://example.com/data.csv'), 'path F: public hostname allowed';
};

subtest '_is_safe_url path-G: dotted-quad but invalid octet -> inet_aton undef -> 1' => sub {
	# 256.0.0.1 passes the dotted-quad regex but inet_aton returns undef.
	# The "or return 1" guard handles this; the IP cannot be checked against ranges.
	ok $IS_SAFE->('http://256.0.0.1/'), 'path G: invalid octet -> inet_aton undef -> pass';
};

subtest '_is_safe_url path-H: 10.x.x.x (RFC 1918) -> 0' => sub {
	ok !$IS_SAFE->('http://10.0.0.1/'),    'path H: 10.0.0.1 blocked';
	ok !$IS_SAFE->('http://10.255.255.254/'), 'path H: 10.255.255.254 blocked';
};

subtest '_is_safe_url path-I: 172.16-31.x.x (RFC 1918) -> 0' => sub {
	ok !$IS_SAFE->('http://172.16.0.1/'), 'path I: 172.16.x.x blocked';
	ok !$IS_SAFE->('http://172.31.255.254/'), 'path I: 172.31.x.x upper bound blocked';
};

subtest '_is_safe_url path-J: 192.168.x.x (RFC 1918) -> 0' => sub {
	ok !$IS_SAFE->('http://192.168.0.1/'), 'path J: 192.168.x.x blocked';
};

subtest '_is_safe_url path-K: 169.254.x.x (link-local / metadata) -> 0' => sub {
	ok !$IS_SAFE->('http://169.254.169.254/latest/meta-data/'), 'path K: AWS metadata endpoint blocked';
};

subtest '_is_safe_url path-L: 100.64.x.x (CGNAT / Tailscale) -> 0' => sub {
	ok !$IS_SAFE->('http://100.64.0.1/'), 'path L: CGNAT range blocked';
};

subtest '_is_safe_url path-M: public IP 8.8.8.8 -> 1 (no private range matches)' => sub {
	ok $IS_SAFE->('http://8.8.8.8/'), 'path M: public IP 8.8.8.8 allowed';
};

# ======================================================================
# PATH COVERAGE: Dashboard::_get_columns
#
# CFG:
#   A: source->columns returns arrayref -> return it directly
#   B: columns undef, no records        -> return ()
#   C: columns undef, records, id_col in data -> id_col first
#   D: columns undef, records, id_col absent from data -> alphabetical
# ======================================================================

{
	# Helper: build a fake DataSource object with controlled columns/id_column.
	sub fake_source {
		my ($cols, $id_col) = @_;
		return bless { _columns => $cols, _id_col => $id_col },
			'Database::BI::Model::DataSource';
	}

	subtest '_get_columns path-A: source->columns returns arrayref -> returned' => sub {
		my $src    = fake_source([qw(product amount region)], 'product');
		my @result = $GET_COLS->($src, []);
		is_deeply \@result, [qw(product amount region)], 'path A: columns arrayref returned as-is';
	};

	subtest '_get_columns path-B: columns undef, no records -> empty list' => sub {
		my $src    = fake_source(undef, 'id');
		my @result = $GET_COLS->($src, []);
		is_deeply \@result, [], 'path B: no columns + no records -> ()';
	};

	subtest '_get_columns path-C: columns undef, id_col present in data -> id_col first' => sub {
		my $src    = fake_source(undef, 'id');
		my @result = $GET_COLS->($src, [{ id => '1', amount => '10', region => 'N' }]);
		is $result[0], 'id', 'path C: id_column appears first';
		is_deeply [sort @result[1..$#result]], [qw(amount region)], 'path C: rest sorted alphabetically';
	};

	subtest '_get_columns path-D: columns undef, id_col absent from data -> alphabetical' => sub {
		my $src    = fake_source(undef, 'entry');   # 'entry' not in data
		my @result = $GET_COLS->($src, [{ amount => '10', region => 'N' }]);
		is $result[0], 'amount', 'path D: alphabetical first col (amount) used as id';
		is $result[1], 'region', 'path D: second col follows';
	};
}

# ======================================================================
# PATH COVERAGE: Dashboard::_spec_to_url
#
# CFG (cascading if/elsif with immediate returns):
#   A: table: spec  -> /view/<name>