From 42b2907d125f377f4ca2b46e652fa2b810c31337 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Sun, 29 Nov 2009 03:02:27 +0000 Subject: [PATCH] Add support for anonymous code blocks (DO blocks) to PL/Perl. Joshua Tolley, reviewed by Brendan Jurd and Tim Bunce --- doc/src/sgml/plperl.sgml | 32 +++++-- src/include/catalog/catversion.h | 4 +- src/include/catalog/pg_pltemplate.h | 6 +- src/pl/plperl/expected/plperl.out | 11 +++ src/pl/plperl/plperl.c | 133 +++++++++++++++++++++++++--- src/pl/plperl/sql/plperl.sql | 8 ++ 6 files changed, 172 insertions(+), 22 deletions(-) diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml index 3e7d3b2aa3..9211693d3d 100644 --- a/doc/src/sgml/plperl.sgml +++ b/doc/src/sgml/plperl.sgml @@ -1,4 +1,4 @@ - + PL/Perl - Perl Procedural Language @@ -59,11 +59,26 @@ CREATE FUNCTION funcname (argument-types # PL/Perl function body $$ LANGUAGE plperl; + The body of the function is ordinary Perl code. In fact, the PL/Perl - glue code wraps it inside a Perl subroutine. A PL/Perl function must - always return a scalar value. You can return more complex structures - (arrays, records, and sets) by returning a reference, as discussed below. - Never return a list. + glue code wraps it inside a Perl subroutine. A PL/Perl function is + called in a scalar context, so it can't return a list. You can return + non-scalar values (arrays, records, and sets) by returning a reference, + as discussed below. + + + + PL/Perl also supports anonymous code blocks called with the + statement: + + +DO $$ + # PL/Perl code +$$ LANGUAGE plperl; + + + An anonymous code block receives no arguments, and whatever value it + might return is discarded. Otherwise it behaves just like a function. @@ -669,6 +684,13 @@ $$ LANGUAGE plperl; plperlu, execution would succeed. + + In the same way, anonymous code blocks written in Perl can use + restricted operations if the language is specified as + plperlu rather than plperl, but the caller + must be a superuser. + + For security reasons, to stop a leak of privileged operations from diff --git a/src/include/catalog/catversion.h b/src/include/catalog/catversion.h index 61b7ccd822..d7225ae0c4 100644 --- a/src/include/catalog/catversion.h +++ b/src/include/catalog/catversion.h @@ -37,7 +37,7 @@ * Portions Copyright (c) 1996-2009, PostgreSQL Global Development Group * Portions Copyright (c) 1994, Regents of the University of California * - * $PostgreSQL: pgsql/src/include/catalog/catversion.h,v 1.552 2009/11/28 23:38:07 tgl Exp $ + * $PostgreSQL: pgsql/src/include/catalog/catversion.h,v 1.553 2009/11/29 03:02:27 tgl Exp $ * *------------------------------------------------------------------------- */ @@ -53,6 +53,6 @@ */ /* yyyymmddN */ -#define CATALOG_VERSION_NO 200911281 +#define CATALOG_VERSION_NO 200911282 #endif diff --git a/src/include/catalog/pg_pltemplate.h b/src/include/catalog/pg_pltemplate.h index 2065a5332b..06f3e98dde 100644 --- a/src/include/catalog/pg_pltemplate.h +++ b/src/include/catalog/pg_pltemplate.h @@ -8,7 +8,7 @@ * Portions Copyright (c) 1996-2009, PostgreSQL Global Development Group * Portions Copyright (c) 1994, Regents of the University of California * - * $PostgreSQL: pgsql/src/include/catalog/pg_pltemplate.h,v 1.8 2009/09/22 23:43:41 tgl Exp $ + * $PostgreSQL: pgsql/src/include/catalog/pg_pltemplate.h,v 1.9 2009/11/29 03:02:27 tgl Exp $ * * NOTES * the genbki.sh script reads this file and generates .bki @@ -70,8 +70,8 @@ typedef FormData_pg_pltemplate *Form_pg_pltemplate; DATA(insert ( "plpgsql" t t "plpgsql_call_handler" "plpgsql_inline_handler" "plpgsql_validator" "$libdir/plpgsql" _null_ )); DATA(insert ( "pltcl" t t "pltcl_call_handler" _null_ _null_ "$libdir/pltcl" _null_ )); DATA(insert ( "pltclu" f f "pltclu_call_handler" _null_ _null_ "$libdir/pltcl" _null_ )); -DATA(insert ( "plperl" t t "plperl_call_handler" _null_ "plperl_validator" "$libdir/plperl" _null_ )); -DATA(insert ( "plperlu" f f "plperl_call_handler" _null_ "plperl_validator" "$libdir/plperl" _null_ )); +DATA(insert ( "plperl" t t "plperl_call_handler" "plperl_inline_handler" "plperl_validator" "$libdir/plperl" _null_ )); +DATA(insert ( "plperlu" f f "plperl_call_handler" "plperl_inline_handler" "plperl_validator" "$libdir/plperl" _null_ )); DATA(insert ( "plpythonu" f f "plpython_call_handler" _null_ _null_ "$libdir/plpython" _null_ )); #endif /* PG_PLTEMPLATE_H */ diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out index c8a8fdb877..b94273911d 100644 --- a/src/pl/plperl/expected/plperl.out +++ b/src/pl/plperl/expected/plperl.out @@ -555,3 +555,14 @@ $$ LANGUAGE plperl; SELECT perl_spi_prepared_bad(4.35) as "double precision"; ERROR: type "does_not_exist" does not exist at line 2. CONTEXT: PL/Perl function "perl_spi_prepared_bad" +-- simple test of a DO block +DO $$ + $a = 'This is a test'; + elog(NOTICE, $a); +$$ LANGUAGE plperl; +NOTICE: This is a test +CONTEXT: PL/Perl anonymous code block +-- check that restricted operations are rejected in a plperl DO block +DO $$ use Config; $$ LANGUAGE plperl; +ERROR: 'require' trapped by operation mask at line 1. +CONTEXT: PL/Perl anonymous code block diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index 9ae4962b21..852b2b155b 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -1,7 +1,7 @@ /********************************************************************** * plperl.c - perl as a procedural language for PostgreSQL * - * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.153 2009/10/31 18:11:59 tgl Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.154 2009/11/29 03:02:27 tgl Exp $ * **********************************************************************/ @@ -144,6 +144,7 @@ static plperl_call_data *current_call_data = NULL; * Forward declarations **********************************************************************/ Datum plperl_call_handler(PG_FUNCTION_ARGS); +Datum plperl_inline_handler(PG_FUNCTION_ARGS); Datum plperl_validator(PG_FUNCTION_ARGS); void _PG_init(void); @@ -160,10 +161,11 @@ static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int); static SV *newSVstring(const char *str); static SV **hv_store_string(HV *hv, const char *key, SV *val); static SV **hv_fetch_string(HV *hv, const char *key); -static SV *plperl_create_sub(char *proname, char *s, bool trusted); +static SV *plperl_create_sub(const char *proname, const char *s, bool trusted); static SV *plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo); static void plperl_compile_callback(void *arg); static void plperl_exec_callback(void *arg); +static void plperl_inline_callback(void *arg); /* * This routine is a crock, and so is everyplace that calls it. The problem @@ -862,9 +864,13 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup) /* - * This is the only externally-visible part of the plperl call interface. - * The Postgres function and trigger managers call it to execute a - * perl function. + * There are three externally visible pieces to plperl: plperl_call_handler, + * plperl_inline_handler, and plperl_validator. + */ + +/* + * The call handler is called to run normal functions (including trigger + * functions) that are defined in pg_proc. */ PG_FUNCTION_INFO_V1(plperl_call_handler); @@ -896,8 +902,102 @@ plperl_call_handler(PG_FUNCTION_ARGS) } /* - * This is the other externally visible function - it is called when CREATE - * FUNCTION is issued to validate the function being created/replaced. + * The inline handler runs anonymous code blocks (DO blocks). + */ +PG_FUNCTION_INFO_V1(plperl_inline_handler); + +Datum +plperl_inline_handler(PG_FUNCTION_ARGS) +{ + InlineCodeBlock *codeblock = (InlineCodeBlock *) PG_GETARG_POINTER(0); + FunctionCallInfoData fake_fcinfo; + FmgrInfo flinfo; + plperl_proc_desc desc; + plperl_call_data *save_call_data = current_call_data; + bool oldcontext = trusted_context; + ErrorContextCallback pl_error_context; + + /* Set up a callback for error reporting */ + pl_error_context.callback = plperl_inline_callback; + pl_error_context.previous = error_context_stack; + pl_error_context.arg = (Datum) 0; + error_context_stack = &pl_error_context; + + /* + * Set up a fake fcinfo and descriptor with just enough info to satisfy + * plperl_call_perl_func(). In particular note that this sets things up + * with no arguments passed, and a result type of VOID. + */ + MemSet(&fake_fcinfo, 0, sizeof(fake_fcinfo)); + MemSet(&flinfo, 0, sizeof(flinfo)); + MemSet(&desc, 0, sizeof(desc)); + fake_fcinfo.flinfo = &flinfo; + flinfo.fn_oid = InvalidOid; + flinfo.fn_mcxt = CurrentMemoryContext; + + desc.proname = "inline_code_block"; + desc.fn_readonly = false; + + desc.lanpltrusted = codeblock->langIsTrusted; + + desc.fn_retistuple = false; + desc.fn_retisset = false; + desc.fn_retisarray = false; + desc.result_oid = VOIDOID; + desc.nargs = 0; + desc.reference = NULL; + + current_call_data = (plperl_call_data *) palloc0(sizeof(plperl_call_data)); + current_call_data->fcinfo = &fake_fcinfo; + current_call_data->prodesc = &desc; + + PG_TRY(); + { + SV *perlret; + + if (SPI_connect() != SPI_OK_CONNECT) + elog(ERROR, "could not connect to SPI manager"); + + check_interp(desc.lanpltrusted); + + desc.reference = plperl_create_sub(desc.proname, + codeblock->source_text, + desc.lanpltrusted); + + if (!desc.reference) /* can this happen? */ + elog(ERROR, "could not create internal procedure for anonymous code block"); + + perlret = plperl_call_perl_func(&desc, &fake_fcinfo); + + SvREFCNT_dec(perlret); + + if (SPI_finish() != SPI_OK_FINISH) + elog(ERROR, "SPI_finish() failed"); + } + PG_CATCH(); + { + current_call_data = save_call_data; + restore_context(oldcontext); + if (desc.reference) + SvREFCNT_dec(desc.reference); + PG_RE_THROW(); + } + PG_END_TRY(); + + current_call_data = save_call_data; + restore_context(oldcontext); + if (desc.reference) + SvREFCNT_dec(desc.reference); + + error_context_stack = pl_error_context.previous; + + PG_RETURN_VOID(); +} + +/* + * The validator is called during CREATE FUNCTION to validate the function + * being created/replaced. The precise behavior of the validator may be + * modified by the check_function_bodies GUC. */ PG_FUNCTION_INFO_V1(plperl_validator); @@ -971,7 +1071,7 @@ plperl_validator(PG_FUNCTION_ARGS) * supplied in s, and returns a reference to the closure. */ static SV * -plperl_create_sub(char *proname, char *s, bool trusted) +plperl_create_sub(const char *proname, const char *s, bool trusted) { dSP; SV *subref; @@ -1375,7 +1475,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) /* Restore the previous error callback */ error_context_stack = pl_error_context.previous; - + if (array_ret == NULL) SvREFCNT_dec(perlret); @@ -2716,9 +2816,9 @@ hv_fetch_string(HV *hv, const char *key) } /* - * Provide function name for PL/Perl execution errors + * Provide function name for PL/Perl execution errors */ -static void +static void plperl_exec_callback(void *arg) { char *procname = (char *) arg; @@ -2727,7 +2827,7 @@ plperl_exec_callback(void *arg) } /* - * Provide function name for PL/Perl compilation errors + * Provide function name for PL/Perl compilation errors */ static void plperl_compile_callback(void *arg) @@ -2736,3 +2836,12 @@ plperl_compile_callback(void *arg) if (procname) errcontext("compilation of PL/Perl function \"%s\"", procname); } + +/* + * Provide error context for the inline handler + */ +static void +plperl_inline_callback(void *arg) +{ + errcontext("PL/Perl anonymous code block"); +} diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql index df17834952..f12e2f7251 100644 --- a/src/pl/plperl/sql/plperl.sql +++ b/src/pl/plperl/sql/plperl.sql @@ -361,3 +361,11 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl $$ LANGUAGE plperl; SELECT perl_spi_prepared_bad(4.35) as "double precision"; +-- simple test of a DO block +DO $$ + $a = 'This is a test'; + elog(NOTICE, $a); +$$ LANGUAGE plperl; + +-- check that restricted operations are rejected in a plperl DO block +DO $$ use Config; $$ LANGUAGE plperl; -- 2.40.0