Skip to content

Commit 4faffd7

Browse files
committed
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: Perl-Toolchain-Gang/Test-Harness#118 and: #20972 for related work that is stalled because we have not decided what to do about these variables.
1 parent 9ed785e commit 4faffd7

File tree

2 files changed

+95
-20
lines changed

2 files changed

+95
-20
lines changed

configpm

Lines changed: 62 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -576,14 +576,30 @@ $_ = <<'!END!';
576576
EOT
577577
#proper lexicographical order of the keys
578578
my %seen_var;
579+
my %v_define;
580+
my $defines = join " ", (Internals::V)[0,1];
581+
if (
582+
$defines =~ /\b(SILENT_NO_TAINT_SUPPORT)\b/ ||
583+
$defines =~ /\b(NO_TAINT_SUPPORT)\b/
584+
){
585+
my $which = $1;
586+
$v_define{taint_disabled} = ($which eq "SILENT_NO_TAINT_SUPPORT")
587+
? "silent" : "define";
588+
$v_define{taint_support}= "";
589+
}
590+
else {
591+
$v_define{taint_disabled} = "";
592+
$v_define{taint_support} = "define";
593+
}
594+
my @v_define = map { "$_='$v_define{$_}'\n" } keys %v_define;
579595
$heavy_txt .= join('',
580596
map { $_->[-1] }
581597
sort {$a->[0] cmp $b->[0] }
582598
grep { !$seen_var{ $_->[0] }++ }
583599
map {
584600
/^([^=]+)/ ? [ $1, $_ ]
585601
: [ $_, $_ ] # shouldnt happen
586-
} @v_others, @v_forced
602+
} (@v_others, @v_forced, @v_define)
587603
) . "!END!\n";
588604

589605
# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
@@ -1014,29 +1030,21 @@ ENDOFTAIL
10141030
if ($Opts{glossary}) {
10151031
open(GLOS, '<', $Glossary) or die "Can't open $Glossary: $!";
10161032
}
1017-
my %seen = ();
10181033
my $text = 0;
10191034
$/ = '';
10201035
my $errors= 0;
10211036

1022-
sub process {
1023-
if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
1024-
my $c = substr $1, 0, 1;
1025-
unless ($seen{$c}++) {
1026-
print CONFIG_POD <<EOF if $text;
1027-
=back
1028-
1029-
EOF
1030-
print CONFIG_POD <<EOF;
1031-
=head2 $c
1037+
my %glossary;
10321038

1033-
=over 4
1039+
my $fc;
1040+
my $item;
10341041

1035-
EOF
1036-
$text = 1;
1037-
}
1042+
sub process {
1043+
if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
1044+
$item = $1;
1045+
$fc = substr $item, 0, 1;
10381046
}
1039-
elsif (!$text || !/\A\t/) {
1047+
elsif (!$item || !/\A\t/) {
10401048
warn "Expected a Configure variable header",
10411049
($text ? " or another paragraph of description" : () ),
10421050
", instead we got:\n$_";
@@ -1068,14 +1076,14 @@ EOF
10681076
s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
10691077
s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
10701078
s/n[\0]t/n't/g; # undo can't, won't damage
1079+
$glossary{$fc}{$item} .= $_;
10711080
}
10721081

10731082
if ($Opts{glossary}) {
10741083
<GLOS>; # Skip the "DO NOT EDIT"
10751084
<GLOS>; # Skip the preamble
10761085
while (<GLOS>) {
10771086
process;
1078-
print CONFIG_POD;
10791087
}
10801088
if ($errors) {
10811089
die "Errors encountered while processing $Glossary. ",
@@ -1086,9 +1094,43 @@ if ($Opts{glossary}) {
10861094
}
10871095
}
10881096

1089-
print CONFIG_POD <<'ENDOFTAIL';
1097+
$glossary{t}{taint_support} //= <<EOF_TEXT;
1098+
=item C<taint_support>
10901099
1091-
=back
1100+
From define: C<SILENT_NO_TAINT_SUPPORT> or C<NO_TAINT_SUPPORT>
1101+
1102+
If this perl is compiled with support for taint mode this variable will
1103+
be set to 'define', if it is not it will be set to the empty string.
1104+
Either of the above defines will result in it being empty. This property
1105+
was added in version 5.37.11. See also L</taint_disabled>.
1106+
1107+
EOF_TEXT
1108+
1109+
$glossary{t}{taint_disabled} //= <<EOF_TEXT;
1110+
=item C<taint_disabled>
1111+
1112+
From define: C<SILENT_NO_TAINT_SUPPORT> or C<NO_TAINT_SUPPORT>
1113+
1114+
If this perl is compiled with support for taint mode this variable will
1115+
be set to the empty string, if it was compiled with
1116+
C<SILENT_NO_TAINT_SUPPORT> defined then it will be set to be "silent",
1117+
and if it was compiled with C<NO_TAINT_SUPPORT> defined it will be
1118+
'define'. Either of the above defines will results in it being a true
1119+
value. This property was added in 5.37.11. See also L</taint_support>.
1120+
1121+
EOF_TEXT
1122+
1123+
if ($Opts{glossary}) {
1124+
foreach my $fc (sort keys %glossary) {
1125+
print CONFIG_POD "=head2 $fc\n\n=over 4\n\n";
1126+
foreach my $item (sort keys %{$glossary{$fc}}) {
1127+
print CONFIG_POD $glossary{$fc}{$item};
1128+
}
1129+
print CONFIG_POD "=back\n\n";
1130+
}
1131+
}
1132+
1133+
print CONFIG_POD <<'ENDOFTAIL';
10921134
10931135
=head1 GIT DATA
10941136

lib/Config.t

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,39 @@ ok( exists $Config{d_fork}, "has d_fork");
5151

5252
ok(!exists $Config{d_bork}, "has no d_bork");
5353

54+
{
55+
# check taint_support and tain_disabled are set up as expected.
56+
57+
ok( exists $Config{taint_support}, "has taint_support");
58+
59+
ok( exists $Config{taint_disabled}, "has taint_disabled");
60+
61+
is( $Config{taint_support}, ($Config{taint_disabled} ? "" : "define"),
62+
"taint_support = !taint_disabled");
63+
64+
ok( ($Config{taint_support} eq "" or $Config{taint_support} eq "define"),
65+
"taint_support is a valid value");
66+
67+
ok( ( $Config{taint_disabled} eq "" or $Config{taint_disabled} eq "silent" or
68+
$Config{taint_disabled} eq "define"),
69+
"taint_disabled is a valid value");
70+
71+
my @opts = Config::non_bincompat_options();
72+
my @want_taint_disabled = ("", "define", "silent");
73+
my @want_taint_support = ("define", "", "");
74+
my ($silent_no_taint_support) = grep $_ eq "SILENT_NO_TAINT_SUPPORT", @opts;
75+
my ($no_taint_support) = grep $_ eq "NO_TAINT_SUPPORT", @opts;
76+
my $no_taint_support_count = 0 + grep /NO_TAINT_SUPPORT/, @opts;
77+
my $want_count = $silent_no_taint_support ? 2 : $no_taint_support ? 1 : 0;
78+
79+
is ($no_taint_support_count, $want_count,
80+
"non_bincompat_options info on taint support is as expected");
81+
is( $Config{taint_disabled}, $want_taint_disabled[$no_taint_support_count],
82+
"taint_disabled is aligned with non_bincompat_options() data");
83+
is( $Config{taint_support}, $want_taint_support[$no_taint_support_count],
84+
"taint_support is aligned with non_bincompat_options() data");
85+
}
86+
5487
like($Config{ivsize}, qr/^(4|8)$/, "ivsize is 4 or 8 (it is $Config{ivsize})");
5588

5689
# byteorder is virtual, but it has rules.

0 commit comments

Comments
 (0)