database/postgres
1
0
Fork 0
mirror of https://github.com/postgres/postgres.git synced 2025-11-03 09:13:20 +03:00
Code Activity

Clean up a number of bogosities around pltcl's handling of the Tcl "result":

Browse Source 
1. Directly reading interp->result is deprecated in Tcl 8.0 and later;
you're supposed to use Tcl_GetStringResult.  This code finally broke with
Tcl 8.5, because Tcl_GetVar can now have side-effects on interp->result even
though it preserves the logical state of the result.  (There's arguably a
Tcl issue here, because Tcl_GetVar could invalidate the pointer result of a
just-preceding Tcl_GetStringResult, but I doubt the Tcl guys will see it as
a bug.)

2. We were being sloppy about the encoding of the result: some places would
push database-encoding data into the Tcl result, which should not happen,
and we were assuming that any error result coming back from Tcl was in the
database encoding, which is not a good assumption.

3. There were a lot of calls of Tcl_SetResult that uselessly specified
TCL_VOLATILE for constant strings.  This is only a minor performance issue,
but I fixed it in passing since I had to look at all the calls anyway.

#2 is a live bug regardless of which Tcl version you are interested in,
so back-patch even to branches that are unlikely to be used with Tcl 8.5.
I went back as far as 8.0, which is as far as the patch applied easily;
7.4 was using a different error processing scheme that has got its own
problems :-(
This commit is contained in:
Tom Lane
2008-06-17 00:52:56 +00:00
parent 17209608ae
commit b5ea5e2f1c
1 changed files with 112 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -2,7 +2,7 @@
* pltcl.c - PostgreSQL support for Tcl as * pltcl.c - PostgreSQL support for Tcl as
* procedural language (PL) * procedural language (PL)
* *
* $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.108 2006/10/04 00:30:14 momjian Exp $ * $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.108.2.1 2008/06/17 00:52:56 tgl Exp $
* *
**********************************************************************/ **********************************************************************/
@@ -33,9 +33,16 @@
#include "utils/syscache.h" #include "utils/syscache.h"
#include "utils/typcache.h" #include "utils/typcache.h"
#define HAVE_TCL_VERSION(maj,min) \
((TCL_MAJOR_VERSION > maj) || \
(TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min))
#if defined(UNICODE_CONVERSION) && TCL_MAJOR_VERSION == 8 \ /* In Tcl >= 8.0, really not supposed to touch interp->result directly */
&& TCL_MINOR_VERSION > 0 #if !HAVE_TCL_VERSION(8,0)
#define Tcl_GetStringResult(interp) ((interp)->result)
#endif
#if defined(UNICODE_CONVERSION) && HAVE_TCL_VERSION(8,1)
#include "mb/pg_wchar.h" #include "mb/pg_wchar.h"
@@ -132,6 +139,8 @@ static Datum pltcl_func_handler(PG_FUNCTION_ARGS);
static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS); static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS);
static void throw_tcl_error(Tcl_Interp *interp);
static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid); static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid);
static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, static int pltcl_elog(ClientData cdata, Tcl_Interp *interp,
@@ -549,15 +558,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
* Check for errors reported by Tcl. * Check for errors reported by Tcl.
************************************************************/ ************************************************************/
if (tcl_rc != TCL_OK) if (tcl_rc != TCL_OK)
{ throw_tcl_error(interp);
UTF_BEGIN;
ereport(ERROR,
(errmsg("%s", interp->result),
errcontext("%s",
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY)))));
UTF_END;
}
/************************************************************ /************************************************************
* Disconnect from SPI manager and then create the return * Disconnect from SPI manager and then create the return
@@ -565,8 +566,8 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
* this must not be allocated in the SPI memory context * this must not be allocated in the SPI memory context
* because SPI_finish would free it). But don't try to call * because SPI_finish would free it). But don't try to call
* the result_in_func if we've been told to return a NULL; * the result_in_func if we've been told to return a NULL;
* the contents of interp->result may not be a valid value of * the Tcl result may not be a valid value of the result type
* the result type in that case. * in that case.
************************************************************/ ************************************************************/
if (SPI_finish() != SPI_OK_FINISH) if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed"); elog(ERROR, "SPI_finish() failed");
@@ -580,7 +581,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS)
{ {
UTF_BEGIN; UTF_BEGIN;
retval = InputFunctionCall(&prodesc->result_in_func, retval = InputFunctionCall(&prodesc->result_in_func,
UTF_U2E(interp->result), UTF_U2E((char *) Tcl_GetStringResult(interp)),
prodesc->result_typioparam, prodesc->result_typioparam,
-1); -1);
UTF_END; UTF_END;
@@ -611,6 +612,7 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
Datum *modvalues; Datum *modvalues;
char *modnulls; char *modnulls;
int ret_numvals; int ret_numvals;
CONST84 char *result;
CONST84 char **ret_values; CONST84 char **ret_values;
/* Connect to SPI manager */ /* Connect to SPI manager */
@@ -778,36 +780,35 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
* Check for errors reported by Tcl. * Check for errors reported by Tcl.
************************************************************/ ************************************************************/
if (tcl_rc != TCL_OK) if (tcl_rc != TCL_OK)
{ throw_tcl_error(interp);
UTF_BEGIN;
ereport(ERROR,
(errmsg("%s", interp->result),
errcontext("%s",
UTF_U2E(Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY)))));
UTF_END;
}
/************************************************************ /************************************************************
* The return value from the procedure might be one of * The return value from the procedure might be one of
* the magic strings OK or SKIP or a list from array get * the magic strings OK or SKIP or a list from array get.
* We can check for OK or SKIP without worrying about encoding.
************************************************************/ ************************************************************/
if (SPI_finish() != SPI_OK_FINISH) if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed"); elog(ERROR, "SPI_finish() failed");
if (strcmp(interp->result, "OK") == 0) result = Tcl_GetStringResult(interp);
if (strcmp(result, "OK") == 0)
return rettup; return rettup;
if (strcmp(interp->result, "SKIP") == 0) if (strcmp(result, "SKIP") == 0)
return (HeapTuple) NULL; return (HeapTuple) NULL;
/************************************************************ /************************************************************
* Convert the result value from the Tcl interpreter * Convert the result value from the Tcl interpreter
* and setup structures for SPI_modifytuple(); * and setup structures for SPI_modifytuple();
************************************************************/ ************************************************************/
if (Tcl_SplitList(interp, interp->result, if (Tcl_SplitList(interp, result,
&ret_numvals, &ret_values) != TCL_OK) &ret_numvals, &ret_values) != TCL_OK)
{
UTF_BEGIN;
elog(ERROR, "could not split return value from trigger: %s", elog(ERROR, "could not split return value from trigger: %s",
interp->result); UTF_U2E(Tcl_GetStringResult(interp)));
UTF_END;
}
/* Use a TRY to ensure ret_values will get freed */ /* Use a TRY to ensure ret_values will get freed */
PG_TRY(); PG_TRY();
@@ -907,6 +908,35 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS)
} }
/**********************************************************************
* throw_tcl_error - ereport an error returned from the Tcl interpreter
**********************************************************************/
static void
throw_tcl_error(Tcl_Interp *interp)
{
/*
* Caution is needed here because Tcl_GetVar could overwrite the
* interpreter result (even though it's not really supposed to),
* and we can't control the order of evaluation of ereport arguments.
* Hence, make real sure we have our own copy of the result string
* before invoking Tcl_GetVar.
*/
char *emsg;
char *econtext;
UTF_BEGIN;
emsg = pstrdup(UTF_U2E(Tcl_GetStringResult(interp)));
UTF_END;
UTF_BEGIN;
econtext = UTF_U2E((char *) Tcl_GetVar(interp, "errorInfo",
TCL_GLOBAL_ONLY));
ereport(ERROR,
(errmsg("%s", emsg),
errcontext("%s", econtext)));
UTF_END;
}
/********************************************************************** /**********************************************************************
* compile_pltcl_function - compile (or hopefully just look up) function * compile_pltcl_function - compile (or hopefully just look up) function
* *
@@ -1224,8 +1254,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid)
{ {
free(prodesc->proname); free(prodesc->proname);
free(prodesc); free(prodesc);
UTF_BEGIN;
elog(ERROR, "could not create internal procedure \"%s\": %s", elog(ERROR, "could not create internal procedure \"%s\": %s",
internal_proname, interp->result); internal_proname, UTF_U2E(Tcl_GetStringResult(interp)));
UTF_END;
} }
/************************************************************ /************************************************************
@@ -1254,8 +1286,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
if (argc != 3) if (argc != 3)
{ {
Tcl_SetResult(interp, "syntax error - 'elog level msg'", Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC);
TCL_VOLATILE);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1280,11 +1311,26 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
return TCL_ERROR; return TCL_ERROR;
} }
/************************************************************ if (level == ERROR)
* If elog() throws an error, catch it and return the error to the {
* Tcl interpreter. Note we are assuming that elog() can't have any /*
* We just pass the error back to Tcl. If it's not caught,
* it'll eventually get converted to a PG error when we reach
* the call handler.
*/
Tcl_SetResult(interp, (char *) argv[2], TCL_VOLATILE);
return TCL_ERROR;
}
/*
* For non-error messages, just pass 'em to elog(). We do not expect
* that this will fail, but just on the off chance it does, report the
* error back to Tcl. Note we are assuming that elog() can't have any
* internal failures that are so bad as to require a transaction abort. * internal failures that are so bad as to require a transaction abort.
************************************************************/ *
* This path is also used for FATAL errors, which aren't going to come
* back to us at all.
*/
oldcontext = CurrentMemoryContext; oldcontext = CurrentMemoryContext;
PG_TRY(); PG_TRY();
{ {
@@ -1302,7 +1348,9 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp,
FlushErrorState(); FlushErrorState();
/* Pass the error message to Tcl */ /* Pass the error message to Tcl */
Tcl_SetResult(interp, edata->message, TCL_VOLATILE); UTF_BEGIN;
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
FreeErrorData(edata); FreeErrorData(edata);
return TCL_ERROR; return TCL_ERROR;
@@ -1330,7 +1378,7 @@ pltcl_quote(ClientData cdata, Tcl_Interp *interp,
************************************************************/ ************************************************************/
if (argc != 2) if (argc != 2)
{ {
Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_VOLATILE); Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1382,7 +1430,8 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
************************************************************/ ************************************************************/
if (argc != 2) if (argc != 2)
{ {
Tcl_SetResult(interp, "syntax error - 'argisnull argno'", TCL_VOLATILE); Tcl_SetResult(interp, "syntax error - 'argisnull argno'",
TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1392,7 +1441,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
if (fcinfo == NULL) if (fcinfo == NULL)
{ {
Tcl_SetResult(interp, "argisnull cannot be used in triggers", Tcl_SetResult(interp, "argisnull cannot be used in triggers",
TCL_VOLATILE); TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1408,7 +1457,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
argno--; argno--;
if (argno < 0 || argno >= fcinfo->nargs) if (argno < 0 || argno >= fcinfo->nargs)
{ {
Tcl_SetResult(interp, "argno out of range", TCL_VOLATILE); Tcl_SetResult(interp, "argno out of range", TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1416,9 +1465,9 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp,
* Get the requested NULL state * Get the requested NULL state
************************************************************/ ************************************************************/
if (PG_ARGISNULL(argno)) if (PG_ARGISNULL(argno))
Tcl_SetResult(interp, "1", TCL_VOLATILE); Tcl_SetResult(interp, "1", TCL_STATIC);
else else
Tcl_SetResult(interp, "0", TCL_VOLATILE); Tcl_SetResult(interp, "0", TCL_STATIC);
return TCL_OK; return TCL_OK;
} }
@@ -1438,7 +1487,7 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
************************************************************/ ************************************************************/
if (argc != 1) if (argc != 1)
{ {
Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_VOLATILE); Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1448,7 +1497,7 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp,
if (fcinfo == NULL) if (fcinfo == NULL)
{ {
Tcl_SetResult(interp, "return_null cannot be used in triggers", Tcl_SetResult(interp, "return_null cannot be used in triggers",
TCL_VOLATILE); TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1534,7 +1583,9 @@ pltcl_subtrans_abort(Tcl_Interp *interp,
SPI_restore_connection(); SPI_restore_connection();
/* Pass the error message to Tcl */ /* Pass the error message to Tcl */
Tcl_SetResult(interp, edata->message, TCL_VOLATILE); UTF_BEGIN;
Tcl_SetResult(interp, UTF_E2U(edata->message), TCL_VOLATILE);
UTF_END;
FreeErrorData(edata); FreeErrorData(edata);
} }
@@ -1566,7 +1617,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
************************************************************/ ************************************************************/
if (argc < 2) if (argc < 2)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1577,7 +1628,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
{ {
if (++i >= argc) if (++i >= argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
arrayname = argv[i++]; arrayname = argv[i++];
@@ -1588,7 +1639,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
{ {
if (++i >= argc) if (++i >= argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK) if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
@@ -1602,7 +1653,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp,
query_idx = i; query_idx = i;
if (query_idx >= argc || query_idx + 2 < argc) if (query_idx >= argc || query_idx + 2 < argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
if (query_idx + 1 < argc) if (query_idx + 1 < argc)
@@ -1674,7 +1725,7 @@ pltcl_process_SPI_result(Tcl_Interp *interp,
case SPI_OK_UTILITY: case SPI_OK_UTILITY:
if (tuptable == NULL) if (tuptable == NULL)
{ {
Tcl_SetResult(interp, "0", TCL_VOLATILE); Tcl_SetResult(interp, "0", TCL_STATIC);
break; break;
} }
/* FALL THRU for utility returning tuples */ /* FALL THRU for utility returning tuples */
@@ -1778,7 +1829,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
if (argc != 3) if (argc != 3)
{ {
Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'", Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'",
TCL_VOLATILE); TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1878,6 +1929,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp,
ckfree((char *) args); ckfree((char *) args);
/* qname is ASCII, so no need for encoding conversion */
Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE); Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE);
return TCL_OK; return TCL_OK;
} }
@@ -1921,7 +1973,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{ {
if (++i >= argc) if (++i >= argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
arrayname = argv[i++]; arrayname = argv[i++];
@@ -1931,7 +1983,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{ {
if (++i >= argc) if (++i >= argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
nulls = argv[i++]; nulls = argv[i++];
@@ -1941,7 +1993,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{ {
if (++i >= argc) if (++i >= argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK) if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK)
@@ -1957,7 +2009,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
************************************************************/ ************************************************************/
if (i >= argc) if (i >= argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -1984,7 +2036,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{ {
Tcl_SetResult(interp, Tcl_SetResult(interp,
"length of nulls string doesn't match # of arguments", "length of nulls string doesn't match # of arguments",
TCL_VOLATILE); TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
} }
@@ -1997,7 +2049,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{ {
if (i >= argc) if (i >= argc)
{ {
Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE); Tcl_SetResult(interp, "missing argument list", TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -2014,7 +2066,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
{ {
Tcl_SetResult(interp, Tcl_SetResult(interp,
"argument list length doesn't match # of arguments for query", "argument list length doesn't match # of arguments for query",
TCL_VOLATILE); TCL_STATIC);
ckfree((char *) callargs); ckfree((char *) callargs);
return TCL_ERROR; return TCL_ERROR;
} }
@@ -2030,7 +2082,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp,
if (i != argc) if (i != argc)
{ {
Tcl_SetResult(interp, usage, TCL_VOLATILE); Tcl_SetResult(interp, usage, TCL_STATIC);
return TCL_ERROR; return TCL_ERROR;
} }