Re: Add on_trusted_init and on_untrusted_init to plperl [PATCH]

Now the dust is settling on the on_perl_init patch I'd like to ask for
clarification on this next patch.

On Fri, Jan 15, 2010 at 12:35:06AM +0000, Tim Bunce wrote:
> This is the fourth of the patches to be split out from the former
> 'plperl feature patch 1'.
>
> Changes in this patch:

I think the only controversial change is this one:

> - Adds plperl.on_trusted_init and plperl.on_untrusted_init GUCs
> Both are PGC_USERSET.
> SPI functions are not available when the code is run.
> Errors are detected and reported as ereport(ERROR, ...)
+ plperl.on_trusted_init runs inside the Safe compartment.

As I recall, Tom had concerns over the combination of PGC_USERSET and
before-first-use semantics.

Would changing plperl.on_trusted_init and plperl.on_untrusted_init to
PGC_BACKEND, so the user can't change the value after the session has
started, resolve those concerns?

Any other concerns with this patch?

Tim.

> - select_perl_context() state management improved
> An error during interpreter initialization will leave
> the state (interp_state etc) unchanged.
>
> - The utf8fix code has been greatly simplified.
>
> Tim.

> diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
> index 0054f5a..f2c91a9 100644
> *** a/doc/src/sgml/plperl.sgml
> --- b/doc/src/sgml/plperl.sgml
> *************** plplerl.on_perl_init = 'use lib "/my/app
> *** 1079,1084 ****
> --- 1079,1120 ----
> </listitem>
> </varlistentry>
>
> + <varlistentry id="guc-plperl-on-trusted-init" xreflabel="plperl.on_trusted_init">
> + <term><varname>plperl.on_trusted_init</varname> (<type>string</type>)</term>
> + <indexterm>
> + <primary><varname>plperl.on_trusted_init</> configuration parameter</primary>
> + </indexterm>
> + <listitem>
> + <para>
> + Specifies perl code to be executed when the <literal>plperl</> perl interpreter
> + is first initialized in a session. The perl code can only perform trusted operations.
> + The SPI functions are not available when this code is executed.
> + Changes made after a <literal>plperl</> perl interpreter has been initialized will have no effect.
> + 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>
> + </listitem>
> + </varlistentry>
> +
> + <varlistentry id="guc-plperl-on-untrusted-init" xreflabel="plperl.on_untrusted_init">
> + <term><varname>plperl.on_untrusted_init</varname> (<type>string</type>)</term>
> + <indexterm>
> + <primary><varname>plperl.on_untrusted_init</> configuration parameter</primary>
> + </indexterm>
> + <listitem>
> + <para>
> + Specifies perl code to be executed when the <literal>plperlu</> perl interpreter
> + is first initialized in a session.
> + The SPI functions are not available when this code is executed.
> + Changes made after a <literal>plperlu</> perl interpreter has been initialized will have no effect.
> + 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>
> + </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 7cd5721..f3cabad 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 ...e69de29 .
> diff --git a/src/pl/plperl/expected/plperl_shared.out b/src/pl/plperl/expected/plperl_shared.out
> index 72ae1ba..c1c12c1 100644
> *** a/src/pl/plperl/expected/plperl_shared.out
> --- b/src/pl/plperl/expected/plperl_shared.out
> ***************
> *** 1,3 ****
> --- 1,7 ----
> + -- test plperl.on_plperl_init via the shared hash
> + -- (must be done before plperl is initialized)
> + -- testing on_trusted_init gets run, and that it can alter %_SHARED
> + SET plperl.on_trusted_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 ****
> --- 28,36 ----
> ourval
> (1 row)
>
> + select getme('on_init');
> + getme
> + -------
> + 42
> + (1 row)
> +
> diff --git a/src/pl/plperl/plc_safe_ok.pl b/src/pl/plperl/plc_safe_ok.pl
> index dc33dd6..7b36e33 100644
> *** a/src/pl/plperl/plc_safe_ok.pl
> --- b/src/pl/plperl/plc_safe_ok.pl
> *************** $PLContainer->permit(qw[caller]);
> *** 27,32 ****
> --- 27,33 ----
> }) or die $@;
> $PLContainer->deny(qw[caller]);
>
> + # called directly for plperl.on_trusted_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 8315d5a..2eef4a7 100644
> *** a/src/pl/plperl/plperl.c
> --- b/src/pl/plperl/plperl.c
> *************** static HTAB *plperl_query_hash = NULL;
> *** 139,144 ****
> --- 139,146 ----
>
> static bool plperl_use_strict = false;
> static char *plperl_on_perl_init = NULL;
> + static char *plperl_on_trusted_init = NULL;
> + static char *plperl_on_untrusted_init = NULL;
> static bool plperl_ending = false;
>
> /* this is saved and restored by plperl_call_handler */
> *************** static plperl_proc_desc *compile_plperl_
> *** 163,169 ****
>
> 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);
> --- 165,172 ----
>
> 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)
> *** 249,254 ****
> --- 252,273 ----
> PGC_SIGHUP, 0,
> NULL, NULL);
>
> + DefineCustomStringVariable("plperl.on_trusted_init",
> + gettext_noop("Perl code to execute when plperl is initialized for user."),
> + NULL,
> + &plperl_on_trusted_init,
> + NULL,
> + PGC_USERSET, 0,
> + NULL, NULL);
> +
> + DefineCustomStringVariable("plperl.on_untrusted_init",
> + gettext_noop("Perl code to execute when plperlu is initialized for user."),
> + NULL,
> + &plperl_on_untrusted_init,
> + NULL,
> + PGC_USERSET, 0,
> + NULL, NULL);
> +
> EmitWarningsOnPlaceholders("plperl");
>
> MemSet(&hash_ctl, 0, sizeof(hash_ctl));
> *************** select_perl_context(bool trusted)
> *** 323,333 ****
> --- 342,354 ----
>
> 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)
> *** 336,345 ****
> {
> #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,
> --- 357,370 ----
> {
> #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)
> *** 350,365 ****
> 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",
> --- 375,380 ----
> *************** plperl_destroy_interp(PerlInterpreter **
> *** 603,609 ****
>
>
> static void
> ! plperl_safe_init(void)
> {
> SV *safe_version_sv;
> IV safe_version_x100;
> --- 618,624 ----
>
>
> static void
> ! plperl_trusted_init(void)
> {
> SV *safe_version_sv;
> IV safe_version_x100;
> *************** plperl_safe_init(void)
> *** 642,679 ****
> 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
> */
> --- 657,720 ----
> 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_trusted_init && *plperl_on_trusted_init)
> ! {
> ! dSP;
>
> ! PUSHMARK(SP);
> ! XPUSHs(sv_2mortal(newSVstring(plperl_on_trusted_init)));
> ! PUTBACK;
>
> ! call_pv("::safe_eval", G_VOID);
> ! SPAGAIN;
>
> ! if (SvTRUE(ERRSV))
> ! {
> ! ereport(ERROR,
> ! (errcode(ERRCODE_INTERNAL_ERROR),
> ! errmsg("while executing plperl.on_trusted_init"),
> ! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
> ! }
> }
> +
> }
> }
>
> +
> + static void
> + plperl_untrusted_init(void)
> + {
> + if (plperl_on_untrusted_init && *plperl_on_untrusted_init)
> + {
> + eval_pv(plperl_on_untrusted_init, FALSE);
> + if (SvTRUE(ERRSV))
> + {
> + ereport(ERROR,
> + (errcode(ERRCODE_INTERNAL_ERROR),
> + errmsg("while executing plperl.on_untrusted_init"),
> + errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
> + }
> + }
> + }
> +
> +
> /*
> * Perl likes to put a newline after its error messages; clean up such
> */
> diff --git a/src/pl/plperl/sql/plperl_init.sql b/src/pl/plperl/sql/plperl_init.sql
> index ...5f6b963 .
> *** a/src/pl/plperl/sql/plperl_init.sql
> --- b/src/pl/plperl/sql/plperl_init.sql
> ***************
> *** 0 ****
> --- 1,7 ----
> + -- test plperl.on_trusted_init errors are fatal
> +
> + SET SESSION plperl.on_trusted_init = ' eval "1+1" ';
> +
> + SHOW plperl.on_trusted_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..83cc5f0 100644
> *** a/src/pl/plperl/sql/plperl_shared.sql
> --- b/src/pl/plperl/sql/plperl_shared.sql
> ***************
> *** 1,3 ****
> --- 1,9 ----
> + -- test plperl.on_plperl_init via the shared hash
> + -- (must be done before plperl is initialized)
> +
> + -- testing on_trusted_init gets run, and that it can alter %_SHARED
> + SET plperl.on_trusted_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');
>
> !
> --- 25,28 ----
>
> select getme('ourkey');
>
> ! select getme('on_init');

>
> --
> Sent via pgsql-hackers mailing list (pgsql-hackers(at)postgresql(dot)org)
> To make changes to your subscription:
> http://www.postgresql.org/mailpref/pgsql-hackers