From 0ed7864d6872e0fd4e4df44db2a978ecaa16d8af Mon Sep 17 00:00:00 2001 From: Bruce Momjian Date: Mon, 18 Jun 2001 21:40:06 +0000 Subject: [PATCH] Well, after persuading cvsup and cvs that it _is_ possible to have local modifiable repositories, I have a clean untrusted plperl patch to offer you :) Highlights: * There's one perl interpreter used for both trusted and untrusted procedures. I do think its unnecessary to keep two perl interpreters around. If someone can break out from trusted "Safe" perl mode, well, they can do what they want already. If someone disagrees, I can change this. * Opcode is not statically loaded anymore. Instead, we load Dynaloader, which then can grab Opcode (and anything else you can 'use') on its own. * Checked to work on FreeBSD 4.3 + perl 5.5.3 , OpenBSD 2.8 + perl5.6.1, RedHat 6.2 + perl 5.5.3 * Uses ExtUtils::Embed to find what options are necessary to link with perl shared libraries * createlang is also updated, it can create untrusted perl using 'plperlu' * Example script (assuming you have Mail::Sendmail installed): create function foo() returns text as ' use Mail::Sendmail; %mail = ( To => q(you@yourname.com), From => q(me@here.com), Message => "This is a very short message" ); sendmail(%mail) or die $Mail::Sendmail::error; return "OK. Log says:\n", $Mail::Sendmail::log; ' language 'plperlu'; Alex Pilosov --- src/bin/scripts/createlang.sh | 8 ++++- src/pl/plperl/Makefile.PL | 27 +------------- src/pl/plperl/plperl.c | 68 +++++++++++++++++++++++------------ 3 files changed, 54 insertions(+), 49 deletions(-) diff --git a/src/bin/scripts/createlang.sh b/src/bin/scripts/createlang.sh index 83bf8b31114..7c4b959367a 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 a01084bc38c..2d6ced9dc07 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 cfd3a6c8c1e..cb733d79707 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) { -- 2.39.5