Add support for anonymous code blocks (DO blocks) to PL/Perl.
Joshua Tolley, reviewed by Brendan Jurd and Tim Bunce
This commit is contained in:
Tom Lane
parent
8217cfbd99
commit
42b2907d12
|
|
@ -1,4 +1,4 @@
|
|||
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.70 2009/08/15 00:33:12 petere Exp $ -->
|
||||
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.71 2009/11/29 03:02:27 tgl Exp $ -->
|
||||
|
||||
<chapter id="plperl">
|
||||
<title>PL/Perl - Perl Procedural Language</title>
|
||||
|
|
@ -59,11 +59,26 @@ CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types
|
|||
# PL/Perl function body
|
||||
$$ LANGUAGE plperl;
|
||||
</programlisting>
|
||||
|
||||
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.
|
||||
</para>
|
||||
|
||||
<para>
|
||||
PL/Perl also supports anonymous code blocks called with the
|
||||
<xref linkend="sql-do" endterm="sql-do-title"> statement:
|
||||
|
||||
<programlisting>
|
||||
DO $$
|
||||
# PL/Perl code
|
||||
$$ LANGUAGE plperl;
|
||||
</programlisting>
|
||||
|
||||
An anonymous code block receives no arguments, and whatever value it
|
||||
might return is discarded. Otherwise it behaves just like a function.
|
||||
</para>
|
||||
|
||||
<note>
|
||||
|
|
@ -669,6 +684,13 @@ $$ LANGUAGE plperl;
|
|||
<literal>plperlu</>, execution would succeed.
|
||||
</para>
|
||||
|
||||
<para>
|
||||
In the same way, anonymous code blocks written in Perl can use
|
||||
restricted operations if the language is specified as
|
||||
<literal>plperlu</> rather than <literal>plperl</>, but the caller
|
||||
must be a superuser.
|
||||
</para>
|
||||
|
||||
<note>
|
||||
<para>
|
||||
For security reasons, to stop a leak of privileged operations from
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 */
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue