diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 79c5aaae57ff..7d2476153857 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -263,6 +263,8 @@ jobs: - "-Duserelocatableinc" - "-Dcc='clang'" - "-Dcc='g++'" + - "-Accflags=-DSILENT_NO_TAINT_SUPPORT" + - "-Accflags=-DNO_TAINT_SUPPORT" steps: - name: Install System dependencies 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/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/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. 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: {