Config.pm - add taint_disabled and taint_support to %Config

.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

configpm

@@ -576,14 +576,16 @@ $_ = <<'!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] }
     grep { !$seen_var{ $_->[0] }++ }
     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 <<EOF if $text;
-=back
+my %glossary;
 
-EOF
-      print CONFIG_POD <<EOF;
-=head2 $c
-
-=over 4
+my $fc;
+my $item;
 
-EOF
-     $text = 1;
-    }
+sub process {
+  if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\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,14 +1086,14 @@ EOF
   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;	# UNISTD
   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
   s/n[\0]t/n't/g;		# undo can't, won't damage
+  $glossary{$fc}{$item} .= $_;
 }
 
 if ($Opts{glossary}) {
     <GLOS>;				# Skip the "DO NOT EDIT"
     <GLOS>;				# Skip the preamble
   while (<GLOS>) {
     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} //= <<EOF_TEXT;
+=item C<taint_support>
 
-=back
+From define: C<SILENT_NO_TAINT_SUPPORT> or C<NO_TAINT_SUPPORT>
+
+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</taint_disabled>.
+
+EOF_TEXT
+
+$glossary{t}{taint_disabled} //= <<EOF_TEXT;
+=item C<taint_disabled>
+
+From define: C<SILENT_NO_TAINT_SUPPORT> or C<NO_TAINT_SUPPORT>
+
+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<SILENT_NO_TAINT_SUPPORT> defined then it will be set to be "silent",
+and if it was compiled with C<NO_TAINT_SUPPORT> 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</taint_support>.
+
+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
 

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
-
+}

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 =~ <branch-folded match> under taint mode';
+        '$x =~ ($_ =~ /$a/);'."\n",
+        '$foo =~ <branch-folded match> under taint mode';
+}
 
 unlike runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-w' ],
                prog => 'BEGIN { undef &foo }'),

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.

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);
 }

t/harness

@@ -433,6 +433,8 @@ for (@tests) {
 
 dump_tests(\@tests) if $dump_tests;
 
+filter_taint_tests(\@tests);
+
 my %options;
 
 my $type = 'perl';

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

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:
 	  {