* Add libtcl dynamic loading

src/Makefile.in

@@ -37,6 +37,7 @@ OBJS = auth.o \
 	garble.o \
 	libcrypto.o \
 	libssl.o \
+	libtcl.o \
 	log.o \
 	main.o \
 	match.o \

src/libtcl.c

@@ -0,0 +1,125 @@
+/*
+ * Copyright (C) 1997 Robey Pointer
+ * Copyright (C) 1999 - 2002 Eggheads Development Team
+ * Copyright (C) 2002 - 2010 Bryan Drewery
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+ */
+
+/*
+ * tcl.c -- handles:
+ *   libtcl handling
+ *
+ */
+
+
+#include "common.h"
+#include "main.h"
+#include "dl.h"
+#include <tcl.h>
+#include <bdlib/src/String.h>
+#include <bdlib/src/Array.h>
+
+#include "libtcl.h"
+
+Tcl_Interp *global_interp = NULL;
+void *libtcl_handle = NULL;
+static bd::Array<bd::String> my_symbols;
+
+void initialize_binds_tcl();
+
+static int load_symbols(void *handle) {
+  const char *dlsym_error = NULL;
+
+  DLSYM_GLOBAL(handle, Tcl_Eval);
+  DLSYM_GLOBAL(handle, Tcl_GetStringResult);
+  DLSYM_GLOBAL(handle, Tcl_DeleteInterp);
+  DLSYM_GLOBAL(handle, Tcl_CreateCommand);
+  DLSYM_GLOBAL(handle, Tcl_AppendResult);
+  DLSYM_GLOBAL(handle, Tcl_CreateInterp);
+  DLSYM_GLOBAL(handle, Tcl_FindExecutable);
+  DLSYM_GLOBAL(handle, Tcl_Init);
+
+  return 0;
+}
+
+int load_libtcl() {
+  if (global_interp) {
+    return 0;
+  }
+
+  bd::Array<bd::String> libs_list(bd::String("libtcl.so libtcl83.so libtcl8.3.so libtcl84.so libtcl8.4.so libtcl85.so libtcl8.5.so").split(' '));
+
+  for (size_t i = 0; i < libs_list.length(); ++i) {
+    dlerror(); // Clear Errors
+    libtcl_handle = dlopen(bd::String(libs_list[i]).c_str(), RTLD_LAZY);
+    if (libtcl_handle) break;
+  }
+  if (!libtcl_handle) {
+    sdprintf("Unable to find libtcl");
+    return 1;
+  }
+
+  load_symbols(libtcl_handle);
+
+  // create interp
+  global_interp = Tcl_CreateInterp();
+  Tcl_FindExecutable(binname);
+
+  if (Tcl_Init(global_interp) != TCL_OK) {
+    sdprintf("Tcl_Init error: %s", Tcl_GetStringResult(global_interp));
+    return 1;
+  }
+
+  initialize_binds_tcl();
+
+  return 0;
+}
+
+void initialize_binds_tcl() {
+}
+
+int unload_libtcl() {
+  if (libtcl_handle) {
+    if (global_interp) {
+      Tcl_DeleteInterp(global_interp);
+      global_interp = NULL;
+    }
+
+    // Cleanup symbol table
+    for (size_t i = 0; i < my_symbols.length(); ++i) {
+      dl_symbol_table.remove(my_symbols[i]);
+      static_cast<bd::String>(my_symbols[i]).clear();
+    }
+    my_symbols.clear();
+
+    dlclose(libtcl_handle);
+    libtcl_handle = NULL;
+    return 0;
+  }
+  return 1;
+}
+
+
+bd::String tcl_eval(const bd::String& str) {
+  load_libtcl();
+  if (!global_interp) return bd::String();
+  if (Tcl_Eval(global_interp, str.c_str()) == TCL_OK) {
+    return Tcl_GetStringResult(global_interp);
+  } else
+    return tcl_eval("set errorInfo");
+  return bd::String();
+}
+

src/libtcl.h

@@ -0,0 +1,37 @@
+#ifndef _LIBTCL_H
+#define _LIBTCL_H
+
+#include "common.h"
+#include "dl.h"
+#include <bdlib/src/String.h>
+#include <tcl.h>
+
+typedef int (*Tcl_Eval_t)(Tcl_Interp*, const char*);
+typedef void (*Tcl_AppendResult_t)(Tcl_Interp*, ...);
+typedef void (*Tcl_CreateCommand_t)(Tcl_Interp*, const char*, Tcl_CmdProc*, ClientData, Tcl_CmdDeleteProc*);
+typedef const char* (*Tcl_GetStringResult_t)(Tcl_Interp*);
+typedef int (*Tcl_DeleteInterp_t)(Tcl_Interp*);
+typedef Tcl_Interp* (*Tcl_CreateInterp_t)();
+typedef void (*Tcl_FindExecutable_t)(const char*);
+typedef int (*Tcl_Init_t)(Tcl_Interp*);
+
+#include ".defs/libtcl_defs.h"
+
+#define STDVAR (ClientData cd, Tcl_Interp *interp, int argc, const char *argv[])
+
+#define BADARGS(nl, nh, example) do {                               \
+	if ((argc < (nl)) || (argc > (nh))) {                       \
+		Tcl_AppendResult(interp, "wrong # args: should be \"", \
+			argv[0], (example), "\"", NULL);            \
+		return TCL_ERROR;                                   \
+	}                                                           \
+} while (0)
+
+extern Tcl_Interp *global_interp;
+
+int load_libtcl();
+int unload_libtcl();
+bd::String tcl_eval(const bd::String&);
+
+
+#endif /* !_LIBTCL_H */