diff --git a/doc/src/sgml/installation.sgml b/doc/src/sgml/installation.sgml
index 5c3cecd840df48c2ecead3632d8f4b2ea51a4dfb..d471e6da00ec287b47922af2073d8f6f1d98bfda 100644
--- a/doc/src/sgml/installation.sgml
+++ b/doc/src/sgml/installation.sgml
@@ -167,6 +167,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>
diff --git a/doc/src/sgml/plperl.sgml b/doc/src/sgml/plperl.sgml
index 864b53d67a8fd1453231ea3c9a4ba93b3c5ef341..d2584623b5a966d2d37c071f2259694e9a31a679 100644
--- a/doc/src/sgml/plperl.sgml
+++ b/doc/src/sgml/plperl.sgml
@@ -41,7 +41,7 @@
<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>
@@ -101,7 +101,7 @@ $$ LANGUAGE plperl;
most convenient to use dollar quoting (see <xref
linkend="sql-syntax-dollar-quoting">) for the string constant.
If you choose to use escape string syntax <literal>E''</>,
- you must double the single quote marks (<literal>'</>) and backslashes
+ you must double any single quote marks (<literal>'</>) and backslashes
(<literal>\</>) used in the body of the function
(see <xref linkend="sql-syntax-strings">).
</para>
@@ -829,10 +829,20 @@ $$ LANGUAGE plperl;
</para>
<para>
- The <varname>%_SHARED</varname> 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 <literal>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
+ <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>
@@ -908,22 +918,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 configured
- 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.
- </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>
@@ -1137,12 +1156,13 @@ CREATE TRIGGER test_valid_id_trig
</indexterm>
<listitem>
<para>
- Specifies Perl code to be executed when a Perl interpreter is first initialized
- and before it is specialized for use by <literal>plperl</> or <literal>plperlu</>.
- The SPI functions are not available when this code is executed.
- If the code fails with an error it will abort the initialization of the interpreter
- and propagate out to the calling query, causing the current transaction
- or subtransaction to be aborted.
+ Specifies Perl code to be executed when a Perl interpreter is first
+ initialized, before it is specialized for use by <literal>plperl</> or
+ <literal>plperlu</>.
+ The SPI functions are not available when this code is executed.
+ If the code fails with an error it will abort the initialization of
+ the interpreter and propagate out to the calling query, causing the
+ current transaction or subtransaction to be aborted.
</para>
<para>
The Perl code is limited to a single string. Longer code can be placed
@@ -1162,9 +1182,21 @@ DO 'elog(WARNING, join ", ", sort keys %INC)' language plperl;
</programlisting>
</para>
<para>
- Initialization will happen in the postmaster if the plperl library is included
- in <literal>shared_preload_libraries</> (see <xref linkend="guc-shared-preload-libraries">),
- 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 <xref linkend="guc-shared-preload-libraries">, 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 <literal>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 <literal>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.
</para>
<para>
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;
</indexterm>
<listitem>
<para>
- These parameters specify Perl code to be executed when the
- <literal>plperl</>, or <literal>plperlu</> language is first used in a
- session. Changes to these parameters after the corresponding language
- has been used will have no effect.
- The SPI functions are not available when this code is executed.
- Only superusers can change these settings.
- The Perl code in <literal>plperl.on_plperl_init</> can only perform trusted operations.
- </para>
- <para>
- The effect of setting these parameters is very similar to executing a
- <literal>DO</> command with the Perl code before any other use of the
- language. The parameters are useful when you want to execute the Perl
- code automatically on every connection, or when a connection is not
- interactive. The parameters can be used by non-superusers by having a
- superuser execute an <literal>ALTER USER ... SET ...</> command.
- For example:
-<programlisting>
-ALTER USER joe SET plperl.on_plperl_init = '$_SHARED{debug} = 1';
-</programlisting>
+ These parameters specify Perl code to be executed when a Perl
+ interpreter is specialized for <literal>plperl</> or
+ <literal>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 <literal>plperl.on_init</>.
+ The SPI functions are not available when this code is executed.
+ The Perl code in <literal>plperl.on_plperl_init</> is executed after
+ <quote>locking down</> the interpreter, and thus it can only perform
+ trusted operations.
</para>
<para>
- If the code fails with an error it will abort the initialization and
- propagate out to the calling query, causing the current transaction or
- subtransaction to be aborted. Any changes within Perl won't be undone.
- If the language is used again the initialization will be repeated.
+ 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.
</para>
<para>
- The difference between these two settings and the
- <literal>plperl.on_init</> setting is that these can be used for
- settings specific to the trusted or untrusted language variant, such
- as setting values in the <varname>%_SHARED</> variable. By contrast,
- <literal>plperl.on_init</> is more useful for doing things like
- setting the library search path for <productname>Perl</> or
- loading Perl modules that don't interact directly with
- <productname>PostgreSQL</>.
+ 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.
</para>
</listitem>
</varlistentry>
@@ -1229,8 +1250,9 @@ ALTER USER joe SET plperl.on_plperl_init = '$_SHARED{debug} = 1';
</indexterm>
<listitem>
<para>
- When set true subsequent compilations of PL/Perl functions have the <literal>strict</> pragma enabled.
- This parameter does not affect functions already compiled in the current session.
+ When set true subsequent compilations of PL/Perl functions will have
+ the <literal>strict</> pragma enabled. This parameter does not affect
+ functions already compiled in the current session.
</para>
</listitem>
</varlistentry>
diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index eb29a8fd036ef45861d7e82cf97dff18ceec3164..326c757e432b20a3168ca5f4278787113cc8bb2b 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 <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
@@ -231,7 +253,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>
@@ -691,8 +715,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
diff --git a/doc/src/sgml/release-7.4.sgml b/doc/src/sgml/release-7.4.sgml
index 2c52be70064caa941cedd574a9b45c33d85f28a9..226275bf3201265c8452a2d8bf7f2258a0e13ace 100644
--- a/doc/src/sgml/release-7.4.sgml
+++ b/doc/src/sgml/release-7.4.sgml
@@ -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
diff --git a/doc/src/sgml/release-8.0.sgml b/doc/src/sgml/release-8.0.sgml
index ae2b3c04cf7989450a5ec0ed28f7c987da33eb37..f35cb61f419b81251dd7b63f789ec64ae25de00e 100644
--- a/doc/src/sgml/release-8.0.sgml
+++ b/doc/src/sgml/release-8.0.sgml
@@ -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
diff --git a/doc/src/sgml/release-8.1.sgml b/doc/src/sgml/release-8.1.sgml
index 37e3751c0e1d8610d0e3869cdb5b2cb041ccd8c7..34b3022d05d5d6efd7ab9e29cae3af034b7ac8a5 100644
--- a/doc/src/sgml/release-8.1.sgml
+++ b/doc/src/sgml/release-8.1.sgml
@@ -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
diff --git a/doc/src/sgml/release-8.2.sgml b/doc/src/sgml/release-8.2.sgml
index f4b0056f6f8a135dde7713b450eecac5ecfedef9..89431c31f4f798dc8a7da01a906aa372f6d7830d 100644
--- a/doc/src/sgml/release-8.2.sgml
+++ b/doc/src/sgml/release-8.2.sgml
@@ -31,6 +31,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
diff --git a/doc/src/sgml/release-8.3.sgml b/doc/src/sgml/release-8.3.sgml
index eac868f3f15a6d4064a02c6313dcab3ffc792149..0f4d44f9c5a17c50fd7f49a57760018ca692d0d5 100644
--- a/doc/src/sgml/release-8.3.sgml
+++ b/doc/src/sgml/release-8.3.sgml
@@ -31,6 +31,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
diff --git a/doc/src/sgml/release-8.4.sgml b/doc/src/sgml/release-8.4.sgml
index 9ff4610ccfaec4fa590cea48ce16ea5836b620c4..f426023896eb06139e42ea8aebc07d7b28b7f24d 100644
--- a/doc/src/sgml/release-8.4.sgml
+++ b/doc/src/sgml/release-8.4.sgml
@@ -31,6 +31,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
diff --git a/doc/src/sgml/release-9.0.sgml b/doc/src/sgml/release-9.0.sgml
index 4d2fef797e82666914c198702bad1ab9e5f29836..67bfa558d7fb874825388021dc02b8684ec7c81f 100644
--- a/doc/src/sgml/release-9.0.sgml
+++ b/doc/src/sgml/release-9.0.sgml
@@ -29,6 +29,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>
Improve <function>pg_get_expr()</> security fix so that the function
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index cfad4878aa3393bb918802e28308ea64cd12e314..b4ced1ce8d45b93f5641bf4360c4053492527631 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 */
+/**********************************************************************
+ * For speedy lookup, we maintain a hash table mapping from
+ * function OID + trigger flag + user OID to plperl_proc_desc pointers.
+ * The reason the plperl_proc_desc struct isn't directly part of the hash
+ * entry is to simplify recovery from errors during compile_plperl_function.
+ *
+ * Note: if the same function is called by multiple userIDs within a session,
+ * there will be a separate plperl_proc_desc entry for each userID in the case
+ * of plperl functions, but only one entry for plperlu functions, because we
+ * set user_id = 0 for that case. If the user redeclares the same function
+ * from plperl to plperlu or vice versa, there might be multiple
+ * plperl_proc_ptr entries in the hashtable, but only one is valid.
+ **********************************************************************/
+typedef struct plperl_proc_key
+{
+ Oid proc_id; /* Function OID */
+ /*
+ * is_trigger is really a bool, but declare as Oid to ensure this struct
+ * contains no padding
+ */
+ Oid is_trigger; /* is it a trigger function? */
+ Oid user_id; /* User calling the function, or 0 */
+} plperl_proc_key;
-typedef struct plperl_proc_entry
+typedef struct plperl_proc_ptr
{
- char proc_name[NAMEDATALEN]; /* internal name, eg
- * __PLPerl_proc_39987 */
- plperl_proc_desc *proc_data;
-} plperl_proc_entry;
+ plperl_proc_key proc_key; /* Hash key (must be first!) */
+ plperl_proc_desc *proc_ptr;
+} plperl_proc_ptr;
/*
* 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));
-
- hash_ctl.keysize = NAMEDATALEN;
- hash_ctl.entrysize = sizeof(plperl_proc_entry);
-
- plperl_proc_hash = hash_create("PLPerl Procedures",
+ /*
+ * 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);
+
+ 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);
- else
- sprintf(internal_proname, "__PLPerl_proc_%u_trigger", 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();
- /************************************************************
- * Lookup the internal proc name in the hashtable
- ************************************************************/
- hash_entry = hash_search(plperl_proc_hash, internal_proname,
- HASH_FIND, NULL);
+ proc_ptr = hash_search(plperl_proc_hash, &proc_key,
+ HASH_FIND, NULL);
- if (hash_entry)
+ if (validate_plperl_function(proc_ptr, procTup))
+ prodesc = proc_ptr->proc_ptr;
+ else
{
- bool uptodate;
-
- prodesc = hash_entry->proc_data;
-
- /************************************************************
- * If it's present, must check whether it's still up to date.
- * This is needed because CREATE OR REPLACE FUNCTION can modify the
- * function's pg_proc entry without changing its OID.
- ************************************************************/
- uptodate = (prodesc->fn_xmin == HeapTupleHeaderGetXmin(procTup->t_data) &&
- 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 8c94c826c994e024a275bb8fc6ab9d193b6a8c27..1c45751d8b398cdcf3383fdca459ac568995cf41 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 Datum pltcl_func_handler(PG_FUNCTION_ARGS, bool pltrusted);
-static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
+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;
+
+ interp_desc = hash_search(pltcl_interp_htab, &user_id,
+ HASH_ENTER,
+ &found);
+ if (!found)
+ pltcl_init_interp(interp_desc, pltrusted);
- return interp;
+ return interp_desc;
}
/**********************************************************************
@@ -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)