Check-in [71648d46bb]
Overview
Comment:Brought system to basic bootable state (early-boot)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 71648d46bb6d98a43284557173a4855189d95b73
User & Date: rkeene on 2012-08-05 21:38:27
Other Links: manifest | tags
Context
2012-08-11
23:17
Corrected bug in "ifconfig" check-in: 704748fc41 user: rkeene tags: trunk
2012-08-05
21:38
Brought system to basic bootable state (early-boot) check-in: 71648d46bb user: rkeene tags: trunk
2012-08-04
05:41
initial empty check-in check-in: 91c4fc4e44 user: rkeene tags: trunk
Changes

Added build-common.sh version [1b93b7f590].

            1  +#! /bin/bash
            2  +
            3  +set -e
            4  +
            5  +case "$1" in
            6  +	clean|distclean)
            7  +		rm -rf out inst
            8  +		rm -f libsystem.a system.o system.so
            9  +		rm -f system.tcl.h
           10  +		exit 0
           11  +		;;
           12  +esac
           13  +
           14  +./stringify.tcl system.tcl > system.tcl.h

Added build-dyn.sh version [02da656833].

            1  +# /bin/bash
            2  +
            3  +# Perform common build options
            4  +. build-common.sh
            5  +
            6  +# Compile using the same options as Tcl
            7  +TCLCONFIGSH="$(find /usr/lib /usr/local/lib /lib -name tclConfig.sh -print -quit)"
            8  +
            9  +. "${TCLCONFIGSH}"
           10  +
           11  +echo "${TCL_CC} -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o system.so system.c"
           12  +eval ${TCL_CC} -Wall -DUSE_TCL_STUBS=1 ${TCL_DEFS} ${TCL_INCLUDE_SPEC} ${TCL_STUB_LIB_SPEC} -shared -rdynamic -o system.so system.c

Added build-static.sh version [a001c327e9].

            1  +#! /bin/bash
            2  +
            3  +# Perform common build options
            4  +. build-common.sh
            5  +
            6  +# Define variables
            7  +KITCREATORROOT="$(readlink -f '..')"
            8  +
            9  +# Compile using the same options as Tcl
           10  +TCLCONFIGSH='/usr/lib/tclConfig.sh'
           11  +
           12  +. "${TCLCONFIGSH}"
           13  +
           14  +echo "diet ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c"
           15  +eval diet ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c
           16  +ar rcu libsystem.a system.o
           17  +ranlib libsystem.a

Added build.sh version [ad274edd90].

            1  +#! /bin/bash
            2  +
            3  +# Perform common build options
            4  +. build-common.sh
            5  +
            6  +# Define variables
            7  +KITCREATORROOT="$(readlink -f '..')"
            8  +
            9  +# Compile using the same options as Tcl
           10  +TCLCONFIGSH="${KITCREATORROOT}/tcl/inst/lib/tclConfig.sh"
           11  +
           12  +. "${TCLCONFIGSH}"
           13  +
           14  +echo "${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c"
           15  +eval ${TCL_CC} ${TCL_DEFS} ${TCL_INCLUDE_SPEC} -o system.o -c system.c
           16  +ar rcu libsystem.a system.o
           17  +ranlib libsystem.a
           18  +
           19  +mkdir -p inst/lib/system1.0
           20  +mkdir -p out/lib/system1.0
           21  +cp libsystem.a inst/lib/system1.0
           22  +cp pkgIndex.tcl out/lib/system1.0

Added pkgIndex.tcl version [1495e7ac95].

            1  +package ifneeded system 0.1 [list load "" system]

Added stringify.tcl version [07e25e6903].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +proc stringifyfile {filename {key 0}} {
            4  +	catch {
            5  +		set fd [open $filename r]
            6  +	}
            7  +
            8  +	if {![info exists fd]} {
            9  +		return ""
           10  +	}
           11  +
           12  +	set data [read -nonewline $fd]
           13  +	close $fd
           14  +
           15  +	foreach line [split $data \n] {
           16  +		set line [string map [list "\\" "\\\\" "\"" "\\\""] $line]
           17  +		append ret "	\"$line\\n\"\n"
           18  +	}
           19  +
           20  +	return $ret
           21  +}
           22  +
           23  +foreach file $argv {
           24  +	puts -nonewline [stringifyfile $file]
           25  +}
           26  +
           27  +exit 0

Added system.c version [0957cdeb4b].

            1  +#define _LINUX_SOURCE 1
            2  +#include <sys/syscall.h>
            3  +#include <netinet/in.h>
            4  +#include <arpa/inet.h>
            5  +#include <sys/socket.h>
            6  +#include <sys/mount.h>
            7  +#include <sys/types.h>
            8  +#include <sys/ioctl.h>
            9  +#include <sys/swap.h>
           10  +#include <sys/stat.h>
           11  +#include <stdlib.h>
           12  +#include <signal.h>
           13  +#include <unistd.h>
           14  +#include <string.h>
           15  +#include <fcntl.h>
           16  +#include <errno.h>
           17  +#include <tcl.h>
           18  +
           19  +#include <linux/sockios.h>
           20  +#include <linux/route.h>
           21  +#include <linux/if.h>
           22  +#include <linux/if_arp.h>
           23  +#include <linux/loop.h>
           24  +#include <linux/fs.h>
           25  +
           26  +#ifndef HOST_NAME_MAX
           27  +/* SUSv2 Limit */
           28  +#define HOST_NAME_MAX 255
           29  +#endif
           30  +
           31  +/* From Linux 2.6 */
           32  +#ifndef MNT_DETACH
           33  +#define MNT_DETACH 2
           34  +#endif
           35  +#ifndef MNT_EXPIRE
           36  +#define MNT_EXPIRE 4
           37  +#endif
           38  +#ifndef MS_MOVE
           39  +#define MS_MOVE 8192
           40  +#endif
           41  +
           42  +/* User environment, for execve */
           43  +extern char **environ;
           44  +
           45  +/* Re-implement these if needed */
           46  +#ifdef SYS_init_module
           47  +static int init_module(void *val, unsigned long len, const char *args) {
           48  +	return(syscall(SYS_init_module, val, len, args));
           49  +}
           50  +#endif
           51  +#ifdef SYS_pivot_root
           52  +static int pivot_root(const char *new_root, const char *put_old) {
           53  +	return(syscall(SYS_pivot_root, new_root, put_old));
           54  +}
           55  +#endif
           56  +
           57  +/*
           58  + * Simple hash routine to enable switching on a string to be implemented
           59  + */
           60  +static unsigned long tclsystem_internal_simplehash(const void *databuf, int datalen) {
           61  +	unsigned long retval = 0;
           62  +	const unsigned char *data;
           63  +
           64  +	data = databuf;
           65  +
           66  +	for (; datalen > 0; datalen--,data++) {
           67  +		retval ^= (retval >> 25) & 0x7F;
           68  +		retval <<= 7;
           69  +		retval &= (0xFFFFFFFFUL);
           70  +		retval ^= *data;
           71  +	}
           72  +
           73  +	return(retval);
           74  +}
           75  +
           76  +static unsigned long tclsystem_internal_simplehash_obj(Tcl_Obj *tcl_data) {
           77  +	unsigned long retval;
           78  +	char *data;
           79  +	int datalen = -1;
           80  +
           81  +	data = Tcl_GetStringFromObj(tcl_data, &datalen);
           82  +
           83  +	retval = tclsystem_internal_simplehash(data, datalen);
           84  +
           85  +	return(retval);
           86  +}
           87  +
           88  +#if 0
           89  +/* NOTUSED: Uncomment when needed: */
           90  +static unsigned long tclsystem_internal_simplehash_str(const char *data) {
           91  +	unsigned long retval;
           92  +	int datalen;
           93  +
           94  +	datalen = strlen(data);
           95  +
           96  +	retval = tclsystem_internal_simplehash(data, datalen);
           97  +
           98  +	return(retval);
           99  +}
          100  +#endif
          101  +
          102  +static int tclsystem_internalproc_simplehash(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          103  +	unsigned long hashval;
          104  +	Tcl_Obj *hashval_obj;
          105  +
          106  +	if (objc != 2) {
          107  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::internal::hash value\"", -1));
          108  +
          109  +		return(TCL_ERROR);
          110  +	}
          111  +
          112  +	hashval = tclsystem_internal_simplehash_obj(objv[1]);
          113  +
          114  +	hashval_obj = Tcl_NewObj();
          115  +	Tcl_SetWideIntObj(hashval_obj, hashval);
          116  +
          117  +	Tcl_SetObjResult(interp, hashval_obj);
          118  +
          119  +	return(TCL_OK);
          120  +}
          121  +
          122  +/*
          123  + * Low-level System Call Wrapper Procedures
          124  + *
          125  + * These procedures should minimally wrap Linux or UNIX system calls to
          126  + * expose to the Tcl-level.  Where possible accept symbolic names rather
          127  + * than numeric values (.e.g, list of values to OR together to get flags).
          128  + */
          129  +static int tclsystem_mount(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          130  +	Tcl_Obj *mountflags_obj, **mountflags_list, *mountflag;
          131  +	int mountflags_list_len;
          132  +	char *source, *target, *fstype;
          133  +	unsigned long mountflags = 0;
          134  +	void *data = NULL;
          135  +	int mount_ret, tcl_ret;
          136  +
          137  +	if (objc < 5 || objc > 6) {
          138  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::mount source target fstype mountflags ?data?\"", -1));
          139  +
          140  +		return(TCL_ERROR);
          141  +	}
          142  +
          143  +	source = Tcl_GetString(objv[1]);
          144  +	target = Tcl_GetString(objv[2]);
          145  +	fstype = Tcl_GetString(objv[3]);
          146  +	mountflags_obj = objv[4];
          147  +
          148  +	if (objc == 6) {
          149  +		data = Tcl_GetString(objv[5]);
          150  +	}
          151  +
          152  +	tcl_ret = Tcl_ListObjGetElements(interp, mountflags_obj, &mountflags_list_len, &mountflags_list);
          153  +	if (tcl_ret != TCL_OK) {
          154  +		return(tcl_ret);
          155  +	}
          156  +
          157  +	for (; mountflags_list_len > 0; mountflags_list_len--,mountflags_list++) {
          158  +		mountflag = mountflags_list[0];
          159  +
          160  +		switch (tclsystem_internal_simplehash_obj(mountflag)) {
          161  +#ifdef MS_BIND
          162  +			case 0x8526744: /* BIND */
          163  +				mountflags |= MS_BIND;
          164  +				break;
          165  +#endif
          166  +#ifdef MS_DIRSYNC
          167  +			case 0x2aff41c3: /* DIRSYNC */
          168  +				mountflags |= MS_DIRSYNC;
          169  +				break;
          170  +#endif
          171  +#ifdef MS_MANDLOCK
          172  +			case 0x410dbcb: /* MANDLOCK */
          173  +				mountflags |= MS_MANDLOCK;
          174  +				break;
          175  +#endif
          176  +#ifdef MS_MOVE
          177  +			case 0x9b3eb45: /* MOVE */
          178  +				mountflags |= MS_MOVE;
          179  +				break;
          180  +#endif
          181  +#ifdef MS_NOATIME
          182  +			case 0x1a0f58c5: /* NOATIME */
          183  +				mountflags |= MS_NOATIME;
          184  +				break;
          185  +#endif
          186  +#ifdef MS_NODEV
          187  +			case 0xe9f120d6: /* NODEV */
          188  +				mountflags |= MS_NODEV;
          189  +				break;
          190  +#endif
          191  +#ifdef MS_NODIRATIME
          192  +			case 0xde08ff45: /* NODIRATIME */
          193  +				mountflags |= MS_NODIRATIME;
          194  +				break;
          195  +#endif
          196  +#ifdef MS_NOEXEC
          197  +			case 0xf8b718c3: /* NOEXEC */
          198  +				mountflags |= MS_NOEXEC;
          199  +				break;
          200  +#endif
          201  +#ifdef MS_NOSUID
          202  +			case 0xfa745ec4: /* NOSUID */
          203  +				mountflags |= MS_NOSUID;
          204  +				break;
          205  +#endif
          206  +#ifdef MS_RDONLY
          207  +			case 0x49f2ec59: /* RDONLY */
          208  +				mountflags |= MS_RDONLY;
          209  +				break;
          210  +#endif
          211  +#ifdef MS_RELATIME
          212  +			case 0x481954c5: /* RELATIME */
          213  +				mountflags |= MS_RELATIME;
          214  +				break;
          215  +#endif
          216  +#ifdef MS_REMOUNT
          217  +			case 0xd9507154: /* REMOUNT */
          218  +				mountflags |= MS_REMOUNT;
          219  +				break;
          220  +#endif
          221  +#ifdef MS_SILENT
          222  +			case 0x99902954: /* SILENT */
          223  +				mountflags |= MS_SILENT;
          224  +				break;
          225  +#endif
          226  +#ifdef MS_STRICTATIME
          227  +			case 0x562fa045: /* STRICTATIME */
          228  +				mountflags |= MS_STRICTATIME;
          229  +				break;
          230  +#endif
          231  +#ifdef MS_SYNCHRONOUS
          232  +			case 0xbf799353: /* SYNCHRONOUS */
          233  +			case 0xa766743: /* SYNC */
          234  +				mountflags |= MS_SYNCHRONOUS;
          235  +				break;
          236  +#endif
          237  +			default:
          238  +				Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown element in mountflags: \"%s\"", Tcl_GetString(mountflag)));
          239  +
          240  +				return(TCL_ERROR);
          241  +		}
          242  +	}
          243  +
          244  +	mount_ret = mount(source, target, fstype, mountflags, data);
          245  +	if (mount_ret != 0) {
          246  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          247  +
          248  +		return(TCL_ERROR);
          249  +	}
          250  +
          251  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(target, -1));
          252  +
          253  +	return(TCL_OK);
          254  +}
          255  +
          256  +static int tclsystem_umount(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          257  +	Tcl_Obj **flags, *flag;
          258  +	Tcl_Obj *pathname_obj;
          259  +	char *pathname;
          260  +	int umount2_flags = 0;
          261  +	int flags_cnt;
          262  +	int chk_ret, tcl_ret;
          263  +
          264  +	if (objc < 2 || objc > 3) {
          265  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::umount dir ?flags?\"", -1));
          266  +
          267  +		return(TCL_ERROR);
          268  +	}
          269  +
          270  +	pathname_obj = objv[1];
          271  +	pathname = Tcl_GetString(pathname_obj);
          272  +
          273  +	/* Set a default return value */
          274  +	Tcl_SetObjResult(interp, pathname_obj);
          275  +
          276  +	if (objc == 3) {
          277  +		tcl_ret = Tcl_ListObjGetElements(interp, objv[2], &flags_cnt, &flags);
          278  +		if (tcl_ret != TCL_OK) {
          279  +			return(tcl_ret);
          280  +		}
          281  +
          282  +		for (; flags_cnt > 0; flags_cnt--,flags++) {
          283  +			flag = flags[0];
          284  +
          285  +			switch (tclsystem_internal_simplehash_obj(flag)) {
          286  +				case 0x69f4a3c5: /* FORCE */
          287  +					umount2_flags |= MNT_FORCE;
          288  +
          289  +					break;
          290  +				case 0x5a9173c8: /* DETACH */
          291  +					umount2_flags |= MNT_DETACH;
          292  +
          293  +					break;
          294  +				case 0x8a137fc5: /* EXPIRE */
          295  +					umount2_flags |= MNT_EXPIRE;
          296  +
          297  +					break;
          298  +				default:
          299  +					Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown flag \"%s\" specified", Tcl_GetString(flag)));
          300  +	
          301  +					return(TCL_ERROR);
          302  +			}
          303  +		}
          304  +
          305  +		chk_ret = umount2(pathname, umount2_flags);
          306  +
          307  +		/* Do not return an error for this case, since it is apparently not exceptional */
          308  +		if (chk_ret != 0 && (umount2_flags & MNT_EXPIRE) == MNT_EXPIRE && errno == EAGAIN) {
          309  +			Tcl_SetObjResult(interp, Tcl_NewStringObj("AGAIN", -1));
          310  +
          311  +			chk_ret = 0;
          312  +		}
          313  +	} else {
          314  +		chk_ret = umount(pathname);
          315  +	}
          316  +
          317  +	if (chk_ret != 0) {
          318  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          319  +
          320  +		return(TCL_ERROR);
          321  +	}
          322  +
          323  +	return(TCL_OK);
          324  +}
          325  +
          326  +static int tclsystem_swapon(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          327  +	char *pathname;
          328  +	int chk_ret;
          329  +
          330  +	if (objc != 2) {
          331  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::swapon pathname\"", -1));
          332  +
          333  +		return(TCL_ERROR);
          334  +	}
          335  +
          336  +	pathname = Tcl_GetString(objv[1]);
          337  +
          338  +	chk_ret = swapon(pathname, 0);
          339  +	if (chk_ret != 0) {
          340  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          341  +
          342  +		return(TCL_ERROR);
          343  +	}
          344  +
          345  +	return(TCL_OK);
          346  +}
          347  +
          348  +static int tclsystem_swapoff(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          349  +	char *pathname;
          350  +	int chk_ret;
          351  +
          352  +	if (objc != 2) {
          353  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::swapoff pathname\"", -1));
          354  +
          355  +		return(TCL_ERROR);
          356  +	}
          357  +
          358  +	pathname = Tcl_GetString(objv[1]);
          359  +
          360  +	chk_ret = swapoff(pathname);
          361  +	if (chk_ret != 0) {
          362  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          363  +
          364  +		return(TCL_ERROR);
          365  +	}
          366  +
          367  +	return(TCL_OK);
          368  +}
          369  +
          370  +static int tclsystem_insmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          371  +	Tcl_Channel fd;
          372  +	Tcl_Obj *module_filename, *module_data;
          373  +	void *module_data_val;
          374  +	int module_data_len;
          375  +	int read_ret, chk_ret;
          376  +
          377  +	if (objc < 2) {
          378  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"system::syscall::insmod filename ?args ...?\"", -1));
          379  +
          380  +		return(TCL_ERROR);
          381  +	}
          382  +
          383  +	module_filename = objv[1];
          384  +
          385  +	fd = Tcl_FSOpenFileChannel(interp, module_filename, "r", 0600);
          386  +	if (fd == NULL) {
          387  +		return(TCL_ERROR);
          388  +	}
          389  +
          390  +	chk_ret = Tcl_SetChannelOption(interp, fd, "-translation", "binary");
          391  +	if (chk_ret != TCL_OK) {
          392  +		Tcl_Close(interp, fd);
          393  +
          394  +		return(chk_ret);
          395  +	}
          396  +
          397  +	module_data = Tcl_NewObj();
          398  +
          399  +	read_ret = Tcl_ReadChars(fd, module_data, -1, 0);
          400  +
          401  +	Tcl_Close(interp, fd);
          402  +
          403  +	if (read_ret <= 0) {
          404  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("read failed", -1));
          405  +
          406  +		return(TCL_ERROR);
          407  +	}
          408  +
          409  +	module_data_val = Tcl_GetByteArrayFromObj(module_data, &module_data_len);
          410  +
          411  +	chk_ret = init_module(module_data_val, module_data_len, "");
          412  +	if (chk_ret != 0) {
          413  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          414  +
          415  +		return(TCL_ERROR);
          416  +	}
          417  +
          418  +	return(TCL_OK);
          419  +}
          420  +
          421  +static int tclsystem_rmmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          422  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
          423  +
          424  +	return(TCL_ERROR);
          425  +}
          426  +
          427  +static int tclsystem_lsmod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          428  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
          429  +
          430  +	return(TCL_ERROR);
          431  +}
          432  +
          433  +static int tclsystem_hostname(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          434  +	char hostname[HOST_NAME_MAX + 1];
          435  +	int chk_ret;
          436  +
          437  +	if (objc == 1) {
          438  +		/* No arguments given, just return the hostname */
          439  +		chk_ret = gethostname(hostname, sizeof(hostname));
          440  +		if (chk_ret != 0) {
          441  +			Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          442  +
          443  +			return(TCL_ERROR);
          444  +		}
          445  +
          446  +		hostname[sizeof(hostname) - 1] = '\0';
          447  +
          448  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(hostname, -1));
          449  +
          450  +		return(TCL_OK);
          451  +	}
          452  +
          453  +	if (objc == 2) {
          454  +		/* Exactly one argument given, set the hostname */
          455  +		strncpy(hostname, Tcl_GetString(objv[1]), sizeof(hostname));
          456  +		hostname[sizeof(hostname) - 1] = '\0';
          457  +
          458  +		chk_ret = sethostname(hostname, strlen(hostname));
          459  +		if (chk_ret != 0) {
          460  +			Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          461  +
          462  +			return(TCL_ERROR);
          463  +		}
          464  +
          465  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(hostname, -1));
          466  +
          467  +		return(TCL_OK);
          468  +	}
          469  +
          470  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"hostname ?hostname?\"", -1));
          471  +
          472  +	return(TCL_ERROR);
          473  +}
          474  +
          475  +static int tclsystem_domainname(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          476  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
          477  +
          478  +	return(TCL_ERROR);
          479  +}
          480  +
          481  +static int tclsystem_chroot(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          482  +	char *pathname;
          483  +	int chk_ret;
          484  +
          485  +	if (objc != 2) {
          486  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall:chroot pathname\"", -1));
          487  +
          488  +		return(TCL_ERROR);
          489  +	}
          490  +
          491  +	pathname = Tcl_GetString(objv[1]);
          492  +
          493  +	chk_ret = chroot(pathname);
          494  +	if (chk_ret != 0) {
          495  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          496  +
          497  +		return(TCL_ERROR);
          498  +	}
          499  +
          500  +	return(TCL_OK);
          501  +}
          502  +
          503  +static int tclsystem_pivot_root(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          504  +	char *new_root, *put_old;
          505  +	int chk_ret;
          506  +
          507  +	if (objc != 3) {
          508  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::pivot_root new_root put_old\"", -1));
          509  +
          510  +		return(TCL_ERROR);
          511  +	}
          512  +
          513  +	new_root = Tcl_GetString(objv[1]);
          514  +	put_old = Tcl_GetString(objv[2]);
          515  +
          516  +	chk_ret = pivot_root(new_root, put_old);
          517  +	if (chk_ret != 0) {
          518  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          519  +
          520  +		return(TCL_ERROR);
          521  +	}
          522  +
          523  +	return(TCL_OK);
          524  +}
          525  +
          526  +static int tclsystem_mknod(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          527  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
          528  +
          529  +	return(TCL_ERROR);
          530  +}
          531  +
          532  +static int tclsystem_getuid(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          533  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
          534  +
          535  +	return(TCL_ERROR);
          536  +}
          537  +
          538  +static int tclsystem_kill(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          539  +	Tcl_Obj *signal_obj;
          540  +
          541  +	Tcl_WideInt pid_wide, sig_wide;
          542  +	pid_t pid;
          543  +	int sig;
          544  +	int kill_ret, tcl_ret;
          545  +
          546  +	if (objc != 3) {
          547  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::kill pid sig\"", -1));
          548  +
          549  +		return(TCL_ERROR);
          550  +	}
          551  +
          552  +	tcl_ret = Tcl_GetWideIntFromObj(interp, objv[1], &pid_wide);
          553  +	if (tcl_ret != TCL_OK) {
          554  +		return(tcl_ret);
          555  +	}
          556  +	pid = pid_wide;
          557  +
          558  +	signal_obj = objv[2];
          559  +
          560  +	tcl_ret = Tcl_GetWideIntFromObj(interp, signal_obj, &sig_wide);
          561  +	if (tcl_ret != TCL_OK) {
          562  +		switch (tclsystem_internal_simplehash_obj(signal_obj)) {
          563  +			case 0x122ad0: /* HUP */
          564  +			case 0x98f364d0: /* SIGHUP */
          565  +				sig = SIGHUP;
          566  +				break;
          567  +			case 0x126754: /* INT */
          568  +			case 0x98f32954: /* SIGINT */
          569  +				sig = SIGINT;
          570  +				break;
          571  +			case 0xa3564d4: /* QUIT */
          572  +			case 0x7a9242d4: /* SIGQUIT */
          573  +				sig = SIGQUIT;
          574  +				break;
          575  +			case 0x12664c: /* ILL */
          576  +			case 0x98f3284c: /* SIGILL */
          577  +				sig = SIGILL;
          578  +				break;
          579  +			case 0xa94a0d0: /* TRAP */
          580  +			case 0x7a3386d0: /* SIGTRAP */
          581  +				sig = SIGTRAP;
          582  +				break;
          583  +			case 0x830a954: /* ABRT */
          584  +			case 0x78978f54: /* SIGABRT */
          585  +				sig = SIGABRT;
          586  +				break;
          587  +			case 0x1267d4: /* IOT */
          588  +			case 0x98f329d4: /* SIGIOT */
          589  +				sig = SIGIOT;
          590  +				break;
          591  +			case 0x10aad3: /* BUS */
          592  +			case 0x98f1e4d3: /* SIGBUS */
          593  +				sig = SIGBUS;
          594  +				break;
          595  +			case 0x11a845: /* FPE */
          596  +			case 0x98f0e645: /* SIGFPE */
          597  +				sig = SIGFPE;
          598  +				break;
          599  +			case 0x972664c: /* KILL */
          600  +			case 0x79d5404c: /* SIGKILL */
          601  +				sig = SIGKILL;
          602  +				break;
          603  +			case 0xab4e931: /* USR1 */
          604  +			case 0x7a13cf31: /* SIGUSR1 */
          605  +				sig = SIGUSR1;
          606  +				break;
          607  +			case 0xa7163d6: /* SEGV */
          608  +			case 0x7ad645d6: /* SIGSEGV */
          609  +				sig = SIGSEGV;
          610  +				break;
          611  +			case 0xab4e932: /* USR2 */
          612  +			case 0x7a13cf32: /* SIGUSR2 */
          613  +				sig = SIGUSR2;
          614  +				break;
          615  +			case 0xa126845: /* PIPE */
          616  +			case 0x7ab54e45: /* SIGPIPE */
          617  +				sig = SIGPIPE;
          618  +				break;
          619  +			case 0x833294d: /* ALRM */
          620  +			case 0x78940f4d: /* SIGALRM */
          621  +				sig = SIGALRM;
          622  +				break;
          623  +			case 0xa91694d: /* TERM */
          624  +			case 0x7a364f4d: /* SIGTERM */
          625  +				sig = SIGTERM;
          626  +				break;
          627  +			case 0x4970e8d4: /* STKFLT */
          628  +			case 0x80fefc54: /* SIGSTKFLT */
          629  +				sig = SIGSTKFLT;
          630  +				break;
          631  +			case 0x8722644: /* CHLD */
          632  +			case 0x78d50044: /* SIGCHLD */
          633  +				sig = SIGCHLD;
          634  +				break;
          635  +			case 0x873e754: /* CONT */
          636  +			case 0x78d4c154: /* SIGCONT */
          637  +				sig = SIGCONT;
          638  +				break;
          639  +			case 0xa7527d0: /* STOP */
          640  +			case 0x7ad201d0: /* SIGSTOP */
          641  +				sig = SIGSTOP;
          642  +				break;
          643  +			case 0xa94ea50: /* TSTP */
          644  +			case 0x7a33cc50: /* SIGTSTP */
          645  +				sig = SIGTSTP;
          646  +				break;
          647  +			case 0xa9524ce: /* TTIN */
          648  +			case 0x7a3202ce: /* SIGTTIN */
          649  +				sig = SIGTTIN;
          650  +				break;
          651  +			case 0xa9527d5: /* TTOU */
          652  +			case 0x7a3201d5: /* SIGTTOU */
          653  +				sig = SIGTTOU;
          654  +				break;
          655  +			case 0x156947: /* URG */
          656  +			case 0x98f42747: /* SIGURG */
          657  +				sig = SIGURG;
          658  +				break;
          659  +			case 0xb10e855: /* XCPU */
          660  +			case 0x7bb7ce55: /* SIGXCPU */
          661  +				sig = SIGXCPU;
          662  +				break;
          663  +			case 0xb11a9da: /* XFSZ */
          664  +			case 0x7bb68fda: /* SIGXFSZ */
          665  +				sig = SIGXFSZ;
          666  +				break;
          667  +			case 0x483273cd: /* VTALRM */
          668  +			case 0x81bc674d: /* SIGVTALRM */
          669  +				sig = SIGVTALRM;
          670  +				break;
          671  +			case 0xa14a7c6: /* PROF */
          672  +			case 0x7ab381c6: /* SIGPROF */
          673  +				sig = SIGPROF;
          674  +				break;
          675  +			case 0x7933a348: /* WINCH */
          676  +			case 0x2aa0bf48: /* SIGWINCH */
          677  +				sig = SIGWINCH;
          678  +				break;
          679  +			case 0x24cf: /* IO */
          680  +			case 0x3931e64f: /* SIGIO */
          681  +				sig = SIGIO;
          682  +				break;
          683  +			case 0x142bd2: /* PWR */
          684  +			case 0x98f565d2: /* SIGPWR */
          685  +				sig = SIGPWR;
          686  +				break;
          687  +			case 0x14ecd3: /* SYS */
          688  +			case 0x98f5a2d3: /* SIGSYS */
          689  +				sig = SIGSYS;
          690  +				break;
          691  +			default:
          692  +				Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown signal \"%s\"", Tcl_GetString(signal_obj)));
          693  +
          694  +				return(TCL_ERROR);
          695  +		}
          696  +	} else {
          697  +		sig = sig_wide;
          698  +	}
          699  +
          700  +	kill_ret = kill(pid, sig);
          701  +	if (kill_ret != 0) {
          702  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          703  +
          704  +		return(TCL_ERROR);
          705  +	}
          706  +
          707  +	return(TCL_OK);
          708  +}
          709  +
          710  +static int tclsystem_ps(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          711  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
          712  +
          713  +	return(TCL_ERROR);
          714  +}
          715  +
          716  +static int tclsystem_execve(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          717  +	char **argv = NULL;
          718  +	char *file;
          719  +	int idx;
          720  +
          721  +	if (objc < 2) {
          722  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::execve file ?args ...?\"", -1));
          723  +
          724  +		return(TCL_ERROR);
          725  +	}
          726  +
          727  +	/* Find executable */
          728  +	file = Tcl_GetString(objv[1]);
          729  +
          730  +	/* Generate argument array */
          731  +	argv = malloc(sizeof(*argv) * (objc - 1));
          732  +
          733  +	for (idx = 2; idx < objc; idx++) {
          734  +		argv[idx - 2] = Tcl_GetString(objv[idx]);
          735  +	}
          736  +	argv[objc - 2] = NULL;
          737  +
          738  +	/* Pass execution to new file */
          739  +	execve(file, argv, environ);
          740  +
          741  +	/* If the new image could not take over, something went wrong -- report error */
          742  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          743  +
          744  +	return(TCL_ERROR);
          745  +}
          746  +
          747  +static int tclsystem_losetup(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
          748  +	char *file, *loopdev;
          749  +	int chk_ret;
          750  +	int loopfd, filefd;
          751  +
          752  +	if (objc != 3) {
          753  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::losetup loopdev file\"", -1));
          754  +
          755  +		return(TCL_ERROR);
          756  +	}
          757  +
          758  +	loopdev = Tcl_GetString(objv[1]);
          759  +	file = Tcl_GetString(objv[2]);
          760  +
          761  +	loopfd = open(loopdev, O_RDONLY);
          762  +	if (loopfd < 0) {
          763  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          764  +
          765  +		return(TCL_ERROR);
          766  +	}
          767  +
          768  +	if (file[0] != '\0') {
          769  +		filefd = open(file, O_RDONLY);
          770  +		if (filefd < 0) {
          771  +			close(loopfd);
          772  +
          773  +			Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          774  +
          775  +			return(TCL_ERROR);
          776  +		}
          777  +
          778  +		chk_ret = ioctl(loopfd, LOOP_SET_FD, filefd);
          779  +
          780  +		close(filefd);
          781  +	} else {
          782  +		chk_ret = ioctl(loopfd, LOOP_CLR_FD, 0);
          783  +	}
          784  +
          785  +	close(loopfd);
          786  +
          787  +	if (chk_ret != 0) {
          788  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
          789  +
          790  +		return(TCL_ERROR);
          791  +	}
          792  +
          793  +	return(TCL_OK);
          794  +}
          795  +
          796  +static void tclsystem_private_append_sockaddr_to_tclobj(Tcl_Interp *interp, Tcl_Obj *list, char *header, struct sockaddr *addr) {
          797  +	char addr_buf[INET6_ADDRSTRLEN + INET_ADDRSTRLEN + 1], *chk_inp;
          798  +
          799  +	switch (addr->sa_family) {
          800  +		case AF_INET: /* IPv4 */
          801  +		case AF_INET6: /* IPv6 */
          802  +			switch (addr->sa_family) {
          803  +				case AF_INET: /* IPv4 */
          804  +					chk_inp = (char *) inet_ntop(addr->sa_family, &((struct sockaddr_in *) addr)->sin_addr, addr_buf, sizeof(addr_buf));
          805  +					break;
          806  +				case AF_INET6: /* IPv6 */
          807  +					chk_inp = (char *) inet_ntop(addr->sa_family, &((struct sockaddr_in6 *) addr)->sin6_addr, addr_buf, sizeof(addr_buf));
          808  +					break;
          809  +			}
          810  +
          811  +			if (chk_inp == NULL) {
          812  +				break;
          813  +			}
          814  +
          815  +			if (header) {
          816  +				Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(header, -1));
          817  +			}
          818  +
          819  +			Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(addr_buf, -1));
          820  +
          821  +			break;
          822  +	}
          823  +
          824  +	return;
          825  +}
          826  +
          827  +static int tclsystem_private_get_sockaddr_from_obj(Tcl_Obj *value, void *target) {
          828  +	struct sockaddr_in local_v4;
          829  +	struct sockaddr_in6 local_v6;
          830  +	const char *addr_str;
          831  +	int inetpton_ret;
          832  +
          833  +	addr_str = Tcl_GetString(value);
          834  +
          835  +	memset(&local_v4, 0, sizeof(local_v4));
          836  +	inetpton_ret = inet_pton(AF_INET, addr_str, &local_v4.sin_addr);
          837  +	if (inetpton_ret == 1) {
          838  +		local_v4.sin_family = AF_INET;
          839  +
          840  +		memcpy(target, &local_v4, sizeof(local_v4));
          841  +
          842  +		return(0);
          843  +	}
          844  +
          845  +	memset(&local_v6, 0, sizeof(local_v6));
          846  +	inetpton_ret = inet_pton(AF_INET6, addr_str, &local_v6.sin6_addr);
          847  +	if (inetpton_ret == 1) {
          848  +		local_v6.sin6_family = AF_INET6;
          849  +
          850  +		memcpy(target, &local_v6, sizeof(local_v6));
          851  +
          852  +		return(0);
          853  +	}
          854  +
          855  +	return(-1);
          856  +}
          857  +
          858  +static int tclsystem_ifconfig_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock) {
          859  +	Tcl_Obj *tcl_iface_list;
          860  +	struct ifconf ifaces_cfg;
          861  +	struct ifreq *iface_req = NULL;
          862  +	int iface_req_cnt = 224, iface_req_len;
          863  +	int idx, iface_cnt;
          864  +	int ioctl_ret, tcl_ret;
          865  +
          866  +	iface_req_len = iface_req_cnt * sizeof(iface_req);
          867  +	iface_req = malloc(iface_req_len);
          868  +	if (iface_req == NULL) {
          869  +		/* Report failure */
          870  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to allocate memory", -1));
          871  +
          872  +		return(TCL_ERROR);
          873  +	}
          874  +
          875  +	ifaces_cfg.ifc_req = iface_req;
          876  +	ifaces_cfg.ifc_len = iface_req_len;
          877  +	ioctl_ret = ioctl(sock, SIOCGIFCONF, &ifaces_cfg);
          878  +	if (ioctl_ret != 0) {
          879  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("ioctl failed", -1));
          880  +
          881  +		free(iface_req);
          882  +
          883  +		return(TCL_ERROR);
          884  +	}
          885  +
          886  +	iface_cnt = ifaces_cfg.ifc_len / sizeof(*iface_req);
          887  +
          888  +	tcl_iface_list = Tcl_NewObj();
          889  +
          890  +	for (idx = 0; idx < iface_cnt; idx++) {
          891  +		tcl_ret = Tcl_ListObjAppendElement(interp, tcl_iface_list, Tcl_NewStringObj(iface_req[idx].ifr_name, -1));
          892  +		if (tcl_ret != TCL_OK) {
          893  +			Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to append to list", -1));
          894  +
          895  +			free(iface_req);
          896  +
          897  +			return(TCL_ERROR);
          898  +		}
          899  +	}
          900  +
          901  +	free(iface_req);
          902  +
          903  +	Tcl_SetObjResult(interp, tcl_iface_list);
          904  +
          905  +	return(TCL_OK);
          906  +}
          907  +
          908  +static int tclsystem_ifconfig_info(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock, int sock_v4, int sock_v6) {
          909  +	Tcl_Obj *retlist, *flags;
          910  +	struct ifreq iface_req;
          911  +	unsigned char *addr_data;
          912  +	const char *link_encap;
          913  +	const char *iface;
          914  +	int flags_bitmask, flag_broadcast = 0, flag_pointopoint = 0;
          915  +	int ioctl_ret;
          916  +
          917  +	retlist = Tcl_NewObj();
          918  +
          919  +	iface = Tcl_GetString(objv[1]);
          920  +
          921  +	if ((strlen(iface) + 1) >= IFNAMSIZ) {
          922  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("interface name too long", -1));
          923  +
          924  +		return(TCL_ERROR);
          925  +	}
          926  +
          927  +	strcpy(iface_req.ifr_name, iface);
          928  +
          929  +	/*
          930  +	 * All interfaces should have flags, so use it as a check for interface
          931  +	 * existance
          932  +	 */
          933  +	ioctl_ret = ioctl(sock, SIOCGIFFLAGS, &iface_req);
          934  +	if (ioctl_ret != 0) {
          935  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("invalid interface", -1));
          936  +
          937  +		return(TCL_ERROR);
          938  +	}
          939  +
          940  +	/* Create list of flags */
          941  +	flags = Tcl_NewObj();
          942  +	flags_bitmask = iface_req.ifr_flags;
          943  +
          944  +	if ((flags_bitmask & IFF_UP) == IFF_UP) {
          945  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("UP", -1));
          946  +	}
          947  +	if ((flags_bitmask & IFF_BROADCAST) == IFF_BROADCAST) {
          948  +		flag_broadcast = 1;
          949  +
          950  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("BROADCAST", -1));
          951  +	}
          952  +	if ((flags_bitmask & IFF_POINTOPOINT) == IFF_POINTOPOINT) {
          953  +		flag_pointopoint = 1;
          954  +
          955  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("POINTOPOINT", -1));
          956  +	}
          957  +	if ((flags_bitmask & IFF_DEBUG) == IFF_DEBUG) {
          958  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("DEBUG", -1));
          959  +	}
          960  +	if ((flags_bitmask & IFF_LOOPBACK) == IFF_LOOPBACK) {
          961  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("LOOPBACK", -1));
          962  +	}
          963  +	if ((flags_bitmask & IFF_NOTRAILERS) == IFF_NOTRAILERS) {
          964  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("NOTRAILERS", -1));
          965  +	}
          966  +	if ((flags_bitmask & IFF_RUNNING) == IFF_RUNNING) {
          967  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("RUNNING", -1));
          968  +	}
          969  +	if ((flags_bitmask & IFF_NOARP) == IFF_NOARP) {
          970  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("NOARP", -1));
          971  +	}
          972  +	if ((flags_bitmask & IFF_PROMISC) == IFF_PROMISC) {
          973  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("PROMISC", -1));
          974  +	}
          975  +	if ((flags_bitmask & IFF_ALLMULTI) == IFF_ALLMULTI) {
          976  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("ALLMULTI", -1));
          977  +	}
          978  +	if ((flags_bitmask & IFF_MASTER) == IFF_MASTER) {
          979  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("MASTER", -1));
          980  +	}
          981  +	if ((flags_bitmask & IFF_SLAVE) == IFF_SLAVE) {
          982  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("SLAVE", -1));
          983  +	}
          984  +	if ((flags_bitmask & IFF_MULTICAST) == IFF_MULTICAST) {
          985  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("MULTICAST", -1));
          986  +	}
          987  +	if ((flags_bitmask & IFF_PORTSEL) == IFF_PORTSEL) {
          988  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("PORTSEL", -1));
          989  +	}
          990  +	if ((flags_bitmask & IFF_AUTOMEDIA) == IFF_AUTOMEDIA) {
          991  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("AUTOMEDIA", -1));
          992  +	}
          993  +	if ((flags_bitmask & IFF_DYNAMIC) == IFF_DYNAMIC) {
          994  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("DYNAMIC", -1));
          995  +	}
          996  +	if ((flags_bitmask & IFF_LOWER_UP) == IFF_LOWER_UP) {
          997  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("LOWER_UP", -1));
          998  +	}
          999  +	if ((flags_bitmask & IFF_DORMANT) == IFF_DORMANT) {
         1000  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("DORMANT", -1));
         1001  +	}
         1002  +#ifdef IFF_ECHO
         1003  +	if ((flags_bitmask & IFF_ECHO) == IFF_ECHO) {
         1004  +		Tcl_ListObjAppendElement(interp, flags, Tcl_NewStringObj("ECHO", -1));
         1005  +	}
         1006  +#endif
         1007  +
         1008  +	/* Add array-compliant/dict entry to the return list */
         1009  +	Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj("flags", -1));
         1010  +	Tcl_ListObjAppendElement(interp, retlist, flags);
         1011  +
         1012  +	/* Fetch other attributes from the interface */
         1013  +	ioctl_ret = ioctl(sock, SIOCGIFHWADDR, &iface_req);
         1014  +	if (ioctl_ret == 0) {
         1015  +		link_encap = "unknown";
         1016  +
         1017  +		addr_data = (unsigned char *) iface_req.ifr_hwaddr.sa_data;
         1018  +		switch (iface_req.ifr_hwaddr.sa_family) {
         1019  +			case ARPHRD_ETHER:
         1020  +				link_encap = "ethernet";
         1021  +
         1022  +				Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj("hwaddr", -1));
         1023  +				Tcl_ListObjAppendElement(interp, retlist,
         1024  +				  Tcl_ObjPrintf("%02x:%02x:%02x:%02x:%02x:%02x",
         1025  +				    addr_data[0],
         1026  +				    addr_data[1],
         1027  +				    addr_data[2],
         1028  +				    addr_data[3],
         1029  +				    addr_data[4],
         1030  +				    addr_data[5]
         1031  +				  )
         1032  +				);
         1033  +
         1034  +				break;
         1035  +			case ARPHRD_AX25:
         1036  +				link_encap = "ax25";
         1037  +				break;
         1038  +			case ARPHRD_PRONET:
         1039  +				link_encap = "pronet";
         1040  +				break;
         1041  +			case ARPHRD_CHAOS:
         1042  +				link_encap = "chaos";
         1043  +				break;
         1044  +			case ARPHRD_IEEE802:
         1045  +				link_encap = "ieee802";
         1046  +				break;
         1047  +			case ARPHRD_ARCNET:
         1048  +				link_encap = "arcnet";
         1049  +				break;
         1050  +			case ARPHRD_APPLETLK:
         1051  +				link_encap = "appletlk";
         1052  +				break;
         1053  +			case ARPHRD_DLCI:
         1054  +				link_encap = "dlci";
         1055  +				break;
         1056  +			case ARPHRD_ATM:
         1057  +				link_encap = "atm";
         1058  +				break;
         1059  +			case ARPHRD_METRICOM:
         1060  +				link_encap = "metricom";
         1061  +				break;
         1062  +			case ARPHRD_IEEE1394:
         1063  +				link_encap = "ieee1394";
         1064  +				break;
         1065  +			case ARPHRD_EUI64:
         1066  +				link_encap = "eui64";
         1067  +				break;
         1068  +			case ARPHRD_INFINIBAND:
         1069  +				link_encap = "infiniband";
         1070  +				break;
         1071  +			case ARPHRD_SLIP:
         1072  +				link_encap = "slip";
         1073  +				break;
         1074  +			case ARPHRD_CSLIP:
         1075  +				link_encap = "cslip";
         1076  +				break;
         1077  +			case ARPHRD_SLIP6:
         1078  +				link_encap = "slip6";
         1079  +				break;
         1080  +			case ARPHRD_CSLIP6:
         1081  +				link_encap = "cslip6";
         1082  +				break;
         1083  +			case ARPHRD_RSRVD:
         1084  +				link_encap = "rsrvd";
         1085  +				break;
         1086  +			case ARPHRD_ADAPT:
         1087  +				link_encap = "adapt";
         1088  +				break;
         1089  +			case ARPHRD_ROSE:
         1090  +				link_encap = "rose";
         1091  +				break;
         1092  +			case ARPHRD_X25:
         1093  +				link_encap = "x25";
         1094  +				break;
         1095  +			case ARPHRD_HWX25:
         1096  +				link_encap = "hwx25";
         1097  +				break;
         1098  +			case ARPHRD_CAN:
         1099  +				link_encap = "can";
         1100  +				break;
         1101  +			case ARPHRD_PPP:
         1102  +				link_encap = "ppp";
         1103  +				break;
         1104  +			case ARPHRD_CISCO:
         1105  +				link_encap = "cisco";
         1106  +				break;
         1107  +			case ARPHRD_LAPB:
         1108  +				link_encap = "lapb";
         1109  +				break;
         1110  +			case ARPHRD_DDCMP:
         1111  +				link_encap = "ddcmp";
         1112  +				break;
         1113  +			case ARPHRD_RAWHDLC:
         1114  +				link_encap = "rawhdlc";
         1115  +				break;
         1116  +			case ARPHRD_TUNNEL:
         1117  +				link_encap = "tunnel";
         1118  +				break;
         1119  +			case ARPHRD_TUNNEL6:
         1120  +				link_encap = "tunnel6";
         1121  +				break;
         1122  +			case ARPHRD_FRAD:
         1123  +				link_encap = "frad";
         1124  +				break;
         1125  +			case ARPHRD_SKIP:
         1126  +				link_encap = "skip";
         1127  +				break;
         1128  +			case ARPHRD_LOOPBACK:
         1129  +				link_encap = "loopback";
         1130  +				break;
         1131  +			case ARPHRD_LOCALTLK:
         1132  +				link_encap = "localtalk";
         1133  +				break;
         1134  +			case ARPHRD_FDDI:
         1135  +				link_encap = "fddi";
         1136  +				break;
         1137  +			case ARPHRD_BIF:
         1138  +				link_encap = "bif";
         1139  +				break;
         1140  +			case ARPHRD_SIT:
         1141  +				link_encap = "sit";
         1142  +				break;
         1143  +			case ARPHRD_IPDDP:
         1144  +				link_encap = "ipddp";
         1145  +				break;
         1146  +			case ARPHRD_IPGRE:
         1147  +				link_encap = "gre";
         1148  +				break;
         1149  +			case ARPHRD_PIMREG:
         1150  +				link_encap = "pimreg";
         1151  +				break;
         1152  +			case ARPHRD_HIPPI:
         1153  +				link_encap = "hippi";
         1154  +				break;
         1155  +			case ARPHRD_ASH:
         1156  +				link_encap = "ash";
         1157  +				break;
         1158  +			case ARPHRD_ECONET:
         1159  +				link_encap = "econet";
         1160  +				break;
         1161  +			case ARPHRD_IRDA:
         1162  +				link_encap = "irda";
         1163  +				break;
         1164  +		}
         1165  +
         1166  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj("link_encap", -1));
         1167  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj(link_encap, -1));
         1168  +	}
         1169  +
         1170  +	ioctl_ret = ioctl(sock, SIOCGIFMETRIC, &iface_req);
         1171  +	if (ioctl_ret == 0) {
         1172  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj("metric", -1));
         1173  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewWideIntObj(iface_req.ifr_metric + 1));
         1174  +	}
         1175  +
         1176  +	ioctl_ret = ioctl(sock, SIOCGIFMTU, &iface_req);
         1177  +	if (ioctl_ret == 0) {
         1178  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj("mtu", -1));
         1179  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewWideIntObj(iface_req.ifr_mtu));
         1180  +	}
         1181  +
         1182  +	ioctl_ret = ioctl(sock, SIOCGIFINDEX, &iface_req);
         1183  +	if (ioctl_ret == 0) {
         1184  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewStringObj("index", -1));
         1185  +		Tcl_ListObjAppendElement(interp, retlist, Tcl_NewWideIntObj(iface_req.ifr_ifindex));
         1186  +	}
         1187  +
         1188  +	if (sock_v4 != -1) {
         1189  +		ioctl_ret = ioctl(sock_v4, SIOCGIFADDR, &iface_req);
         1190  +		if (ioctl_ret == 0) {
         1191  +			tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "address", &iface_req.ifr_addr);
         1192  +		}
         1193  +
         1194  +		if (flag_pointopoint) {
         1195  +			/* Point-to-Point interfaces */
         1196  +			ioctl_ret = ioctl(sock_v4, SIOCGIFDSTADDR, &iface_req);
         1197  +			if (ioctl_ret == 0) {
         1198  +				tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "destination", &iface_req.ifr_addr);
         1199  +			}
         1200  +		}
         1201  +
         1202  +		if (flag_broadcast) {
         1203  +			/* Broadcast interfaces */
         1204  +			ioctl_ret = ioctl(sock_v4, SIOCGIFBRDADDR, &iface_req);
         1205  +			if (ioctl_ret == 0) {
         1206  +				tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "broadcast", &iface_req.ifr_addr);
         1207  +			}
         1208  +		}
         1209  +
         1210  +		ioctl_ret = ioctl(sock_v4, SIOCGIFNETMASK, &iface_req);
         1211  +		if (ioctl_ret == 0) {
         1212  +			tclsystem_private_append_sockaddr_to_tclobj(interp, retlist, "netmask", &iface_req.ifr_addr);
         1213  +		}
         1214  +	}
         1215  +
         1216  +	Tcl_SetObjResult(interp, retlist);
         1217  +
         1218  +	return(TCL_OK);
         1219  +}
         1220  +
         1221  +static int tclsystem_ifconfig_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock, int sock_v4, int sock_v6) {
         1222  +	Tcl_Obj *option_name_obj, *option_val_obj;
         1223  +	Tcl_Obj **flags_objv;
         1224  +	struct ifreq iface_req;
         1225  +	struct sockaddr *tmp_ioctl_addr;
         1226  +	const char *iface;
         1227  +	short flags;
         1228  +	int flags_objc;
         1229  +	int tmp_sock, tmp_ioctl;
         1230  +	int ioctl_ret, tcl_ret, parse_ret;
         1231  +
         1232  +	iface = Tcl_GetString(objv[1]);
         1233  +
         1234  +	if ((strlen(iface) + 1) >= IFNAMSIZ) {
         1235  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("interface name too long", -1));
         1236  +
         1237  +		return(TCL_ERROR);
         1238  +	}
         1239  +
         1240  +	objc -= 2;
         1241  +	objv += 2;
         1242  +
         1243  +	for (; objc > 0; objc--,objv++) {
         1244  +		/* Prepare for an ioctl() */
         1245  +		strcpy(iface_req.ifr_name, iface);
         1246  +		tmp_ioctl = -1;
         1247  +
         1248  +		option_name_obj = objv[0];
         1249  +
         1250  +		if (objc == 1) {
         1251  +			Tcl_SetObjResult(interp, Tcl_ObjPrintf("option \"%s\" requires an argument", Tcl_GetString(option_name_obj)));
         1252  +
         1253  +			return(TCL_ERROR);
         1254  +		}
         1255  +
         1256  +		objc--;
         1257  +		objv++;
         1258  +
         1259  +		option_val_obj = objv[0];
         1260  +
         1261  +		switch (tclsystem_internal_simplehash_obj(option_name_obj)) {
         1262  +			case 0x6d9870f3: /* flags */
         1263  +				flags = 0;
         1264  +
         1265  +				tcl_ret = Tcl_ListObjGetElements(interp, option_val_obj, &flags_objc, &flags_objv);
         1266  +				if (tcl_ret != TCL_OK) {
         1267  +					return(tcl_ret);
         1268  +				}
         1269  +
         1270  +				for (; flags_objc > 0; flags_objc--,flags_objv++) {
         1271  +					switch (tclsystem_internal_simplehash_obj(flags_objv[0])) {
         1272  +						case 0x2ad0: /* UP */
         1273  +							flags |= IFF_UP;
         1274  +							break;
         1275  +						case 0x1aef7f54: /* BROADCAST */
         1276  +							flags |= IFF_BROADCAST;
         1277  +							break;
         1278  +						case 0xc252abd4: /* POINTOPOINT */
         1279  +							flags |= IFF_POINTOPOINT;
         1280  +							break;
         1281  +						case 0x48b0a8c7: /* DEBUG */
         1282  +							flags |= IFF_DEBUG;
         1283  +							break;
         1284  +						case 0x4d3dbcd3: /* NOTRAILERS */
         1285  +							flags |= IFF_NOTRAILERS;
         1286  +							break;
         1287  +						case 0xe9773147: /* RUNNING */
         1288  +							flags |= IFF_RUNNING;
         1289  +							break;
         1290  +						case 0xe9f06b50: /* NOARP */
         1291  +							flags |= IFF_NOARP;
         1292  +							break;
         1293  +						case 0xf91323c3: /* PROMISC */
         1294  +							flags |= IFF_PROMISC;
         1295  +							break;
         1296  +						case 0x9b2a1849: /* ALLMULTI */
         1297  +							flags |= IFF_ALLMULTI;
         1298  +							break;
         1299  +						case 0x1a7414d2: /* MASTER */
         1300  +							flags |= IFF_MASTER;
         1301  +							break;
         1302  +						case 0x399069c5: /* SLAVE */
         1303  +							flags |= IFF_SLAVE;
         1304  +							break;
         1305  +						case 0x4de928d4: /* MULTICAST */
         1306  +							flags |= IFF_MULTICAST;
         1307  +							break;
         1308  +						case 0x2a35dc4c: /* PORTSEL */
         1309  +							flags |= IFF_PORTSEL;
         1310  +							break;
         1311  +						case 0xd180ac1: /* AUTOMEDIA */
         1312  +							flags |= IFF_AUTOMEDIA;
         1313  +							break;
         1314  +						case 0xe8ba02c3: /* DYNAMIC */
         1315  +							flags |= IFF_DYNAMIC;
         1316  +							break;
         1317  +						case 0x16c8b4d0: /* LOWER_UP */
         1318  +							flags |= IFF_LOWER_UP;
         1319  +							break;
         1320  +						case 0x293959d4: /* DORMANT */
         1321  +							flags |= IFF_DORMANT;
         1322  +							break;
         1323  +#ifdef IFF_ECHO
         1324  +						case 0x8b0e44f: /* ECHO */
         1325  +							flags |= IFF_ECHO;
         1326  +							break;
         1327  +#endif
         1328  +					}
         1329  +				}
         1330  +
         1331  +				iface_req.ifr_flags = flags;
         1332  +
         1333  +				ioctl_ret = ioctl(sock, SIOCSIFFLAGS, &iface_req);
         1334  +				if (ioctl_ret != 0) {
         1335  +					Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
         1336  +
         1337  +					return(TCL_ERROR);
         1338  +				}
         1339  +
         1340  +				break;
         1341  +			case 0x5e9d03e3: /* metric */
         1342  +			case 0x1b7a75: /* mtu */
         1343  +			case 0x7c3891f2: /* hwaddr */
         1344  +			case 0xbf72a969: /* addmulti */
         1345  +			case 0xba708969: /* delmulti */
         1346  +			case 0xdd876e5: /* name */
         1347  +					Tcl_SetObjResult(interp, Tcl_ObjPrintf("option \"%s\" unsupported", Tcl_GetString(option_name_obj)));
         1348  +
         1349  +					return(TCL_ERROR);
         1350  +				break;
         1351  +			case 0x4e9aeaf3: /* address */
         1352  +				if (tmp_ioctl == -1) {
         1353  +					tmp_ioctl = SIOCSIFADDR;
         1354  +					tmp_ioctl_addr = &iface_req.ifr_addr;
         1355  +				}
         1356  +
         1357  +			case 0xec05706e: /* destination */
         1358  +				if (tmp_ioctl == -1) {
         1359  +					tmp_ioctl = SIOCSIFDSTADDR;
         1360  +					tmp_ioctl_addr = &iface_req.ifr_dstaddr;
         1361  +				}
         1362  +
         1363  +			case 0x3ea7e674: /* broadcast */
         1364  +				if (tmp_ioctl == -1) {
         1365  +					tmp_ioctl = SIOCSIFBRDADDR;
         1366  +					tmp_ioctl_addr = &iface_req.ifr_broadaddr;
         1367  +				}
         1368  +
         1369  +			case 0x4d65ee6b: /* netmask */
         1370  +				if (tmp_ioctl == -1) {
         1371  +					tmp_ioctl = SIOCSIFNETMASK;
         1372  +					tmp_ioctl_addr = &iface_req.ifr_netmask;
         1373  +				}
         1374  +
         1375  +				parse_ret = tclsystem_private_get_sockaddr_from_obj(option_val_obj, tmp_ioctl_addr);
         1376  +				if (parse_ret != 0) {
         1377  +					Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(option_val_obj)));
         1378  +
         1379  +					return(TCL_ERROR);
         1380  +				}
         1381  +
         1382  +				switch (tmp_ioctl_addr->sa_family) {
         1383  +					case AF_INET:
         1384  +						tmp_sock = sock_v4;
         1385  +
         1386  +						break;
         1387  +					case AF_INET6:
         1388  +						tmp_sock = sock_v6;
         1389  +
         1390  +						break;
         1391  +					default:
         1392  +						Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to determine address family of sockaddr", -1));
         1393  +						return(TCL_ERROR);
         1394  +				}
         1395  +
         1396  +				ioctl_ret = ioctl(tmp_sock, tmp_ioctl, &iface_req);
         1397  +				if (ioctl_ret != 0) {
         1398  +					Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
         1399  +
         1400  +					return(TCL_ERROR);
         1401  +				}
         1402  +
         1403  +				break;
         1404  +			default:
         1405  +				Tcl_SetObjResult(interp, Tcl_ObjPrintf("unknown option \"%s\"", Tcl_GetString(option_name_obj)));
         1406  +
         1407  +				return(TCL_ERROR);
         1408  +		}
         1409  +	}
         1410  +
         1411  +	return(TCL_OK);
         1412  +}
         1413  +
         1414  +static int tclsystem_ifconfig(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
         1415  +	int sock_v4, sock_v6, sock;
         1416  +	int retval = TCL_ERROR;
         1417  +
         1418  +	/*
         1419  +	 * Check for IPv4 support before trying to create an IPv4 socket to
         1420  +	 * avoid demand-loading IPv4 (XXX: TODO)
         1421  +	 */
         1422  +	sock_v4 = socket(AF_INET, SOCK_DGRAM, 0);
         1423  +
         1424  +	/*
         1425  +	 * Check for IPv6 support before trying to create an IPv6 socket to
         1426  +	 * avoid demand-loading IPv6 (XXX: TODO)
         1427  +	 */
         1428  +	sock_v6 = socket(AF_INET6, SOCK_DGRAM, 0);
         1429  +
         1430  +	/* Pick a socket to query for the interface list */
         1431  +	if (sock_v4 == -1 && sock_v6 == -1) {
         1432  +		/* Report failure */
         1433  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create socket", -1));
         1434  +
         1435  +		return(TCL_ERROR);
         1436  +	}
         1437  +
         1438  +	if (sock_v6 != -1) {
         1439  +		sock = sock_v6;
         1440  +	} else {
         1441  +		sock = sock_v4;
         1442  +	}
         1443  +
         1444  +	switch (objc) {
         1445  +		case 0:
         1446  +		case 1: /* No arguments, list all interfaces */
         1447  +			retval = tclsystem_ifconfig_list(cd, interp, objc, objv, sock);
         1448  +
         1449  +			break;
         1450  +		case 2: /* One argument, give information about the interface */
         1451  +			retval = tclsystem_ifconfig_info(cd, interp, objc, objv, sock, sock_v4, sock_v6);
         1452  +
         1453  +			break;
         1454  +		default:
         1455  +			/* Otherwise, configure the interace */
         1456  +			retval = tclsystem_ifconfig_conf(cd, interp, objc, objv, sock, sock_v4, sock_v6);
         1457  +
         1458  +			break;
         1459  +	}
         1460  +
         1461  +	/* Cleanup */
         1462  +	if (sock_v4 != -1) {
         1463  +		close(sock_v4);
         1464  +	}
         1465  +
         1466  +	if (sock_v6 != -1) {
         1467  +		close(sock_v6);
         1468  +	}
         1469  +
         1470  +	return(retval);
         1471  +}
         1472  +
         1473  +static int tclsystem_route_list(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock_v4, int sock_v6) {
         1474  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("not implemented", -1));
         1475  +
         1476  +	return(TCL_ERROR);
         1477  +}
         1478  +
         1479  +static int tclsystem_route_conf(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int sock_v4, int sock_v6) {
         1480  +	Tcl_WideInt option_val_wide; 
         1481  +	Tcl_Obj *operation_obj, *dest_obj, *destmask_obj;
         1482  +	Tcl_Obj *option_name_obj, *option_val_obj;
         1483  +	struct rtentry route;
         1484  +	int sock;
         1485  +	int ioctl_id;
         1486  +	int tcl_ret, ioctl_ret, parse_ret;
         1487  +
         1488  +	if (objc < 4) {
         1489  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # args: should be \"::system::syscall::route operation destination destination_mask ?options?\"", -1));
         1490  +
         1491  +		return(TCL_ERROR);
         1492  +	}
         1493  +
         1494  +	/* Clear object values */
         1495  +	memset(&route, 0, sizeof(route));
         1496  +
         1497  +	/* Determine operation */
         1498  +	operation_obj = objv[1];
         1499  +	switch (tclsystem_internal_simplehash_obj(operation_obj)) {
         1500  +		case 0x187264: /* add */
         1501  +			ioctl_id = SIOCADDRT;
         1502  +			break;
         1503  +		case 0x1932ec: /* del */
         1504  +		case 0x5d98e965: /* delete */
         1505  +			ioctl_id = SIOCDELRT;
         1506  +			break;
         1507  +		default:
         1508  +			Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad option \"%s\": must be add, or delete", Tcl_GetString(operation_obj)));
         1509  +
         1510  +			return(TCL_ERROR);
         1511  +	}
         1512  +
         1513  +	/* Set default flags */
         1514  +	route.rt_flags = RTF_UP;
         1515  +
         1516  +	/* Parse destination address */
         1517  +	dest_obj = objv[2];
         1518  +	parse_ret = tclsystem_private_get_sockaddr_from_obj(dest_obj, &route.rt_dst);
         1519  +	if (parse_ret != 0) {
         1520  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(dest_obj)));
         1521  +
         1522  +		return(TCL_ERROR);
         1523  +	}
         1524  +
         1525  +	/* Parse destination netmask */
         1526  +	destmask_obj = objv[3];
         1527  +	parse_ret = tclsystem_private_get_sockaddr_from_obj(destmask_obj, &route.rt_genmask);
         1528  +	if (parse_ret != 0) {
         1529  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(destmask_obj)));
         1530  +
         1531  +		return(TCL_ERROR);
         1532  +	}
         1533  +
         1534  +	if (route.rt_dst.sa_family != route.rt_genmask.sa_family) {
         1535  +		Tcl_SetObjResult(interp,
         1536  +		  Tcl_ObjPrintf("destination (\"%s\") and destination_mask (\"%s\") are different classes",
         1537  +		    Tcl_GetString(dest_obj),
         1538  +		    Tcl_GetString(destmask_obj)
         1539  +		  )
         1540  +		);
         1541  +
         1542  +		return(TCL_ERROR);
         1543  +	}
         1544  +
         1545  +	switch (route.rt_dst.sa_family) {
         1546  +		case AF_INET: /* IPv4 */
         1547  +			if (sock_v4 == -1) {
         1548  +				Tcl_SetObjResult(interp, Tcl_ObjPrintf("address \"%s\" is IPv4, but unable to create IPv4 socket", Tcl_GetString(dest_obj)));
         1549  +
         1550  +				return(TCL_ERROR);
         1551  +			}
         1552  +
         1553  +			if (((struct sockaddr_in *) &route.rt_genmask)->sin_addr.s_addr == INADDR_BROADCAST) {
         1554  +				route.rt_flags |= RTF_HOST;
         1555  +			}
         1556  +
         1557  +			sock = sock_v4;
         1558  +
         1559  +			break;
         1560  +		case AF_INET6: /* IPv6 */
         1561  +			if (sock_v6 == -1) {
         1562  +				Tcl_SetObjResult(interp, Tcl_ObjPrintf("address \"%s\" is IPv6, but unable to create IPv6 socket", Tcl_GetString(dest_obj)));
         1563  +
         1564  +				return(TCL_ERROR);
         1565  +			}
         1566  +
         1567  +			sock = sock_v6;
         1568  +
         1569  +			break;
         1570  +		default:
         1571  +			Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to determine type of address for \"%s\"", Tcl_GetString(dest_obj)));
         1572  +
         1573  +			return(TCL_ERROR);
         1574  +	}
         1575  +
         1576  +	/* Parse remaining options */
         1577  +	objc -= 4;
         1578  +	objv += 4;
         1579  +
         1580  +	for (; objc > 0; objc--,objv++) {
         1581  +		option_name_obj = objv[0];
         1582  +
         1583  +		if (objc < 2) {
         1584  +			Tcl_SetObjResult(interp, Tcl_ObjPrintf("option \"%s\" requires an argument", Tcl_GetString(option_name_obj)));
         1585  +
         1586  +			return(TCL_ERROR);
         1587  +		}
         1588  +
         1589  +		objc--;
         1590  +		objv++;
         1591  +
         1592  +		option_val_obj = objv[0];
         1593  +
         1594  +		switch (tclsystem_internal_simplehash_obj(option_name_obj)) {
         1595  +			case 0x4c727779: /* gateway */
         1596  +				parse_ret = tclsystem_private_get_sockaddr_from_obj(option_val_obj, &route.rt_gateway);
         1597  +				if (parse_ret != 0) {
         1598  +					Tcl_SetObjResult(interp, Tcl_ObjPrintf("unable to parse \"%s\" as an address", Tcl_GetString(option_val_obj)));
         1599  +
         1600  +					return(TCL_ERROR);
         1601  +				}
         1602  +
         1603  +				route.rt_flags &= (~RTF_HOST);
         1604  +				route.rt_flags |= RTF_GATEWAY;
         1605  +
         1606  +				break;
         1607  +			case 0x1b7a75: /* mtu */
         1608  +				tcl_ret = Tcl_GetWideIntFromObj(interp, option_val_obj, &option_val_wide);
         1609  +				if (tcl_ret != TCL_OK) {
         1610  +					return(tcl_ret);
         1611  +				}
         1612  +
         1613  +				route.rt_flags |= RTF_MTU;
         1614  +				route.rt_mtu = option_val_wide;
         1615  +
         1616  +				break;
         1617  +			case 0x5e9d03e3: /* metric */
         1618  +				tcl_ret = Tcl_GetWideIntFromObj(interp, option_val_obj, &option_val_wide);
         1619  +				if (tcl_ret != TCL_OK) {
         1620  +					return(tcl_ret);
         1621  +				}
         1622  +
         1623  +				route.rt_metric = option_val_wide;
         1624  +
         1625  +				break;
         1626  +			case 0x9dd8e8f7: /* window */
         1627  +				tcl_ret = Tcl_GetWideIntFromObj(interp, option_val_obj, &option_val_wide);
         1628  +				if (tcl_ret != TCL_OK) {
         1629  +					return(tcl_ret);
         1630  +				}
         1631  +
         1632  +				route.rt_flags |= RTF_WINDOW;
         1633  +				route.rt_window = option_val_wide;
         1634  +
         1635  +				break;
         1636  +			case 0x1932f6: /* dev */
         1637  +			case 0x5edbe2e5: /* device */
         1638  +				route.rt_dev = strdup(Tcl_GetString(option_val_obj));
         1639  +
         1640  +				break;
         1641  +			default:
         1642  +				Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad option \"%s\": must be gateway, mtu, metric, device, or window", Tcl_GetString(option_name_obj)));
         1643  +
         1644  +				return(TCL_ERROR);
         1645  +		}
         1646  +	}
         1647  +
         1648  +	/* Request route change */
         1649  +	ioctl_ret = ioctl(sock, ioctl_id, &route);
         1650  +	if (ioctl_ret != 0) {
         1651  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(strerror(errno), -1));
         1652  +
         1653  +		return(TCL_ERROR);
         1654  +	}
         1655  +
         1656  +	return(TCL_OK);
         1657  +}
         1658  +
         1659  +static int tclsystem_route(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
         1660  +	int sock_v4, sock_v6, sock;
         1661  +	int retval = TCL_ERROR;
         1662  +
         1663  +	/*
         1664  +	 * Check for IPv4 support before trying to create an IPv4 socket to
         1665  +	 * avoid demand-loading IPv4 (XXX: TODO)
         1666  +	 */
         1667  +	sock_v4 = socket(AF_INET, SOCK_DGRAM, 0);
         1668  +
         1669  +	/*
         1670  +	 * Check for IPv6 support before trying to create an IPv6 socket to
         1671  +	 * avoid demand-loading IPv6 (XXX: TODO)
         1672  +	 */
         1673  +	sock_v6 = socket(AF_INET6, SOCK_DGRAM, 0);
         1674  +
         1675  +	/* Pick a socket to query for the interface list */
         1676  +	if (sock_v4 == -1 && sock_v6 == -1) {
         1677  +		/* Report failure */
         1678  +		Tcl_SetObjResult(interp, Tcl_NewStringObj("unable to create socket", -1));
         1679  +
         1680  +		return(TCL_ERROR);
         1681  +	}
         1682  +
         1683  +	if (sock_v6 != -1) {
         1684  +		sock = sock_v6;
         1685  +	} else {
         1686  +		sock = sock_v4;
         1687  +	}
         1688  +
         1689  +	switch (objc) {
         1690  +		case 0:
         1691  +		case 1: /* No arguments, list all interfaces */
         1692  +			retval = tclsystem_route_list(cd, interp, objc, objv, sock_v4, sock_v6);
         1693  +
         1694  +			break;
         1695  +		default:
         1696  +			/* Otherwise, modify routes */
         1697  +			retval = tclsystem_route_conf(cd, interp, objc, objv, sock_v4, sock_v6);
         1698  +
         1699  +			break;
         1700  +	}
         1701  +
         1702  +	/* Cleanup */
         1703  +	if (sock_v4 != -1) {
         1704  +		close(sock_v4);
         1705  +	}
         1706  +
         1707  +	if (sock_v6 != -1) {
         1708  +		close(sock_v6);
         1709  +	}
         1710  +
         1711  +	return(retval);
         1712  +}
         1713  +
         1714  +int System_Init(Tcl_Interp *interp) {
         1715  +#ifdef USE_TCL_STUBS
         1716  +	const char *tclInitStubs_ret;
         1717  +
         1718  +	/* Initialize Stubs */
         1719  +	tclInitStubs_ret = Tcl_InitStubs(interp, "8.4", 0);
         1720  +	if (!tclInitStubs_ret) {
         1721  +		return(TCL_ERROR);
         1722  +	}
         1723  +#endif
         1724  +
         1725  +	/* Kernel maintenance related commands */
         1726  +	Tcl_CreateObjCommand(interp, "::system::syscall::insmod", tclsystem_insmod, NULL, NULL);
         1727  +	Tcl_CreateObjCommand(interp, "::system::syscall::rmmod", tclsystem_rmmod, NULL, NULL);
         1728  +	Tcl_CreateObjCommand(interp, "::system::syscall::lsmod", tclsystem_lsmod, NULL, NULL);
         1729  +	Tcl_CreateObjCommand(interp, "::system::syscall::hostname", tclsystem_hostname, NULL, NULL);
         1730  +	Tcl_CreateObjCommand(interp, "::system::syscall::domainname", tclsystem_domainname, NULL, NULL);
         1731  +
         1732  +	/* Block or char device related commands */
         1733  +	Tcl_CreateObjCommand(interp, "::system::syscall::losetup", tclsystem_losetup, NULL, NULL);
         1734  +
         1735  +	/* Filesystem related commands */
         1736  +	Tcl_CreateObjCommand(interp, "::system::syscall::mount", tclsystem_mount, NULL, NULL);
         1737  +	Tcl_CreateObjCommand(interp, "::system::syscall::umount", tclsystem_umount, NULL, NULL);
         1738  +	Tcl_CreateObjCommand(interp, "::system::syscall::swapon", tclsystem_swapon, NULL, NULL);
         1739  +	Tcl_CreateObjCommand(interp, "::system::syscall::swapoff", tclsystem_swapoff, NULL, NULL);
         1740  +	Tcl_CreateObjCommand(interp, "::system::syscall::mknod", tclsystem_mknod, NULL, NULL);
         1741  +
         1742  +	/* Process related commands */
         1743  +	Tcl_CreateObjCommand(interp, "::system::syscall::getuid", tclsystem_getuid, NULL, NULL);
         1744  +	Tcl_CreateObjCommand(interp, "::system::syscall::chroot", tclsystem_chroot, NULL, NULL);
         1745  +	Tcl_CreateObjCommand(interp, "::system::syscall::pivot_root", tclsystem_pivot_root, NULL, NULL);
         1746  +	Tcl_CreateObjCommand(interp, "::system::syscall::kill", tclsystem_kill, NULL, NULL);
         1747  +	Tcl_CreateObjCommand(interp, "::system::syscall::ps", tclsystem_ps, NULL, NULL);
         1748  +	Tcl_CreateObjCommand(interp, "::system::syscall::execve", tclsystem_execve, NULL, NULL);
         1749  +
         1750  +	/* Network related commands */
         1751  +	Tcl_CreateObjCommand(interp, "::system::syscall::ifconfig", tclsystem_ifconfig, NULL, NULL);
         1752  +	Tcl_CreateObjCommand(interp, "::system::syscall::route", tclsystem_route, NULL, NULL);
         1753  +
         1754  +	/* Internal functions */
         1755  +	Tcl_CreateObjCommand(interp, "::system::internal::hash", tclsystem_internalproc_simplehash, NULL, NULL);
         1756  +
         1757  +	/* Define constants */
         1758  +	/** Create parent namespace **/
         1759  +	Tcl_CreateNamespace(interp, "::system::const", NULL, NULL);
         1760  +
         1761  +	/** Define constants, for real **/
         1762  +	Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::system::const::HOST_NAME_MAX", -1), NULL, Tcl_NewWideIntObj(HOST_NAME_MAX), TCL_GLOBAL_ONLY);
         1763  +
         1764  +	/* Create high-level user functions */
         1765  +	Tcl_Eval(interp,
         1766  +#include "system.tcl.h" 
         1767  +	);
         1768  +
         1769  +	Tcl_PkgProvide(interp, "system", "0.1");
         1770  +
         1771  +	return(TCL_OK);
         1772  +}

Added system.tcl version [69a9dbf05c].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +namespace eval ::system {}
            4  +namespace eval ::system::helper {}
            5  +
            6  +set ::system::_mount_flags(bind) BIND
            7  +set ::system::_mount_flags(move) MOVE
            8  +set ::system::_mount_flags(remount) REMOUNT
            9  +set ::system::_mount_flags(mandlock) MANDLOCK
           10  +set ::system::_mount_flags(dirsync) DIRSYNC
           11  +set ::system::_mount_flags(noatime) NOATIME
           12  +set ::system::_mount_flags(nodiratime) NODIRATIME
           13  +set ::system::_mount_flags(relatime) RELATIME
           14  +set ::system::_mount_flags(strictatime) STRICTATIME
           15  +set ::system::_mount_flags(nodev) NODEV
           16  +set ::system::_mount_flags(noexec) NOEXEC
           17  +set ::system::_mount_flags(nosuid) NOSUID
           18  +set ::system::_mount_flags(ro) RDONLY
           19  +set ::system::_mount_flags(silent) SILENT
           20  +set ::system::_mount_flags(synchronous) SYNCHRONOUS
           21  +set ::system::_mount_flags(sync) SYNCHRONOUS
           22  +
           23  +
           24  +# Determine where to mount a given device (usually by checking "/etc/fstab")
           25  +proc ::system::helper::find_mountpoint {device} {
           26  +	set data ""
           27  +	catch {
           28  +		set fd [open "/etc/fstab"]
           29  +		set data [read -nonewline $fd]
           30  +		close $fd
           31  +	}
           32  +
           33  +	foreach line [split $data "\n"] {
           34  +		set line [string trim [regsub {#.*$} $line ""]]
           35  +		set line [regsub -all {[ \t][ \t][ \t]*} $line " "]
           36  +
           37  +		set work [split $line]
           38  +
           39  +		set curr_device     [lindex $work 0]
           40  +		set curr_mountpoint [lindex $work 1]
           41  +		set curr_fstype     [lindex $work 2]
           42  +		set curr_opts       [split [lindex $work 3] ","]
           43  +		set curr_dumpfreq   [lindex $work 4]
           44  +		set curr_fsckpass   [lindex $work 5]
           45  +
           46  +
           47  +		if {$curr_device == $device || $curr_mountpoint == $device} {
           48  +			return [list source $curr_device target $curr_mountpoint fstype $curr_fstype options $curr_opts dumpfreq $curr_dumpfreq fsckpass $curr_fsckpass]
           49  +		}
           50  +	}
           51  +
           52  +	return -code error "no entry found in \"/etc/fstab\" for \"$device\""
           53  +}
           54  +
           55  +proc ::system::mount args {
           56  +	set options_list [list]
           57  +
           58  +	for {set idx 0} {$idx < [llength $args]} {incr idx} {
           59  +		set curr_arg [lindex $args $idx]
           60  +
           61  +		switch -glob -- $curr_arg {
           62  +			"-t" {
           63  +				incr idx
           64  +				set fstype [lindex $args $idx]
           65  +			}
           66  +			"-r" {
           67  +				lappend options_list "RDONLY"
           68  +			}
           69  +			"-w" {
           70  +				set idx [lsearch -exact $options_list "RDONLY"]
           71  +				if {$idx != -1} {
           72  +					set options_list [lreplace $options_list $idx $idx]
           73  +				}
           74  +			}
           75  +			"-o" {
           76  +				incr idx
           77  +				set options [lindex $args $idx]
           78  +			}
           79  +			"--" {
           80  +				incr idx
           81  +
           82  +				break
           83  +			}
           84  +			"-*" {
           85  +				return -code error "unknown option \"$curr_arg\""
           86  +			}
           87  +			default {
           88  +				break
           89  +			}
           90  +		}
           91  +	}
           92  +
           93  +	set args [lrange $args $idx end]
           94  +
           95  +	if {[llength $args] < 1 || [llength $args] > 2} {
           96  +		return -code error "wrong # args: should be \"::system::mount ?options? source ?target?\""
           97  +	}
           98  +
           99  +	set source [lindex $args 0]
          100  +
          101  +	if {[llength $args] == 2} {
          102  +		set target [lindex $args 1]
          103  +	} else {
          104  +		array set mountinfo [::system::helper::find_mountpoint $source]
          105  +		set source $mountinfo(source)
          106  +		set target $mountinfo(target)
          107  +
          108  +		if {![info exists fstype]} {
          109  +			set fstype $mountinfo(fstype)
          110  +		}
          111  +
          112  +		if {![info exists options]} {
          113  +			set options $mountinfo(options)
          114  +		}
          115  +	}
          116  +
          117  +	# Ensure all mount-related parameters have been computed
          118  +	if {![info exists fstype]} {
          119  +		set fstype "auto"
          120  +	}
          121  +
          122  +	if {![info exists options]} {
          123  +		set options [list]
          124  +	}
          125  +
          126  +	# Process options
          127  +	foreach option $options {
          128  +		set option_lc [string tolower $option]
          129  +
          130  +		# Special option handling
          131  +		switch -- $option_lc {
          132  +			"defaults" {
          133  +				set options_list [list]
          134  +				unset -nocomplain unknown_options
          135  +
          136  +				continue
          137  +			}
          138  +			"rw" {
          139  +				set option_lc "noro"
          140  +			}
          141  +			"norw" {
          142  +				set option_lc "ro"
          143  +			}
          144  +		}
          145  +
          146  +		# Example: noatime
          147  +		if {[info exists ::system::_mount_flags($option_lc)]} {
          148  +			lappend options_list $::system::_mount_flags($option_lc)
          149  +
          150  +			continue
          151  +		}
          152  +
          153  +		# Example: atime
          154  +		if {[info exists ::system::_mount_flags(no$option_lc)]} {
          155  +			set idx [lsearch -exact $options_list $::system::_mount_flags(no$option_lc)]
          156  +			if {$idx != -1} {
          157  +				set options_list [lreplace $options_list $idx $idx]
          158  +			}
          159  +
          160  +			continue
          161  +		}
          162  +
          163  +		# Example: norelatime
          164  +		if {[string match "no*" $option_lc]} {
          165  +			set neg_option_lc [string range $option_lc 2 end]
          166  +
          167  +			if {[info exists ::system::_mount_flags($neg_option_lc)]} {
          168  +				set idx [lsearch -exact $options_list $::system::_mount_flags($neg_option_lc)]
          169  +				if {$idx != -1} {
          170  +					set options_list [lreplace $options_list $idx $idx]
          171  +				}
          172  +
          173  +				continue
          174  +			}
          175  +		}
          176  +
          177  +		# Accumulate unknown options
          178  +		lappend unknown_options $option
          179  +	}
          180  +
          181  +	# Use "swapon" if this is swap
          182  +	if {$fstype == "swap"} {
          183  +		return [::system::syscall::swapon $source]
          184  +	}
          185  +
          186  +	# Otherwise, call "mount" system call
          187  +	## If we have accumulated any unknown options, pass them as a
          188  +	## comma-seperated value string
          189  +	if {[info exists unknown_options]} {
          190  +		set data [join $unknown_options ","]
          191  +
          192  +		return [::system::syscall::mount $source $target $fstype $options_list $data]
          193  +	}
          194  +
          195  +	return [::system::syscall::mount $source $target $fstype $options_list]
          196  +}
          197  +
          198  +proc ::system::umount {dir {flags ""}} {
          199  +	return [::system::syscall::umount $dir [string toupper $flags]]
          200  +}
          201  +
          202  +proc ::system::kill {pid sig} {
          203  +	return [::system::syscall::kill $pid [string toupper $sig]]
          204  +}
          205  +
          206  +proc ::system::killpg {pgroup sig} {
          207  +	if {$pgroup <= 1} {
          208  +		return -code error "invalid process group specified (must be greater than 1)"
          209  +	}
          210  +
          211  +	return [::system::syscall::kill -$pgroup [string toupper $sig]]
          212  +}
          213  +
          214  +proc ::system::ifconfig args {
          215  +	if {[llength $args] == 0} {
          216  +		# Return information on all interfaces
          217  +		set retlist [list]
          218  +		foreach interface [::system::syscall::ifconfig] {
          219  +			lappend retlist $interface [::system::syscall::ifconfig $interface]
          220  +		}
          221  +
          222  +		return $retlist
          223  +	}
          224  +
          225  +	set interface [lindex $args 0]
          226  +	set args [lrange $args 1 end]
          227  +
          228  +	array set ifaceinfo [::system::syscall::ifconfig $interface]
          229  +
          230  +	if {[llength $args] == 0} {
          231  +		return [array get ifaceinfo]
          232  +	}
          233  +
          234  +	for {set idx 0} {$idx < [llength $args]} {incr idx} {
          235  +		set opt [lindex $args $idx]
          236  +
          237  +		switch -- $opt {
          238  +			"up" {
          239  +				if {[info exists ifaceinfo(flags)]} {
          240  +					set flags $ifaceinfo(flags)
          241  +				} else {
          242  +					set flags ""
          243  +				}
          244  +
          245  +				foreach newflag [list UP RUNNING] {
          246  +					if {[lsearch -exact $flags $newflag] == -1} {
          247  +						lappend flags $newflag
          248  +					}
          249  +				}
          250  +
          251  +				::system::syscall::ifconfig $interface flags $flags
          252  +			}
          253  +
          254  +		}
          255  +	}
          256  +}

Added test.tcl version [8645af428b].

            1  +#! /usr/bin/env tclsh
            2  +
            3  +puts [exec ./build-dyn.sh]
            4  +
            5  +load ./system.so
            6  +
            7  +foreach iface [system::syscall::ifconfig] {
            8  +#lo0:2: flags=2001000849<UP,LOOPBACK,RUNNING,MULTICAST,IPv4,VIRTUAL> mtu 8232 index 1
            9  +#        inet 127.0.0.1 netmask ff000000 
           10  +#aggr100003:1: flags=201000843<UP,BROADCAST,RUNNING,MULTICAST,IPv4,CoS> mtu 1500 index 2
           11  +#        inet 140.194.100.149 netmask ffffff00 broadcast 140.194.100.255
           12  +
           13  +	unset -nocomplain ifaceinfo
           14  +	array set ifaceinfo [system::syscall::ifconfig $iface]
           15  +
           16  +	set secondline ""
           17  +	foreach {label entry} [list inet address netmask netmask broadcast broadcast] {
           18  +		if {![info exists ifaceinfo($entry)]} {
           19  +			continue
           20  +		}
           21  +
           22  +		append secondline " $label $ifaceinfo($entry)"
           23  +	}
           24  +
           25  +	puts "$iface: flags=<[join $ifaceinfo(flags) ,]> mtu $ifaceinfo(mtu) index $ifaceinfo(index)"
           26  +	puts "\t[string trim $secondline]"
           27  +	if {[info exists ifaceinfo(hwaddr)]} {
           28  +		puts "\tether $ifaceinfo(hwaddr)"
           29  +	}
           30  +}
           31  +
           32  +#system::syscall::route add 1.2.3.4 255.255.255.255
           33  +system::syscall::ifconfig dummy0 address 1.2.3.4 netmask 255.255.255.0 flags [list UP RUNNING BROADCAST MULTICAST]