Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit0ed7864

Browse files
committed
Well, after persuading cvsup and cvs that it _is_ possible to have local
modifiable repositories, I have a clean untrusted plperl patch to offeryou :)Highlights:* There's one perl interpreter used for both trusted and untrustedprocedures. I do think its unnecessary to keep two perlinterpreters around. If someone can break out from trusted "Safe" perlmode, well, they can do what they want already. If someone disagrees, Ican 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 withperl 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
1 parent558fae1 commit0ed7864

File tree

3 files changed

+54
-49
lines changed

3 files changed

+54
-49
lines changed

‎src/bin/scripts/createlang.sh

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
# Portions Copyright (c) 1996-2001, PostgreSQL Global Development Group
88
# Portions Copyright (c) 1994, Regents of the University of California
99
#
10-
# $Header: /cvsroot/pgsql/src/bin/scripts/Attic/createlang.sh,v 1.27 2001/05/24 00:13:13 petere Exp $
10+
# $Header: /cvsroot/pgsql/src/bin/scripts/Attic/createlang.sh,v 1.28 2001/06/18 21:40:06 momjian Exp $
1111
#
1212
#-------------------------------------------------------------------------
1313

@@ -210,6 +210,12 @@ case "$langname" in
210210
handler="plperl_call_handler"
211211
object="plperl"
212212
;;
213+
plperlu)
214+
lancomp="PL/Perl (untrusted)"
215+
trusted=""
216+
handler="plperl_call_handler"
217+
object="plperl"
218+
;;
213219
plpython)
214220
lancomp="PL/Python"
215221
trusted="TRUSTED"

‎src/pl/plperl/Makefile.PL

Lines changed: 1 addition & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -29,33 +29,8 @@ EndOfMakefile
2929
exit(0);
3030
}
3131

32-
33-
#
34-
# get the location of the Opcode module
35-
#
36-
my$opcode ='';
37-
{
38-
39-
$modname ='Opcode';
40-
41-
my$dir;
42-
foreach (@INC) {
43-
if (-d"$_/auto/$modname") {
44-
$dir ="$_/auto/$modname";
45-
last;
46-
}
47-
}
48-
49-
if (defined$dir) {
50-
$opcode = DynaLoader::dl_findfile("-L$dir",$modname);
51-
}
52-
53-
}
54-
55-
my$perllib ="-L$Config{archlibexp}/CORE -lperl";
56-
5732
WriteMakefile('NAME'=>'plperl',
58-
dynamic_lib=> {'OTHERLDFLAGS'=>"$opcode$perllib" } ,
33+
dynamic_lib=> {'OTHERLDFLAGS'=> ldopts() } ,
5934
INC=>"$ENV{EXTRA_INCLUDES}",
6035
XS=> {'SPI.xs'=>'SPI.c' },
6136
OBJECT=>'plperl.o eloglvl.o SPI.o',

‎src/pl/plperl/plperl.c

Lines changed: 46 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.21 2001/06/09 02:19:07 tgl Exp $
36+
* $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.22 2001/06/18 21:40:06 momjian Exp $
3737
*
3838
**********************************************************************/
3939

@@ -95,6 +95,7 @@ typedef struct plperl_proc_desc
9595
Oidarg_out_elem[FUNC_MAX_ARGS];
9696
intarg_out_len[FUNC_MAX_ARGS];
9797
intarg_is_rel[FUNC_MAX_ARGS];
98+
boollanpltrusted;
9899
SV*reference;
99100
}plperl_proc_desc;
100101

@@ -121,7 +122,7 @@ typedef struct plperl_query_desc
121122
staticintplperl_firstcall=1;
122123
staticintplperl_call_level=0;
123124
staticintplperl_restart_in_progress=0;
124-
staticPerlInterpreter*plperl_safe_interp=NULL;
125+
staticPerlInterpreter*plperl_interp=NULL;
125126
staticHV*plperl_proc_hash=NULL;
126127

127128
#ifREALLYHAVEITONTHEBALL
@@ -133,7 +134,7 @@ static Tcl_HashTable *plperl_query_hash = NULL;
133134
* Forward declarations
134135
**********************************************************************/
135136
staticvoidplperl_init_all(void);
136-
staticvoidplperl_init_safe_interp(void);
137+
staticvoidplperl_init_interp(void);
137138

138139
Datumplperl_call_handler(PG_FUNCTION_ARGS);
139140

@@ -201,11 +202,11 @@ plperl_init_all(void)
201202
/************************************************************
202203
* Destroy the existing safe interpreter
203204
************************************************************/
204-
if (plperl_safe_interp!=NULL)
205+
if (plperl_interp!=NULL)
205206
{
206-
perl_destruct(plperl_safe_interp);
207-
perl_free(plperl_safe_interp);
208-
plperl_safe_interp=NULL;
207+
perl_destruct(plperl_interp);
208+
perl_free(plperl_interp);
209+
plperl_interp=NULL;
209210
}
210211

211212
/************************************************************
@@ -229,40 +230,41 @@ plperl_init_all(void)
229230
/************************************************************
230231
* Now recreate a new safe interpreter
231232
************************************************************/
232-
plperl_init_safe_interp();
233+
plperl_init_interp();
233234

234235
plperl_firstcall=0;
235236
return;
236237
}
237238

238239

239240
/**********************************************************************
240-
*plperl_init_safe_interp() - Create the safe Perl interpreter
241+
*plperl_init_interp() - Create the safe Perl interpreter
241242
**********************************************************************/
242243
staticvoid
243-
plperl_init_safe_interp(void)
244+
plperl_init_interp(void)
244245
{
245246

246247
char*embedding[3]= {
247248
"","-e",
248249

249250
/*
250-
* no commas between the next4 please. They are supposed to be
251+
* no commas between the next5 please. They are supposed to be
251252
* one string
252253
*/
253254
"require Safe; SPI::bootstrap();"
254255
"sub ::mksafefunc { my $x = new Safe; $x->permit_only(':default');$x->permit(':base_math');"
255256
"$x->share(qw[&elog &DEBUG &NOTICE &ERROR]);"
256257
" return $x->reval(qq[sub { $_[0] }]); }"
258+
"sub ::mkunsafefunc {return eval(qq[ sub { $_[0] } ]); }"
257259
};
258260

259-
plperl_safe_interp=perl_alloc();
260-
if (!plperl_safe_interp)
261-
elog(ERROR,"plperl_init_safe_interp(): could not allocate perl interpreter");
261+
plperl_interp=perl_alloc();
262+
if (!plperl_interp)
263+
elog(ERROR,"plperl_init_interp(): could not allocate perl interpreter");
262264

263-
perl_construct(plperl_safe_interp);
264-
perl_parse(plperl_safe_interp,plperl_init_shared_libs,3,embedding,NULL);
265-
perl_run(plperl_safe_interp);
265+
perl_construct(plperl_interp);
266+
perl_parse(plperl_interp,plperl_init_shared_libs,3,embedding,NULL);
267+
perl_run(plperl_interp);
266268

267269

268270

@@ -336,7 +338,7 @@ plperl_call_handler(PG_FUNCTION_ARGS)
336338
**********************************************************************/
337339
static
338340
SV*
339-
plperl_create_sub(char*s)
341+
plperl_create_sub(char*s,booltrusted)
340342
{
341343
dSP;
342344

@@ -348,7 +350,8 @@ plperl_create_sub(char *s)
348350
PUSHMARK(SP);
349351
XPUSHs(sv_2mortal(newSVpv(s,0)));
350352
PUTBACK;
351-
count=perl_call_pv("mksafefunc",G_SCALAR |G_EVAL |G_KEEPERR);
353+
count=perl_call_pv( (trusted?"mksafefunc":"mkunsafefunc"),
354+
G_SCALAR |G_EVAL |G_KEEPERR);
352355
SPAGAIN;
353356

354357
if (SvTRUE(ERRSV))
@@ -397,15 +400,15 @@ plperl_create_sub(char *s)
397400
*
398401
**********************************************************************/
399402

400-
externvoidboot_Opcode_((CV*cv));
403+
externvoidboot_DynaLoader_((CV*cv));
401404
externvoidboot_SPI_((CV*cv));
402405

403406
staticvoid
404407
plperl_init_shared_libs(void)
405408
{
406409
char*file=__FILE__;
407410

408-
newXS("Opcode::bootstrap",boot_Opcode,file);
411+
newXS("DynaLoader::boot_DynaLoader",boot_DynaLoader,file);
409412
newXS("SPI::bootstrap",boot_SPI,file);
410413
}
411414

@@ -529,8 +532,10 @@ plperl_func_handler(PG_FUNCTION_ARGS)
529532
* Then we load the procedure into the safe interpreter.
530533
************************************************************/
531534
HeapTupleprocTup;
535+
HeapTuplelangTup;
532536
HeapTupletypeTup;
533537
Form_pg_procprocStruct;
538+
Form_pg_languagelangStruct;
534539
Form_pg_typetypeStruct;
535540
char*proc_source;
536541

@@ -541,6 +546,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
541546
prodesc->proname=malloc(strlen(internal_proname)+1);
542547
strcpy(prodesc->proname,internal_proname);
543548

549+
544550
/************************************************************
545551
* Lookup the pg_proc tuple by Oid
546552
************************************************************/
@@ -556,6 +562,24 @@ plperl_func_handler(PG_FUNCTION_ARGS)
556562
}
557563
procStruct= (Form_pg_proc)GETSTRUCT(procTup);
558564

565+
/************************************************************
566+
* Lookup the pg_language tuple by Oid
567+
************************************************************/
568+
langTup=SearchSysCache(LANGOID,
569+
ObjectIdGetDatum(procStruct->prolang),
570+
0,0,0);
571+
if (!HeapTupleIsValid(langTup))
572+
{
573+
free(prodesc->proname);
574+
free(prodesc);
575+
elog(ERROR,"plperl: cache lookup for language %u failed",
576+
procStruct->prolang);
577+
}
578+
langStruct= (Form_pg_language)GETSTRUCT(langTup);
579+
580+
prodesc->lanpltrusted=langStruct->lanpltrusted;
581+
ReleaseSysCache(langTup);
582+
559583
/************************************************************
560584
* Get the required information for input conversion of the
561585
* return value.
@@ -634,7 +658,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
634658
/************************************************************
635659
* Create the procedure in the interpreter
636660
************************************************************/
637-
prodesc->reference=plperl_create_sub(proc_source);
661+
prodesc->reference=plperl_create_sub(proc_source,prodesc->lanpltrusted);
638662
pfree(proc_source);
639663
if (!prodesc->reference)
640664
{

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp