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

Reply via email to