dist/Safe/t/safeops.t

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