From ac84793dd6e5380f3f2b4ba2444e3c00494f8d52 Mon Sep 17 00:00:00 2001 From: Kevin Easton Date: Sat, 1 Jul 2017 00:47:20 +1000 Subject: [PATCH] Switch from direct tcl_interp->result access to Tcl_GetStringResult() and Tcl_AppendResult() This allows building against recent libtcl versions. A fallback definition of Tcl_GetStringResult() is included so that building against libtcl 7 still works. --- Changelog | 3 +++ include/tcl_bx.h | 5 +++++ source/bot_link.c | 4 ++-- source/commands.c | 41 ++++++++++++++++++++--------------- source/tcl.c | 53 ++++++++++++++++++++++++++++----------------- source/tcl_public.c | 28 +++++++++++------------- 6 files changed, 80 insertions(+), 54 deletions(-) diff --git a/Changelog b/Changelog index ac9d7b1..ec982e0 100644 --- a/Changelog +++ b/Changelog @@ -1,5 +1,8 @@ [Changes 1.2.2] +* Update to build against modern libtcl (don't access tcl_interp->result + directly). (caf) + * Add /FSET SEND_ENCRYPTED_PUBLIC format. (caf) * Correct order of arguments to /FSET SEND_ENCRYPTED_MSG and diff --git a/include/tcl_bx.h b/include/tcl_bx.h index fe3f116..7530603 100644 --- a/include/tcl_bx.h +++ b/include/tcl_bx.h @@ -28,6 +28,11 @@ void tcl_load (char *, char *, char *, char *); #define USE_NON_CONST #include + +#if (TCL_MAJOR_VERSION < 8) +#define Tcl_GetStringResult(interp) ((interp)->result) +#endif + extern Tcl_Interp *tcl_interp; void check_tcl_tand (char *, char *, char *); void check_tcl_msgm (char *, char *, char *, char *, char *); diff --git a/source/bot_link.c b/source/bot_link.c index 51de119..f23a4c1 100644 --- a/source/bot_link.c +++ b/source/bot_link.c @@ -743,9 +743,9 @@ int cmd_tcl(int idx, char *par) return TCL_ERROR; if ((Tcl_Eval(tcl_interp, par)) == TCL_OK) { - dcc_printf(idx, "Tcl: %s\n", tcl_interp->result); + dcc_printf(idx, "Tcl: %s\n", Tcl_GetStringResult(tcl_interp)); } else - dcc_printf(idx, "Tcl Error: %s\n", tcl_interp->result); + dcc_printf(idx, "Tcl Error: %s\n", Tcl_GetStringResult(tcl_interp)); #else dcc_printf(idx, "Not implemented in this client\n"); #endif diff --git a/source/commands.c b/source/commands.c index 12a6fa4..6d90da0 100644 --- a/source/commands.c +++ b/source/commands.c @@ -4579,8 +4579,6 @@ int BX_parse_command(char *line, int hist_flag, char *sub_args) } else { - char unknown[] = "Unknown command:"; - if (hist_flag && add_to_hist && !oper_issued) add_to_history(this_cmd); command = find_command(cline, &cmd_cnt); @@ -4635,25 +4633,28 @@ int BX_parse_command(char *line, int hist_flag, char *sub_args) else if (tcl_interp) { int err; + const char *tcl_result; + err = Tcl_Invoke(tcl_interp, cline, rest); + tcl_result = Tcl_GetStringResult(tcl_interp); + if (err == TCL_OK) { - if (tcl_interp->result && *tcl_interp->result) - bitchsay("%s %s", *tcl_interp->result?empty_string:unknown, *tcl_interp->result?tcl_interp->result:empty_string); + bitchsay("%s", tcl_result); } else { - if (alias_cnt + cmd_cnt > 1) - bitchsay("Ambiguous command: %s", cline); - else if (get_int_var(DISPATCH_UNKNOWN_COMMANDS_VAR)) - send_to_server("%s %s", cline, rest); - else if (tcl_interp->result && *tcl_interp->result) + if (*tcl_result) { if (check_help_bind(cline)) - bitchsay("%s", tcl_interp->result); + bitchsay("%s", tcl_result); } + else if (get_int_var(DISPATCH_UNKNOWN_COMMANDS_VAR)) + send_to_server("%s %s", cline, rest); + else if (alias_cnt + cmd_cnt > 1) + bitchsay("Ambiguous command: %s", cline); else - bitchsay("%s %s", unknown, cline); + bitchsay("Unknown command: %s", cline); } } @@ -4663,7 +4664,7 @@ int BX_parse_command(char *line, int hist_flag, char *sub_args) else if (alias_cnt + cmd_cnt > 1) bitchsay("Ambiguous command: %s", cline); else - bitchsay("%s %s", unknown, cline); + bitchsay("Unknown command: %s", cline); } if (alias) new_free(&alias_name); @@ -4803,7 +4804,7 @@ BUILT_IN_COMMAND(BX_load) { #ifdef WANT_TCL if (Tcl_EvalFile(tcl_interp, filename) != TCL_OK) - error("Unable to load filename %s[%s]", filename, tcl_interp->result); + error("Unable to load filename %s [%s]", filename, Tcl_GetStringResult(tcl_interp)); #endif continue; } @@ -5490,12 +5491,18 @@ int result = 0; if ((filename = next_arg(args, &args))) { char *bla = NULL; + const char *tcl_result; + if (get_string_var(LOAD_PATH_VAR)) bla = path_search(filename, get_string_var(LOAD_PATH_VAR)); - if ((result = Tcl_EvalFile(tcl_interp, bla?bla:filename)) != TCL_OK) - put_it("Tcl: [%s]",tcl_interp->result); - else if (*tcl_interp->result) - put_it("Tcl: [%s]", tcl_interp->result); + + result = Tcl_EvalFile(tcl_interp, bla ? bla : filename); + tcl_result = Tcl_GetStringResult(tcl_interp); + + if (result != TCL_OK) + put_it("Tcl Error: [%s]", tcl_result); + else if (*tcl_result) + put_it("Tcl: [%s]", tcl_result); } } diff --git a/source/tcl.c b/source/tcl.c index fd58924..7aad074 100644 --- a/source/tcl.c +++ b/source/tcl.c @@ -1368,10 +1368,12 @@ int stk; int trigger_bind(char *proc, char *param, char *(*func)(char *, char *)) { -char *result = NULL; + char *result = NULL; + int err; if (internal_debug & DEBUG_TCL) debugyell("Tcl exec [%s] with [%s]", proc, param); + if (func) { result = (*func)(proc, param); @@ -1381,16 +1383,18 @@ char *result = NULL; debugyell("Tcl return from [%s] with [%s]", proc, result); return BIND_EXECUTED; } - if (Tcl_VarEval(tcl_interp,proc,param,NULL)==TCL_ERROR) + + err = Tcl_VarEval(tcl_interp, proc, param, NULL); + result = Tcl_GetStringResult(tcl_interp); + + if (internal_debug & DEBUG_TCL) + debugyell("Tcl return from [%s] with [%s]", proc, result); + if (err == TCL_ERROR) { - if (internal_debug & DEBUG_TCL) - debugyell("Tcl return from [%s] with [%s]", proc, tcl_interp->result); - putlog(LOG_ALL,"*","Tcl error [%s]: %s",proc,tcl_interp->result); + putlog(LOG_ALL,"*","Tcl error [%s]: %s", proc, result); return BIND_EXECUTED; } - if (internal_debug & DEBUG_TCL) - debugyell("Tcl return from [%s] with [%s]", proc, tcl_interp->result); - return (atoi(tcl_interp->result)>0)?BIND_EXEC_LOG:BIND_EXECUTED; + return (atoi(result)>0)?BIND_EXEC_LOG:BIND_EXECUTED; } void init_builtins() @@ -1954,7 +1958,7 @@ char *check_tcl_alias(char *command, char *args) Tcl_SetVar(tcl_interp, "_a", args?args:empty_string, TCL_GLOBAL_ONLY); if (check_tcl_bind(&H_functions, command, -1, " $_a", MATCH_MASK|BIND_STACKABLE, NULL)) - return m_strdup(tcl_interp->result?tcl_interp->result:empty_string); + return m_strdup(Tcl_GetStringResult(tcl_interp)); return NULL; } @@ -2325,7 +2329,8 @@ BUILT_IN_COMMAND(tcl_version) BUILT_IN_COMMAND(tcl_command) { -int result = 0; + int result = 0; + const char *tcl_result; tcl_init(); if (args && *args) @@ -2338,10 +2343,12 @@ int result = 0; bla = next_arg(args, &args); if (get_string_var(LOAD_PATH_VAR)) bla = path_search(args, get_string_var(LOAD_PATH_VAR)); - if ((result = Tcl_EvalFile(tcl_interp, bla ? bla : args)) != TCL_OK) - put_it("Tcl: [%s]",tcl_interp->result); - else if (tcl_echo && *tcl_interp->result) - put_it("Tcl: [%s]", tcl_interp->result); + + result = Tcl_EvalFile(tcl_interp, bla ? bla : args); + tcl_result = Tcl_GetStringResult(tcl_interp); + + if ((result != TCL_OK) || (tcl_echo && *tcl_result)) + put_it("Tcl: [%s]", tcl_result); } else if (!my_strnicmp(args+1, "xecho", 4)) { @@ -2354,10 +2361,12 @@ int result = 0; put_it("Tcl: unknown cmd [%s]", args); return; } - if ((result = Tcl_Eval(tcl_interp, args)) != TCL_OK) - put_it("Tcl: %s %s", args, tcl_interp->result); - else if (tcl_echo && *tcl_interp->result) - put_it("Tcl: [%s] %s", args, tcl_interp->result); + + result = Tcl_Eval(tcl_interp, args); + tcl_result = Tcl_GetStringResult(tcl_interp); + + if ((result != TCL_OK) || (tcl_echo && *tcl_result)) + put_it("Tcl: [%s] %s", args, tcl_result); } else { @@ -2392,7 +2401,7 @@ char *com; Tcl_ResetResult(irp); lower(com); if (internal_debug & DEBUG_TCL) - debugyell("Invoking tcl [%s] with [%s]", com, rest); + debugyell("Invoking Tcl [%s] with [%s]", com, rest); if (Tcl_GetCommandInfo(irp, com, &info) && info.proc) { result = (*info.proc)(info.clientData, irp, argc, ArgList); @@ -2400,7 +2409,11 @@ char *com; debugyell("Tcl returning with [%d]", result); } else - Tcl_AppendResult(irp, "Unknown command \"", com, "\"", NULL); + { + if (internal_debug & DEBUG_TCL) + debugyell("Tcl could not find command [%s]", com); + } + return result; } diff --git a/source/tcl_public.c b/source/tcl_public.c index ba345d3..6406797 100644 --- a/source/tcl_public.c +++ b/source/tcl_public.c @@ -41,8 +41,6 @@ cmd_t C_dcc[] = }; #ifdef WANT_TCL -#include - /* * I wish to thank vore!vore@domination.ml.org for pushing me * todo something like this, although by-Tor requested @@ -234,16 +232,16 @@ static int CompareKeyListField (tcl_interp, fieldName, field, valuePtr, valueSiz int fieldNameSize, elementSize; if (field [0] == '\0') { - tcl_interp->result = - "invalid keyed list format: list contains an empty field entry"; + Tcl_AppendResult(tcl_interp, + "invalid keyed list format: list contains an empty field entry", NULL); return TCL_ERROR; } if (TclFindElement (tcl_interp, (char *) field, &elementPtr, &nextPtr, &elementSize, NULL) != TCL_OK) return TCL_ERROR; if (elementSize == 0) { - tcl_interp->result = - "invalid keyed list format: list contains an empty field name"; + Tcl_AppendResult(tcl_interp, + "invalid keyed list format: list contains an empty field name", NULL); return TCL_ERROR; } if (nextPtr[0] == '\0') { @@ -310,7 +308,7 @@ static int SplitAndFindField (tcl_interp, fieldName, keyedList, fieldInfoPtr) int idx, result, braced; if (fieldName == '\0') { - tcl_interp->result = "null key not allowed"; + Tcl_AppendResult(tcl_interp, "null key not allowed", NULL); return TCL_ERROR; } @@ -505,7 +503,7 @@ int Tcl_GetKeyedListField (tcl_interp, fieldName, keyedList, fieldValuePtr) if (fieldName == '\0') { - tcl_interp->result = "null key not allowed"; + Tcl_AppendResult(tcl_interp, "null key not allowed", NULL); return TCL_ERROR; } @@ -862,7 +860,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha * Handle retrieving a value for a specified key. */ if (argv [2] == '\0') { - tcl_interp->result = "null key not allowed"; + Tcl_AppendResult(tcl_interp, "null key not allowed", NULL); return TCL_ERROR; } if ((argc == 4) && (argv [3][0] == '\0')) @@ -884,7 +882,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha "\" not found in keyed list", (char *) NULL); return TCL_ERROR; } else { - tcl_interp->result = zero; + Tcl_AppendResult(tcl_interp, zero, NULL); return TCL_OK; } } @@ -901,7 +899,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha * Handle null return variable specified and key was found. */ if (argv [3][0] == '\0') { - tcl_interp->result = one; + Tcl_AppendResult(tcl_interp, one, NULL); return TCL_OK; } @@ -913,7 +911,7 @@ int Tcl_KeylgetCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, cha else result = TCL_OK; ckfree (fieldValue); - tcl_interp->result = one; + Tcl_AppendResult(tcl_interp, one, NULL); return result; } @@ -1199,7 +1197,7 @@ int Tcl_LemptyCmd (ClientData clientData, Tcl_Interp *tcl_interp, int argc, char scanPtr = argv [1]; while ((*scanPtr != '\0') && (ISSPACE (*scanPtr))) scanPtr++; - sprintf (tcl_interp->result, "%d", (*scanPtr == '\0')); + Tcl_AppendResult(tcl_interp, (*scanPtr == '\0') ? "1" : "0", NULL); return TCL_OK; } @@ -1430,7 +1428,7 @@ struct timeval now1; int code; Tcl_DStringInit(&ds); if (Tcl_SplitList(tcl_interp,mark->command,&argc,&argv) != TCL_OK) - putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, tcl_interp->result); + putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, Tcl_GetStringResult(tcl_interp)); else { for (i=0; icmd); */ Tcl_DStringFree(&ds); if (code!=TCL_OK) - putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, tcl_interp->result); + putlog(LOG_CRAP,"*","(Timer) Error for '%s': %s", mark->command, Tcl_GetStringResult(tcl_interp)); } } else