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

diff --git a/src/bin/scripts/createlang.sh b/src/bin/scripts/createlang.sh
index 83bf8b311148806578e315391f14e9b810a8b62b..7c4b959367a322ddf1d6118bba861953c04c3eee 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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)
                {