From 17790f03ddb178e2fc2a9afbd7e4e82fda136769 Mon Sep 17 00:00:00 2001 From: yuu-no Date: Fri, 8 May 2026 14:51:38 +0900 Subject: [PATCH] fix: filter @INC hook refs from yath startup snapshot and process_includes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Tools like Carmel inject blessed @INC hooks via PERL5OPT=-MCarmel::Setup. yath snapshots @INC into two places that all assume plain strings: * App::Yath::Script::V1::call (settings->harness->orig_inc) — JSON encoded by write_settings_to and stringified into child -I flags. * Test2::Harness::Util::process_includes(include_current => 1) — runs through clean_path (realpath/rel2abs) which stringifies refs to bogus "HASH(0x...)" / "CODE(0x...)" / "ARRAY(0x...)" paths, then those leak into child -I flags. Filter refs at both snapshot points. Hook refs cannot survive an exec boundary as -I args anyway; the child reruns whatever PERL5OPT injection the parent had. Tests cover all three @INC hook forms documented in perlvar "@INC" (blessed object, coderef, arrayref) end-to-end through `yath test`. Co-Authored-By: Claude Opus 4.7 (1M context) --- lib/App/Yath/Script/V1.pm | 3 +- lib/Test2/Harness/Util.pm | 3 +- t/integration/inc_hook.t | 63 ++++++++++++++++++++++++++ t/integration/inc_hook/ArrayrefHook.pm | 7 +++ t/integration/inc_hook/CoderefHook.pm | 7 +++ t/integration/inc_hook/FakeHook.pm | 10 ++++ t/integration/inc_hook/simple.tx | 5 ++ 7 files changed, 96 insertions(+), 2 deletions(-) create mode 100644 t/integration/inc_hook.t create mode 100644 t/integration/inc_hook/ArrayrefHook.pm create mode 100644 t/integration/inc_hook/CoderefHook.pm create mode 100644 t/integration/inc_hook/FakeHook.pm create mode 100644 t/integration/inc_hook/simple.tx diff --git a/lib/App/Yath/Script/V1.pm b/lib/App/Yath/Script/V1.pm index 2f60b1879..2ce9c39a5 100644 --- a/lib/App/Yath/Script/V1.pm +++ b/lib/App/Yath/Script/V1.pm @@ -21,7 +21,8 @@ sub do_begin { my $ORIG_TMP_PERMS; my %ORIG_SIG = map { defined($SIG{$_}) ? ($_ => "$SIG{$_}") : () } keys %SIG; my @ORIG_ARGV = @$argv; - my @ORIG_INC = @INC; + # Skip @INC hook refs (coderef / arrayref / blessed); they can't cross exec via -I nor round-trip JSON. + my @ORIG_INC = grep { ref $_ eq '' } @INC; my %CONFIG; @ARGV = @$argv; diff --git a/lib/Test2/Harness/Util.pm b/lib/Test2/Harness/Util.pm index 9e408aea5..2c5070cb5 100644 --- a/lib/Test2/Harness/Util.pm +++ b/lib/Test2/Harness/Util.pm @@ -104,7 +104,8 @@ sub process_includes { @list = @start; } - push @list => @INC if delete $params{include_current}; + # Skip @INC hook refs; clean_path would stringify them to bogus paths. + push @list => grep { ref $_ eq '' } @INC if delete $params{include_current}; @list = map { $_ eq '.' ? $_ : clean_path($_) || $_ } @list if delete $params{clean}; diff --git a/t/integration/inc_hook.t b/t/integration/inc_hook.t new file mode 100644 index 000000000..6bb492a48 --- /dev/null +++ b/t/integration/inc_hook.t @@ -0,0 +1,63 @@ +use Test2::V0; + +use File::Spec; + +use App::Yath::Tester qw/yath/; + +use App::Yath::Util qw/find_yath/; +find_yath(); + +my $dir = __FILE__; +$dir =~ s{\.t$}{}g; + +my $hook_dir = File::Spec->rel2abs($dir); +my $target = File::Spec->catfile($hook_dir, 'simple.tx'); + +# Each fixture injects one of the three @INC hook forms documented in +# perlvar "@INC": blessed object, coderef, arrayref. Without filtering, +# the ref would be snapshotted into settings->harness->orig_inc, crash +# JSON encoding in write_settings_to, and inject "HASH(0x...)" / +# "CODE(0x...)" / "ARRAY(0x...)" garbage paths into child -I flags. +my @cases = ( + { + name => 'blessed object hook', + module => 'FakeHook', + ref_re => qr/FakeHook=HASH\(/, + }, + { + name => 'coderef hook', + module => 'CoderefHook', + ref_re => qr{/CODE\(0x}, + }, + { + name => 'arrayref hook', + module => 'ArrayrefHook', + ref_re => qr{/ARRAY\(0x}, + }, +); + +for my $case (@cases) { + yath( + command => 'test', + args => [$target], + env => { + PERL5OPT => "-I$hook_dir -M$case->{module}", + }, + exit => 0, + test => sub { + my $out = shift; + unlike( + $out->{output}, + qr/encountered object/, + "$case->{name}: no JSON encode error", + ); + unlike( + $out->{output}, + $case->{ref_re}, + "$case->{name}: no stringified ref leaked into output", + ); + }, + ); +} + +done_testing; diff --git a/t/integration/inc_hook/ArrayrefHook.pm b/t/integration/inc_hook/ArrayrefHook.pm new file mode 100644 index 000000000..6e8226c5a --- /dev/null +++ b/t/integration/inc_hook/ArrayrefHook.pm @@ -0,0 +1,7 @@ +package ArrayrefHook; +use strict; +use warnings; + +unshift @INC, [sub { return }]; + +1; diff --git a/t/integration/inc_hook/CoderefHook.pm b/t/integration/inc_hook/CoderefHook.pm new file mode 100644 index 000000000..6820f10b6 --- /dev/null +++ b/t/integration/inc_hook/CoderefHook.pm @@ -0,0 +1,7 @@ +package CoderefHook; +use strict; +use warnings; + +unshift @INC, sub { return }; + +1; diff --git a/t/integration/inc_hook/FakeHook.pm b/t/integration/inc_hook/FakeHook.pm new file mode 100644 index 000000000..acc5a533d --- /dev/null +++ b/t/integration/inc_hook/FakeHook.pm @@ -0,0 +1,10 @@ +package FakeHook; +use strict; +use warnings; + +# INC is a special identifier that lives in main::, hence the FQN. +sub FakeHook::INC { return } + +unshift @INC, bless({}, __PACKAGE__); + +1; diff --git a/t/integration/inc_hook/simple.tx b/t/integration/inc_hook/simple.tx new file mode 100644 index 000000000..4aae73687 --- /dev/null +++ b/t/integration/inc_hook/simple.tx @@ -0,0 +1,5 @@ +use Test2::V0; + +ok(1, 'basic test runs under @INC hook'); + +done_testing;