Skip to content

Commit 96b9dc1

Browse files
bmomjianbmomjian
committed
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). Andrew Dunstan
1 parent f4c5e06 commit 96b9dc1

File tree

3 files changed

+125
-24
lines changed

3 files changed

+125
-24
lines changed

‎src/pl/plperl/plperl.c‎

Lines changed: 110 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.45 2004/07/01 20:50:22 joe Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.46 2004/07/12 14:31:04 momjian Exp $
3737
*
3838
**********************************************************************/
3939

@@ -80,6 +80,7 @@ typedef struct plperl_proc_desc
8080
CommandId fn_cmin;
8181
bool lanpltrusted;
8282
bool fn_retistuple; /* true, if function returns tuple */
83+
bool fn_retisset; /*true, if function returns set*/
8384
Oid ret_oid; /* Oid of returning type */
8485
FmgrInfo result_in_func;
8586
Oid result_typioparam;
@@ -95,11 +96,13 @@ typedef struct plperl_proc_desc
9596
* Global data
9697
**********************************************************************/
9798
static int plperl_firstcall = 1;
99+
static bool plperl_safe_init_done = false;
98100
static PerlInterpreter *plperl_interp = NULL;
99101
static HV *plperl_proc_hash = NULL;
100-
AV *g_row_keys = NULL;
101-
AV *g_column_keys = NULL;
102-
int g_attr_num = 0;
102+
static AV *g_row_keys = NULL;
103+
static AV *g_column_keys = NULL;
104+
static SV *srf_perlret=NULL; /*keep returned value*/
105+
static int g_attr_num = 0;
103106

104107
/**********************************************************************
105108
* Forward declarations
@@ -215,11 +218,7 @@ plperl_init_interp(void)
215218
* no commas between the next lines please. They are supposed to be
216219
* one string
217220
*/
218-
"require Safe; SPI::bootstrap(); use vars qw(%_SHARED);"
219-
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
220-
"$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');"
221-
"$PLContainer->share(qw[&elog &spi_exec_query &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);"
222-
"sub ::mksafefunc { return $PLContainer->reval(qq[sub { $_[0] $_[1]}]); }"
221+
"SPI::bootstrap(); use vars qw(%_SHARED);"
223222
"sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
224223
};
225224

@@ -238,6 +237,41 @@ plperl_init_interp(void)
238237

239238
}
240239

240+
241+
static void
242+
plperl_safe_init(void)
243+
{
244+
static char *safe_module =
245+
"require Safe; $Safe::VERSION";
246+
247+
static char * safe_ok =
248+
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
249+
"$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');"
250+
"$PLContainer->share(qw[&elog &spi_exec_query &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);"
251+
"sub ::mksafefunc { return $PLContainer->reval(qq[sub { $_[0] $_[1]}]); }"
252+
;
253+
254+
static char * safe_bad =
255+
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
256+
"$PLContainer->permit_only(':default');$PLContainer->permit(':base_math');"
257+
"$PLContainer->share(qw[&elog &DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %SHARED ]);"
258+
"sub ::mksafefunc { return $PLContainer->reval(qq[sub { "
259+
"elog(ERROR,'trusted perl functions disabled - please upgrade perl Safe module to at least 2.09');}]); }"
260+
;
261+
262+
SV * res;
263+
264+
float safe_version;
265+
266+
res = eval_pv(safe_module,FALSE); /* TRUE = croak if failure */
267+
268+
safe_version = SvNV(res);
269+
270+
eval_pv((safe_version < 2.09 ? safe_bad : safe_ok),FALSE);
271+
272+
plperl_safe_init_done = true;
273+
}
274+
241275
/**********************************************************************
242276
* turn a tuple into a hash expression and add it to a list
243277
**********************************************************************/
@@ -596,6 +630,9 @@ plperl_create_sub(char *s, bool trusted)
596630
SV *subref;
597631
int count;
598632

633+
if(trusted && !plperl_safe_init_done)
634+
plperl_safe_init();
635+
599636
ENTER;
600637
SAVETMPS;
601638
PUSHMARK(SP);
@@ -839,15 +876,22 @@ plperl_func_handler(PG_FUNCTION_ARGS)
839876
/* Find or compile the function */
840877
prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);
841878
/************************************************************
842-
* Call the Perl function
879+
* Call the Perl function if not returning set
843880
************************************************************/
881+
if (!prodesc->fn_retisset)
844882
perlret = plperl_call_perl_func(prodesc, fcinfo);
845-
if (prodesc->fn_retistuple && SRF_IS_FIRSTCALL())
883+
else
846884
{
847-
885+
if (SRF_IS_FIRSTCALL()) /*call function only once*/
886+
srf_perlret = plperl_call_perl_func(prodesc, fcinfo);
887+
perlret = srf_perlret;
888+
}
889+
890+
if (prodesc->fn_retisset && SRF_IS_FIRSTCALL())
891+
{
892+
if (prodesc->fn_retistuple) g_column_keys = newAV();
848893
if (SvTYPE(perlret) != SVt_RV)
849-
elog(ERROR, "plperl: this function must return a reference");
850-
g_column_keys = newAV();
894+
elog(ERROR, "plperl: set-returning function must return reference");
851895
}
852896

853897
/************************************************************
@@ -882,14 +926,15 @@ plperl_func_handler(PG_FUNCTION_ARGS)
882926
char **values = NULL;
883927
ReturnSetInfo *rsinfo = (ReturnSetInfo *) fcinfo->resultinfo;
884928

885-
if (!rsinfo)
929+
if (prodesc->fn_retisset && !rsinfo)
886930
ereport(ERROR,
887931
(errcode(ERRCODE_SYNTAX_ERROR),
888932
errmsg("returning a composite type is not allowed in this context"),
889933
errhint("This function is intended for use in the FROM clause.")));
890934

891935
if (SvTYPE(perlret) != SVt_RV)
892-
elog(ERROR, "plperl: this function must return a reference");
936+
elog(ERROR, "plperl: composite-returning function must return a reference");
937+
893938

894939
isset = plperl_is_set(perlret);
895940

@@ -997,6 +1042,53 @@ plperl_func_handler(PG_FUNCTION_ARGS)
9971042
SRF_RETURN_DONE(funcctx);
9981043
}
9991044
}
1045+
else if (prodesc->fn_retisset)
1046+
{
1047+
FuncCallContext *funcctx;
1048+
1049+
if (SRF_IS_FIRSTCALL())
1050+
{
1051+
MemoryContext oldcontext;
1052+
int i;
1053+
1054+
funcctx = SRF_FIRSTCALL_INIT();
1055+
oldcontext = MemoryContextSwitchTo(funcctx->multi_call_memory_ctx);
1056+
1057+
if(SvTYPE(SvRV(perlret))!=SVt_PVAV) elog(ERROR, "plperl: set-returning function must return reference to array");
1058+
else funcctx->max_calls = av_len((AV*)SvRV(perlret))+1;
1059+
}
1060+
1061+
funcctx = SRF_PERCALL_SETUP();
1062+
1063+
if (funcctx->call_cntr < funcctx->max_calls)
1064+
{
1065+
Datum result;
1066+
AV* array;
1067+
SV** svp;
1068+
int i;
1069+
1070+
array = (AV*)SvRV(perlret);
1071+
svp = av_fetch(array, funcctx->call_cntr, FALSE);
1072+
1073+
if (SvTYPE(*svp) != SVt_NULL)
1074+
result = FunctionCall3(&prodesc->result_in_func,
1075+
PointerGetDatum(SvPV(*svp, PL_na)),
1076+
ObjectIdGetDatum(prodesc->result_typioparam),
1077+
Int32GetDatum(-1));
1078+
else
1079+
{
1080+
fcinfo->isnull = true;
1081+
result = (Datum) 0;
1082+
}
1083+
SRF_RETURN_NEXT(funcctx, result);
1084+
fcinfo->isnull = false;
1085+
}
1086+
else
1087+
{
1088+
if (perlret) SvREFCNT_dec(perlret);
1089+
SRF_RETURN_DONE(funcctx);
1090+
}
1091+
}
10001092
else if (! fcinfo->isnull)
10011093
{
10021094
retval = FunctionCall3(&prodesc->result_in_func,
@@ -1249,6 +1341,8 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
12491341
}
12501342
}
12511343

1344+
prodesc->fn_retisset = procStruct->proretset; /*true, if function returns set*/
1345+
12521346
if (typeStruct->typtype == 'c' || procStruct->prorettype == RECORDOID)
12531347
{
12541348
prodesc->fn_retistuple = true;

‎src/pl/plperl/spi_internal.c‎

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -82,42 +82,48 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
8282
* Get the attributes value
8383
************************************************************/
8484
attdata = SPI_getvalue(tuple, tupdesc, i+1);
85+
if(attdata)
8586
hv_store(array, attname, strlen(attname), newSVpv(attdata,0), 0);
87+
else
88+
hv_store(array, attname, strlen(attname), newSVpv("undef",0), 0);
8689
}
8790
return array;
8891
}
8992

9093
static HV*
91-
plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int rows, int status)
94+
plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int processed, int status)
9295
{
9396

9497
HV *result;
98+
AV *rows;
9599
int i;
96100

97101
result = newHV();
102+
rows = newAV();
98103

99104
if (status == SPI_OK_UTILITY)
100105
{
101106
hv_store(result, "status", strlen("status"), newSVpv("SPI_OK_UTILITY",0), 0);
102-
hv_store(result, "rows", strlen("rows"), newSViv(rows), 0);
107+
hv_store(result, "processed", strlen("processed"), newSViv(processed), 0);
103108
}
104109
else if (status != SPI_OK_SELECT)
105110
{
106111
hv_store(result, "status", strlen("status"), newSVpv((char*)plperl_spi_status_string(status),0), 0);
107-
hv_store(result, "rows", strlen("rows"), newSViv(rows), 0);
112+
hv_store(result, "processed", strlen("processed"), newSViv(processed), 0);
108113
}
109114
else
110115
{
111-
if (rows)
116+
hv_store(result, "status", strlen("status"), newSVpv((char*)plperl_spi_status_string(status),0), 0);
117+
hv_store(result, "processed", strlen("processed"), newSViv(processed), 0);
118+
if (processed)
112119
{
113-
char* key=palloc(sizeof(int));
114120
HV *row;
115-
for (i = 0; i < rows; i++)
121+
for (i = 0; i < processed; i++)
116122
{
117123
row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
118-
sprintf(key, "%i", i);
119-
hv_store(result, key, strlen(key), newRV_noinc((SV*)row), 0);
124+
av_store(rows, i, newRV_noinc((SV*)row));
120125
}
126+
hv_store(result, "rows", strlen("rows"), newRV_noinc((SV*)rows), 0);
121127
SPI_freetuptable(tuptable);
122128
}
123129
}

‎src/pl/plperl/spi_internal.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
#include "EXTERN.h"
22
#include "perl.h"
33
#include "XSUB.h"
4+
#include "ppport.h"
45

56
int spi_DEBUG(void);
67

0 commit comments

Comments
 (0)