Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit42b2907

Browse files
committed
Add support for anonymous code blocks (DO blocks) to PL/Perl.
Joshua Tolley, reviewed by Brendan Jurd and Tim Bunce
1 parent8217cfb commit42b2907

File tree

6 files changed

+172
-22
lines changed

6 files changed

+172
-22
lines changed

‎doc/src/sgml/plperl.sgml‎

Lines changed: 27 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.70 2009/08/15 00:33:12 petere Exp $ -->
1+
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.71 2009/11/29 03:02:27 tgl Exp $ -->
22

33
<chapter id="plperl">
44
<title>PL/Perl - Perl Procedural Language</title>
@@ -59,11 +59,26 @@ CREATE FUNCTION <replaceable>funcname</replaceable> (<replaceable>argument-types
5959
# PL/Perl function body
6060
$$ LANGUAGE plperl;
6161
</programlisting>
62+
6263
The body of the function is ordinary Perl code. In fact, the PL/Perl
63-
glue code wraps it inside a Perl subroutine. A PL/Perl function must
64-
always return a scalar value. You can return more complex structures
65-
(arrays, records, and sets) by returning a reference, as discussed below.
66-
Never return a list.
64+
glue code wraps it inside a Perl subroutine. A PL/Perl function is
65+
called in a scalar context, so it can't return a list. You can return
66+
non-scalar values (arrays, records, and sets) by returning a reference,
67+
as discussed below.
68+
</para>
69+
70+
<para>
71+
PL/Perl also supports anonymous code blocks called with the
72+
<xref linkend="sql-do" endterm="sql-do-title"> statement:
73+
74+
<programlisting>
75+
DO $$
76+
# PL/Perl code
77+
$$ LANGUAGE plperl;
78+
</programlisting>
79+
80+
An anonymous code block receives no arguments, and whatever value it
81+
might return is discarded. Otherwise it behaves just like a function.
6782
</para>
6883

6984
<note>
@@ -669,6 +684,13 @@ $$ LANGUAGE plperl;
669684
<literal>plperlu</>, execution would succeed.
670685
</para>
671686

687+
<para>
688+
In the same way, anonymous code blocks written in Perl can use
689+
restricted operations if the language is specified as
690+
<literal>plperlu</> rather than <literal>plperl</>, but the caller
691+
must be a superuser.
692+
</para>
693+
672694
<note>
673695
<para>
674696
For security reasons, to stop a leak of privileged operations from

‎src/include/catalog/catversion.h‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@
3737
* Portions Copyright (c) 1996-2009, PostgreSQL Global Development Group
3838
* Portions Copyright (c) 1994, Regents of the University of California
3939
*
40-
* $PostgreSQL: pgsql/src/include/catalog/catversion.h,v 1.552 2009/11/28 23:38:07 tgl Exp $
40+
* $PostgreSQL: pgsql/src/include/catalog/catversion.h,v 1.553 2009/11/29 03:02:27 tgl Exp $
4141
*
4242
*-------------------------------------------------------------------------
4343
*/
@@ -53,6 +53,6 @@
5353
*/
5454

5555
/*yyyymmddN */
56-
#defineCATALOG_VERSION_NO200911281
56+
#defineCATALOG_VERSION_NO200911282
5757

5858
#endif

‎src/include/catalog/pg_pltemplate.h‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
* Portions Copyright (c) 1996-2009, PostgreSQL Global Development Group
99
* Portions Copyright (c) 1994, Regents of the University of California
1010
*
11-
* $PostgreSQL: pgsql/src/include/catalog/pg_pltemplate.h,v 1.8 2009/09/22 23:43:41 tgl Exp $
11+
* $PostgreSQL: pgsql/src/include/catalog/pg_pltemplate.h,v 1.9 2009/11/29 03:02:27 tgl Exp $
1212
*
1313
* NOTES
1414
* the genbki.sh script reads this file and generates .bki
@@ -70,8 +70,8 @@ typedef FormData_pg_pltemplate *Form_pg_pltemplate;
7070
DATA(insert ("plpgsql"tt"plpgsql_call_handler""plpgsql_inline_handler""plpgsql_validator""$libdir/plpgsql"_null_ ));
7171
DATA(insert ("pltcl"tt"pltcl_call_handler"_null__null_"$libdir/pltcl"_null_ ));
7272
DATA(insert ("pltclu"ff"pltclu_call_handler"_null__null_"$libdir/pltcl"_null_ ));
73-
DATA(insert ("plperl"tt"plperl_call_handler"_null_"plperl_validator""$libdir/plperl"_null_ ));
74-
DATA(insert ("plperlu"ff"plperl_call_handler"_null_"plperl_validator""$libdir/plperl"_null_ ));
73+
DATA(insert ("plperl"tt"plperl_call_handler""plperl_inline_handler""plperl_validator""$libdir/plperl"_null_ ));
74+
DATA(insert ("plperlu"ff"plperl_call_handler""plperl_inline_handler""plperl_validator""$libdir/plperl"_null_ ));
7575
DATA(insert ("plpythonu"ff"plpython_call_handler"_null__null_"$libdir/plpython"_null_ ));
7676

7777
#endif/* PG_PLTEMPLATE_H */

‎src/pl/plperl/expected/plperl.out‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -555,3 +555,14 @@ $$ LANGUAGE plperl;
555555
SELECT perl_spi_prepared_bad(4.35) as "double precision";
556556
ERROR: type "does_not_exist" does not exist at line 2.
557557
CONTEXT: PL/Perl function "perl_spi_prepared_bad"
558+
-- simple test of a DO block
559+
DO $$
560+
$a = 'This is a test';
561+
elog(NOTICE, $a);
562+
$$ LANGUAGE plperl;
563+
NOTICE: This is a test
564+
CONTEXT: PL/Perl anonymous code block
565+
-- check that restricted operations are rejected in a plperl DO block
566+
DO $$ use Config; $$ LANGUAGE plperl;
567+
ERROR: 'require' trapped by operation mask at line 1.
568+
CONTEXT: PL/Perl anonymous code block

‎src/pl/plperl/plperl.c‎

Lines changed: 121 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/**********************************************************************
22
* plperl.c - perl as a procedural language for PostgreSQL
33
*
4-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.153 2009/10/31 18:11:59 tgl Exp $
4+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.154 2009/11/29 03:02:27 tgl Exp $
55
*
66
**********************************************************************/
77

@@ -144,6 +144,7 @@ static plperl_call_data *current_call_data = NULL;
144144
* Forward declarations
145145
**********************************************************************/
146146
Datumplperl_call_handler(PG_FUNCTION_ARGS);
147+
Datumplperl_inline_handler(PG_FUNCTION_ARGS);
147148
Datumplperl_validator(PG_FUNCTION_ARGS);
148149
void_PG_init(void);
149150

@@ -160,10 +161,11 @@ static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
160161
staticSV*newSVstring(constchar*str);
161162
staticSV**hv_store_string(HV*hv,constchar*key,SV*val);
162163
staticSV**hv_fetch_string(HV*hv,constchar*key);
163-
staticSV*plperl_create_sub(char*proname,char*s,booltrusted);
164+
staticSV*plperl_create_sub(constchar*proname,constchar*s,booltrusted);
164165
staticSV*plperl_call_perl_func(plperl_proc_desc*desc,FunctionCallInfofcinfo);
165166
staticvoidplperl_compile_callback(void*arg);
166167
staticvoidplperl_exec_callback(void*arg);
168+
staticvoidplperl_inline_callback(void*arg);
167169

168170
/*
169171
* 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)
862864

863865

864866
/*
865-
* This is the only externally-visible part of the plperl call interface.
866-
* The Postgres function and trigger managers call it to execute a
867-
* perl function.
867+
* There are three externally visible pieces to plperl: plperl_call_handler,
868+
* plperl_inline_handler, and plperl_validator.
869+
*/
870+
871+
/*
872+
* The call handler is called to run normal functions (including trigger
873+
* functions) that are defined in pg_proc.
868874
*/
869875
PG_FUNCTION_INFO_V1(plperl_call_handler);
870876

@@ -896,8 +902,102 @@ plperl_call_handler(PG_FUNCTION_ARGS)
896902
}
897903

898904
/*
899-
* This is the other externally visible function - it is called when CREATE
900-
* FUNCTION is issued to validate the function being created/replaced.
905+
* The inline handler runs anonymous code blocks (DO blocks).
906+
*/
907+
PG_FUNCTION_INFO_V1(plperl_inline_handler);
908+
909+
Datum
910+
plperl_inline_handler(PG_FUNCTION_ARGS)
911+
{
912+
InlineCodeBlock*codeblock= (InlineCodeBlock*)PG_GETARG_POINTER(0);
913+
FunctionCallInfoDatafake_fcinfo;
914+
FmgrInfoflinfo;
915+
plperl_proc_descdesc;
916+
plperl_call_data*save_call_data=current_call_data;
917+
boololdcontext=trusted_context;
918+
ErrorContextCallbackpl_error_context;
919+
920+
/* Set up a callback for error reporting */
921+
pl_error_context.callback=plperl_inline_callback;
922+
pl_error_context.previous=error_context_stack;
923+
pl_error_context.arg= (Datum)0;
924+
error_context_stack=&pl_error_context;
925+
926+
/*
927+
* Set up a fake fcinfo and descriptor with just enough info to satisfy
928+
* plperl_call_perl_func(). In particular note that this sets things up
929+
* with no arguments passed, and a result type of VOID.
930+
*/
931+
MemSet(&fake_fcinfo,0,sizeof(fake_fcinfo));
932+
MemSet(&flinfo,0,sizeof(flinfo));
933+
MemSet(&desc,0,sizeof(desc));
934+
fake_fcinfo.flinfo=&flinfo;
935+
flinfo.fn_oid=InvalidOid;
936+
flinfo.fn_mcxt=CurrentMemoryContext;
937+
938+
desc.proname="inline_code_block";
939+
desc.fn_readonly= false;
940+
941+
desc.lanpltrusted=codeblock->langIsTrusted;
942+
943+
desc.fn_retistuple= false;
944+
desc.fn_retisset= false;
945+
desc.fn_retisarray= false;
946+
desc.result_oid=VOIDOID;
947+
desc.nargs=0;
948+
desc.reference=NULL;
949+
950+
current_call_data= (plperl_call_data*)palloc0(sizeof(plperl_call_data));
951+
current_call_data->fcinfo=&fake_fcinfo;
952+
current_call_data->prodesc=&desc;
953+
954+
PG_TRY();
955+
{
956+
SV*perlret;
957+
958+
if (SPI_connect()!=SPI_OK_CONNECT)
959+
elog(ERROR,"could not connect to SPI manager");
960+
961+
check_interp(desc.lanpltrusted);
962+
963+
desc.reference=plperl_create_sub(desc.proname,
964+
codeblock->source_text,
965+
desc.lanpltrusted);
966+
967+
if (!desc.reference)/* can this happen? */
968+
elog(ERROR,"could not create internal procedure for anonymous code block");
969+
970+
perlret=plperl_call_perl_func(&desc,&fake_fcinfo);
971+
972+
SvREFCNT_dec(perlret);
973+
974+
if (SPI_finish()!=SPI_OK_FINISH)
975+
elog(ERROR,"SPI_finish() failed");
976+
}
977+
PG_CATCH();
978+
{
979+
current_call_data=save_call_data;
980+
restore_context(oldcontext);
981+
if (desc.reference)
982+
SvREFCNT_dec(desc.reference);
983+
PG_RE_THROW();
984+
}
985+
PG_END_TRY();
986+
987+
current_call_data=save_call_data;
988+
restore_context(oldcontext);
989+
if (desc.reference)
990+
SvREFCNT_dec(desc.reference);
991+
992+
error_context_stack=pl_error_context.previous;
993+
994+
PG_RETURN_VOID();
995+
}
996+
997+
/*
998+
* The validator is called during CREATE FUNCTION to validate the function
999+
* being created/replaced. The precise behavior of the validator may be
1000+
* modified by the check_function_bodies GUC.
9011001
*/
9021002
PG_FUNCTION_INFO_V1(plperl_validator);
9031003

@@ -971,7 +1071,7 @@ plperl_validator(PG_FUNCTION_ARGS)
9711071
* supplied in s, and returns a reference to the closure.
9721072
*/
9731073
staticSV*
974-
plperl_create_sub(char*proname,char*s,booltrusted)
1074+
plperl_create_sub(constchar*proname,constchar*s,booltrusted)
9751075
{
9761076
dSP;
9771077
SV*subref;
@@ -1375,7 +1475,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
13751475

13761476
/* Restore the previous error callback */
13771477
error_context_stack=pl_error_context.previous;
1378-
1478+
13791479
if (array_ret==NULL)
13801480
SvREFCNT_dec(perlret);
13811481

@@ -2716,9 +2816,9 @@ hv_fetch_string(HV *hv, const char *key)
27162816
}
27172817

27182818
/*
2719-
* Provide function name for PL/Perl execution errors
2819+
* Provide function name for PL/Perl execution errors
27202820
*/
2721-
staticvoid
2821+
staticvoid
27222822
plperl_exec_callback(void*arg)
27232823
{
27242824
char*procname= (char*)arg;
@@ -2727,7 +2827,7 @@ plperl_exec_callback(void *arg)
27272827
}
27282828

27292829
/*
2730-
* Provide function name for PL/Perl compilation errors
2830+
* Provide function name for PL/Perl compilation errors
27312831
*/
27322832
staticvoid
27332833
plperl_compile_callback(void*arg)
@@ -2736,3 +2836,12 @@ plperl_compile_callback(void *arg)
27362836
if (procname)
27372837
errcontext("compilation of PL/Perl function \"%s\"",procname);
27382838
}
2839+
2840+
/*
2841+
* Provide error context for the inline handler
2842+
*/
2843+
staticvoid
2844+
plperl_inline_callback(void*arg)
2845+
{
2846+
errcontext("PL/Perl anonymous code block");
2847+
}

‎src/pl/plperl/sql/plperl.sql‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -361,3 +361,11 @@ CREATE OR REPLACE FUNCTION perl_spi_prepared_bad(double precision) RETURNS doubl
361361
$$ LANGUAGE plperl;
362362
SELECT perl_spi_prepared_bad(4.35)as"double precision";
363363

364+
-- simple test of a DO block
365+
DO $$
366+
$a='This is a test';
367+
elog(NOTICE, $a);
368+
$$ LANGUAGE plperl;
369+
370+
-- check that restricted operations are rejected in a plperl DO block
371+
DO $$ use Config; $$ LANGUAGE plperl;

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp