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

Commita2b34b1

Browse files
committed
Tidy up and refactor plperl.c.
- Changed MULTIPLICITY check from runtime to compiletime. No loads the large Config module.- Changed plperl_init_interp() to return new interp and not alter the global interp_state- Moved plperl_safe_init() call into check_interp().- Removed plperl_safe_init_done state variable as interp_state now covers that role.- Changed plperl_create_sub() to take a plperl_proc_desc argument.- Simplified return value handling in plperl_create_sub.- Changed perl.com link in the docs to perl.org and tweaked wording to clarify that require, not use, is what's blocked.- Moved perl code in large multi-line C string literal macros out to plc_*.pl files.- Added a test2macro.pl utility to convert the plc_*.pl files to macros in a perlchunks.h file which is #included- Simplifed plperl_safe_init() slightly- Optimized pg_verifymbstr calls to avoid unneeded strlen()s.Patch from Tim Bunce, with minor editing from me.
1 parent369494e commita2b34b1

File tree

8 files changed

+303
-201
lines changed

8 files changed

+303
-201
lines changed

‎doc/src/sgml/plperl.sgml

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.71 2009/11/29 03:02:27 tgl Exp $ -->
1+
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.72 2010/01/0902:40:50 adunstan Exp $ -->
22

33
<chapter id="plperl">
44
<title>PL/Perl - Perl Procedural Language</title>
@@ -14,7 +14,7 @@
1414
<para>
1515
PL/Perl is a loadable procedural language that enables you to write
1616
<productname>PostgreSQL</productname> functions in the
17-
<ulink url="http://www.perl.com">Perl programming language</ulink>.
17+
<ulink url="http://www.perl.org">Perl programming language</ulink>.
1818
</para>
1919

2020
<para>
@@ -313,7 +313,8 @@ SELECT * FROM perl_set();
313313
use strict;
314314
</programlisting>
315315
in the function body. But this only works in <application>PL/PerlU</>
316-
functions, since <literal>use</> is not a trusted operation. In
316+
functions, since the <literal>use</> triggers a <literal>require</>
317+
which is not a trusted operation. In
317318
<application>PL/Perl</> functions you can instead do:
318319
<programlisting>
319320
BEGIN { strict->import(); }

‎src/pl/plperl/GNUmakefile

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
# Makefile for PL/Perl
2-
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.37 2009/06/05 18:29:56 adunstan Exp $
2+
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.38 2010/01/09 02:40:50 adunstan Exp $
33

44
subdir = src/pl/plperl
55
top_builddir = ../../..
@@ -45,6 +45,11 @@ PSQLDIR = $(bindir)
4545

4646
include$(top_srcdir)/src/Makefile.shlib
4747

48+
plperl.o: perlchunks.h
49+
50+
perlchunks.h: plc_*.pl
51+
$(PERL) text2macro.pl --strip='^(\#.*|\s*)$$' plc_*.pl> perlchunks.htmp
52+
mv perlchunks.htmp perlchunks.h
4853

4954
all: all-lib
5055

@@ -65,7 +70,7 @@ submake:
6570
$(MAKE) -C$(top_builddir)/src/test/regress pg_regress$(X)
6671

6772
cleandistcleanmaintainer-clean: clean-lib
68-
rm -f SPI.c$(OBJS)
73+
rm -f SPI.c$(OBJS) perlchunks.htmp perlchunks.h
6974
rm -rf results
7075
rm -f regression.diffs regression.out
7176

‎src/pl/plperl/plc_perlboot.pl

Lines changed: 50 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,50 @@
1+
SPI::bootstrap();
2+
use varsqw(%_SHARED);
3+
4+
sub ::plperl_warn {
5+
(my$msg =shift) =~s/\(eval\d+\)//g;
6+
&elog(&NOTICE,$msg);
7+
}
8+
$SIG{__WARN__} = \&::plperl_warn;
9+
10+
sub ::plperl_die {
11+
(my$msg =shift) =~s/\(eval\d+\)//g;
12+
die$msg;
13+
}
14+
$SIG{__DIE__} = \&::plperl_die;
15+
16+
sub ::mkunsafefunc {
17+
my$ret =eval(qq[ sub {$_[0]$_[1] }]);
18+
$@ =~s/\(eval\d+\)//gif$@;
19+
return$ret;
20+
}
21+
22+
use strict;
23+
24+
sub ::mk_strict_unsafefunc {
25+
my$ret =eval(qq[ sub { use strict;$_[0]$_[1] }]);
26+
$@ =~s/\(eval\d+\)//gif$@;
27+
return$ret;
28+
}
29+
30+
sub ::_plperl_to_pg_array {
31+
my$arg =shift;
32+
ref$argeq'ARRAY' ||return$arg;
33+
my$res ='';
34+
my$first = 1;
35+
foreachmy$elem (@$arg) {
36+
$res .=','unless$first;$first =undef;
37+
if (ref$elem) {
38+
$res .= _plperl_to_pg_array($elem);
39+
}
40+
elsif (defined($elem)) {
41+
my$str =qq($elem);
42+
$str =~s/([\"\\])/\\$1/g;
43+
$res .=qq(\"$str\");
44+
}
45+
else {
46+
$res .='NULL' ;
47+
}
48+
}
49+
returnqq({$res});
50+
}

‎src/pl/plperl/plc_safe_bad.pl

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
use varsqw($PLContainer);
2+
3+
$PLContainer = new Safe('PLPerl');
4+
$PLContainer->permit_only(':default');
5+
$PLContainer->share(qw[&elog &ERROR]);
6+
7+
my$msg ='trusted Perl functions disabled - please upgrade Perl Safe module to version 2.09 or later';
8+
sub ::mksafefunc {
9+
return$PLContainer->reval(qq[sub { elog(ERROR,'$msg') }]);
10+
}
11+
12+
sub ::mk_strict_safefunc {
13+
return$PLContainer->reval(qq[sub { elog(ERROR,'$msg') }]);
14+
}
15+

‎src/pl/plperl/plc_safe_ok.pl

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
use varsqw($PLContainer);
2+
3+
$PLContainer = new Safe('PLPerl');
4+
$PLContainer->permit_only(':default');
5+
$PLContainer->permit(qw[:base_math !:base_io sort time]);
6+
7+
$PLContainer->share(qw[&elog &return_next
8+
&spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query
9+
&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan
10+
&_plperl_to_pg_array
11+
&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED
12+
]);
13+
14+
# Load strict into the container.
15+
# The temporary enabling of the caller opcode here is to work around a
16+
# bug in perl 5.10, which unkindly changed the way its Safe.pm works, without
17+
# notice. It is quite safe, as caller is informational only, and in any case
18+
# we only enable it while we load the 'strict' module.
19+
$PLContainer->permit(qw[require caller]);
20+
$PLContainer->reval('use strict;');
21+
$PLContainer->deny(qw[require caller]);
22+
23+
sub ::mksafefunc {
24+
my$ret =$PLContainer->reval(qq[sub {$_[0]$_[1] }]);
25+
$@ =~s/\(eval\d+\)//gif$@;
26+
return$ret;
27+
}
28+
29+
sub ::mk_strict_safefunc {
30+
my$ret =$PLContainer->reval(qq[sub { BEGIN { strict->import(); }$_[0]$_[1] }]);
31+
$@ =~s/\(eval\d+\)//gif$@;
32+
return$ret;
33+
}

0 commit comments

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