Adding upstream version 13.4.upstream/13.4upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 63 insertions, 0 deletions

diff --git a/src/pl/plperl/plperl_opmask.pl b/src/pl/plperl/plperl_opmask.pl
new file mode 100644
index 0000000..3b33112
--- /dev/null
+++ b/src/pl/plperl/plperl_opmask.pl
@@ -0,0 +1,63 @@
+#!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;