Index: kitdll/buildsrc/kitdll-0.0/Makefile.in ================================================================== --- kitdll/buildsrc/kitdll-0.0/Makefile.in +++ kitdll/buildsrc/kitdll-0.0/Makefile.in @@ -52,9 +52,10 @@ distclean: clean rm -f config.status config.log rm -f *~ rm -f Makefile + rm -rf starpack.vfs mrproper: distclean .PHONY: all clean distclean Index: kitdll/buildsrc/kitdll-0.0/aclocal.m4 ================================================================== --- kitdll/buildsrc/kitdll-0.0/aclocal.m4 +++ kitdll/buildsrc/kitdll-0.0/aclocal.m4 @@ -254,5 +254,32 @@ done AC_SUBST(WISH_CFLAGS) AC_SUBST(ARCHS) ]) + +AC_DEFUN(DC_CHECK_FOR_ACCEPTABLE_DLADDR, [ + AC_CHECK_HEADERS(dlfcn.h) + AC_CHECK_FUNCS(dladdr) + + AC_MSG_CHECKING([for acceptable dladdr]) + + AC_LINK_IFELSE( + AC_LANG_PROGRAM([[ +#ifdef HAVE_DLFCN_H +#include +#endif + ]], [[ +char *x; +Dl_info syminfo; +dladdr((void *) 0, &syminfo); +x = syminfo.dli_fname; + ]] + ), + [ + AC_MSG_RESULT([found]) + AC_DEFINE(HAVE_ACCEPTABLE_DLADDR, [1], [Define to 1 if you have an acceptable dladdr implementation with dli_fname]) + ], [ + AC_MSG_RESULT([not found]) + ] + ) +]) Index: kitdll/buildsrc/kitdll-0.0/boot.tcl ================================================================== --- kitdll/buildsrc/kitdll-0.0/boot.tcl +++ kitdll/buildsrc/kitdll-0.0/boot.tcl @@ -1,22 +1,22 @@ proc tclInit {} { rename tclInit {} global auto_path tcl_library tcl_libPath - global tcl_version tcl_rcFileName + global tcl_version # Set path where to mount VFS - set noe "/.KITDLL_TCL" + set tcl_mountpoint "/.KITDLL_TCL" - set tcl_library [file join $noe lib tcl$tcl_version] - set tcl_libPath [list $tcl_library [file join $noe lib]] + set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version] + set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]] # get rid of a build residue unset -nocomplain ::tclDefaultLibrary # the following code only gets executed once on startup - if {[info exists tcl_rcFileName]} { + if {[info exists ::initVFS]} { set vfsHandler [list ::vfs::kitdll::vfshandler tcl] # alter path to find encodings if {[info tclversion] eq "8.4"} { load {} pwb @@ -48,21 +48,22 @@ # now remount the executable with the correct encoding vfs::filesystem unmount [lindex [::vfs::filesystem info] 0] # Resolve symlinks - set noe [file dirname [file normalize [file join $noe __dummy__]]] - - set tcl_library [file join $noe lib tcl$tcl_version] - set tcl_libPath [list $tcl_library [file join $noe lib]] - - vfs::filesystem mount $noe $vfsHandler - } - + set tcl_mountpoint [file dirname [file normalize [file join $tcl_mountpoint __dummy__]]] + + set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version] + set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]] + + vfs::filesystem mount $tcl_mountpoint $vfsHandler + + } + # load config settings file if present namespace eval ::vfs { variable tclkit_version 1 } - catch { uplevel #0 [list source [file join $noe config.tcl]] } + catch { uplevel #0 [list source [file join $tcl_mountpoint config.tcl]] } uplevel #0 [list source [file join $tcl_library init.tcl]] # reset auto_path, so that init.tcl's search outside of tclkit is cancelled set auto_path $tcl_libPath @@ -69,6 +70,35 @@ # This loads everything needed for "clock scan" to work # "clock scan" is used within "vfs::zip", which may be # loaded before this is run causing the root VFS to break catch { clock scan } + + # Load these, the original Tclkit does so it should be safe. + uplevel #0 [list source [file join $tcl_mountpoint lib vfs vfsUtils.tcl]] + + # Now that the initialization is complete, mount the user VFS if needed + ## Mount the VFS from the Shared Object + if {[info exists ::initVFS] && [info exists ::tclKitFilename]} { + catch { + package require vfs::zip + + vfs::zip::Mount $::tclKitFilename "/.KITDLL_USER" + + lappend auto_path [file normalize "/.KITDLL_USER/lib"] + } + } + + ## Mount the VFS from executable + if {[info exists ::initVFS]} { + catch { + package require vfs::zip + + vfs::zip::Mount [info nameofexecutable] "/.KITDLL_APP" + + lappend auto_path [file normalize "/.KITDLL_APP/lib"] + } + } + + # Clean up after the kitInit.c:preInitCmd + unset -nocomplain ::initVFS ::tclKitFilename } Index: kitdll/buildsrc/kitdll-0.0/configure.ac ================================================================== --- kitdll/buildsrc/kitdll-0.0/configure.ac +++ kitdll/buildsrc/kitdll-0.0/configure.ac @@ -35,8 +35,14 @@ AC_SUBST(EXTRA_OBJS) dnl Check for optional headers AC_HEADER_STDC AC_CHECK_HEADERS(unistd.h string.h strings.h) + +dnl Check for optional system calls +AC_CHECK_FUNCS(readlink) + +dnl Check for acceptable dladdr so we can find ourselves on UNIX +DC_CHECK_FOR_ACCEPTABLE_DLADDR dnl Produce output AC_OUTPUT(Makefile) Index: kitdll/buildsrc/kitdll-0.0/kitInit.c ================================================================== --- kitdll/buildsrc/kitdll-0.0/kitInit.c +++ kitdll/buildsrc/kitdll-0.0/kitInit.c @@ -7,15 +7,28 @@ #ifdef _WIN32 # define WIN32_LEAN_AND_MEAN # include # undef WIN32_LEAN_AND_MEAN #endif /* _WIN32 */ + +#ifdef HAVE_STRING_H +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_DLFCN_H +# include +#endif #include "tclInt.h" #if defined(HAVE_TCL_GETENCODINGNAMEFROMENVIRONMENT) && defined(HAVE_TCL_SETSYSTEMENCODING) # define TCLKIT_CAN_SET_ENCODING 1 +#endif +#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85 +# define TCLKIT_REQUIRE_TCLEXECUTABLENAME 1 #endif #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85 # define KIT_INCLUDES_PWB 1 #endif @@ -29,19 +42,27 @@ #endif #ifdef _WIN32 Tcl_AppInitProc Dde_Init, Registry_Init; #endif +/* + * This Tcl code is invoked whenever Tcl_Init() is called on an + * interpreter. It should mount up the VFS and make everything ready for + * that interpreter to do its job. + */ static char *preInitCmd = "proc tclKitInit {} {\n" "rename tclKitInit {}\n" "load {} tclkit::init\n" "load {} rechan\n" "load {} vfs\n" "load {} vfs_kitdll_data_tcl\n" #include "vfs_kitdll.tcl.h" - "vfs::kitdll::Mount tcl /.KITDLL_TCL\n" + "if {![file exists \"/.KITDLL_TCL/boot.tcl\"]} {\n" + "vfs::kitdll::Mount tcl /.KITDLL_TCL\n" + "set ::initVFS 1\n" + "}\n" "set f [open \"/.KITDLL_TCL/boot.tcl\"]\n" "set s [read $f]\n" "close $f\n" "::tclkit::init::initInterp\n" "rename ::tclkit::init::initInterp {}\n" @@ -56,16 +77,150 @@ "catch {load {} registry}\n" #endif /* _WIN32 */ "}\n" "tclKitInit"; +#ifdef HAVE_ACCEPTABLE_DLADDR +/* Symbol to resolve against dladdr() */ +static void _tclkit_dummy_func(void) { + return; +} + +int main(int argc, char **argv); +#endif /* HAVE_ACCEPTABLE_DLADDR */ + +/* + * This function will return a pathname we can open() to treat as a VFS, + * hopefully + */ +static char *find_tclkit_dll_path(void) { +#ifdef HAVE_ACCEPTABLE_DLADDR + Dl_info syminfo; + int dladdr_ret; +#endif /* HAVE_ACCEPTABLE_DLADDR */ +#ifdef _WIN32 + TCHAR modulename[8192]; + DWORD gmfn_ret; +#endif /* _WIN32 */ + +#ifdef HAVE_ACCEPTABLE_DLADDR + dladdr_ret = dladdr(&_tclkit_dummy_func, &syminfo); + if (dladdr_ret != 0) { + if (syminfo.dli_fname && syminfo.dli_fname[0] != '\0') { + return(strdup(syminfo.dli_fname)); + } + } +#endif /* HAVE_ACCEPTABLE_DLADDR */ + +#ifdef _WIN32 + gmfn_ret = GetModuleFileName(TclWinGetTclInstance(), modulename, sizeof(modulename) / sizeof(modulename[0]) - 1); + + if (gmfn_ret != 0) { + return(strdup(modulename)); + } +#endif /* _WIN32 */ + + return(NULL); +} + +/* SetExecName -- + + Hack to get around Tcl bug 1224888. +*/ +static void SetExecName(Tcl_Interp *interp, const char *path) { +#ifdef TCLKIT_REQUIRE_TCLEXECUTABLENAME + tclExecutableName = strdup(path); +#endif + Tcl_FindExecutable(path); + + return; +} + +static void FindAndSetExecName(Tcl_Interp *interp) { + int len = 0; + Tcl_Obj *execNameObj; + Tcl_Obj *lobjv[1]; +#ifdef HAVE_READLINK + ssize_t readlink_ret; + char exe_buf[4096]; +#endif /* HAVE_READLINK */ +#ifdef HAVE_ACCEPTABLE_DLADDR + Dl_info syminfo; + int dladdr_ret; +#endif /* HAVE_ACCEPTABLE_DLADDR */ + +#ifdef HAVE_READLINK + if (Tcl_GetNameOfExecutable() == NULL) { + readlink_ret = readlink("/proc/self/exe", exe_buf, sizeof(exe_buf) - 1); + + if (readlink_ret > 0 && readlink_ret < (sizeof(exe_buf) - 1)) { + exe_buf[readlink_ret] = '\0'; + + SetExecName(interp, exe_buf); + + return; + } + } + + if (Tcl_GetNameOfExecutable() == NULL) { + readlink_ret = readlink("/proc/curproc/file", exe_buf, sizeof(exe_buf) - 1); + + if (readlink_ret > 0 && readlink_ret < (sizeof(exe_buf) - 1)) { + exe_buf[readlink_ret] = '\0'; + + if (strcmp(exe_buf, "unknown") != 0) { + SetExecName(interp, exe_buf); + + return; + } + } + } +#endif /* HAVE_READLINK */ + +#ifdef HAVE_ACCEPTABLE_DLADDR + if (Tcl_GetNameOfExecutable() == NULL) { + dladdr_ret = dladdr(&main, &syminfo); + if (dladdr_ret != 0) { + SetExecName(interp, syminfo.dli_fname); + } + } +#endif /* HAVE_ACCEPTABLE_DLADDR */ + + if (Tcl_GetNameOfExecutable() == NULL) { + lobjv[0] = Tcl_GetVar2Ex(interp, "argv0", NULL, TCL_GLOBAL_ONLY); + execNameObj = Tcl_FSJoinToPath(Tcl_FSGetCwd(interp), 1, lobjv); + + SetExecName(interp, Tcl_GetStringFromObj(execNameObj, &len)); + + return; + } + + return; +} + + +/* + * This function exists to allow C code to initialize a particular + * interpreter. + */ static int tclkit_init_initinterp(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + char *kitdll_path; + #ifdef _WIN32 Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY); #else Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY); #endif + + kitdll_path = find_tclkit_dll_path(); + if (kitdll_path != NULL) { + Tcl_SetVar(interp, "tclKitFilename", kitdll_path, TCL_GLOBAL_ONLY); + + free(kitdll_path); + } + + FindAndSetExecName(interp); #ifdef TCLKIT_CAN_SET_ENCODING /* Set the encoding from the Environment */ Tcl_GetEncodingNameFromEnvironment(&encodingName); Tcl_SetSystemEncoding(NULL, Tcl_DStringValue(&encodingName)); @@ -74,10 +229,16 @@ #endif return(TCL_OK); } +/* + * Create a package for initializing a particular interpreter. This is + * our hook to have Tcl invoke C commands when creating an interpreter. + * The preInitCmd will load the package in the new interpreter and invoke + * this function. + */ int Tclkit_init_Init(Tcl_Interp *interp) { Tcl_Command tclCreatComm_ret; int tclPkgProv_ret; tclCreatComm_ret = Tcl_CreateObjCommand(interp, "::tclkit::init::initInterp", tclkit_init_initinterp, NULL, NULL); @@ -88,10 +249,14 @@ tclPkgProv_ret = Tcl_PkgProvide(interp, "tclkit::init", "1.0"); return(tclPkgProv_ret); } +/* + * Initialize the Tcl system when we are loaded, that way Tcl functions + * are ready to be used when invoked. + */ void __attribute__((constructor)) _Tclkit_Init(void) { Tcl_StaticPackage(0, "tclkit::init", Tclkit_init_Init, NULL); Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL); Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL); Tcl_StaticPackage(0, "vfs_kitdll_data_tcl", Vfs_kitdll_data_tcl_Init, NULL);