mirror of
https://git.postgresql.org/git/postgresql.git
synced 2024-12-21 08:29:39 +08:00
Add plperl.on_plperl_init and plperl.on_plperlu_init settings for language-specific startup. Rename recently added plperl.on_perl_init to plperl.on_init. Also, code cleanup for utf8 hack. Patch from Tim Bunce, reviewed by Alex Hunsaker.
This commit is contained in:
Andrew Dunstan
parent
ec4be2ee68
commit
1b04b8f1bc
@ -1,4 +1,4 @@
|
||||
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.79 2010/02/05 18:11:46 momjian Exp $ -->
|
||||
<!-- $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.80 2010/02/12 19:35:25 adunstan Exp $ -->
|
||||
|
||||
<chapter id="plperl">
|
||||
<title>PL/Perl - Perl Procedural Language</title>
|
||||
@ -831,6 +831,13 @@ $$ LANGUAGE plperl;
|
||||
<literal>return $_SHARED{myquote}->($_[0]);</literal>
|
||||
at the expense of readability.)
|
||||
</para>
|
||||
|
||||
<para>
|
||||
The <varname>%_SHARED</varname> variable and other global state within
|
||||
the language is public data, available to all PL/Perl functions within a
|
||||
session. Use with care, especially in situations that involve use of
|
||||
multiple roles or <literal>SECURITY DEFINER</> functions.
|
||||
</para>
|
||||
</sect1>
|
||||
|
||||
<sect1 id="plperl-trusted">
|
||||
@ -1127,26 +1134,27 @@ CREATE TRIGGER test_valid_id_trig
|
||||
|
||||
<variablelist>
|
||||
|
||||
<varlistentry id="guc-plperl-on-perl-init" xreflabel="plperl.on_perl_init">
|
||||
<term><varname>plperl.on_perl_init</varname> (<type>string</type>)</term>
|
||||
<varlistentry id="guc-plperl-on-init" xreflabel="plperl.on_init">
|
||||
<term><varname>plperl.on_init</varname> (<type>string</type>)</term>
|
||||
<indexterm>
|
||||
<primary><varname>plperl.on_perl_init</> configuration parameter</primary>
|
||||
<primary><varname>plperl.on_init</> configuration parameter</primary>
|
||||
</indexterm>
|
||||
<listitem>
|
||||
<para>
|
||||
Specifies perl code to be executed when a perl interpreter is first initialized.
|
||||
Specifies Perl code to be executed when a Perl interpreter is first initialized
|
||||
and before it is specialized for use by <literal>plperl</> or <literal>plperlu</>.
|
||||
The SPI functions are not available when this code is executed.
|
||||
If the code fails with an error it will abort the initialization of the interpreter
|
||||
and propagate out to the calling query, causing the current transaction
|
||||
or subtransaction to be aborted.
|
||||
</para>
|
||||
<para>
|
||||
The perl code is limited to a single string. Longer code can be placed
|
||||
into a module and loaded by the <literal>on_perl_init</> string.
|
||||
The Perl code is limited to a single string. Longer code can be placed
|
||||
into a module and loaded by the <literal>on_init</> string.
|
||||
Examples:
|
||||
<programlisting>
|
||||
plplerl.on_perl_init = '$ENV{NYTPROF}="start=no"; require Devel::NYTProf::PgPLPerl'
|
||||
plplerl.on_perl_init = 'use lib "/my/app"; use MyApp::PgInit;'
|
||||
plplerl.on_init = '$ENV{NYTPROF}="start=no"; require Devel::NYTProf::PgPLPerl'
|
||||
plplerl.on_init = 'use lib "/my/app"; use MyApp::PgInit;'
|
||||
</programlisting>
|
||||
</para>
|
||||
<para>
|
||||
@ -1160,6 +1168,56 @@ plplerl.on_perl_init = 'use lib "/my/app"; use MyApp::PgInit;'
|
||||
</listitem>
|
||||
</varlistentry>
|
||||
|
||||
<varlistentry id="guc-plperl-on-plperl-init" xreflabel="plperl.on_plperl_init">
|
||||
<term><varname>plperl.on_plperl_init</varname> (<type>string</type>)</term>
|
||||
<term><varname>plperl.on_plperlu_init</varname> (<type>string</type>)</term>
|
||||
<indexterm>
|
||||
<primary><varname>plperl.on_plperl_init</> configuration parameter</primary>
|
||||
</indexterm>
|
||||
<indexterm>
|
||||
<primary><varname>plperl.on_plperlu_init</> configuration parameter</primary>
|
||||
</indexterm>
|
||||
<listitem>
|
||||
<para>
|
||||
These parameters specify Perl code to be executed when the
|
||||
<literal>plperl</>, or <literal>plperlu</> language is first used in a
|
||||
session. Changes to these parameters after the corresponding language
|
||||
has been used will have no effect.
|
||||
The SPI functions are not available when this code is executed.
|
||||
Only superusers can change these settings.
|
||||
The Perl code in <literal>plperl.on_plperl_init</> can only perform trusted operations.
|
||||
</para>
|
||||
<para>
|
||||
The effect of setting these parameters is very similar to executing a
|
||||
<literal>DO</> command with the Perl code before any other use of the
|
||||
language. The parameters are useful when you want to execute the Perl
|
||||
code automatically on every connection, or when a connection is not
|
||||
interactive. The parameters can be used by non-superusers by having a
|
||||
superuser execute an <literal>ALTER USER ... SET ...</> command.
|
||||
For example:
|
||||
<programlisting>
|
||||
ALTER USER joe SET plplerl.on_plperl_init = '$_SHARED{debug} = 1';
|
||||
</programlisting>
|
||||
</para>
|
||||
<para>
|
||||
If the code fails with an error it will abort the initialization and
|
||||
propagate out to the calling query, causing the current transaction or
|
||||
subtransaction to be aborted. Any changes within Perl won't be undone.
|
||||
If the language is used again the initialization will be repeated.
|
||||
</para>
|
||||
<para>
|
||||
The difference between these two settings and the
|
||||
<literal>plperl.on_init</> setting is that these can be used for
|
||||
settings specific to the trusted or untrusted language variant, such
|
||||
as setting values in the <varname>%_SHARED</> variable. By contrast,
|
||||
<literal>plperl.on_init</> is more useful for doing things like
|
||||
setting the library search path for <productname>Perl</> or
|
||||
loading Perl modules that don't interact directly with
|
||||
<productname>PostgreSQL</>.
|
||||
</para>
|
||||
</listitem>
|
||||
</varlistentry>
|
||||
|
||||
<varlistentry id="guc-plperl-use-strict" xreflabel="plperl.use_strict">
|
||||
<term><varname>plperl.use_strict</varname> (<type>boolean</type>)</term>
|
||||
<indexterm>
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# Makefile for PL/Perl
|
||||
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.42 2010/01/20 01:08:21 adunstan Exp $
|
||||
# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.43 2010/02/12 19:35:25 adunstan Exp $
|
||||
|
||||
subdir = src/pl/plperl
|
||||
top_builddir = ../../..
|
||||
@ -41,7 +41,7 @@ PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl
|
||||
SHLIB_LINK = $(perl_embed_ldflags)
|
||||
|
||||
REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl --load-language=plperlu
|
||||
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperlu
|
||||
REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperl_init plperlu
|
||||
# if Perl can support two interpreters in one backend,
|
||||
# test plperl-and-plperlu cases
|
||||
ifneq ($(PERL),)
|
||||
|
||||
@ -1,3 +1,9 @@
|
||||
-- test plperl.on_plperl_init via the shared hash
|
||||
-- (must be done before plperl is first used)
|
||||
-- Avoid need for custom_variable_classes = 'plperl'
|
||||
LOAD 'plperl';
|
||||
-- testing on_plperl_init gets run, and that it can alter %_SHARED
|
||||
SET plperl.on_plperl_init = '$_SHARED{on_init} = 42';
|
||||
-- test the shared hash
|
||||
create function setme(key text, val text) returns void language plperl as $$
|
||||
|
||||
@ -24,3 +30,9 @@ select getme('ourkey');
|
||||
ourval
|
||||
(1 row)
|
||||
|
||||
select getme('on_init');
|
||||
getme
|
||||
-------
|
||||
42
|
||||
(1 row)
|
||||
|
||||
|
||||
@ -1,5 +1,12 @@
|
||||
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
|
||||
-- see plperl_plperlu.sql
|
||||
-- Avoid need for custom_variable_classes = 'plperl'
|
||||
LOAD 'plperl';
|
||||
-- Test plperl.on_plperlu_init gets run
|
||||
SET plperl.on_plperlu_init = '$_SHARED{init} = 42';
|
||||
DO $$ warn $_SHARED{init} $$ language plperlu;
|
||||
NOTICE: 42 at line 1.
|
||||
CONTEXT: PL/Perl anonymous code block
|
||||
--
|
||||
-- Test compilation of unicode regex - regardless of locale.
|
||||
-- This code fails in plain plperl in a non-UTF8 database.
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
|
||||
|
||||
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.3 2010/01/26 23:11:56 adunstan Exp $
|
||||
# $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.4 2010/02/12 19:35:25 adunstan Exp $
|
||||
|
||||
use strict;
|
||||
use vars qw($PLContainer);
|
||||
@ -31,6 +31,7 @@ $PLContainer->permit(qw[caller]);
|
||||
}) or die $@;
|
||||
$PLContainer->deny(qw[caller]);
|
||||
|
||||
# called directly for plperl.on_plperl_init
|
||||
sub ::safe_eval {
|
||||
my $ret = $PLContainer->reval(shift);
|
||||
$@ =~ s/\(eval \d+\) //g if $@;
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
/**********************************************************************
|
||||
* plperl.c - perl as a procedural language for PostgreSQL
|
||||
*
|
||||
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.164 2010/02/12 04:31:14 adunstan Exp $
|
||||
* $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.165 2010/02/12 19:35:25 adunstan Exp $
|
||||
*
|
||||
**********************************************************************/
|
||||
|
||||
@ -139,7 +139,9 @@ static HTAB *plperl_proc_hash = NULL;
|
||||
static HTAB *plperl_query_hash = NULL;
|
||||
|
||||
static bool plperl_use_strict = false;
|
||||
static char *plperl_on_perl_init = NULL;
|
||||
static char *plperl_on_init = NULL;
|
||||
static char *plperl_on_plperl_init = NULL;
|
||||
static char *plperl_on_plperlu_init = NULL;
|
||||
static bool plperl_ending = false;
|
||||
|
||||
/* this is saved and restored by plperl_call_handler */
|
||||
@ -164,7 +166,8 @@ static plperl_proc_desc *compile_plperl_function(Oid fn_oid, bool is_trigger);
|
||||
|
||||
static SV *plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc);
|
||||
static void plperl_init_shared_libs(pTHX);
|
||||
static void plperl_safe_init(void);
|
||||
static void plperl_trusted_init(void);
|
||||
static void plperl_untrusted_init(void);
|
||||
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
|
||||
static SV *newSVstring(const char *str);
|
||||
static SV **hv_store_string(HV *hv, const char *key, SV *val);
|
||||
@ -242,14 +245,38 @@ _PG_init(void)
|
||||
PGC_USERSET, 0,
|
||||
NULL, NULL);
|
||||
|
||||
DefineCustomStringVariable("plperl.on_perl_init",
|
||||
gettext_noop("Perl code to execute when the perl interpreter is initialized."),
|
||||
DefineCustomStringVariable("plperl.on_init",
|
||||
gettext_noop("Perl initialization code to execute when a perl interpreter is initialized."),
|
||||
NULL,
|
||||
&plperl_on_perl_init,
|
||||
&plperl_on_init,
|
||||
NULL,
|
||||
PGC_SIGHUP, 0,
|
||||
NULL, NULL);
|
||||
|
||||
/*
|
||||
* plperl.on_plperl_init is currently PGC_SUSET to avoid issues whereby a user
|
||||
* who doesn't have USAGE privileges on the plperl language could possibly use
|
||||
* SET plperl.on_plperl_init='...' to influence the behaviour of any existing
|
||||
* plperl function that they can EXECUTE (which may be security definer).
|
||||
* Set http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php
|
||||
* and the overall thread.
|
||||
*/
|
||||
DefineCustomStringVariable("plperl.on_plperl_init",
|
||||
gettext_noop("Perl initialization code to execute once when plperl is first used."),
|
||||
NULL,
|
||||
&plperl_on_plperl_init,
|
||||
NULL,
|
||||
PGC_SUSET, 0,
|
||||
NULL, NULL);
|
||||
|
||||
DefineCustomStringVariable("plperl.on_plperlu_init",
|
||||
gettext_noop("Perl initialization code to execute once when plperlu is first used."),
|
||||
NULL,
|
||||
&plperl_on_plperlu_init,
|
||||
NULL,
|
||||
PGC_SUSET, 0,
|
||||
NULL, NULL);
|
||||
|
||||
EmitWarningsOnPlaceholders("plperl");
|
||||
|
||||
MemSet(&hash_ctl, 0, sizeof(hash_ctl));
|
||||
@ -285,7 +312,9 @@ plperl_fini(int code, Datum arg)
|
||||
elog(DEBUG3, "plperl_fini");
|
||||
|
||||
/*
|
||||
* Disable use of spi_* functions when running END/DESTROY code.
|
||||
* Indicate that perl is terminating.
|
||||
* Disables use of spi_* functions when running END/DESTROY code.
|
||||
* See check_spi_usage_allowed().
|
||||
* Could be enabled in future, with care, using a transaction
|
||||
* http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
|
||||
*/
|
||||
@ -340,11 +369,13 @@ select_perl_context(bool trusted)
|
||||
|
||||
if (trusted)
|
||||
{
|
||||
plperl_trusted_init();
|
||||
plperl_trusted_interp = plperl_held_interp;
|
||||
interp_state = INTERP_TRUSTED;
|
||||
}
|
||||
else
|
||||
{
|
||||
plperl_untrusted_init();
|
||||
plperl_untrusted_interp = plperl_held_interp;
|
||||
interp_state = INTERP_UNTRUSTED;
|
||||
}
|
||||
@ -353,10 +384,14 @@ select_perl_context(bool trusted)
|
||||
{
|
||||
#ifdef MULTIPLICITY
|
||||
PerlInterpreter *plperl = plperl_init_interp();
|
||||
if (trusted)
|
||||
if (trusted) {
|
||||
plperl_trusted_init();
|
||||
plperl_trusted_interp = plperl;
|
||||
else
|
||||
}
|
||||
else {
|
||||
plperl_untrusted_init();
|
||||
plperl_untrusted_interp = plperl;
|
||||
}
|
||||
interp_state = INTERP_BOTH;
|
||||
#else
|
||||
elog(ERROR,
|
||||
@ -367,17 +402,11 @@ select_perl_context(bool trusted)
|
||||
trusted_context = trusted;
|
||||
|
||||
/*
|
||||
* initialization - done after plperl_*_interp and trusted_context
|
||||
* updates above to ensure a clean state (and thereby avoid recursion via
|
||||
* plperl_safe_init caling plperl_call_perl_func for utf8fix)
|
||||
*/
|
||||
if (trusted) {
|
||||
plperl_safe_init();
|
||||
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
|
||||
}
|
||||
|
||||
/*
|
||||
* enable access to the database
|
||||
* Since the timing of first use of PL/Perl can't be predicted,
|
||||
* any database interaction during initialization is problematic.
|
||||
* Including, but not limited to, security definer issues.
|
||||
* So we only enable access to the database AFTER on_*_init code has run.
|
||||
* See http://archives.postgresql.org/message-id/20100127143318.GE713@timac.local
|
||||
*/
|
||||
newXS("PostgreSQL::InServer::SPI::bootstrap",
|
||||
boot_PostgreSQL__InServer__SPI, __FILE__);
|
||||
@ -474,10 +503,10 @@ plperl_init_interp(void)
|
||||
save_time = loc ? pstrdup(loc) : NULL;
|
||||
#endif
|
||||
|
||||
if (plperl_on_perl_init)
|
||||
if (plperl_on_init)
|
||||
{
|
||||
embedding[nargs++] = "-e";
|
||||
embedding[nargs++] = plperl_on_perl_init;
|
||||
embedding[nargs++] = plperl_on_init;
|
||||
}
|
||||
|
||||
/****
|
||||
@ -645,7 +674,7 @@ plperl_destroy_interp(PerlInterpreter **interp)
|
||||
|
||||
|
||||
static void
|
||||
plperl_safe_init(void)
|
||||
plperl_trusted_init(void)
|
||||
{
|
||||
SV *safe_version_sv;
|
||||
IV safe_version_x100;
|
||||
@ -684,38 +713,64 @@ plperl_safe_init(void)
|
||||
if (GetDatabaseEncoding() == PG_UTF8)
|
||||
{
|
||||
/*
|
||||
* Fill in just enough information to set up this perl function in
|
||||
* the safe container and call it. For some reason not entirely
|
||||
* clear, it prevents errors that can arise from the regex code
|
||||
* later trying to load utf8 modules.
|
||||
* Force loading of utf8 module now to prevent errors that can
|
||||
* arise from the regex code later trying to load utf8 modules.
|
||||
* See http://rt.perl.org/rt3/Ticket/Display.html?id=47576
|
||||
*/
|
||||
plperl_proc_desc desc;
|
||||
FunctionCallInfoData fcinfo;
|
||||
SV *perlret;
|
||||
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
|
||||
if (SvTRUE(ERRSV))
|
||||
{
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_INTERNAL_ERROR),
|
||||
errmsg("while executing utf8fix"),
|
||||
errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
|
||||
}
|
||||
}
|
||||
|
||||
desc.proname = "utf8fix";
|
||||
desc.lanpltrusted = true;
|
||||
desc.nargs = 1;
|
||||
desc.arg_is_rowtype[0] = false;
|
||||
fmgr_info(F_TEXTOUT, &(desc.arg_out_func[0]));
|
||||
/* switch to the safe require opcode */
|
||||
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
|
||||
|
||||
/* compile the function */
|
||||
plperl_create_sub(&desc,
|
||||
"return shift =~ /\\xa9/i ? 'true' : 'false' ;", 0);
|
||||
if (plperl_on_plperl_init && *plperl_on_plperl_init)
|
||||
{
|
||||
dSP;
|
||||
|
||||
/* set up to call the function with a single text argument 'a' */
|
||||
fcinfo.arg[0] = CStringGetTextDatum("a");
|
||||
fcinfo.argnull[0] = false;
|
||||
PUSHMARK(SP);
|
||||
XPUSHs(sv_2mortal(newSVstring(plperl_on_plperl_init)));
|
||||
PUTBACK;
|
||||
|
||||
/* and make the call */
|
||||
perlret = plperl_call_perl_func(&desc, &fcinfo);
|
||||
call_pv("::safe_eval", G_VOID);
|
||||
SPAGAIN;
|
||||
|
||||
SvREFCNT_dec(perlret);
|
||||
if (SvTRUE(ERRSV))
|
||||
{
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_INTERNAL_ERROR),
|
||||
errmsg("while executing plperl.on_plperl_init"),
|
||||
errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
plperl_untrusted_init(void)
|
||||
{
|
||||
if (plperl_on_plperlu_init && *plperl_on_plperlu_init)
|
||||
{
|
||||
eval_pv(plperl_on_plperlu_init, FALSE);
|
||||
if (SvTRUE(ERRSV))
|
||||
{
|
||||
ereport(ERROR,
|
||||
(errcode(ERRCODE_INTERNAL_ERROR),
|
||||
errmsg("while executing plperl.on_plperlu_init"),
|
||||
errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* Perl likes to put a newline after its error messages; clean up such
|
||||
*/
|
||||
@ -1284,6 +1339,7 @@ plperl_init_shared_libs(pTHX)
|
||||
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
|
||||
newXS("PostgreSQL::InServer::Util::bootstrap",
|
||||
boot_PostgreSQL__InServer__Util, file);
|
||||
/* newXS for...::SPI::bootstrap is in select_perl_context() */
|
||||
}
|
||||
|
||||
|
||||
@ -2023,6 +2079,7 @@ plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
|
||||
static void
|
||||
check_spi_usage_allowed()
|
||||
{
|
||||
/* see comment in plperl_fini() */
|
||||
if (plperl_ending) {
|
||||
/* simple croak as we don't want to involve PostgreSQL code */
|
||||
croak("SPI functions can not be used in END blocks");
|
||||
|
||||
@ -1,3 +1,12 @@
|
||||
-- test plperl.on_plperl_init via the shared hash
|
||||
-- (must be done before plperl is first used)
|
||||
|
||||
-- Avoid need for custom_variable_classes = 'plperl'
|
||||
LOAD 'plperl';
|
||||
|
||||
-- testing on_plperl_init gets run, and that it can alter %_SHARED
|
||||
SET plperl.on_plperl_init = '$_SHARED{on_init} = 42';
|
||||
|
||||
-- test the shared hash
|
||||
|
||||
create function setme(key text, val text) returns void language plperl as $$
|
||||
@ -19,4 +28,4 @@ select setme('ourkey','ourval');
|
||||
|
||||
select getme('ourkey');
|
||||
|
||||
|
||||
select getme('on_init');
|
||||
|
||||
@ -1,6 +1,13 @@
|
||||
-- Use ONLY plperlu tests here. For plperl/plerlu combined tests
|
||||
-- see plperl_plperlu.sql
|
||||
|
||||
-- Avoid need for custom_variable_classes = 'plperl'
|
||||
LOAD 'plperl';
|
||||
|
||||
-- Test plperl.on_plperlu_init gets run
|
||||
SET plperl.on_plperlu_init = '$_SHARED{init} = 42';
|
||||
DO $$ warn $_SHARED{init} $$ language plperlu;
|
||||
|
||||
--
|
||||
-- Test compilation of unicode regex - regardless of locale.
|
||||
-- This code fails in plain plperl in a non-UTF8 database.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user