mirrors/postgres
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add support for anonymous code blocks (DO blocks) to PL/Perl.

Browse Source 
Joshua Tolley, reviewed by Brendan Jurd and Tim Bunce
This commit is contained in:
Tom Lane 2009-11-29 03:02:27 +00:00
parent 8217cfbd99
commit 42b2907d12
6 changed files with 172 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
doc/src/sgml/plperl.sgml
View File

@ -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

4
src/include/catalog/catversion.h
View File

@ -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

6
src/include/catalog/pg_pltemplate.h
View File

@ -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 */

11
src/pl/plperl/expected/plperl.out
View File

@ -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

133
src/pl/plperl/plperl.c
View File

@ -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");
}

8
src/pl/plperl/sql/plperl.sql
View File

@ -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;