diff --git a/src/bin/scripts/createlang.sh b/src/bin/scripts/createlang.sh index 83bf8b311148806578e315391f14e9b810a8b62b..7c4b959367a322ddf1d6118bba861953c04c3eee 100644 --- a/src/bin/scripts/createlang.sh +++ b/src/bin/scripts/createlang.sh @@ -7,7 +7,7 @@ # Portions Copyright (c) 1996-2001, PostgreSQL Global Development Group # Portions Copyright (c) 1994, Regents of the University of California # -# $Header: /cvsroot/pgsql/src/bin/scripts/Attic/createlang.sh,v 1.27 2001/05/24 00:13:13 petere Exp $ +# $Header: /cvsroot/pgsql/src/bin/scripts/Attic/createlang.sh,v 1.28 2001/06/18 21:40:06 momjian Exp $ # #------------------------------------------------------------------------- @@ -210,6 +210,12 @@ case "$langname" in handler="plperl_call_handler" object="plperl" ;; + plperlu) + lancomp="PL/Perl (untrusted)" + trusted="" + handler="plperl_call_handler" + object="plperl" + ;; plpython) lancomp="PL/Python" trusted="TRUSTED " diff --git a/src/pl/plperl/Makefile.PL b/src/pl/plperl/Makefile.PL index a01084bc38c836ef10370801db19b8535f9a35a7..2d6ced9dc07becd40f78c891909bed3365f9d3b6 100644 --- a/src/pl/plperl/Makefile.PL +++ b/src/pl/plperl/Makefile.PL @@ -29,33 +29,8 @@ EndOfMakefile exit(0); } - -# -# get the location of the Opcode module -# -my $opcode = ''; -{ - - $modname = 'Opcode'; - - my $dir; - foreach (@INC) { - if (-d "$_/auto/$modname") { - $dir = "$_/auto/$modname"; - last; - } - } - - if (defined $dir) { - $opcode = DynaLoader::dl_findfile("-L$dir", $modname); - } - -} - -my $perllib = "-L$Config{archlibexp}/CORE -lperl"; - WriteMakefile( 'NAME' => 'plperl', - dynamic_lib => { 'OTHERLDFLAGS' => "$opcode $perllib" } , + dynamic_lib => { 'OTHERLDFLAGS' => ldopts() } , INC => "$ENV{EXTRA_INCLUDES}", XS => { 'SPI.xs' => 'SPI.c' }, OBJECT => 'plperl.o eloglvl.o SPI.o', diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index cfd3a6c8c1eec1eeb43e8fa7bc65923754a98163..cb733d7970763edcaea8992ee2f073bb82f6394d 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -33,7 +33,7 @@ * ENHANCEMENTS, OR MODIFICATIONS. * * IDENTIFICATION - * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.21 2001/06/09 02:19:07 tgl Exp $ + * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.22 2001/06/18 21:40:06 momjian Exp $ * **********************************************************************/ @@ -95,6 +95,7 @@ typedef struct plperl_proc_desc Oid arg_out_elem[FUNC_MAX_ARGS]; int arg_out_len[FUNC_MAX_ARGS]; int arg_is_rel[FUNC_MAX_ARGS]; + bool lanpltrusted; SV *reference; } plperl_proc_desc; @@ -121,7 +122,7 @@ typedef struct plperl_query_desc static int plperl_firstcall = 1; static int plperl_call_level = 0; static int plperl_restart_in_progress = 0; -static PerlInterpreter *plperl_safe_interp = NULL; +static PerlInterpreter *plperl_interp = NULL; static HV *plperl_proc_hash = NULL; #if REALLYHAVEITONTHEBALL @@ -133,7 +134,7 @@ static Tcl_HashTable *plperl_query_hash = NULL; * Forward declarations **********************************************************************/ static void plperl_init_all(void); -static void plperl_init_safe_interp(void); +static void plperl_init_interp(void); Datum plperl_call_handler(PG_FUNCTION_ARGS); @@ -201,11 +202,11 @@ plperl_init_all(void) /************************************************************ * Destroy the existing safe interpreter ************************************************************/ - if (plperl_safe_interp != NULL) + if (plperl_interp != NULL) { - perl_destruct(plperl_safe_interp); - perl_free(plperl_safe_interp); - plperl_safe_interp = NULL; + perl_destruct(plperl_interp); + perl_free(plperl_interp); + plperl_interp = NULL; } /************************************************************ @@ -229,7 +230,7 @@ plperl_init_all(void) /************************************************************ * Now recreate a new safe interpreter ************************************************************/ - plperl_init_safe_interp(); + plperl_init_interp(); plperl_firstcall = 0; return; @@ -237,32 +238,33 @@ plperl_init_all(void) /********************************************************************** - * plperl_init_safe_interp() - Create the safe Perl interpreter + * plperl_init_interp() - Create the safe Perl interpreter **********************************************************************/ static void -plperl_init_safe_interp(void) +plperl_init_interp(void) { char *embedding[3] = { "", "-e", /* - * no commas between the next 4 please. They are supposed to be + * no commas between the next 5 please. They are supposed to be * one string */ "require Safe; SPI::bootstrap();" "sub ::mksafefunc { my $x = new Safe; $x->permit_only(':default');$x->permit(':base_math');" "$x->share(qw[&elog &DEBUG &NOTICE &ERROR]);" " return $x->reval(qq[sub { $_[0] }]); }" + "sub ::mkunsafefunc {return eval(qq[ sub { $_[0] } ]); }" }; - plperl_safe_interp = perl_alloc(); - if (!plperl_safe_interp) - elog(ERROR, "plperl_init_safe_interp(): could not allocate perl interpreter"); + plperl_interp = perl_alloc(); + if (!plperl_interp) + elog(ERROR, "plperl_init_interp(): could not allocate perl interpreter"); - perl_construct(plperl_safe_interp); - perl_parse(plperl_safe_interp, plperl_init_shared_libs, 3, embedding, NULL); - perl_run(plperl_safe_interp); + perl_construct(plperl_interp); + perl_parse(plperl_interp, plperl_init_shared_libs, 3, embedding, NULL); + perl_run(plperl_interp); @@ -336,7 +338,7 @@ plperl_call_handler(PG_FUNCTION_ARGS) **********************************************************************/ static SV * -plperl_create_sub(char *s) +plperl_create_sub(char *s, bool trusted) { dSP; @@ -348,7 +350,8 @@ plperl_create_sub(char *s) PUSHMARK(SP); XPUSHs(sv_2mortal(newSVpv(s, 0))); PUTBACK; - count = perl_call_pv("mksafefunc", G_SCALAR | G_EVAL | G_KEEPERR); + count = perl_call_pv( (trusted?"mksafefunc":"mkunsafefunc"), + G_SCALAR | G_EVAL | G_KEEPERR); SPAGAIN; if (SvTRUE(ERRSV)) @@ -397,7 +400,7 @@ plperl_create_sub(char *s) * **********************************************************************/ -extern void boot_Opcode _((CV * cv)); +extern void boot_DynaLoader _((CV * cv)); extern void boot_SPI _((CV * cv)); static void @@ -405,7 +408,7 @@ plperl_init_shared_libs(void) { char *file = __FILE__; - newXS("Opcode::bootstrap", boot_Opcode, file); + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); newXS("SPI::bootstrap", boot_SPI, file); } @@ -529,8 +532,10 @@ plperl_func_handler(PG_FUNCTION_ARGS) * Then we load the procedure into the safe interpreter. ************************************************************/ HeapTuple procTup; + HeapTuple langTup; HeapTuple typeTup; Form_pg_proc procStruct; + Form_pg_language langStruct; Form_pg_type typeStruct; char *proc_source; @@ -541,6 +546,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) prodesc->proname = malloc(strlen(internal_proname) + 1); strcpy(prodesc->proname, internal_proname); + /************************************************************ * Lookup the pg_proc tuple by Oid ************************************************************/ @@ -556,6 +562,24 @@ plperl_func_handler(PG_FUNCTION_ARGS) } procStruct = (Form_pg_proc) GETSTRUCT(procTup); + /************************************************************ + * Lookup the pg_language tuple by Oid + ************************************************************/ + langTup = SearchSysCache(LANGOID, + ObjectIdGetDatum(procStruct->prolang), + 0, 0, 0); + if (!HeapTupleIsValid(langTup)) + { + free(prodesc->proname); + free(prodesc); + elog(ERROR, "plperl: cache lookup for language %u failed", + procStruct->prolang); + } + langStruct = (Form_pg_language) GETSTRUCT(langTup); + + prodesc->lanpltrusted = langStruct->lanpltrusted; + ReleaseSysCache(langTup); + /************************************************************ * Get the required information for input conversion of the * return value. @@ -634,7 +658,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) /************************************************************ * Create the procedure in the interpreter ************************************************************/ - prodesc->reference = plperl_create_sub(proc_source); + prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted); pfree(proc_source); if (!prodesc->reference) {