Skip to content

P
Postgres FD Implementation
Commit 1a7c2f9d authored by Andrew Dunstan's avatar Andrew Dunstan
Browse files
Options

Various small improvements and cleanups for PL/Perl. 

- Allow (ineffective) use of 'require' in plperl
    If the required module is not already loaded then it dies.
    So "use strict;" now works in plperl.

- Pre-load the feature module if perl >= 5.10.
    So "use feature :5.10;" now works in plperl.

- Stored procedure subs are now given names.
    The names are not visible in ordinary use, but they make
    tools like Devel::NYTProf and Devel::Cover much more useful.

- Simplified and generalized the subroutine creation code.
    Now one code path for generating sub source code, not four.
    Can generate multiple 'use' statements with specific imports
    (which handles plperl.use_strict currently and can easily
    be extended to handle a plperl.use_feature=':5.12' in future).

- Disallows use of Safe version 2.20 which is broken for PL/Perl.
    http://rt.perl.org/rt3/Ticket/Display.html?id=72068

- Assorted minor optimizations by pre-growing data structures.

Patch from Tim Bunce, reviewed by Alex Hunsaker.
parent d879697c
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 270 additions and 176 deletions
doc/src/sgml/plperl.sgml
View file @ 1a7c2f9d
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.74 2010/01/20 03:37:10 rhaas Exp $ -->
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.75 2010/01/26 23:11:56 adunstan Exp $ -->
<chapter id="plperl">
<title>PL/Perl - Perl Procedural Language</title>
......@@ -285,29 +285,39 @@ SELECT * FROM perl_set();
</para>
<para>
If you wish to use the <literal>strict</> pragma with your code,
the easiest way to do so is to <command>SET</>
<literal>plperl.use_strict</literal> to true. This parameter affects
subsequent compilations of <application>PL/Perl</> functions, but not
functions already compiled in the current session. To set the
parameter before <application>PL/Perl</> has been loaded, it is
necessary to have added <quote><literal>plperl</></> to the <xref
linkend="guc-custom-variable-classes"> list in
<filename>postgresql.conf</filename>.
If you wish to use the <literal>strict</> pragma with your code you have a few options.
For temporary global use you can <command>SET</> <literal>plperl.use_strict</literal>
to true (see <xref linkend="plperl.use_strict">).
This will affect subsequent compilations of <application>PL/Perl</>
functions, but not functions already compiled in the current session.
For permanent global use you can set <literal>plperl.use_strict</literal>
to true in the <filename>postgresql.conf</filename> file.
</para>
<para>
Another way to use the <literal>strict</> pragma is to put:
For permanent use in specific functions you can simply put:
<programlisting>
use strict;
</programlisting>
in the function body. But this only works in <application>PL/PerlU</>
functions, since the <literal>use</> triggers a <literal>require</>
which is not a trusted operation. In
<application>PL/Perl</> functions you can instead do:
<programlisting>
BEGIN { strict->import(); }
</programlisting>
at the top of the function body.
</para>
<para>
The <literal>feature</> pragma is also available to <function>use</> if your Perl is version 5.10.0 or higher.
</para>
</sect1>
<sect1 id="plperl-data">
<title>Data Values in PL/Perl</title>
<para>
The argument values supplied to a PL/Perl function's code are
simply the input arguments converted to text form (just as if they
had been displayed by a <command>SELECT</command> statement).
Conversely, the <function>return</function> and <function>return_next</function>
commands will accept any string that is acceptable input format
for the function's declared return type.
</para>
</sect1>
......@@ -682,18 +692,6 @@ SELECT done();
</sect2>
</sect1>
<sect1 id="plperl-data">
<title>Data Values in PL/Perl</title>
<para>
The argument values supplied to a PL/Perl function's code are
simply the input arguments converted to text form (just as if they
had been displayed by a <command>SELECT</command> statement).
Conversely, the <literal>return</> command will accept any string
that is acceptable input format for the function's declared return
type. So, within the PL/Perl function,
all values are just text strings.
</para>
</sect1>
<sect1 id="plperl-global">
......@@ -1042,8 +1040,7 @@ CREATE TRIGGER test_valid_id_trig
<itemizedlist>
<listitem>
<para>
PL/Perl functions cannot call each other directly (because they
are anonymous subroutines inside Perl).
PL/Perl functions cannot call each other directly.
</para>
</listitem>
......@@ -1072,6 +1069,8 @@ CREATE TRIGGER test_valid_id_trig
</listitem>
</itemizedlist>
</para>
</sect2>
</sect1>
</chapter>
src/pl/plperl/expected/plperl.out
View file @ 1a7c2f9d
......@@ -563,6 +563,17 @@ $$ LANGUAGE plperl;
NOTICE: This is a test
CONTEXT: PL/Perl anonymous code block
-- check that restricted operations are rejected in a plperl DO block
DO $$ use Config; $$ LANGUAGE plperl;
ERROR: 'require' trapped by operation mask at line 1.
DO $$ eval "1+1"; $$ LANGUAGE plperl;
ERROR: 'eval "string"' trapped by operation mask at line 1.
CONTEXT: PL/Perl anonymous code block
-- check that we can't "use" a module that's not been loaded already
-- compile-time error: "Unable to load blib.pm into plperl"
DO $$ use blib; $$ LANGUAGE plperl;
ERROR: Unable to load blib.pm into plperl at line 1.
BEGIN failed--compilation aborted at line 1.
CONTEXT: PL/Perl anonymous code block
-- check that we can "use" a module that has already been loaded
-- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use
DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
ERROR: Can't use string ("foo") as a SCALAR ref while "strict refs" in use at line 1.
CONTEXT: PL/Perl anonymous code block
src/pl/plperl/expected/plperl_plperlu.out
View file @ 1a7c2f9d
-- test plperl/plperlu interaction
-- the language and call ordering of this test sequence is useful
CREATE OR REPLACE FUNCTION bar() RETURNS integer AS $$
#die 'BANG!'; # causes server process to exit(2)
# alternative - causes server process to exit(255)
spi_exec_query("invalid sql statement");
$$ language plperl; -- plperl or plperlu
$$ language plperl; -- compile plperl code
CREATE OR REPLACE FUNCTION foo() RETURNS integer AS $$
spi_exec_query("SELECT * FROM bar()");
return 1;
$$ LANGUAGE plperlu; -- must be opposite to language of bar
$$ LANGUAGE plperlu; -- compile plperlu code
SELECT * FROM bar(); -- throws exception normally
SELECT * FROM bar(); -- throws exception normally (running plperl)
ERROR: syntax error at or near "invalid" at line 4.
CONTEXT: PL/Perl function "bar"
SELECT * FROM foo(); -- used to cause backend crash
SELECT * FROM foo(); -- used to cause backend crash (after switching to plperlu)
ERROR: syntax error at or near "invalid" at line 4. at line 2.
CONTEXT: PL/Perl function "foo"
src/pl/plperl/plc_perlboot.pl
View file @ 1a7c2f9d
# $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
# $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.3 2010/01/26 23:11:56 adunstan Exp $
PostgreSQL::InServer::Util::bootstrap();
PostgreSQL::InServer::SPI::bootstrap();
......@@ -21,17 +21,25 @@ sub ::plperl_die {
}
$SIG{__DIE__} = \&::plperl_die;
sub ::mkfuncsrc {
my ($name, $imports, $prolog, $src) = @_;
sub ::mkunsafefunc {
my $ret = eval(qq[ sub { $_[0] $_[1] } ]);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
my $BEGIN = join "\n", map {
my $names = $imports->{$_} || [];
"$_->import(qw(@$names));"
} sort keys %$imports;
$BEGIN &&= "BEGIN { $BEGIN }";
$name =~ s/\\/\\\\/g;
$name =~ s/::|'/_/g; # avoid package delimiters
return qq[ undef *{'$name'}; *{'$name'} = sub { $BEGIN $prolog $src } ];
}
use strict;
sub ::mk_strict_unsafefunc {
my $ret = eval(qq[ sub { use strict; $_[0] $_[1] } ]);
# see also mksafefunc() in plc_safe_ok.pl
sub ::mkunsafefunc {
no strict; # default to no strict for the eval
my $ret = eval(::mkfuncsrc(@_));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
......@@ -64,7 +72,7 @@ sub ::encode_array_constructor {
if ref $arg ne 'ARRAY';
my $res = join ", ", map {
(ref $_) ? ::encode_array_constructor($_)
: ::quote_nullable($_)
: ::quote_nullable($_)
} @$arg;
return "ARRAY[$res]";
}
......
src/pl/plperl/plc_safe_bad.pl
View file @ 1a7c2f9d
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_bad.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_bad.pl,v 1.3 2010/01/26 23:11:56 adunstan Exp $
use vars qw($PLContainer);
# Minimal version of plc_safe_ok.pl
# that's used if Safe is too old or doesn't load for any reason
$PLContainer = new Safe('PLPerl');
$PLContainer->permit_only(':default');
$PLContainer->share(qw[&elog &ERROR]);
my $msg = 'trusted Perl functions disabled - please upgrade Perl Safe module';
my $msg = 'trusted Perl functions disabled - please upgrade Perl Safe module to version 2.09 or later';
sub ::mksafefunc {
return $PLContainer->reval(qq[sub { elog(ERROR,'$msg') }]);
sub mksafefunc {
my ($name, $pragma, $prolog, $src) = @_;
# replace $src with code to generate an error
$src = qq{ ::elog(::ERROR,"$msg\n") };
my $ret = eval(::mkfuncsrc($name, $pragma, '', $src));
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
sub ::mk_strict_safefunc {
return $PLContainer->reval(qq[sub { elog(ERROR,'$msg') }]);
}
src/pl/plperl/plc_safe_ok.pl
View file @ 1a7c2f9d
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.3 2010/01/26 23:11:56 adunstan Exp $
use strict;
use vars qw($PLContainer);
$PLContainer = new Safe('PLPerl');
$PLContainer->permit_only(':default');
$PLContainer->permit(qw[:base_math !:base_io sort time]);
$PLContainer->permit(qw[:base_math !:base_io sort time require]);
$PLContainer->share(qw[&elog &return_next
&spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query
......@@ -18,23 +19,24 @@ $PLContainer->share(qw[&elog &return_next
&looks_like_number
]);
# Load strict into the container.
# The temporary enabling of the caller opcode here is to work around a
# bug in perl 5.10, which unkindly changed the way its Safe.pm works, without
# notice. It is quite safe, as caller is informational only, and in any case
# we only enable it while we load the 'strict' module.
$PLContainer->permit(qw[require caller]);
$PLContainer->reval('use strict;');
$PLContainer->deny(qw[require caller]);
sub ::mksafefunc {
my $ret = $PLContainer->reval(qq[sub { $_[0] $_[1] }]);
# Load widely useful pragmas into the container to make them available.
# (Temporarily enable caller here as work around for bug in perl 5.10,
# which changed the way its Safe.pm works. It is quite safe, as caller is
# informational only.)
$PLContainer->permit(qw[caller]);
::safe_eval(q{
require strict;
require feature if $] >= 5.010000;
1;
}) or die $@;
$PLContainer->deny(qw[caller]);
sub ::safe_eval {
my $ret = $PLContainer->reval(shift);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
}
sub ::mk_strict_safefunc {
my $ret = $PLContainer->reval(qq[sub { BEGIN { strict->import(); } $_[0] $_[1] }]);
$@ =~ s/\(eval \d+\) //g if $@;
return $ret;
sub ::mksafefunc {
return ::safe_eval(::mkfuncsrc(@_));
}
src/pl/plperl/plperl.c
View file @ 1a7c2f9d
This diff is collapsed.
src/pl/plperl/sql/plperl.sql
View file @ 1a7c2f9d
......@@ -368,5 +368,13 @@ DO $$
$$ LANGUAGE plperl;
-- check that restricted operations are rejected in a plperl DO block
DO $$ use Config; $$ LANGUAGE plperl;
DO $$ eval "1+1"; $$ LANGUAGE plperl;
-- check that we can't "use" a module that's not been loaded already
-- compile-time error: "Unable to load blib.pm into plperl"
DO $$ use blib; $$ LANGUAGE plperl;
-- check that we can "use" a module that has already been loaded
-- runtime error: "Can't use string ("foo") as a SCALAR ref while "strict refs" in use
DO $do$ use strict; my $name = "foo"; my $ref = $$name; $do$ LANGUAGE plperl;
src/pl/plperl/sql/plperl_plperlu.sql
View file @ 1a7c2f9d
-- test plperl/plperlu interaction
-- the language and call ordering of this test sequence is useful
CREATE OR REPLACE FUNCTION bar() RETURNS integer AS $$
#die 'BANG!'; # causes server process to exit(2)
# alternative - causes server process to exit(255)
spi_exec_query("invalid sql statement");
$$ language plperl; -- plperl or plperlu
$$ language plperl; -- compile plperl code
CREATE OR REPLACE FUNCTION foo() RETURNS integer AS $$
spi_exec_query("SELECT * FROM bar()");
return 1;
$$ LANGUAGE plperlu; -- must be opposite to language of bar
$$ LANGUAGE plperlu; -- compile plperlu code
SELECT * FROM bar(); -- throws exception normally
SELECT * FROM foo(); -- used to cause backend crash
SELECT * FROM bar(); -- throws exception normally (running plperl)
SELECT * FROM foo(); -- used to cause backend crash (after switching to plperlu)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment