Index: build-dyn.sh ================================================================== --- build-dyn.sh +++ build-dyn.sh @@ -6,7 +6,7 @@ # Compile using the same options as Tcl TCLCONFIGSH="$(find /usr/lib /usr/lib64 /usr/local/lib /usr/local/lib64 /lib /lib64 -name tclConfig.sh -print -quit)" . "${TCLCONFIGSH}" -echo "${TCL_CC} -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o system.so system.c" -eval ${TCL_CC} -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o system.so system.c +echo "${TCL_CC} -ggdb3 -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o system.so system.c" +eval ${TCL_CC} -ggdb3 -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o system.so system.c Index: system.c ================================================================== --- system.c +++ system.c @@ -1,10 +1,11 @@ #define _LINUX_SOURCE 1 #include #include #include #include +#include #include #include #include #include #include @@ -1877,16 +1878,16 @@ return(retval); } static int tclsystem_tsmf_start_svc(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct timeval select_timeout; - Tcl_WideInt umask_tclval; - Tcl_Obj *filename_obj, *env_obj, *logfile_obj, **env_entry_objv, *cwd_obj, *umask_obj, *user_obj, *group_obj, *sri_obj; + Tcl_WideInt umask_val, timeout_val; + Tcl_Obj *filename_obj, *env_obj, *logfile_obj, **env_entry_objv, *cwd_obj, *umask_obj, *user_obj, *group_obj; + Tcl_Obj *sri_obj, *timeout_obj; pid_t child, child_pgid = -1; ssize_t read_ret; time_t currtime; - mode_t umask_val; char *argv[3], *envv[512]; char *logfile, *filename, *cwd, *user, *group; char logmsg[2048]; fd_set read_fdset; int pipe_ret, setsid_ret, execve_ret, tcl_ret, select_ret; @@ -1896,12 +1897,12 @@ int status; int idx; /* 1. Parse arguments */ /* 1.a. Ensure the correct number of arguments were passed */ - if (objc != 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::tsmf_start_svc sri filename logfile env cwd umask user group\"", -1)); + if (objc != 10) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::tsmf_start_svc sri filename logfile env cwd umask user group timeout\"", -1)); return(TCL_ERROR); } /* 1.b. Identify Tcl_Objs to use for each argument */ @@ -1911,26 +1912,30 @@ env_obj = objv[4]; cwd_obj = objv[5]; umask_obj = objv[6]; user_obj = objv[7]; group_obj = objv[8]; + timeout_obj = objv[9]; /* 1.c. Store string arguments */ filename = Tcl_GetString(filename_obj); logfile = Tcl_GetString(logfile_obj); cwd = Tcl_GetString(cwd_obj); user = Tcl_GetString(user_obj); group = Tcl_GetString(group_obj); /* 1.d. Integer objects */ - tcl_ret = Tcl_GetWideIntFromObj(interp, umask_obj, &umask_tclval); + tcl_ret = Tcl_GetWideIntFromObj(interp, umask_obj, &umask_val); + if (tcl_ret != TCL_OK) { + return(tcl_ret); + } + + tcl_ret = Tcl_GetWideIntFromObj(interp, timeout_obj, &timeout_val); if (tcl_ret != TCL_OK) { return(tcl_ret); } - umask_val = umask_tclval; - /* 1.e. Process environment */ tcl_ret = Tcl_ListObjGetElements(interp, env_obj, &env_entry_objc, &env_entry_objv); if (tcl_ret != TCL_OK) { return(tcl_ret); } @@ -1961,11 +1966,11 @@ /* 4.parent.a. Close write end of pipe -- we are read-only */ close(fds[1]); fd = fds[0]; /* 4.parent.b. Read process group ID of child from pipe */ - select_timeout.tv_sec = 30; + select_timeout.tv_sec = timeout_val; select_timeout.tv_usec = 0; FD_ZERO(&read_fdset); FD_SET(fd, &read_fdset); Index: test.tcl ================================================================== --- test.tcl +++ test.tcl @@ -1,10 +1,12 @@ #! /usr/bin/env tclsh puts [exec ./build-dyn.sh] load ./system.so + +::system::syscall::tsmf_start_svc blah /bin/true /tmp/logfile [list PATH=/bin] / 022 root root foreach iface [system::syscall::ifconfig] { #lo0:2: flags=2001000849 mtu 8232 index 1 # inet 127.0.0.1 netmask ff000000 #aggr100003:1: flags=201000843 mtu 1500 index 2