recent <productname>Perl</productname> versions, but it was not
in earlier versions, and in any case it is the choice of whomever
installed Perl at your site.
+ If you intend to make more than incidental use of
+ <application>PL/Perl</application>, you should ensure that the
+ <productname>Perl</productname> installation was built with the
+ <literal>usemultiplicity</> option enabled (<literal>perl -V</>
+ will show whether this is the case).
</para>
<para>
<para>
Users of source packages must specially enable the build of
PL/Perl during the installation process. (Refer to <xref
- linkend="install-short"> for more information.) Users of
+ linkend="installation"> for more information.) Users of
binary packages might find PL/Perl in a separate subpackage.
</para>
</note>
<literal>return $_SHARED{myquote}->($_[0]);</literal>
at the expense of readability.)
</para>
+
+ <para>
+ For security reasons, PL/Perl executes functions called by any one SQL role
+ in a separate Perl interpreter for that role. This prevents accidental or
+ malicious interference by one user with the behavior of another user's
+ PL/Perl functions. Each such interpreter has its own value of the
+ <varname>%_SHARED</varname> variable and other global state. Thus, two
+ PL/Perl functions will share the same value of <varname>%_SHARED</varname>
+ if and only if they are executed by the same SQL role. In an application
+ wherein a single session executes code under multiple SQL roles (via
+ <literal>SECURITY DEFINER</> functions, use of <command>SET ROLE</>, etc)
+ you may need to take explicit steps to ensure that PL/Perl functions can
+ share data via <varname>%_SHARED</varname>. To do that, make sure that
+ functions that should communicate are owned by the same user, and mark
+ them <literal>SECURITY DEFINER</>. You must of course take care that
+ such functions can't be used to do anything unintended.
+ </para>
</sect1>
<sect1 id="plperl-trusted">
</para>
<note>
- <para>
- For security reasons, to stop a leak of privileged operations from
- <application>PL/PerlU</> to <application>PL/Perl</>, these two languages
- have to run in separate instances of the Perl interpreter. If your
- Perl installation has been appropriately compiled, this is not a problem.
- However, not all installations are compiled with the requisite flags.
- If <productname>PostgreSQL</> detects that this is the case then it will
- not start a second interpreter, but instead create an error. In
- consequence, in such an installation, you cannot use both
- <application>PL/PerlU</> and <application>PL/Perl</> in the same backend
- process. The remedy for this is to obtain a Perl installation created
- with the appropriate flags, namely either <literal>usemultiplicity</> or
- both <literal>usethreads</> and <literal>useithreads</>.
- For more details,see the <literal>perlembed</> manual page.
- </para>
+ <para>
+ While <application>PL/Perl</> functions run in a separate Perl
+ interpreter for each SQL role, all <application>PL/PerlU</> functions
+ executed in a given session run in a single Perl interpreter (which is
+ not any of the ones used for <application>PL/Perl</> functions).
+ This allows <application>PL/PerlU</> functions to share data freely,
+ but no communication can occur between <application>PL/Perl</> and
+ <application>PL/PerlU</> functions.
+ </para>
+ </note>
+
+ <note>
+ <para>
+ Perl cannot support multiple interpreters within one process unless
+ it was built with the appropriate flags, namely either
+ <literal>usemultiplicity</> or <literal>useithreads</>.
+ (<literal>usemultiplicity</> is preferred unless you actually need
+ to use threads. For more details, see the
+ <citerefentry><refentrytitle>perlembed</></citerefentry> man page.)
+ If <application>PL/Perl</> is used with a copy of Perl that was not built
+ this way, then it is only possible to have one Perl interpreter per
+ session, and so any one session can only execute either
+ <application>PL/PerlU</> functions, or <application>PL/Perl</> functions
+ that are all called by the same SQL role.
+ </para>
</note>
</sect1>
Sometimes it
is useful to have some global data that is held between two
calls to a function or is shared between different functions.
- This is easily done since
- all PL/Tcl functions executed in one session share the same
- safe Tcl interpreter. So, any global Tcl variable is accessible to
- all PL/Tcl function calls and will persist for the duration of the
- SQL session. (Note that <application>PL/TclU</> functions likewise share
- global data, but they are in a different Tcl interpreter and cannot
- communicate with PL/Tcl functions.)
+ This is easily done in PL/Tcl, but there are some restrictions that
+ must be understood.
</para>
+
+ <para>
+ For security reasons, PL/Tcl executes functions called by any one SQL
+ role in a separate Tcl interpreter for that role. This prevents
+ accidental or malicious interference by one user with the behavior of
+ another user's PL/Tcl functions. Each such interpreter will have its own
+ values for any <quote>global</> Tcl variables. Thus, two PL/Tcl
+ functions will share the same global variables if and only if they are
+ executed by the same SQL role. In an application wherein a single
+ session executes code under multiple SQL roles (via <literal>SECURITY
+ DEFINER</> functions, use of <command>SET ROLE</>, etc) you may need to
+ take explicit steps to ensure that PL/Tcl functions can share data. To
+ do that, make sure that functions that should communicate are owned by
+ the same user, and mark them <literal>SECURITY DEFINER</>. You must of
+ course take care that such functions can't be used to do anything
+ unintended.
+ </para>
+
+ <para>
+ All PL/TclU functions used in a session execute in the same Tcl
+ interpreter, which of course is distinct from the interpreter(s)
+ used for PL/Tcl functions. So global data is automatically shared
+ between PL/TclU functions. This is not considered a security risk
+ because all PL/TclU functions execute at the same trust level,
+ namely that of a database superuser.
+ </para>
+
<para>
To help protect PL/Tcl functions from unintentionally interfering
with each other, a global
<literal>GD</> be used
for persistent private data of a function. Use regular Tcl global
variables only for values that you specifically intend to be shared among
- multiple functions.
+ multiple functions. (Note that the <literal>GD</> arrays are only
+ global within a particular interpreter, so they do not bypass the
+ security restrictions mentioned above.)
</para>
<para>
exists, the module <literal>unknown</> is fetched from the table
and loaded into the Tcl interpreter immediately before the first
execution of a PL/Tcl function in a database session. (This
- happens separately for PL/Tcl and PL/TclU, if both are used,
- because separate interpreters are used for the two languages.)
+ happens separately for each Tcl interpreter, if more than one is
+ used in a session; see <xref linkend="pltcl-global">.)
</para>
<para>
While the <literal>unknown</> module could actually contain any
<itemizedlist>
+ <listitem>
+ <para>
+ Use a separate interpreter for each calling SQL userid in PL/Perl and
+ PL/Tcl (Tom Lane)
+ </para>
+
+ <para>
+ This change prevents security problems that can be caused by subverting
+ Perl or Tcl code that will be executed later in the same session under
+ another SQL user identity (for example, within a <literal>SECURITY
+ DEFINER</> function). Most scripting languages offer numerous ways that
+ that might be done, such as redefining standard functions or operators
+ called by the target function. Without this change, any SQL user with
+ Perl or Tcl language usage rights can do essentially anything with the
+ SQL privileges of the target function's owner.
+ </para>
+
+ <para>
+ The cost of this change is that intentional communication among Perl
+ and Tcl functions becomes more difficult. To provide an escape hatch,
+ PL/PerlU and PL/TclU functions continue to use only one interpreter
+ per session. This is not considered a security issue since all such
+ functions execute at the trust level of a database superuser already.
+ </para>
+
+ <para>
+ It is likely that third-party procedural languages that claim to offer
+ trusted execution have similar security issues. We advise contacting
+ the authors of any PL you are depending on for security-critical
+ purposes.
+ </para>
+
+ <para>
+ Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433).
+ </para>
+ </listitem>
+
<listitem>
<para>
Prevent possible crashes in <function>pg_get_expr()</> by disallowing
<itemizedlist>
+ <listitem>
+ <para>
+ Use a separate interpreter for each calling SQL userid in PL/Perl and
+ PL/Tcl (Tom Lane)
+ </para>
+
+ <para>
+ This change prevents security problems that can be caused by subverting
+ Perl or Tcl code that will be executed later in the same session under
+ another SQL user identity (for example, within a <literal>SECURITY
+ DEFINER</> function). Most scripting languages offer numerous ways that
+ that might be done, such as redefining standard functions or operators
+ called by the target function. Without this change, any SQL user with
+ Perl or Tcl language usage rights can do essentially anything with the
+ SQL privileges of the target function's owner.
+ </para>
+
+ <para>
+ The cost of this change is that intentional communication among Perl
+ and Tcl functions becomes more difficult. To provide an escape hatch,
+ PL/PerlU and PL/TclU functions continue to use only one interpreter
+ per session. This is not considered a security issue since all such
+ functions execute at the trust level of a database superuser already.
+ </para>
+
+ <para>
+ It is likely that third-party procedural languages that claim to offer
+ trusted execution have similar security issues. We advise contacting
+ the authors of any PL you are depending on for security-critical
+ purposes.
+ </para>
+
+ <para>
+ Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433).
+ </para>
+ </listitem>
+
<listitem>
<para>
Prevent possible crashes in <function>pg_get_expr()</> by disallowing
#include "commands/trigger.h"
#include "executor/spi.h"
#include "funcapi.h"
+#include "miscadmin.h"
#include "mb/pg_wchar.h"
#include "utils/lsyscache.h"
#include "utils/typcache.h"
/* defines PLPERL_SET_OPMASK */
#include "plperl_opmask.h"
+EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
+EXTERN_C void boot_SPI(pTHX_ CV *cv);
+
+
+/**********************************************************************
+ * Information associated with a Perl interpreter. We have one interpreter
+ * that is used for all plperlu (untrusted) functions. For plperl (trusted)
+ * functions, there is a separate interpreter for each effective SQL userid.
+ * (This is needed to ensure that an unprivileged user can't inject Perl code
+ * that'll be executed with the privileges of some other SQL user.)
+ *
+ * The plperl_interp_desc structs are kept in a Postgres hash table indexed
+ * by userid OID, with OID 0 used for the single untrusted interpreter.
+ *
+ * We start out by creating a "held" interpreter, which we initialize
+ * only as far as we can do without deciding if it will be trusted or
+ * untrusted. Later, when we first need to run a plperl or plperlu
+ * function, we complete the initialization appropriately and move the
+ * PerlInterpreter pointer into the plperl_interp_hash hashtable. If after
+ * that we need more interpreters, we create them as needed if we can, or
+ * fail if the Perl build doesn't support multiple interpreters.
+ *
+ * The reason for all the dancing about with a held interpreter is to make
+ * it possible for people to preload a lot of Perl code at postmaster startup
+ * (using plperl.on_init) and then use that code in backends. Of course this
+ * will only work for the first interpreter created in any backend, but it's
+ * still useful with that restriction.
+ **********************************************************************/
+typedef struct plperl_interp_desc
+{
+ Oid user_id; /* Hash key (must be first!) */
+ PerlInterpreter *interp; /* The interpreter */
+} plperl_interp_desc;
+
/**********************************************************************
* The information we cache about loaded procedures
char *proname;
TransactionId fn_xmin;
CommandId fn_cmin;
+ plperl_interp_desc *interp; /* interpreter it's created in */
bool fn_readonly;
bool lanpltrusted;
bool fn_retistuple; /* true, if function returns tuple */
* Global data
**********************************************************************/
-typedef enum
-{
- INTERP_NONE,
- INTERP_HELD,
- INTERP_TRUSTED,
- INTERP_UNTRUSTED,
- INTERP_BOTH
-} InterpState;
-
-static InterpState interp_state = INTERP_NONE;
-static bool can_run_two = false;
-
-static int plperl_firstcall = 1;
-static bool plperl_safe_init_done = false;
-static PerlInterpreter *plperl_trusted_interp = NULL;
-static PerlInterpreter *plperl_untrusted_interp = NULL;
+static bool plperl_firstcall = true;
+static HTAB *plperl_interp_hash = NULL;
+static HTAB *plperl_proc_hash = NULL;
+static plperl_interp_desc *plperl_active_interp = NULL;
+/* If we have an unassigned "held" interpreter, it's stored here */
static PerlInterpreter *plperl_held_interp = NULL;
+
static OP *(*pp_require_orig) (pTHX) = NULL;
-static OP *pp_require_safe(pTHX);
-static bool trusted_context;
-static HTAB *plperl_proc_hash = NULL;
static char plperl_opmask[MAXO];
-static void set_interp_require(void);
/* this is saved and restored by plperl_call_handler */
static plperl_proc_desc *plperl_current_prodesc = NULL;
/**********************************************************************
* Forward declarations
**********************************************************************/
-static void plperl_init_all(void);
-static void plperl_init_interp(void);
-
Datum plperl_call_handler(PG_FUNCTION_ARGS);
void plperl_init(void);
HV *plperl_spi_exec(char *query, int limit);
-static Datum plperl_func_handler(PG_FUNCTION_ARGS);
+static PerlInterpreter *plperl_init_interp(void);
+static void set_interp_require(bool trusted);
+static Datum plperl_func_handler(PG_FUNCTION_ARGS);
static Datum plperl_trigger_handler(PG_FUNCTION_ARGS);
+
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_trusted_init(void);
+static void plperl_untrusted_init(void);
static HV *plperl_spi_execute_fetch_result(SPITupleTable *, int, int);
-static void check_interp(bool trusted);
+static void plperl_create_sub(plperl_proc_desc *desc, char *s, Oid fn_oid);
static char *strip_trailing_ws(const char *msg);
+static OP *pp_require_safe(pTHX);
+static void activate_interpreter(plperl_interp_desc *interp_desc);
#ifdef WIN32
static char *setlocale_perl(int category, char *locale);
#endif
-/* hash table entry for proc desc */
+/**********************************************************************
+ * For speedy lookup, we maintain a hash table mapping from
+ * function OID + trigger flag + user OID to plperl_proc_desc pointers.
+ * The reason the plperl_proc_desc struct isn't directly part of the hash
+ * entry is to simplify recovery from errors during compile_plperl_function.
+ *
+ * Note: if the same function is called by multiple userIDs within a session,
+ * there will be a separate plperl_proc_desc entry for each userID in the case
+ * of plperl functions, but only one entry for plperlu functions, because we
+ * set user_id = 0 for that case. If the user redeclares the same function
+ * from plperl to plperlu or vice versa, there might be multiple
+ * plperl_proc_ptr entries in the hashtable, but only one is valid.
+ **********************************************************************/
+typedef struct plperl_proc_key
+{
+ Oid proc_id; /* Function OID */
+ /*
+ * is_trigger is really a bool, but declare as Oid to ensure this struct
+ * contains no padding
+ */
+ Oid is_trigger; /* is it a trigger function? */
+ Oid user_id; /* User calling the function, or 0 */
+} plperl_proc_key;
-typedef struct plperl_proc_entry
+typedef struct plperl_proc_ptr
{
- char proc_name[NAMEDATALEN];
- plperl_proc_desc *proc_data;
-} plperl_proc_entry;
+ plperl_proc_key proc_key; /* Hash key (must be first!) */
+ plperl_proc_desc *proc_ptr;
+} plperl_proc_ptr;
/*
* This routine is a crock, and so is everyplace that calls it. The problem
if (!plperl_firstcall)
return;
- MemSet(&hash_ctl, 0, sizeof(hash_ctl));
-
- hash_ctl.keysize = NAMEDATALEN;
- hash_ctl.entrysize = sizeof(plperl_proc_entry);
-
- plperl_proc_hash = hash_create("PLPerl Procedures",
+ memset(&hash_ctl, 0, sizeof(hash_ctl));
+ hash_ctl.keysize = sizeof(Oid);
+ hash_ctl.entrysize = sizeof(plperl_interp_desc);
+ hash_ctl.hash = tag_hash;
+ plperl_interp_hash = hash_create("PL/Perl interpreters",
+ 8,
+ &hash_ctl,
+ HASH_ELEM | HASH_FUNCTION);
+
+ memset(&hash_ctl, 0, sizeof(hash_ctl));
+ hash_ctl.keysize = sizeof(plperl_proc_key);
+ hash_ctl.entrysize = sizeof(plperl_proc_ptr);
+ hash_ctl.hash = tag_hash;
+ plperl_proc_hash = hash_create("PL/Perl procedures",
32,
&hash_ctl,
- HASH_ELEM);
+ HASH_ELEM | HASH_FUNCTION);
/************************************************************
* Create the Perl interpreter
************************************************************/
PLPERL_SET_OPMASK(plperl_opmask);
- plperl_init_interp();
+ plperl_held_interp = plperl_init_interp();
- plperl_firstcall = 0;
+ plperl_firstcall = false;
}
/**********************************************************************
#define PLC_TRUSTED \
"require strict; "
-#define TEST_FOR_MULTI \
- "use Config; " \
- "$Config{usemultiplicity} eq 'define' or " \
- "($Config{usethreads} eq 'define' " \
- " and $Config{useithreads} eq 'define')"
-
-
static void
-set_interp_require(void)
+set_interp_require(bool trusted)
{
- if (trusted_context)
+ if (trusted)
{
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
PL_ppaddr[OP_DOFILE] = pp_require_safe;
}
}
-/********************************************************************
- *
- * We start out by creating a "held" interpreter that we can use in
- * trusted or untrusted mode (but not both) as the need arises. Later, we
- * assign that interpreter if it is available to either the trusted or
- * untrusted interpreter. If it has already been assigned, and we need to
- * create the other interpreter, we do that if we can, or error out.
- * We detect if it is safe to run two interpreters during the setup of the
- * dummy interpreter.
+/*
+ * Select and activate an appropriate Perl interpreter.
*/
-
-
static void
-check_interp(bool trusted)
+select_perl_context(bool trusted)
{
- if (interp_state == INTERP_HELD)
+ Oid user_id;
+ plperl_interp_desc *interp_desc;
+ bool found;
+ PerlInterpreter *interp = NULL;
+
+ /* Find or create the interpreter hashtable entry for this userid */
+ if (trusted)
+ user_id = GetUserId();
+ else
+ user_id = InvalidOid;
+
+ interp_desc = hash_search(plperl_interp_hash, &user_id,
+ HASH_ENTER,
+ &found);
+ if (!found)
{
- if (trusted)
- {
- plperl_trusted_interp = plperl_held_interp;
- interp_state = INTERP_TRUSTED;
- }
- else
- {
- plperl_untrusted_interp = plperl_held_interp;
- interp_state = INTERP_UNTRUSTED;
- }
- plperl_held_interp = NULL;
- trusted_context = trusted;
- set_interp_require();
+ /* Initialize newly-created hashtable entry */
+ interp_desc->interp = NULL;
}
- else if (interp_state == INTERP_BOTH ||
- (trusted && interp_state == INTERP_TRUSTED) ||
- (!trusted && interp_state == INTERP_UNTRUSTED))
+
+ /*
+ * Quick exit if already have an interpreter
+ */
+ if (interp_desc->interp)
{
- if (trusted_context != trusted)
- {
- if (trusted)
- PERL_SET_CONTEXT(plperl_trusted_interp);
- else
- PERL_SET_CONTEXT(plperl_untrusted_interp);
- trusted_context = trusted;
- set_interp_require();
- }
+ activate_interpreter(interp_desc);
+ return;
}
- else if (can_run_two)
+
+ /*
+ * adopt held interp if free, else create new one if possible
+ */
+ if (plperl_held_interp != NULL)
{
- PERL_SET_CONTEXT(plperl_held_interp);
- plperl_init_interp();
+ /* first actual use of a perl interpreter */
+ interp = plperl_held_interp;
+
+ /*
+ * Reset the plperl_held_interp pointer first; if we fail during init
+ * we don't want to try again with the partially-initialized interp.
+ */
+ plperl_held_interp = NULL;
+
if (trusted)
- plperl_trusted_interp = plperl_held_interp;
+ plperl_trusted_init();
else
- plperl_untrusted_interp = plperl_held_interp;
- interp_state = INTERP_BOTH;
- plperl_held_interp = NULL;
- trusted_context = trusted;
- set_interp_require();
+ plperl_untrusted_init();
}
else
{
- elog(ERROR,
- "can not allocate second Perl interpreter on this platform");
+#ifdef MULTIPLICITY
+ /*
+ * plperl_init_interp will change Perl's idea of the active
+ * interpreter. Reset plperl_active_interp temporarily, so that if we
+ * hit an error partway through here, we'll make sure to switch back
+ * to a non-broken interpreter before running any other Perl
+ * functions.
+ */
+ plperl_active_interp = NULL;
+ /* Now build the new interpreter */
+ interp = plperl_init_interp();
+
+ if (trusted)
+ plperl_trusted_init();
+ else
+ plperl_untrusted_init();
+#else
+ elog(ERROR,
+ "cannot allocate multiple Perl interpreters on this platform");
+#endif
}
-}
+ set_interp_require(trusted);
+
+ /* Fully initialized, so mark the hashtable entry valid */
+ interp_desc->interp = interp;
+ /* And mark this as the active interpreter */
+ plperl_active_interp = interp_desc;
+}
+/*
+ * Make the specified interpreter the active one
+ *
+ * A call with NULL does nothing. This is so that "restoring" to a previously
+ * null state of plperl_active_interp doesn't result in useless thrashing.
+ */
static void
-restore_context(bool old_context)
+activate_interpreter(plperl_interp_desc *interp_desc)
{
- if (trusted_context != old_context)
+ if (interp_desc && plperl_active_interp != interp_desc)
{
- if (old_context)
- PERL_SET_CONTEXT(plperl_trusted_interp);
- else
- PERL_SET_CONTEXT(plperl_untrusted_interp);
-
- trusted_context = old_context;
- set_interp_require();
+ Assert(interp_desc->interp);
+ PERL_SET_CONTEXT(interp_desc->interp);
+ /* trusted iff user_id isn't InvalidOid */
+ set_interp_require(OidIsValid(interp_desc->user_id));
+ plperl_active_interp = interp_desc;
}
}
-/**********************************************************************
- * plperl_init_interp() - Create the Perl interpreter
- **********************************************************************/
-static void
+/*
+ * Create a new Perl interpreter.
+ *
+ * We initialize the interpreter as far as we can without knowing whether
+ * it will become a trusted or untrusted interpreter; in particular, the
+ * plperl.on_init code will get executed. Later, either plperl_trusted_init
+ * or plperl_untrusted_init must be called to complete the initialization.
+ */
+static PerlInterpreter *
plperl_init_interp(void)
{
+ PerlInterpreter *plperl;
+ static int perl_sys_init_done;
+
static char *embedding[3] = {
"", "-e",
* true when MYMALLOC is set.
*/
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
- if (interp_state == INTERP_NONE)
+ if (!perl_sys_init_done)
{
int nargs;
char *dummy_perl_env[1];
nargs = 3;
dummy_perl_env[0] = NULL;
PERL_SYS_INIT3(&nargs, (char ***) &embedding, (char ***) &dummy_perl_env);
+ perl_sys_init_done = 1;
}
#endif
- plperl_held_interp = perl_alloc();
- if (!plperl_held_interp)
+ plperl = perl_alloc();
+ if (!plperl)
elog(ERROR, "could not allocate Perl interpreter");
- perl_construct(plperl_held_interp);
+ PERL_SET_CONTEXT(plperl);
+ perl_construct(plperl);
/*
* Record the original function for the 'require' and 'dofile' opcodes.
PL_ppaddr[OP_DOFILE] = pp_require_orig;
}
- perl_parse(plperl_held_interp, plperl_init_shared_libs,
- 3, embedding, NULL);
- perl_run(plperl_held_interp);
-
- if (interp_state == INTERP_NONE)
- {
- SV *res;
+ if (perl_parse(plperl, plperl_init_shared_libs,
+ 3, embedding, NULL) != 0)
+ ereport(ERROR,
+ (errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
+ errcontext("while parsing Perl initialization")));
- res = eval_pv(TEST_FOR_MULTI, TRUE);
- can_run_two = SvIV(res);
- interp_state = INTERP_HELD;
- }
+ if (perl_run(plperl) != 0)
+ ereport(ERROR,
+ (errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
+ errcontext("while running Perl initialization")));
#ifdef PLPERL_RESTORE_LOCALE
PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
#endif
+ return plperl;
}
/*
DIE(aTHX_ "Unable to load %s into plperl", name);
}
-
+/*
+ * Initialize the current Perl interpreter as a trusted interp
+ */
static void
-plperl_safe_init(void)
+plperl_trusted_init(void)
{
HV *stash;
SV *sv;
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
PL_ppaddr[OP_DOFILE] = pp_require_safe;
- /*
- * prevent (any more) unsafe opcodes being compiled
- * PL_op_mask is per interpreter, so this only needs to be set once
+ /*
+ * prevent (any more) unsafe opcodes being compiled
+ * PL_op_mask is per interpreter, so this only needs to be set once
*/
PL_op_mask = plperl_opmask;
#ifdef PL_stashcache
hv_clear(PL_stashcache);
#endif
+}
- plperl_safe_init_done = true;
+/*
+ * Initialize the current Perl interpreter as an untrusted interp
+ */
+static void
+plperl_untrusted_init(void)
+{
+ /*
+ * Nothing to do here
+ */
}
/*
{
Datum retval;
plperl_proc_desc *save_prodesc;
- bool oldcontext = trusted_context;
+ plperl_interp_desc *oldinterp;
/*
* Initialize interpreter if first time through
* Ensure that static pointers are saved/restored properly
*/
save_prodesc = plperl_current_prodesc;
+ oldinterp = plperl_active_interp;
PG_TRY();
{
PG_CATCH();
{
plperl_current_prodesc = save_prodesc;
- restore_context(oldcontext);
+ activate_interpreter(oldinterp);
PG_RE_THROW();
}
PG_END_TRY();
plperl_current_prodesc = save_prodesc;
- restore_context(oldcontext);
+ activate_interpreter(oldinterp);
return retval;
}
* create the anonymous subroutine whose text is in the SV.
* Returns the SV containing the RV to the closure.
**********************************************************************/
-static SV *
-plperl_create_sub(char *s, bool trusted)
+static void
+plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
{
dSP;
SV *subref;
int count;
- if (trusted && !plperl_safe_init_done)
- {
- plperl_safe_init();
- SPAGAIN;
- }
-
ENTER;
SAVETMPS;
PUSHMARK(SP);
FREETMPS;
LEAVE;
- return subref;
+ prodesc->reference = subref;
}
/**********************************************************************
* and do the initialization behind perl's back.
*
**********************************************************************/
-
-EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
-EXTERN_C void boot_SPI(pTHX_ CV *cv);
-
static void
plperl_init_shared_libs(pTHX)
{
plperl_current_prodesc = prodesc;
- check_interp(prodesc->lanpltrusted);
+ activate_interpreter(prodesc->interp);
/************************************************************
* Call the Perl function if not returning set
* Call the Perl function
************************************************************/
- check_interp(prodesc->lanpltrusted);
+ activate_interpreter(prodesc->interp);
/*
* call perl trigger function and build TD hash
return retval;
}
+
+static bool
+validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)
+{
+ if (proc_ptr && proc_ptr->proc_ptr)
+ {
+ plperl_proc_desc *prodesc = proc_ptr->proc_ptr;
+ bool uptodate;
+
+ /************************************************************
+ * If it's present, must check whether it's still up to date.
+ * This is needed because CREATE OR REPLACE FUNCTION can modify the
+ * function's pg_proc entry without changing its OID.
+ ************************************************************/
+ uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
+ prodesc->fn_cmin == HeapTupleHeaderGetCmin(procTup->t_data));
+
+ if (uptodate)
+ return true;
+
+ /* Otherwise, unlink the obsoleted entry from the hashtable ... */
+ proc_ptr->proc_ptr = NULL;
+ /* ... and throw it away */
+ if (prodesc->reference)
+ {
+ plperl_interp_desc *oldinterp = plperl_active_interp;
+
+ activate_interpreter(prodesc->interp);
+ SvREFCNT_dec(prodesc->reference);
+ activate_interpreter(oldinterp);
+ }
+ free(prodesc->proname);
+ free(prodesc);
+ }
+
+ return false;
+}
+
+
/**********************************************************************
* compile_plperl_function - compile (or hopefully just look up) function
**********************************************************************/
{
HeapTuple procTup;
Form_pg_proc procStruct;
- char internal_proname[64];
- int proname_len;
+ plperl_proc_key proc_key;
+ plperl_proc_ptr *proc_ptr;
plperl_proc_desc *prodesc = NULL;
int i;
- plperl_proc_entry *hash_entry;
- bool found;
- bool oldcontext = trusted_context;
+ plperl_interp_desc *oldinterp = plperl_active_interp;
/* We'll need the pg_proc tuple in any case... */
procTup = SearchSysCache(PROCOID,
elog(ERROR, "cache lookup failed for function %u", fn_oid);
procStruct = (Form_pg_proc) GETSTRUCT(procTup);
- /************************************************************
- * Build our internal proc name from the functions Oid
- ************************************************************/
- if (!is_trigger)
- sprintf(internal_proname, "__PLPerl_proc_%u", fn_oid);
- else
- sprintf(internal_proname, "__PLPerl_proc_%u_trigger", fn_oid);
-
- proname_len = strlen(internal_proname);
+ /* Try to find function in plperl_proc_hash */
+ proc_key.proc_id = fn_oid;
+ proc_key.is_trigger = is_trigger;
+ proc_key.user_id = GetUserId();
- /************************************************************
- * Lookup the internal proc name in the hashtable
- ************************************************************/
- hash_entry = hash_search(plperl_proc_hash, internal_proname,
- HASH_FIND, NULL);
+ proc_ptr = hash_search(plperl_proc_hash, &proc_key,
+ HASH_FIND, NULL);
- if (hash_entry)
+ if (validate_plperl_function(proc_ptr, procTup))
+ prodesc = proc_ptr->proc_ptr;
+ else
{
- bool uptodate;
-
- prodesc = hash_entry->proc_data;
-
- /************************************************************
- * If it's present, must check whether it's still up to date.
- * This is needed because CREATE OR REPLACE FUNCTION can modify the
- * function's pg_proc entry without changing its OID.
- ************************************************************/
- uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
- prodesc->fn_cmin == HeapTupleHeaderGetCmin(procTup->t_data));
-
- if (!uptodate)
- {
- hash_search(plperl_proc_hash, internal_proname,
- HASH_REMOVE, NULL);
- if (prodesc->reference)
- {
- check_interp(prodesc->lanpltrusted);
- SvREFCNT_dec(prodesc->reference);
- restore_context(oldcontext);
- }
- free(prodesc->proname);
- free(prodesc);
- prodesc = NULL;
- }
+ /* If not found or obsolete, maybe it's plperlu */
+ proc_key.user_id = InvalidOid;
+ proc_ptr = hash_search(plperl_proc_hash, &proc_key,
+ HASH_FIND, NULL);
+ if (validate_plperl_function(proc_ptr, procTup))
+ prodesc = proc_ptr->proc_ptr;
}
/************************************************************
(errcode(ERRCODE_OUT_OF_MEMORY),
errmsg("out of memory")));
MemSet(prodesc, 0, sizeof(plperl_proc_desc));
- prodesc->proname = strdup(internal_proname);
+ prodesc->proname = strdup(NameStr(procStruct->proname));
+ if (prodesc->proname == NULL)
+ ereport(ERROR,
+ (errcode(ERRCODE_OUT_OF_MEMORY),
+ errmsg("out of memory")));
prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
prodesc->fn_cmin = HeapTupleHeaderGetCmin(procTup->t_data);
prosrcdatum));
/************************************************************
- * Create the procedure in the interpreter
+ * Create the procedure in the appropriate interpreter
************************************************************/
- check_interp(prodesc->lanpltrusted);
+ select_perl_context(prodesc->lanpltrusted);
- prodesc->reference = plperl_create_sub(proc_source, prodesc->lanpltrusted);
+ prodesc->interp = plperl_active_interp;
- restore_context(oldcontext);
+ plperl_create_sub(prodesc, proc_source, fn_oid);
+
+ activate_interpreter(oldinterp);
pfree(proc_source);
if (!prodesc->reference) /* can this happen? */
{
free(prodesc->proname);
free(prodesc);
- elog(ERROR, "could not create internal procedure \"%s\"",
- internal_proname);
+ elog(ERROR, "could not create PL/Perl internal procedure");
}
/************************************************************
- * Add the proc description block to the hashtable
+ * OK, link the procedure into the correct hashtable entry
************************************************************/
- hash_entry = hash_search(plperl_proc_hash, internal_proname,
- HASH_ENTER, &found);
- hash_entry->proc_data = prodesc;
+ proc_key.user_id = prodesc->lanpltrusted ? GetUserId() : InvalidOid;
+
+ proc_ptr = hash_search(plperl_proc_hash, &proc_key,
+ HASH_ENTER, NULL);
+ proc_ptr->proc_ptr = prodesc;
}
ReleaseSysCache(procTup);
SELECT * FROM recurse_plperl(5);
recurse_plperl
------------------------------------------------------------------------
- plperl 5 entry: 'stat' trapped by operation mask at (eval 4) line 1.
+ plperl 5 entry: 'stat' trapped by operation mask at (eval 3) line 1.
plperlu 4 entry: ok
- plperl 3 entry: 'stat' trapped by operation mask at (eval 5) line 1.
+ plperl 3 entry: 'stat' trapped by operation mask at (eval 4) line 1.
plperlu 2 entry: ok
- plperl 1 entry: 'stat' trapped by operation mask at (eval 6) line 1.
+ plperl 1 entry: 'stat' trapped by operation mask at (eval 5) line 1.
(5 rows)
recurse_plperlu
------------------------------------------------------------------------
plperlu 5 entry: ok
- plperl 4 entry: 'stat' trapped by operation mask at (eval 7) line 1.
+ plperl 4 entry: 'stat' trapped by operation mask at (eval 6) line 1.
plperlu 3 entry: ok
- plperl 2 entry: 'stat' trapped by operation mask at (eval 8) line 1.
+ plperl 2 entry: 'stat' trapped by operation mask at (eval 7) line 1.
plperlu 1 entry: ok
(5 rows)
use Errno;
$$;
select use_plperl();
-ERROR: creation of Perl function failed: Unable to load Errno.pm into plperl at (eval 9) line 2.
-BEGIN failed--compilation aborted at (eval 9) line 2.
+ERROR: creation of Perl function failed: Unable to load Errno.pm into plperl at (eval 8) line 2.
+BEGIN failed--compilation aborted at (eval 8) line 2.
select use_plperlu();
use_plperlu
-------------
use Errno;
$$;
select use_plperl();
-ERROR: creation of Perl function failed: Unable to load Errno.pm into plperl at (eval 10) line 2.
-BEGIN failed--compilation aborted at (eval 10) line 2.
+ERROR: creation of Perl function failed: Unable to load Errno.pm into plperl at (eval 9) line 2.
+BEGIN failed--compilation aborted at (eval 9) line 2.
my $fd = fileno STDERR;
$$ LANGUAGE plperl;
select perl_unsafe1();
-ERROR: creation of Perl function failed: 'fileno' trapped by operation mask at (eval 26) line 2.
+ERROR: creation of Perl function failed: 'fileno' trapped by operation mask at (eval 25) line 2.
#include "access/heapam.h"
#include "catalog/namespace.h"
-#include "catalog/pg_language.h"
#include "catalog/pg_proc.h"
#include "commands/trigger.h"
#include "executor/spi.h"
#endif /* PLTCL_UTF */
+
+/**********************************************************************
+ * Information associated with a Tcl interpreter. We have one interpreter
+ * that is used for all pltclu (untrusted) functions. For pltcl (trusted)
+ * functions, there is a separate interpreter for each effective SQL userid.
+ * (This is needed to ensure that an unprivileged user can't inject Tcl code
+ * that'll be executed with the privileges of some other SQL user.)
+ *
+ * The pltcl_interp_desc structs are kept in a Postgres hash table indexed
+ * by userid OID, with OID 0 used for the single untrusted interpreter.
+ **********************************************************************/
+typedef struct pltcl_interp_desc
+{
+ Oid user_id; /* Hash key (must be first!) */
+ Tcl_Interp *interp; /* The interpreter */
+ Tcl_HashTable query_hash; /* pltcl_query_desc structs */
+} pltcl_interp_desc;
+
+
/**********************************************************************
* The information we cache about loaded procedures
**********************************************************************/
CommandId fn_cmin;
bool fn_readonly;
bool lanpltrusted;
+ pltcl_interp_desc *interp_desc;
FmgrInfo result_in_func;
Oid result_typioparam;
int nargs;
} pltcl_query_desc;
+/**********************************************************************
+ * For speedy lookup, we maintain a hash table mapping from
+ * function OID + trigger OID + user OID to pltcl_proc_desc pointers.
+ * The reason the pltcl_proc_desc struct isn't directly part of the hash
+ * entry is to simplify recovery from errors during compile_pltcl_function.
+ *
+ * Note: if the same function is called by multiple userIDs within a session,
+ * there will be a separate pltcl_proc_desc entry for each userID in the case
+ * of pltcl functions, but only one entry for pltclu functions, because we
+ * set user_id = 0 for that case.
+ **********************************************************************/
+typedef struct pltcl_proc_key
+{
+ Oid proc_id; /* Function OID */
+ Oid trig_id; /* Trigger OID, or 0 if not trigger */
+ Oid user_id; /* User calling the function, or 0 */
+} pltcl_proc_key;
+
+typedef struct pltcl_proc_ptr
+{
+ pltcl_proc_key proc_key; /* Hash key (must be first!) */
+ pltcl_proc_desc *proc_ptr;
+} pltcl_proc_ptr;
+
+
/**********************************************************************
* Global data
**********************************************************************/
static bool pltcl_pm_init_done = false;
-static bool pltcl_be_norm_init_done = false;
-static bool pltcl_be_safe_init_done = false;
static Tcl_Interp *pltcl_hold_interp = NULL;
-static Tcl_Interp *pltcl_norm_interp = NULL;
-static Tcl_Interp *pltcl_safe_interp = NULL;
-static Tcl_HashTable *pltcl_proc_hash = NULL;
-static Tcl_HashTable *pltcl_norm_query_hash = NULL;
-static Tcl_HashTable *pltcl_safe_query_hash = NULL;
+static HTAB *pltcl_interp_htab = NULL;
+static HTAB *pltcl_proc_htab = NULL;
-/* these are saved and restored by pltcl_call_handler */
+/* these are saved and restored by pltcl_handler */
static FunctionCallInfo pltcl_current_fcinfo = NULL;
static pltcl_proc_desc *pltcl_current_prodesc = NULL;
* Forward declarations
**********************************************************************/
-static void pltcl_init_interp(Tcl_Interp *interp);
-static Tcl_Interp *pltcl_fetch_interp(bool pltrusted);
-static void pltcl_init_load_unknown(Tcl_Interp *interp);
-
Datum pltcl_call_handler(PG_FUNCTION_ARGS);
Datum pltclu_call_handler(PG_FUNCTION_ARGS);
void pltcl_init(void);
-static Datum pltcl_func_handler(PG_FUNCTION_ARGS);
+static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
+static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
+static void pltcl_init_load_unknown(Tcl_Interp *interp);
+
+static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
-static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
+static Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
+
+static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted);
static void throw_tcl_error(Tcl_Interp *interp);
-static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid);
+static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid,
+ bool pltrusted);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
void
pltcl_init(void)
{
+ HASHCTL hash_ctl;
+
/************************************************************
* Do initialization only once
************************************************************/
* stdout and stderr on DeleteInterp
************************************************************/
if ((pltcl_hold_interp = Tcl_CreateInterp()) == NULL)
- elog(ERROR, "could not create \"hold\" interpreter");
+ elog(ERROR, "could not create master Tcl interpreter");
if (Tcl_Init(pltcl_hold_interp) == TCL_ERROR)
- elog(ERROR, "could not initialize \"hold\" interpreter");
+ elog(ERROR, "could not initialize master Tcl interpreter");
/************************************************************
- * Create the two slave interpreters. Note: Tcl automatically does
- * Tcl_Init on the normal slave, and it's not wanted for the safe slave.
+ * Create the hash table for working interpreters
************************************************************/
- if ((pltcl_norm_interp =
- Tcl_CreateSlave(pltcl_hold_interp, "norm", 0)) == NULL)
- elog(ERROR, "could not create \"normal\" interpreter");
- pltcl_init_interp(pltcl_norm_interp);
-
- if ((pltcl_safe_interp =
- Tcl_CreateSlave(pltcl_hold_interp, "safe", 1)) == NULL)
- elog(ERROR, "could not create \"safe\" interpreter");
- pltcl_init_interp(pltcl_safe_interp);
+ memset(&hash_ctl, 0, sizeof(hash_ctl));
+ hash_ctl.keysize = sizeof(Oid);
+ hash_ctl.entrysize = sizeof(pltcl_interp_desc);
+ hash_ctl.hash = tag_hash;
+ pltcl_interp_htab = hash_create("PL/Tcl interpreters",
+ 8,
+ &hash_ctl,
+ HASH_ELEM | HASH_FUNCTION);
/************************************************************
- * Initialize the proc and query hash tables
+ * Create the hash table for function lookup
************************************************************/
- pltcl_proc_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
- pltcl_norm_query_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
- pltcl_safe_query_hash = (Tcl_HashTable *) malloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(pltcl_proc_hash, TCL_STRING_KEYS);
- Tcl_InitHashTable(pltcl_norm_query_hash, TCL_STRING_KEYS);
- Tcl_InitHashTable(pltcl_safe_query_hash, TCL_STRING_KEYS);
+ memset(&hash_ctl, 0, sizeof(hash_ctl));
+ hash_ctl.keysize = sizeof(pltcl_proc_key);
+ hash_ctl.entrysize = sizeof(pltcl_proc_ptr);
+ hash_ctl.hash = tag_hash;
+ pltcl_proc_htab = hash_create("PL/Tcl functions",
+ 100,
+ &hash_ctl,
+ HASH_ELEM | HASH_FUNCTION);
pltcl_pm_init_done = true;
}
/**********************************************************************
- * pltcl_init_interp() - initialize a Tcl interpreter
- *
- * The work done here must be safe to do in the postmaster process,
- * in case the pltcl library is preloaded in the postmaster. Note
- * that this is applied separately to the "normal" and "safe" interpreters.
+ * pltcl_init_interp() - initialize a new Tcl interpreter
**********************************************************************/
static void
-pltcl_init_interp(Tcl_Interp *interp)
+pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
{
+ Tcl_Interp *interp;
+ char interpname[32];
+
+ /************************************************************
+ * Create the Tcl interpreter as a slave of pltcl_hold_interp.
+ * Note: Tcl automatically does Tcl_Init in the untrusted case,
+ * and it's not wanted in the trusted case.
+ ************************************************************/
+ snprintf(interpname, sizeof(interpname), "slave_%u", interp_desc->user_id);
+ if ((interp = Tcl_CreateSlave(pltcl_hold_interp, interpname,
+ pltrusted ? 1 : 0)) == NULL)
+ elog(ERROR, "could not create slave Tcl interpreter");
+ interp_desc->interp = interp;
+
+ /************************************************************
+ * Initialize the query hash table associated with interpreter
+ ************************************************************/
+ Tcl_InitHashTable(&interp_desc->query_hash, TCL_STRING_KEYS);
+
/************************************************************
* Install the commands for SPI support in the interpreter
************************************************************/
pltcl_SPI_execute_plan, NULL, NULL);
Tcl_CreateCommand(interp, "spi_lastoid",
pltcl_SPI_lastoid, NULL, NULL);
+
+ /************************************************************
+ * Try to load the unknown procedure from pltcl_modules
+ ************************************************************/
+ pltcl_init_load_unknown(interp);
}
/**********************************************************************
* pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function
*
* This also takes care of any on-first-use initialization required.
- * The initialization work done here can't be done in the postmaster, and
- * hence is not safe to do at library load time, because it may invoke
- * arbitrary user-defined code.
* Note: we assume caller has already connected to SPI.
**********************************************************************/
-static Tcl_Interp *
+static pltcl_interp_desc *
pltcl_fetch_interp(bool pltrusted)
{
- Tcl_Interp *interp;
+ Oid user_id;
+ pltcl_interp_desc *interp_desc;
+ bool found;
- /* On first use, we try to load the unknown procedure from pltcl_modules */
+ /* Find or create the interpreter hashtable entry for this userid */
if (pltrusted)
- {
- interp = pltcl_safe_interp;
- if (!pltcl_be_safe_init_done)
- {
- pltcl_init_load_unknown(interp);
- pltcl_be_safe_init_done = true;
- }
- }
+ user_id = GetUserId();
else
- {
- interp = pltcl_norm_interp;
- if (!pltcl_be_norm_init_done)
- {
- pltcl_init_load_unknown(interp);
- pltcl_be_norm_init_done = true;
- }
- }
+ user_id = InvalidOid;
+
+ interp_desc = hash_search(pltcl_interp_htab, &user_id,
+ HASH_ENTER,
+ &found);
+ if (!found)
+ pltcl_init_interp(interp_desc, pltrusted);
- return interp;
+ return interp_desc;
}
/**********************************************************************
/* keep non-static */
Datum
pltcl_call_handler(PG_FUNCTION_ARGS)
+{
+ return pltcl_handler(fcinfo, true);
+}
+
+/*
+ * Alternative handler for unsafe functions
+ */
+PG_FUNCTION_INFO_V1(pltclu_call_handler);
+
+/* keep non-static */
+Datum
+pltclu_call_handler(PG_FUNCTION_ARGS)
+{
+ return pltcl_handler(fcinfo, false);
+}
+
+
+static Datum
+pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
Datum retval;
FunctionCallInfo save_fcinfo;
if (CALLED_AS_TRIGGER(fcinfo))
{
pltcl_current_fcinfo = NULL;
- retval = PointerGetDatum(pltcl_trigger_handler(fcinfo));
+ retval = PointerGetDatum(pltcl_trigger_handler(fcinfo, pltrusted));
}
else
{
pltcl_current_fcinfo = fcinfo;
- retval = pltcl_func_handler(fcinfo);
+ retval = pltcl_func_handler(fcinfo, pltrusted);
}
}
PG_CATCH();
}
-/*
- * Alternate handler for unsafe functions
- */
-PG_FUNCTION_INFO_V1(pltclu_call_handler);
-
-/* keep non-static */
-Datum
-pltclu_call_handler(PG_FUNCTION_ARGS)
-{
- return pltcl_call_handler(fcinfo);
-}
-
/**********************************************************************
* pltcl_func_handler() - Handler for regular function calls
**********************************************************************/
static Datum
-pltcl_func_handler(PG_FUNCTION_ARGS)
+pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
elog(ERROR, "could not connect to SPI manager");
/* Find or compile the function */
- prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid);
+ prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid, InvalidOid,
+ pltrusted);
pltcl_current_prodesc = prodesc;
- interp = pltcl_fetch_interp(prodesc->lanpltrusted);
+ interp = prodesc->interp_desc->interp;
/************************************************************
* Create the tcl command to call the internal
* pltcl_trigger_handler() - Handler for trigger calls
**********************************************************************/
static HeapTuple
-pltcl_trigger_handler(PG_FUNCTION_ARGS)
+pltcl_trigger_handler(PG_FUNCTION_ARGS, bool pltrusted)
{
pltcl_proc_desc *prodesc;
Tcl_Interp *volatile interp;
/* Find or compile the function */
prodesc = compile_pltcl_function(fcinfo->flinfo->fn_oid,
- RelationGetRelid(trigdata->tg_relation));
+ RelationGetRelid(trigdata->tg_relation),
+ pltrusted);
pltcl_current_prodesc = prodesc;
- interp = pltcl_fetch_interp(prodesc->lanpltrusted);
+ interp = prodesc->interp_desc->interp;
tupdesc = trigdata->tg_relation->rd_att;
* (InvalidOid) when compiling a plain function.
**********************************************************************/
static pltcl_proc_desc *
-compile_pltcl_function(Oid fn_oid, Oid tgreloid)
+compile_pltcl_function(Oid fn_oid, Oid tgreloid, bool pltrusted)
{
- bool is_trigger = OidIsValid(tgreloid);
HeapTuple procTup;
Form_pg_proc procStruct;
- char internal_proname[128];
- Tcl_HashEntry *hashent;
- pltcl_proc_desc *prodesc = NULL;
- Tcl_Interp *interp;
- int i;
- int hashnew;
- int tcl_rc;
+ pltcl_proc_key proc_key;
+ pltcl_proc_ptr *proc_ptr;
+ bool found;
+ pltcl_proc_desc *prodesc;
/* We'll need the pg_proc tuple in any case... */
procTup = SearchSysCache(PROCOID,
elog(ERROR, "cache lookup failed for function %u", fn_oid);
procStruct = (Form_pg_proc) GETSTRUCT(procTup);
- /************************************************************
- * Build our internal proc name from the functions Oid
- ************************************************************/
- if (!is_trigger)
- snprintf(internal_proname, sizeof(internal_proname),
- "__PLTcl_proc_%u", fn_oid);
- else
- snprintf(internal_proname, sizeof(internal_proname),
- "__PLTcl_proc_%u_trigger_%u", fn_oid, tgreloid);
+ /* Try to find function in pltcl_proc_htab */
+ proc_key.proc_id = fn_oid;
+ proc_key.trig_id = tgreloid;
+ proc_key.user_id = pltrusted ? GetUserId() : InvalidOid;
- /************************************************************
- * Lookup the internal proc name in the hashtable
- ************************************************************/
- hashent = Tcl_FindHashEntry(pltcl_proc_hash, internal_proname);
+ proc_ptr = hash_search(pltcl_proc_htab, &proc_key,
+ HASH_ENTER,
+ &found);
+ if (!found)
+ proc_ptr->proc_ptr = NULL;
+
+ prodesc = proc_ptr->proc_ptr;
/************************************************************
* If it's present, must check whether it's still up to date.
* This is needed because CREATE OR REPLACE FUNCTION can modify the
* function's pg_proc entry without changing its OID.
************************************************************/
- if (hashent != NULL)
+ if (prodesc != NULL)
{
bool uptodate;
- prodesc = (pltcl_proc_desc *) Tcl_GetHashValue(hashent);
-
uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
prodesc->fn_cmin == HeapTupleHeaderGetCmin(procTup->t_data));
if (!uptodate)
{
- Tcl_DeleteHashEntry(hashent);
- hashent = NULL;
+ proc_ptr->proc_ptr = NULL;
+ prodesc = NULL;
}
}
*
* Then we load the procedure into the Tcl interpreter.
************************************************************/
- if (hashent == NULL)
+ if (prodesc == NULL)
{
- HeapTuple langTup;
+ bool is_trigger = OidIsValid(tgreloid);
+ char internal_proname[128];
HeapTuple typeTup;
- Form_pg_language langStruct;
Form_pg_type typeStruct;
Tcl_DString proc_internal_def;
Tcl_DString proc_internal_body;
bool isnull;
char *proc_source;
char buf[32];
+ Tcl_Interp *interp;
+ int i;
+ int tcl_rc;
+
+ /************************************************************
+ * Build our internal proc name from the functions Oid + trigger Oid
+ ************************************************************/
+ if (!is_trigger)
+ snprintf(internal_proname, sizeof(internal_proname),
+ "__PLTcl_proc_%u", fn_oid);
+ else
+ snprintf(internal_proname, sizeof(internal_proname),
+ "__PLTcl_proc_%u_trigger_%u", fn_oid, tgreloid);
/************************************************************
* Allocate a new procedure description block
errmsg("out of memory")));
MemSet(prodesc, 0, sizeof(pltcl_proc_desc));
prodesc->proname = strdup(internal_proname);
+ if (prodesc->proname == NULL)
+ ereport(ERROR,
+ (errcode(ERRCODE_OUT_OF_MEMORY),
+ errmsg("out of memory")));
prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data);
prodesc->fn_cmin = HeapTupleHeaderGetCmin(procTup->t_data);
/* Remember if function is STABLE/IMMUTABLE */
prodesc->fn_readonly =
(procStruct->provolatile != PROVOLATILE_VOLATILE);
+ /* And whether it is trusted */
+ prodesc->lanpltrusted = pltrusted;
/************************************************************
- * Lookup the pg_language tuple by Oid
+ * Identify the interpreter to use for the function
************************************************************/
- langTup = SearchSysCache(LANGOID,
- ObjectIdGetDatum(procStruct->prolang),
- 0, 0, 0);
- if (!HeapTupleIsValid(langTup))
- {
- free(prodesc->proname);
- free(prodesc);
- elog(ERROR, "cache lookup failed for language %u",
- procStruct->prolang);
- }
- langStruct = (Form_pg_language) GETSTRUCT(langTup);
- prodesc->lanpltrusted = langStruct->lanpltrusted;
- ReleaseSysCache(langTup);
-
- interp = pltcl_fetch_interp(prodesc->lanpltrusted);
+ prodesc->interp_desc = pltcl_fetch_interp(prodesc->lanpltrusted);
+ interp = prodesc->interp_desc->interp;
/************************************************************
* Get the required information for input conversion of the
}
/************************************************************
- * Add the proc description block to the hashtable
+ * Add the proc description block to the hashtable. Note we do not
+ * attempt to free any previously existing prodesc block. This is
+ * annoying, but necessary since there could be active calls using
+ * the old prodesc.
************************************************************/
- hashent = Tcl_CreateHashEntry(pltcl_proc_hash,
- prodesc->proname, &hashnew);
- Tcl_SetHashValue(hashent, (ClientData) prodesc);
+ proc_ptr->proc_ptr = prodesc;
}
ReleaseSysCache(procTup);
* Insert a hashtable entry for the plan and return
* the key to the caller
************************************************************/
- if (interp == pltcl_norm_interp)
- query_hash = pltcl_norm_query_hash;
- else
- query_hash = pltcl_safe_query_hash;
+ query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
hashent = Tcl_CreateHashEntry(query_hash, qdesc->qname, &hashnew);
Tcl_SetHashValue(hashent, (ClientData) qdesc);
return TCL_ERROR;
}
- if (interp == pltcl_norm_interp)
- query_hash = pltcl_norm_query_hash;
- else
- query_hash = pltcl_safe_query_hash;
+ query_hash = &pltcl_current_prodesc->interp_desc->query_hash;
hashent = Tcl_FindHashEntry(query_hash, argv[i]);
if (hashent == NULL)
projects / users / c2main / postgres.git / commitdiff