Re: plperl fixes - Mailing list pgsql-patches

From Bruce Momjian
Subject Re: plperl fixes
Date
Msg-id 200407120041.i6C0fAW20024@candle.pha.pa.us
Whole thread Raw
In response to plperl fixes  (Andrew Dunstan <andrew@dunslane.net>)
List pgsql-patches
Previous patch removed from the queue.

Your patch has been added to the PostgreSQL unapplied patches list at:

    http://momjian.postgresql.org/cgi-bin/pgpatches

I will try to apply it within the next 48 hours.

---------------------------------------------------------------------------


Andrew Dunstan wrote:
>
> The attached patch, which incorporates the previous one sent and
> currently unapplied regarding spi_internal.c, makes some additional
> fixes relating to return types, and also contains the fix for
> preventing  the use of insecure versions of Safe.pm.
>
> There is one remaing return case that does not appear to work, namely
> return of a composite directly in a select, i.e. if  foo returns some
> composite type, 'select * from foo()' works but 'select foo()' doesn't.
> We will either fix that or document it as a limitation.
>
> The function plperl_func_handler is a mess - I will try to get it
> cleaned up (and split up) in a subsequent patch, time permitting.
>
> Also, reiterating previous advice - this changes slightly the API for
> spi_exec_query - the returned object has either 2 or 3 members: 'status'
> (string) and 'proceesed' (int,- number of rows) and, if rows are
> returned, 'rows' (array of tuple hashes).
>
> cheers
>
> andrew

> Index: plperl.c
> ===================================================================
> RCS file: /projects/cvsroot/pgsql-server/src/pl/plperl/plperl.c,v
> retrieving revision 1.45
> diff -c -w -r1.45 plperl.c
> *** plperl.c    1 Jul 2004 20:50:22 -0000    1.45
> --- plperl.c    7 Jul 2004 15:35:35 -0000
> ***************
> *** 80,85 ****
> --- 80,86 ----
>       CommandId    fn_cmin;
>       bool        lanpltrusted;
>       bool        fn_retistuple;    /* true, if function returns tuple */
> +     bool        fn_retisset;        /*true, if function returns set*/
>       Oid            ret_oid;        /* Oid of returning type */
>       FmgrInfo    result_in_func;
>       Oid            result_typioparam;
> ***************
> *** 95,105 ****
>    * Global data
>    **********************************************************************/
>   static int    plperl_firstcall = 1;
>   static PerlInterpreter *plperl_interp = NULL;
>   static HV  *plperl_proc_hash = NULL;
> ! AV           *g_row_keys = NULL;
> ! AV           *g_column_keys = NULL;
> ! int            g_attr_num = 0;
>
>   /**********************************************************************
>    * Forward declarations
> --- 96,108 ----
>    * Global data
>    **********************************************************************/
>   static int    plperl_firstcall = 1;
> + static bool plperl_safe_init_done = false;
>   static PerlInterpreter *plperl_interp = NULL;
>   static HV  *plperl_proc_hash = NULL;
> ! static AV           *g_row_keys = NULL;
> ! static AV           *g_column_keys = NULL;
> ! static SV           *srf_perlret=NULL; /*keep returned value*/
> ! static int            g_attr_num = 0;
>
>   /**********************************************************************
>    * Forward declarations
> ***************
> *** 215,225 ****
>            * no commas between the next lines please. They are supposed to be
>            * one string
>            */
> !         "require Safe; SPI::bootstrap(); use vars qw(%_SHARED);"
> !         "use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
> !         "$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');"
> !         "$PLContainer->share(qw[&elog &spi_exec_query &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);"
> !         "sub ::mksafefunc { return $PLContainer->reval(qq[sub { $_[0] $_[1]}]); }"
>           "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
>       };
>
> --- 218,224 ----
>            * no commas between the next lines please. They are supposed to be
>            * one string
>            */
> !         "SPI::bootstrap(); use vars qw(%_SHARED);"
>           "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
>       };
>
> ***************
> *** 238,243 ****
> --- 237,277 ----
>
>   }
>
> +
> + static void
> + plperl_safe_init(void)
> + {
> +     static char *safe_module  =
> +         "require Safe; $Safe::VERSION";
> +
> +     static char * safe_ok =
> +         "use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
> +         "$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');"
> +         "$PLContainer->share(qw[&elog &spi_exec_query &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);"
> +         "sub ::mksafefunc { return $PLContainer->reval(qq[sub { $_[0] $_[1]}]); }"
> +         ;
> +
> +     static char * safe_bad =
> +         "use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
> +         "$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');"
> +         "$PLContainer->share(qw[&elog &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);"
> +         "sub ::mksafefunc { return $PLContainer->reval(qq[sub { "
> +         "elog(ERROR,'trusted perl functions disabled - please upgrade perl Safe module to at least 2.09');}]); }"
> +         ;
> +
> +     SV * res;
> +
> +     float safe_version;
> +
> +     res = eval_pv(safe_module,FALSE); /* TRUE = croak if failure */
> +
> +     safe_version = SvNV(res);
> +
> +     eval_pv((safe_version < 2.09 ? safe_bad : safe_ok),FALSE);
> +
> +     plperl_safe_init_done = true;
> + }
> +
>   /**********************************************************************
>    * turn a tuple into a hash expression and add it to a list
>    **********************************************************************/
> ***************
> *** 596,601 ****
> --- 630,638 ----
>       SV           *subref;
>       int            count;
>
> +     if(trusted && !plperl_safe_init_done)
> +         plperl_safe_init();
> +
>       ENTER;
>       SAVETMPS;
>       PUSHMARK(SP);
> ***************
> *** 839,853 ****
>       /* Find or compile the function */
>       prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
>       /************************************************************
> !      * Call the Perl function
>        ************************************************************/
>       perlret = plperl_call_perl_func(prodesc, fcinfo);
> !     if (prodesc->fn_retistuple && SRF_IS_FIRSTCALL())
>       {
>
>           if (SvTYPE(perlret) != SVt_RV)
> !             elog(ERROR, "plperl: this function must return a reference");
> !         g_column_keys = newAV();
>       }
>
>       /************************************************************
> --- 876,897 ----
>       /* Find or compile the function */
>       prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
>       /************************************************************
> !      * Call the Perl function if not returning set
>        ************************************************************/
> +      if (!prodesc->fn_retisset)
>           perlret = plperl_call_perl_func(prodesc, fcinfo);
> !      else
>        {
> +         if (SRF_IS_FIRSTCALL()) /*call function only once*/
> +             srf_perlret = plperl_call_perl_func(prodesc, fcinfo);
> +         perlret = srf_perlret;
> +      }
>
> +      if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
> +      {
> +          if (prodesc->fn_retistuple) g_column_keys = newAV();
>            if (SvTYPE(perlret) != SVt_RV)
> !              elog(ERROR, "plperl: set-returning function must return reference");
>       }
>
>       /************************************************************
> ***************
> *** 882,895 ****
>           char      **values = NULL;
>           ReturnSetInfo  *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo;
>
> !         if (!rsinfo)
>               ereport(ERROR,
>                       (errcode(ERRCODE_SYNTAX_ERROR),
>                       errmsg("returning a composite type is not allowed in this context"),
>                       errhint("This function is intended for use in the FROM clause.")));
>
>           if (SvTYPE(perlret) != SVt_RV)
> !             elog(ERROR, "plperl: this function must return a reference");
>
>           isset = plperl_is_set(perlret);
>
> --- 926,940 ----
>           char      **values = NULL;
>           ReturnSetInfo  *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo;
>
> !         if (prodesc->fn_retisset && !rsinfo)
>               ereport(ERROR,
>                       (errcode(ERRCODE_SYNTAX_ERROR),
>                       errmsg("returning a composite type is not allowed in this context"),
>                       errhint("This function is intended for use in the FROM clause.")));
>
>           if (SvTYPE(perlret) != SVt_RV)
> !             elog(ERROR, "plperl: composite-returning function must return a reference");
> !
>
>           isset = plperl_is_set(perlret);
>
> ***************
> *** 997,1002 ****
> --- 1042,1094 ----
>               SRF_RETURN_DONE(funcctx);
>           }
>       }
> +     else if (prodesc->fn_retisset)
> +     {
> +         FuncCallContext    *funcctx;
> +
> +         if (SRF_IS_FIRSTCALL())
> +         {
> +             MemoryContext oldcontext;
> +             int i;
> +
> +             funcctx = SRF_FIRSTCALL_INIT();
> +             oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
> +
> +             if(SvTYPE(SvRV(perlret))!=SVt_PVAV) elog(ERROR, "plperl: set-returning function must return reference
toarray"); 
> +                 else funcctx->max_calls =  av_len((AV*)SvRV(perlret))+1;
> +         }
> +
> +         funcctx = SRF_PERCALL_SETUP();
> +
> +         if (funcctx->call_cntr < funcctx->max_calls)
> +         {
> +             Datum        result;
> +             AV*         array;
> +             SV**         svp;
> +             int             i;
> +
> +             array = (AV*)SvRV(perlret);
> +             svp = av_fetch(array, funcctx->call_cntr, FALSE);
> +
> +             if (SvTYPE(*svp) != SVt_NULL)
> +                 result = FunctionCall3(&prodesc->result_in_func,
> +                                    PointerGetDatum(SvPV(*svp, PL_na)),
> +                                    ObjectIdGetDatum(prodesc->result_typioparam),
> +                                    Int32GetDatum(-1));
> +             else
> +             {
> +                 fcinfo->isnull = true;
> +                 result = (Datum) 0;
> +             }
> +             SRF_RETURN_NEXT(funcctx, result);
> +             fcinfo->isnull = false;
> +         }
> +         else
> +         {
> +             if (perlret) SvREFCNT_dec(perlret);
> +             SRF_RETURN_DONE(funcctx);
> +         }
> +      }
>       else if (! fcinfo->isnull)
>       {
>           retval = FunctionCall3(&prodesc->result_in_func,
> ***************
> *** 1248,1253 ****
> --- 1340,1347 ----
>                                   format_type_be(procStruct->prorettype))));
>                   }
>               }
> +
> +             prodesc->fn_retisset = procStruct->proretset; /*true, if function returns set*/
>
>               if (typeStruct->typtype == 'c' || procStruct->prorettype == RECORDOID)
>               {
> Index: spi_internal.c
> ===================================================================
> RCS file: /projects/cvsroot/pgsql-server/src/pl/plperl/spi_internal.c,v
> retrieving revision 1.1
> diff -c -w -r1.1 spi_internal.c
> *** spi_internal.c    1 Jul 2004 20:50:22 -0000    1.1
> --- spi_internal.c    7 Jul 2004 15:35:35 -0000
> ***************
> *** 82,123 ****
>           * Get the attributes value
>           ************************************************************/
>           attdata = SPI_getvalue(tuple, tupdesc, i+1);
>           hv_store(array, attname, strlen(attname), newSVpv(attdata,0), 0);
>       }
>       return array;
>   }
>
>   static HV*
> ! plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int rows, int status)
>   {
>
>       HV *result;
>       int i;
>
>       result = newHV();
>
>       if (status == SPI_OK_UTILITY)
>       {
>           hv_store(result, "status", strlen("status"), newSVpv("SPI_OK_UTILITY",0), 0);
> !         hv_store(result, "rows", strlen("rows"), newSViv(rows), 0);
>       }
>       else if (status != SPI_OK_SELECT)
>       {
>           hv_store(result, "status", strlen("status"), newSVpv((char*)plperl_spi_status_string(status),0), 0);
> !         hv_store(result, "rows", strlen("rows"), newSViv(rows), 0);
>       }
>       else
>       {
> !         if (rows)
>           {
> -             char* key=palloc(sizeof(int));
>               HV *row;
> !             for (i = 0; i < rows; i++)
>               {
>                   row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
> !                 sprintf(key, "%i", i);
> !                 hv_store(result, key, strlen(key), newRV_noinc((SV*)row), 0);
>               }
>               SPI_freetuptable(tuptable);
>           }
>       }
> --- 82,129 ----
>           * Get the attributes value
>           ************************************************************/
>           attdata = SPI_getvalue(tuple, tupdesc, i+1);
> +         if(attdata)
>               hv_store(array, attname, strlen(attname), newSVpv(attdata,0), 0);
> +         else
> +             hv_store(array, attname, strlen(attname), newSVpv("undef",0), 0);
>       }
>       return array;
>   }
>
>   static HV*
> ! plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
>   {
>
>       HV *result;
> +      AV *rows;
>       int i;
>
>       result = newHV();
> +     rows = newAV();
>
>       if (status == SPI_OK_UTILITY)
>       {
>           hv_store(result, "status", strlen("status"), newSVpv("SPI_OK_UTILITY",0), 0);
> !         hv_store(result, "processed", strlen("processed"), newSViv(processed), 0);
>       }
>       else if (status != SPI_OK_SELECT)
>       {
>           hv_store(result, "status", strlen("status"), newSVpv((char*)plperl_spi_status_string(status),0), 0);
> !         hv_store(result, "processed", strlen("processed"), newSViv(processed), 0);
>       }
>       else
>       {
> !         hv_store(result, "status", strlen("status"), newSVpv((char*)plperl_spi_status_string(status),0), 0);
> !         hv_store(result, "processed", strlen("processed"), newSViv(processed), 0);
> !         if (processed)
>           {
>               HV *row;
> !             for (i = 0; i < processed; i++)
>               {
>                   row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
> !                  av_store(rows, i, newRV_noinc((SV*)row));
>               }
> +             hv_store(result, "rows", strlen("rows"), newRV_noinc((SV*)rows), 0);
>               SPI_freetuptable(tuptable);
>           }
>       }
> Index: spi_internal.h
> ===================================================================
> RCS file: /projects/cvsroot/pgsql-server/src/pl/plperl/spi_internal.h,v
> retrieving revision 1.1
> diff -c -w -r1.1 spi_internal.h
> *** spi_internal.h    1 Jul 2004 20:50:22 -0000    1.1
> --- spi_internal.h    7 Jul 2004 15:35:35 -0000
> ***************
> *** 1,6 ****
> --- 1,7 ----
>   #include "EXTERN.h"
>   #include "perl.h"
>   #include "XSUB.h"
> + #include "ppport.h"
>
>   int            spi_DEBUG(void);
>

>
> ---------------------------(end of broadcast)---------------------------
> TIP 6: Have you searched our list archives?
>
>                http://archives.postgresql.org

--
  Bruce Momjian                        |  http://candle.pha.pa.us
  pgman@candle.pha.pa.us               |  (610) 359-1001
  +  If your life is a hard drive,     |  13 Roberts Road
  +  Christ can be your backup.        |  Newtown Square, Pennsylvania 19073

pgsql-patches by date:

Previous
From: Bruce Momjian
Date:
Subject: Re: plperl spi_exec_query patch
Next
From: Bruce Momjian
Date:
Subject: Re: value.h has no VALUE_H