Check-in [d121970301]
Overview
Comment:Basic functionality to the point where Tcl_Channel types need to be implemented
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: d1219703011f2e2bc222e8713ef84b1326b26fe864b7c1ffd4534305e4247a0d
User & Date: rkeene on 2019-05-02 23:06:10
Other Links: manifest | tags
Context
2019-05-02
23:11
Added start of split into standalone/client/flexible modes check-in: acfc5037c6 user: rkeene tags: trunk
23:06
Basic functionality to the point where Tcl_Channel types need to be implemented check-in: d121970301 user: rkeene tags: trunk
21:08
Minimal support to be loaded and not crash the process check-in: e5b6962adf user: rkeene tags: trunk
Changes

Modified Makefile from [8907b35042] to [ff706ebdb4].

15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
xvfs-core.o: xvfs-core.c xvfs-core.h Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) -o xvfs-core.o -c xvfs-core.c

example.so: example.o xvfs-core.o Makefile
	$(CC) $(CFLAGS) $(LDFLAGS) -shared -o example.so example.o xvfs-core.o $(LIBS)

test: example.so
	echo 'if {[catch { load ./example.so Xvfs_example; source //xvfs:/main.tcl }]} { puts stderr $$::errorInfo; exit 1 }; exit 0' | tclsh

clean:
	rm -f example.so example.o example.c


distclean: clean

.PHONY: all clean distclean test







|



>




15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
xvfs-core.o: xvfs-core.c xvfs-core.h Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) -o xvfs-core.o -c xvfs-core.c

example.so: example.o xvfs-core.o Makefile
	$(CC) $(CFLAGS) $(LDFLAGS) -shared -o example.so example.o xvfs-core.o $(LIBS)

test: example.so
	echo 'if {[catch { load ./example.so Xvfs_example; source //xvfs:/example/main.tcl }]} { puts stderr $$::errorInfo; exit 1 }; exit 0' | tclsh

clean:
	rm -f example.so example.o example.c
	rm -f xvfs-core.o

distclean: clean

.PHONY: all clean distclean test

Modified xvfs-core.c from [b7bfd15588] to [449d9d44b1].

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83




84
85
86
87
88
89
90
91
#include <xvfs-core.h>

#include <tcl.h>


static int xvfs_tclvfs_standalone_pathInFilesystem(Tcl_Obj *path, ClientData *dataPtr) {

























	return(TCL_ERROR);
}





static int xvfs_tclvfs_normalizePath(Tcl_Interp *interp, Tcl_Obj *path, int nextCheckpoint) {














	return(TCL_ERROR);
}












static Tcl_Obj *xvfs_tclvfs_listVolumes() {
	return(NULL);




























}

/*
 * There are three (3) modes of operation for Xvfs_Register:
 *    1. standalone -- We register our own Tcl_Filesystem
 *                     and handle requests under `//xvfs:/<fsName>`
 *    2. client -- A single Tcl_Filesystem is registered for the
 *                 interp to handle requests under `//xvfs:/` which
 *                 then dispatches to the appropriate registered
 *                 handler
 *    3. flexible -- Attempts to find a core Xvfs instance for the
 *                   process at runtime, if found do #2, otherwise
 *                   fallback to #1
 *
 */
static int xvfs_standalone_register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo) {
	Tcl_Filesystem *xvfsInfo;
	int tcl_ret;

	








	/*
	 * In standalone mode, we only support the same protocol we are
	 * compiling for.
	 */
	if (fsInfo->protocolVersion != XVFS_PROTOCOL_VERSION) {
		if (interp) {
			Tcl_SetResult(interp, "Protocol mismatch", NULL);
		}
		return(TCL_ERROR);
	}
	
	xvfsInfo = (Tcl_Filesystem *) Tcl_AttemptAlloc(sizeof(*xvfsInfo));
	if (!xvfsInfo) {
		if (interp) {
			Tcl_SetResult(interp, "Unable to allocate Tcl_Filesystem object", NULL);
		}
		return(TCL_ERROR);
	}
	
	xvfsInfo->typeName                   = "xvfs";
	xvfsInfo->structureLength            = sizeof(*xvfsInfo);
	xvfsInfo->version                    = TCL_FILESYSTEM_VERSION_1;
	xvfsInfo->pathInFilesystemProc       = xvfs_tclvfs_standalone_pathInFilesystem;
	xvfsInfo->dupInternalRepProc         = NULL;
	xvfsInfo->freeInternalRepProc        = NULL;
	xvfsInfo->internalToNormalizedProc   = NULL;
	xvfsInfo->createInternalRepProc      = NULL;
	xvfsInfo->normalizePathProc          = xvfs_tclvfs_normalizePath;
	xvfsInfo->filesystemPathTypeProc     = NULL;
	xvfsInfo->filesystemSeparatorProc    = NULL;
	xvfsInfo->statProc                   = NULL;
	xvfsInfo->accessProc                 = NULL;
	xvfsInfo->openFileChannelProc        = NULL;
	xvfsInfo->matchInDirectoryProc       = NULL;
	xvfsInfo->utimeProc                  = NULL;
	xvfsInfo->linkProc                   = NULL;
	xvfsInfo->listVolumesProc            = xvfs_tclvfs_listVolumes;
	xvfsInfo->fileAttrStringsProc        = NULL;
	xvfsInfo->fileAttrsGetProc           = NULL;
	xvfsInfo->fileAttrsSetProc           = NULL;
	xvfsInfo->createDirectoryProc        = NULL;
	xvfsInfo->removeDirectoryProc        = NULL;
	xvfsInfo->deleteFileProc             = NULL;
	xvfsInfo->copyFileProc               = NULL;
	xvfsInfo->renameFileProc             = NULL;
	xvfsInfo->copyDirectoryProc          = NULL;
	xvfsInfo->lstatProc                  = NULL;
	xvfsInfo->loadFileProc               = NULL;
	xvfsInfo->getCwdProc                 = NULL;
	xvfsInfo->chdirProc                  = NULL;





	tcl_ret = Tcl_FSRegister(NULL, xvfsInfo);
	if (tcl_ret != TCL_OK) {
		if (interp) {
			Tcl_SetResult(interp, "Tcl_FSRegister() failed", NULL);
		}
		
		return(tcl_ret);
	}

>


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

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


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

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
















|

>

>
>
>
>
>
>
>
>











|
|






|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

>
>
>
>
|







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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
#include <xvfs-core.h>
#include <string.h>
#include <tcl.h>

#define XVFS_ROOT_MOUNTPOINT "//xvfs:/"

struct xvfs_tclfs_instance_info {
	struct Xvfs_FSInfo *fsInfo;
	Tcl_Obj            *mountpoint;
};
static struct xvfs_tclfs_instance_info xvfs_tclfs_standalone_info;

/*
 * Internal Core Utilities
 */
static const char *xvfs_relativePath(Tcl_Obj *path, struct xvfs_tclfs_instance_info *info) {
	const char *pathStr, *rootStr;
	int pathLen, rootLen;
	
	pathStr = Tcl_GetStringFromObj(path, &pathLen);
	rootStr = Tcl_GetStringFromObj(info->mountpoint, &rootLen);
	
	if (pathLen < rootLen) {
		return(NULL);
	}
	
	if (memcmp(pathStr, rootStr, rootLen) != 0) {
		return(NULL);
	}
	
	if (pathLen == rootLen) {
		return("");
	}

	/* XXX:TODO: Should this use the native OS path separator ? */
	if (pathStr[rootLen] != '/') {
		return(NULL);
	}
	
	return(pathStr + rootLen + 1);
}

/*
 * Internal Tcl_Filesystem functions, with the appropriate instance info
 */
static int xvfs_tclfs_pathInFilesystem(Tcl_Obj *path, ClientData *dataPtr, struct xvfs_tclfs_instance_info *instanceInfo) {
	const char *relativePath;
	
	relativePath = xvfs_relativePath(path, instanceInfo);
	if (!relativePath) {
		return(-1);
	}
	
	return(TCL_OK);
}

static int xvfs_tclfs_stat(Tcl_Obj *path, Tcl_StatBuf *statBuf, struct xvfs_tclfs_instance_info *instanceInfo) {
	const char *pathStr;
	int retval;

	pathStr = xvfs_relativePath(path, instanceInfo);
	
	retval = instanceInfo->fsInfo->getInfoProc(pathStr, statBuf);
	
	return(retval);
}

static Tcl_Obj *xvfs_tclfs_listVolumes(struct xvfs_tclfs_instance_info *instanceInfo) {
	return(NULL);
}

static Tcl_Channel xvfs_tclfs_openFileChannel(Tcl_Interp *interp, Tcl_Obj *path, int mode, int permissions, struct xvfs_tclfs_instance_info *instanceInfo) {
	const char *pathStr;

	pathStr = xvfs_relativePath(path, instanceInfo);
fprintf(stderr, "Called open(%s)!\n", pathStr);
	
	return(NULL);
}

/*
 * Tcl_Filesystem handlers for the standalone implementation
 */
static int xvfs_tclfs_standalone_pathInFilesystem(Tcl_Obj *path, ClientData *dataPtr) {
	return(xvfs_tclfs_pathInFilesystem(path, dataPtr, &xvfs_tclfs_standalone_info));
}

static int xvfs_tclfs_standalone_stat(Tcl_Obj *path, Tcl_StatBuf *statBuf) {
	return(xvfs_tclfs_stat(path, statBuf, &xvfs_tclfs_standalone_info));
}

static Tcl_Obj *xvfs_tclfs_standalone_listVolumes(void) {
	return(xvfs_tclfs_listVolumes(&xvfs_tclfs_standalone_info));
}

static Tcl_Channel xvfs_tclfs_standalone_openFileChannel(Tcl_Interp *interp, Tcl_Obj *path, int mode, int permissions) {
	return(xvfs_tclfs_openFileChannel(interp, path, mode, permissions, &xvfs_tclfs_standalone_info));
}

/*
 * There are three (3) modes of operation for Xvfs_Register:
 *    1. standalone -- We register our own Tcl_Filesystem
 *                     and handle requests under `//xvfs:/<fsName>`
 *    2. client -- A single Tcl_Filesystem is registered for the
 *                 interp to handle requests under `//xvfs:/` which
 *                 then dispatches to the appropriate registered
 *                 handler
 *    3. flexible -- Attempts to find a core Xvfs instance for the
 *                   process at runtime, if found do #2, otherwise
 *                   fallback to #1
 *
 */
static int xvfs_standalone_register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo) {
	Tcl_Filesystem *xvfs_tclfs_Info;
	int tcl_ret;
	static int registered = 0;
	
	/*
	 * Ensure this instance is not already registered
	 */
	if (registered) {
		return(TCL_OK);
	}
	registered = 1;

	/*
	 * In standalone mode, we only support the same protocol we are
	 * compiling for.
	 */
	if (fsInfo->protocolVersion != XVFS_PROTOCOL_VERSION) {
		if (interp) {
			Tcl_SetResult(interp, "Protocol mismatch", NULL);
		}
		return(TCL_ERROR);
	}
	
	xvfs_tclfs_Info = (Tcl_Filesystem *) Tcl_AttemptAlloc(sizeof(*xvfs_tclfs_Info));
	if (!xvfs_tclfs_Info) {
		if (interp) {
			Tcl_SetResult(interp, "Unable to allocate Tcl_Filesystem object", NULL);
		}
		return(TCL_ERROR);
	}
	
	xvfs_tclfs_Info->typeName                   = strdup("xvfs");
	xvfs_tclfs_Info->structureLength            = sizeof(*xvfs_tclfs_Info);
	xvfs_tclfs_Info->version                    = TCL_FILESYSTEM_VERSION_1;
	xvfs_tclfs_Info->pathInFilesystemProc       = xvfs_tclfs_standalone_pathInFilesystem;
	xvfs_tclfs_Info->dupInternalRepProc         = NULL;
	xvfs_tclfs_Info->freeInternalRepProc        = NULL;
	xvfs_tclfs_Info->internalToNormalizedProc   = NULL;
	xvfs_tclfs_Info->createInternalRepProc      = NULL;
	xvfs_tclfs_Info->normalizePathProc          = NULL;
	xvfs_tclfs_Info->filesystemPathTypeProc     = NULL;
	xvfs_tclfs_Info->filesystemSeparatorProc    = NULL;
	xvfs_tclfs_Info->statProc                   = xvfs_tclfs_standalone_stat;
	xvfs_tclfs_Info->accessProc                 = NULL;
	xvfs_tclfs_Info->openFileChannelProc        = xvfs_tclfs_standalone_openFileChannel;
	xvfs_tclfs_Info->matchInDirectoryProc       = NULL;
	xvfs_tclfs_Info->utimeProc                  = NULL;
	xvfs_tclfs_Info->linkProc                   = NULL;
	xvfs_tclfs_Info->listVolumesProc            = xvfs_tclfs_standalone_listVolumes;
	xvfs_tclfs_Info->fileAttrStringsProc        = NULL;
	xvfs_tclfs_Info->fileAttrsGetProc           = NULL;
	xvfs_tclfs_Info->fileAttrsSetProc           = NULL;
	xvfs_tclfs_Info->createDirectoryProc        = NULL;
	xvfs_tclfs_Info->removeDirectoryProc        = NULL;
	xvfs_tclfs_Info->deleteFileProc             = NULL;
	xvfs_tclfs_Info->copyFileProc               = NULL;
	xvfs_tclfs_Info->renameFileProc             = NULL;
	xvfs_tclfs_Info->copyDirectoryProc          = NULL;
	xvfs_tclfs_Info->lstatProc                  = NULL;
	xvfs_tclfs_Info->loadFileProc               = NULL;
	xvfs_tclfs_Info->getCwdProc                 = NULL;
	xvfs_tclfs_Info->chdirProc                  = NULL;

	xvfs_tclfs_standalone_info.fsInfo = fsInfo;
	xvfs_tclfs_standalone_info.mountpoint = Tcl_NewObj();
	Tcl_AppendStringsToObj(xvfs_tclfs_standalone_info.mountpoint, XVFS_ROOT_MOUNTPOINT, fsInfo->name, NULL);
	
	tcl_ret = Tcl_FSRegister(NULL, xvfs_tclfs_Info);
	if (tcl_ret != TCL_OK) {
		if (interp) {
			Tcl_SetResult(interp, "Tcl_FSRegister() failed", NULL);
		}
		
		return(tcl_ret);
	}

Modified xvfs-core.h from [ac3847ed22] to [9145593486].

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15

16
17
18
19
20
#ifndef XVFS_COMMON_H_1B4B28D60EBAA11D5FF85642FA7CA22C29E8E817
#define XVFS_COMMON_H_1B4B28D60EBAA11D5FF85642FA7CA22C29E8E817 1

#include <tcl.h>

#define XVFS_PROTOCOL_VERSION 1

typedef const char **(*xvfs_proc_getChildren_t)(const char *path, Tcl_WideInt *count);
typedef const unsigned char *(*xvfs_proc_getData_t)(const char *path, Tcl_WideInt start, Tcl_WideInt *length);


struct Xvfs_FSInfo {
	int                      protocolVersion;
	const char               *fsName;
	xvfs_proc_getChildren_t  getChildrenProc;
	xvfs_proc_getData_t      getDataProc;

};

int Xvfs_Register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo);

#endif









>



|


>





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
#ifndef XVFS_COMMON_H_1B4B28D60EBAA11D5FF85642FA7CA22C29E8E817
#define XVFS_COMMON_H_1B4B28D60EBAA11D5FF85642FA7CA22C29E8E817 1

#include <tcl.h>

#define XVFS_PROTOCOL_VERSION 1

typedef const char **(*xvfs_proc_getChildren_t)(const char *path, Tcl_WideInt *count);
typedef const unsigned char *(*xvfs_proc_getData_t)(const char *path, Tcl_WideInt start, Tcl_WideInt *length);
typedef int (*xvfs_proc_getInfo_t)(const char *path, Tcl_StatBuf *statBuf);

struct Xvfs_FSInfo {
	int                      protocolVersion;
	const char               *name;
	xvfs_proc_getChildren_t  getChildrenProc;
	xvfs_proc_getData_t      getDataProc;
	xvfs_proc_getInfo_t      getInfoProc;
};

int Xvfs_Register(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo);

#endif

Modified xvfs.c.rvt from [6b271a3398] to [eb4591d1ce].

1
2
3
4

5
6
7
8
9
10
11
#include <xvfs-core.h>
#include <unistd.h>
#include <string.h>
#include <tcl.h>


#define XVFS_NAME_LOOKUP_ERROR (-1)
#define MIN(a, b) (((a) < (b)) ? (a) : (b))

typedef enum {
	XVFS_FILE_TYPE_REG,
	XVFS_FILE_TYPE_DIR




>







1
2
3
4
5
6
7
8
9
10
11
12
#include <xvfs-core.h>
#include <unistd.h>
#include <string.h>
#include <tcl.h>
#include <sys/stat.h>

#define XVFS_NAME_LOOKUP_ERROR (-1)
#define MIN(a, b) (((a) < (b)) ? (a) : (b))

typedef enum {
	XVFS_FILE_TYPE_REG,
	XVFS_FILE_TYPE_DIR
127
128
129
130
131
132
133
134



















135



























136
137
138
139
140

141


142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
	*length = resultLength;
	
	/*
	 * Return the data
	 */
	return(fileInfo->data.fileContents + start);
}




















int Xvfs_<?= $::xvfs::fsName ?>_Init(Tcl_Interp *interp) {



























	struct Xvfs_FSInfo fsInfo = {
		.protocolVersion = XVFS_PROTOCOL_VERSION,
		.fsName          = "<?= $::xvfs::fsName ?>",
		.getChildrenProc = xvfs_<?= $::xvfs::fsName ?>_getChildren,
		.getDataProc     = xvfs_<?= $::xvfs::fsName ?>_getData

	};


	int register_ret;

#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
	
	register_ret = Xvfs_Register(interp, &fsInfo);
	if (register_ret != TCL_OK) {
		return(register_ret);
	}
	
	return(TCL_OK);
}








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











|






128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
	*length = resultLength;
	
	/*
	 * Return the data
	 */
	return(fileInfo->data.fileContents + start);
}

static int xvfs_<?= $::xvfs::fsName ?>_getInfo(const char *path, Tcl_StatBuf *statBuf) {
	struct xvfs_file_data *fileInfo;
	long inode;

	/*
	 * Validate input parameters
	 */
	if (!statBuf) {
		return(-1);
	}
	
	/*
	 * Get the inode from the lookup function
	 */
	inode = xvfs_<?= $::xvfs::fsName ?>_nameToIndex(path);
	if (inode == XVFS_NAME_LOOKUP_ERROR) {
		return(-1);
	}
	
	fileInfo = &xvfs_<?= $::xvfs::fsName ?>_data[inode];
	
	statBuf->st_dev   = 0;
	statBuf->st_rdev  = 0;
	statBuf->st_ino   = inode;
	statBuf->st_uid   = -1;
	statBuf->st_gid   = -1;
	statBuf->st_atime = 0;
	statBuf->st_ctime = 0;
	statBuf->st_mtime = 0;
	statBuf->st_blksize = 1024;
	
	if (fileInfo->type == XVFS_FILE_TYPE_REG) {
		statBuf->st_mode   = 0400;
		statBuf->st_nlink  = 1;
		statBuf->st_size   = fileInfo->size;
		statBuf->st_blocks = (fileInfo->size + statBuf->st_blksize - 1) / statBuf->st_blksize;
	} else if (fileInfo->type == XVFS_FILE_TYPE_DIR) {
		statBuf->st_mode   = 0500;
		statBuf->st_nlink  = fileInfo->size;
		statBuf->st_size   = fileInfo->size;
		statBuf->st_blocks = 1;
	}
	
	return(0);
}


static struct Xvfs_FSInfo xvfs_<?= $::xvfs::fsName ?>_fsInfo = {
	.protocolVersion = XVFS_PROTOCOL_VERSION,
	.name            = "<?= $::xvfs::fsName ?>",
	.getChildrenProc = xvfs_<?= $::xvfs::fsName ?>_getChildren,
	.getDataProc     = xvfs_<?= $::xvfs::fsName ?>_getData,
	.getInfoProc     = xvfs_<?= $::xvfs::fsName ?>_getInfo
};

int Xvfs_<?= $::xvfs::fsName ?>_Init(Tcl_Interp *interp) {
	int register_ret;

#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
	
	register_ret = Xvfs_Register(interp, &xvfs_<?= $::xvfs::fsName ?>_fsInfo);
	if (register_ret != TCL_OK) {
		return(register_ret);
	}
	
	return(TCL_OK);
}