From 19a6bace9480bc51d61d87a8497b05b5c1ea04c1 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Tue, 17 Jun 2008 00:52:43 +0000 Subject: [PATCH] Clean up a number of bogosities around pltcl's handling of the Tcl "result": 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 :-( --- src/pl/tcl/pltcl.c | 171 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 110 insertions(+), 61 deletions(-) diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index c7bb416f25..e9fdf9fc38 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -2,7 +2,7 @@ * pltcl.c - PostgreSQL support for Tcl as * procedural language (PL) * - * $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.120 2008/05/12 00:00:54 alvherre Exp $ + * $PostgreSQL: pgsql/src/pl/tcl/pltcl.c,v 1.121 2008/06/17 00:52:43 tgl Exp $ * **********************************************************************/ @@ -36,6 +36,11 @@ ((TCL_MAJOR_VERSION > maj) || \ (TCL_MAJOR_VERSION == maj && TCL_MINOR_VERSION >= min)) +/* In Tcl >= 8.0, really not supposed to touch interp->result directly */ +#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" @@ -134,6 +139,8 @@ static Datum pltcl_func_handler(PG_FUNCTION_ARGS); static HeapTuple pltcl_trigger_handler(PG_FUNCTION_ARGS); +static void throw_tcl_error(Tcl_Interp *interp, const char *proname); + static pltcl_proc_desc *compile_pltcl_function(Oid fn_oid, Oid tgreloid); static int pltcl_elog(ClientData cdata, Tcl_Interp *interp, @@ -224,7 +231,7 @@ pltcl_WaitForEvent(Tcl_Time *timePtr) { return 0; } -#endif /* HAVE_TCL_VERSION(8,2) */ +#endif /* HAVE_TCL_VERSION(8,4) */ /* @@ -632,16 +639,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS) * Check for errors reported by Tcl. ************************************************************/ if (tcl_rc != TCL_OK) - { - UTF_BEGIN; - ereport(ERROR, - (errmsg("%s", interp->result), - errcontext("%s\nin PL/Tcl function \"%s\"", - UTF_U2E(Tcl_GetVar(interp, "errorInfo", - TCL_GLOBAL_ONLY)), - prodesc->user_proname))); - UTF_END; - } + throw_tcl_error(interp, prodesc->user_proname); /************************************************************ * Disconnect from SPI manager and then create the return @@ -649,8 +647,8 @@ pltcl_func_handler(PG_FUNCTION_ARGS) * this must not be allocated in the SPI memory context * 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 contents of interp->result may not be a valid value of - * the result type in that case. + * the Tcl result may not be a valid value of the result type + * in that case. ************************************************************/ if (SPI_finish() != SPI_OK_FINISH) elog(ERROR, "SPI_finish() failed"); @@ -664,7 +662,7 @@ pltcl_func_handler(PG_FUNCTION_ARGS) { UTF_BEGIN; retval = InputFunctionCall(&prodesc->result_in_func, - UTF_U2E(interp->result), + UTF_U2E((char *) Tcl_GetStringResult(interp)), prodesc->result_typioparam, -1); UTF_END; @@ -695,6 +693,7 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS) Datum *modvalues; char *modnulls; int ret_numvals; + CONST84 char *result; CONST84 char **ret_values; /* Connect to SPI manager */ @@ -864,37 +863,35 @@ pltcl_trigger_handler(PG_FUNCTION_ARGS) * Check for errors reported by Tcl. ************************************************************/ if (tcl_rc != TCL_OK) - { - UTF_BEGIN; - ereport(ERROR, - (errmsg("%s", interp->result), - errcontext("%s\nin PL/Tcl function \"%s\"", - UTF_U2E(Tcl_GetVar(interp, "errorInfo", - TCL_GLOBAL_ONLY)), - prodesc->user_proname))); - UTF_END; - } + throw_tcl_error(interp, prodesc->user_proname); /************************************************************ * 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) elog(ERROR, "SPI_finish() failed"); - if (strcmp(interp->result, "OK") == 0) + result = Tcl_GetStringResult(interp); + + if (strcmp(result, "OK") == 0) return rettup; - if (strcmp(interp->result, "SKIP") == 0) + if (strcmp(result, "SKIP") == 0) return (HeapTuple) NULL; /************************************************************ * Convert the result value from the Tcl interpreter * and setup structures for SPI_modifytuple(); ************************************************************/ - if (Tcl_SplitList(interp, interp->result, + if (Tcl_SplitList(interp, result, &ret_numvals, &ret_values) != TCL_OK) + { + UTF_BEGIN; 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 */ PG_TRY(); @@ -995,6 +992,36 @@ 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, const char *proname) +{ + /* + * 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\nin PL/Tcl function \"%s\"", + econtext, proname))); + UTF_END; +} + + +/********************************************************************** * compile_pltcl_function - compile (or hopefully just look up) function * * tgreloid is the OID of the relation when compiling a trigger, or zero @@ -1319,8 +1346,10 @@ compile_pltcl_function(Oid fn_oid, Oid tgreloid) free(prodesc->user_proname); free(prodesc->internal_proname); free(prodesc); + UTF_BEGIN; elog(ERROR, "could not create internal procedure \"%s\": %s", - internal_proname, interp->result); + internal_proname, UTF_U2E(Tcl_GetStringResult(interp))); + UTF_END; } /************************************************************ @@ -1349,8 +1378,7 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, if (argc != 3) { - Tcl_SetResult(interp, "syntax error - 'elog level msg'", - TCL_VOLATILE); + Tcl_SetResult(interp, "syntax error - 'elog level msg'", TCL_STATIC); return TCL_ERROR; } @@ -1375,11 +1403,26 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, return TCL_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 + if (level == ERROR) + { + /* + * 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. - ************************************************************/ + * + * This path is also used for FATAL errors, which aren't going to come + * back to us at all. + */ oldcontext = CurrentMemoryContext; PG_TRY(); { @@ -1397,7 +1440,9 @@ pltcl_elog(ClientData cdata, Tcl_Interp *interp, FlushErrorState(); /* 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); return TCL_ERROR; @@ -1425,7 +1470,7 @@ pltcl_quote(ClientData cdata, Tcl_Interp *interp, ************************************************************/ if (argc != 2) { - Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_VOLATILE); + Tcl_SetResult(interp, "syntax error - 'quote string'", TCL_STATIC); return TCL_ERROR; } @@ -1477,7 +1522,8 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, ************************************************************/ if (argc != 2) { - Tcl_SetResult(interp, "syntax error - 'argisnull argno'", TCL_VOLATILE); + Tcl_SetResult(interp, "syntax error - 'argisnull argno'", + TCL_STATIC); return TCL_ERROR; } @@ -1487,7 +1533,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, if (fcinfo == NULL) { Tcl_SetResult(interp, "argisnull cannot be used in triggers", - TCL_VOLATILE); + TCL_STATIC); return TCL_ERROR; } @@ -1503,7 +1549,7 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, argno--; 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; } @@ -1511,9 +1557,9 @@ pltcl_argisnull(ClientData cdata, Tcl_Interp *interp, * Get the requested NULL state ************************************************************/ if (PG_ARGISNULL(argno)) - Tcl_SetResult(interp, "1", TCL_VOLATILE); + Tcl_SetResult(interp, "1", TCL_STATIC); else - Tcl_SetResult(interp, "0", TCL_VOLATILE); + Tcl_SetResult(interp, "0", TCL_STATIC); return TCL_OK; } @@ -1533,7 +1579,7 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, ************************************************************/ if (argc != 1) { - Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_VOLATILE); + Tcl_SetResult(interp, "syntax error - 'return_null'", TCL_STATIC); return TCL_ERROR; } @@ -1543,7 +1589,7 @@ pltcl_returnnull(ClientData cdata, Tcl_Interp *interp, if (fcinfo == NULL) { Tcl_SetResult(interp, "return_null cannot be used in triggers", - TCL_VOLATILE); + TCL_STATIC); return TCL_ERROR; } @@ -1629,7 +1675,9 @@ pltcl_subtrans_abort(Tcl_Interp *interp, SPI_restore_connection(); /* 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); } @@ -1661,7 +1709,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, ************************************************************/ if (argc < 2) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } @@ -1672,7 +1720,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, { if (++i >= argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } arrayname = argv[i++]; @@ -1683,7 +1731,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, { if (++i >= argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK) @@ -1697,7 +1745,7 @@ pltcl_SPI_execute(ClientData cdata, Tcl_Interp *interp, query_idx = i; if (query_idx >= argc || query_idx + 2 < argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } if (query_idx + 1 < argc) @@ -1769,7 +1817,7 @@ pltcl_process_SPI_result(Tcl_Interp *interp, case SPI_OK_UTILITY: if (tuptable == NULL) { - Tcl_SetResult(interp, "0", TCL_VOLATILE); + Tcl_SetResult(interp, "0", TCL_STATIC); break; } /* FALL THRU for utility returning tuples */ @@ -1873,7 +1921,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, if (argc != 3) { Tcl_SetResult(interp, "syntax error - 'SPI_prepare query argtypes'", - TCL_VOLATILE); + TCL_STATIC); return TCL_ERROR; } @@ -1974,6 +2022,7 @@ pltcl_SPI_prepare(ClientData cdata, Tcl_Interp *interp, ckfree((char *) args); + /* qname is ASCII, so no need for encoding conversion */ Tcl_SetResult(interp, qdesc->qname, TCL_VOLATILE); return TCL_OK; } @@ -2017,7 +2066,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, { if (++i >= argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } arrayname = argv[i++]; @@ -2027,7 +2076,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, { if (++i >= argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } nulls = argv[i++]; @@ -2037,7 +2086,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, { if (++i >= argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } if (Tcl_GetInt(interp, argv[i++], &count) != TCL_OK) @@ -2053,7 +2102,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, ************************************************************/ if (i >= argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } @@ -2080,7 +2129,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, { Tcl_SetResult(interp, "length of nulls string doesn't match # of arguments", - TCL_VOLATILE); + TCL_STATIC); return TCL_ERROR; } } @@ -2093,7 +2142,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, { if (i >= argc) { - Tcl_SetResult(interp, "missing argument list", TCL_VOLATILE); + Tcl_SetResult(interp, "missing argument list", TCL_STATIC); return TCL_ERROR; } @@ -2110,7 +2159,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, { Tcl_SetResult(interp, "argument list length doesn't match # of arguments for query", - TCL_VOLATILE); + TCL_STATIC); ckfree((char *) callargs); return TCL_ERROR; } @@ -2126,7 +2175,7 @@ pltcl_SPI_execute_plan(ClientData cdata, Tcl_Interp *interp, if (i != argc) { - Tcl_SetResult(interp, usage, TCL_VOLATILE); + Tcl_SetResult(interp, usage, TCL_STATIC); return TCL_ERROR; } -- 2.11.0