src/pl/plperl/plperl_opmask.pl

   1 #!perl
   2
   3 # Copyright (c) 2021-2024, PostgreSQL Global Development Group
   4
   5 use strict;
   6 use warnings FATAL => 'all';
   7
   8 use Opcode qw(opset opset_to_ops opdesc);
   9
  10 my $plperl_opmask_h = shift
  11   or die "Usage: $0 <output_filename.h>\n";
  12
  13 my $plperl_opmask_tmp = $plperl_opmask_h . "tmp";
  14 END { unlink $plperl_opmask_tmp }
  15
  16 open my $fh, ">", "$plperl_opmask_tmp"
  17   or die "Could not write to $plperl_opmask_tmp: $!";
  18
  19 printf $fh "#define PLPERL_SET_OPMASK(opmask) \\\n";
  20 printf $fh "  memset(opmask, 1, MAXO);\t/* disable all */ \\\n";
  21 printf $fh "  /* then allow some... */                       \\\n";
  22
  23 my @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
  50 printf $fh "  /* ALLOWED: @allowed_ops */ \\\n";
  51
  52 foreach 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 }
  57 printf $fh "                                                            /* end */\n";
  58
  59 close $fh
  60   or die "Error closing $plperl_opmask_tmp: $!";
  61
  62 rename $plperl_opmask_tmp, $plperl_opmask_h
  63   or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!";
  64
  65 exit 0;