mirror of https://github.com/postgres/postgres
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
This commit is contained in:
Bruce Momjian
parent
558fae16e3
commit
0ed7864d68
|
|
@ -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 "
|
||||
|
|
|
|||
|
|
@ -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',
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
Loading…
Reference in New Issue