6
use Opcode qw(opset opset_to_ops opdesc full_opset);
8
my $plperl_opmask_h = shift
9
or die "Usage: $0 <output_filename.h>\n";
11
my $plperl_opmask_tmp = $plperl_opmask_h."tmp";
12
END { unlink $plperl_opmask_tmp }
14
open my $fh, ">", "$plperl_opmask_tmp"
15
or die "Could not write to $plperl_opmask_tmp: $!";
17
printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n";
18
printf $fh " memset(opmask, 1, MAXO);\t/* disable all */ \\\n";
19
printf $fh " /* then allow some... */ \\\n";
22
# basic set of opcodes
23
qw[:default :base_math !:base_io sort time],
24
# require is safe because we redirect the opcode
25
# entereval is safe as the opmask is now permanently set
26
# caller is safe because the entire interpreter is locked down
27
qw[require entereval caller],
28
# These are needed for utf8_heavy.pl:
29
# dofile is safe because we redirect the opcode like require above
30
# print is safe because the only writable filehandles are STDOUT & STDERR
31
# prtf (printf) is safe as it's the same as print + sprintf
32
qw[dofile print prtf],
33
# Disallow these opcodes that are in the :base_orig optag
34
# (included in :default) but aren't considered sufficiently safe
35
qw[!dbmopen !setpgrp !setpriority],
38
if (grep { /^custom$/ } opset_to_ops(full_opset) ) {
39
# custom is not deemed a likely security risk as it can't be generated from
40
# perl so would only be seen if the DBA had chosen to load a module that
41
# used it. Even then it's unlikely to be seen because it's typically
42
# generated by compiler plugins that operate after PL_op_mask checks.
43
# But we err on the side of caution and disable it, if it is actually
45
push(@allowed_ops,qw[!custom]);
48
printf $fh " /* ALLOWED: @allowed_ops */ \\\n";
50
foreach my $opname (opset_to_ops(opset(@allowed_ops))) {
51
printf $fh qq{ opmask[OP_%-12s] = 0;\t/* %s */ \\\n},
52
uc($opname), opdesc($opname);
54
printf $fh " /* end */ \n";
57
or die "Error closing $plperl_opmask_tmp: $!";
59
rename $plperl_opmask_tmp, $plperl_opmask_h
60
or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!";