64 lines
2.0 KiB
Perl
64 lines
2.0 KiB
Perl
#!perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Opcode qw(opset opset_to_ops opdesc);
|
|
|
|
my $plperl_opmask_h = shift
|
|
or die "Usage: $0 <output_filename.h>\n";
|
|
|
|
my $plperl_opmask_tmp = $plperl_opmask_h . "tmp";
|
|
END { unlink $plperl_opmask_tmp }
|
|
|
|
open my $fh, ">", "$plperl_opmask_tmp"
|
|
or die "Could not write to $plperl_opmask_tmp: $!";
|
|
|
|
printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n";
|
|
printf $fh " memset(opmask, 1, MAXO);\t/* disable all */ \\\n";
|
|
printf $fh " /* then allow some... */ \\\n";
|
|
|
|
my @allowed_ops = (
|
|
|
|
# basic set of opcodes
|
|
qw[:default :base_math !:base_io sort time],
|
|
|
|
# require is safe because we redirect the opcode
|
|
# entereval is safe as the opmask is now permanently set
|
|
# caller is safe because the entire interpreter is locked down
|
|
qw[require entereval caller],
|
|
|
|
# These are needed for utf8_heavy.pl:
|
|
# dofile is safe because we redirect the opcode like require above
|
|
# print is safe because the only writable filehandles are STDOUT & STDERR
|
|
# prtf (printf) is safe as it's the same as print + sprintf
|
|
qw[dofile print prtf],
|
|
|
|
# Disallow these opcodes that are in the :base_orig optag
|
|
# (included in :default) but aren't considered sufficiently safe
|
|
qw[!dbmopen !setpgrp !setpriority],
|
|
|
|
# custom is not deemed a likely security risk as it can't be generated from
|
|
# perl so would only be seen if the DBA had chosen to load a module that
|
|
# used it. Even then it's unlikely to be seen because it's typically
|
|
# generated by compiler plugins that operate after PL_op_mask checks.
|
|
# But we err on the side of caution and disable it
|
|
qw[!custom],);
|
|
|
|
printf $fh " /* ALLOWED: @allowed_ops */ \\\n";
|
|
|
|
foreach my $opname (opset_to_ops(opset(@allowed_ops)))
|
|
{
|
|
printf $fh qq{ opmask[OP_%-12s] = 0;\t/* %s */ \\\n},
|
|
uc($opname), opdesc($opname);
|
|
}
|
|
printf $fh " /* end */\n";
|
|
|
|
close $fh
|
|
or die "Error closing $plperl_opmask_tmp: $!";
|
|
|
|
rename $plperl_opmask_tmp, $plperl_opmask_h
|
|
or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!";
|
|
|
|
exit 0;
|