view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

};

# ---------------------------------------------------------------------------
# Subtest: _new_from_url -- invalid URL scheme is rejected
# ---------------------------------------------------------------------------
subtest 'DataSource::_new_from_url -- invalid URL scheme croaks' => sub {
	throws_ok { $DS->new(url => 'ftp://example.com/data.csv') }
		qr/must begin with http/i,
		'croaks for ftp:// URL';

	throws_ok { $DS->new(url => 'file:///etc/passwd') }
		qr/must begin with http/i,
		'croaks for file:// URL';

	throws_ok { $DS->new(url => 'javascript:alert(1)') }
		qr/must begin with http/i,
		'croaks for javascript: pseudo-URL';
};

# ============================================================================
# PART 2: Database::BI::Controller::Dashboard -- pure-function helpers
#
# These subs are not :Private and survive stash cleanup, so they can be
# called as plain functions without a Mojolicious controller context.
# ============================================================================

my $D = 'Database::BI::Controller::Dashboard';

# ---------------------------------------------------------------------------
# Subtest: _is_safe_url -- SSRF guard
#
# Each blocked range has a representative, a boundary, and a just-safe IP.
# Non-IP hostnames must always pass (firewall handles those).
# ---------------------------------------------------------------------------
subtest '_is_safe_url -- loopback aliases are blocked' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_is_safe_url;

	ok !$fn->('http://localhost/'),           'localhost blocked';
	ok !$fn->('http://localhost:8080/path'),  'localhost with port blocked';
	ok !$fn->('https://localhost/'),          'https://localhost blocked';
	ok !$fn->('http://127.0.0.1/'),           '127.0.0.1 blocked';
	ok !$fn->('http://127.255.255.255/'),     '127.255.255.255 blocked (127/8)';
	ok !$fn->('http://0.0.0.0/'),             '0.0.0.0 blocked';
	ok !$fn->('http://[::1]/'),               'IPv6 ::1 blocked';
};

subtest '_is_safe_url -- RFC 1918 private ranges are blocked' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_is_safe_url;

	ok !$fn->('http://10.0.0.1/'),            '10.0.0.1 blocked (10/8)';
	ok !$fn->('http://10.255.255.255/'),      '10.255.255.255 blocked (10/8 boundary)';
	ok !$fn->('http://172.16.0.1/'),          '172.16.0.1 blocked (172.16/12)';
	ok !$fn->('http://172.31.255.255/'),      '172.31.255.255 blocked (172.16/12 boundary)';
	ok !$fn->('http://192.168.0.1/'),         '192.168.0.1 blocked (192.168/16)';
	ok !$fn->('http://192.168.255.255/'),     '192.168.255.255 blocked (192.168/16 boundary)';
};

subtest '_is_safe_url -- link-local and CGNAT ranges are blocked' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_is_safe_url;

	ok !$fn->('http://169.254.169.254/'),     'AWS metadata endpoint blocked (169.254/16)';
	ok !$fn->('http://169.254.0.1/'),         '169.254.0.1 blocked (link-local)';
	ok !$fn->('http://100.64.0.1/'),          '100.64.0.1 blocked (CGNAT 100.64/10)';
	ok !$fn->('http://100.127.255.255/'),     '100.127.255.255 blocked (CGNAT boundary)';
};

subtest '_is_safe_url -- public addresses are allowed' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_is_safe_url;

	ok $fn->('http://8.8.8.8/'),              '8.8.8.8 (Google DNS) allowed';
	ok $fn->('http://1.1.1.1/'),              '1.1.1.1 (Cloudflare) allowed';
	ok $fn->('https://example.com/data'),     'example.com hostname allowed';
	ok $fn->('http://internal.corp.example/'), 'internal hostname allowed (firewall handles it)';

	# Just outside blocked ranges
	ok $fn->('http://11.0.0.1/'),             '11.0.0.1 allowed (outside 10/8)';
	ok $fn->('http://172.32.0.1/'),           '172.32.0.1 allowed (outside 172.16/12)';
	ok $fn->('http://192.169.0.1/'),          '192.169.0.1 allowed (outside 192.168/16)';
	ok $fn->('http://100.128.0.1/'),          '100.128.0.1 allowed (outside 100.64/10)';
};

subtest '_is_safe_url -- non-http scheme returns 0' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_is_safe_url;

	ok !$fn->('ftp://example.com/'),          'ftp:// returns 0 (no http/https match)';
	ok !$fn->('file:///etc/passwd'),           'file:// returns 0';
	ok !$fn->(''),                             'empty string returns 0';
};

# ---------------------------------------------------------------------------
# Subtest: _get_columns -- column ordering logic
#
# For CSV/PSV the source stores the original file-header order.
# For SQLite/XML (columns() returns undef), the fallback puts id_column first
# then alphabetical order.
# ---------------------------------------------------------------------------
subtest '_get_columns -- returns file-header order for CSV source' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_get_columns;

	# Mock a DataSource that has an ordered column list (CSV case).
	my $mock_src = bless {}, 'FakeDS_CSV';
	{
		no strict 'refs';
		*{'FakeDS_CSV::columns'}   = sub { [qw(id product region amount)] };
		*{'FakeDS_CSV::id_column'} = sub { 'id' };
	}

	my @cols = $fn->($mock_src, [{ id => 1, product => 'x' }]);
	is_deeply \@cols, [qw(id product region amount)],
		'preserves file-header order from columns()';
};

subtest '_get_columns -- fallback alphabetical order when columns() is undef' => sub {
	my $fn = \&Database::BI::Controller::Dashboard::_get_columns;

	# Mock a DataSource where columns() returns undef (SQLite/XML case).
	my $mock_src = bless {}, 'FakeDS_SQLite';
	{
		no strict 'refs';
		*{'FakeDS_SQLite::columns'}   = sub { undef };
		*{'FakeDS_SQLite::id_column'} = sub { 'id' };