diff --git a/doc/src/sgml/installation.sgml b/doc/src/sgml/installation.sgml index 5c3cecd840d..d471e6da00e 100644 --- a/doc/src/sgml/installation.sgml +++ b/doc/src/sgml/installation.sgml @@ -167,6 +167,11 @@ su - postgres recent Perl 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 + PL/Perl, you should ensure that the + Perl installation was built with the + usemultiplicity option enabled (perl -V + will show whether this is the case). diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml index 864b53d67a8..d2584623b5a 100644 --- a/doc/src/sgml/plperl.sgml +++ b/doc/src/sgml/plperl.sgml @@ -41,7 +41,7 @@ Users of source packages must specially enable the build of PL/Perl during the installation process. (Refer to for more information.) Users of + linkend="installation"> for more information.) Users of binary packages might find PL/Perl in a separate subpackage. @@ -101,7 +101,7 @@ $$ LANGUAGE plperl; most convenient to use dollar quoting (see ) for the string constant. If you choose to use escape string syntax E'', - you must double the single quote marks (') and backslashes + you must double any single quote marks (') and backslashes (\) used in the body of the function (see ). @@ -829,10 +829,20 @@ $$ LANGUAGE plperl; - The %_SHARED variable and other global state within - the language are public data, available to all PL/Perl functions within a - session. Use with care, especially in situations that involve use of - multiple roles or SECURITY DEFINER functions. + 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 + %_SHARED variable and other global state. Thus, two + PL/Perl functions will share the same value of %_SHARED + 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 + SECURITY DEFINER functions, use of SET ROLE, etc) + you may need to take explicit steps to ensure that PL/Perl functions can + share data via %_SHARED. To do that, make sure that + functions that should communicate are owned by the same user, and mark + them SECURITY DEFINER. You must of course take care that + such functions can't be used to do anything unintended. @@ -908,22 +918,31 @@ $$ LANGUAGE plperl; - - For security reasons, to stop a leak of privileged operations from - PL/PerlU to 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 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 - PL/PerlU and PL/Perl in the same backend - process. The remedy for this is to obtain a Perl installation configured - with the appropriate flags, namely either usemultiplicity - or useithreads. usemultiplicity is preferred - unless you actually need to use threads. For more details, see the - perlembed man page. - + + While PL/Perl functions run in a separate Perl + interpreter for each SQL role, all PL/PerlU functions + executed in a given session run in a single Perl interpreter (which is + not any of the ones used for PL/Perl functions). + This allows PL/PerlU functions to share data freely, + but no communication can occur between PL/Perl and + PL/PerlU functions. + + + + + + Perl cannot support multiple interpreters within one process unless + it was built with the appropriate flags, namely either + usemultiplicity or useithreads. + (usemultiplicity is preferred unless you actually need + to use threads. For more details, see the + perlembed man page.) + If 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 + PL/PerlU functions, or PL/Perl functions + that are all called by the same SQL role. + @@ -1137,12 +1156,13 @@ CREATE TRIGGER test_valid_id_trig - Specifies Perl code to be executed when a Perl interpreter is first initialized - and before it is specialized for use by plperl or plperlu. - The SPI functions are not available when this code is executed. - If the code fails with an error it will abort the initialization of the interpreter - and propagate out to the calling query, causing the current transaction - or subtransaction to be aborted. + Specifies Perl code to be executed when a Perl interpreter is first + initialized, before it is specialized for use by plperl or + plperlu. + The SPI functions are not available when this code is executed. + If the code fails with an error it will abort the initialization of + the interpreter and propagate out to the calling query, causing the + current transaction or subtransaction to be aborted. The Perl code is limited to a single string. Longer code can be placed @@ -1162,9 +1182,21 @@ DO 'elog(WARNING, join ", ", sort keys %INC)' language plperl; - Initialization will happen in the postmaster if the plperl library is included - in shared_preload_libraries (see ), - in which case extra consideration should be given to the risk of destabilizing the postmaster. + Initialization will happen in the postmaster if the plperl library is + included in , in which + case extra consideration should be given to the risk of destabilizing + the postmaster. The principal reason for making use of this feature + is that Perl modules loaded by plperl.on_init need be + loaded only at postmaster start, and will be instantly available + without loading overhead in individual database sessions. However, + keep in mind that the overhead is avoided only for the first Perl + interpreter used by a database session — either PL/PerlU, or + PL/Perl for the first SQL role that calls a PL/Perl function. Any + additional Perl interpreters created in a database session will have + to execute plperl.on_init afresh. Also, on Windows there + will be no savings whatsoever from preloading, since the Perl + interpreter created in the postmaster process does not propagate to + child processes. This parameter can only be set in the postgresql.conf file or on the server command line. @@ -1183,41 +1215,30 @@ DO 'elog(WARNING, join ", ", sort keys %INC)' language plperl; - These parameters specify Perl code to be executed when the - plperl, or plperlu language is first used in a - session. Changes to these parameters after the corresponding language - has been used will have no effect. - The SPI functions are not available when this code is executed. - Only superusers can change these settings. - The Perl code in plperl.on_plperl_init can only perform trusted operations. + These parameters specify Perl code to be executed when a Perl + interpreter is specialized for plperl or + plperlu respectively. This will happen when a PL/Perl or + PL/PerlU function is first executed in a database session, or when + an additional interpreter has to be created because the other language + is called or a PL/Perl function is called by a new SQL role. This + follows any initialization done by plperl.on_init. + The SPI functions are not available when this code is executed. + The Perl code in plperl.on_plperl_init is executed after + locking down the interpreter, and thus it can only perform + trusted operations. - The effect of setting these parameters is very similar to executing a - DO command with the Perl code before any other use of the - language. The parameters are useful when you want to execute the Perl - code automatically on every connection, or when a connection is not - interactive. The parameters can be used by non-superusers by having a - superuser execute an ALTER USER ... SET ... command. - For example: - -ALTER USER joe SET plperl.on_plperl_init = '$_SHARED{debug} = 1'; - + If the code fails with an error it will abort the initialization and + propagate out to the calling query, causing the current transaction or + subtransaction to be aborted. Any actions already done within Perl + won't be undone; however, that interpreter won't be used again. + If the language is used again the initialization will be attempted + again within a fresh Perl interpreter. - If the code fails with an error it will abort the initialization and - propagate out to the calling query, causing the current transaction or - subtransaction to be aborted. Any changes within Perl won't be undone. - If the language is used again the initialization will be repeated. - - - The difference between these two settings and the - plperl.on_init setting is that these can be used for - settings specific to the trusted or untrusted language variant, such - as setting values in the %_SHARED variable. By contrast, - plperl.on_init is more useful for doing things like - setting the library search path for Perl or - loading Perl modules that don't interact directly with - PostgreSQL. + Only superusers can change these settings. Although these settings + can be changed within a session, such changes will not affect Perl + interpreters that have already been used to execute functions. @@ -1229,8 +1250,9 @@ ALTER USER joe SET plperl.on_plperl_init = '$_SHARED{debug} = 1'; - When set true subsequent compilations of PL/Perl functions have the strict pragma enabled. - This parameter does not affect functions already compiled in the current session. + When set true subsequent compilations of PL/Perl functions will have + the strict pragma enabled. This parameter does not affect + functions already compiled in the current session. diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml index eb29a8fd036..326c757e432 100644 --- a/doc/src/sgml/pltcl.sgml +++ b/doc/src/sgml/pltcl.sgml @@ -214,14 +214,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 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. + + + 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 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 SECURITY + DEFINER functions, use of 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 SECURITY DEFINER. You must of + course take care that such functions can't be used to do anything + unintended. + + + + 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. + + To help protect PL/Tcl functions from unintentionally interfering with each other, a global @@ -231,7 +253,9 @@ $$ LANGUAGE pltcl; 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 GD arrays are only + global within a particular interpreter, so they do not bypass the + security restrictions mentioned above.) @@ -691,8 +715,8 @@ CREATE TRIGGER trig_mytab_modcount BEFORE INSERT OR UPDATE ON mytab exists, the module 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 .) While the unknown module could actually contain any diff --git a/doc/src/sgml/release-7.4.sgml b/doc/src/sgml/release-7.4.sgml index 2c52be70064..226275bf320 100644 --- a/doc/src/sgml/release-7.4.sgml +++ b/doc/src/sgml/release-7.4.sgml @@ -37,6 +37,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Prevent possible crashes in pg_get_expr() by disallowing diff --git a/doc/src/sgml/release-8.0.sgml b/doc/src/sgml/release-8.0.sgml index ae2b3c04cf7..f35cb61f419 100644 --- a/doc/src/sgml/release-8.0.sgml +++ b/doc/src/sgml/release-8.0.sgml @@ -37,6 +37,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Prevent possible crashes in pg_get_expr() by disallowing diff --git a/doc/src/sgml/release-8.1.sgml b/doc/src/sgml/release-8.1.sgml index 37e3751c0e1..34b3022d05d 100644 --- a/doc/src/sgml/release-8.1.sgml +++ b/doc/src/sgml/release-8.1.sgml @@ -37,6 +37,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Prevent possible crashes in pg_get_expr() by disallowing diff --git a/doc/src/sgml/release-8.2.sgml b/doc/src/sgml/release-8.2.sgml index f4b0056f6f8..89431c31f4f 100644 --- a/doc/src/sgml/release-8.2.sgml +++ b/doc/src/sgml/release-8.2.sgml @@ -31,6 +31,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Prevent possible crashes in pg_get_expr() by disallowing diff --git a/doc/src/sgml/release-8.3.sgml b/doc/src/sgml/release-8.3.sgml index eac868f3f15..0f4d44f9c5a 100644 --- a/doc/src/sgml/release-8.3.sgml +++ b/doc/src/sgml/release-8.3.sgml @@ -31,6 +31,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Prevent possible crashes in pg_get_expr() by disallowing diff --git a/doc/src/sgml/release-8.4.sgml b/doc/src/sgml/release-8.4.sgml index 9ff4610ccfa..f426023896e 100644 --- a/doc/src/sgml/release-8.4.sgml +++ b/doc/src/sgml/release-8.4.sgml @@ -31,6 +31,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Prevent possible crashes in pg_get_expr() by disallowing diff --git a/doc/src/sgml/release-9.0.sgml b/doc/src/sgml/release-9.0.sgml index 4d2fef797e8..67bfa558d7f 100644 --- a/doc/src/sgml/release-9.0.sgml +++ b/doc/src/sgml/release-9.0.sgml @@ -29,6 +29,43 @@ + + + Use a separate interpreter for each calling SQL userid in PL/Perl and + PL/Tcl (Tom Lane) + + + + 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 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. + + + + 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. + + + + 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. + + + + Our thanks to Tim Bunce for pointing out this issue (CVE-2010-3433). + + + Improve pg_get_expr() security fix so that the function diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c index cfad4878aa3..b4ced1ce8d4 100644 --- a/src/pl/plperl/plperl.c +++ b/src/pl/plperl/plperl.c @@ -49,8 +49,45 @@ /* defines PLPERL_SET_OPMASK */ #include "plperl_opmask.h" +EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); +EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv); +EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv); + PG_MODULE_MAGIC; + +/********************************************************************** + * 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 */ + HTAB *query_hash; /* plperl_query_entry structs */ +} plperl_interp_desc; + + /********************************************************************** * The information we cache about loaded procedures **********************************************************************/ @@ -59,6 +96,7 @@ typedef struct plperl_proc_desc char *proname; /* user name of procedure */ TransactionId fn_xmin; ItemPointerData fn_tid; + plperl_interp_desc *interp; /* interpreter it's created in */ bool fn_readonly; bool lanpltrusted; bool fn_retistuple; /* true, if function returns tuple */ @@ -73,14 +111,35 @@ typedef struct plperl_proc_desc SV *reference; } plperl_proc_desc; -/* 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]; /* internal name, eg - * __PLPerl_proc_39987 */ - 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; /* * The information we cache for the duration of a single call to a @@ -101,7 +160,7 @@ typedef struct plperl_call_data **********************************************************************/ typedef struct plperl_query_desc { - char qname[20]; + char qname[24]; void *plan; int nargs; Oid *argtypes; @@ -121,33 +180,21 @@ typedef struct plperl_query_entry * Global data **********************************************************************/ -typedef enum -{ - INTERP_NONE, - INTERP_HELD, - INTERP_TRUSTED, - INTERP_UNTRUSTED, - INTERP_BOTH -} InterpState; - -static InterpState interp_state = INTERP_NONE; - -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 HTAB *plperl_interp_hash = NULL; static HTAB *plperl_proc_hash = NULL; -static HTAB *plperl_query_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; +/* GUC variables */ static bool plperl_use_strict = false; static char *plperl_on_init = NULL; static char *plperl_on_plperl_init = NULL; static char *plperl_on_plperlu_init = NULL; + static bool plperl_ending = false; +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_call_data *current_call_data = NULL; @@ -163,6 +210,7 @@ void _PG_init(void); static PerlInterpreter *plperl_init_interp(void); static void plperl_destroy_interp(PerlInterpreter **); static void plperl_fini(int code, Datum arg); +static void set_interp_require(bool trusted); static Datum plperl_func_handler(PG_FUNCTION_ARGS); static Datum plperl_trigger_handler(PG_FUNCTION_ARGS); @@ -184,7 +232,7 @@ static void plperl_exec_callback(void *arg); static void plperl_inline_callback(void *arg); static char *strip_trailing_ws(const char *msg); static OP *pp_require_safe(pTHX); -static int restore_context(bool); +static void activate_interpreter(plperl_interp_desc *interp_desc); #ifdef WIN32 static char *setlocale_perl(int category, char *locale); @@ -251,8 +299,14 @@ _PG_init(void) if (inited) return; + /* + * Support localized messages. + */ pg_bindtextdomain(TEXTDOMAIN); + /* + * Initialize plperl's GUCs. + */ DefineCustomBoolVariable("plperl.use_strict", gettext_noop("If true, trusted and untrusted Perl code will be compiled in strict mode."), NULL, @@ -261,6 +315,12 @@ _PG_init(void) PGC_USERSET, 0, NULL, NULL); + /* + * plperl.on_init is marked PGC_SIGHUP to support the idea that it might + * be executed in the postmaster (if plperl is loaded into the postmaster + * via shared_preload_libraries). This isn't really right either way, + * though. + */ DefineCustomStringVariable("plperl.on_init", gettext_noop("Perl initialization code to execute when a Perl interpreter is initialized."), NULL, @@ -270,13 +330,18 @@ _PG_init(void) NULL, NULL); /* - * plperl.on_plperl_init is currently PGC_SUSET to avoid issues whereby a - * user who doesn't have USAGE privileges on the plperl language could - * possibly use SET plperl.on_plperl_init='...' to influence the behaviour - * of any existing plperl function that they can EXECUTE (which may be - * security definer). Set + * plperl.on_plperl_init is marked PGC_SUSET to avoid issues whereby a + * user who might not even have USAGE privilege on the plperl language + * could nonetheless use SET plperl.on_plperl_init='...' to influence the + * behaviour of any existing plperl function that they can execute (which + * might be SECURITY DEFINER, leading to a privilege escalation). See * http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php and * the overall thread. + * + * Note that because plperl.use_strict is USERSET, a nefarious user could + * set it to be applied against other people's functions. This is judged + * OK since the worst result would be an error. Your code oughta pass + * use_strict anyway ;-) */ DefineCustomStringVariable("plperl.on_plperl_init", gettext_noop("Perl initialization code to execute once when plperl is first used."), @@ -296,35 +361,45 @@ _PG_init(void) EmitWarningsOnPlaceholders("plperl"); - MemSet(&hash_ctl, 0, sizeof(hash_ctl)); + /* + * Create hash tables. + */ + memset(&hash_ctl, 0, sizeof(hash_ctl)); + hash_ctl.keysize = sizeof(Oid); + hash_ctl.entrysize = sizeof(plperl_interp_desc); + hash_ctl.hash = oid_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_ctl.entrysize = sizeof(plperl_query_entry); - plperl_query_hash = hash_create("PLPerl Queries", - 32, - &hash_ctl, - HASH_ELEM); + HASH_ELEM | HASH_FUNCTION); + /* + * Save the default opmask. + */ PLPERL_SET_OPMASK(plperl_opmask); + /* + * Create the first Perl interpreter, but only partially initialize it. + */ plperl_held_interp = plperl_init_interp(); - interp_state = INTERP_HELD; inited = true; } 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; @@ -343,6 +418,9 @@ set_interp_require(void) static void plperl_fini(int code, Datum arg) { + HASH_SEQ_STATUS hash_seq; + plperl_interp_desc *interp_desc; + elog(DEBUG3, "plperl_fini"); /* @@ -360,91 +438,129 @@ plperl_fini(int code, Datum arg) return; } - plperl_destroy_interp(&plperl_trusted_interp); - plperl_destroy_interp(&plperl_untrusted_interp); + /* Zap the "held" interpreter, if we still have it */ plperl_destroy_interp(&plperl_held_interp); + /* Zap any fully-initialized interpreters */ + hash_seq_init(&hash_seq, plperl_interp_hash); + while ((interp_desc = hash_seq_search(&hash_seq)) != NULL) + { + if (interp_desc->interp) + { + activate_interpreter(interp_desc); + plperl_destroy_interp(&interp_desc->interp); + } + } + elog(DEBUG3, "plperl_fini: done"); } -/******************************************************************** - * - * 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. +/* + * Select and activate an appropriate Perl interpreter. */ - - static void select_perl_context(bool trusted) { - EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv); + 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) + { + /* Initialize newly-created hashtable entry */ + interp_desc->interp = NULL; + interp_desc->query_hash = NULL; + } + + /* Make sure we have a query_hash for this interpreter */ + if (interp_desc->query_hash == NULL) + { + HASHCTL hash_ctl; + + memset(&hash_ctl, 0, sizeof(hash_ctl)); + hash_ctl.keysize = NAMEDATALEN; + hash_ctl.entrysize = sizeof(plperl_query_entry); + interp_desc->query_hash = hash_create("PL/Perl queries", + 32, + &hash_ctl, + HASH_ELEM); + } /* - * handle simple cases + * Quick exit if already have an interpreter */ - if (restore_context(trusted)) + if (interp_desc->interp) + { + activate_interpreter(interp_desc); return; + } /* * adopt held interp if free, else create new one if possible */ - if (interp_state == INTERP_HELD) + if (plperl_held_interp != NULL) { /* 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_init(); - plperl_trusted_interp = plperl_held_interp; - interp_state = INTERP_TRUSTED; - } else - { plperl_untrusted_init(); - plperl_untrusted_interp = plperl_held_interp; - interp_state = INTERP_UNTRUSTED; - } /* successfully initialized, so arrange for cleanup */ on_proc_exit(plperl_fini, 0); - } else { #ifdef MULTIPLICITY - PerlInterpreter *plperl = plperl_init_interp(); + /* + * 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(); - plperl_trusted_interp = plperl; - } else - { plperl_untrusted_init(); - plperl_untrusted_interp = plperl; - } - interp_state = INTERP_BOTH; #else elog(ERROR, - "cannot allocate second Perl interpreter on this platform"); + "cannot allocate multiple Perl interpreters on this platform"); #endif } - plperl_held_interp = NULL; - trusted_context = trusted; - set_interp_require(); + + set_interp_require(trusted); /* * Since the timing of first use of PL/Perl can't be predicted, any * database interaction during initialization is problematic. Including, * but not limited to, security definer issues. So we only enable access * to the database AFTER on_*_init code has run. See - * http://archives.postgresql.org/message-id/20100127143318.GE713@timac.loc - * al + * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02669.php */ newXS("PostgreSQL::InServer::SPI::bootstrap", boot_PostgreSQL__InServer__SPI, __FILE__); @@ -454,35 +570,41 @@ select_perl_context(bool trusted) ereport(ERROR, (errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))), errcontext("while executing PostgreSQL::InServer::SPI::bootstrap"))); + + /* Fully initialized, so mark the hashtable entry valid */ + interp_desc->interp = interp; + + /* And mark this as the active interpreter */ + plperl_active_interp = interp_desc; } /* - * Restore previous interpreter selection, if two are active + * 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 int -restore_context(bool trusted) +static void +activate_interpreter(plperl_interp_desc *interp_desc) { - if (interp_state == INTERP_BOTH || - (trusted && interp_state == INTERP_TRUSTED) || - (!trusted && interp_state == INTERP_UNTRUSTED)) + if (interp_desc && plperl_active_interp != interp_desc) { - 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(); - } - return 1; /* context restored */ + 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; } - - return 0; /* unable - appropriate interpreter not - * available */ } +/* + * 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) { @@ -538,17 +660,17 @@ plperl_init_interp(void) STMT_START { \ if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \ } STMT_END -#endif +#endif /* WIN32 */ - if (plperl_on_init) + if (plperl_on_init && *plperl_on_init) { embedding[nargs++] = "-e"; embedding[nargs++] = plperl_on_init; } - /**** + /* * The perl API docs state that PERL_SYS_INIT3 should be called before - * allocating interprters. Unfortunately, on some platforms this fails + * allocating interpreters. Unfortunately, on some platforms this fails * in the Perl_do_taint() routine, which is called when the platform is * using the system's malloc() instead of perl's own. Other platforms, * notably Windows, fail if PERL_SYS_INIT3 is not called. So we call it @@ -655,6 +777,11 @@ pp_require_safe(pTHX) } +/* + * Destroy one Perl interpreter ... actually we just run END blocks. + * + * Caller must have ensured this interpreter is the active one. + */ static void plperl_destroy_interp(PerlInterpreter **interp) { @@ -671,8 +798,6 @@ plperl_destroy_interp(PerlInterpreter **interp) * be used to perform manual cleanup. */ - PERL_SET_CONTEXT(*interp); - /* Run END blocks - based on perl's perl_destruct() */ if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) { @@ -692,7 +817,9 @@ plperl_destroy_interp(PerlInterpreter **interp) } } - +/* + * Initialize the current Perl interpreter as a trusted interp + */ static void plperl_trusted_init(void) { @@ -770,9 +897,15 @@ plperl_trusted_init(void) } +/* + * Initialize the current Perl interpreter as an untrusted interp + */ static void plperl_untrusted_init(void) { + /* + * Nothing to do except execute plperl.on_plperlu_init + */ if (plperl_on_plperlu_init && *plperl_on_plperlu_init) { eval_pv(plperl_on_plperlu_init, FALSE); @@ -1077,7 +1210,7 @@ plperl_call_handler(PG_FUNCTION_ARGS) { Datum retval; plperl_call_data *save_call_data = current_call_data; - bool oldcontext = trusted_context; + plperl_interp_desc *oldinterp = plperl_active_interp; PG_TRY(); { @@ -1089,13 +1222,13 @@ plperl_call_handler(PG_FUNCTION_ARGS) PG_CATCH(); { current_call_data = save_call_data; - restore_context(oldcontext); + activate_interpreter(oldinterp); PG_RE_THROW(); } PG_END_TRY(); current_call_data = save_call_data; - restore_context(oldcontext); + activate_interpreter(oldinterp); return retval; } @@ -1112,7 +1245,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS) FmgrInfo flinfo; plperl_proc_desc desc; plperl_call_data *save_call_data = current_call_data; - bool oldcontext = trusted_context; + plperl_interp_desc *oldinterp = plperl_active_interp; ErrorContextCallback pl_error_context; /* Set up a callback for error reporting */ @@ -1175,7 +1308,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS) if (desc.reference) SvREFCNT_dec(desc.reference); current_call_data = save_call_data; - restore_context(oldcontext); + activate_interpreter(oldinterp); PG_RE_THROW(); } PG_END_TRY(); @@ -1184,7 +1317,7 @@ plperl_inline_handler(PG_FUNCTION_ARGS) SvREFCNT_dec(desc.reference); current_call_data = save_call_data; - restore_context(oldcontext); + activate_interpreter(oldinterp); error_context_stack = pl_error_context.previous; @@ -1336,8 +1469,6 @@ static void plperl_init_shared_libs(pTHX) { char *file = __FILE__; - EXTERN_C void boot_DynaLoader(pTHX_ CV *cv); - EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv); newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); newXS("PostgreSQL::InServer::Util::bootstrap", @@ -1535,7 +1666,7 @@ plperl_func_handler(PG_FUNCTION_ARGS) "cannot accept a set"))); } - select_perl_context(prodesc->lanpltrusted); + activate_interpreter(prodesc->interp); perlret = plperl_call_perl_func(prodesc, fcinfo); @@ -1682,7 +1813,7 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) pl_error_context.arg = prodesc->proname; error_context_stack = &pl_error_context; - select_perl_context(prodesc->lanpltrusted); + activate_interpreter(prodesc->interp); svTD = plperl_trigger_build_args(fcinfo); perlret = plperl_call_perl_trigger_func(prodesc, fcinfo, svTD); @@ -1762,17 +1893,54 @@ plperl_trigger_handler(PG_FUNCTION_ARGS) } +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) && + ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self)); + + 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; +} + + static plperl_proc_desc * compile_plperl_function(Oid fn_oid, bool is_trigger) { HeapTuple procTup; Form_pg_proc procStruct; - char internal_proname[NAMEDATALEN]; + 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; ErrorContextCallback plperl_error_context; /* We'll need the pg_proc tuple in any case... */ @@ -1787,48 +1955,24 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) plperl_error_context.arg = NameStr(procStruct->proname); error_context_stack = &plperl_error_context; - /************************************************************ - * Build our internal proc name from the function's Oid - ************************************************************/ - if (!is_trigger) - sprintf(internal_proname, "__PLPerl_proc_%u", fn_oid); + /* 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 - sprintf(internal_proname, "__PLPerl_proc_%u_trigger", fn_oid); - - /************************************************************ - * Lookup the internal proc name in the hashtable - ************************************************************/ - hash_entry = hash_search(plperl_proc_hash, internal_proname, - HASH_FIND, NULL); - - if (hash_entry) { - 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) && - ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self)); - - if (!uptodate) - { - hash_search(plperl_proc_hash, internal_proname, - HASH_REMOVE, NULL); - if (prodesc->reference) - { - select_perl_context(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; } /************************************************************ @@ -1859,6 +2003,10 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) errmsg("out of memory"))); MemSet(prodesc, 0, sizeof(plperl_proc_desc)); 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_tid = procTup->t_self; @@ -1996,27 +2144,33 @@ compile_plperl_function(Oid fn_oid, bool is_trigger) proc_source = TextDatumGetCString(prosrcdatum); /************************************************************ - * Create the procedure in the interpreter + * Create the procedure in the appropriate interpreter ************************************************************/ select_perl_context(prodesc->lanpltrusted); + prodesc->interp = plperl_active_interp; + plperl_create_sub(prodesc, proc_source, fn_oid); - restore_context(oldcontext); + 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"); } - hash_entry = hash_search(plperl_proc_hash, internal_proname, - HASH_ENTER, &found); - hash_entry->proc_data = prodesc; + /************************************************************ + * OK, link the procedure into the correct hashtable entry + ************************************************************/ + 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; } /* restore previous error callback */ @@ -2636,7 +2790,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv) * the key to the caller. ************************************************************/ - hash_entry = hash_search(plperl_query_hash, qdesc->qname, + hash_entry = hash_search(plperl_active_interp->query_hash, qdesc->qname, HASH_ENTER, &found); hash_entry->query_data = qdesc; @@ -2675,7 +2829,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) * Fetch the saved plan descriptor, see if it's o.k. ************************************************************/ - hash_entry = hash_search(plperl_query_hash, query, + hash_entry = hash_search(plperl_active_interp->query_hash, query, HASH_FIND, NULL); if (hash_entry == NULL) elog(ERROR, "spi_exec_prepared: Invalid prepared query passed"); @@ -2683,7 +2837,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv) qdesc = hash_entry->query_data; if (qdesc == NULL) - elog(ERROR, "spi_exec_prepared: panic - plperl_query_hash value vanished"); + elog(ERROR, "spi_exec_prepared: panic - plperl query_hash value vanished"); if (qdesc->nargs != argc) elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed", @@ -2818,7 +2972,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) /************************************************************ * Fetch the saved plan descriptor, see if it's o.k. ************************************************************/ - hash_entry = hash_search(plperl_query_hash, query, + hash_entry = hash_search(plperl_active_interp->query_hash, query, HASH_FIND, NULL); if (hash_entry == NULL) elog(ERROR, "spi_exec_prepared: Invalid prepared query passed"); @@ -2826,7 +2980,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv) qdesc = hash_entry->query_data; if (qdesc == NULL) - elog(ERROR, "spi_query_prepared: panic - plperl_query_hash value vanished"); + elog(ERROR, "spi_query_prepared: panic - plperl query_hash value vanished"); if (qdesc->nargs != argc) elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed", @@ -2934,7 +3088,7 @@ plperl_spi_freeplan(char *query) check_spi_usage_allowed(); - hash_entry = hash_search(plperl_query_hash, query, + hash_entry = hash_search(plperl_active_interp->query_hash, query, HASH_FIND, NULL); if (hash_entry == NULL) elog(ERROR, "spi_exec_prepared: Invalid prepared query passed"); @@ -2942,13 +3096,13 @@ plperl_spi_freeplan(char *query) qdesc = hash_entry->query_data; if (qdesc == NULL) - elog(ERROR, "spi_exec_freeplan: panic - plperl_query_hash value vanished"); + elog(ERROR, "spi_exec_freeplan: panic - plperl query_hash value vanished"); /* * free all memory before SPI_freeplan, so if it dies, nothing will be * left over */ - hash_search(plperl_query_hash, query, + hash_search(plperl_active_interp->query_hash, query, HASH_REMOVE, NULL); plan = qdesc->plan; diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index 8c94c826c99..1c45751d8b3 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -19,7 +19,6 @@ #endif #include "access/xact.h" -#include "catalog/pg_language.h" #include "catalog/pg_proc.h" #include "catalog/pg_type.h" #include "commands/trigger.h" @@ -83,6 +82,25 @@ utf_e2u(unsigned char *src) PG_MODULE_MAGIC; + +/********************************************************************** + * 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 **********************************************************************/ @@ -94,6 +112,7 @@ typedef struct pltcl_proc_desc ItemPointerData fn_tid; bool fn_readonly; bool lanpltrusted; + pltcl_interp_desc *interp_desc; FmgrInfo result_in_func; Oid result_typioparam; int nargs; @@ -116,20 +135,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; @@ -140,17 +179,20 @@ Datum pltcl_call_handler(PG_FUNCTION_ARGS); Datum pltclu_call_handler(PG_FUNCTION_ARGS); void _PG_init(void); -static void pltcl_init_interp(Tcl_Interp *interp); -static Tcl_Interp *pltcl_fetch_interp(bool pltrusted); +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_func_handler(PG_FUNCTION_ARGS); +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, const char *proname); -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[]); @@ -264,10 +306,15 @@ perm_fmgr_info(Oid functionId, FmgrInfo *finfo) * _PG_init() - library load-time initialization * * DO NOT make this static nor change its name! + * + * The work done here must be safe to do in the postmaster process, + * in case the pltcl library is preloaded in the postmaster. */ void _PG_init(void) { + HASHCTL hash_ctl; + /* Be sure we do initialization only once (should be redundant now) */ if (pltcl_pm_init_done) return; @@ -304,47 +351,62 @@ _PG_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 = oid_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 ************************************************************/ @@ -365,43 +427,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; } /********************************************************************** @@ -532,6 +590,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; @@ -552,12 +629,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(); @@ -575,23 +652,11 @@ pltcl_call_handler(PG_FUNCTION_ARGS) } -/* - * Alternative 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; @@ -606,11 +671,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 @@ -738,7 +804,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; @@ -764,11 +830,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; @@ -1086,18 +1153,14 @@ throw_tcl_error(Tcl_Interp *interp, const char *proname) * (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 = SearchSysCache1(PROCOID, ObjectIdGetDatum(fn_oid)); @@ -1105,39 +1168,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) && ItemPointerEquals(&prodesc->fn_tid, &procTup->t_self)); if (!uptodate) { - Tcl_DeleteHashEntry(hashent); - hashent = NULL; + proc_ptr->proc_ptr = NULL; + prodesc = NULL; } } @@ -1149,11 +1208,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; @@ -1162,6 +1221,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 @@ -1174,31 +1246,24 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid) MemSet(prodesc, 0, sizeof(pltcl_proc_desc)); prodesc->user_proname = strdup(NameStr(procStruct->proname)); prodesc->internal_proname = strdup(internal_proname); + if (prodesc->user_proname == NULL || prodesc->internal_proname == NULL) + ereport(ERROR, + (errcode(ERRCODE_OUT_OF_MEMORY), + errmsg("out of memory"))); prodesc->fn_xmin = HeapTupleHeaderGetXmin(procTup->t_data); prodesc->fn_tid = procTup->t_self; /* 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 = SearchSysCache1(LANGOID, - ObjectIdGetDatum(procStruct->prolang)); - if (!HeapTupleIsValid(langTup)) - { - free(prodesc->user_proname); - free(prodesc->internal_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 @@ -1404,11 +1469,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->internal_proname, &hashnew); - Tcl_SetHashValue(hashent, (ClientData) prodesc); + proc_ptr->proc_ptr = prodesc; } ReleaseSysCache(procTup); @@ -2064,10 +2130,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); @@ -2158,10 +2221,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)