Tcl UNIX API
Check-in [504add9c98]
Login
HomeTimelineFilesBranchesTagsTicketsWiki
Overview
Comment:Updated to allow (and require) user to specify timeout
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 504add9c98e8136e9e9b98ad569e9773907d346c
User & Date: rkeene on 2012-09-09 21:25:04
Other Links: manifest | tags
Context
2012-09-09
21:25
Corrected example in test.tcl check-in: 8d15889864 user: rkeene tags: trunk
21:25
Updated to allow (and require) user to specify timeout check-in: 504add9c98 user: rkeene tags: trunk
21:18
Started processing "umask" and "cwd" arguments Updated to have 30sec (currently hard-coded) timeout for starting processes check-in: 4b855bb7b2 user: rkeene tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified build-dyn.sh from [078554ca42] to [3cc9484186]. 

1
2
3
4
5
6
7
8
9
10
11
12



1
2
3
4
5
6
7
8
9
10


11
12











-
-
+
+

# /bin/bash

# Perform common build options
. build-common.sh

# 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

Modified system.c from [dc2605a233] to [1d6aabc455]. 

1
2
3
4
5

6
7
8
9
10
11
12

1
2
3
4
5
6
7
8
9
10
11
12
13






+








#define _LINUX_SOURCE 1
#include <sys/syscall.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <sys/socket.h>
#include <sys/select.h>
#include <sys/mount.h>
#include <sys/types.h>
#include <sys/ioctl.h>
#include <sys/swap.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <stdlib.h>
︙
1875
1876
1877
1878
1879
1880
1881
1882
1883



1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902


1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915

1916
1917
1918
1919
1920
1921
1922
1923
1924
1925






1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938

1876
1877
1878
1879
1880
1881
1882


1883
1884
1885
1886
1887
1888

1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901


1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926

1927
1928
1929
1930
1931
1932
1933
1934
1935
1936


1937
1938
1939
1940
1941
1942
1943








-
-
+
+
+



-













-
-
+
+













+









-
+
+
+
+
+
+




-
-








	}

	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;
	int null_fd, log_fd, tmp_fd, max_fd;
	int env_entry_objc;
	int fds[2], fd;
	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 */
	sri_obj = objv[1];
	filename_obj = objv[2];
	logfile_obj = objv[3];
	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);
	}

	for (idx = 0; idx < MIN(env_entry_objc, sizeof(envv) / sizeof(envv[0]) - 1); idx++) {
︙
1959
1960
1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973

1964
1965
1966
1967
1968
1969
1970

1971
1972
1973
1974
1975
1976
1977
1978








-
+








	if (child != 0) {
		/* 4.parent. Get PGID from child */
		/* 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);

		select_ret = select(fd + 1, &read_fdset, NULL, NULL, &select_timeout);
		if (select_ret == 0) {
︙

Modified test.tcl from [8645af428b] to [97fe9fd63b]. 

1
2
3
4
5


6
7
8
9
10
11
12

1
2
3
4
5
6
7
8
9
10
11
12
13
14






+
+








#! /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<UP,LOOPBACK,RUNNING,MULTICAST,IPv4,VIRTUAL> mtu 8232 index 1
#        inet 127.0.0.1 netmask ff000000 
#aggr100003:1: flags=201000843<UP,BROADCAST,RUNNING,MULTICAST,IPv4,CoS> mtu 1500 index 2
#        inet 140.194.100.149 netmask ffffff00 broadcast 140.194.100.255
︙

Powered by Fossil · RSS