This is an updated version of the third of the patches to be split out
from the former 'plperl feature patch 1'.
It includes changes following discussions with Tom Lane and others.
Changes in this patch:
- Added plperl.on_perl_init GUC for DBA use (PGC_SIGHUP)
SPI functions are not available when the code is run.
- Added interpreter destruction behaviour
Hooked via on_proc_exit().
Only has any effect for normal shutdown.
END blocks, if any, are run then objects are
destroyed, calling their DESTROY methods, if any.
SPI functions will die if called at this time.
Tim.
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 5fa7e3a..06c63df 100644
*** a/doc/src/sgml/plperl.sgml
--- b/doc/src/sgml/plperl.sgml
*************** CREATE TRIGGER test_valid_id_trig
*** 1028,1034 ****
</para>
</sect1>
! <sect1 id="plperl-missing">
<title>Limitations and Missing Features</title>
<para>
--- 1028,1098 ----
</para>
</sect1>
! <sect1 id="plperl-under-the-hood">
! <title>PL/Perl Under the Hood</title>
!
! <sect2 id="plperl-config">
! <title>Configuration</title>
!
! <para>
! This section lists configuration parameters that affect <application>PL/Perl</>.
! To set any of these parameters before <application>PL/Perl</> has been loaded,
! it is necessary to have added <quote><literal>plperl</></> to the
! <xref linkend="guc-custom-variable-classes"> list in
! <filename>postgresql.conf</filename>.
! </para>
!
! <variablelist>
!
! <varlistentry id="guc-plperl-on-perl-init" xreflabel="plperl.on_perl_init">
! <term><varname>plperl.on_perl_init</varname> (<type>string</type>)</term>
! <indexterm>
! <primary><varname>plperl.on_perl_init</> configuration parameter</primary>
! </indexterm>
! <listitem>
! <para>
! Specifies perl code to be executed when a perl interpreter is first initialized.
! 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.
! 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;'
! </programlisting>
! </para>
! <para>
! Initialization will happen in the postmaster if the plperl library is included
! in <literal>shared_preload_libraries</> (see <xref linkend="shared_preload_libraries">),
! in which case extra consideration should be given to the risk of destabilizing the postmaster.
! </para>
! <para>
! This parameter can only be set in the postgresql.conf file or on the server command line.
! </para>
! </listitem>
! </varlistentry>
!
! <varlistentry id="guc-plperl-use-strict" xreflabel="plperl.use_strict">
! <term><varname>plperl.use_strict</varname> (<type>boolean</type>)</term>
! <indexterm>
! <primary><varname>plperl.use_strict</> configuration parameter</primary>
! </indexterm>
! <listitem>
! <para>
! When set true subsequent compilations of PL/Perl functions have the <literal>strict</> pragma enabled.
! This parameter does not affect functions already compiled in the current session.
! </para>
! </listitem>
! </varlistentry>
!
! </variablelist>
!
! <sect2 id="plperl-missing">
<title>Limitations and Missing Features</title>
<para>
*************** CREATE TRIGGER test_valid_id_trig
*** 1067,1072 ****
--- 1131,1138 ----
</listitem>
</itemizedlist>
</para>
+ </sect2>
+
</sect1>
</chapter>
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index 24e2487..5d2e962 100644
*** a/src/pl/plperl/plc_perlboot.pl
--- b/src/pl/plperl/plc_perlboot.pl
***************
*** 2,8 ****
# $PostgreSQL$
PostgreSQL::InServer::Util::bootstrap();
- PostgreSQL::InServer::SPI::bootstrap();
use strict;
use warnings;
--- 2,7 ----
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 9277072..2202b0f 100644
*** a/src/pl/plperl/plperl.c
--- b/src/pl/plperl/plperl.c
***************
*** 27,32 ****
--- 27,33 ----
#include "miscadmin.h"
#include "nodes/makefuncs.h"
#include "parser/parse_type.h"
+ #include "storage/ipc.h"
#include "utils/builtins.h"
#include "utils/fmgroids.h"
#include "utils/guc.h"
*************** static HTAB *plperl_proc_hash = NULL;
*** 138,143 ****
--- 139,146 ----
static HTAB *plperl_query_hash = NULL;
static bool plperl_use_strict = false;
+ static char *plperl_on_perl_init = NULL;
+ static bool plperl_ending = false;
/* this is saved and restored by plperl_call_handler */
static plperl_call_data *current_call_data = NULL;
*************** Datum plperl_validator(PG_FUNCTION_ARGS
*** 151,156 ****
--- 154,161 ----
void _PG_init(void);
static PerlInterpreter *plperl_init_interp(void);
+ static void plperl_destroy_interp(PerlInterpreter **);
+ static void plperl_fini(int code, Datum arg);
static Datum plperl_func_handler(PG_FUNCTION_ARGS);
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
*************** _PG_init(void)
*** 237,242 ****
--- 242,255 ----
PGC_USERSET, 0,
NULL, NULL);
+ DefineCustomStringVariable("plperl.on_perl_init",
+ gettext_noop("Perl code to execute when the perl interpreter is initialized."),
+ NULL,
+ &plperl_on_perl_init,
+ NULL,
+ PGC_SIGHUP, 0,
+ NULL, NULL);
+
EmitWarningsOnPlaceholders("plperl");
MemSet(&hash_ctl, 0, sizeof(hash_ctl));
*************** _PG_init(void)
*** 261,266 ****
--- 274,310 ----
inited = true;
}
+
+ /*
+ * Cleanup perl interpreters, including running END blocks.
+ * Does not fully undo the actions of _PG_init() nor make it callable again.
+ */
+ static void
+ plperl_fini(int code, Datum arg)
+ {
+ elog(DEBUG3, "plperl_fini");
+
+ /*
+ * Disable use of spi_* functions when running END/DESTROY code.
+ * Could be enabled in future, with care, using a transaction
+ * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
+ */
+ plperl_ending = true;
+
+ /* Only perform perl cleanup if we're exiting cleanly */
+ if (code) {
+ elog(DEBUG3, "plperl_fini: skipped");
+ return;
+ }
+
+ plperl_destroy_interp(&plperl_trusted_interp);
+ plperl_destroy_interp(&plperl_untrusted_interp);
+ plperl_destroy_interp(&plperl_held_interp);
+
+ elog(DEBUG3, "plperl_fini: done");
+ }
+
+
#define SAFE_MODULE \
"require Safe; $Safe::VERSION"
*************** _PG_init(void)
*** 277,282 ****
--- 321,328 ----
static void
select_perl_context(bool trusted)
{
+ EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv);
+
/*
* handle simple cases
*/
*************** select_perl_context(bool trusted)
*** 288,293 ****
--- 334,343 ----
*/
if (interp_state == INTERP_HELD)
{
+ /* first actual use of a perl interpreter */
+
+ on_proc_exit(plperl_fini, 0);
+
if (trusted)
{
plperl_trusted_interp = plperl_held_interp;
*************** select_perl_context(bool trusted)
*** 325,330 ****
--- 375,396 ----
plperl_safe_init();
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
}
+
+ /*
+ * enable access to the database
+ */
+ newXS("PostgreSQL::InServer::SPI::bootstrap",
+ boot_PostgreSQL__InServer__SPI, __FILE__);
+
+ eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE);
+ if (SvTRUE(ERRSV))
+ {
+ ereport(ERROR,
+ (errcode(ERRCODE_INTERNAL_ERROR),
+ errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
+ errdetail("While executing PostgreSQL::InServer::SPI::bootstrap")));
+ }
+
}
/*
*************** plperl_init_interp(void)
*** 361,371 ****
PerlInterpreter *plperl;
static int perl_sys_init_done;
! static char *embedding[3] = {
"", "-e", PLC_PERLBOOT
};
int nargs = 3;
#ifdef WIN32
/*
--- 427,443 ----
PerlInterpreter *plperl;
static int perl_sys_init_done;
! static char *embedding[3+2] = {
"", "-e", PLC_PERLBOOT
};
int nargs = 3;
+ if (plperl_on_perl_init)
+ {
+ embedding[nargs++] = "-e";
+ embedding[nargs++] = plperl_on_perl_init;
+ }
+
#ifdef WIN32
/*
*************** plperl_init_interp(void)
*** 437,442 ****
--- 509,517 ----
PERL_SET_CONTEXT(plperl);
perl_construct(plperl);
+ /* run END blocks in perl_destruct instead of perl_run */
+ PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
+
/*
* Record the original function for the 'require' opcode.
* Ensure it's used for new interpreters.
*************** plperl_init_interp(void)
*** 446,454 ****
else
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
! perl_parse(plperl, plperl_init_shared_libs,
! nargs, embedding, NULL);
! perl_run(plperl);
#ifdef WIN32
--- 521,538 ----
else
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
! if (perl_parse(plperl, plperl_init_shared_libs,
! nargs, embedding, NULL) != 0)
! ereport(ERROR,
! (errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while parsing perl initialization"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
!
! if (perl_run(plperl) != 0)
! ereport(ERROR,
! (errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while running perl initialization"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
#ifdef WIN32
*************** pp_require_safe(pTHX)
*** 524,529 ****
--- 608,653 ----
static void
+ plperl_destroy_interp(PerlInterpreter **interp)
+ {
+ if (interp && *interp)
+ {
+ /*
+ * Only a very minimal destruction is performed.
+ * Just END blocks and object destructors, no system-level actions.
+ * Code code here extracted from perl's perl_destruct().
+ */
+
+ /* Run END blocks */
+ if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
+ dJMPENV;
+ int x = 0;
+
+ JMPENV_PUSH(x);
+ PERL_UNUSED_VAR(x);
+ if (PL_endav && !PL_minus_c)
+ call_list(PL_scopestack_ix, PL_endav);
+ JMPENV_POP;
+ }
+ LEAVE;
+ FREETMPS;
+
+ PL_dirty = TRUE;
+
+ /* destroy objects - call DESTROY methods */
+ if (PL_sv_objcount) {
+ Perl_sv_clean_objs(aTHX);
+ PL_sv_objcount = 0;
+ if (PL_defoutgv && !SvREFCNT(PL_defoutgv))
+ PL_defoutgv = NULL; /* may have been freed */
+ }
+
+ *interp = NULL;
+ }
+ }
+
+
+ static void
plperl_safe_init(void)
{
SV *safe_version_sv;
*************** plperl_safe_init(void)
*** 544,551 ****
{
ereport(ERROR,
(errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
! errdetail("While executing PLC_SAFE_BAD")));
}
}
--- 668,675 ----
{
ereport(ERROR,
(errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while executing PLC_SAFE_BAD"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
}
}
*************** plperl_safe_init(void)
*** 556,563 ****
{
ereport(ERROR,
(errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
! errdetail("While executing PLC_SAFE_OK")));
}
if (GetDatabaseEncoding() == PG_UTF8)
--- 680,687 ----
{
ereport(ERROR,
(errcode(ERRCODE_INTERNAL_ERROR),
! errmsg("while executing PLC_SAFE_OK"),
! errdetail("%s", strip_trailing_ws(SvPV_nolen(ERRSV))) ));
}
if (GetDatabaseEncoding() == PG_UTF8)
*************** plperl_create_sub(plperl_proc_desc *prod
*** 1150,1167 ****
*
**********************************************************************/
- EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
- EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv);
- EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv);
-
static void
plperl_init_shared_libs(pTHX)
{
char *file = __FILE__;
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
- newXS("PostgreSQL::InServer::SPI::bootstrap",
- boot_PostgreSQL__InServer__SPI, file);
newXS("PostgreSQL::InServer::Util::bootstrap",
boot_PostgreSQL__InServer__Util, file);
}
--- 1274,1287 ----
*
**********************************************************************/
static void
plperl_init_shared_libs(pTHX)
{
char *file = __FILE__;
+ EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
+ EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv);
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
newXS("PostgreSQL::InServer::Util::bootstrap",
boot_PostgreSQL__InServer__Util, file);
}
*************** plperl_hash_from_tuple(HeapTuple tuple,
*** 1897,1902 ****
--- 2017,2032 ----
}
+ static void
+ check_spi_usage_allowed()
+ {
+ if (plperl_ending) {
+ /* simple croak as we don't want to involve PostgreSQL code */
+ croak("SPI functions can not be used in END blocks");
+ }
+ }
+
+
HV *
plperl_spi_exec(char *query, int limit)
{
*************** plperl_spi_exec(char *query, int limit)
*** 1909,1914 ****
--- 2039,2046 ----
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ check_spi_usage_allowed();
+
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_execute_fetch_result(SPITuple
*** 1972,1977 ****
--- 2104,2111 ----
{
HV *result;
+ check_spi_usage_allowed();
+
result = newHV();
hv_store_string(result, "status",
*************** plperl_spi_query(char *query)
*** 2145,2150 ****
--- 2279,2286 ----
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ check_spi_usage_allowed();
+
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_fetchrow(char *cursor)
*** 2223,2228 ****
--- 2359,2366 ----
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ check_spi_usage_allowed();
+
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_fetchrow(char *cursor)
*** 2297,2303 ****
void
plperl_spi_cursor_close(char *cursor)
{
! Portal p = SPI_cursor_find(cursor);
if (p)
SPI_cursor_close(p);
--- 2435,2445 ----
void
plperl_spi_cursor_close(char *cursor)
{
! Portal p;
!
! check_spi_usage_allowed();
!
! p = SPI_cursor_find(cursor);
if (p)
SPI_cursor_close(p);
*************** plperl_spi_prepare(char *query, int argc
*** 2315,2320 ****
--- 2457,2464 ----
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ check_spi_usage_allowed();
+
BeginInternalSubTransaction(NULL);
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_exec_prepared(char *query, HV
*** 2450,2455 ****
--- 2594,2601 ----
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ check_spi_usage_allowed();
+
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_query_prepared(char *query, i
*** 2592,2597 ****
--- 2738,2745 ----
MemoryContext oldcontext = CurrentMemoryContext;
ResourceOwner oldowner = CurrentResourceOwner;
+ check_spi_usage_allowed();
+
BeginInternalSubTransaction(NULL);
/* Want to run inside function's memory context */
MemoryContextSwitchTo(oldcontext);
*************** plperl_spi_freeplan(char *query)
*** 2715,2720 ****
--- 2863,2870 ----
plperl_query_desc *qdesc;
plperl_query_entry *hash_entry;
+ check_spi_usage_allowed();
+
hash_entry = hash_search(plperl_query_hash, query,
HASH_FIND, NULL);
if (hash_entry == NULL)
diff --git a/src/pl/plperl/sql/plperl_end.sql b/src/pl/plperl/sql/plperl_end.sql
index ...695f0a7 .
*** a/src/pl/plperl/sql/plperl_end.sql
--- b/src/pl/plperl/sql/plperl_end.sql
***************
*** 0 ****
--- 1,28 ----
+ -- test END block handling
+
+ -- Not included in the normal testing
+ -- because it's beyond the scope of the test harness.
+ -- Available here for manual developer testing.
+
+ DO $do$
+ my $testlog = "/tmp/pgplperl_test.log";
+
+ warn "Create $testlog, re-run test, then manually examine contents.\n";
+ return unless -f $testlog;
+
+ open my $fh, '>', $testlog
+ or die "Can't write to $testlog: $!";
+ print $fh "# you should see just 3 'Warn: ...' lines: END, SPI ..., and DESTROY\n";
+
+ $SIG{__WARN__} = sub { printf $fh "Warn: @_" };
+ $SIG{__DIE__} = sub { printf $fh "Die: @_" unless $^S; die @_ };
+
+ sub MyClass::DESTROY { warn "DESTROY\n" };
+ $_SHARED{object} = bless [], 'MyClass';
+
+ END {
+ warn "END\n";
+ eval { spi_exec_query("select 1") };
+ warn $@;
+ }
+ $do$ language plperlu;
diff --git a/src/pl/plperl/sql/plperl_plperlu.sql b/src/pl/plperl/sql/plperl_plperlu.sql
index fc2bb7b..15b5aa2 100644
*** a/src/pl/plperl/sql/plperl_plperlu.sql
--- b/src/pl/plperl/sql/plperl_plperlu.sql
*************** $$ LANGUAGE plperlu; -- compile plperlu
*** 16,19 ****
SELECT * FROM bar(); -- throws exception normally (running plperl)
SELECT * FROM foo(); -- used to cause backend crash (after switching to plperlu)
-
--- 16,18 ----
--
Sent via pgsql-hackers mailing list (pgsql-hackers@postgresql.org)
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
