[p5sagit/p5-mst-13.2.git] / ext / Safe / t / safeops.t

#!perl
# Tests that all ops can be trapped by a Safe compartment

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
	@INC = '../lib';
    }
    else {
	# this won't work outside of the core, so exit
        print "1..0\n"; exit 0;
    }
}
use Config;
BEGIN {
    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
        print "1..0\n"; exit 0;
    }
}

use strict;
use Test::More tests => 354;
use Safe;

# Read the op names and descriptions directly from opcode.pl
my @op;
my @opname;
open my $fh, '<', '../opcode.pl' or die "Can't open opcode.pl: $!";
while (<$fh>) {
    last if /^__END__/;
}
while (<$fh>) {
    chomp;
    next if !$_ or /^#/;
    my ($op, $opname) = split /\t+/;
    push @op, $op;
    push @opname, $opname;
}
close $fh;

sub testop {
    my ($op, $opname, $code) = @_;
    pass("$op : skipped") and return if $code =~ /^SKIP/;
    pass("$op : skipped") and return if $code =~ m://: && $] < 5.009; # no dor
    my $c = new Safe;
    $c->deny_only($op);
    $c->reval($code);
    like($@, qr/'\Q$opname\E' trapped by operation mask/, $op);
}

my $i = 0;
while (<DATA>) {
    testop $op[$i], $opname[$i], $_;
    ++$i;
}

# lists op examples, in the same order than opcode.pl
# things that begin with SKIP are skipped, for various reasons (notably
# optree modified by the optimizer -- Safe checks are done before the
# optimizer modifies the optree)

__DATA__
SKIP # null
SKIP # stub
scalar $x # scalar
print @x # pushmark
wantarray # wantarray
42 # const
SKIP (set by optimizer) $x # gvsv
SKIP *x # gv
*x{SCALAR} # gelem
SKIP my $x # padsv
SKIP my @x # padav
SKIP my %x # padhv
SKIP (not implemented) # padany
SKIP split /foo/ # pushre
*x # rv2gv
$x # rv2sv
$#x # av2arylen
f() # rv2cv
sub { } # anoncode
prototype 'foo' # prototype
\($x,$y) # refgen
SKIP \$x # srefgen
ref # ref
bless # bless
qx/ls/ # backtick
<*.c> # glob
<FH> # readline
SKIP (set by optimizer) $x .= <F> # rcatline
SKIP (internal) # regcmaybe
SKIP (internal) # regcreset
SKIP (internal) # regcomp
/foo/ # match
qr/foo/ # qr
s/foo/bar/ # subst
SKIP (set by optimizer) # substcont
y:z:t: # trans
$x = $y # sassign
@x = @y # aassign
chop @foo # chop
chop # schop
chomp @foo # chomp
chomp # schomp
defined # defined
undef # undef
study # study
pos # pos
++$i # preinc
SKIP (set by optimizer) # i_preinc
--$i # predec
SKIP (set by optimizer) # i_predec
$i++ # postinc
SKIP (set by optimizer) # i_postinc
$i-- # postdec
SKIP (set by optimizer) # i_postdec
$x ** $y # pow
$x * $y # multiply
SKIP (set by optimizer) # i_multiply
$x / $y # divide
SKIP (set by optimizer) # i_divide
$x % $y # modulo
SKIP (set by optimizer) # i_modulo
$x x $y # repeat
$x + $y # add
SKIP (set by optimizer) # i_add
$x - $y # subtract
SKIP (set by optimizer) # i_subtract
$x . $y # concat
"$x" # stringify
$x << 1 # left_shift
$x >> 1 # right_shift
$x < $y # lt
SKIP (set by optimizer) # i_lt
$x > $y # gt
SKIP (set by optimizer) # i_gt
$i <= $y # le
SKIP (set by optimizer) # i_le
$i >= $y # ge
SKIP (set by optimizer) # i_ge
$x == $y # eq
SKIP (set by optimizer) # i_eq
$x != $y # ne
SKIP (set by optimizer) # i_ne
$i <=> $y # ncmp
SKIP (set by optimizer) # i_ncmp
$x lt $y # slt
$x gt $y # sgt
$x le $y # sle
$x ge $y # sge
$x eq $y # seq
$x ne $y # sne
$x cmp $y # scmp
$x & $y # bit_and
$x ^ $y # bit_xor
$x | $y # bit_or
-$x # negate
SKIP (set by optimizer) # i_negate
!$x # not
~$x # complement
atan2 1 # atan2
sin 1 # sin
cos 1 # cos
rand # rand
srand # srand
exp 1 # exp
log 1 # log
sqrt 1 # sqrt
int # int
hex # hex
oct # oct
abs # abs
length # length
substr $x, 1 # substr
vec # vec
index # index
rindex # rindex
sprintf '%s', 'foo' # sprintf
formline # formline
ord # ord
chr # chr
crypt 'foo','bar' # crypt
ucfirst # ucfirst
lcfirst # lcfirst
uc # uc
lc # lc
quotemeta # quotemeta
@a # rv2av
SKIP (set by optimizer) # aelemfast
$a[1] # aelem
@a[1,2] # aslice
each %h # each
values %h # values
keys %h # keys
delete $h{Key} # delete
exists $h{Key} # exists
%h # rv2hv
$h{kEy} # helem
@h{kEy} # hslice
unpack # unpack
pack # pack
split /foo/ # split
join $a, @b # join
@x = (1,2) # list
SKIP @x[1,2] # lslice
[1,2] # anonlist
{ a => 1 } # anonhash
splice @x, 1, 2, 3 # splice
push @x, $x # push
pop @x # pop
shift @x # shift
unshift @x # unshift
sort @x # sort
reverse @x # reverse
grep { $_ eq 'foo' } @x # grepstart
SKIP grep { $_ eq 'foo' } @x # grepwhile
map $_ + 1, @foo # mapstart
SKIP (set by optimizer) # mapwhile
SKIP # range
1..2 # flip
1..2 # flop
$x && $y # and
$x || $y # or
$x xor $y # xor
$x ? 1 : 0 # cond_expr
$x &&= $y # andassign
$x ||= $y # orassign
Foo->$x() # method
f() # entersub
sub f{} f() # leavesub
sub f:lvalue{return $x} f() # leavesublv
caller # caller
warn # warn
die # die
reset # reset
SKIP # lineseq
SKIP # nextstate
SKIP (needs debugger) # dbstate
while(0){} # unstack
SKIP # enter
SKIP # leave
SKIP # scope
SKIP # enteriter
SKIP # iter
SKIP # enterloop
SKIP # leaveloop
return # return
last # last
next # next
redo THIS # redo
dump # dump
goto THERE # goto
exit 0 # exit
open FOO # open
close FOO # close
pipe FOO,BAR # pipe_op
fileno FOO # fileno
umask 0755, 'foo' # umask
binmode FOO # binmode
tie # tie
untie # untie
tied # tied
dbmopen # dbmopen
dbmclose # dbmclose
SKIP (set by optimizer) # sselect
select FOO # select
getc FOO # getc
read FOO # read
write # enterwrite
SKIP # leavewrite
printf # prtf
print # print
sysopen # sysopen
sysseek # sysseek
sysread # sysread
syswrite # syswrite
send # send
recv # recv
eof FOO # eof
tell # tell
seek FH, $pos, $whence # seek
truncate FOO, 42 # truncate
fcntl # fcntl
ioctl # ioctl
flock FOO, 1 # flock
socket # socket
socketpair # sockpair
bind # bind
connect # connect
listen # listen
accept # accept
shutdown # shutdown
getsockopt # gsockopt
setsockopt # ssockopt
getsockname # getsockname
getpeername # getpeername
lstat FOO # lstat
stat FOO # stat
-R # ftrread
-W # ftrwrite
-X # ftrexec
-r # fteread
-w # ftewrite
-x # fteexec
-e # ftis
SKIP -O # fteowned
SKIP -o # ftrowned
-z # ftzero
-s # ftsize
-M # ftmtime
-A # ftatime
-C # ftctime
-S # ftsock
-c # ftchr
-b # ftblk
-f # ftfile
-d # ftdir
-p # ftpipe
-l # ftlink
-u # ftsuid
-g # ftsgid
-k # ftsvtx
-t # fttty
-T # fttext
-B # ftbinary
chdir '/' # chdir
chown # chown
chroot # chroot
unlink 'foo' # unlink
chmod 511, 'foo' # chmod
utime # utime
rename 'foo', 'bar' # rename
link 'foo', 'bar' # link
symlink 'foo', 'bar' # symlink
readlink 'foo' # readlink
mkdir 'foo' # mkdir
rmdir 'foo' # rmdir
opendir DIR # open_dir
readdir DIR # readdir
telldir DIR # telldir
seekdir DIR, $pos # seekdir
rewinddir DIR # rewinddir
closedir DIR # closedir
fork # fork
wait # wait
waitpid # waitpid
system # system
exec # exec
kill # kill
getppid # getppid
getpgrp # getpgrp
setpgrp # setpgrp
getpriority # getpriority
setpriority # setpriority
time # time
times # tms
localtime # localtime
gmtime # gmtime
alarm # alarm
sleep 1 # sleep
shmget # shmget
shmctl # shmctl
shmread # shmread
shmwrite # shmwrite
msgget # msgget
msgctl # msgctl
msgsnd # msgsnd
msgrcv # msgrcv
semget # semget
semctl # semctl
semop # semop
use strict # require
do 'file' # dofile
eval "1+1" # entereval
eval "1+1" # leaveeval
SKIP eval { 1+1 } # entertry
SKIP eval { 1+1 } # leavetry
gethostbyname 'foo' # ghbyname
gethostbyaddr 'foo' # ghbyaddr
gethostent # ghostent
getnetbyname 'foo' # gnbyname
getnetbyaddr 'foo' # gnbyaddr
getnetent # gnetent
getprotobyname 'foo' # gpbyname
getprotobynumber 42 # gpbynumber
getprotoent # gprotoent
getservbyname 'name', 'proto' # gsbyname
getservbyport 'a', 'b' # gsbyport
getservent # gservent
sethostent # shostent
setnetent # snetent
setprotoent # sprotoent
setservent # sservent
endhostent # ehostent
endnetent # enetent
endprotoent # eprotoent
endservent # eservent
getpwnam # gpwnam
getpwuid # gpwuid
getpwent # gpwent
setpwent # spwent
endpwent # epwent
getgrnam # ggrnam
getgrgid # ggrgid
getgrent # ggrent
setgrent # sgrent
endgrent # egrent
getlogin # getlogin
syscall # syscall
SKIP # lock
SKIP # threadsv
SKIP # setstate
$x->y() # method_named
$x // $y # dor
$x //= $y # dorassign
SKIP (no way) # custom
Commit	Line	Data
6c52f3eb	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/;
fd9784a1	44	pass("$op : skipped") and return if $code =~ m://: && $] < 5.009; # no dor
6c52f3eb	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