t/op/taint.t

   1 #!./perl -T
   2 #
   3 # Taint tests by Tom Phoenix <rootbeer@teleport.com>.
   4 #
   5 # I don't claim to know all about tainting. If anyone sees
   6 # tests that I've missed here, please add them. But this is
   7 # better than having no tests at all, right?
   8 #
   9
  10 BEGIN {
  11     chdir 't' if -d 't';
  12     @INC = '../lib' if -d '../lib';
  13 }
  14
  15 use strict;
  16 use Config;
  17
  18 my $Is_VMS = $^O eq 'VMS';
  19 my $Invoke_Perl = $Is_VMS ? 'MCR Sys$Disk:[]Perl.' : './perl';
  20 if ($Is_VMS) {
  21     my($olddcl) = $ENV{'DCL$PATH'} =~ /^(.*)$/;
  22     my($oldifs) = $ENV{IFS} =~ /^(.*)$/;
  23     eval <<EndOfCleanup;
  24         END {
  25             \$ENV{PATH} = '';
  26             warn "# Note: logical name 'PATH' may have been deleted\n";
  27             \$ENV{IFS} =  "$oldifs";
  28             \$ENV{'DCL\$PATH'} = "$olddcl";
  29         }
  30 EndOfCleanup
  31 }
  32
  33 # Sources of taint:
  34 #   The empty tainted value, for tainting strings
  35 my $TAINT = substr($^X, 0, 0);
  36 #   A tainted zero, useful for tainting numbers
  37 my $TAINT0 = 0 + $TAINT;
  38
  39 # This taints each argument passed. All must be lvalues.
  40 # Side effect: It also stringifies them. :-(
  41 sub taint_these (@) {
  42     for (@_) { $_ .= $TAINT }
  43 }
  44
  45 # How to identify taint when you see it
  46 sub any_tainted (@) {
  47     not eval { join("",@_), kill 0; 1 };
  48 }
  49 sub tainted ($) {
  50     any_tainted @_;
  51 }
  52 sub all_tainted (@) {
  53     for (@_) { return 0 unless tainted $_ }
  54     1;
  55 }
  56
  57 sub test ($$;$) {
  58     my($serial, $boolean, $diag) = @_;
  59     if ($boolean) {
  60         print "ok $serial\n";
  61     } else {
  62         print "not ok $serial\n";
  63         for (split m/^/m, $diag) {
  64             print "# $_";
  65         }
  66         print "\n" unless
  67             $diag eq ''
  68             or substr($diag, -1) eq "\n";
  69     }
  70 }
  71
  72 # We need an external program to call.
  73 my $ECHO = "./echo$$";
  74 END { unlink $ECHO }
  75 open PROG, "> $ECHO" or die "Can't create $ECHO: $!";
  76 print PROG 'print "@ARGV\n"', "\n";
  77 close PROG;
  78 my $echo = "$Invoke_Perl $ECHO";
  79
  80 print "1..98\n";
  81
  82 # First, let's make sure that Perl is checking the dangerous
  83 # environment variables. Maybe they aren't set yet, so we'll
  84 # taint them ourselves.
  85 {
  86     $ENV{'DCL$PATH'} = '' if $Is_VMS;
  87
  88     $ENV{PATH} = $TAINT;
  89     $ENV{IFS} = " \t\n";
  90     test 1, eval { `$echo 1` } eq '';
  91     test 2, $@ =~ /^Insecure \$ENV{PATH}/, $@;
  92
  93     $ENV{PATH} = '';
  94     $ENV{IFS} = $TAINT;
  95     test 3, eval { `$echo 1` } eq '';
  96     test 4, $@ =~ /^Insecure \$ENV{IFS}/, $@;
  97
  98     my $tmp;
  99     if ($^O eq 'os2' || $^O eq 'amigaos') {
 100         print "# all directories are writeable\n";
 101     }
 102     else {
 103         $tmp = (grep { defined and -d and (stat _)[2] & 2 }
 104                      qw(/tmp /var/tmp /usr/tmp /sys$scratch),
 105                      @ENV{qw(TMP TEMP)})[0]
 106             or print "# can't find world-writeable directory to test PATH\n";
 107     }
 108
 109     if ($tmp) {
 110         $ENV{PATH} = $tmp;
 111         $ENV{IFS} = " \t\n";
 112         test 5, eval { `$echo 1` } eq '';
 113         test 6, $@ =~ /^Insecure directory in \$ENV{PATH}/, $@;
 114     }
 115     else {
 116         for (5..6) { print "ok $_\n" }
 117     }
 118
 119     $ENV{PATH} = '';
 120     $ENV{IFS} = " \t\n";
 121     test 7, eval { `$echo 1` } eq "1\n";
 122     test 8, $@ eq '', $@;
 123
 124     if ($Is_VMS) {
 125         $ENV{'DCL$PATH'} = $TAINT;
 126         test 9,  eval { `$echo 1` } eq '';
 127         test 10, $@ =~ /^Insecure \$ENV{DCL\$PATH}/, $@;
 128         if ($tmp) {
 129             $ENV{'DCL$PATH'} = $tmp;
 130             test 11, eval { `$echo 1` } eq '';
 131             test 12, $@ =~ /^Insecure directory in \$ENV{DCL\$PATH}/, $@;
 132         }
 133         else {
 134             print "# can't find world-writeable directory to test DCL\$PATH\n";
 135             for (11..12) { print "ok $_\n" }
 136         }
 137         $ENV{'DCL$PATH'} = '';
 138     }
 139     else {
 140         print "# This is not VMS\n";
 141         for (9..12) { print "ok $_\n"; }
 142     }
 143 }
 144
 145 # Let's see that we can taint and untaint as needed.
 146 {
 147     my $foo = $TAINT;
 148     test 13, tainted $foo;
 149
 150     # That was a sanity check. If it failed, stop the insanity!
 151     die "Taint checks don't seem to be enabled" unless tainted $foo;
 152
 153     $foo = "foo";
 154     test 14, not tainted $foo;
 155
 156     taint_these($foo);
 157     test 15, tainted $foo;
 158
 159     my @list = 1..10;
 160     test 16, not any_tainted @list;
 161     taint_these @list[1,3,5,7,9];
 162     test 17, any_tainted @list;
 163     test 18, all_tainted @list[1,3,5,7,9];
 164     test 19, not any_tainted @list[0,2,4,6,8];
 165
 166     ($foo) = $foo =~ /(.+)/;
 167     test 20, not tainted $foo;
 168
 169     $foo = $1 if ('bar' . $TAINT) =~ /(.+)/;
 170     test 21, not tainted $foo;
 171     test 22, $foo eq 'bar';
 172
 173     my $pi = 4 * atan2(1,1) + $TAINT0;
 174     test 23, tainted $pi;
 175
 176     ($pi) = $pi =~ /(\d+\.\d+)/;
 177     test 24, not tainted $pi;
 178     test 25, sprintf("%.5f", $pi) eq '3.14159';
 179 }
 180
 181 # How about command-line arguments? The problem is that we don't
 182 # always get some, so we'll run another process with some.
 183 {
 184     my $arg = "./arg$$";
 185     open PROG, "> $arg" or die "Can't create $arg: $!";
 186     print PROG q{
 187         eval { join('', @ARGV), kill 0 };
 188         exit 0 if $@ =~ /^Insecure dependency/;
 189         print "# Oops: \$@ was [$@]\n";
 190         exit 1;
 191     };
 192     close PROG;
 193     print `$Invoke_Perl "-T" $arg and some suspect arguments`;
 194     test 26, !$?, "Exited with status $?";
 195     unlink $arg;
 196 }
 197
 198 # Reading from a file should be tainted
 199 {
 200     my $file = './TEST';
 201     test 27, open(FILE, $file), "Couldn't open '$file': $!";
 202
 203     my $block;
 204     sysread(FILE, $block, 100);
 205     my $line = <FILE>;
 206     close FILE;
 207     test 28, tainted $block;
 208     test 29, tainted $line;
 209 }
 210
 211 # Globs should be tainted.
 212 {
 213     # Some glob implementations need to spawn system programs.
 214     local $ENV{PATH} = '';
 215     $ENV{PATH} = (-l '/bin' ? '' : '/bin:') . '/usr/bin' unless $Is_VMS;
 216
 217     my @globs = <*>;
 218     test 30, all_tainted @globs;
 219
 220     @globs = glob '*';
 221     test 31, all_tainted @globs;
 222 }
 223
 224 # Output of commands should be tainted
 225 {
 226     my $foo = `$echo abc`;
 227     test 32, tainted $foo;
 228 }
 229
 230 # Certain system variables should be tainted
 231 {
 232     test 33, all_tainted $^X, $0;
 233 }
 234
 235 # Results of matching should all be untainted
 236 {
 237     my $foo = "abcdefghi" . $TAINT;
 238     test 34, tainted $foo;
 239
 240     $foo =~ /def/;
 241     test 35, not any_tainted $`, $&, $';
 242
 243     $foo =~ /(...)(...)(...)/;
 244     test 36, not any_tainted $1, $2, $3, $+;
 245
 246     my @bar = $foo =~ /(...)(...)(...)/;
 247     test 37, not any_tainted @bar;
 248
 249     test 38, tainted $foo;      # $foo should still be tainted!
 250     test 39, $foo eq "abcdefghi";
 251 }
 252
 253 # Operations which affect files can't use tainted data.
 254 {
 255     test 40, eval { chmod 0, $TAINT } eq '', 'chmod';
 256     test 41, $@ =~ /^Insecure dependency/, $@;
 257
 258     # There is no feature test in $Config{} for truncate,
 259     #   so we allow for the possibility that it's missing.
 260     test 42, eval { truncate 'NoSuChFiLe', $TAINT0 } eq '', 'truncate';
 261     test 43, $@ =~ /^(?:Insecure dependency|truncate not implemented)/, $@;
 262
 263     test 44, eval { rename '', $TAINT } eq '', 'rename';
 264     test 45, $@ =~ /^Insecure dependency/, $@;
 265
 266     test 46, eval { unlink $TAINT } eq '', 'unlink';
 267     test 47, $@ =~ /^Insecure dependency/, $@;
 268
 269     test 48, eval { utime $TAINT } eq '', 'utime';
 270     test 49, $@ =~ /^Insecure dependency/, $@;
 271
 272     if ($Config{d_chown}) {
 273         test 50, eval { chown -1, -1, $TAINT } eq '', 'chown';
 274         test 51, $@ =~ /^Insecure dependency/, $@;
 275     }
 276     else {
 277         print "# chown() is not available\n";
 278         for (50..51) { print "ok $_\n" }
 279     }
 280
 281     if ($Config{d_link}) {
 282         test 52, eval { link $TAINT, '' } eq '', 'link';
 283         test 53, $@ =~ /^Insecure dependency/, $@;
 284     }
 285     else {
 286         print "# link() is not available\n";
 287         for (52..53) { print "ok $_\n" }
 288     }
 289
 290     if ($Config{d_symlink}) {
 291         test 54, eval { symlink $TAINT, '' } eq '', 'symlink';
 292         test 55, $@ =~ /^Insecure dependency/, $@;
 293     }
 294     else {
 295         print "# symlink() is not available\n";
 296         for (54..55) { print "ok $_\n" }
 297     }
 298 }
 299
 300 # Operations which affect directories can't use tainted data.
 301 {
 302     test 56, eval { mkdir $TAINT0, $TAINT } eq '', 'mkdir';
 303     test 57, $@ =~ /^Insecure dependency/, $@;
 304
 305     test 58, eval { rmdir $TAINT } eq '', 'rmdir';
 306     test 59, $@ =~ /^Insecure dependency/, $@;
 307
 308     test 60, eval { chdir $TAINT } eq '', 'chdir';
 309     test 61, $@ =~ /^Insecure dependency/, $@;
 310
 311     if ($Config{d_chroot}) {
 312         test 62, eval { chroot $TAINT } eq '', 'chroot';
 313         test 63, $@ =~ /^Insecure dependency/, $@;
 314     }
 315     else {
 316         print "# chroot() is not available\n";
 317         for (62..63) { print "ok $_\n" }
 318     }
 319 }
 320
 321 # Some operations using files can't use tainted data.
 322 {
 323     my $foo = "imaginary library" . $TAINT;
 324     test 64, eval { require $foo } eq '', 'require';
 325     test 65, $@ =~ /^Insecure dependency/, $@;
 326
 327     my $filename = "./taintB$$";        # NB: $filename isn't tainted!
 328     END { unlink $filename if defined $filename }
 329     $foo = $filename . $TAINT;
 330     unlink $filename;   # in any case
 331
 332     test 66, eval { open FOO, $foo } eq '', 'open for read';
 333     test 67, $@ eq '', $@;              # NB: This should be allowed
 334     test 68, $! == 2;                   # File not found
 335
 336     test 69, eval { open FOO, "> $foo" } eq '', 'open for write';
 337     test 70, $@ =~ /^Insecure dependency/, $@;
 338 }
 339
 340 # Commands to the system can't use tainted data
 341 {
 342     my $foo = $TAINT;
 343
 344     if ($^O eq 'amigaos') {
 345         print "# open(\"|\") is not available\n";
 346         for (71..74) { print "ok $_\n" }
 347     }
 348     else {
 349         test 71, eval { open FOO, "| $foo" } eq '', 'popen to';
 350         test 72, $@ =~ /^Insecure dependency/, $@;
 351
 352         test 73, eval { open FOO, "$foo |" } eq '', 'popen from';
 353         test 74, $@ =~ /^Insecure dependency/, $@;
 354     }
 355
 356     test 75, eval { exec $TAINT } eq '', 'exec';
 357     test 76, $@ =~ /^Insecure dependency/, $@;
 358
 359     test 77, eval { system $TAINT } eq '', 'system';
 360     test 78, $@ =~ /^Insecure dependency/, $@;
 361
 362     $foo = "*";
 363     taint_these $foo;
 364
 365     test 79, eval { `$echo 1$foo` } eq '', 'backticks';
 366     test 80, $@ =~ /^Insecure dependency/, $@;
 367
 368     if ($Is_VMS) { # wildcard expansion doesn't invoke shell, so is safe
 369         test 81, join('', eval { glob $foo } ) ne '', 'globbing';
 370         test 82, $@ eq '', $@;
 371     }
 372     else {
 373         test 81, join('', eval { glob $foo } ) eq '', 'globbing';
 374         test 82, $@ =~ /^Insecure dependency/, $@;
 375     }
 376 }
 377
 378 # Operations which affect processes can't use tainted data.
 379 {
 380     test 83, eval { kill 0, $TAINT } eq '', 'kill';
 381     test 84, $@ =~ /^Insecure dependency/, $@;
 382
 383     if ($Config{d_setpgrp}) {
 384         test 85, eval { setpgrp 0, $TAINT } eq '', 'setpgrp';
 385         test 86, $@ =~ /^Insecure dependency/, $@;
 386     }
 387     else {
 388         print "# setpgrp() is not available\n";
 389         for (85..86) { print "ok $_\n" }
 390     }
 391
 392     if ($Config{d_setprior}) {
 393         test 87, eval { setpriority 0, $TAINT, $TAINT } eq '', 'setpriority';
 394         test 88, $@ =~ /^Insecure dependency/, $@;
 395     }
 396     else {
 397         print "# setpriority() is not available\n";
 398         for (87..88) { print "ok $_\n" }
 399     }
 400 }
 401
 402 # Some miscellaneous operations can't use tainted data.
 403 {
 404     if ($Config{d_syscall}) {
 405         test 89, eval { syscall $TAINT } eq '', 'syscall';
 406         test 90, $@ =~ /^Insecure dependency/, $@;
 407     }
 408     else {
 409         print "# syscall() is not available\n";
 410         for (89..90) { print "ok $_\n" }
 411     }
 412
 413     {
 414         my $foo = "x" x 979;
 415         taint_these $foo;
 416         local *FOO;
 417         my $temp = "./taintC$$";
 418         END { unlink $temp }
 419         test 91, open(FOO, "> $temp"), "Couldn't open $temp for write: $!";
 420
 421         test 92, eval { ioctl FOO, $TAINT, $foo } eq '', 'ioctl';
 422         test 93, $@ =~ /^Insecure dependency/, $@;
 423
 424         if ($Config{d_fcntl}) {
 425             test 94, eval { fcntl FOO, $TAINT, $foo } eq '', 'fcntl';
 426             test 95, $@ =~ /^Insecure dependency/, $@;
 427         }
 428         else {
 429             print "# fcntl() is not available\n";
 430             for (94..95) { print "ok $_\n" }
 431         }
 432
 433         close FOO;
 434     }
 435 }
 436
 437 # Some tests involving references
 438 {
 439     my $foo = 'abc' . $TAINT;
 440     my $fooref = \$foo;
 441     test 96, not tainted $fooref;
 442     test 97, tainted $$fooref;
 443     test 98, tainted $foo;
 444 }