From 6818ff3b3f238cf40f89c6117e86d90f30907df2 Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Wed, 29 Mar 2023 11:51:05 +0200 Subject: [PATCH 1/4] Config.pm - add taint_disabled and taint_support to %Config This adds 'taint_disabled' and 'taint_support' to Config.pm and %Config. This way people can use them while we decide what to do about the changes to Configure. We shouldn't need to have Configure changed to export status variables like this in Config.pm See: https://github.com/Perl-Toolchain-Gang/Test-Harness/pull/118 and: https://github.com/Perl/perl5/pull/20972 for related work that is stalled because we have not decided what to do about these variables. --- configpm | 96 ++++++++++++++++++++++++++++++++++++++++------------ lib/Config.t | 33 ++++++++++++++++++ 2 files changed, 107 insertions(+), 22 deletions(-) diff --git a/configpm b/configpm index 8ee45c05cc4c..166080b44536 100755 --- a/configpm +++ b/configpm @@ -576,6 +576,8 @@ $_ = <<'!END!'; EOT #proper lexicographical order of the keys my %seen_var; +my @v_define = ( "taint_support=''\n", + "taint_disabled=''\n" ); $heavy_txt .= join('', map { $_->[-1] } sort {$a->[0] cmp $b->[0] } @@ -583,7 +585,7 @@ $heavy_txt .= join('', map { /^([^=]+)/ ? [ $1, $_ ] : [ $_, $_ ] # shouldnt happen - } @v_others, @v_forced + } (@v_others, @v_forced, @v_define) ) . "!END!\n"; # Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of @@ -594,6 +596,32 @@ if ($Common{byteorder}) { $heavy_txt .= $byteorder_code; } +$heavy_txt .= <<'EOT'; +s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m; + +EOT + +$heavy_txt .= <<'EOF_TAINT_INIT'; +{ + # We have to set this up late as Win32 does not build miniperl + # with the same defines and CC flags as it builds perl itself. + my $defines = join " ", (Internals::V)[0,1]; + if ( + $defines =~ /\b(SILENT_NO_TAINT_SUPPORT)\b/ || + $defines =~ /\b(NO_TAINT_SUPPORT)\b/ + ){ + my $which = $1; + my $taint_disabled = ($which eq "SILENT_NO_TAINT_SUPPORT") + ? "silent" : "define"; + s/^(taint_disabled=['"])(["'])/$1$taint_disabled$2/m; + } + else { + my $taint_support = 'define'; + s/^(taint_support=['"])(["'])/$1$taint_support$2/m; + } +} +EOF_TAINT_INIT + if (@need_relocation) { $heavy_txt .= 'foreach my $what (qw(' . join (' ', @need_relocation) . ")) {\n" . <<'EOT'; @@ -612,8 +640,6 @@ EOT } $heavy_txt .= <<'EOT'; -s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m; - my $config_sh_len = length $_; our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL'; @@ -1014,29 +1040,21 @@ ENDOFTAIL if ($Opts{glossary}) { open(GLOS, '<', $Glossary) or die "Can't open $Glossary: $!"; } -my %seen = (); my $text = 0; $/ = ''; my $errors= 0; -sub process { - if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) { - my $c = substr $1, 0, 1; - unless ($seen{$c}++) { - print CONFIG_POD <\n\nFrom F<$2>:\n\n/m) { + $item = $1; + $fc = substr $item, 0, 1; } - elsif (!$text || !/\A\t/) { + elsif (!$item || !/\A\t/) { warn "Expected a Configure variable header", ($text ? " or another paragraph of description" : () ), ", instead we got:\n$_"; @@ -1068,6 +1086,7 @@ EOF s/(?/g; # UNISTD s/(? macro/g; # FILE_cnt macro s/n[\0]t/n't/g; # undo can't, won't damage + $glossary{$fc}{$item} .= $_; } if ($Opts{glossary}) { @@ -1075,7 +1094,6 @@ if ($Opts{glossary}) { ; # Skip the preamble while () { process; - print CONFIG_POD; } if ($errors) { die "Errors encountered while processing $Glossary. ", @@ -1086,9 +1104,43 @@ if ($Opts{glossary}) { } } -print CONFIG_POD <<'ENDOFTAIL'; +$glossary{t}{taint_support} //= < -=back +From define: C or C + +If this perl is compiled with support for taint mode this variable will +be set to 'define', if it is not it will be set to the empty string. +Either of the above defines will result in it being empty. This property +was added in version 5.37.11. See also L. + +EOF_TEXT + +$glossary{t}{taint_disabled} //= < + +From define: C or C + +If this perl is compiled with support for taint mode this variable will +be set to the empty string, if it was compiled with +C defined then it will be set to be "silent", +and if it was compiled with C defined it will be +'define'. Either of the above defines will results in it being a true +value. This property was added in 5.37.11. See also L. + +EOF_TEXT + +if ($Opts{glossary}) { + foreach my $fc (sort keys %glossary) { + print CONFIG_POD "=head2 $fc\n\n=over 4\n\n"; + foreach my $item (sort keys %{$glossary{$fc}}) { + print CONFIG_POD $glossary{$fc}{$item}; + } + print CONFIG_POD "=back\n\n"; + } +} + +print CONFIG_POD <<'ENDOFTAIL'; =head1 GIT DATA diff --git a/lib/Config.t b/lib/Config.t index 4a07ff58af25..fa505266d166 100644 --- a/lib/Config.t +++ b/lib/Config.t @@ -51,6 +51,39 @@ ok( exists $Config{d_fork}, "has d_fork"); ok(!exists $Config{d_bork}, "has no d_bork"); +{ + # check taint_support and tain_disabled are set up as expected. + + ok( exists $Config{taint_support}, "has taint_support"); + + ok( exists $Config{taint_disabled}, "has taint_disabled"); + + is( $Config{taint_support}, ($Config{taint_disabled} ? "" : "define"), + "taint_support = !taint_disabled"); + + ok( ($Config{taint_support} eq "" or $Config{taint_support} eq "define"), + "taint_support is a valid value"); + + ok( ( $Config{taint_disabled} eq "" or $Config{taint_disabled} eq "silent" or + $Config{taint_disabled} eq "define"), + "taint_disabled is a valid value"); + + my @opts = Config::non_bincompat_options(); + my @want_taint_disabled = ("", "define", "silent"); + my @want_taint_support = ("define", "", ""); + my ($silent_no_taint_support) = grep $_ eq "SILENT_NO_TAINT_SUPPORT", @opts; + my ($no_taint_support) = grep $_ eq "NO_TAINT_SUPPORT", @opts; + my $no_taint_support_count = 0 + grep /NO_TAINT_SUPPORT/, @opts; + my $want_count = $silent_no_taint_support ? 2 : $no_taint_support ? 1 : 0; + + is ($no_taint_support_count, $want_count, + "non_bincompat_options info on taint support is as expected"); + is( $Config{taint_disabled}, $want_taint_disabled[$no_taint_support_count], + "taint_disabled is aligned with non_bincompat_options() data"); + is( $Config{taint_support}, $want_taint_support[$no_taint_support_count], + "taint_support is aligned with non_bincompat_options() data"); +} + like($Config{ivsize}, qr/^(4|8)$/, "ivsize is 4 or 8 (it is $Config{ivsize})"); # byteorder is virtual, but it has rules. From 32d5adb3028350d2f465f0ae1e8dd7c3005f49a4 Mon Sep 17 00:00:00 2001 From: David Cantrell Date: Sat, 25 Mar 2023 22:46:01 +0000 Subject: [PATCH 2/4] workflows/testsuite.yml - Automatically test without taint support Add an entry for -DSILENT_NO_TAINT_SUPPORT to our linux based test matrix. Currently we cannot do the same for plain -DNO_TAINT_SUPPORT as it chokes on -t and -T on the command line. [Committers note: edited commit message to add detail] --- .github/workflows/testsuite.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 79c5aaae57ff..3ca0511da291 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -263,6 +263,7 @@ jobs: - "-Duserelocatableinc" - "-Dcc='clang'" - "-Dcc='g++'" + - "-Accflags=-DSILENT_NO_TAINT_SUPPORT" steps: - name: Install System dependencies From 40b4fae97cd0fe9fb82757cfba16b247deedd208 Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Fri, 31 Mar 2023 13:22:15 +0200 Subject: [PATCH 3/4] test infra - Under -DNO_TAINT_SUPPORT skip tests that use -T or -t This patch uses a collection of heuristics to skip test files which would die on a perl compiled with -DNO_TAINT_SUPPORT but without -DSILENT_NO_TAINT_SUPPORT. -DNO_TAINT_SUPPORT disables taint support in a "safe" way, such that if you try to use taint mode with the -t or -T options an exception will be thrown informing you that the perl you are using does not support taint. (The related setting -DSILENT_NO_TAINT_SUPPORT disables taint support but causes the -t and -T options to be silently ignored.) The error from using -t and -T is thrown very early in the process startup and there is no way to "gracefully" handle it and convert it into something else, for instance to skip a test file which contains it. This patch generally fixes our code to skip these tests. * Make t/TEST and t/harness check shebang lines and use filename checks to filter out tests that use -t or -T. Primarily this is the result of checking their shebang line, but some cpan/ files are excluded by name, either from a very short list of exclusions, or because their file name contains the word "taint". Non-cpan test files were fixed individually as noted below. * test.pl - make run_multiple_progs() skip test cases based on the switches that are part of the test definition. This function is used in a great deal of our internal tests, so it fixes a lot of tests in one go. * XS-APITest/t/call.t, t/run/switchDX.t, lib/B/Deparse.t - Skip a small set of tests in each file. --- ext/XS-APItest/t/call.t | 9 ++++++--- lib/B/Deparse.t | 29 +++++++++++++++++++---------- t/TEST | 32 ++++++++++++++++++++++++++++++++ t/harness | 2 ++ t/run/switchDx.t | 7 ++++++- t/test.pl | 11 +++++++++++ 6 files changed, 76 insertions(+), 14 deletions(-) diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index 390ed8de9387..1116f286fb2e 100644 --- a/ext/XS-APItest/t/call.t +++ b/ext/XS-APItest/t/call.t @@ -14,7 +14,7 @@ BEGIN { plan(538); use_ok('XS::APItest') }; - +use Config; ######################### # f(): general test sub to be called by call_sv() etc. @@ -343,8 +343,11 @@ for my $fn_type (qw(eval_pv eval_sv call_sv)) { # DAPM 9-Aug-04. A taint test in eval_sv() could die after setting up # a new jump level but before pushing an eval context, leading to # stack corruption +SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config{taint_support}; -fresh_perl_is(<<'EOF', "x=2", { switches => ['-T', '-I../../lib'] }, 'eval_sv() taint'); + fresh_perl_is(<<'EOF', "x=2", { switches => ['-T', '-I../../lib'] }, 'eval_sv() taint'); use XS::APItest; my $x = 0; @@ -357,4 +360,4 @@ sub f { eval { my @a = sort f 2, 1; $x++}; print "x=$x\n"; EOF - +} diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index ae1372f63050..292c04064052 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -307,14 +307,19 @@ x(); z() . EOCODH -is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], +SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config::Config{taint_support}; + + is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], prog => "format =\n\@\n\$;\n.\n"), - <<'EOCODM', '$; on format line'; -format STDOUT = -@ -$; -. -EOCODM + <<~'EOCODM', '$; on format line'; + format STDOUT = + @ + $; + . + EOCODM +} is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse,-l', $path ], prog => "format =\n\@\n\$foo\n.\n"), @@ -537,10 +542,14 @@ is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], "sub BEGIN {\n \$main::{'f'} = \\!0;\n}\n", '&PL_sv_yes constant (used to croak)'; -is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], +SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config::Config{taint_support}; + is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], prog => '$x =~ (1?/$a/:0)'), - '$x =~ ($_ =~ /$a/);'."\n", - '$foo =~ under taint mode'; + '$x =~ ($_ =~ /$a/);'."\n", + '$foo =~ under taint mode'; +} unlike runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-w' ], prog => 'BEGIN { undef &foo }'), diff --git a/t/TEST b/t/TEST index 01ba89d94f8d..a5f56404b3d8 100755 --- a/t/TEST +++ b/t/TEST @@ -522,6 +522,36 @@ sub dump_tests { exit(0); } +sub filter_taint_tests { + my $tests = shift; + require Config; + return unless $Config::Config{taint_disabled} eq "define"; + + # These are test files which are known to fail with -DNO_TAINT_SUPPORT + # but which do not have "taint" in their name, nor have shebang lines + # with -t or -T in them. So we exclude them specifically instead. + my %known_tainter = map { $_ => 0 } ( + '../cpan/Test-Harness/t/regression.t', + '../cpan/Test-Harness/t/source_handler.t', + '../cpan/Test-Harness/t/compat/inc-propagation.t', + ); + @$tests = grep { + my $file = $_; + open my $ifh, "<", $file + or die "Failed to read: '$file': $!"; + my $line = <$ifh>; + my $keep = $file=~/taint/ ? 0 : ($known_tainter{$file} // 1); + if ($line=~/^#!.*perl\s+-(\w+)/) { + my $switch = $1; + if ($switch =~ s/[Tt]//) { + $keep = 0; + } + } + $keep + } @$tests; +} + + unless (@ARGV) { # base first, as TEST bails out if that can't run # then comp, to validate that require works @@ -608,6 +638,8 @@ unless (@ARGV) { dump_tests(\@ARGV) if $dump_tests; +filter_taint_tests(\@ARGV); + if ($::deparse) { _testprogs('deparse', '', @ARGV); } diff --git a/t/harness b/t/harness index 50801fa0bf80..a79d5c0d450c 100644 --- a/t/harness +++ b/t/harness @@ -433,6 +433,8 @@ for (@tests) { dump_tests(\@tests) if $dump_tests; +filter_taint_tests(\@tests); + my %options; my $type = 'perl'; diff --git a/t/run/switchDx.t b/t/run/switchDx.t index 9d936735adf8..e59e5560340d 100644 --- a/t/run/switchDx.t +++ b/t/run/switchDx.t @@ -48,9 +48,14 @@ END { fresh_perl_like("print qq(hello)", qr/define raw/, { stderr => 1, switches => [ '-Di' ] }, "-Di defaults to stderr"); - fresh_perl_like("print qq(hello)", qr/define raw/, + SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config{taint_support}; + + fresh_perl_like("print qq(hello)", qr/define raw/, { stderr => 1, switches => [ '-TDi' ] }, "Perlio debug output to STDERR with -TDi (no PERLIO_DEBUG)"); + } } { # -DXv tests diff --git a/t/test.pl b/t/test.pl index 7df78c7b6286..b46785571402 100644 --- a/t/test.pl +++ b/t/test.pl @@ -1327,6 +1327,13 @@ sub run_multiple_progs { my $dummy; ($dummy, @prgs) = _setup_one_file(shift); } + my $taint_disabled; + if (! eval {require Config; 1}) { + warn "test.pl had problems loading Config: $@"; + $taint_disabled = ''; + } else { + $taint_disabled = $Config::Config{taint_disabled}; + } my $tmpfile = tempfile(); @@ -1379,6 +1386,10 @@ sub run_multiple_progs { $name = "test from $file at line $line"; } + if ($switch=~/[Tt]/ and $taint_disabled eq "define") { + $reason{skip} ||= "This perl does not support taint"; + } + if ($reason{skip}) { SKIP: { From 5b2d45323fb15ce928d9de23c224fd4fba3e972f Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Fri, 31 Mar 2023 21:29:02 +0200 Subject: [PATCH 4/4] workflows/testsuite.yaml - Add testing of -DNO_TAINT_SUPPORT Test that we can pass test with -DNO_TAINT_SUPPORT but without -DSILENT_NO_TAINT_SUPPORT. Both disable taint mode, but the latter causes -t and -T to be silently ignored, whereas the former by itself causes use of -t and -T to throw fatal exceptions during process startup. --- .github/workflows/testsuite.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 3ca0511da291..7d2476153857 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -264,6 +264,7 @@ jobs: - "-Dcc='clang'" - "-Dcc='g++'" - "-Accflags=-DSILENT_NO_TAINT_SUPPORT" + - "-Accflags=-DNO_TAINT_SUPPORT" steps: - name: Install System dependencies