tuapi.so
libtuapi.a
tuapi.o
tuapi.tcl.h
pkgIndex.tcl
compile_commands.json

#! /usr/bin/env bash

bashArrayToJSON() (
	args=("$@")

	jq -M -r -n -c --args '$ARGS.positional' --args -- "${args[@]}"
)

bashStringToJSON() (
	string="$1"

	eval "tmpArray=($string)"
	bashArrayToJSON "${tmpArray[@]}"
)

# Perform common build options
. ./build-common.sh

# Compile using the same options as Tcl
if [ -z "${TCLCONFIGSH}" ]; then
	TCLCONFIGSH="$(find /usr/lib /usr/lib64 /usr/local/lib /usr/local/lib64 /lib /lib64 -name tclConfig.sh -print -quit)"
fi

. "${TCLCONFIGSH}"

echo "${TCL_CC} -ggdb3 -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -shared -rdynamic -o tuapi.so tuapi.c ${TCL_STUB_LIB_SPEC}"

cat << _EOF_ > compile_commands.json.new
[
	{
		"directory": "$(pwd)",
		"file": "tuapi.c",
		"arguments": [
			"$(echo "${TCL_CC}" | sed 's@ @", "@g')",
			"-ggdb3",
			"-fPIC",
			"-DPIC",
			"-Wall",
			"-DUSE_TCL_STUBS=1",
			$(bashStringToJSON "${TCL_DEFS}" | sed 's@^\[@@;s@\]$@@'),
			$(bashStringToJSON "${TCL_INCLUDE_SPEC}" | sed 's@^\[@@;s@\]$@@'),
			"-shared",
			"-rdynamic",
			"-o",
			"tuapi.so",
			"tuapi.c"
		]
	}
]
_EOF_

eval ${TCL_CC} -ggdb3 -fPIC -DPIC -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -shared -rdynamic -o tuapi.so tuapi.c ${TCL_STUB_LIB_SPEC} || exit 1
mv compile_commands.json.new compile_commands.json

echo 'package ifneeded tuapi '"${tuapi_version}"' [list load [file join $dir tuapi.so]]' > pkgIndex.tcl

		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) {
			/* On timeout, terminate starting process */
			child_pgid = getpgid(child);
			if (child_pgid != -1) {
				kill(-child_pgid, SIGKILL);
			}

			Tcl_SetObjResult(interp, Tcl_NewStringObj("timeout", -1));

			currtime = time(NULL);
			strftime(logmsg, sizeof(logmsg), "[ %b %e %H:%M:%S ", localtime(&currtime));
			write(log_fd, logmsg, strlen(logmsg));

			snprintf(logmsg, sizeof(logmsg), "Method \"start\" timed out after %i seconds ]\n", (int) timeout_val);
			write(log_fd, logmsg, strlen(logmsg));

			close(log_fd);

			waitpid(child, NULL, WNOHANG);

			return(TCL_ERROR);
		}

		if (select_ret > 0) {
			read_ret = read(fd, &child_pgid, sizeof(child_pgid));
		} else {
			read_ret = -1;
		}

		/* 4.parent.d. Close read end of pipe */
		close(fd);

		/* 4.parent.e. Verify read was meaningful */
		if (read_ret != sizeof(child_pgid)) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj("failed to communicate with started service", -1));

			currtime = time(NULL);
			strftime(logmsg, sizeof(logmsg), "[ %b %e %H:%M:%S ", localtime(&currtime));
			write(log_fd, logmsg, strlen(logmsg));

			snprintf(logmsg, sizeof(logmsg), "Method \"start\" failed: communication with started service broken ]\n");
			write(log_fd, logmsg, strlen(logmsg));

			close(log_fd);

			waitpid(child, NULL, WNOHANG);

			return(TCL_ERROR);
		}

		/* 4.parent.f. If the PGID given is actually an error, return error */
		if (child_pgid == -1) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj("service failed to start", -1));

			currtime = time(NULL);
			strftime(logmsg, sizeof(logmsg), "[ %b %e %H:%M:%S ", localtime(&currtime));
			write(log_fd, logmsg, strlen(logmsg));

			snprintf(logmsg, sizeof(logmsg), "Method \"start\" failed ]\n");
			write(log_fd, logmsg, strlen(logmsg));

			close(log_fd);

			waitpid(child, NULL, WNOHANG);

			return(TCL_ERROR);
		}

		/* 4.parent.g. Return PGID to Tcl */
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) child_pgid));

		currtime = time(NULL);
		strftime(logmsg, sizeof(logmsg), "[ %b %e %H:%M:%S ", localtime(&currtime));
		write(log_fd, logmsg, strlen(logmsg));

		snprintf(logmsg, sizeof(logmsg), "Method \"start\" completed, process group = %lu ]\n", (unsigned long) child_pgid);
		write(log_fd, logmsg, strlen(logmsg));

		close(log_fd);

		waitpid(child, NULL, 0);

		return(TCL_OK);
	}

	/* 4.child.a. Close read end of pipe -- we only write to it */
	close(fds[0]);
	fd = fds[1];

}

int Tuapi_Init(Tcl_Interp *interp) {
#ifdef USE_TCL_STUBS
	const char *tclInitStubs_ret;

	/* Initialize Stubs */
	tclInitStubs_ret = Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0);
	if (!tclInitStubs_ret) {
		return(TCL_ERROR);
	}
#endif

	/* Kernel maintenance related commands */
	Tcl_CreateObjCommand(interp, "::tuapi::syscall::insmod", tuapi_insmod, NULL, NULL);