ext/Safe/t/safeops.t

   1 #!perl
   2 # Tests that all ops can be trapped by a Safe compartment
   3
   4 BEGIN {
   5     if ($ENV{PERL_CORE}) {
   6         chdir 't' if -d 't';
   7         @INC = '../lib';
   8     }
   9     else {
  10         # this won't work outside of the core, so exit
  11         print "1..0\n"; exit 0;
  12     }
  13 }
  14 use Config;
  15 BEGIN {
  16     if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
  17         print "1..0\n"; exit 0;
  18     }
  19 }
  20
  21 use strict;
  22 use Test::More tests => 354;
  23 use Safe;
  24
  25 # Read the op names and descriptions directly from opcode.pl
  26 my @op;
  27 my @opname;
  28 open my $fh, '<', '../opcode.pl' or die "Can't open opcode.pl: $!";
  29 while (<$fh>) {
  30     last if /^__END__/;
  31 }
  32 while (<$fh>) {
  33     chomp;
  34     next if !$_ or /^#/;
  35     my ($op, $opname) = split /\t+/;
  36     push @op, $op;
  37     push @opname, $opname;
  38 }
  39 close $fh;
  40
  41 sub testop {
  42     my ($op, $opname, $code) = @_;
  43     pass("$op : skipped") and return if $code =~ /^SKIP/;
  44     pass("$op : skipped") and return if $code =~ m://: && $] < 5.009; # no dor
  45     my $c = new Safe;
  46     $c->deny_only($op);
  47     $c->reval($code);
  48     like($@, qr/'\Q$opname\E' trapped by operation mask/, $op);
  49 }
  50
  51 my $i = 0;
  52 while (<DATA>) {
  53     testop $op[$i], $opname[$i], $_;
  54     ++$i;
  55 }
  56
  57 # lists op examples, in the same order than opcode.pl
  58 # things that begin with SKIP are skipped, for various reasons (notably
  59 # optree modified by the optimizer -- Safe checks are done before the
  60 # optimizer modifies the optree)
  61
  62 __DATA__
  63 SKIP # null
  64 SKIP # stub
  65 scalar $x # scalar
  66 print @x # pushmark
  67 wantarray # wantarray
  68 42 # const
  69 SKIP (set by optimizer) $x # gvsv
  70 SKIP *x # gv
  71 *x{SCALAR} # gelem
  72 SKIP my $x # padsv
  73 SKIP my @x # padav
  74 SKIP my %x # padhv
  75 SKIP (not implemented) # padany
  76 SKIP split /foo/ # pushre
  77 *x # rv2gv
  78 $x # rv2sv
  79 $#x # av2arylen
  80 f() # rv2cv
  81 sub { } # anoncode
  82 prototype 'foo' # prototype
  83 \($x,$y) # refgen
  84 SKIP \$x # srefgen
  85 ref # ref
  86 bless # bless
  87 qx/ls/ # backtick
  88 <*.c> # glob
  89 <FH> # readline
  90 SKIP (set by optimizer) $x .= <F> # rcatline
  91 SKIP (internal) # regcmaybe
  92 SKIP (internal) # regcreset
  93 SKIP (internal) # regcomp
  94 /foo/ # match
  95 qr/foo/ # qr
  96 s/foo/bar/ # subst
  97 SKIP (set by optimizer) # substcont
  98 y:z:t: # trans
  99 $x = $y # sassign
 100 @x = @y # aassign
 101 chop @foo # chop
 102 chop # schop
 103 chomp @foo # chomp
 104 chomp # schomp
 105 defined # defined
 106 undef # undef
 107 study # study
 108 pos # pos
 109 ++$i # preinc
 110 SKIP (set by optimizer) # i_preinc
 111 --$i # predec
 112 SKIP (set by optimizer) # i_predec
 113 $i++ # postinc
 114 SKIP (set by optimizer) # i_postinc
 115 $i-- # postdec
 116 SKIP (set by optimizer) # i_postdec
 117 $x ** $y # pow
 118 $x * $y # multiply
 119 SKIP (set by optimizer) # i_multiply
 120 $x / $y # divide
 121 SKIP (set by optimizer) # i_divide
 122 $x % $y # modulo
 123 SKIP (set by optimizer) # i_modulo
 124 $x x $y # repeat
 125 $x + $y # add
 126 SKIP (set by optimizer) # i_add
 127 $x - $y # subtract
 128 SKIP (set by optimizer) # i_subtract
 129 $x . $y # concat
 130 "$x" # stringify
 131 $x << 1 # left_shift
 132 $x >> 1 # right_shift
 133 $x < $y # lt
 134 SKIP (set by optimizer) # i_lt
 135 $x > $y # gt
 136 SKIP (set by optimizer) # i_gt
 137 $i <= $y # le
 138 SKIP (set by optimizer) # i_le
 139 $i >= $y # ge
 140 SKIP (set by optimizer) # i_ge
 141 $x == $y # eq
 142 SKIP (set by optimizer) # i_eq
 143 $x != $y # ne
 144 SKIP (set by optimizer) # i_ne
 145 $i <=> $y # ncmp
 146 SKIP (set by optimizer) # i_ncmp
 147 $x lt $y # slt
 148 $x gt $y # sgt
 149 $x le $y # sle
 150 $x ge $y # sge
 151 $x eq $y # seq
 152 $x ne $y # sne
 153 $x cmp $y # scmp
 154 $x & $y # bit_and
 155 $x ^ $y # bit_xor
 156 $x | $y # bit_or
 157 -$x # negate
 158 SKIP (set by optimizer) # i_negate
 159 !$x # not
 160 ~$x # complement
 161 atan2 1 # atan2
 162 sin 1 # sin
 163 cos 1 # cos
 164 rand # rand
 165 srand # srand
 166 exp 1 # exp
 167 log 1 # log
 168 sqrt 1 # sqrt
 169 int # int
 170 hex # hex
 171 oct # oct
 172 abs # abs
 173 length # length
 174 substr $x, 1 # substr
 175 vec # vec
 176 index # index
 177 rindex # rindex
 178 sprintf '%s', 'foo' # sprintf
 179 formline # formline
 180 ord # ord
 181 chr # chr
 182 crypt 'foo','bar' # crypt
 183 ucfirst # ucfirst
 184 lcfirst # lcfirst
 185 uc # uc
 186 lc # lc
 187 quotemeta # quotemeta
 188 @a # rv2av
 189 SKIP (set by optimizer) # aelemfast
 190 $a[1] # aelem
 191 @a[1,2] # aslice
 192 each %h # each
 193 values %h # values
 194 keys %h # keys
 195 delete $h{Key} # delete
 196 exists $h{Key} # exists
 197 %h # rv2hv
 198 $h{kEy} # helem
 199 @h{kEy} # hslice
 200 unpack # unpack
 201 pack # pack
 202 split /foo/ # split
 203 join $a, @b # join
 204 @x = (1,2) # list
 205 SKIP @x[1,2] # lslice
 206 [1,2] # anonlist
 207 { a => 1 } # anonhash
 208 splice @x, 1, 2, 3 # splice
 209 push @x, $x # push
 210 pop @x # pop
 211 shift @x # shift
 212 unshift @x # unshift
 213 sort @x # sort
 214 reverse @x # reverse
 215 grep { $_ eq 'foo' } @x # grepstart
 216 SKIP grep { $_ eq 'foo' } @x # grepwhile
 217 map $_ + 1, @foo # mapstart
 218 SKIP (set by optimizer) # mapwhile
 219 SKIP # range
 220 1..2 # flip
 221 1..2 # flop
 222 $x && $y # and
 223 $x || $y # or
 224 $x xor $y # xor
 225 $x ? 1 : 0 # cond_expr
 226 $x &&= $y # andassign
 227 $x ||= $y # orassign
 228 Foo->$x() # method
 229 f() # entersub
 230 sub f{} f() # leavesub
 231 sub f:lvalue{return $x} f() # leavesublv
 232 caller # caller
 233 warn # warn
 234 die # die
 235 reset # reset
 236 SKIP # lineseq
 237 SKIP # nextstate
 238 SKIP (needs debugger) # dbstate
 239 while(0){} # unstack
 240 SKIP # enter
 241 SKIP # leave
 242 SKIP # scope
 243 SKIP # enteriter
 244 SKIP # iter
 245 SKIP # enterloop
 246 SKIP # leaveloop
 247 return # return
 248 last # last
 249 next # next
 250 redo THIS # redo
 251 dump # dump
 252 goto THERE # goto
 253 exit 0 # exit
 254 open FOO # open
 255 close FOO # close
 256 pipe FOO,BAR # pipe_op
 257 fileno FOO # fileno
 258 umask 0755, 'foo' # umask
 259 binmode FOO # binmode
 260 tie # tie
 261 untie # untie
 262 tied # tied
 263 dbmopen # dbmopen
 264 dbmclose # dbmclose
 265 SKIP (set by optimizer) # sselect
 266 select FOO # select
 267 getc FOO # getc
 268 read FOO # read
 269 write # enterwrite
 270 SKIP # leavewrite
 271 printf # prtf
 272 print # print
 273 sysopen # sysopen
 274 sysseek # sysseek
 275 sysread # sysread
 276 syswrite # syswrite
 277 send # send
 278 recv # recv
 279 eof FOO # eof
 280 tell # tell
 281 seek FH, $pos, $whence # seek
 282 truncate FOO, 42 # truncate
 283 fcntl # fcntl
 284 ioctl # ioctl
 285 flock FOO, 1 # flock
 286 socket # socket
 287 socketpair # sockpair
 288 bind # bind
 289 connect # connect
 290 listen # listen
 291 accept # accept
 292 shutdown # shutdown
 293 getsockopt # gsockopt
 294 setsockopt # ssockopt
 295 getsockname # getsockname
 296 getpeername # getpeername
 297 lstat FOO # lstat
 298 stat FOO # stat
 299 -R # ftrread
 300 -W # ftrwrite
 301 -X # ftrexec
 302 -r # fteread
 303 -w # ftewrite
 304 -x # fteexec
 305 -e # ftis
 306 SKIP -O # fteowned
 307 SKIP -o # ftrowned
 308 -z # ftzero
 309 -s # ftsize
 310 -M # ftmtime
 311 -A # ftatime
 312 -C # ftctime
 313 -S # ftsock
 314 -c # ftchr
 315 -b # ftblk
 316 -f # ftfile
 317 -d # ftdir
 318 -p # ftpipe
 319 -l # ftlink
 320 -u # ftsuid
 321 -g # ftsgid
 322 -k # ftsvtx
 323 -t # fttty
 324 -T # fttext
 325 -B # ftbinary
 326 chdir '/' # chdir
 327 chown # chown
 328 chroot # chroot
 329 unlink 'foo' # unlink
 330 chmod 511, 'foo' # chmod
 331 utime # utime
 332 rename 'foo', 'bar' # rename
 333 link 'foo', 'bar' # link
 334 symlink 'foo', 'bar' # symlink
 335 readlink 'foo' # readlink
 336 mkdir 'foo' # mkdir
 337 rmdir 'foo' # rmdir
 338 opendir DIR # open_dir
 339 readdir DIR # readdir
 340 telldir DIR # telldir
 341 seekdir DIR, $pos # seekdir
 342 rewinddir DIR # rewinddir
 343 closedir DIR # closedir
 344 fork # fork
 345 wait # wait
 346 waitpid # waitpid
 347 system # system
 348 exec # exec
 349 kill # kill
 350 getppid # getppid
 351 getpgrp # getpgrp
 352 setpgrp # setpgrp
 353 getpriority # getpriority
 354 setpriority # setpriority
 355 time # time
 356 times # tms
 357 localtime # localtime
 358 gmtime # gmtime
 359 alarm # alarm
 360 sleep 1 # sleep
 361 shmget # shmget
 362 shmctl # shmctl
 363 shmread # shmread
 364 shmwrite # shmwrite
 365 msgget # msgget
 366 msgctl # msgctl
 367 msgsnd # msgsnd
 368 msgrcv # msgrcv
 369 semget # semget
 370 semctl # semctl
 371 semop # semop
 372 use strict # require
 373 do 'file' # dofile
 374 eval "1+1" # entereval
 375 eval "1+1" # leaveeval
 376 SKIP eval { 1+1 } # entertry
 377 SKIP eval { 1+1 } # leavetry
 378 gethostbyname 'foo' # ghbyname
 379 gethostbyaddr 'foo' # ghbyaddr
 380 gethostent # ghostent
 381 getnetbyname 'foo' # gnbyname
 382 getnetbyaddr 'foo' # gnbyaddr
 383 getnetent # gnetent
 384 getprotobyname 'foo' # gpbyname
 385 getprotobynumber 42 # gpbynumber
 386 getprotoent # gprotoent
 387 getservbyname 'name', 'proto' # gsbyname
 388 getservbyport 'a', 'b' # gsbyport
 389 getservent # gservent
 390 sethostent # shostent
 391 setnetent # snetent
 392 setprotoent # sprotoent
 393 setservent # sservent
 394 endhostent # ehostent
 395 endnetent # enetent
 396 endprotoent # eprotoent
 397 endservent # eservent
 398 getpwnam # gpwnam
 399 getpwuid # gpwuid
 400 getpwent # gpwent
 401 setpwent # spwent
 402 endpwent # epwent
 403 getgrnam # ggrnam
 404 getgrgid # ggrgid
 405 getgrent # ggrent
 406 setgrent # sgrent
 407 endgrent # egrent
 408 getlogin # getlogin
 409 syscall # syscall
 410 SKIP # lock
 411 SKIP # threadsv
 412 SKIP # setstate
 413 $x->y() # method_named
 414 $x // $y # dor
 415 $x //= $y # dorassign
 416 SKIP (no way) # custom