aboutsummaryrefslogtreecommitdiff
path: root/src/pl
diff options
context:
space:
mode:
Diffstat (limited to 'src/pl')
-rw-r--r--src/pl/plperl/plc_perlboot.pl130
-rw-r--r--src/pl/plperl/plperl_opmask.pl35
-rw-r--r--src/pl/plperl/text2macro.pl24
-rw-r--r--src/pl/plpgsql/src/generate-plerrcodes.pl36
-rw-r--r--src/pl/plpython/generate-spiexceptions.pl42
5 files changed, 144 insertions, 123 deletions
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index e3e507722a8..d506d01163b 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -7,99 +7,113 @@ PostgreSQL::InServer::Util::bootstrap();
# globals
-sub ::is_array_ref {
+sub ::is_array_ref
+{
return ref($_[0]) =~ m/^(?:PostgreSQL::InServer::)?ARRAY$/;
}
-sub ::encode_array_literal {
+sub ::encode_array_literal
+{
my ($arg, $delim) = @_;
- return $arg unless(::is_array_ref($arg));
+ return $arg unless (::is_array_ref($arg));
$delim = ', ' unless defined $delim;
my $res = '';
- foreach my $elem (@$arg) {
+ foreach my $elem (@$arg)
+ {
$res .= $delim if length $res;
- if (ref $elem) {
+ if (ref $elem)
+ {
$res .= ::encode_array_literal($elem, $delim);
}
- elsif (defined $elem) {
+ elsif (defined $elem)
+ {
(my $str = $elem) =~ s/(["\\])/\\$1/g;
$res .= qq("$str");
}
- else {
+ else
+ {
$res .= 'NULL';
}
}
return qq({$res});
}
-sub ::encode_array_constructor {
+sub ::encode_array_constructor
+{
my $arg = shift;
return ::quote_nullable($arg) unless ::is_array_ref($arg);
- my $res = join ", ", map {
- (ref $_) ? ::encode_array_constructor($_)
- : ::quote_nullable($_)
- } @$arg;
+ my $res = join ", ",
+ map { (ref $_) ? ::encode_array_constructor($_) : ::quote_nullable($_) }
+ @$arg;
return "ARRAY[$res]";
}
{
-package PostgreSQL::InServer;
-use strict;
-use warnings;
-
-sub plperl_warn {
- (my $msg = shift) =~ s/\(eval \d+\) //g;
- chomp $msg;
- &::elog(&::WARNING, $msg);
-}
-$SIG{__WARN__} = \&plperl_warn;
-sub plperl_die {
- (my $msg = shift) =~ s/\(eval \d+\) //g;
- die $msg;
-}
-$SIG{__DIE__} = \&plperl_die;
+ package PostgreSQL::InServer;
+ use strict;
+ use warnings;
-sub mkfuncsrc {
- my ($name, $imports, $prolog, $src) = @_;
+ sub plperl_warn
+ {
+ (my $msg = shift) =~ s/\(eval \d+\) //g;
+ chomp $msg;
+ &::elog(&::WARNING, $msg);
+ }
+ $SIG{__WARN__} = \&plperl_warn;
- my $BEGIN = join "\n", map {
- my $names = $imports->{$_} || [];
- "$_->import(qw(@$names));"
- } sort keys %$imports;
- $BEGIN &&= "BEGIN { $BEGIN }";
+ sub plperl_die
+ {
+ (my $msg = shift) =~ s/\(eval \d+\) //g;
+ die $msg;
+ }
+ $SIG{__DIE__} = \&plperl_die;
- return qq[ package main; sub { $BEGIN $prolog $src } ];
-}
+ sub mkfuncsrc
+ {
+ my ($name, $imports, $prolog, $src) = @_;
-sub mkfunc {
- no strict; # default to no strict for the eval
- no warnings; # default to no warnings for the eval
- my $ret = eval(mkfuncsrc(@_));
- $@ =~ s/\(eval \d+\) //g if $@;
- return $ret;
-}
+ my $BEGIN = join "\n", map {
+ my $names = $imports->{$_} || [];
+ "$_->import(qw(@$names));"
+ } sort keys %$imports;
+ $BEGIN &&= "BEGIN { $BEGIN }";
-1;
+ return qq[ package main; sub { $BEGIN $prolog $src } ];
+ }
+
+ sub mkfunc
+ {
+ no strict; # default to no strict for the eval
+ no warnings; # default to no warnings for the eval
+ my $ret = eval(mkfuncsrc(@_));
+ $@ =~ s/\(eval \d+\) //g if $@;
+ return $ret;
+ }
+
+ 1;
}
{
-package PostgreSQL::InServer::ARRAY;
-use strict;
-use warnings;
-use overload
- '""'=>\&to_str,
- '@{}'=>\&to_arr;
+ package PostgreSQL::InServer::ARRAY;
+ use strict;
+ use warnings;
-sub to_str {
- my $self = shift;
- return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'});
-}
+ use overload
+ '""' => \&to_str,
+ '@{}' => \&to_arr;
-sub to_arr {
- return shift->{'array'};
-}
+ sub to_str
+ {
+ my $self = shift;
+ return ::encode_typed_literal($self->{'array'}, $self->{'typeoid'});
+ }
+
+ sub to_arr
+ {
+ return shift->{'array'};
+ }
-1;
+ 1;
}
diff --git a/src/pl/plperl/plperl_opmask.pl b/src/pl/plperl/plperl_opmask.pl
index 3e9ecaa3c1b..61e5cac1485 100644
--- a/src/pl/plperl/plperl_opmask.pl
+++ b/src/pl/plperl/plperl_opmask.pl
@@ -5,54 +5,59 @@ 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_h = shift
+ or die "Usage: $0 <output_filename.h>\n";
-my $plperl_opmask_tmp = $plperl_opmask_h."tmp";
+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: $!";
+ 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],
-);
+
+ # 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))) {
+foreach my $opname (opset_to_ops(opset(@allowed_ops)))
+{
printf $fh qq{ opmask[OP_%-12s] = 0;\t/* %s */ \\\n},
- uc($opname), opdesc($opname);
+ uc($opname), opdesc($opname);
}
printf $fh " /* end */ \n";
close $fh
- or die "Error closing $plperl_opmask_tmp: $!";
+ 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: $!";
+ or die "Error renaming $plperl_opmask_tmp to $plperl_opmask_h: $!";
exit 0;
diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl
index 88241e2cb2f..c88e5ec4be2 100644
--- a/src/pl/plperl/text2macro.pl
+++ b/src/pl/plperl/text2macro.pl
@@ -32,11 +32,10 @@ GetOptions(
'prefix=s' => \my $opt_prefix,
'name=s' => \my $opt_name,
'strip=s' => \my $opt_strip,
- 'selftest!' => sub { exit selftest() },
-) or exit 1;
+ 'selftest!' => sub { exit selftest() },) or exit 1;
die "No text files specified"
- unless @ARGV;
+ unless @ARGV;
print qq{
/*
@@ -45,17 +44,19 @@ print qq{
*/
};
-for my $src_file (@ARGV) {
+for my $src_file (@ARGV)
+{
(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
- open my $src_fh, $src_file # not 3-arg form
- or die "Can't open $src_file: $!";
+ open my $src_fh, $src_file # not 3-arg form
+ or die "Can't open $src_file: $!";
printf qq{#define %s%s \\\n},
- $opt_prefix || '',
- ($opt_name) ? $opt_name : uc $macro;
- while (<$src_fh>) {
+ $opt_prefix || '',
+ ($opt_name) ? $opt_name : uc $macro;
+ while (<$src_fh>)
+ {
chomp;
next if $opt_strip and m/$opt_strip/o;
@@ -74,8 +75,9 @@ print "/* end */\n";
exit 0;
-sub selftest {
- my $tmp = "text2macro_tmp";
+sub selftest
+{
+ my $tmp = "text2macro_tmp";
my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
open my $fh, ">$tmp.pl" or die;
diff --git a/src/pl/plpgsql/src/generate-plerrcodes.pl b/src/pl/plpgsql/src/generate-plerrcodes.pl
index 066f83d1780..89c6a137050 100644
--- a/src/pl/plpgsql/src/generate-plerrcodes.pl
+++ b/src/pl/plpgsql/src/generate-plerrcodes.pl
@@ -6,35 +6,35 @@
use warnings;
use strict;
-print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
+print
+ "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef PLERRCODES_H here */\n";
open my $errcodes, $ARGV[0] or die;
-while (<$errcodes>) {
- chomp;
+while (<$errcodes>)
+{
+ chomp;
- # Skip comments
- next if /^#/;
- next if /^\s*$/;
+ # Skip comments
+ next if /^#/;
+ next if /^\s*$/;
- # Skip section headers
- next if /^Section:/;
+ # Skip section headers
+ next if /^Section:/;
- die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
+ die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
- (my $sqlstate,
- my $type,
- my $errcode_macro,
- my $condition_name) = ($1, $2, $3, $4);
+ (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
+ ($1, $2, $3, $4);
- # Skip non-errors
- next unless $type eq 'E';
+ # Skip non-errors
+ next unless $type eq 'E';
- # Skip lines without PL/pgSQL condition names
- next unless defined($condition_name);
+ # Skip lines without PL/pgSQL condition names
+ next unless defined($condition_name);
- print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n";
+ print "{\n\t\"$condition_name\", $errcode_macro\n},\n\n";
}
close $errcodes;
diff --git a/src/pl/plpython/generate-spiexceptions.pl b/src/pl/plpython/generate-spiexceptions.pl
index c29a03e05cd..31bf5bfd796 100644
--- a/src/pl/plpython/generate-spiexceptions.pl
+++ b/src/pl/plpython/generate-spiexceptions.pl
@@ -6,39 +6,39 @@
use warnings;
use strict;
-print "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
+print
+ "/* autogenerated from src/backend/utils/errcodes.txt, do not edit */\n";
print "/* there is deliberately not an #ifndef SPIEXCEPTIONS_H here */\n";
open my $errcodes, $ARGV[0] or die;
-while (<$errcodes>) {
- chomp;
+while (<$errcodes>)
+{
+ chomp;
- # Skip comments
- next if /^#/;
- next if /^\s*$/;
+ # Skip comments
+ next if /^#/;
+ next if /^\s*$/;
- # Skip section headers
- next if /^Section:/;
+ # Skip section headers
+ next if /^Section:/;
- die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
+ die unless /^([^\s]{5})\s+([EWS])\s+([^\s]+)(?:\s+)?([^\s]+)?/;
- (my $sqlstate,
- my $type,
- my $errcode_macro,
- my $condition_name) = ($1, $2, $3, $4);
+ (my $sqlstate, my $type, my $errcode_macro, my $condition_name) =
+ ($1, $2, $3, $4);
- # Skip non-errors
- next unless $type eq 'E';
+ # Skip non-errors
+ next unless $type eq 'E';
- # Skip lines without PL/pgSQL condition names
- next unless defined($condition_name);
+ # Skip lines without PL/pgSQL condition names
+ next unless defined($condition_name);
- # Change some_error_condition to SomeErrorCondition
- $condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g;
+ # Change some_error_condition to SomeErrorCondition
+ $condition_name =~ s/([a-z])([^_]*)(?:_|$)/\u$1$2/g;
- print "{ \"spiexceptions.$condition_name\", " .
- "\"$condition_name\", $errcode_macro },\n";
+ print "{ \"spiexceptions.$condition_name\", "
+ . "\"$condition_name\", $errcode_macro },\n";
}
close $errcodes;
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-07 02:58:57 +0000