Sat Jun 21 22:28:50 2014: Request 96291 was acted upon.
Transaction: Correspondence added by ETJ
       Queue: Inline
     Subject: t/08taint.t fails on perl 5.20.0
   Broken in: 0.55
    Severity: (no value)
       Owner: Nobody
  Requestors: e...@cpan.org
      Status: open
 Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=96291 >


On further further reflection, the previous logic is bound to give false 
positives when running as root, which means installing as root using CPAN (a 
reasonable thing to do) will fail tests, which is where we came in. Instead, 
this patch (replacing previous two) actually tests $< != $>, which revealed a 
couple of quirks, hence a couple of extra changes:

diff --git a/C/t/08taint.t b/C/t/08taint.t
index 9effb6f..357b551 100644
--- a/C/t/08taint.t
+++ b/C/t/08taint.t
@@ -21,13 +21,15 @@ BEGIN {
 use warnings;
 use strict;
 use Test::More tests => 10;
-
 use Test::Warn;
 
 # Suppress "Set up gcc environment ..." warning.
 # (Affects ActivePerl only.)
 $ENV{ACTIVEPERL_CONFIG_SILENT} = 1;
 
+# deal with running as root - actually simulate running as setuid program
+$< = 1; # ignore failure
+
 my $w1 = 'Blindly untainting tainted fields in %ENV';
 my $w2 = 'Blindly untainting Inline configuration file information';
 my $w3 = 'Blindly untainting tainted fields in Inline object';
diff --git a/Inline.pm b/Inline.pm
index 32868a3..83f7035 100644
--- a/Inline.pm
+++ b/Inline.pm
@@ -846,6 +846,8 @@ sub create_config_file {
                next;
            }
            next if $mod =~ /^(MakeMaker|denter|messages)$/;
+           # @INC is made safe by -T disallowing PERL5LIB et al
+           ($mod) = $mod =~ /(.*)/;
            eval "require Inline::$mod;";
             warn($@), next if $@;
            eval "\$register=&Inline::${mod}::register";
@@ -1075,11 +1077,16 @@ sub env_untaint {
                  join ';', grep {not /^\./ and -d $_
                                  } split /;/, $ENV{PATH}
                  :
-                 join ':', grep {/^\// and -d $_ and not ((stat($_))[2] & 0022)
+                 join ':', grep {/^\// and -d $_ and $< == $> ? 1 : not (-W $_ 
or -O $_)
                                   } split /:/, $ENV{PATH};
 
     map {($_) = /(.*)/} @INC;
 
+    # list cherry-picked from `perldoc perlrun`
+    delete @ENV{qw(PERL5OPT PERL5SHELL PERL_ROOT IFS CDPATH ENV BASH_ENV)};
+    $ENV{SHELL} = '/bin/sh' if -x '/bin/sh';
+
+    $< = $> if $< != $>; # so child processes retain euid - ignore failure
 }
 #==============================================================================
 # Blindly untaint tainted fields in Inline object.

Reply via email to