dist/IO/t/io_taint.t

   1 #!./perl -T
   2
   3 use Config;
   4
   5 BEGIN {
   6     if ($ENV{PERL_CORE}
   7         and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS'
   8         or not ${^TAINT}) # not ${^TAINT} => perl without taint support
   9     {
  10         print "1..0\n";
  11         exit 0;
  12     }
  13 }
  14
  15 use strict;
  16 if ($ENV{PERL_CORE}) {
  17   require("../../t/test.pl");
  18 }
  19 else {
  20   require("./t/test.pl");
  21 }
  22 plan(tests => 5);
  23
  24 END { unlink "./__taint__$$" }
  25
  26 use IO::File;
  27 my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
  28 print $x "$$\n";
  29 $x->close;
  30
  31 $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
  32 chop(my $unsafe = <$x>);
  33 eval { kill 0 * $unsafe };
  34 SKIP: {
  35   skip($^O) if $^O eq 'MSWin32' or $^O eq 'NetWare';
  36   like($@, '^Insecure');
  37 }
  38 $x->close;
  39
  40 # We could have just done a seek on $x, but technically we haven't tested
  41 # seek yet...
  42 $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
  43 $x->untaint;
  44 ok(!$?); # Calling the method worked
  45 chop($unsafe = <$x>);
  46 eval { kill 0 * $unsafe };
  47 unlike($@,'^Insecure');
  48 $x->close;
  49
  50 TODO: {
  51   todo_skip("Known bug in 5.10.0",2) if $] >= 5.010 and $] < 5.010_001;
  52
  53   # this will segfault if it fails
  54
  55   sub PVBM () { 'foo' }
  56   { my $dummy = index 'foo', PVBM }
  57
  58   eval { IO::Handle::untaint(PVBM) };
  59   pass();
  60
  61   eval { IO::Handle::untaint(\PVBM) };
  62   pass();
  63 }
  64
  65 exit 0;