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