ADDED .fossil-settings/ignore-glob Index: .fossil-settings/ignore-glob ================================================================== --- /dev/null +++ .fossil-settings/ignore-glob @@ -0,0 +1,5 @@ +tuapi.so +libtuapi.a +tuapi.o +tuapi.tcl.h +pkgIndex.tcl Index: build-common.sh ================================================================== --- build-common.sh +++ build-common.sh @@ -3,12 +3,14 @@ set -e case "$1" in clean|distclean) rm -rf out inst - rm -f libsystem.a system.o system.so - rm -f system.tcl.h + rm -f libtuapi.a tuapi.o tuapi.so + rm -f tuapi.tcl.h exit 0 ;; esac -./stringify.tcl system.tcl > system.tcl.h +tuapi_version="$(grep Tcl_PkgProvide system.c | awk '{ print $3 }' | sed 's@[");]*@@g')" + +./stringify.tcl system.tcl > tuapi.tcl.h Index: build-dyn.sh ================================================================== --- build-dyn.sh +++ build-dyn.sh @@ -6,7 +6,9 @@ # 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} -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 +echo "${TCL_CC} -ggdb3 -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o tuapi.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 tuapi.so system.c + +echo 'package ifneeded tuapi '"${tuapi_version}"' [list load [file join $dir tuapi.so]]' > pkgIndex.tcl Index: build-static.sh ================================================================== --- build-static.sh +++ build-static.sh @@ -5,13 +5,14 @@ # Define variables KITCREATORROOT="$(readlink -f '..')" # Compile using the same options as Tcl -TCLCONFIGSH='/usr/lib/tclConfig.sh' +TCLCONFIGSH='/usr/lib64/tclConfig.sh' . "${TCLCONFIGSH}" -echo "diet ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c" -eval diet ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c -ar rcu libsystem.a system.o -ranlib libsystem.a +echo "${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o tuapi.o -c system.c" +eval ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o tuapi.o -c system.c +ar rcu libtuapi.a tuapi.o +ranlib libtuapi.a +echo 'package ifneeded tuapi '"${tuapi_version}"' [list load {} tuapi]' > pkgIndex.tcl Index: build.sh ================================================================== --- build.sh +++ build.sh @@ -9,14 +9,16 @@ # Compile using the same options as Tcl TCLCONFIGSH="${KITCREATORROOT}/tcl/inst/lib/tclConfig.sh" . "${TCLCONFIGSH}" -echo "${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c" -eval ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c -ar rcu libsystem.a system.o -ranlib libsystem.a - -mkdir -p inst/lib/system1.0 -mkdir -p out/lib/system1.0 -cp libsystem.a inst/lib/system1.0 -cp pkgIndex.tcl out/lib/system1.0 +echo "${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o tuapi.o -c system.c" +eval ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o tuapi.o -c system.c +ar rcu libtuapi.a tuapi.o +ranlib libtuapi.a + +echo 'package ifneeded tuapi '"${tuapi_version}"' [list load {} tuapi]' > pkgIndex.tcl + +mkdir -p inst/lib/tuapi-0.1 +mkdir -p out/lib/tuapi-0.1 +cp libtuapi.a inst/lib/tuapi-0.1 +cp pkgIndex.tcl out/lib/tuapi-0.1 DELETED pkgIndex.tcl Index: pkgIndex.tcl ================================================================== --- pkgIndex.tcl +++ /dev/null @@ -1,1 +0,0 @@ -package ifneeded system 0.1 [list load "" system] Index: system.c ================================================================== --- system.c +++ system.c @@ -68,11 +68,11 @@ #endif /* * Simple hash routine to enable switching on a string to be implemented */ -static unsigned long tclsystem_internal_simplehash(const void *databuf, int datalen) { +static unsigned long tuapi_internal_simplehash(const void *databuf, int datalen) { unsigned long retval = 0; const unsigned char *data; data = databuf; @@ -84,57 +84,57 @@ } return(retval); } -static unsigned long tclsystem_internal_simplehash_obj(Tcl_Obj *tcl_data) { +static unsigned long tuapi_internal_simplehash_obj(Tcl_Obj *tcl_data) { unsigned long retval; char *data; int datalen = -1; data = Tcl_GetStringFromObj(tcl_data, &datalen); - retval = tclsystem_internal_simplehash(data, datalen); + retval = tuapi_internal_simplehash(data, datalen); return(retval); } #if 0 /* NOTUSED: Uncomment when needed: */ -static unsigned long tclsystem_internal_simplehash_str(const char *data) { +static unsigned long tuapi_internal_simplehash_str(const char *data) { unsigned long retval; int datalen; datalen = strlen(data); - retval = tclsystem_internal_simplehash(data, datalen); + retval = tuapi_internal_simplehash(data, datalen); return(retval); } #endif -static int tclsystem_internalproc_simplehash(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_internalproc_simplehash(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { unsigned long hashval; Tcl_Obj *hashval_obj; if (objc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::internal::hash value\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::internal::hash value\"", -1)); return(TCL_ERROR); } - hashval = tclsystem_internal_simplehash_obj(objv[1]); + hashval = tuapi_internal_simplehash_obj(objv[1]); hashval_obj = Tcl_NewObj(); Tcl_SetWideIntObj(hashval_obj, hashval); Tcl_SetObjResult(interp, hashval_obj); return(TCL_OK); } -static int tclsystem_internal_getsock(int *sock_v4_out, int *sock_v6_out) { +static int tuapi_internal_getsock(int *sock_v4_out, int *sock_v6_out) { int sock_v4 = -1, sock_v6 = -1; int sock; if (sock_v4_out == NULL && sock_v6_out == NULL) { return(-1); @@ -183,20 +183,20 @@ * * These procedures should minimally wrap Linux or UNIX system calls to * expose to the Tcl-level. Where possible accept symbolic names rather * than numeric values (.e.g, list of values to OR together to get flags). */ -static int tclsystem_mount(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_mount(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_Obj *mountflags_obj, **mountflags_list, *mountflag; int mountflags_list_len; char *source, *target, *fstype; unsigned long mountflags = 0; void *data = NULL; int mount_ret, tcl_ret; if (objc < 5 || objc > 6) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::mount source target fstype mountflags ?data?\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::mount source target fstype mountflags ?data?\"", -1)); return(TCL_ERROR); } source = Tcl_GetString(objv[1]); @@ -214,11 +214,11 @@ } for (; mountflags_list_len > 0; mountflags_list_len--,mountflags_list++) { mountflag = mountflags_list[0]; - switch (tclsystem_internal_simplehash_obj(mountflag)) { + switch (tuapi_internal_simplehash_obj(mountflag)) { #ifdef MS_BIND case 0x8526744: /* BIND */ mountflags |= MS_BIND; break; #endif @@ -310,20 +310,20 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj(target, -1)); return(TCL_OK); } -static int tclsystem_umount(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_umount(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_Obj **flags, *flag; Tcl_Obj *pathname_obj; char *pathname; int umount2_flags = 0; int flags_cnt; int chk_ret, tcl_ret; if (objc < 2 || objc > 3) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::umount dir ?flags?\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"tuapi::syscall::umount dir ?flags?\"", -1)); return(TCL_ERROR); } pathname_obj = objv[1]; @@ -339,11 +339,11 @@ } for (; flags_cnt > 0; flags_cnt--,flags++) { flag = flags[0]; - switch (tclsystem_internal_simplehash_obj(flag)) { + switch (tuapi_internal_simplehash_obj(flag)) { case 0x69f4a3c5: /* FORCE */ umount2_flags |= MNT_FORCE; break; case 0x5a9173c8: /* DETACH */ @@ -380,16 +380,16 @@ } return(TCL_OK); } -static int tclsystem_swapon(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_swapon(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char *pathname; int chk_ret; if (objc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::swapon pathname\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"tuapi::syscall::swapon pathname\"", -1)); return(TCL_ERROR); } pathname = Tcl_GetString(objv[1]); @@ -402,16 +402,16 @@ } return(TCL_OK); } -static int tclsystem_swapoff(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_swapoff(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char *pathname; int chk_ret; if (objc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::swapoff pathname\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"tuapi::syscall::swapoff pathname\"", -1)); return(TCL_ERROR); } pathname = Tcl_GetString(objv[1]); @@ -424,19 +424,19 @@ } return(TCL_OK); } -static int tclsystem_insmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_insmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_Channel fd; Tcl_Obj *module_filename, *module_data; void *module_data_val; int module_data_len; int read_ret, chk_ret; if (objc < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::insmod filename ?args ...?\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"tuapi::syscall::insmod filename ?args ...?\"", -1)); return(TCL_ERROR); } module_filename = objv[1]; @@ -475,23 +475,23 @@ } return(TCL_OK); } -static int tclsystem_rmmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_rmmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_lsmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_lsmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_hostname(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_hostname(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char hostname[HOST_NAME_MAX + 1]; int chk_ret; if (objc == 1) { /* No arguments given, just return the hostname */ @@ -529,22 +529,22 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"hostname ?hostname?\"", -1)); return(TCL_ERROR); } -static int tclsystem_domainname(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_domainname(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_chroot(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_chroot(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char *pathname; int chk_ret; if (objc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall:chroot pathname\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall:chroot pathname\"", -1)); return(TCL_ERROR); } pathname = Tcl_GetString(objv[1]); @@ -557,16 +557,16 @@ } return(TCL_OK); } -static int tclsystem_pivot_root(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_pivot_root(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char *new_root, *put_old; int chk_ret; if (objc != 3) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::pivot_root new_root put_old\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::pivot_root new_root put_old\"", -1)); return(TCL_ERROR); } new_root = Tcl_GetString(objv[1]); @@ -580,32 +580,32 @@ } return(TCL_OK); } -static int tclsystem_mknod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_mknod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_getuid(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_getuid(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_kill(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_kill(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_Obj *signal_obj; Tcl_WideInt pid_wide, sig_wide; pid_t pid; int sig; int kill_ret, tcl_ret; if (objc != 3) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::kill pid sig\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::kill pid sig\"", -1)); return(TCL_ERROR); } tcl_ret = Tcl_GetWideIntFromObj(interp, objv[1], &pid_wide); @@ -616,11 +616,11 @@ signal_obj = objv[2]; tcl_ret = Tcl_GetWideIntFromObj(interp, signal_obj, &sig_wide); if (tcl_ret != TCL_OK) { - switch (tclsystem_internal_simplehash_obj(signal_obj)) { + switch (tuapi_internal_simplehash_obj(signal_obj)) { case 0x122ad0: /* HUP */ case 0x98f364d0: /* SIGHUP */ sig = SIGHUP; break; case 0x126754: /* INT */ @@ -764,23 +764,23 @@ } return(TCL_OK); } -static int tclsystem_ps(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_ps(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_execve(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_execve(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char **argv = NULL; char *file; int idx; if (objc < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::execve file ?args ...?\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::execve file ?args ...?\"", -1)); return(TCL_ERROR); } /* Find executable */ @@ -801,17 +801,17 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1)); return(TCL_ERROR); } -static int tclsystem_losetup(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_losetup(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char *file, *loopdev; int chk_ret; int loopfd, filefd; if (objc != 3) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::losetup loopdev file\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::losetup loopdev file\"", -1)); return(TCL_ERROR); } loopdev = Tcl_GetString(objv[1]); @@ -850,11 +850,11 @@ } return(TCL_OK); } -static void tclsystem_private_append_sockaddr_to_tclobj(Tcl_Interp *interp, Tcl_Obj *list, char *header, struct sockaddr *addr) { +static void tuapi_private_append_sockaddr_to_tclobj(Tcl_Interp *interp, Tcl_Obj *list, char *header, struct sockaddr *addr) { char addr_buf[INET6_ADDRSTRLEN + INET_ADDRSTRLEN + 1], *chk_inp; switch (addr->sa_family) { case AF_INET: /* IPv4 */ case AF_INET6: /* IPv6 */ @@ -881,11 +881,11 @@ } return; } -static int tclsystem_private_get_sockaddr_from_obj(Tcl_Obj *value, void *target) { +static int tuapi_private_get_sockaddr_from_obj(Tcl_Obj *value, void *target) { struct sockaddr_in local_v4; struct sockaddr_in6 local_v6; const char *addr_str; int inetpton_ret; @@ -912,11 +912,11 @@ } return(-1); } -static int tclsystem_ifconfig_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) { +static int tuapi_ifconfig_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) { Tcl_Obj *tcl_iface_list; struct ifconf ifaces_cfg; struct ifreq *iface_req = NULL; int iface_req_cnt = 224, iface_req_len; int idx, iface_cnt; @@ -962,11 +962,11 @@ Tcl_SetObjResult(interp, tcl_iface_list); return(TCL_OK); } -static int tclsystem_ifconfig_info(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock, int sock_v4, int sock_v6) { +static int tuapi_ifconfig_info(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock, int sock_v4, int sock_v6) { Tcl_Obj *retlist, *flags; struct ifreq iface_req; unsigned char *addr_data; const char *link_encap; const char *iface; @@ -1245,41 +1245,41 @@ } if (sock_v4 != -1) { ioctl_ret = ioctl(sock_v4, SIOCGIFADDR, &iface_req); if (ioctl_ret == 0) { - tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "address", &iface_req.ifr_addr); + tuapi_private_append_sockaddr_to_tclobj(interp, retlist, "address", &iface_req.ifr_addr); } if (flag_pointopoint) { /* Point-to-Point interfaces */ ioctl_ret = ioctl(sock_v4, SIOCGIFDSTADDR, &iface_req); if (ioctl_ret == 0) { - tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "destination", &iface_req.ifr_addr); + tuapi_private_append_sockaddr_to_tclobj(interp, retlist, "destination", &iface_req.ifr_addr); } } if (flag_broadcast) { /* Broadcast interfaces */ ioctl_ret = ioctl(sock_v4, SIOCGIFBRDADDR, &iface_req); if (ioctl_ret == 0) { - tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "broadcast", &iface_req.ifr_addr); + tuapi_private_append_sockaddr_to_tclobj(interp, retlist, "broadcast", &iface_req.ifr_addr); } } ioctl_ret = ioctl(sock_v4, SIOCGIFNETMASK, &iface_req); if (ioctl_ret == 0) { - tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "netmask", &iface_req.ifr_addr); + tuapi_private_append_sockaddr_to_tclobj(interp, retlist, "netmask", &iface_req.ifr_addr); } } Tcl_SetObjResult(interp, retlist); return(TCL_OK); } -static int tclsystem_ifconfig_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock, int sock_v4, int sock_v6) { +static int tuapi_ifconfig_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock, int sock_v4, int sock_v6) { Tcl_Obj *option_name_obj, *option_val_obj; Tcl_Obj **flags_objv; struct ifreq iface_req; struct sockaddr *tmp_ioctl_addr; const char *iface; @@ -1315,21 +1315,21 @@ objc--; objv++; option_val_obj = objv[0]; - switch (tclsystem_internal_simplehash_obj(option_name_obj)) { + switch (tuapi_internal_simplehash_obj(option_name_obj)) { case 0x6d9870f3: /* flags */ flags = 0; tcl_ret = Tcl_ListObjGetElements(interp, option_val_obj, &flags_objc, &flags_objv); if (tcl_ret != TCL_OK) { return(tcl_ret); } for (; flags_objc > 0; flags_objc--,flags_objv++) { - switch (tclsystem_internal_simplehash_obj(flags_objv[0])) { + switch (tuapi_internal_simplehash_obj(flags_objv[0])) { case 0x2ad0: /* UP */ flags |= IFF_UP; break; case 0x1aef7f54: /* BROADCAST */ flags |= IFF_BROADCAST; @@ -1429,11 +1429,11 @@ if (tmp_ioctl == -1) { tmp_ioctl = SIOCSIFNETMASK; tmp_ioctl_addr = &iface_req.ifr_netmask; } - parse_ret = tclsystem_private_get_sockaddr_from_obj(option_val_obj, tmp_ioctl_addr); + parse_ret = tuapi_private_get_sockaddr_from_obj(option_val_obj, tmp_ioctl_addr); if (parse_ret != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(option_val_obj))); return(TCL_ERROR); } @@ -1468,34 +1468,34 @@ } return(TCL_OK); } -static int tclsystem_ifconfig(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_ifconfig(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int sock_v4, sock_v6, sock; int retval = TCL_ERROR; - sock = tclsystem_internal_getsock(&sock_v4, &sock_v6); + sock = tuapi_internal_getsock(&sock_v4, &sock_v6); if (sock == -1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create socket", -1)); return(TCL_ERROR); } switch (objc) { case 0: case 1: /* No arguments, list all interfaces */ - retval = tclsystem_ifconfig_list(cd, interp, objc, objv, sock); + retval = tuapi_ifconfig_list(cd, interp, objc, objv, sock); break; case 2: /* One argument, give information about the interface */ - retval = tclsystem_ifconfig_info(cd, interp, objc, objv, sock, sock_v4, sock_v6); + retval = tuapi_ifconfig_info(cd, interp, objc, objv, sock, sock_v4, sock_v6); break; default: /* Otherwise, configure the interace */ - retval = tclsystem_ifconfig_conf(cd, interp, objc, objv, sock, sock_v4, sock_v6); + retval = tuapi_ifconfig_conf(cd, interp, objc, objv, sock, sock_v4, sock_v6); break; } /* Cleanup */ @@ -1508,37 +1508,37 @@ } return(retval); } -static int tclsystem_route_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock_v4, int sock_v6) { +static int tuapi_route_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock_v4, int sock_v6) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_route_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock_v4, int sock_v6) { +static int tuapi_route_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock_v4, int sock_v6) { Tcl_WideInt option_val_wide; Tcl_Obj *operation_obj, *dest_obj, *destmask_obj; Tcl_Obj *option_name_obj, *option_val_obj; struct rtentry route; int sock; int ioctl_id; int tcl_ret, ioctl_ret, parse_ret; if (objc < 4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::route operation destination destination_mask ?options?\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::route operation destination destination_mask ?options?\"", -1)); return(TCL_ERROR); } /* Clear object values */ memset(&route, 0, sizeof(route)); /* Determine operation */ operation_obj = objv[1]; - switch (tclsystem_internal_simplehash_obj(operation_obj)) { + switch (tuapi_internal_simplehash_obj(operation_obj)) { case 0x187264: /* add */ ioctl_id = SIOCADDRT; break; case 0x1932ec: /* del */ case 0x5d98e965: /* delete */ @@ -1553,20 +1553,20 @@ /* Set default flags */ route.rt_flags = RTF_UP; /* Parse destination address */ dest_obj = objv[2]; - parse_ret = tclsystem_private_get_sockaddr_from_obj(dest_obj, &route.rt_dst); + parse_ret = tuapi_private_get_sockaddr_from_obj(dest_obj, &route.rt_dst); if (parse_ret != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(dest_obj))); return(TCL_ERROR); } /* Parse destination netmask */ destmask_obj = objv[3]; - parse_ret = tclsystem_private_get_sockaddr_from_obj(destmask_obj, &route.rt_genmask); + parse_ret = tuapi_private_get_sockaddr_from_obj(destmask_obj, &route.rt_genmask); if (parse_ret != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(destmask_obj))); return(TCL_ERROR); } @@ -1629,13 +1629,13 @@ objc--; objv++; option_val_obj = objv[0]; - switch (tclsystem_internal_simplehash_obj(option_name_obj)) { + switch (tuapi_internal_simplehash_obj(option_name_obj)) { case 0x4c727779: /* gateway */ - parse_ret = tclsystem_private_get_sockaddr_from_obj(option_val_obj, &route.rt_gateway); + parse_ret = tuapi_private_get_sockaddr_from_obj(option_val_obj, &route.rt_gateway); if (parse_ret != 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(option_val_obj))); return(TCL_ERROR); } @@ -1694,30 +1694,30 @@ } return(TCL_OK); } -static int tclsystem_route(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_route(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int sock_v4, sock_v6, sock; int retval = TCL_ERROR; - sock = tclsystem_internal_getsock(&sock_v4, &sock_v6); + sock = tuapi_internal_getsock(&sock_v4, &sock_v6); if (sock == -1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create socket", -1)); return(TCL_ERROR); } switch (objc) { case 0: case 1: /* No arguments, list all interfaces */ - retval = tclsystem_route_list(cd, interp, objc, objv, sock_v4, sock_v6); + retval = tuapi_route_list(cd, interp, objc, objv, sock_v4, sock_v6); break; default: /* Otherwise, modify routes */ - retval = tclsystem_route_conf(cd, interp, objc, objv, sock_v4, sock_v6); + retval = tuapi_route_conf(cd, interp, objc, objv, sock_v4, sock_v6); break; } /* Cleanup */ @@ -1730,34 +1730,34 @@ } return(retval); } -static int tclsystem_brctl_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) { +static int tuapi_brctl_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR); } -static int tclsystem_brctl_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) { +static int tuapi_brctl_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) { Tcl_Obj *operation_obj, *bridge_name_obj, *interface_name_obj; unsigned long arg[4]; struct ifreq ifr; int ioctl_ret, ioctl_id; int add = 0; /* Determine operation */ operation_obj = objv[1]; - switch (tclsystem_internal_simplehash_obj(operation_obj)) { + switch (tuapi_internal_simplehash_obj(operation_obj)) { case 0x1c993272: /* addbr */ add = 1; case 0x4cbb3272: /* delbr */ if (objc != 3) { if (add) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::brctl addbr bridge\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::brctl addbr bridge\"", -1)); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::brctl delbr bridge\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::brctl delbr bridge\"", -1)); } return(TCL_ERROR); } @@ -1778,13 +1778,13 @@ case 0x1C9937E6: /* addif */ add = 1; case 0x4cbb37e6: /* delif */ if (objc != 4) { if (add) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::brctl addif bridge interface\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::brctl addif bridge interface\"", -1)); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::brctl delif bridge interface\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::brctl delif bridge interface\"", -1)); } return(TCL_ERROR); } @@ -1816,30 +1816,30 @@ } return(TCL_OK); } -static int tclsystem_brctl(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_brctl(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int sock_v4, sock_v6, sock; int retval = TCL_ERROR; - sock = tclsystem_internal_getsock(&sock_v4, &sock_v6); + sock = tuapi_internal_getsock(&sock_v4, &sock_v6); if (sock == -1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create socket", -1)); return(TCL_ERROR); } switch (objc) { case 0: case 1: /* No arguments, list all bridges */ - retval = tclsystem_brctl_list(cd, interp, objc, objv, sock); + retval = tuapi_brctl_list(cd, interp, objc, objv, sock); break; default: /* Otherwise, modify routes */ - retval = tclsystem_brctl_conf(cd, interp, objc, objv, sock); + retval = tuapi_brctl_conf(cd, interp, objc, objv, sock); break; } /* Cleanup */ @@ -1852,15 +1852,15 @@ } return(retval); } -static int tclsystem_vconfig(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_vconfig(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int sock_v4, sock_v6, sock; int retval = TCL_ERROR; - sock = tclsystem_internal_getsock(&sock_v4, &sock_v6); + sock = tuapi_internal_getsock(&sock_v4, &sock_v6); if (sock == -1) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create socket", -1)); return(TCL_ERROR); } @@ -1878,17 +1878,17 @@ return(retval); } #ifndef DISABLE_UNIX_SOCKETS -struct tclsystem_socket_unix__chan_id { +struct tuapi_socket_unix__chan_id { int fd; Tcl_Channel chan; }; -static int tclsystem_socket_unix__chan_close(ClientData id_p, Tcl_Interp *interp) { - struct tclsystem_socket_unix__chan_id *id; +static int tuapi_socket_unix__chan_close(ClientData id_p, Tcl_Interp *interp) { + struct tuapi_socket_unix__chan_id *id; int fd; id = id_p; fd = id->fd; @@ -1898,12 +1898,12 @@ free(id); return(0); } -static int tclsystem_socket_unix__chan_read(ClientData id_p, char *buf, int bufsize, int *errorCodePtr) { - struct tclsystem_socket_unix__chan_id *id; +static int tuapi_socket_unix__chan_read(ClientData id_p, char *buf, int bufsize, int *errorCodePtr) { + struct tuapi_socket_unix__chan_id *id; ssize_t read_ret; int fd; int retval; id = id_p; @@ -1920,12 +1920,12 @@ retval = read_ret; return(retval); } -static int tclsystem_socket_unix__chan_write(ClientData id_p, const char *buf, int toWrite, int *errorCodePtr) { - struct tclsystem_socket_unix__chan_id *id; +static int tuapi_socket_unix__chan_write(ClientData id_p, const char *buf, int toWrite, int *errorCodePtr) { + struct tuapi_socket_unix__chan_id *id; ssize_t write_ret; int fd; int bytesWritten; id = id_p; @@ -1957,12 +1957,12 @@ } return(bytesWritten); } -static void tclsystem_socket_unix__chan_eventhandler(ClientData id_p, int mask) { - struct tclsystem_socket_unix__chan_id *id; +static void tuapi_socket_unix__chan_eventhandler(ClientData id_p, int mask) { + struct tuapi_socket_unix__chan_id *id; Tcl_Channel chan; id = id_p; chan = id->chan; @@ -1972,25 +1972,25 @@ } Tcl_NotifyChannel(chan, mask); } -static void tclsystem_socket_unix__chan_watch(ClientData id_p, int mask) { - struct tclsystem_socket_unix__chan_id *id; +static void tuapi_socket_unix__chan_watch(ClientData id_p, int mask) { + struct tuapi_socket_unix__chan_id *id; int fd; id = id_p; fd = id->fd; - Tcl_CreateFileHandler(fd, mask, tclsystem_socket_unix__chan_eventhandler, id); + Tcl_CreateFileHandler(fd, mask, tuapi_socket_unix__chan_eventhandler, id); return; } -static int tclsystem_socket_unix__chan_gethandle(ClientData id_p, int direction, ClientData *handlePtr) { - struct tclsystem_socket_unix__chan_id *id; +static int tuapi_socket_unix__chan_gethandle(ClientData id_p, int direction, ClientData *handlePtr) { + struct tuapi_socket_unix__chan_id *id; int fd; ClientData fd_cd; id = id_p; @@ -2001,26 +2001,26 @@ *handlePtr = fd_cd; return(TCL_OK); } -static Tcl_Channel tclsystem_socket_unix_sock2tclchan(int sock) { - struct tclsystem_socket_unix__chan_id *id; +static Tcl_Channel tuapi_socket_unix_sock2tclchan(int sock) { + struct tuapi_socket_unix__chan_id *id; static Tcl_ChannelType tcl_chan_type; static int tcl_chan_type_init = 0; Tcl_Channel tcl_chan; char chan_name[32]; int sock_flags; if (!tcl_chan_type_init) { tcl_chan_type.typeName = "socket"; tcl_chan_type.version = TCL_CHANNEL_VERSION_2; - tcl_chan_type.closeProc = tclsystem_socket_unix__chan_close; - tcl_chan_type.inputProc = tclsystem_socket_unix__chan_read; - tcl_chan_type.outputProc = tclsystem_socket_unix__chan_write; - tcl_chan_type.watchProc = tclsystem_socket_unix__chan_watch; - tcl_chan_type.getHandleProc = tclsystem_socket_unix__chan_gethandle; + tcl_chan_type.closeProc = tuapi_socket_unix__chan_close; + tcl_chan_type.inputProc = tuapi_socket_unix__chan_read; + tcl_chan_type.outputProc = tuapi_socket_unix__chan_write; + tcl_chan_type.watchProc = tuapi_socket_unix__chan_watch; + tcl_chan_type.getHandleProc = tuapi_socket_unix__chan_gethandle; tcl_chan_type.seekProc = NULL; tcl_chan_type.setOptionProc = NULL; tcl_chan_type.getOptionProc = NULL; tcl_chan_type.close2Proc = NULL; tcl_chan_type.blockModeProc = NULL; @@ -2059,18 +2059,18 @@ id->chan = tcl_chan; return(tcl_chan); } -struct tclsystem_socket_unix__chan_accept_cd { +struct tuapi_socket_unix__chan_accept_cd { int fd; Tcl_Interp *interp; Tcl_Obj *command; }; -static void tclsystem_socket_unix__chan_accept(ClientData cd_p, int mask) { - struct tclsystem_socket_unix__chan_accept_cd *cd; +static void tuapi_socket_unix__chan_accept(ClientData cd_p, int mask) { + struct tuapi_socket_unix__chan_accept_cd *cd; Tcl_Interp *interp; Tcl_Channel chan; Tcl_Obj *command, *command_to_run_objs[5], *command_to_run; int setsockopt_ret; int pass_creds_true = 1; @@ -2090,11 +2090,11 @@ sock = accept(fd, NULL, NULL); if (sock < 0) { return; } - chan = tclsystem_socket_unix_sock2tclchan(sock); + chan = tuapi_socket_unix_sock2tclchan(sock); if (chan == NULL) { close(sock); return; } @@ -2118,12 +2118,12 @@ Tcl_EvalObjEx(interp, command_to_run, TCL_EVAL_GLOBAL); return; } -static int tclsystem_socket_unix_server(ClientData cd, Tcl_Interp *interp, int sock, const char *path, Tcl_Obj *command) { - struct tclsystem_socket_unix__chan_accept_cd *accept_cd; +static int tuapi_socket_unix_server(ClientData cd, Tcl_Interp *interp, int sock, const char *path, Tcl_Obj *command) { + struct tuapi_socket_unix__chan_accept_cd *accept_cd; struct sockaddr_un dest; ssize_t pathlen; int bind_ret, listen_ret; pathlen = strlen(path) + 1; @@ -2167,16 +2167,16 @@ accept_cd->interp = interp; accept_cd->command = command; Tcl_IncrRefCount(command); - Tcl_CreateFileHandler(sock, TCL_READABLE, tclsystem_socket_unix__chan_accept, accept_cd); + Tcl_CreateFileHandler(sock, TCL_READABLE, tuapi_socket_unix__chan_accept, accept_cd); return(TCL_OK); } -static int tclsystem_socket_unix_client(ClientData cd, Tcl_Interp *interp, int sock, const char *path) { +static int tuapi_socket_unix_client(ClientData cd, Tcl_Interp *interp, int sock, const char *path) { Tcl_Channel chan; struct sockaddr_un dest; ssize_t pathlen; int connect_ret, setsockopt_ret; int pass_creds_true = 1; @@ -2209,11 +2209,11 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1)); return(TCL_ERROR); } - chan = tclsystem_socket_unix_sock2tclchan(sock); + chan = tuapi_socket_unix_sock2tclchan(sock); if (chan == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create Tcl channel", -1)); return(TCL_ERROR); } @@ -2223,18 +2223,18 @@ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return(TCL_OK); } -static int tclsystem_socket_unix(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_socket_unix(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_Obj *path_obj, *command_obj; char *path; int retval; int sock; if (objc < 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::socket_unix path\" or \"::system::syscall::socket_unix -server command path\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::socket_unix path\" or \"::tuapi::syscall::socket_unix -server command path\"", -1)); return(TCL_ERROR); } path_obj = objv[1]; @@ -2247,11 +2247,11 @@ return(TCL_ERROR); } if (strcmp(path, "-server") == 0) { if (objc != 4) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::socket_unix -server command path\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::socket_unix -server command path\"", -1)); close(sock); return(TCL_ERROR); } @@ -2259,37 +2259,37 @@ command_obj = objv[2]; path_obj = objv[3]; path = Tcl_GetString(path_obj); - retval = tclsystem_socket_unix_server(cd, interp, sock, path, command_obj); + retval = tuapi_socket_unix_server(cd, interp, sock, path, command_obj); } else { if (objc != 2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::socket_unix path\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::socket_unix path\"", -1)); close(sock); return(TCL_ERROR); } - retval = tclsystem_socket_unix_client(cd, interp, sock, path); + retval = tuapi_socket_unix_client(cd, interp, sock, path); } if (retval != TCL_OK) { close(sock); } return(retval); } #else -static int tclsystem_socket_unix(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_socket_unix(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1)); return(TCL_ERROR) } #endif -static int tclsystem_tsmf_start_svc(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { +static int tuapi_tsmf_start_svc(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { struct timeval select_timeout; Tcl_WideInt umask_val, timeout_val, uid_val, gid_val; Tcl_Obj *filename_obj, *env_obj, *logfile_obj, **env_entry_objv, *cwd_obj, *umask_obj, *uid_obj, *gid_obj; Tcl_Obj *sri_obj, *timeout_obj; pid_t child, child_pgid = -1, waitpid_ret; @@ -2307,11 +2307,11 @@ int idx; /* 1. Parse arguments */ /* 1.a. Ensure the correct number of arguments were passed */ if (objc != 10) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::tsmf_start_svc sri filename logfile env cwd umask uid gid timeout\"", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::tuapi::syscall::tsmf_start_svc sri filename logfile env cwd umask uid gid timeout\"", -1)); return(TCL_ERROR); } /* 1.b. Identify Tcl_Objs to use for each argument */ @@ -2547,13 +2547,17 @@ argv[2] = NULL; execve_ret = execve(filename, argv, envv); /* 10. Abort if something has gone wrong */ _exit(execve_ret); + + /* Handle lint-ness */ + return(TCL_ERROR); + sri_obj = sri_obj; } -int System_Init(Tcl_Interp *interp) { +int Tuapi_Init(Tcl_Interp *interp) { #ifdef USE_TCL_STUBS const char *tclInitStubs_ret; /* Initialize Stubs */ tclInitStubs_ret = Tcl_InitStubs(interp, "8.4", 0); @@ -2561,60 +2565,60 @@ return(TCL_ERROR); } #endif /* Kernel maintenance related commands */ - Tcl_CreateObjCommand(interp, "::system::syscall::insmod", tclsystem_insmod, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::rmmod", tclsystem_rmmod, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::lsmod", tclsystem_lsmod, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::hostname", tclsystem_hostname, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::domainname", tclsystem_domainname, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::insmod", tuapi_insmod, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::rmmod", tuapi_rmmod, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::lsmod", tuapi_lsmod, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::hostname", tuapi_hostname, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::domainname", tuapi_domainname, NULL, NULL); /* Block or char device related commands */ - Tcl_CreateObjCommand(interp, "::system::syscall::losetup", tclsystem_losetup, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::losetup", tuapi_losetup, NULL, NULL); /* Filesystem related commands */ - Tcl_CreateObjCommand(interp, "::system::syscall::mount", tclsystem_mount, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::umount", tclsystem_umount, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::swapon", tclsystem_swapon, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::swapoff", tclsystem_swapoff, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::mknod", tclsystem_mknod, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::mount", tuapi_mount, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::umount", tuapi_umount, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::swapon", tuapi_swapon, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::swapoff", tuapi_swapoff, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::mknod", tuapi_mknod, NULL, NULL); /* Process related commands */ - Tcl_CreateObjCommand(interp, "::system::syscall::getuid", tclsystem_getuid, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::chroot", tclsystem_chroot, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::pivot_root", tclsystem_pivot_root, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::kill", tclsystem_kill, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::ps", tclsystem_ps, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::execve", tclsystem_execve, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::getuid", tuapi_getuid, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::chroot", tuapi_chroot, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::pivot_root", tuapi_pivot_root, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::kill", tuapi_kill, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::ps", tuapi_ps, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::execve", tuapi_execve, NULL, NULL); /* Network related commands */ - Tcl_CreateObjCommand(interp, "::system::syscall::ifconfig", tclsystem_ifconfig, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::route", tclsystem_route, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::brctl", tclsystem_brctl, NULL, NULL); - Tcl_CreateObjCommand(interp, "::system::syscall::vconfig", tclsystem_vconfig, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::ifconfig", tuapi_ifconfig, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::route", tuapi_route, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::brctl", tuapi_brctl, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::vconfig", tuapi_vconfig, NULL, NULL); /* Needed commands for basic services Tcl lacks */ - Tcl_CreateObjCommand(interp, "::system::syscall::socket_unix", tclsystem_socket_unix, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::socket_unix", tuapi_socket_unix, NULL, NULL); /* Service (TSMF) related commands */ - Tcl_CreateObjCommand(interp, "::system::syscall::tsmf_start_svc", tclsystem_tsmf_start_svc, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::syscall::tsmf_start_svc", tuapi_tsmf_start_svc, NULL, NULL); /* Internal functions */ - Tcl_CreateObjCommand(interp, "::system::internal::hash", tclsystem_internalproc_simplehash, NULL, NULL); + Tcl_CreateObjCommand(interp, "::tuapi::internal::hash", tuapi_internalproc_simplehash, NULL, NULL); /* Define constants */ /** Create parent namespace **/ - Tcl_CreateNamespace(interp, "::system::const", NULL, NULL); + Tcl_CreateNamespace(interp, "::tuapi::const", NULL, NULL); /** Define constants, for real **/ - Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::system::const::HOST_NAME_MAX", -1), NULL, Tcl_NewWideIntObj(HOST_NAME_MAX), TCL_GLOBAL_ONLY); + Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::tuapi::const::HOST_NAME_MAX", -1), NULL, Tcl_NewWideIntObj(HOST_NAME_MAX), TCL_GLOBAL_ONLY); /* Create high-level user functions */ Tcl_Eval(interp, -#include "system.tcl.h" +#include "tuapi.tcl.h" ); - Tcl_PkgProvide(interp, "system", "0.1"); + Tcl_PkgProvide(interp, "tuapi", "0.1"); return(TCL_OK); } Index: system.tcl ================================================================== --- system.tcl +++ system.tcl @@ -1,30 +1,30 @@ #! /usr/bin/env tclsh -namespace eval ::system {} -namespace eval ::system::helper {} - -set ::system::_mount_flags(bind) BIND -set ::system::_mount_flags(move) MOVE -set ::system::_mount_flags(remount) REMOUNT -set ::system::_mount_flags(mandlock) MANDLOCK -set ::system::_mount_flags(dirsync) DIRSYNC -set ::system::_mount_flags(noatime) NOATIME -set ::system::_mount_flags(nodiratime) NODIRATIME -set ::system::_mount_flags(relatime) RELATIME -set ::system::_mount_flags(strictatime) STRICTATIME -set ::system::_mount_flags(nodev) NODEV -set ::system::_mount_flags(noexec) NOEXEC -set ::system::_mount_flags(nosuid) NOSUID -set ::system::_mount_flags(ro) RDONLY -set ::system::_mount_flags(silent) SILENT -set ::system::_mount_flags(synchronous) SYNCHRONOUS -set ::system::_mount_flags(sync) SYNCHRONOUS +namespace eval ::tuapi {} +namespace eval ::tuapi::helper {} + +set ::tuapi::_mount_flags(bind) BIND +set ::tuapi::_mount_flags(move) MOVE +set ::tuapi::_mount_flags(remount) REMOUNT +set ::tuapi::_mount_flags(mandlock) MANDLOCK +set ::tuapi::_mount_flags(dirsync) DIRSYNC +set ::tuapi::_mount_flags(noatime) NOATIME +set ::tuapi::_mount_flags(nodiratime) NODIRATIME +set ::tuapi::_mount_flags(relatime) RELATIME +set ::tuapi::_mount_flags(strictatime) STRICTATIME +set ::tuapi::_mount_flags(nodev) NODEV +set ::tuapi::_mount_flags(noexec) NOEXEC +set ::tuapi::_mount_flags(nosuid) NOSUID +set ::tuapi::_mount_flags(ro) RDONLY +set ::tuapi::_mount_flags(silent) SILENT +set ::tuapi::_mount_flags(synchronous) SYNCHRONOUS +set ::tuapi::_mount_flags(sync) SYNCHRONOUS # Determine where to mount a given device (usually by checking "/etc/fstab") -proc ::system::helper::find_mountpoint {device} { +proc ::tuapi::helper::find_mountpoint {device} { set data "" catch { set fd [open "/etc/fstab"] set data [read -nonewline $fd] close $fd @@ -50,11 +50,11 @@ } return -code error "no entry found in \"/etc/fstab\" for \"$device\"" } -proc ::system::mount args { +proc ::tuapi::mount args { set options_list [list] for {set idx 0} {$idx < [llength $args]} {incr idx} { set curr_arg [lindex $args $idx] @@ -91,19 +91,19 @@ } set args [lrange $args $idx end] if {[llength $args] < 1 || [llength $args] > 2} { - return -code error "wrong # args: should be \"::system::mount ?options? source ?target?\"" + return -code error "wrong # args: should be \"::tuapi::mount ?options? source ?target?\"" } set source [lindex $args 0] if {[llength $args] == 2} { set target [lindex $args 1] } else { - array set mountinfo [::system::helper::find_mountpoint $source] + array set mountinfo [::tuapi::helper::find_mountpoint $source] set source $mountinfo(source) set target $mountinfo(target) if {![info exists fstype]} { set fstype $mountinfo(fstype) @@ -142,19 +142,19 @@ set option_lc "ro" } } # Example: noatime - if {[info exists ::system::_mount_flags($option_lc)]} { - lappend options_list $::system::_mount_flags($option_lc) + if {[info exists ::tuapi::_mount_flags($option_lc)]} { + lappend options_list $::tuapi::_mount_flags($option_lc) continue } # Example: atime - if {[info exists ::system::_mount_flags(no$option_lc)]} { - set idx [lsearch -exact $options_list $::system::_mount_flags(no$option_lc)] + if {[info exists ::tuapi::_mount_flags(no$option_lc)]} { + set idx [lsearch -exact $options_list $::tuapi::_mount_flags(no$option_lc)] if {$idx != -1} { set options_list [lreplace $options_list $idx $idx] } continue @@ -162,12 +162,12 @@ # Example: norelatime if {[string match "no*" $option_lc]} { set neg_option_lc [string range $option_lc 2 end] - if {[info exists ::system::_mount_flags($neg_option_lc)]} { - set idx [lsearch -exact $options_list $::system::_mount_flags($neg_option_lc)] + if {[info exists ::tuapi::_mount_flags($neg_option_lc)]} { + set idx [lsearch -exact $options_list $::tuapi::_mount_flags($neg_option_lc)] if {$idx != -1} { set options_list [lreplace $options_list $idx $idx] } continue @@ -178,56 +178,56 @@ lappend unknown_options $option } # Use "swapon" if this is swap if {$fstype == "swap"} { - return [::system::syscall::swapon $source] + return [::tuapi::syscall::swapon $source] } # Otherwise, call "mount" system call ## If we have accumulated any unknown options, pass them as a ## comma-seperated value string if {[info exists unknown_options]} { set data [join $unknown_options ","] - return [::system::syscall::mount $source $target $fstype $options_list $data] - } - - return [::system::syscall::mount $source $target $fstype $options_list] -} - -proc ::system::umount {dir {flags ""}} { - return [::system::syscall::umount $dir [string toupper $flags]] -} - -proc ::system::kill {pid sig} { - return [::system::syscall::kill $pid [string toupper $sig]] -} - -proc ::system::killpg {pgroup sig} { + return [::tuapi::syscall::mount $source $target $fstype $options_list $data] + } + + return [::tuapi::syscall::mount $source $target $fstype $options_list] +} + +proc ::tuapi::umount {dir {flags ""}} { + return [::tuapi::syscall::umount $dir [string toupper $flags]] +} + +proc ::tuapi::kill {pid sig} { + return [::tuapi::syscall::kill $pid [string toupper $sig]] +} + +proc ::tuapi::killpg {pgroup sig} { if {$pgroup <= 1} { return -code error "invalid process group specified (must be greater than 1)" } - return [::system::syscall::kill -$pgroup [string toupper $sig]] + return [::tuapi::syscall::kill -$pgroup [string toupper $sig]] } -proc ::system::ifconfig args { +proc ::tuapi::ifconfig args { if {[llength $args] == 0} { # Return information on all interfaces set retlist [list] - foreach interface [::system::syscall::ifconfig] { - lappend retlist $interface [::system::syscall::ifconfig $interface] + foreach interface [::tuapi::syscall::ifconfig] { + lappend retlist $interface [::tuapi::syscall::ifconfig $interface] } return $retlist } set interface [lindex $args 0] set args [lrange $args 1 end] - array set ifaceinfo [::system::syscall::ifconfig $interface] + array set ifaceinfo [::tuapi::syscall::ifconfig $interface] if {[llength $args] == 0} { return [array get ifaceinfo] } @@ -246,11 +246,11 @@ if {[lsearch -exact $flags $newflag] == -1} { lappend flags $newflag } } - ::system::syscall::ifconfig $interface flags $flags + ::tuapi::syscall::ifconfig $interface flags $flags } } } } Index: test.tcl ================================================================== --- test.tcl +++ test.tcl @@ -1,21 +1,21 @@ #! /usr/bin/env tclsh puts [exec ./build-dyn.sh] -load ./system.so +load ./tuapi.so -::system::syscall::tsmf_start_svc blah /bin/true /tmp/logfile [list PATH=/bin] / 022 root root 10 +::tuapi::syscall::tsmf_start_svc blah /bin/true /tmp/logfile [list PATH=/bin] / 022 0 0 10 -foreach iface [system::syscall::ifconfig] { +foreach iface [tuapi::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 # inet 140.194.100.149 netmask ffffff00 broadcast 140.194.100.255 unset -nocomplain ifaceinfo - array set ifaceinfo [system::syscall::ifconfig $iface] + array set ifaceinfo [tuapi::syscall::ifconfig $iface] set secondline "" foreach {label entry} [list inet address netmask netmask broadcast broadcast] { if {![info exists ifaceinfo($entry)]} { continue @@ -29,7 +29,7 @@ if {[info exists ifaceinfo(hwaddr)]} { puts "\tether $ifaceinfo(hwaddr)" } } -#system::syscall::route add 1.2.3.4 255.255.255.255 -system::syscall::ifconfig dummy0 address 1.2.3.4 netmask 255.255.255.0 flags [list UP RUNNING BROADCAST MULTICAST] +#tuapi::syscall::route add 1.2.3.4 255.255.255.255 +tuapi::syscall::ifconfig dummy0 address 1.2.3.4 netmask 255.255.255.0 flags [list UP RUNNING BROADCAST MULTICAST]