dist/IO/t/io_taint.t

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