tallship
/
bitchx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Kevin Easton 2017-07-01 00:47:20 +10:00
parent 356eb699d0
commit ac84793dd6
6 changed files with 80 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Changelog
View File

@ -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

5
include/tcl_bx.h
View File

@ -28,6 +28,11 @@ void tcl_load (char *, char *, char *, char *);
#define USE_NON_CONST
#include <tcl.h>
#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 *);

4
source/bot_link.c
View File

@ -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

41
source/commands.c
View File

@ -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);
}
}

53
source/tcl.c
View File

@ -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;
}

28
source/tcl_public.c
View File

@ -41,8 +41,6 @@ cmd_t C_dcc[] =
};
#ifdef WANT_TCL
#include <tcl.h>
/*
* 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; i<argc; i++)
@ -1440,7 +1438,7 @@ struct timeval now1;
/* code=Tcl_Eval(tcl_interp,mark->cmd); */
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