Tcl UNIX API
Changes On Branch bug/tsmf-bug-fixes
Login
HomeTimelineFilesBranchesTagsTicketsWiki
Hide Diff Patch Unified Diff

Changes In Branch bug/tsmf-bug-fixes Excluding Merge-Ins

This is equivalent to a diff from 0115d84b2b to a39fa02e97

2024-03-05
20:44
Merge in bug fixes for TSMF check-in: 48f82833d5 user: rkeene tags: trunk
20:42
Fix some issues with TUAPI TSMF functions Closed-Leaf check-in: a39fa02e97 user: rkeene tags: bug/tsmf-bug-fixes
20:41
Add "compile_commands.json" to build process check-in: 7d25632786 user: rkeene tags: bug/tsmf-bug-fixes
20:04
Create new branch named "bug/tsmf-bug-fixes" check-in: e3b90d3c3e user: rkeene tags: bug/tsmf-bug-fixes
2017-09-12
19:43
Post-release version increment check-in: 0115d84b2b user: rkeene tags: trunk
19:42
TUAPI 0.12 check-in: 32375279e7 user: rkeene tags: 0.12, trunk

Modified .fossil-settings/ignore-glob from [8823994c8d] to [06351b337f]. 

1
2
3
4
5


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







>

1
2
3
4
5
6

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

Modified build-dyn.sh from [58689ba4b3] to [b25814ea59]. 


1












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

























14

15
16


# /bin/bash













# 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}"

























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}


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

>
|
>
>
>
>
>
>
>
>
>
>
>
>












>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

#! /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

Modified tuapi.c from [80d5a89597] to [9e72e665c6].

︙︙
3070
3071
3072
3073
3074
3075
3076

3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094


3095
3096
3097
3098
3099


3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117


3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133


3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147


3148
3149
3150
3151
3152
3153
3154

		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);



			return(TCL_ERROR);
		}

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


		}

		/* 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);



			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);



			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);



		return(TCL_OK);
	}

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








>


















>
>





>
>


















>
>
















>
>














>
>








3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165

		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];
︙︙
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288

}

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

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

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








|








3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299

}

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);
︙︙

Powered by Fossil · RSS