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: