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