Patch applied.  Thanks.

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


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 to array");
> +                             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
  [EMAIL PROTECTED]               |  (610) 359-1001
  +  If your life is a hard drive,     |  13 Roberts Road
  +  Christ can be your backup.        |  Newtown Square, Pennsylvania 19073

---------------------------(end of broadcast)---------------------------
TIP 4: Don't 'kill -9' the postmaster

Reply via email to