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@postgresql.org) > To make changes to your subscription: > http://www.postgresql.org/mailpref/pgsql-hackers -- Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org) To make changes to your subscription: http://www.postgresql.org/mailpref/pgsql-hackers