[Sigh. This email, unlike the previous, actually includes the patch.]
On Mon, Feb 08, 2010 at 01:44:16PM +0000, Tim Bunce wrote:
>
> > I'll continue reviewing the patch, but these things at least need fixing.
Here's an updated patch. The only changes relative to the previous
version are in the docs, as I outlined in the previous message.
I'll add it to the commitfest.
Tim.
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 7018624..f742f0b 100644
*** a/doc/src/sgml/plperl.sgml
--- b/doc/src/sgml/plperl.sgml
*************** $$ LANGUAGE plperl;
*** 748,753 ****
--- 748,759 ----
<literal>return $_SHARED{myquote}->($_[0]);</literal>
at the expense of readability.)
</para>
+
+ <para>
+ The <varname>%_SHARED</varname> variable and other global state within
+ the language is public data, available to all PL/Perl functions within a
+ session. Use with care.
+ </para>
</sect1>
<sect1 id="plperl-trusted">
*************** CREATE TRIGGER test_valid_id_trig
*** 1044,1069 ****
<variablelist>
! <varlistentry id="guc-plperl-on-perl-init" xreflabel="plperl.on_perl_init">
! <term><varname>plperl.on_perl_init</varname> (<type>string</type>)</term>
<indexterm>
! <primary><varname>plperl.on_perl_init</> configuration parameter</primary>
</indexterm>
<listitem>
<para>
! Specifies perl code to be executed when a perl interpreter is first initialized.
The SPI functions are not available when this code is executed.
If the code fails with an error it will abort the initialization of the interpreter
and propagate out to the calling query, causing the current transaction
or subtransaction to be aborted.
</para>
<para>
! The perl code is limited to a single string. Longer code can be placed
! into a module and loaded by the <literal>on_perl_init</> string.
Examples:
<programlisting>
! plplerl.on_perl_init = '$ENV{NYTPROF}="start=no"; require Devel::NYTProf::PgPLPerl'
! plplerl.on_perl_init = 'use lib "/my/app"; use MyApp::PgInit;'
</programlisting>
</para>
<para>
--- 1050,1076 ----
<variablelist>
! <varlistentry id="guc-plperl-on-init" xreflabel="plperl.on_init">
! <term><varname>plperl.on_init</varname> (<type>string</type>)</term>
<indexterm>
! <primary><varname>plperl.on_init</> configuration parameter</primary>
</indexterm>
<listitem>
<para>
! Specifies Perl code to be executed when a Perl interpreter is first initialized
! and before it is specialized for use by <literal>plperl</> or <literal>plperlu</>.
The SPI functions are not available when this code is executed.
If the code fails with an error it will abort the initialization of the interpreter
and propagate out to the calling query, causing the current transaction
or subtransaction to be aborted.
</para>
<para>
! The Perl code is limited to a single string. Longer code can be placed
! into a module and loaded by the <literal>on_init</> string.
Examples:
<programlisting>
! plplerl.on_init = '$ENV{NYTPROF}="start=no"; require Devel::NYTProf::PgPLPerl'
! plplerl.on_init = 'use lib "/my/app"; use MyApp::PgInit;'
</programlisting>
</para>
<para>
*************** plplerl.on_perl_init = 'use lib "/my/app
*** 1077,1082 ****
--- 1084,1129 ----
</listitem>
</varlistentry>
+ <varlistentry id="guc-plperl-on-plperl-init" xreflabel="plperl.on_plperl_init">
+ <term><varname>plperl.on_plperl_init</varname> (<type>string</type>)</term>
+ <term><varname>plperl.on_plperlu_init</varname> (<type>string</type>)</term>
+ <indexterm>
+ <primary><varname>plperl.on_plperl_init</> configuration parameter</primary>
+ </indexterm>
+ <indexterm>
+ <primary><varname>plperl.on_plperlu_init</> configuration parameter</primary>
+ </indexterm>
+ <listitem>
+ <para>
+ These parameters specify Perl code to be executed when the
+ <literal>plperl</>, or <literal>plperlu</> language is first used in a
+ session. Changes to these parameters after the corresponding language
+ has been used will have no effect.
+ The SPI functions are not available when this code is executed.
+ Only superusers can change these settings.
+ The Perl code in <literal>plperl.on_plperl_init</> can only perform trusted operations.
+ </para>
+ <para>
+ The effect of setting these parameters is very similar to executing a
+ <literal>DO</> command with the Perl code before any other use of the
+ language. The parameters are useful when you want to execute the Perl
+ code automatically on every connection, or when a connection is not
+ interactive. The parameters can be used by non-superusers by having a
+ superuser execute an <literal>ALTER USER ... SET ...</> command.
+ For example:
+ <programlisting>
+ ALTER USER joe SET plplerl.on_plperl_init = '$_SHARED{debug} = 1';
+ </programlisting>
+ </para>
+ <para>
+ If the code fails with an error it will abort the initialization and
+ propagate out to the calling query, causing the current transaction or
+ subtransaction to be aborted. Any changes within Perl won't be undone.
+ If the language is used again the initialization will be repeated.
+ </para>
+ </listitem>
+ </varlistentry>
+
<varlistentry id="guc-plperl-use-strict" xreflabel="plperl.use_strict">
<term><varname>plperl.use_strict</varname> (<type>boolean</type>)</term>
<indexterm>
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index a9bb003..165e90d 100644
*** a/src/pl/plperl/GNUmakefile
--- b/src/pl/plperl/GNUmakefile
*************** PERLCHUNKS = plc_perlboot.pl plc_safe_ba
*** 41,47 ****
SHLIB_LINK = $(perl_embed_ldflags)
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperlu
# if Perl can support two interpreters in one backend,
# test plperl-and-plperlu cases
ifneq ($(PERL),)
--- 41,47 ----
SHLIB_LINK = $(perl_embed_ldflags)
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
! REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu
# if Perl can support two interpreters in one backend,
# test plperl-and-plperlu cases
ifneq ($(PERL),)
diff --git a/src/pl/plperl/expected/plperl_init.out b/src/pl/plperl/expected/plperl_init.out
index ...a2d4e18 .
*** a/src/pl/plperl/expected/plperl_init.out
--- b/src/pl/plperl/expected/plperl_init.out
***************
*** 0 ****
--- 1,14 ----
+ -- test plperl.on_plperl_init errors are fatal
+ -- Avoid need for custom_variable_classes = 'plperl'
+ LOAD 'plperl';
+ SET SESSION plperl.on_plperl_init = ' eval "1+1" ';
+ SHOW plperl.on_plperl_init;
+ plperl.on_plperl_init
+ -----------------------
+ eval "1+1"
+ (1 row)
+
+ DO $$ warn 42 $$ language plperl;
+ ERROR: while executing plperl.on_plperl_init
+ DETAIL: 'eval "string"' trapped by operation mask at line 2.
+ CONTEXT: PL/Perl anonymous code block
diff --git a/src/pl/plperl/expected/plperl_shared.out b/src/pl/plperl/expected/plperl_shared.out
index 72ae1ba..d054985 100644
*** a/src/pl/plperl/expected/plperl_shared.out
--- b/src/pl/plperl/expected/plperl_shared.out
***************
*** 1,3 ****
--- 1,9 ----
+ -- test plperl.on_plperl_init via the shared hash
+ -- (must be done before plperl is first used)
+ -- Avoid need for custom_variable_classes = 'plperl'
+ LOAD 'plperl';
+ -- testing on_plperl_init gets run, and that it can alter %_SHARED
+ SET plperl.on_plperl_init = '$_SHARED{on_init} = 42';
-- test the shared hash
create function setme(key text, val text) returns void language plperl as $$
*************** select getme('ourkey');
*** 24,26 ****
--- 30,38 ----
ourval
(1 row)
+ select getme('on_init');
+ getme
+ -------
+ 42
+ (1 row)
+
diff --git a/src/pl/plperl/expected/plperlu.out b/src/pl/plperl/expected/plperlu.out
index c464e56..a37262c 100644
*** a/src/pl/plperl/expected/plperlu.out
--- b/src/pl/plperl/expected/plperlu.out
***************
*** 1,5 ****
--- 1,12 ----
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
-- see plperl_plperlu.sql
+ -- Avoid need for custom_variable_classes = 'plperl'
+ LOAD 'plperl';
+ -- Test plperl.on_plperlu_init gets run
+ SET plperl.on_plperlu_init = '$_SHARED{init} = 42';
+ DO $$ warn $_SHARED{init} $$ language plperlu;
+ NOTICE: 42 at line 1.
+ CONTEXT: PL/Perl anonymous code block
--
-- Test compilation of unicode regex - regardless of locale.
-- This code fails in plain plperl in a non-UTF8 database.
diff --git a/src/pl/plperl/plc_safe_ok.pl b/src/pl/plperl/plc_safe_ok.pl
index 0999d40..e8abb07 100644
*** a/src/pl/plperl/plc_safe_ok.pl
--- b/src/pl/plperl/plc_safe_ok.pl
*************** $PLContainer->permit(qw[caller]);
*** 31,36 ****
--- 31,37 ----
}) or die $@;
$PLContainer->deny(qw[caller]);
+ # called directly for plperl.on_plperl_init
sub ::safe_eval {
my $ret = $PLContainer->reval(shift);
$@ =~ s/\(eval \d+\) //g if $@;
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 1a559f3..05ed7fe 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
*************** static HTAB *plperl_proc_hash = NULL;
*** 139,145 ****
static HTAB *plperl_query_hash = NULL;
static bool plperl_use_strict = false;
! static char *plperl_on_perl_init = NULL;
static bool plperl_ending = false;
/* this is saved and restored by plperl_call_handler */
--- 139,147 ----
static HTAB *plperl_query_hash = NULL;
static bool plperl_use_strict = false;
! static char *plperl_on_init = NULL;
! static char *plperl_on_plperl_init = NULL;
! static char *plperl_on_plperlu_init = NULL;
static bool plperl_ending = false;
/* this is saved and restored by plperl_call_handler */
*************** static plperl_proc_desc *compile_plperl_
*** 164,170 ****
static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
static void plperl_init_shared_libs(pTHX);
! static void plperl_safe_init(void);
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
static SV *newSVstring(const char *str);
static SV **hv_store_string(HV *hv, const char *key, SV *val);
--- 166,173 ----
static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
static void plperl_init_shared_libs(pTHX);
! static void plperl_trusted_init(void);
! static void plperl_untrusted_init(void);
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
static SV *newSVstring(const char *str);
static SV **hv_store_string(HV *hv, const char *key, SV *val);
*************** _PG_init(void)
*** 242,255 ****
PGC_USERSET, 0,
NULL, NULL);
! DefineCustomStringVariable("plperl.on_perl_init",
! gettext_noop("Perl code to execute when the perl interpreter is initialized."),
NULL,
! &plperl_on_perl_init,
NULL,
PGC_SIGHUP, 0,
NULL, NULL);
EmitWarningsOnPlaceholders("plperl");
MemSet(&hash_ctl, 0, sizeof(hash_ctl));
--- 245,282 ----
PGC_USERSET, 0,
NULL, NULL);
! DefineCustomStringVariable("plperl.on_init",
! gettext_noop("Perl initialization code to execute when a perl interpreter is initialized."),
NULL,
! &plperl_on_init,
NULL,
PGC_SIGHUP, 0,
NULL, NULL);
+ /*
+ * plperl.on_plperl_init is currently PGC_SUSET to avoid issues whereby a user
+ * who doesn't have USAGE privileges on the plperl language could possibly use
+ * SET plperl.on_plperl_init='...' to influence the behaviour of any existing
+ * plperl function that they can EXECUTE (which may be security definer).
+ * Set http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php
+ * and the overall thread.
+ */
+ DefineCustomStringVariable("plperl.on_plperl_init",
+ gettext_noop("Perl initialization code to execute once when plperl is first used."),
+ NULL,
+ &plperl_on_plperl_init,
+ NULL,
+ PGC_SUSET, 0,
+ NULL, NULL);
+
+ DefineCustomStringVariable("plperl.on_plperlu_init",
+ gettext_noop("Perl initialization code to execute once when plperlu is first used."),
+ NULL,
+ &plperl_on_plperlu_init,
+ NULL,
+ PGC_SUSET, 0,
+ NULL, NULL);
+
EmitWarningsOnPlaceholders("plperl");
MemSet(&hash_ctl, 0, sizeof(hash_ctl));
*************** plperl_fini(int code, Datum arg)
*** 285,291 ****
elog(DEBUG3, "plperl_fini");
/*
! * Disable use of spi_* functions when running END/DESTROY code.
* Could be enabled in future, with care, using a transaction
* http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
*/
--- 312,320 ----
elog(DEBUG3, "plperl_fini");
/*
! * Indicate that perl is terminating.
! * Disables use of spi_* functions when running END/DESTROY code.
! * See check_spi_usage_allowed().
* Could be enabled in future, with care, using a transaction
* http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
*/
*************** select_perl_context(bool trusted)
*** 340,350 ****
--- 369,381 ----
if (trusted)
{
+ plperl_trusted_init();
plperl_trusted_interp = plperl_held_interp;
interp_state = INTERP_TRUSTED;
}
else
{
+ plperl_untrusted_init();
plperl_untrusted_interp = plperl_held_interp;
interp_state = INTERP_UNTRUSTED;
}
*************** select_perl_context(bool trusted)
*** 353,362 ****
{
#ifdef MULTIPLICITY
PerlInterpreter *plperl = plperl_init_interp();
! if (trusted)
plperl_trusted_interp = plperl;
! else
plperl_untrusted_interp = plperl;
interp_state = INTERP_BOTH;
#else
elog(ERROR,
--- 384,397 ----
{
#ifdef MULTIPLICITY
PerlInterpreter *plperl = plperl_init_interp();
! if (trusted) {
! plperl_trusted_init();
plperl_trusted_interp = plperl;
! }
! else {
! plperl_untrusted_init();
plperl_untrusted_interp = plperl;
+ }
interp_state = INTERP_BOTH;
#else
elog(ERROR,
*************** select_perl_context(bool trusted)
*** 367,383 ****
trusted_context = trusted;
/*
! * initialization - done after plperl_*_interp and trusted_context
! * updates above to ensure a clean state (and thereby avoid recursion via
! * plperl_safe_init caling plperl_call_perl_func for utf8fix)
! */
! if (trusted) {
! plperl_safe_init();
! PL_ppaddr[OP_REQUIRE] = pp_require_safe;
! }
!
! /*
! * enable access to the database
*/
newXS("PostgreSQL::InServer::SPI::bootstrap",
boot_PostgreSQL__InServer__SPI, __FILE__);
--- 402,412 ----
trusted_context = trusted;
/*
! * Since the timing of first use of PL/Perl can't be predicted,
! * any database interaction during initialization is problematic.
! * Including, but not limited to, security definer issues.
! * So we only enable access to the database AFTER on_*_init code has run.
! * See http://archives.postgresql.org/message-id/20100127143318.ge...@timac.local
*/
newXS("PostgreSQL::InServer::SPI::bootstrap",
boot_PostgreSQL__InServer__SPI, __FILE__);
*************** plperl_init_interp(void)
*** 474,483 ****
save_time = loc ? pstrdup(loc) : NULL;
#endif
! if (plperl_on_perl_init)
{
embedding[nargs++] = "-e";
! embedding[nargs++] = plperl_on_perl_init;
}
/****
--- 503,512 ----
save_time = loc ? pstrdup(loc) : NULL;
#endif
! if (plperl_on_init)
{
embedding[nargs++] = "-e";
! embedding[nargs++] = plperl_on_init;
}
/****
*************** plperl_destroy_interp(PerlInterpreter **
*** 645,651 ****
static void
! plperl_safe_init(void)
{
SV *safe_version_sv;
IV safe_version_x100;
--- 674,680 ----
static void
! plperl_trusted_init(void)
{
SV *safe_version_sv;
IV safe_version_x100;
*************** plperl_safe_init(void)
*** 684,721 ****
if (GetDatabaseEncoding() == PG_UTF8)
{
/*
! * Fill in just enough information to set up this perl function in
! * the safe container and call it. For some reason not entirely
! * clear, it prevents errors that can arise from the regex code
! * later trying to load utf8 modules.
* See http://rt.perl.org/rt3/Ticket/Display.html?id=47576
*/
! plperl_proc_desc desc;
! FunctionCallInfoData fcinfo;
! SV *perlret;
! desc.proname = "utf8fix";
! desc.lanpltrusted = true;
! desc.nargs = 1;
! desc.arg_is_rowtype[0] = false;
! fmgr_info(F_TEXTOUT, &(desc.arg_out_func[0]));
! /* compile the function */
! plperl_create_sub(&desc,
! "return shift =~ /\\xa9/i ? 'true' : 'false' ;", 0);
! /* set up to call the function with a single text argument 'a' */
! fcinfo.arg[0] = CStringGetTextDatum("a");
! fcinfo.argnull[0] = false;
! /* and make the call */
! perlret = plperl_call_perl_func(&desc, &fcinfo);
! SvREFCNT_dec(perlret);
}
}
}
/*
* Perl likes to put a newline after its error messages; clean up such
*/
--- 713,776 ----
if (GetDatabaseEncoding() == PG_UTF8)
{
/*
! * Force loading of utf8 module now to prevent errors that can
! * arise from the regex code later trying to load utf8 modules.
* See http://rt.perl.org/rt3/Ticket/Display.html?id=47576
*/
! eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
! if (SvTRUE(ERRSV))
! {
! ereport(ERROR,
! (errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while executing utf8fix"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
! }
! }
! /* switch to the safe require opcode */
! PL_ppaddr[OP_REQUIRE] = pp_require_safe;
! if (plperl_on_plperl_init && *plperl_on_plperl_init)
! {
! dSP;
! PUSHMARK(SP);
! XPUSHs(sv_2mortal(newSVstring(plperl_on_plperl_init)));
! PUTBACK;
! call_pv("::safe_eval", G_VOID);
! SPAGAIN;
! if (SvTRUE(ERRSV))
! {
! ereport(ERROR,
! (errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while executing plperl.on_plperl_init"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
! }
}
+
}
}
+
+ static void
+ plperl_untrusted_init(void)
+ {
+ if (plperl_on_plperlu_init && *plperl_on_plperlu_init)
+ {
+ eval_pv(plperl_on_plperlu_init, FALSE);
+ if (SvTRUE(ERRSV))
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_INTERNAL_ERROR),
+ errmsg("while executing plperl.on_plperlu_init"),
+ errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
+ }
+ }
+ }
+
+
/*
* Perl likes to put a newline after its error messages; clean up such
*/
*************** plperl_init_shared_libs(pTHX)
*** 1284,1289 ****
--- 1339,1345 ----
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
newXS("PostgreSQL::InServer::Util::bootstrap",
boot_PostgreSQL__InServer__Util, file);
+ /* newXS for...::SPI::bootstrap is in select_perl_context() */
}
*************** plperl_hash_from_tuple(HeapTuple tuple,
*** 2020,2025 ****
--- 2076,2082 ----
static void
check_spi_usage_allowed()
{
+ /* see comment in plperl_fini() */
if (plperl_ending) {
/* simple croak as we don't want to involve PostgreSQL code */
croak("SPI functions can not be used in END blocks");
diff --git a/src/pl/plperl/sql/plperl_init.sql b/src/pl/plperl/sql/plperl_init.sql
index ...69b12e9 .
*** a/src/pl/plperl/sql/plperl_init.sql
--- b/src/pl/plperl/sql/plperl_init.sql
***************
*** 0 ****
--- 1,10 ----
+ -- test plperl.on_plperl_init errors are fatal
+
+ -- Avoid need for custom_variable_classes = 'plperl'
+ LOAD 'plperl';
+
+ SET SESSION plperl.on_plperl_init = ' eval "1+1" ';
+
+ SHOW plperl.on_plperl_init;
+
+ DO $$ warn 42 $$ language plperl;
diff --git a/src/pl/plperl/sql/plperl_shared.sql b/src/pl/plperl/sql/plperl_shared.sql
index 3e99e59..a617b46 100644
*** a/src/pl/plperl/sql/plperl_shared.sql
--- b/src/pl/plperl/sql/plperl_shared.sql
***************
*** 1,3 ****
--- 1,12 ----
+ -- test plperl.on_plperl_init via the shared hash
+ -- (must be done before plperl is first used)
+
+ -- Avoid need for custom_variable_classes = 'plperl'
+ LOAD 'plperl';
+
+ -- testing on_plperl_init gets run, and that it can alter %_SHARED
+ SET plperl.on_plperl_init = '$_SHARED{on_init} = 42';
+
-- test the shared hash
create function setme(key text, val text) returns void language plperl as $$
*************** select setme('ourkey','ourval');
*** 19,22 ****
select getme('ourkey');
!
--- 28,31 ----
select getme('ourkey');
! select getme('on_init');
diff --git a/src/pl/plperl/sql/plperlu.sql b/src/pl/plperl/sql/plperlu.sql
index 978bb4b..125691e 100644
*** a/src/pl/plperl/sql/plperlu.sql
--- b/src/pl/plperl/sql/plperlu.sql
***************
*** 1,6 ****
--- 1,13 ----
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
-- see plperl_plperlu.sql
+ -- Avoid need for custom_variable_classes = 'plperl'
+ LOAD 'plperl';
+
+ -- Test plperl.on_plperlu_init gets run
+ SET plperl.on_plperlu_init = '$_SHARED{init} = 42';
+ DO $$ warn $_SHARED{init} $$ language plperlu;
+
--
-- Test compilation of unicode regex - regardless of locale.
-- This code fails in plain plperl in a non-UTF8 database.
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
