pltcl_start_proc-1.patch

diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml
index 0a69380..ad216dd 100644
*** a/doc/src/sgml/pltcl.sgml
--- b/doc/src/sgml/pltcl.sgml
*************** if {[catch { spi_exec $sql_command }]} {
*** 902,907 ****
--- 902,981 ----
      </para>
     </sect1>
  
+    <sect1 id="pltcl-config">
+     <title>PL/Tcl Configuration</title>
+ 
+     <para>
+      This section lists configuration parameters that
+      affect <application>PL/Tcl</>.
+     </para>
+ 
+     <variablelist>
+ 
+      <varlistentry id="guc-pltcl-start-proc" xreflabel="pltcl.start_proc">
+       <term>
+        <varname>pltcl.start_proc</varname> (<type>string</type>)
+        <indexterm>
+         <primary><varname>pltcl.start_proc</> configuration parameter</primary>
+        </indexterm>
+       </term>
+       <listitem>
+        <para>
+         This parameter, if set to a nonempty string, specifies the name
+         (possibly schema-qualified) of a parameterless PL/Tcl function that
+         is to be executed whenever a new Tcl interpreter is created for
+         PL/Tcl.  Such a function can perform per-session initialization, such
+         as loading additional Tcl code.  A new Tcl interpreter is created
+         when a PL/Tcl function is first executed in a database session, or
+         when an additional interpreter has to be created because a PL/Tcl
+         function is called by a new SQL role.
+        </para>
+ 
+        <para>
+         The referenced function must be written in the <literal>pltcl</>
+         language, and must not be marked <literal>SECURITY DEFINER</>.
+         (These restrictions ensure that it runs in the interpreter it's
+         supposed to initialize.)  The current user must have permission to
+         call it, too.
+        </para>
+ 
+        <para>
+         If the function fails with an error it will abort the function call
+         that caused the new interpreter to be created and propagate out to
+         the calling query, causing the current transaction or subtransaction
+         to be aborted.  Any actions already done within Tcl 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
+         Tcl interpreter.
+        </para>
+ 
+        <para>
+         Only superusers can change this setting.  Although this setting
+         can be changed within a session, such changes will not affect Tcl
+         interpreters that have already been created.
+        </para>
+       </listitem>
+      </varlistentry>
+ 
+      <varlistentry id="guc-pltclu-start-proc" xreflabel="pltclu.start_proc">
+       <term>
+        <varname>pltclu.start_proc</varname> (<type>string</type>)
+        <indexterm>
+         <primary><varname>pltclu.start_proc</> configuration parameter</primary>
+        </indexterm>
+       </term>
+       <listitem>
+        <para>
+         This parameter is exactly like <varname>pltcl.start_proc</varname>,
+         except that it applies to PL/TclU.  The referenced function must
+         be written in the <literal>pltclu</> language.
+        </para>
+       </listitem>
+      </varlistentry>
+ 
+     </variablelist>
+    </sect1>
+ 
     <sect1 id="pltcl-procnames">
      <title>Tcl Procedure Names</title>
  
diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile
index 453e7ad..1096c4f 100644
*** a/src/pl/tcl/Makefile
--- b/src/pl/tcl/Makefile
*************** DATA = pltcl.control pltcl--1.0.sql pltc
*** 28,34 ****
         pltclu.control pltclu--1.0.sql pltclu--unpackaged--1.0.sql
  
  REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=pltcl
! REGRESS = pltcl_setup pltcl_queries pltcl_unicode
  
  # Tcl on win32 ships with import libraries only for Microsoft Visual C++,
  # which are not compatible with mingw gcc. Therefore we need to build a
--- 28,34 ----
         pltclu.control pltclu--1.0.sql pltclu--unpackaged--1.0.sql
  
  REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-extension=pltcl
! REGRESS = pltcl_setup pltcl_queries pltcl_start_proc pltcl_unicode
  
  # Tcl on win32 ships with import libraries only for Microsoft Visual C++,
  # which are not compatible with mingw gcc. Therefore we need to build a
diff --git a/src/pl/tcl/expected/pltcl_start_proc.out b/src/pl/tcl/expected/pltcl_start_proc.out
index ...0b8afb7 .
*** a/src/pl/tcl/expected/pltcl_start_proc.out
--- b/src/pl/tcl/expected/pltcl_start_proc.out
***************
*** 0 ****
--- 1,28 ----
+ --
+ -- Test start_proc execution
+ --
+ SET pltcl.start_proc = 'no_such_function';
+ select tcl_int4add(1, 2);
+ ERROR:  function no_such_function() does not exist
+ select tcl_int4add(1, 2);
+ ERROR:  function no_such_function() does not exist
+ create function tcl_initialize() returns void as
+ $$ elog NOTICE "in tcl_initialize" $$ language pltcl SECURITY DEFINER;
+ SET pltcl.start_proc = 'public.tcl_initialize';
+ select tcl_int4add(1, 2);  -- fail
+ ERROR:  function "public.tcl_initialize" must not be SECURITY DEFINER to use in pltcl.start_proc
+ create or replace function tcl_initialize() returns void as
+ $$ elog NOTICE "in tcl_initialize" $$ language pltcl;
+ select tcl_int4add(1, 2);
+ NOTICE:  in tcl_initialize
+  tcl_int4add 
+ -------------
+            3
+ (1 row)
+ 
+ select tcl_int4add(1, 2);
+  tcl_int4add 
+ -------------
+            3
+ (1 row)
+ 
diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c
index 11faa6d..a390b6e 100644
*** a/src/pl/tcl/pltcl.c
--- b/src/pl/tcl/pltcl.c
***************
*** 15,20 ****
--- 15,21 ----
  
  #include "access/htup_details.h"
  #include "access/xact.h"
+ #include "catalog/objectaccess.h"
  #include "catalog/pg_proc.h"
  #include "catalog/pg_type.h"
  #include "commands/event_trigger.h"
***************
*** 25,35 ****
--- 26,39 ----
  #include "mb/pg_wchar.h"
  #include "miscadmin.h"
  #include "nodes/makefuncs.h"
+ #include "parser/parse_func.h"
  #include "parser/parse_type.h"
+ #include "pgstat.h"
  #include "tcop/tcopprot.h"
  #include "utils/builtins.h"
  #include "utils/lsyscache.h"
  #include "utils/memutils.h"
+ #include "utils/regproc.h"
  #include "utils/rel.h"
  #include "utils/syscache.h"
  #include "utils/typcache.h"
*************** typedef struct pltcl_call_state
*** 226,231 ****
--- 230,237 ----
  /**********************************************************************
   * Global data
   **********************************************************************/
+ static char *pltcl_start_proc = NULL;
+ static char *pltclu_start_proc = NULL;
  static bool pltcl_pm_init_done = false;
  static Tcl_Interp *pltcl_hold_interp = NULL;
  static HTAB *pltcl_interp_htab = NULL;
*************** static const TclExceptionNameMap excepti
*** 253,260 ****
   **********************************************************************/
  void		_PG_init(void);
  
! static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted);
! static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted);
  
  static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
  
--- 259,268 ----
   **********************************************************************/
  void		_PG_init(void);
  
! static void pltcl_init_interp(pltcl_interp_desc *interp_desc,
! 				  Oid prolang, bool pltrusted);
! static pltcl_interp_desc *pltcl_fetch_interp(Oid prolang, bool pltrusted);
! static void call_pltcl_start_proc(Oid prolang, bool pltrusted);
  
  static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted);
  
*************** _PG_init(void)
*** 441,446 ****
--- 449,472 ----
  								  &hash_ctl,
  								  HASH_ELEM | HASH_BLOBS);
  
+ 	/************************************************************
+ 	 * Define PL/Tcl's custom GUCs
+ 	 ************************************************************/
+ 	DefineCustomStringVariable("pltcl.start_proc",
+ 	  gettext_noop("PL/Tcl function to call once when pltcl is first used."),
+ 							   NULL,
+ 							   &pltcl_start_proc,
+ 							   NULL,
+ 							   PGC_SUSET, 0,
+ 							   NULL, NULL, NULL);
+ 	DefineCustomStringVariable("pltclu.start_proc",
+ 	gettext_noop("PL/TclU function to call once when pltclu is first used."),
+ 							   NULL,
+ 							   &pltclu_start_proc,
+ 							   NULL,
+ 							   PGC_SUSET, 0,
+ 							   NULL, NULL, NULL);
+ 
  	pltcl_pm_init_done = true;
  }
  
*************** _PG_init(void)
*** 448,454 ****
   * pltcl_init_interp() - initialize a new Tcl interpreter
   **********************************************************************/
  static void
! pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted)
  {
  	Tcl_Interp *interp;
  	char		interpname[32];
--- 474,480 ----
   * pltcl_init_interp() - initialize a new Tcl interpreter
   **********************************************************************/
  static void
! pltcl_init_interp(pltcl_interp_desc *interp_desc, Oid prolang, bool pltrusted)
  {
  	Tcl_Interp *interp;
  	char		interpname[32];
*************** pltcl_init_interp(pltcl_interp_desc *int
*** 462,468 ****
  	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
--- 488,493 ----
*************** pltcl_init_interp(pltcl_interp_desc *int
*** 490,505 ****
  						 pltcl_SPI_execute_plan, NULL, NULL);
  	Tcl_CreateObjCommand(interp, "spi_lastoid",
  						 pltcl_SPI_lastoid, NULL, NULL);
  }
  
  /**********************************************************************
   * pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function
   *
   * This also takes care of any on-first-use initialization required.
-  * Note: we assume caller has already connected to SPI.
   **********************************************************************/
  static pltcl_interp_desc *
! pltcl_fetch_interp(bool pltrusted)
  {
  	Oid			user_id;
  	pltcl_interp_desc *interp_desc;
--- 515,549 ----
  						 pltcl_SPI_execute_plan, NULL, NULL);
  	Tcl_CreateObjCommand(interp, "spi_lastoid",
  						 pltcl_SPI_lastoid, NULL, NULL);
+ 
+ 	/************************************************************
+ 	 * Call the appropriate start_proc, if there is one.
+ 	 *
+ 	 * We must set interp_desc->interp before the call, else the start_proc
+ 	 * won't find the interpreter it's supposed to use.  But, if the
+ 	 * start_proc fails, we want to abandon use of the interpreter.
+ 	 ************************************************************/
+ 	PG_TRY();
+ 	{
+ 		interp_desc->interp = interp;
+ 		call_pltcl_start_proc(prolang, pltrusted);
+ 	}
+ 	PG_CATCH();
+ 	{
+ 		interp_desc->interp = NULL;
+ 		Tcl_DeleteInterp(interp);
+ 		PG_RE_THROW();
+ 	}
+ 	PG_END_TRY();
  }
  
  /**********************************************************************
   * pltcl_fetch_interp() - fetch the Tcl interpreter to use for a function
   *
   * This also takes care of any on-first-use initialization required.
   **********************************************************************/
  static pltcl_interp_desc *
! pltcl_fetch_interp(Oid prolang, bool pltrusted)
  {
  	Oid			user_id;
  	pltcl_interp_desc *interp_desc;
*************** pltcl_fetch_interp(bool pltrusted)
*** 515,527 ****
  							  HASH_ENTER,
  							  &found);
  	if (!found)
! 		pltcl_init_interp(interp_desc, pltrusted);
  
  	return interp_desc;
  }
  
  
  /**********************************************************************
   * pltcl_call_handler		- This is the only visible function
   *				  of the PL interpreter. The PostgreSQL
   *				  function manager and trigger manager
--- 559,654 ----
  							  HASH_ENTER,
  							  &found);
  	if (!found)
! 		interp_desc->interp = NULL;
! 
! 	/* If we haven't yet successfully made an interpreter, try to do that */
! 	if (!interp_desc->interp)
! 		pltcl_init_interp(interp_desc, prolang, pltrusted);
  
  	return interp_desc;
  }
  
  
  /**********************************************************************
+  * call_pltcl_start_proc()	 - Call user-defined initialization proc, if any
+  **********************************************************************/
+ static void
+ call_pltcl_start_proc(Oid prolang, bool pltrusted)
+ {
+ 	char	   *start_proc;
+ 	List	   *namelist;
+ 	Oid			fargtypes[1];	/* dummy */
+ 	Oid			procOid;
+ 	HeapTuple	procTup;
+ 	Form_pg_proc procStruct;
+ 	AclResult	aclresult;
+ 	FmgrInfo	finfo;
+ 	FunctionCallInfoData fcinfo;
+ 	PgStat_FunctionCallUsage fcusage;
+ 
+ 	/* select appropriate GUC */
+ 	start_proc = pltrusted ? pltcl_start_proc : pltclu_start_proc;
+ 
+ 	/* Nothing to do if it's empty or unset */
+ 	if (start_proc == NULL || start_proc[0] == '\0')
+ 		return;
+ 
+ 	/* Parse possibly-qualified identifier and look up the function */
+ 	namelist = stringToQualifiedNameList(start_proc);
+ 	procOid = LookupFuncName(namelist, 0, fargtypes, false);
+ 
+ 	/* Current user must have permission to call function */
+ 	aclresult = pg_proc_aclcheck(procOid, GetUserId(), ACL_EXECUTE);
+ 	if (aclresult != ACLCHECK_OK)
+ 		aclcheck_error(aclresult, ACL_KIND_PROC, start_proc);
+ 
+ 	/* Get the function's pg_proc entry */
+ 	procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(procOid));
+ 	if (!HeapTupleIsValid(procTup))
+ 		elog(ERROR, "cache lookup failed for function %u", procOid);
+ 	procStruct = (Form_pg_proc) GETSTRUCT(procTup);
+ 
+ 	/* It must be same language as the function we're currently calling */
+ 	if (procStruct->prolang != prolang)
+ 		ereport(ERROR,
+ 				(errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
+ 			  errmsg("function \"%s\" is in the wrong language to use in %s",
+ 					 start_proc,
+ 					 pltrusted ? "pltcl.start_proc" : "pltclu.start_proc")));
+ 
+ 	/*
+ 	 * It must not be SECURITY DEFINER, either.  This together with the
+ 	 * language match check ensures that the function will execute in the same
+ 	 * Tcl interpreter we just finished initializing.
+ 	 */
+ 	if (procStruct->prosecdef)
+ 		ereport(ERROR,
+ 				(errcode(ERRCODE_OBJECT_NOT_IN_PREREQUISITE_STATE),
+ 		  errmsg("function \"%s\" must not be SECURITY DEFINER to use in %s",
+ 				 start_proc,
+ 				 pltrusted ? "pltcl.start_proc" : "pltclu.start_proc")));
+ 
+ 	/* A-OK */
+ 	ReleaseSysCache(procTup);
+ 
+ 	/*
+ 	 * Call the function using the normal SQL function call mechanism.  We
+ 	 * could perhaps cheat and jump directly to pltcl_handler(), but it seems
+ 	 * better to do it this way so that the call is exposed to, eg, call
+ 	 * statistics collection.
+ 	 */
+ 	InvokeFunctionExecuteHook(procOid);
+ 	fmgr_info(procOid, &finfo);
+ 	InitFunctionCallInfoData(fcinfo, &finfo,
+ 							 0,
+ 							 InvalidOid, NULL, NULL);
+ 	pgstat_init_function_usage(&fcinfo, &fcusage);
+ 	(void) FunctionCallInvoke(&fcinfo);
+ 	pgstat_end_function_usage(&fcusage, true);
+ }
+ 
+ 
+ /**********************************************************************
   * pltcl_call_handler		- This is the only visible function
   *				  of the PL interpreter. The PostgreSQL
   *				  function manager and trigger manager
*************** compile_pltcl_function(Oid fn_oid, Oid t
*** 1319,1325 ****
  		/************************************************************
  		 * Identify the interpreter to use for the function
  		 ************************************************************/
! 		prodesc->interp_desc = pltcl_fetch_interp(prodesc->lanpltrusted);
  		interp = prodesc->interp_desc->interp;
  
  		/************************************************************
--- 1446,1453 ----
  		/************************************************************
  		 * Identify the interpreter to use for the function
  		 ************************************************************/
! 		prodesc->interp_desc = pltcl_fetch_interp(procStruct->prolang,
! 												  prodesc->lanpltrusted);
  		interp = prodesc->interp_desc->interp;
  
  		/************************************************************
diff --git a/src/pl/tcl/sql/pltcl_start_proc.sql b/src/pl/tcl/sql/pltcl_start_proc.sql
index ...7a8e68e .
*** a/src/pl/tcl/sql/pltcl_start_proc.sql
--- b/src/pl/tcl/sql/pltcl_start_proc.sql
***************
*** 0 ****
--- 1,21 ----
+ --
+ -- Test start_proc execution
+ --
+ 
+ SET pltcl.start_proc = 'no_such_function';
+ 
+ select tcl_int4add(1, 2);
+ select tcl_int4add(1, 2);
+ 
+ create function tcl_initialize() returns void as
+ $$ elog NOTICE "in tcl_initialize" $$ language pltcl SECURITY DEFINER;
+ 
+ SET pltcl.start_proc = 'public.tcl_initialize';
+ 
+ select tcl_int4add(1, 2);  -- fail
+ 
+ create or replace function tcl_initialize() returns void as
+ $$ elog NOTICE "in tcl_initialize" $$ language pltcl;
+ 
+ select tcl_int4add(1, 2);
+ select tcl_int4add(1, 2);