diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/pl/plperl/GNUmakefile | 4 | ||||
| -rw-r--r-- | src/pl/plperl/expected/plperl_shared.out | 12 | ||||
| -rw-r--r-- | src/pl/plperl/expected/plperlu.out | 7 | ||||
| -rw-r--r-- | src/pl/plperl/plc_safe_ok.pl | 3 | ||||
| -rw-r--r-- | src/pl/plperl/plperl.c | 145 | ||||
| -rw-r--r-- | src/pl/plperl/sql/plperl_shared.sql | 11 | ||||
| -rw-r--r-- | src/pl/plperl/sql/plperlu.sql | 7 |
7 files changed, 141 insertions, 48 deletions
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile index f794f028bec..e4fc226c336 100644 --- a/src/pl/plperl/GNUmakefile +++ b/src/pl/plperl/GNUmakefile @@ -1,5 +1,5 @@ # Makefile for PL/Perl -# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.42 2010/01/20 01:08:21 adunstan Exp $ +# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.43 2010/02/12 19:35:25 adunstan Exp $ subdir = src/pl/plperl top_builddir = ../../.. @@ -41,7 +41,7 @@ PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl SHLIB_LINK = $(perl_embed_ldflags) REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu -REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperlu +REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu # if Perl can support two interpreters in one backend, # test plperl-and-plperlu cases ifneq ($(PERL),) diff --git a/src/pl/plperl/expected/plperl_shared.out b/src/pl/plperl/expected/plperl_shared.out index 72ae1ba7be7..d054985cb84 100644 --- a/src/pl/plperl/expected/plperl_shared.out +++ b/src/pl/plperl/expected/plperl_shared.out @@ -1,3 +1,9 @@ +-- test plperl.on_plperl_init via the shared hash +-- (must be done before plperl is first used) +-- Avoid need for custom_variable_classes = 'plperl' +LOAD 'plperl'; +-- testing on_plperl_init gets run, and that it can alter %_SHARED +SET plperl.on_plperl_init = '$_SHARED{on_init} = 42'; -- test the shared hash create function setme(key text, val text) returns void language plperl as $$ @@ -24,3 +30,9 @@ select getme('ourkey'); ourval (1 row) +select getme('on_init'); + getme +------- + 42 +(1 row) + diff --git a/src/pl/plperl/expected/plperlu.out b/src/pl/plperl/expected/plperlu.out index c464e5625ce..a37262c1c27 100644 --- a/src/pl/plperl/expected/plperlu.out +++ b/src/pl/plperl/expected/plperlu.out @@ -1,5 +1,12 @@ -- Use ONLY plperlu tests here. For plperl/plerlu combined tests -- see plperl_plperlu.sql +-- Avoid need for custom_variable_classes = 'plperl' +LOAD 'plperl'; +-- Test plperl.on_plperlu_init gets run +SET plperl.on_plperlu_init = '$_SHARED{init} = 42'; +DO $$ warn $_SHARED{init} $$ language plperlu; +NOTICE: 42 at line 1. +CONTEXT: PL/Perl anonymous code block -- -- Test compilation of unicode regex - regardless of locale. -- This code fails in plain plperl in a non-UTF8 database. diff --git a/src/pl/plperl/plc_safe_ok.pl b/src/pl/plperl/plc_safe_ok.pl index c7dc437d82b..6e17f45e654 100644 --- a/src/pl/plperl/plc_safe_ok.pl +++ b/src/pl/plperl/plc_safe_ok.pl @@ -1,6 +1,6 @@ -# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.3 2010/01/26 23:11:56 adunstan Exp $ +# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.4 2010/02/12 19:35:25 adunstan Exp $ use strict; use vars qw($PLContainer); @@ -31,6 +31,7 @@ $PLContainer->permit(qw[caller]); }) or die $@; $PLContainer->deny(qw[caller]); +# called directly for plperl.on_plperl_init sub ::safe_eval { my $ret = $PLContainer->reval(shift); $@ =~ s/\(eval \d+\) //g if $@; diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index f3e8d1bd830..d066b504d45 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.164 2010/02/12 04:31:14 adunstan Exp $ + * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.165 2010/02/12 19:35:25 adunstan Exp $ * **********************************************************************/ @@ -139,7 +139,9 @@ static HTAB *plperl_proc_hash = NULL; static HTAB *plperl_query_hash = NULL; static bool plperl_use_strict = false; -static char *plperl_on_perl_init = NULL; +static char *plperl_on_init = NULL; +static char *plperl_on_plperl_init = NULL; +static char *plperl_on_plperlu_init = NULL; static bool plperl_ending = false; /* this is saved and restored by plperl_call_handler */ @@ -164,7 +166,8 @@ static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger); static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc); static void plperl_init_shared_libs(pTHX); -static void plperl_safe_init(void); +static void plperl_trusted_init(void); +static void plperl_untrusted_init(void); 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); @@ -242,14 +245,38 @@ _PG_init(void) PGC_USERSET, 0, NULL, NULL); - DefineCustomStringVariable("plperl.on_perl_init", - gettext_noop("Perl code to execute when the perl interpreter is initialized."), + DefineCustomStringVariable("plperl.on_init", + gettext_noop("Perl initialization code to execute when a perl interpreter is initialized."), NULL, - &plperl_on_perl_init, + &plperl_on_init, NULL, PGC_SIGHUP, 0, NULL, NULL); + /* + * plperl.on_plperl_init is currently PGC_SUSET to avoid issues whereby a user + * who doesn't have USAGE privileges on the plperl language could possibly use + * SET plperl.on_plperl_init='...' to influence the behaviour of any existing + * plperl function that they can EXECUTE (which may be security definer). + * Set http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php + * and the overall thread. + */ + DefineCustomStringVariable("plperl.on_plperl_init", + gettext_noop("Perl initialization code to execute once when plperl is first used."), + NULL, + &plperl_on_plperl_init, + NULL, + PGC_SUSET, 0, + NULL, NULL); + + DefineCustomStringVariable("plperl.on_plperlu_init", + gettext_noop("Perl initialization code to execute once when plperlu is first used."), + NULL, + &plperl_on_plperlu_init, + NULL, + PGC_SUSET, 0, + NULL, NULL); + EmitWarningsOnPlaceholders("plperl"); MemSet(&hash_ctl, 0, sizeof(hash_ctl)); @@ -285,7 +312,9 @@ plperl_fini(int code, Datum arg) elog(DEBUG3, "plperl_fini"); /* - * Disable use of spi_* functions when running END/DESTROY code. + * Indicate that perl is terminating. + * Disables use of spi_* functions when running END/DESTROY code. + * See check_spi_usage_allowed(). * Could be enabled in future, with care, using a transaction * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php */ @@ -340,11 +369,13 @@ select_perl_context(bool trusted) if (trusted) { + plperl_trusted_init(); plperl_trusted_interp = plperl_held_interp; interp_state = INTERP_TRUSTED; } else { + plperl_untrusted_init(); plperl_untrusted_interp = plperl_held_interp; interp_state = INTERP_UNTRUSTED; } @@ -353,10 +384,14 @@ select_perl_context(bool trusted) { #ifdef MULTIPLICITY PerlInterpreter *plperl = plperl_init_interp(); - if (trusted) + if (trusted) { + plperl_trusted_init(); plperl_trusted_interp = plperl; - else + } + else { + plperl_untrusted_init(); plperl_untrusted_interp = plperl; + } interp_state = INTERP_BOTH; #else elog(ERROR, @@ -367,17 +402,11 @@ select_perl_context(bool trusted) trusted_context = trusted; /* - * initialization - done after plperl_*_interp and trusted_context - * updates above to ensure a clean state (and thereby avoid recursion via - * plperl_safe_init caling plperl_call_perl_func for utf8fix) - */ - if (trusted) { - plperl_safe_init(); - PL_ppaddr[OP_REQUIRE] = pp_require_safe; - } - - /* - * enable access to the database + * Since the timing of first use of PL/Perl can't be predicted, + * any database interaction during initialization is problematic. + * Including, but not limited to, security definer issues. + * So we only enable access to the database AFTER on_*_init code has run. + * See http://archives.postgresql.org/message-id/20100127143318.GE713@timac.local */ newXS("PostgreSQL::InServer::SPI::bootstrap", boot_PostgreSQL__InServer__SPI, __FILE__); @@ -474,10 +503,10 @@ plperl_init_interp(void) save_time = loc ? pstrdup(loc) : NULL; #endif - if (plperl_on_perl_init) + if (plperl_on_init) { embedding[nargs++] = "-e"; - embedding[nargs++] = plperl_on_perl_init; + embedding[nargs++] = plperl_on_init; } /**** @@ -645,7 +674,7 @@ plperl_destroy_interp(PerlInterpreter **interp) static void -plperl_safe_init(void) +plperl_trusted_init(void) { SV *safe_version_sv; IV safe_version_x100; @@ -684,38 +713,64 @@ plperl_safe_init(void) if (GetDatabaseEncoding() == PG_UTF8) { /* - * Fill in just enough information to set up this perl function in - * the safe container and call it. For some reason not entirely - * clear, it prevents errors that can arise from the regex code - * later trying to load utf8 modules. + * Force loading of utf8 module now to prevent errors that can + * arise from the regex code later trying to load utf8 modules. * See http://rt.perl.org/rt3/Ticket/Display.html?id=47576 */ - plperl_proc_desc desc; - FunctionCallInfoData fcinfo; - SV *perlret; + eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE); + if (SvTRUE(ERRSV)) + { + ereport(ERROR, + (errcode(ERRCODE_INTERNAL_ERROR), + errmsg("while executing utf8fix"), + errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) )); + } + } - desc.proname = "utf8fix"; - desc.lanpltrusted = true; - desc.nargs = 1; - desc.arg_is_rowtype[0] = false; - fmgr_info(F_TEXTOUT, &(desc.arg_out_func[0])); + /* switch to the safe require opcode */ + PL_ppaddr[OP_REQUIRE] = pp_require_safe; - /* compile the function */ - plperl_create_sub(&desc, - "return shift =~ /\\xa9/i ? 'true' : 'false' ;", 0); + if (plperl_on_plperl_init && *plperl_on_plperl_init) + { + dSP; - /* set up to call the function with a single text argument 'a' */ - fcinfo.arg[0] = CStringGetTextDatum("a"); - fcinfo.argnull[0] = false; + PUSHMARK(SP); + XPUSHs(sv_2mortal(newSVstring(plperl_on_plperl_init))); + PUTBACK; - /* and make the call */ - perlret = plperl_call_perl_func(&desc, &fcinfo); + call_pv("::safe_eval", G_VOID); + SPAGAIN; - SvREFCNT_dec(perlret); + if (SvTRUE(ERRSV)) + { + ereport(ERROR, + (errcode(ERRCODE_INTERNAL_ERROR), + errmsg("while executing plperl.on_plperl_init"), + errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) )); + } + } + + } +} + + +static void +plperl_untrusted_init(void) +{ + if (plperl_on_plperlu_init && *plperl_on_plperlu_init) + { + eval_pv(plperl_on_plperlu_init, FALSE); + if (SvTRUE(ERRSV)) + { + ereport(ERROR, + (errcode(ERRCODE_INTERNAL_ERROR), + errmsg("while executing plperl.on_plperlu_init"), + errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) )); } } } + /* * Perl likes to put a newline after its error messages; clean up such */ @@ -1284,6 +1339,7 @@ plperl_init_shared_libs(pTHX) newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); newXS("PostgreSQL::InServer::Util::bootstrap", boot_PostgreSQL__InServer__Util, file); + /* newXS for...::SPI::bootstrap is in select_perl_context() */ } @@ -2023,6 +2079,7 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc) static void check_spi_usage_allowed() { + /* see comment in plperl_fini() */ if (plperl_ending) { /* simple croak as we don't want to involve PostgreSQL code */ croak("SPI functions can not be used in END blocks"); diff --git a/src/pl/plperl/sql/plperl_shared.sql b/src/pl/plperl/sql/plperl_shared.sql index 3e99e590496..a617b46a7af 100644 --- a/src/pl/plperl/sql/plperl_shared.sql +++ b/src/pl/plperl/sql/plperl_shared.sql @@ -1,3 +1,12 @@ +-- test plperl.on_plperl_init via the shared hash +-- (must be done before plperl is first used) + +-- Avoid need for custom_variable_classes = 'plperl' +LOAD 'plperl'; + +-- testing on_plperl_init gets run, and that it can alter %_SHARED +SET plperl.on_plperl_init = '$_SHARED{on_init} = 42'; + -- test the shared hash create function setme(key text, val text) returns void language plperl as $$ @@ -19,4 +28,4 @@ select setme('ourkey','ourval'); select getme('ourkey'); - +select getme('on_init'); diff --git a/src/pl/plperl/sql/plperlu.sql b/src/pl/plperl/sql/plperlu.sql index 978bb4bc15a..125691e5f7b 100644 --- a/src/pl/plperl/sql/plperlu.sql +++ b/src/pl/plperl/sql/plperlu.sql @@ -1,6 +1,13 @@ -- Use ONLY plperlu tests here. For plperl/plerlu combined tests -- see plperl_plperlu.sql +-- Avoid need for custom_variable_classes = 'plperl' +LOAD 'plperl'; + +-- Test plperl.on_plperlu_init gets run +SET plperl.on_plperlu_init = '$_SHARED{init} = 42'; +DO $$ warn $_SHARED{init} $$ language plperlu; + -- -- Test compilation of unicode regex - regardless of locale. -- This code fails in plain plperl in a non-UTF8 database. |