view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

	} 'extra unknown keys do not cause a crash';

	like $out, qr/Carp/, 'normal output produced despite extra keys';
};

subtest 'generate: list context returns exactly one Str element' => sub {
	# The POD says Returns: Str.  Calling in list context must yield a
	# single-element list, not an accidentally exploded multi-value return.
	my $g  = empty_home();
	my $mf = make_mf($MF_SIMPLE);

	my @result = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 0,
	);

	is   scalar @result, 1,    'list context: exactly one element returned';
	ok   !ref $result[0],      'the element is a plain Str (not a reference)';
	like $result[0], qr/\n$/, 'the value ends with a newline';
};

# -----------------------------------------------------------------------
# SECTION 3: Security — module name content via YAML config
# -----------------------------------------------------------------------

subtest 'security: YAML config module name with single quote is rejected (injection guard)' => sub {
	# VULN-1 regression: a YAML config key such as
	#   Safe'; system('evil'); requires 'Safe2
	# used to reach _fmt_dep and produce a syntactically valid cpanfile line
	# that cpanm eval's, executing the injected command.
	#
	# After the fix, _load_develop_config validates every key against a strict
	# Perl module-name pattern and skips (with carp) anything that does not
	# match.  A key containing "'" can never be a valid module name.
	my $g  = home_with_config( { develop => { "Bad'Quote" => 0 } } );
	my $mf = make_mf($MF_SIMPLE);

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	my $out;
	lives_ok {
		$out = App::makefilepl2cpanfile::generate(
			makefile     => "$mf",
			with_develop => 1,
		);
	} 'invalid module name in config does not crash generate()';

	unlike $out, qr/Bad/,
		"module name containing \"'\" is rejected — does not reach output";
	ok scalar @warnings > 0,
		'carp emitted for rejected module name';
	like $warnings[0], qr/invalid module name/i,
		'carp message identifies the problem';

	diag "Output:\n$out\nWarnings: @warnings" if $ENV{TEST_VERBOSE};
};

subtest 'security: YAML config crafted name that would inject code is rejected' => sub {
	# Confirm the most dangerous payload — a name that closes the single-quoted
	# string and inserts a system() call — is blocked before it can reach
	# _fmt_dep and appear in the cpanfile.
	Readonly my $PAYLOAD => "Safe'; warn q(INJECTED); requires 'Safe2";

	my $g  = home_with_config( { develop => { $PAYLOAD => 0 } } );
	my $mf = make_mf($MF_SIMPLE);

	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 1,
	);

	unlike $out, qr/INJECTED/,
		'injection payload does not appear in generated cpanfile';
	unlike $out, qr/warn/,
		'warn() call is not present in generated cpanfile';

	# Verify the output is safe to eval (no injection triggered).
	my $eval_warned = 0;
	local $SIG{__WARN__} = sub { $eval_warned = 1 };
	eval q{ sub requires {} sub on { my ($p, $cb) = @_; $cb->() } } . $out;
	ok !$eval_warned && !$@,
		'generated cpanfile evals cleanly with no injected side-effects';
};

subtest 'security: YAML config poisoned version string is rejected (VULN-2)' => sub {
	# VULN-2 regression: a YAML version value such as
	#   "1'; warn q(VERSION_INJECTED); '1"
	# used to pass _has_version (non-numeric → truthy) and be embedded as
	# ", '$ver'" in _fmt_dep, injecting executable Perl into the cpanfile.
	Readonly my $POISON_VER => "1'; warn q(VERSION_INJECTED); '1";

	my $g  = home_with_config( { develop => { 'Safe::Mod' => $POISON_VER } } );
	my $mf = make_mf($MF_SIMPLE);

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	my $out = App::makefilepl2cpanfile::generate(
		makefile     => "$mf",
		with_develop => 1,
	);

	unlike $out, qr/VERSION_INJECTED/,
		'poisoned version string does not appear in generated cpanfile';

	# The module itself must still be present (version falls back to 0).
	like $out, qr/Safe::Mod/,
		'module with invalid version is still emitted (version defaults to 0)';

	ok scalar @warnings > 0,
		'carp emitted for rejected version string';
	like $warnings[0], qr/invalid version/i,
		'carp message identifies the rejected version';
};

subtest 'security: valid YAML config module names and versions are accepted' => sub {
	# Confirm the validation rejects only invalid entries, not valid ones.
	my $g  = home_with_config( {
		develop => {
			'Perl::Critic'        => 0,

t/edge_cases.t  view on Meta::CPAN

	# directory was resolved (e.g. an NFS mount that went stale between
	# the my_home() call and the subsequent is_file() check on the config path).
	# The error must propagate out of generate() without being swallowed.
	my $g_home   = empty_home();
	my $mf       = make_mf($MF_SIMPLE);
	my $g_isfile = mock_scoped 'Path::Tiny::is_file' => sub {
		die "stat(): Stale NFS file handle\n";
	};

	throws_ok {
		App::makefilepl2cpanfile::generate(
			makefile     => "$mf",
			with_develop => 1,    # triggers _load_develop_config -> is_file
		)
	} qr/stat\(\).*Stale NFS/,
		'Path::Tiny::is_file failure propagates from _load_develop_config';
};

# -----------------------------------------------------------------------
# SECTION 8: Mid-flight Hardware/OS Failure Simulation
#
# Injects POSIX errno-flavoured failures into the I/O wrapper layer
# (Path::Tiny, YAML::Tiny) AFTER the readability guards have already
# passed.  This simulates hardware faults, TOCTOU races, interrupted
# syscalls, and truncated reads that cannot be detected by file-test
# operators before the call.
#
# Three invariants are verified throughout:
#   1. The error propagates unmasked from generate().
#   2. No global Perl state ($@, Readonly constants) is corrupted.
#   3. A subsequent call with working I/O produces correct output.
# -----------------------------------------------------------------------

# OS-canonical errno strings derived from Perl's $! layer rather than
# POSIX::strerror() to stay locale-consistent (see locales.t guidance).
Readonly my $MSG_EIO    => do { local $! = EIO;    "$!" };
Readonly my $MSG_ENOSPC => do { local $! = ENOSPC; "$!" };
Readonly my $MSG_EINTR  => do { local $! = EINTR;  "$!" };
Readonly my $MSG_ENOENT => do { local $! = ENOENT; "$!" };
Readonly my $MSG_ENOMEM => do { local $! = ENOMEM; "$!" };

subtest 'io-failure-read: EIO (hardware fault) mid-slurp — propagates with POSIX errno string' => sub {
	# A hardware read error (disk controller failure, bit-rot) that occurs
	# AFTER the -f / -r guard has already confirmed the file's existence.
	# Strategy: file is real (passes guard); slurp_utf8 is mocked to die
	# with local $! = EIO, matching what the kernel would set.
	my $g_home  = empty_home();
	my $mf      = make_mf($MF_SIMPLE);
	my $g_slurp = mock_scoped 'Path::Tiny::slurp_utf8' => sub {
		local $! = EIO;
		die "read: $!\n";
	};

	throws_ok {
		App::makefilepl2cpanfile::generate(makefile => "$mf", with_develop => 0)
	} qr/\Q$MSG_EIO\E/,
		"EIO mid-slurp propagates with canonical '$MSG_EIO' string";
};

subtest 'io-failure-read: EINTR (interrupted syscall) mid-slurp — propagates' => sub {
	# An async signal (SIGALRM, SIGTERM) arrived while sysread() was blocked.
	# The kernel set errno = EINTR.  Path::Tiny does not automatically retry;
	# the exception propagates to generate()'s caller.
	my $g_home  = empty_home();
	my $mf      = make_mf($MF_SIMPLE);
	my $g_slurp = mock_scoped 'Path::Tiny::slurp_utf8' => sub {
		local $! = EINTR;
		die "sysread: $!\n";
	};

	throws_ok {
		App::makefilepl2cpanfile::generate(makefile => "$mf", with_develop => 0)
	} qr/\Q$MSG_EINTR\E/,
		"EINTR mid-slurp propagates with canonical '$MSG_EINTR' string";
};

subtest 'io-failure-read: ENOENT (TOCTOU race) — file removed between guard and slurp' => sub {
	# Race window: another process deletes Makefile.PL after the -f/-r check
	# passes (TOCTOU).  slurp_utf8 then fails with ENOENT.  The error must
	# propagate clearly and not be confused with the Cannot-read guard croak.
	my $g_home  = empty_home();
	my $mf      = make_mf($MF_SIMPLE);
	my $g_slurp = mock_scoped 'Path::Tiny::slurp_utf8' => sub {
		local $! = ENOENT;
		die "open: $!\n";
	};

	throws_ok {
		App::makefilepl2cpanfile::generate(makefile => "$mf", with_develop => 0)
	} qr/\Q$MSG_ENOENT\E/,
		"ENOENT from TOCTOU race propagates with canonical '$MSG_ENOENT' string";
};

subtest 'io-failure-read: ENOMEM (OOM) during Makefile.PL buffer allocation — propagates' => sub {
	# The kernel cannot allocate the page-cache buffer for the file content.
	# Possible under strict cgroup memory limits in containers.
	my $g_home  = empty_home();
	my $mf      = make_mf($MF_SIMPLE);
	my $g_slurp = mock_scoped 'Path::Tiny::slurp_utf8' => sub {
		local $! = ENOMEM;
		die "mmap: $!\n";
	};

	throws_ok {
		App::makefilepl2cpanfile::generate(makefile => "$mf", with_develop => 0)
	} qr/\Q$MSG_ENOMEM\E/,
		"ENOMEM during buffer alloc propagates with canonical '$MSG_ENOMEM' string";
};

subtest 'io-failure-read: unexpected EOF — slurp_utf8 returns truncated Makefile.PL' => sub {
	# Simulate a file whose size shrank between stat() and read() (a log
	# rotator truncated the wrong file, or a network FS returned a stale
	# inode size).  The truncated string ends mid-PREREQ_PM (no closing
	# brace), so generate() must return a valid header-only cpanfile, not
	# a partial or malformed entry.
	my $g_home  = empty_home();
	my $mf      = make_mf($MF_SIMPLE);
	my $g_slurp = mock_scoped 'Path::Tiny::slurp_utf8' => sub {
		return "WriteMakefile(PREREQ_PM => { \x27Carp\x27 =>";    # truncated mid-value
	};