rdelaage
/
postgresql
mirror of https://git.postgresql.org/git/postgresql.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Use a separate interpreter for each calling SQL userid in plperl and pltcl. 

There are numerous methods by which a Perl or Tcl function can subvert
the behavior of another such function executed later; for example, by
redefining standard functions or operators called by the target function.
If the target function is SECURITY DEFINER, or is called by such a
function, this means that any ordinary SQL user with Perl or Tcl language
usage rights can do essentially anything with the privileges of the target
function's owner.

To close this security hole, create a separate Perl or Tcl interpreter for
each SQL userid under which plperl or pltcl functions are executed within
a session.  However, all plperlu or pltclu functions run within a session
still share a single interpreter, since they all execute at the trust
level of a database superuser anyway.

Note: this change results in a functionality loss when libperl has been
built without the "multiplicity" option: it's no longer possible to call
plperl functions under different userids in one session, since such a
libperl can't support multiple interpreters in one process.  However, such
a libperl already failed to support concurrent use of plperl and plperlu,
so it's likely that few people use such versions with Postgres.

Security: CVE-2010-3433
This commit is contained in:
Tom Lane 2010-09-30 17:22:23 -04:00
parent ee54ffd549
commit 8d7694b0d4
9 changed files with 689 additions and 400 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/src/sgml/installation.sgml
View File

@ -170,6 +170,11 @@ su - postgres
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>

59
doc/src/sgml/plperl.sgml
View File

@ -35,7 +35,7 @@ $PostgreSQL: pgsql/doc/src/sgml/plperl.sgml,v 2.37.4.1 2010/05/13 16:44:03 aduns
<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>
@ -397,6 +397,23 @@ $$ LANGUAGE plperl;
<literal>return $_SHARED{myquote}-&gt;($_[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">
@ -460,21 +477,31 @@ $$ LANGUAGE plperl;
</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>

44
doc/src/sgml/pltcl.sgml
View File

@ -210,14 +210,36 @@ $$ LANGUAGE pltcl;
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
@ -227,7 +249,9 @@ $$ LANGUAGE pltcl;
<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>
@ -666,8 +690,8 @@ CREATE TRIGGER trig_mytab_modcount BEFORE INSERT OR UPDATE ON mytab
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

37
doc/src/sgml/release-7.4.sgml
View File

@ -37,6 +37,43 @@
<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

37
doc/src/sgml/release-8.0.sgml
View File

@ -37,6 +37,43 @@
<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

544
src/pl/plperl/plperl.c
View File

@ -49,6 +49,7 @@
#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"
@ -80,6 +81,40 @@
/* 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
@ -89,6 +124,7 @@ typedef struct plperl_proc_desc
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 */
@ -107,29 +143,15 @@ typedef struct plperl_proc_desc
* 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 PerlInterpreter *plperl_held_interp = NULL;
static OP *(*pp_require_orig) (pTHX) = NULL;
static OP *pp_require_safe(pTHX);
static bool trusted_context;
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 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;
@ -137,37 +159,63 @@ 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 */
typedef struct plperl_proc_entry
/**********************************************************************
* 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
{
char proc_name[NAMEDATALEN];
plperl_proc_desc *proc_data;
} plperl_proc_entry;
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_ptr
{
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
@ -204,24 +252,32 @@ plperl_init(void)
if (!plperl_firstcall)
return;
MemSet(&hash_ctl, 0, sizeof(hash_ctl));
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);
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(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;
}
/**********************************************************************
@ -247,17 +303,10 @@ plperl_init_all(void)
#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;
@ -269,95 +318,127 @@ set_interp_require(void)
}
}
/********************************************************************
*
* 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();
if (trusted)
plperl_trusted_interp = plperl_held_interp;
else
plperl_untrusted_interp = plperl_held_interp;
interp_state = INTERP_BOTH;
/* 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;
trusted_context = trusted;
set_interp_require();
if (trusted)
plperl_trusted_init();
else
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();
}
static void
restore_context(bool old_context)
{
if (trusted_context != old_context)
{
if (old_context)
PERL_SET_CONTEXT(plperl_trusted_interp);
if (trusted)
plperl_trusted_init();
else
PERL_SET_CONTEXT(plperl_untrusted_interp);
plperl_untrusted_init();
#else
elog(ERROR,
"cannot allocate multiple Perl interpreters on this platform");
#endif
}
trusted_context = old_context;
set_interp_require();
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
activate_interpreter(plperl_interp_desc *interp_desc)
{
if (interp_desc && plperl_active_interp != interp_desc)
{
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",
@ -425,7 +506,7 @@ plperl_init_interp(void)
* 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];
@ -434,14 +515,16 @@ plperl_init_interp(void)
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.
@ -458,18 +541,16 @@ plperl_init_interp(void)
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 (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")));
if (interp_state == INTERP_NONE)
{
SV *res;
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);
@ -479,6 +560,7 @@ plperl_init_interp(void)
PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
#endif
return plperl;
}
/*
@ -510,9 +592,11 @@ pp_require_safe(pTHX)
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;
@ -552,9 +636,9 @@ plperl_safe_init(void)
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;
@ -575,8 +659,17 @@ plperl_safe_init(void)
#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
*/
}
/*
@ -851,7 +944,7 @@ plperl_call_handler(PG_FUNCTION_ARGS)
{
Datum retval;
plperl_proc_desc *save_prodesc;
bool oldcontext = trusted_context;
plperl_interp_desc *oldinterp;
/*
* Initialize interpreter if first time through
@ -862,6 +955,7 @@ plperl_call_handler(PG_FUNCTION_ARGS)
* Ensure that static pointers are saved/restored properly
*/
save_prodesc = plperl_current_prodesc;
oldinterp = plperl_active_interp;
PG_TRY();
{
@ -877,13 +971,13 @@ plperl_call_handler(PG_FUNCTION_ARGS)
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;
}
@ -893,19 +987,13 @@ plperl_call_handler(PG_FUNCTION_ARGS)
* 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);
@ -964,7 +1052,7 @@ plperl_create_sub(char *s, bool trusted)
FREETMPS;
LEAVE;
return subref;
prodesc->reference = subref;
}
/**********************************************************************
@ -975,10 +1063,6 @@ plperl_create_sub(char *s, bool trusted)
* 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)
{
@ -1161,7 +1245,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
plperl_current_prodesc = prodesc;
check_interp(prodesc->lanpltrusted);
activate_interpreter(prodesc->interp);
/************************************************************
* Call the Perl function if not returning set
@ -1380,7 +1464,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
* Call the Perl function
************************************************************/
check_interp(prodesc->lanpltrusted);
activate_interpreter(prodesc->interp);
/*
* call perl trigger function and build TD hash
@ -1458,52 +1542,15 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
return retval;
}
/**********************************************************************
* compile_plperl_function - compile (or hopefully just look up) function
**********************************************************************/
static plperl_proc_desc *
compile_plperl_function(Oid fn_oid, bool is_trigger)
static bool
validate_plperl_function(plperl_proc_ptr *proc_ptr, HeapTuple procTup)
{
HeapTuple procTup;
Form_pg_proc procStruct;
char internal_proname[64];
int proname_len;
plperl_proc_desc *prodesc = NULL;
int i;
plperl_proc_entry *hash_entry;
bool found;
bool oldcontext = trusted_context;
/* We'll need the pg_proc tuple in any case... */
procTup = SearchSysCache(PROCOID,
ObjectIdGetDatum(fn_oid),
0, 0, 0);
if (!HeapTupleIsValid(procTup))
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);
/************************************************************
* Lookup the internal proc name in the hashtable
************************************************************/
hash_entry = hash_search(plperl_proc_hash, internal_proname,
HASH_FIND, NULL);
if (hash_entry)
if (proc_ptr && proc_ptr->proc_ptr)
{
plperl_proc_desc *prodesc = proc_ptr->proc_ptr;
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
@ -1512,20 +1559,68 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
prodesc->fn_cmin == HeapTupleHeaderGetCmin(procTup->t_data));
if (!uptodate)
if (uptodate)
return true;
/* Otherwise, unlink the obsoleted entry from the hashtable ... */
proc_ptr->proc_ptr = NULL;
/* ... and throw it away */
if (prodesc->reference)
{
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;
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
**********************************************************************/
static plperl_proc_desc *
compile_plperl_function(Oid fn_oid, bool is_trigger)
{
HeapTuple procTup;
Form_pg_proc procStruct;
plperl_proc_key proc_key;
plperl_proc_ptr *proc_ptr;
plperl_proc_desc *prodesc = NULL;
int i;
plperl_interp_desc *oldinterp = plperl_active_interp;
/* We'll need the pg_proc tuple in any case... */
procTup = SearchSysCache(PROCOID,
ObjectIdGetDatum(fn_oid),
0, 0, 0);
if (!HeapTupleIsValid(procTup))
elog(ERROR, "cache lookup failed for function %u", fn_oid);
procStruct = (Form_pg_proc) GETSTRUCT(procTup);
/* 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();
proc_ptr = hash_search(plperl_proc_hash, &proc_key,
HASH_FIND, NULL);
if (validate_plperl_function(proc_ptr, procTup))
prodesc = proc_ptr->proc_ptr;
else
{
/* 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;
}
/************************************************************
@ -1555,7 +1650,11 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
(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);
@ -1693,30 +1792,33 @@ compile_plperl_function(Oid fn_oid, bool is_trigger)
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);

18
src/pl/plperl/test/plperlu_plperl.expected
View File

@ -23,13 +23,13 @@ $$;
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)
@ -37,10 +37,10 @@ SELECT * FROM recurse_plperlu(5);
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)
@ -54,8 +54,8 @@ AS $$
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
-------------
@ -67,5 +67,5 @@ AS $$
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.

2
src/pl/plperl/test/test.expected
View File

@ -304,4 +304,4 @@ CREATE OR REPLACE FUNCTION perl_unsafe1() RETURNS void AS $$
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.

343
src/pl/tcl/pltcl.c
View File

@ -49,7 +49,6 @@
#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"
@ -108,6 +107,25 @@ utf_e2u(unsigned char *src)
#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
**********************************************************************/
@ -118,6 +136,7 @@ typedef struct pltcl_proc_desc
CommandId fn_cmin;
bool fn_readonly;
bool lanpltrusted;
pltcl_interp_desc *interp_desc;
FmgrInfo result_in_func;
Oid result_typioparam;
int nargs;
@ -141,20 +160,40 @@ typedef struct pltcl_query_desc
} 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;
@ -162,21 +201,24 @@ 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 HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
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[]);
@ -233,6 +275,8 @@ perm_fmgr_info(Oid functionId, FmgrInfo *finfo)
void
pltcl_init(void)
{
HASHCTL hash_ctl;
/************************************************************
* Do initialization only once
************************************************************/
@ -249,47 +293,62 @@ pltcl_init(void)
* 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
************************************************************/
@ -310,43 +369,39 @@ pltcl_init_interp(Tcl_Interp *interp)
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;
return interp;
interp_desc = hash_search(pltcl_interp_htab, &user_id,
HASH_ENTER,
&found);
if (!found)
pltcl_init_interp(interp_desc, pltrusted);
return interp_desc;
}
/**********************************************************************
@ -493,6 +548,25 @@ PG_FUNCTION_INFO_V1(pltcl_call_handler);
/* 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;
@ -519,12 +593,12 @@ pltcl_call_handler(PG_FUNCTION_ARGS)
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();
@ -542,23 +616,11 @@ pltcl_call_handler(PG_FUNCTION_ARGS)
}
/*
* 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;
@ -573,11 +635,12 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
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
@ -705,7 +768,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
* 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;
@ -731,11 +794,12 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
/* 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;
@ -1043,18 +1107,14 @@ throw_tcl_error(Tcl_Interp *interp)
* (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,
@ -1064,39 +1124,35 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
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;
}
}
@ -1108,11 +1164,11 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
*
* 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;
@ -1121,6 +1177,19 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
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
@ -1132,31 +1201,24 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
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
@ -1358,11 +1420,12 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
}
/************************************************************
* 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);
@ -2024,10 +2087,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
* 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);
@ -2118,10 +2178,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
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)