summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2023-03-29 11:51:05 +0200
committerYves Orton <demerphq@gmail.com>2023-04-02 21:29:27 +0800
commitda791ecc4cd01c56b1259293abdbb287dadd5fe2 (patch)
tree798b9ea3254cfd11525b3a9e0a38a4eea156b8a8
parent0099fe06da2470ae6f7b3feb560b1a116886a531 (diff)
downloadperl-da791ecc4cd01c56b1259293abdbb287dadd5fe2.tar.gz
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.
-rwxr-xr-xconfigpm96
-rw-r--r--lib/Config.t33
2 files changed, 107 insertions, 22 deletions
diff --git a/configpm b/configpm
index 8ee45c05cc..166080b445 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 <<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,6 +1086,7 @@ 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}) {
@@ -1075,7 +1094,6 @@ if ($Opts{glossary}) {
<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
diff --git a/lib/Config.t b/lib/Config.t
index 4a07ff58af..fa505266d1 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.