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

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

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

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

Security: CVE-2010-3433

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>

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>
 
@@ -909,20 +919,29 @@ $$ LANGUAGE plperl;
 
   <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.
+    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>
 
@@ -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</>.
+        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.
+        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 &mdash; 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.
+        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.
-       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>
+        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.
+        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>

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

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

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

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

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

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

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

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

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",
-								   32,
+	/*
+	 * 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_ELEM | HASH_FUNCTION);
 
-	hash_ctl.entrysize = sizeof(plperl_query_entry);
-	plperl_query_hash = hash_create("PLPerl Queries",
+	memset(&hash_ctl, 0, sizeof(hash_ctl));
+	hash_ctl.keysize = sizeof(plperl_proc_key);
+	hash_ctl.entrysize = sizeof(plperl_proc_ptr);
+	hash_ctl.hash = tag_hash;
+	plperl_proc_hash = hash_create("PL/Perl procedures",
 								   32,
 								   &hash_ctl,
-									HASH_ELEM);
+								   HASH_ELEM | HASH_FUNCTION);
 
+	/*
+	 * 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 (trusted_context != trusted)
+	if (interp_desc && plperl_active_interp != interp_desc)
 	{
-			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,
+	proc_ptr = hash_search(plperl_proc_hash, &proc_key,
 						   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)
+	if (validate_plperl_function(proc_ptr, procTup))
+		prodesc = proc_ptr->proc_ptr;
+	else
 	{
-				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;

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)