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

Commita626045

Browse files
committed
Fix up plperl 'use_strict' so that it can be enabled or disabled on the
fly. Fix problem with incompletely duplicated setup code. Andrew Dunstan,from an idea of Michael Fuhr's.
1 parenta06d98b commita626045

File tree

3 files changed

+139
-83
lines changed

3 files changed

+139
-83
lines changed

‎src/pl/plperl/expected/plperl_elog.out‎

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,10 +19,38 @@ create or replace function perl_warn(text) returns void language plperl as $$
1919

2020
$$;
2121
select perl_warn('implicit elog via warn');
22-
NOTICE: implicit elog via warn at(eval 7)line 4.
22+
NOTICE: implicit elog via warn at line 4.
2323

2424
perl_warn
2525
-----------
2626

2727
(1 row)
2828

29+
-- test strict mode on/off
30+
SET plperl.use_strict = true;
31+
create or replace function uses_global() returns text language plperl as $$
32+
33+
$global = 1;
34+
$other_global = 2;
35+
return 'uses_global worked';
36+
37+
$$;
38+
ERROR: creation of Perl function failed: Global symbol "$global" requires explicit package name at line 3.
39+
Global symbol "$other_global" requires explicit package name at line 4.
40+
select uses_global();
41+
ERROR: function uses_global() does not exist
42+
HINT: No function matches the given name and argument types. You may need to add explicit type casts.
43+
SET plperl.use_strict = false;
44+
create or replace function uses_global() returns text language plperl as $$
45+
46+
$global = 1;
47+
$other_global=2;
48+
return 'uses_global worked';
49+
50+
$$;
51+
select uses_global();
52+
uses_global
53+
--------------------
54+
uses_global worked
55+
(1 row)
56+

‎src/pl/plperl/plperl.c‎

Lines changed: 88 additions & 82 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@
3333
* ENHANCEMENTS, OR MODIFICATIONS.
3434
*
3535
* IDENTIFICATION
36-
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.90 2005/08/20 19:19:21 tgl Exp $
36+
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.91 2005/08/24 18:16:56 tgl Exp $
3737
*
3838
**********************************************************************/
3939

@@ -185,57 +185,88 @@ plperl_init_all(void)
185185
/* We don't need to do anything yet when a new backend starts. */
186186
}
187187

188+
/* Each of these macros must represent a single string literal */
189+
190+
#definePERLBOOT \
191+
"SPI::bootstrap(); use vars qw(%_SHARED);" \
192+
"sub ::plperl_warn { my $msg = shift; " \
193+
" $msg =~ s/\\(eval \\d+\\) //g; &elog(&NOTICE, $msg); } " \
194+
"$SIG{__WARN__} = \\&::plperl_warn; " \
195+
"sub ::plperl_die { my $msg = shift; " \
196+
" $msg =~ s/\\(eval \\d+\\) //g; die $msg; } " \
197+
"$SIG{__DIE__} = \\&::plperl_die; " \
198+
"sub ::mkunsafefunc {" \
199+
" my $ret = eval(qq[ sub { $_[0] $_[1] } ]); " \
200+
" $@ =~ s/\\(eval \\d+\\) //g if $@; return $ret; }" \
201+
"use strict; " \
202+
"sub ::mk_strict_unsafefunc {" \
203+
" my $ret = eval(qq[ sub { use strict; $_[0] $_[1] } ]); " \
204+
" $@ =~ s/\\(eval \\d+\\) //g if $@; return $ret; } " \
205+
"sub ::_plperl_to_pg_array {" \
206+
" my $arg = shift; ref $arg eq 'ARRAY' || return $arg; " \
207+
" my $res = ''; my $first = 1; " \
208+
" foreach my $elem (@$arg) " \
209+
" { " \
210+
" $res .= ', ' unless $first; $first = undef; " \
211+
" if (ref $elem) " \
212+
" { " \
213+
" $res .= _plperl_to_pg_array($elem); " \
214+
" } " \
215+
" else " \
216+
" { " \
217+
" my $str = qq($elem); " \
218+
" $str =~ s/([\"\\\\])/\\\\$1/g; " \
219+
" $res .= qq(\"$str\"); " \
220+
" } " \
221+
" } " \
222+
" return qq({$res}); " \
223+
"} "
224+
225+
#defineSAFE_MODULE \
226+
"require Safe; $Safe::VERSION"
227+
228+
#defineSAFE_OK \
229+
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');" \
230+
"$PLContainer->permit_only(':default');" \
231+
"$PLContainer->permit(qw[:base_math !:base_io sort time]);" \
232+
"$PLContainer->share(qw[&elog &spi_exec_query &return_next " \
233+
"&spi_query &spi_fetchrow " \
234+
"&_plperl_to_pg_array " \
235+
"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);" \
236+
"sub ::mksafefunc {" \
237+
" my $ret = $PLContainer->reval(qq[sub { $_[0] $_[1] }]); " \
238+
" $@ =~ s/\\(eval \\d+\\) //g if $@; return $ret; }" \
239+
"$PLContainer->permit('require'); $PLContainer->reval('use strict;');" \
240+
"$PLContainer->deny('require');" \
241+
"sub ::mk_strict_safefunc {" \
242+
" my $ret = $PLContainer->reval(qq[sub { BEGIN { strict->import(); } $_[0] $_[1] }]); " \
243+
" $@ =~ s/\\(eval \\d+\\) //g if $@; return $ret; }"
244+
245+
#defineSAFE_BAD \
246+
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');" \
247+
"$PLContainer->permit_only(':default');" \
248+
"$PLContainer->share(qw[&elog &ERROR ]);" \
249+
"sub ::mksafefunc { return $PLContainer->reval(qq[sub { " \
250+
" elog(ERROR,'trusted Perl functions disabled - " \
251+
" please upgrade Perl Safe module to version 2.09 or later');}]); }" \
252+
"sub ::mk_strict_safefunc { return $PLContainer->reval(qq[sub { " \
253+
" elog(ERROR,'trusted Perl functions disabled - " \
254+
" please upgrade Perl Safe module to version 2.09 or later');}]); }"
255+
188256

189257
staticvoid
190258
plperl_init_interp(void)
191259
{
192-
staticchar*loose_embedding[3]= {
193-
"","-e",
194-
/* all one string follows (no commas please) */
195-
"SPI::bootstrap(); use vars qw(%_SHARED);"
196-
"sub ::plperl_warn { my $msg = shift; &elog(&NOTICE, $msg); } "
197-
"$SIG{__WARN__} = \\&::plperl_warn; "
198-
"sub ::mkunsafefunc {return eval(qq[ sub { $_[0] $_[1] } ]); }"
199-
"sub ::_plperl_to_pg_array"
200-
"{"
201-
" my $arg = shift; ref $arg eq 'ARRAY' || return $arg; "
202-
" my $res = ''; my $first = 1; "
203-
" foreach my $elem (@$arg) "
204-
" { "
205-
" $res .= ', ' unless $first; $first = undef; "
206-
" if (ref $elem) "
207-
" { "
208-
" $res .= _plperl_to_pg_array($elem); "
209-
" } "
210-
" else "
211-
" { "
212-
" my $str = qq($elem); "
213-
" $str =~ s/([\"\\\\])/\\\\$1/g; "
214-
" $res .= qq(\"$str\"); "
215-
" } "
216-
" } "
217-
" return qq({$res}); "
218-
"} "
219-
};
220-
221-
222-
staticchar*strict_embedding[3]= {
223-
"","-e",
224-
/* all one string follows (no commas please) */
225-
"SPI::bootstrap(); use vars qw(%_SHARED);"
226-
"sub ::plperl_warn { my $msg = shift; &elog(&NOTICE, $msg); } "
227-
"$SIG{__WARN__} = \\&::plperl_warn; "
228-
"sub ::mkunsafefunc {return eval("
229-
"qq[ sub { use strict; $_[0] $_[1] } ]); }"
260+
staticchar*embedding[3]= {
261+
"","-e",PERLBOOT
230262
};
231263

232264
plperl_interp=perl_alloc();
233265
if (!plperl_interp)
234266
elog(ERROR,"could not allocate Perl interpreter");
235267

236268
perl_construct(plperl_interp);
237-
perl_parse(plperl_interp,plperl_init_shared_libs,3 ,
238-
(plperl_use_strict ?strict_embedding :loose_embedding),NULL);
269+
perl_parse(plperl_interp,plperl_init_shared_libs,3,embedding,NULL);
239270
perl_run(plperl_interp);
240271

241272
plperl_proc_hash=newHV();
@@ -245,44 +276,10 @@ plperl_init_interp(void)
245276
staticvoid
246277
plperl_safe_init(void)
247278
{
248-
staticchar*safe_module=
249-
"require Safe; $Safe::VERSION";
250-
251-
staticchar*common_safe_ok=
252-
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
253-
"$PLContainer->permit_only(':default');"
254-
"$PLContainer->permit(qw[:base_math !:base_io sort time]);"
255-
"$PLContainer->share(qw[&elog &spi_exec_query &return_next "
256-
"&spi_query &spi_fetchrow "
257-
"&_plperl_to_pg_array "
258-
"&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED ]);"
259-
;
260-
261-
staticchar*strict_safe_ok=
262-
"$PLContainer->permit('require');$PLContainer->reval('use strict;');"
263-
"$PLContainer->deny('require');"
264-
"sub ::mksafefunc { return $PLContainer->reval(qq[ "
265-
" sub { BEGIN { strict->import(); } $_[0] $_[1]}]); }"
266-
;
267-
268-
staticchar*loose_safe_ok=
269-
"sub ::mksafefunc { return $PLContainer->reval(qq[ "
270-
" sub { $_[0] $_[1]}]); }"
271-
;
272-
273-
staticchar*safe_bad=
274-
"use vars qw($PLContainer); $PLContainer = new Safe('PLPerl');"
275-
"$PLContainer->permit_only(':default');"
276-
"$PLContainer->share(qw[&elog &ERROR ]);"
277-
"sub ::mksafefunc { return $PLContainer->reval(qq[sub { "
278-
"elog(ERROR,'trusted Perl functions disabled - "
279-
"please upgrade Perl Safe module to version 2.09 or later');}]); }"
280-
;
281-
282279
SV*res;
283280
doublesafe_version;
284281

285-
res=eval_pv(safe_module, FALSE);/* TRUE = croak if failure */
282+
res=eval_pv(SAFE_MODULE, FALSE);/* TRUE = croak if failure */
286283

287284
safe_version=SvNV(res);
288285

@@ -294,12 +291,11 @@ plperl_safe_init(void)
294291
if (safe_version<2.0899 )
295292
{
296293
/* not safe, so disallow all trusted funcs */
297-
eval_pv(safe_bad, FALSE);
294+
eval_pv(SAFE_BAD, FALSE);
298295
}
299296
else
300297
{
301-
eval_pv(common_safe_ok, FALSE);
302-
eval_pv((plperl_use_strict ?strict_safe_ok :loose_safe_ok), FALSE);
298+
eval_pv(SAFE_OK, FALSE);
303299
}
304300

305301
plperl_safe_init_done= true;
@@ -369,7 +365,7 @@ plperl_convert_to_pg_array(SV *src)
369365
XPUSHs(src);
370366
PUTBACK ;
371367

372-
count=call_pv("_plperl_to_pg_array",G_SCALAR);
368+
count=call_pv("::_plperl_to_pg_array",G_SCALAR);
373369

374370
SPAGAIN ;
375371

@@ -661,6 +657,7 @@ plperl_create_sub(char *s, bool trusted)
661657
dSP;
662658
SV*subref;
663659
intcount;
660+
char*compile_sub;
664661

665662
if (trusted&& !plperl_safe_init_done)
666663
{
@@ -680,8 +677,17 @@ plperl_create_sub(char *s, bool trusted)
680677
* errors properly. Perhaps it's because there's another level of
681678
* eval inside mksafefunc?
682679
*/
683-
count=perl_call_pv((trusted ?"::mksafefunc" :"::mkunsafefunc"),
684-
G_SCALAR |G_EVAL |G_KEEPERR);
680+
681+
if (trusted&&plperl_use_strict)
682+
compile_sub="::mk_strict_safefunc";
683+
elseif (plperl_use_strict)
684+
compile_sub="::mk_strict_unsafefunc";
685+
elseif (trusted)
686+
compile_sub="::mksafefunc";
687+
else
688+
compile_sub="::mkunsafefunc";
689+
690+
count=perl_call_pv(compile_sub,G_SCALAR |G_EVAL |G_KEEPERR);
685691
SPAGAIN;
686692

687693
if (count!=1)

‎src/pl/plperl/sql/plperl_elog.sql‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,28 @@ $$;
1818

1919
select perl_warn('implicit elog via warn');
2020

21+
-- test strict mode on/off
2122

23+
SETplperl.use_strict= true;
2224

25+
create or replacefunctionuses_global() returnstext language plperlas $$
2326

27+
$global=1;
28+
$other_global=2;
29+
return'uses_global worked';
30+
31+
$$;
32+
33+
select uses_global();
34+
35+
SETplperl.use_strict= false;
36+
37+
create or replacefunctionuses_global() returnstext language plperlas $$
38+
39+
$global=1;
40+
$other_global=2;
41+
return'uses_global worked';
42+
43+
$$;
44+
45+
select uses_global();

0 commit comments

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