Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclIOUtil.c@260cb5ec6c19 (annotated)

sl@0	1	/*
sl@0	2	* tclIOUtil.c --
sl@0	3	*
sl@0	4	* This file contains the implementation of Tcl's generic
sl@0	5	* filesystem code, which supports a pluggable filesystem
sl@0	6	* architecture allowing both platform specific filesystems and
sl@0	7	* 'virtual filesystems'. All filesystem access should go through
sl@0	8	* the functions defined in this file. Most of this code was
sl@0	9	* contributed by Vince Darley.
sl@0	10	*
sl@0	11	* Parts of this file are based on code contributed by Karl
sl@0	12	* Lehenbauer, Mark Diekhans and Peter da Silva.
sl@0	13	*
sl@0	14	* Copyright (c) 1991-1994 The Regents of the University of California.
sl@0	15	* Copyright (c) 1994-1997 Sun Microsystems, Inc.
sl@0	16	* Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
sl@0	17	*
sl@0	18	* See the file "license.terms" for information on usage and redistribution
sl@0	19	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	20	*
sl@0	21	* RCS: @(#) $Id: tclIOUtil.c,v 1.77.2.34 2007/02/19 23:49:05 hobbs Exp $
sl@0	22	*/
sl@0	23
sl@0	24	#include "tclInt.h"
sl@0	25	#include "tclPort.h"
sl@0	26	#ifdef MAC_TCL
sl@0	27	#include "tclMacInt.h"
sl@0	28	#endif
sl@0	29	#ifdef __WIN32__
sl@0	30	/* for tclWinProcs->useWide */
sl@0	31	#include "tclWinInt.h"
sl@0	32	#endif
sl@0	33	#if defined(__SYMBIAN32__) && defined(__WINSCW__)
sl@0	34	#include "tclSymbianGlobals.h"
sl@0	35	#define dataKey getdataKey(4)
sl@0	36	#endif
sl@0	37
sl@0	38	/*
sl@0	39	* struct FilesystemRecord --
sl@0	40	*
sl@0	41	* A filesystem record is used to keep track of each
sl@0	42	* filesystem currently registered with the core,
sl@0	43	* in a linked list. Pointers to these structures
sl@0	44	* are also kept by each "path" Tcl_Obj, and we must
sl@0	45	* retain a refCount on the number of such references.
sl@0	46	*/
sl@0	47	typedef struct FilesystemRecord {
sl@0	48	ClientData clientData; /* Client specific data for the new
sl@0	49	* filesystem (can be NULL) */
sl@0	50	Tcl_Filesystem fsPtr; / Pointer to filesystem dispatch
sl@0	51	* table. */
sl@0	52	int fileRefCount; /* How many Tcl_Obj's use this
sl@0	53	* filesystem. */
sl@0	54	struct FilesystemRecord *nextPtr;
sl@0	55	/* The next filesystem registered
sl@0	56	* to Tcl, or NULL if no more. */
sl@0	57	struct FilesystemRecord *prevPtr;
sl@0	58	/* The previous filesystem registered
sl@0	59	* to Tcl, or NULL if no more. */
sl@0	60	} FilesystemRecord;
sl@0	61
sl@0	62	/*
sl@0	63	* The internal TclFS API provides routines for handling and
sl@0	64	* manipulating paths efficiently, taking direct advantage of
sl@0	65	* the "path" Tcl_Obj type.
sl@0	66	*
sl@0	67	* These functions are not exported at all at present.
sl@0	68	*/
sl@0	69
sl@0	70	int TclFSCwdPointerEquals _ANSI_ARGS_((Tcl_Obj* objPtr));
sl@0	71	int TclFSMakePathFromNormalized _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	72	Tcl_Obj *objPtr, ClientData clientData));
sl@0	73	int TclFSNormalizeToUniquePath _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	74	Tcl_Obj pathPtr, int startAt, ClientData clientDataPtr));
sl@0	75	Tcl_Obj* TclFSMakePathRelative _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	76	Tcl_Obj objPtr, Tcl_Obj cwdPtr));
sl@0	77	Tcl_Obj* TclFSInternalToNormalized _ANSI_ARGS_((
sl@0	78	Tcl_Filesystem *fromFilesystem, ClientData clientData,
sl@0	79	FilesystemRecord **fsRecPtrPtr));
sl@0	80	int TclFSEnsureEpochOk _ANSI_ARGS_((Tcl_Obj* pathObjPtr,
sl@0	81	Tcl_Filesystem **fsPtrPtr));
sl@0	82	void TclFSSetPathDetails _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
sl@0	83	FilesystemRecord *fsRecPtr, ClientData clientData));
sl@0	84
sl@0	85	/*
sl@0	86	* Private variables for use in this file
sl@0	87	*/
sl@0	88	extern Tcl_Filesystem tclNativeFilesystem;
sl@0	89	extern int theFilesystemEpoch;
sl@0	90
sl@0	91	/*
sl@0	92	* Private functions for use in this file
sl@0	93	*/
sl@0	94	static Tcl_PathType FSGetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
sl@0	95	Tcl_Filesystem **filesystemPtrPtr,
sl@0	96	int *driveNameLengthPtr));
sl@0	97	static Tcl_PathType GetPathType _ANSI_ARGS_((Tcl_Obj *pathObjPtr,
sl@0	98	Tcl_Filesystem **filesystemPtrPtr,
sl@0	99	int driveNameLengthPtr, Tcl_Obj *driveNameRef));
sl@0	100	static Tcl_FSPathInFilesystemProc NativePathInFilesystem;
sl@0	101	static Tcl_Obj* TclFSNormalizeAbsolutePath
sl@0	102	_ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr,
sl@0	103	ClientData *clientDataPtr));
sl@0	104	/*
sl@0	105	* Prototypes for procedures defined later in this file.
sl@0	106	*/
sl@0	107
sl@0	108	static FilesystemRecord* FsGetFirstFilesystem(void);
sl@0	109	static void FsThrExitProc(ClientData cd);
sl@0	110	static Tcl_Obj* FsListMounts _ANSI_ARGS_((Tcl_Obj *pathPtr,
sl@0	111	CONST char *pattern));
sl@0	112	static Tcl_Obj* FsAddMountsToGlobResult _ANSI_ARGS_((Tcl_Obj *result,
sl@0	113	Tcl_Obj pathPtr, CONST char pattern, Tcl_GlobTypeData *types));
sl@0	114
sl@0	115	#ifdef TCL_THREADS
sl@0	116	static void FsRecacheFilesystemList(void);
sl@0	117	#endif
sl@0	118
sl@0	119	/*
sl@0	120	* These form part of the native filesystem support. They are needed
sl@0	121	* here because we have a few native filesystem functions (which are
sl@0	122	* the same for mac/win/unix) in this file. There is no need to place
sl@0	123	* them in tclInt.h, because they are not (and should not be) used
sl@0	124	* anywhere else.
sl@0	125	*/
sl@0	126	extern CONST char * tclpFileAttrStrings[];
sl@0	127	extern CONST TclFileAttrProcs tclpFileAttrProcs[];
sl@0	128
sl@0	129	/*
sl@0	130	* The following functions are obsolete string based APIs, and should
sl@0	131	* be removed in a future release (Tcl 9 would be a good time).
sl@0	132	*/
sl@0	133
sl@0	134	/* Obsolete */
sl@0	135	EXPORT_C int
sl@0	136	Tcl_Stat(path, oldStyleBuf)
sl@0	137	CONST char path; / Path of file to stat (in current CP). */
sl@0	138	struct stat oldStyleBuf; / Filled with results of stat call. */
sl@0	139	{
sl@0	140	int ret;
sl@0	141	Tcl_StatBuf buf;
sl@0	142	Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
sl@0	143
sl@0	144	Tcl_IncrRefCount(pathPtr);
sl@0	145	ret = Tcl_FSStat(pathPtr, &buf);
sl@0	146	Tcl_DecrRefCount(pathPtr);
sl@0	147	if (ret != -1) {
sl@0	148	#ifndef TCL_WIDE_INT_IS_LONG
sl@0	149	# define OUT_OF_RANGE(x) \
sl@0	150	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) \|\| \
sl@0	151	((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
sl@0	152	#if defined(__GNUC__) && __GNUC__ >= 2
sl@0	153	/*
sl@0	154	* Workaround gcc warning of "comparison is always false due to limited range of
sl@0	155	* data type" in this macro by checking max type size, and when necessary ANDing
sl@0	156	* with the complement of ULONG_MAX instead of the comparison:
sl@0	157	*/
sl@0	158	# define OUT_OF_URANGE(x) \
sl@0	159	((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \
sl@0	160	(((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))
sl@0	161	#else
sl@0	162	# define OUT_OF_URANGE(x) \
sl@0	163	(((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
sl@0	164	#endif
sl@0	165
sl@0	166	/*
sl@0	167	* Perform the result-buffer overflow check manually.
sl@0	168	*
sl@0	169	* Note that ino_t/ino64_t is unsigned...
sl@0	170	*/
sl@0	171
sl@0	172	if (OUT_OF_URANGE(buf.st_ino) \|\| OUT_OF_RANGE(buf.st_size)
sl@0	173	#ifdef HAVE_ST_BLOCKS
sl@0	174	\|\| OUT_OF_RANGE(buf.st_blocks)
sl@0	175	#endif
sl@0	176	) {
sl@0	177	#ifdef EFBIG
sl@0	178	errno = EFBIG;
sl@0	179	#else
sl@0	180	# ifdef EOVERFLOW
sl@0	181	errno = EOVERFLOW;
sl@0	182	# else
sl@0	183	# error "What status should be returned for file size out of range?"
sl@0	184	# endif
sl@0	185	#endif
sl@0	186	return -1;
sl@0	187	}
sl@0	188
sl@0	189	# undef OUT_OF_RANGE
sl@0	190	# undef OUT_OF_URANGE
sl@0	191	#endif /* !TCL_WIDE_INT_IS_LONG */
sl@0	192
sl@0	193	/*
sl@0	194	* Copy across all supported fields, with possible type
sl@0	195	* coercions on those fields that change between the normal
sl@0	196	* and lf64 versions of the stat structure (on Solaris at
sl@0	197	* least.) This is slow when the structure sizes coincide,
sl@0	198	* but that's what you get for using an obsolete interface.
sl@0	199	*/
sl@0	200
sl@0	201	oldStyleBuf->st_mode = buf.st_mode;
sl@0	202	oldStyleBuf->st_ino = (ino_t) buf.st_ino;
sl@0	203	oldStyleBuf->st_dev = buf.st_dev;
sl@0	204	oldStyleBuf->st_rdev = buf.st_rdev;
sl@0	205	oldStyleBuf->st_nlink = buf.st_nlink;
sl@0	206	oldStyleBuf->st_uid = buf.st_uid;
sl@0	207	oldStyleBuf->st_gid = buf.st_gid;
sl@0	208	oldStyleBuf->st_size = (off_t) buf.st_size;
sl@0	209	oldStyleBuf->st_atime = buf.st_atime;
sl@0	210	oldStyleBuf->st_mtime = buf.st_mtime;
sl@0	211	oldStyleBuf->st_ctime = buf.st_ctime;
sl@0	212	#ifdef HAVE_ST_BLOCKS
sl@0	213	oldStyleBuf->st_blksize = buf.st_blksize;
sl@0	214	oldStyleBuf->st_blocks = (blkcnt_t) buf.st_blocks;
sl@0	215	#endif
sl@0	216	}
sl@0	217	return ret;
sl@0	218	}
sl@0	219
sl@0	220	/* Obsolete */
sl@0	221	EXPORT_C int
sl@0	222	Tcl_Access(path, mode)
sl@0	223	CONST char path; / Path of file to access (in current CP). */
sl@0	224	int mode; /* Permission setting. */
sl@0	225	{
sl@0	226	int ret;
sl@0	227	Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
sl@0	228	Tcl_IncrRefCount(pathPtr);
sl@0	229	ret = Tcl_FSAccess(pathPtr,mode);
sl@0	230	Tcl_DecrRefCount(pathPtr);
sl@0	231	return ret;
sl@0	232	}
sl@0	233
sl@0	234	/* Obsolete */
sl@0	235	EXPORT_C Tcl_Channel
sl@0	236	Tcl_OpenFileChannel(interp, path, modeString, permissions)
sl@0	237	Tcl_Interp interp; / Interpreter for error reporting;
sl@0	238	* can be NULL. */
sl@0	239	CONST char path; / Name of file to open. */
sl@0	240	CONST char modeString; / A list of POSIX open modes or
sl@0	241	* a string such as "rw". */
sl@0	242	int permissions; /* If the open involves creating a
sl@0	243	* file, with what modes to create
sl@0	244	* it? */
sl@0	245	{
sl@0	246	Tcl_Channel ret;
sl@0	247	Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
sl@0	248	Tcl_IncrRefCount(pathPtr);
sl@0	249	ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
sl@0	250	Tcl_DecrRefCount(pathPtr);
sl@0	251	return ret;
sl@0	252
sl@0	253	}
sl@0	254
sl@0	255	/* Obsolete */
sl@0	256	EXPORT_C int
sl@0	257	Tcl_Chdir(dirName)
sl@0	258	CONST char *dirName;
sl@0	259	{
sl@0	260	int ret;
sl@0	261	Tcl_Obj *pathPtr = Tcl_NewStringObj(dirName,-1);
sl@0	262	Tcl_IncrRefCount(pathPtr);
sl@0	263	ret = Tcl_FSChdir(pathPtr);
sl@0	264	Tcl_DecrRefCount(pathPtr);
sl@0	265	return ret;
sl@0	266	}
sl@0	267
sl@0	268	/* Obsolete */
sl@0	269	EXPORT_C char *
sl@0	270	Tcl_GetCwd(interp, cwdPtr)
sl@0	271	Tcl_Interp *interp;
sl@0	272	Tcl_DString *cwdPtr;
sl@0	273	{
sl@0	274	Tcl_Obj *cwd;
sl@0	275	cwd = Tcl_FSGetCwd(interp);
sl@0	276	if (cwd == NULL) {
sl@0	277	return NULL;
sl@0	278	} else {
sl@0	279	Tcl_DStringInit(cwdPtr);
sl@0	280	Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
sl@0	281	Tcl_DecrRefCount(cwd);
sl@0	282	return Tcl_DStringValue(cwdPtr);
sl@0	283	}
sl@0	284	}
sl@0	285
sl@0	286	/* Obsolete */
sl@0	287	EXPORT_C int
sl@0	288	Tcl_EvalFile(interp, fileName)
sl@0	289	Tcl_Interp interp; / Interpreter in which to process file. */
sl@0	290	CONST char fileName; / Name of file to process. Tilde-substitution
sl@0	291	* will be performed on this name. */
sl@0	292	{
sl@0	293	int ret;
sl@0	294	Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);
sl@0	295	Tcl_IncrRefCount(pathPtr);
sl@0	296	ret = Tcl_FSEvalFile(interp, pathPtr);
sl@0	297	Tcl_DecrRefCount(pathPtr);
sl@0	298	return ret;
sl@0	299	}
sl@0	300
sl@0	301
sl@0	302	/*
sl@0	303	* The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
sl@0	304	* complete, general hooked filesystem APIs should be used instead.
sl@0	305	* This define decides whether to include the obsolete hooks and
sl@0	306	* related code. If these are removed, we'll also want to remove them
sl@0	307	* from stubs/tclInt. The only known users of these APIs are prowrap
sl@0	308	* and mktclapp. New code/extensions should not use them, since they
sl@0	309	* do not provide as full support as the full filesystem API.
sl@0	310	*
sl@0	311	* As soon as prowrap and mktclapp are updated to use the full
sl@0	312	* filesystem support, I suggest all these hooks are removed.
sl@0	313	*/
sl@0	314	#define USE_OBSOLETE_FS_HOOKS
sl@0	315
sl@0	316
sl@0	317	#ifdef USE_OBSOLETE_FS_HOOKS
sl@0	318	/*
sl@0	319	* The following typedef declarations allow for hooking into the chain
sl@0	320	* of functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
sl@0	321	* 'Tcl_OpenFileChannel(...)'. Basically for each hookable function
sl@0	322	* a linked list is defined.
sl@0	323	*/
sl@0	324
sl@0	325	typedef struct StatProc {
sl@0	326	TclStatProc_ proc; / Function to process a 'stat()' call */
sl@0	327	struct StatProc nextPtr; / The next 'stat()' function to call */
sl@0	328	} StatProc;
sl@0	329
sl@0	330	typedef struct AccessProc {
sl@0	331	TclAccessProc_ proc; / Function to process a 'access()' call */
sl@0	332	struct AccessProc nextPtr; / The next 'access()' function to call */
sl@0	333	} AccessProc;
sl@0	334
sl@0	335	typedef struct OpenFileChannelProc {
sl@0	336	TclOpenFileChannelProc_ proc; / Function to process a
sl@0	337	* 'Tcl_OpenFileChannel()' call */
sl@0	338	struct OpenFileChannelProc *nextPtr;
sl@0	339	/* The next 'Tcl_OpenFileChannel()'
sl@0	340	* function to call */
sl@0	341	} OpenFileChannelProc;
sl@0	342
sl@0	343	/*
sl@0	344	* For each type of (obsolete) hookable function, a static node is
sl@0	345	* declared to hold the function pointer for the "built-in" routine
sl@0	346	* (e.g. 'TclpStat(...)') and the respective list is initialized as a
sl@0	347	* pointer to that node.
sl@0	348	*
sl@0	349	* The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that
sl@0	350	* these statically declared list entry cannot be inadvertently removed.
sl@0	351	*
sl@0	352	* This method avoids the need to call any sort of "initialization"
sl@0	353	* function.
sl@0	354	*
sl@0	355	* All three lists are protected by a global obsoleteFsHookMutex.
sl@0	356	*/
sl@0	357
sl@0	358	static StatProc *statProcList = NULL;
sl@0	359	static AccessProc *accessProcList = NULL;
sl@0	360	static OpenFileChannelProc *openFileChannelProcList = NULL;
sl@0	361
sl@0	362	TCL_DECLARE_MUTEX(obsoleteFsHookMutex)
sl@0	363
sl@0	364	#endif /* USE_OBSOLETE_FS_HOOKS */
sl@0	365
sl@0	366	/*
sl@0	367	* Declare the native filesystem support. These functions should
sl@0	368	* be considered private to Tcl, and should really not be called
sl@0	369	* directly by any code other than this file (i.e. neither by
sl@0	370	* Tcl's core nor by extensions). Similarly, the old string-based
sl@0	371	* Tclp... native filesystem functions should not be called.
sl@0	372	*
sl@0	373	* The correct API to use now is the Tcl_FS... set of functions,
sl@0	374	* which ensure correct and complete virtual filesystem support.
sl@0	375	*
sl@0	376	* We cannot make all of these static, since some of them
sl@0	377	* are implemented in the platform-specific directories.
sl@0	378	*/
sl@0	379	static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
sl@0	380	static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
sl@0	381	static Tcl_FSCreateInternalRepProc NativeCreateNativeRep;
sl@0	382	static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
sl@0	383	static Tcl_FSFileAttrsGetProc NativeFileAttrsGet;
sl@0	384	static Tcl_FSFileAttrsSetProc NativeFileAttrsSet;
sl@0	385
sl@0	386	/*
sl@0	387	* The only reason these functions are not static is that they
sl@0	388	* are either called by code in the native (win/unix/mac) directories
sl@0	389	* or they are actually implemented in those directories. They
sl@0	390	* should simply not be called by code outside Tcl's native
sl@0	391	* filesystem core. i.e. they should be considered 'static' to
sl@0	392	* Tcl's filesystem code (if we ever built the native filesystem
sl@0	393	* support into a separate code library, this could actually be
sl@0	394	* enforced).
sl@0	395	*/
sl@0	396	Tcl_FSFilesystemPathTypeProc TclpFilesystemPathType;
sl@0	397	Tcl_FSInternalToNormalizedProc TclpNativeToNormalized;
sl@0	398	Tcl_FSStatProc TclpObjStat;
sl@0	399	Tcl_FSAccessProc TclpObjAccess;
sl@0	400	Tcl_FSMatchInDirectoryProc TclpMatchInDirectory;
sl@0	401	Tcl_FSGetCwdProc TclpObjGetCwd;
sl@0	402	Tcl_FSChdirProc TclpObjChdir;
sl@0	403	Tcl_FSLstatProc TclpObjLstat;
sl@0	404	Tcl_FSCopyFileProc TclpObjCopyFile;
sl@0	405	Tcl_FSDeleteFileProc TclpObjDeleteFile;
sl@0	406	Tcl_FSRenameFileProc TclpObjRenameFile;
sl@0	407	Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
sl@0	408	Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
sl@0	409	Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
sl@0	410	Tcl_FSUnloadFileProc TclpUnloadFile;
sl@0	411	Tcl_FSLinkProc TclpObjLink;
sl@0	412	Tcl_FSListVolumesProc TclpObjListVolumes;
sl@0	413
sl@0	414	/*
sl@0	415	* Define the native filesystem dispatch table. If necessary, it
sl@0	416	* is ok to make this non-static, but it should only be accessed
sl@0	417	* by the functions actually listed within it (or perhaps other
sl@0	418	* helper functions of them). Anything which is not part of this
sl@0	419	* 'native filesystem implementation' should not be delving inside
sl@0	420	* here!
sl@0	421	*/
sl@0	422	Tcl_Filesystem tclNativeFilesystem = {
sl@0	423	"native",
sl@0	424	sizeof(Tcl_Filesystem),
sl@0	425	TCL_FILESYSTEM_VERSION_1,
sl@0	426	&NativePathInFilesystem,
sl@0	427	&TclNativeDupInternalRep,
sl@0	428	&NativeFreeInternalRep,
sl@0	429	&TclpNativeToNormalized,
sl@0	430	&NativeCreateNativeRep,
sl@0	431	&TclpObjNormalizePath,
sl@0	432	&TclpFilesystemPathType,
sl@0	433	&NativeFilesystemSeparator,
sl@0	434	&TclpObjStat,
sl@0	435	&TclpObjAccess,
sl@0	436	&TclpOpenFileChannel,
sl@0	437	&TclpMatchInDirectory,
sl@0	438	&TclpUtime,
sl@0	439	#ifndef S_IFLNK
sl@0	440	NULL,
sl@0	441	#else
sl@0	442	&TclpObjLink,
sl@0	443	#endif /* S_IFLNK */
sl@0	444	&TclpObjListVolumes,
sl@0	445	&NativeFileAttrStrings,
sl@0	446	&NativeFileAttrsGet,
sl@0	447	&NativeFileAttrsSet,
sl@0	448	&TclpObjCreateDirectory,
sl@0	449	&TclpObjRemoveDirectory,
sl@0	450	&TclpObjDeleteFile,
sl@0	451	&TclpObjCopyFile,
sl@0	452	&TclpObjRenameFile,
sl@0	453	&TclpObjCopyDirectory,
sl@0	454	&TclpObjLstat,
sl@0	455	&TclpDlopen,
sl@0	456	&TclpObjGetCwd,
sl@0	457	&TclpObjChdir
sl@0	458	};
sl@0	459
sl@0	460	/*
sl@0	461	* Define the tail of the linked list. Note that for unconventional
sl@0	462	* uses of Tcl without a native filesystem, we may in the future wish
sl@0	463	* to modify the current approach of hard-coding the native filesystem
sl@0	464	* in the lookup list 'filesystemList' below.
sl@0	465	*
sl@0	466	* We initialize the record so that it thinks one file uses it. This
sl@0	467	* means it will never be freed.
sl@0	468	*/
sl@0	469	static FilesystemRecord nativeFilesystemRecord = {
sl@0	470	NULL,
sl@0	471	&tclNativeFilesystem,
sl@0	472	1,
sl@0	473	NULL
sl@0	474	};
sl@0	475
sl@0	476	/*
sl@0	477	* This is incremented each time we modify the linked list of
sl@0	478	* filesystems. Any time it changes, all cached filesystem
sl@0	479	* representations are suspect and must be freed.
sl@0	480	* For multithreading builds, change of the filesystem epoch
sl@0	481	* will trigger cache cleanup in all threads.
sl@0	482	*/
sl@0	483	int theFilesystemEpoch = 0;
sl@0	484
sl@0	485	/*
sl@0	486	* Stores the linked list of filesystems. A 1:1 copy of this
sl@0	487	* list is also maintained in the TSD for each thread. This
sl@0	488	* is to avoid synchronization issues.
sl@0	489	*/
sl@0	490	static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
sl@0	491
sl@0	492	TCL_DECLARE_MUTEX(filesystemMutex)
sl@0	493
sl@0	494	#if !defined(__SYMBIAN32__) \|\| !defined(__WINSCW__)
sl@0	495	/*
sl@0	496	* Used to implement Tcl_FSGetCwd in a file-system independent way.
sl@0	497	*/
sl@0	498	static Tcl_Obj* cwdPathPtr = NULL;
sl@0	499	static int cwdPathEpoch = 0;
sl@0	500	#endif
sl@0	501	TCL_DECLARE_MUTEX(cwdMutex)
sl@0	502
sl@0	503	/*
sl@0	504	* This structure holds per-thread private copies of
sl@0	505	* some global data. This way we avoid most of the
sl@0	506	* synchronization calls which boosts performance, at
sl@0	507	* cost of having to update this information each
sl@0	508	* time the corresponding epoch counter changes.
sl@0	509	*
sl@0	510	*/
sl@0	511	typedef struct ThreadSpecificData {
sl@0	512	int initialized;
sl@0	513	int cwdPathEpoch;
sl@0	514	int filesystemEpoch;
sl@0	515	Tcl_Obj *cwdPathPtr;
sl@0	516	FilesystemRecord *filesystemList;
sl@0	517	} ThreadSpecificData;
sl@0	518
sl@0	519	#if !defined(__SYMBIAN32__) \|\| !defined(__WINSCW__)
sl@0	520	static Tcl_ThreadDataKey dataKey;
sl@0	521	#endif
sl@0	522
sl@0	523	/*
sl@0	524	* Declare fallback support function and
sl@0	525	* information for Tcl_FSLoadFile
sl@0	526	*/
sl@0	527	static Tcl_FSUnloadFileProc FSUnloadTempFile;
sl@0	528
sl@0	529	/*
sl@0	530	* One of these structures is used each time we successfully load a
sl@0	531	* file from a file system by way of making a temporary copy of the
sl@0	532	* file on the native filesystem. We need to store both the actual
sl@0	533	* unloadProc/clientData combination which was used, and the original
sl@0	534	* and modified filenames, so that we can correctly undo the entire
sl@0	535	* operation when we want to unload the code.
sl@0	536	*/
sl@0	537	typedef struct FsDivertLoad {
sl@0	538	Tcl_LoadHandle loadHandle;
sl@0	539	Tcl_FSUnloadFileProc *unloadProcPtr;
sl@0	540	Tcl_Obj *divertedFile;
sl@0	541	Tcl_Filesystem *divertedFilesystem;
sl@0	542	ClientData divertedFileNativeRep;
sl@0	543	} FsDivertLoad;
sl@0	544
sl@0	545	/* Now move on to the basic filesystem implementation */
sl@0	546
sl@0	547	static void
sl@0	548	FsThrExitProc(cd)
sl@0	549	ClientData cd;
sl@0	550	{
sl@0	551	ThreadSpecificData tsdPtr = (ThreadSpecificData)cd;
sl@0	552	FilesystemRecord fsRecPtr = NULL, tmpFsRecPtr = NULL;
sl@0	553
sl@0	554	/* Trash the cwd copy */
sl@0	555	if (tsdPtr->cwdPathPtr != NULL) {
sl@0	556	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
sl@0	557	tsdPtr->cwdPathPtr = NULL;
sl@0	558	}
sl@0	559	/* Trash the filesystems cache */
sl@0	560	fsRecPtr = tsdPtr->filesystemList;
sl@0	561	while (fsRecPtr != NULL) {
sl@0	562	tmpFsRecPtr = fsRecPtr->nextPtr;
sl@0	563	if (--fsRecPtr->fileRefCount <= 0) {
sl@0	564	ckfree((char *)fsRecPtr);
sl@0	565	}
sl@0	566	fsRecPtr = tmpFsRecPtr;
sl@0	567	}
sl@0	568	tsdPtr->initialized = 0;
sl@0	569	}
sl@0	570
sl@0	571	int
sl@0	572	TclFSCwdPointerEquals(objPtr)
sl@0	573	Tcl_Obj* objPtr;
sl@0	574	{
sl@0	575	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	576
sl@0	577	Tcl_MutexLock(&cwdMutex);
sl@0	578	#if !defined(__SYMBIAN32__) \|\| !defined(__WINSCW__)
sl@0	579	if (tsdPtr->cwdPathPtr == NULL) {
sl@0	580	if (cwdPathPtr == NULL) {
sl@0	581	tsdPtr->cwdPathPtr = NULL;
sl@0	582	} else {
sl@0	583	tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
sl@0	584	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
sl@0	585	}
sl@0	586	tsdPtr->cwdPathEpoch = cwdPathEpoch;
sl@0	587	} else if (tsdPtr->cwdPathEpoch != cwdPathEpoch) {
sl@0	588	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
sl@0	589	if (cwdPathPtr == NULL) {
sl@0	590	tsdPtr->cwdPathPtr = NULL;
sl@0	591	} else {
sl@0	592	tsdPtr->cwdPathPtr = Tcl_DuplicateObj(cwdPathPtr);
sl@0	593	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
sl@0	594	}
sl@0	595	}
sl@0	596	#else
sl@0	597	if (tsdPtr->cwdPathPtr == NULL) {
sl@0	598	if (glcwdPathPtr == NULL) {
sl@0	599	tsdPtr->cwdPathPtr = NULL;
sl@0	600	} else {
sl@0	601	tsdPtr->cwdPathPtr = Tcl_DuplicateObj(glcwdPathPtr);
sl@0	602	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
sl@0	603	}
sl@0	604	tsdPtr->cwdPathEpoch = glcwdPathEpoch;
sl@0	605	} else if (tsdPtr->cwdPathEpoch != glcwdPathEpoch) {
sl@0	606	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
sl@0	607	if (glcwdPathPtr == NULL) {
sl@0	608	tsdPtr->cwdPathPtr = NULL;
sl@0	609	} else {
sl@0	610	tsdPtr->cwdPathPtr = Tcl_DuplicateObj(glcwdPathPtr);
sl@0	611	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
sl@0	612	}
sl@0	613	}
sl@0	614	#endif
sl@0	615	Tcl_MutexUnlock(&cwdMutex);
sl@0	616
sl@0	617	if (tsdPtr->initialized == 0) {
sl@0	618	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
sl@0	619	tsdPtr->initialized = 1;
sl@0	620	}
sl@0	621	return (tsdPtr->cwdPathPtr == objPtr);
sl@0	622	}
sl@0	623	#ifdef TCL_THREADS
sl@0	624
sl@0	625	static void
sl@0	626	FsRecacheFilesystemList(void)
sl@0	627	{
sl@0	628	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	629	FilesystemRecord fsRecPtr, tmpFsRecPtr = NULL;
sl@0	630
sl@0	631	/* Trash the current cache */
sl@0	632	fsRecPtr = tsdPtr->filesystemList;
sl@0	633	while (fsRecPtr != NULL) {
sl@0	634	tmpFsRecPtr = fsRecPtr->nextPtr;
sl@0	635	if (--fsRecPtr->fileRefCount <= 0) {
sl@0	636	ckfree((char *)fsRecPtr);
sl@0	637	}
sl@0	638	fsRecPtr = tmpFsRecPtr;
sl@0	639	}
sl@0	640	tsdPtr->filesystemList = NULL;
sl@0	641
sl@0	642	/*
sl@0	643	* Code below operates on shared data. We
sl@0	644	* are already called under mutex lock so
sl@0	645	* we can safely proceed.
sl@0	646	*/
sl@0	647
sl@0	648	/* Locate tail of the global filesystem list */
sl@0	649	fsRecPtr = filesystemList;
sl@0	650	while (fsRecPtr != NULL) {
sl@0	651	tmpFsRecPtr = fsRecPtr;
sl@0	652	fsRecPtr = fsRecPtr->nextPtr;
sl@0	653	}
sl@0	654
sl@0	655	/* Refill the cache honouring the order */
sl@0	656	fsRecPtr = tmpFsRecPtr;
sl@0	657	while (fsRecPtr != NULL) {
sl@0	658	tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));
sl@0	659	tmpFsRecPtr = fsRecPtr;
sl@0	660	tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
sl@0	661	tmpFsRecPtr->prevPtr = NULL;
sl@0	662	if (tsdPtr->filesystemList) {
sl@0	663	tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
sl@0	664	}
sl@0	665	tsdPtr->filesystemList = tmpFsRecPtr;
sl@0	666	fsRecPtr = fsRecPtr->prevPtr;
sl@0	667	}
sl@0	668
sl@0	669	/* Make sure the above gets released on thread exit */
sl@0	670	if (tsdPtr->initialized == 0) {
sl@0	671	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData)tsdPtr);
sl@0	672	tsdPtr->initialized = 1;
sl@0	673	}
sl@0	674	}
sl@0	675	#endif
sl@0	676
sl@0	677	static FilesystemRecord *
sl@0	678	FsGetFirstFilesystem(void) {
sl@0	679	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	680	FilesystemRecord *fsRecPtr;
sl@0	681	#ifndef TCL_THREADS
sl@0	682	tsdPtr->filesystemEpoch = theFilesystemEpoch;
sl@0	683	fsRecPtr = filesystemList;
sl@0	684	#else
sl@0	685	Tcl_MutexLock(&filesystemMutex);
sl@0	686	if (tsdPtr->filesystemList == NULL
sl@0	687	\|\| (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
sl@0	688	FsRecacheFilesystemList();
sl@0	689	tsdPtr->filesystemEpoch = theFilesystemEpoch;
sl@0	690	}
sl@0	691	Tcl_MutexUnlock(&filesystemMutex);
sl@0	692	fsRecPtr = tsdPtr->filesystemList;
sl@0	693	#endif
sl@0	694	return fsRecPtr;
sl@0	695	}
sl@0	696
sl@0	697	static void
sl@0	698	FsUpdateCwd(cwdObj)
sl@0	699	Tcl_Obj *cwdObj;
sl@0	700	{
sl@0	701	int len;
sl@0	702	char *str = NULL;
sl@0	703	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	704
sl@0	705	if (cwdObj != NULL) {
sl@0	706	str = Tcl_GetStringFromObj(cwdObj, &len);
sl@0	707	}
sl@0	708
sl@0	709	Tcl_MutexLock(&cwdMutex);
sl@0	710	#if !defined(__SYMBIAN32__) \|\| !defined(__WINSCW__)
sl@0	711	if (cwdPathPtr != NULL) {
sl@0	712	Tcl_DecrRefCount(cwdPathPtr);
sl@0	713	}
sl@0	714	if (cwdObj == NULL) {
sl@0	715	cwdPathPtr = NULL;
sl@0	716	} else {
sl@0	717	/* This MUST be stored as string object! */
sl@0	718	cwdPathPtr = Tcl_NewStringObj(str, len);
sl@0	719	Tcl_IncrRefCount(cwdPathPtr);
sl@0	720	}
sl@0	721	cwdPathEpoch++;
sl@0	722	tsdPtr->cwdPathEpoch = cwdPathEpoch;
sl@0	723	#else
sl@0	724	if (glcwdPathPtr != NULL) {
sl@0	725	Tcl_DecrRefCount(glcwdPathPtr);
sl@0	726	}
sl@0	727	if (cwdObj == NULL) {
sl@0	728	glcwdPathPtr = NULL;
sl@0	729	} else {
sl@0	730	/* This MUST be stored as string object! */
sl@0	731	glcwdPathPtr = Tcl_NewStringObj(str, len);
sl@0	732	Tcl_IncrRefCount(glcwdPathPtr);
sl@0	733	}
sl@0	734	glcwdPathEpoch++;
sl@0	735	tsdPtr->cwdPathEpoch = glcwdPathEpoch;
sl@0	736	#endif
sl@0	737	Tcl_MutexUnlock(&cwdMutex);
sl@0	738
sl@0	739	if (tsdPtr->cwdPathPtr) {
sl@0	740	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
sl@0	741	}
sl@0	742	if (cwdObj == NULL) {
sl@0	743	tsdPtr->cwdPathPtr = NULL;
sl@0	744	} else {
sl@0	745	tsdPtr->cwdPathPtr = Tcl_NewStringObj(str, len);
sl@0	746	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
sl@0	747	}
sl@0	748	}
sl@0	749
sl@0	750	/*
sl@0	751	*----------------------------------------------------------------------
sl@0	752	*
sl@0	753	* TclFinalizeFilesystem --
sl@0	754	*
sl@0	755	* Clean up the filesystem. After this, calls to all Tcl_FS...
sl@0	756	* functions will fail.
sl@0	757	*
sl@0	758	* We will later call TclResetFilesystem to restore the FS
sl@0	759	* to a pristine state.
sl@0	760	*
sl@0	761	* Results:
sl@0	762	* None.
sl@0	763	*
sl@0	764	* Side effects:
sl@0	765	* Frees any memory allocated by the filesystem.
sl@0	766	*
sl@0	767	*----------------------------------------------------------------------
sl@0	768	*/
sl@0	769
sl@0	770	void
sl@0	771	TclFinalizeFilesystem()
sl@0	772	{
sl@0	773	FilesystemRecord *fsRecPtr;
sl@0	774
sl@0	775	/*
sl@0	776	* Assumption that only one thread is active now. Otherwise
sl@0	777	* we would need to put various mutexes around this code.
sl@0	778	*/
sl@0	779	#if !defined(__SYMBIAN32__) \|\| !defined(__WINSCW__)
sl@0	780	if (cwdPathPtr != NULL) {
sl@0	781	Tcl_DecrRefCount(cwdPathPtr);
sl@0	782	cwdPathPtr = NULL;
sl@0	783	cwdPathEpoch = 0;
sl@0	784	#else
sl@0	785	if (glcwdPathPtr != NULL) {
sl@0	786	Tcl_DecrRefCount(glcwdPathPtr);
sl@0	787	glcwdPathPtr = NULL;
sl@0	788	glcwdPathEpoch = 0;
sl@0	789	#endif
sl@0	790	}
sl@0	791
sl@0	792	/*
sl@0	793	* Remove all filesystems, freeing any allocated memory
sl@0	794	* that is no longer needed
sl@0	795	*/
sl@0	796
sl@0	797	fsRecPtr = filesystemList;
sl@0	798	while (fsRecPtr != NULL) {
sl@0	799	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
sl@0	800	if (fsRecPtr->fileRefCount <= 0) {
sl@0	801	/* The native filesystem is static, so we don't free it */
sl@0	802	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
sl@0	803	ckfree((char *)fsRecPtr);
sl@0	804	}
sl@0	805	}
sl@0	806	fsRecPtr = tmpFsRecPtr;
sl@0	807	}
sl@0	808	filesystemList = NULL;
sl@0	809
sl@0	810	/*
sl@0	811	* Now filesystemList is NULL. This means that any attempt
sl@0	812	* to use the filesystem is likely to fail.
sl@0	813	*/
sl@0	814
sl@0	815	statProcList = NULL;
sl@0	816	accessProcList = NULL;
sl@0	817	openFileChannelProcList = NULL;
sl@0	818	#ifdef __WIN32__
sl@0	819	TclWinEncodingsCleanup();
sl@0	820	#endif
sl@0	821	}
sl@0	822
sl@0	823	/*
sl@0	824	*----------------------------------------------------------------------
sl@0	825	*
sl@0	826	* TclResetFilesystem --
sl@0	827	*
sl@0	828	* Restore the filesystem to a pristine state.
sl@0	829	*
sl@0	830	* Results:
sl@0	831	* None.
sl@0	832	*
sl@0	833	* Side effects:
sl@0	834	* None.
sl@0	835	*
sl@0	836	*----------------------------------------------------------------------
sl@0	837	*/
sl@0	838
sl@0	839	void
sl@0	840	TclResetFilesystem()
sl@0	841	{
sl@0	842	filesystemList = &nativeFilesystemRecord;
sl@0	843
sl@0	844	/*
sl@0	845	* Note, at this point, I believe nativeFilesystemRecord ->
sl@0	846	* fileRefCount should equal 1 and if not, we should try to track
sl@0	847	* down the cause.
sl@0	848	*/
sl@0	849
sl@0	850	#ifdef __WIN32__
sl@0	851	/*
sl@0	852	* Cleans up the win32 API filesystem proc lookup table. This must
sl@0	853	* happen very late in finalization so that deleting of copied
sl@0	854	* dlls can occur.
sl@0	855	*/
sl@0	856	TclWinResetInterfaces();
sl@0	857	#endif
sl@0	858	}
sl@0	859
sl@0	860	/*
sl@0	861	*----------------------------------------------------------------------
sl@0	862	*
sl@0	863	* Tcl_FSRegister --
sl@0	864	*
sl@0	865	* Insert the filesystem function table at the head of the list of
sl@0	866	* functions which are used during calls to all file-system
sl@0	867	* operations. The filesystem will be added even if it is
sl@0	868	* already in the list. (You can use Tcl_FSData to
sl@0	869	* check if it is in the list, provided the ClientData used was
sl@0	870	* not NULL).
sl@0	871	*
sl@0	872	* Note that the filesystem handling is head-to-tail of the list.
sl@0	873	* Each filesystem is asked in turn whether it can handle a
sl@0	874	* particular request, _until_ one of them says 'yes'. At that
sl@0	875	* point no further filesystems are asked.
sl@0	876	*
sl@0	877	* In particular this means if you want to add a diagnostic
sl@0	878	* filesystem (which simply reports all fs activity), it must be
sl@0	879	* at the head of the list: i.e. it must be the last registered.
sl@0	880	*
sl@0	881	* Results:
sl@0	882	* Normally TCL_OK; TCL_ERROR if memory for a new node in the list
sl@0	883	* could not be allocated.
sl@0	884	*
sl@0	885	* Side effects:
sl@0	886	* Memory allocated and modifies the link list for filesystems.
sl@0	887	*
sl@0	888	*----------------------------------------------------------------------
sl@0	889	*/
sl@0	890
sl@0	891	EXPORT_C int
sl@0	892	Tcl_FSRegister(clientData, fsPtr)
sl@0	893	ClientData clientData; /* Client specific data for this fs */
sl@0	894	Tcl_Filesystem fsPtr; / The filesystem record for the new fs. */
sl@0	895	{
sl@0	896	FilesystemRecord *newFilesystemPtr;
sl@0	897
sl@0	898	if (fsPtr == NULL) {
sl@0	899	return TCL_ERROR;
sl@0	900	}
sl@0	901
sl@0	902	newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
sl@0	903
sl@0	904	newFilesystemPtr->clientData = clientData;
sl@0	905	newFilesystemPtr->fsPtr = fsPtr;
sl@0	906	/*
sl@0	907	* We start with a refCount of 1. If this drops to zero, then
sl@0	908	* anyone is welcome to ckfree us.
sl@0	909	*/
sl@0	910	newFilesystemPtr->fileRefCount = 1;
sl@0	911
sl@0	912	/*
sl@0	913	* Is this lock and wait strictly speaking necessary? Since any
sl@0	914	* iterators out there will have grabbed a copy of the head of
sl@0	915	* the list and be iterating away from that, if we add a new
sl@0	916	* element to the head of the list, it can't possibly have any
sl@0	917	* effect on any of their loops. In fact it could be better not
sl@0	918	* to wait, since we are adjusting the filesystem epoch, any
sl@0	919	* cached representations calculated by existing iterators are
sl@0	920	* going to have to be thrown away anyway.
sl@0	921	*
sl@0	922	* However, since registering and unregistering filesystems is
sl@0	923	* a very rare action, this is not a very important point.
sl@0	924	*/
sl@0	925	Tcl_MutexLock(&filesystemMutex);
sl@0	926
sl@0	927	newFilesystemPtr->nextPtr = filesystemList;
sl@0	928	newFilesystemPtr->prevPtr = NULL;
sl@0	929	if (filesystemList) {
sl@0	930	filesystemList->prevPtr = newFilesystemPtr;
sl@0	931	}
sl@0	932	filesystemList = newFilesystemPtr;
sl@0	933
sl@0	934	/*
sl@0	935	* Increment the filesystem epoch counter, since existing paths
sl@0	936	* might conceivably now belong to different filesystems.
sl@0	937	*/
sl@0	938	theFilesystemEpoch++;
sl@0	939	Tcl_MutexUnlock(&filesystemMutex);
sl@0	940
sl@0	941	return TCL_OK;
sl@0	942	}
sl@0	943
sl@0	944	/*
sl@0	945	*----------------------------------------------------------------------
sl@0	946	*
sl@0	947	* Tcl_FSUnregister --
sl@0	948	*
sl@0	949	* Remove the passed filesystem from the list of filesystem
sl@0	950	* function tables. It also ensures that the built-in
sl@0	951	* (native) filesystem is not removable, although we may wish
sl@0	952	* to change that decision in the future to allow a smaller
sl@0	953	* Tcl core, in which the native filesystem is not used at
sl@0	954	* all (we could, say, initialise Tcl completely over a network
sl@0	955	* connection).
sl@0	956	*
sl@0	957	* Results:
sl@0	958	* TCL_OK if the procedure pointer was successfully removed,
sl@0	959	* TCL_ERROR otherwise.
sl@0	960	*
sl@0	961	* Side effects:
sl@0	962	* Memory may be deallocated (or will be later, once no "path"
sl@0	963	* objects refer to this filesystem), but the list of registered
sl@0	964	* filesystems is updated immediately.
sl@0	965	*
sl@0	966	*----------------------------------------------------------------------
sl@0	967	*/
sl@0	968
sl@0	969	EXPORT_C int
sl@0	970	Tcl_FSUnregister(fsPtr)
sl@0	971	Tcl_Filesystem fsPtr; / The filesystem record to remove. */
sl@0	972	{
sl@0	973	int retVal = TCL_ERROR;
sl@0	974	FilesystemRecord *fsRecPtr;
sl@0	975
sl@0	976	Tcl_MutexLock(&filesystemMutex);
sl@0	977
sl@0	978	/*
sl@0	979	* Traverse the 'filesystemList' looking for the particular node
sl@0	980	* whose 'fsPtr' member matches 'fsPtr' and remove that one from
sl@0	981	* the list. Ensure that the "default" node cannot be removed.
sl@0	982	*/
sl@0	983
sl@0	984	fsRecPtr = filesystemList;
sl@0	985	while ((retVal == TCL_ERROR) && (fsRecPtr->fsPtr != &tclNativeFilesystem)) {
sl@0	986	if (fsRecPtr->fsPtr == fsPtr) {
sl@0	987	if (fsRecPtr->prevPtr) {
sl@0	988	fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;
sl@0	989	} else {
sl@0	990	filesystemList = fsRecPtr->nextPtr;
sl@0	991	}
sl@0	992	if (fsRecPtr->nextPtr) {
sl@0	993	fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr;
sl@0	994	}
sl@0	995	/*
sl@0	996	* Increment the filesystem epoch counter, since existing
sl@0	997	* paths might conceivably now belong to different
sl@0	998	* filesystems. This should also ensure that paths which
sl@0	999	* have cached the filesystem which is about to be deleted
sl@0	1000	* do not reference that filesystem (which would of course
sl@0	1001	* lead to memory exceptions).
sl@0	1002	*/
sl@0	1003	theFilesystemEpoch++;
sl@0	1004
sl@0	1005	fsRecPtr->fileRefCount--;
sl@0	1006	if (fsRecPtr->fileRefCount <= 0) {
sl@0	1007	ckfree((char *)fsRecPtr);
sl@0	1008	}
sl@0	1009
sl@0	1010	retVal = TCL_OK;
sl@0	1011	} else {
sl@0	1012	fsRecPtr = fsRecPtr->nextPtr;
sl@0	1013	}
sl@0	1014	}
sl@0	1015
sl@0	1016	Tcl_MutexUnlock(&filesystemMutex);
sl@0	1017	return (retVal);
sl@0	1018	}
sl@0	1019
sl@0	1020	/*
sl@0	1021	*----------------------------------------------------------------------
sl@0	1022	*
sl@0	1023	* Tcl_FSMatchInDirectory --
sl@0	1024	*
sl@0	1025	* This routine is used by the globbing code to search a directory
sl@0	1026	* for all files which match a given pattern. The appropriate
sl@0	1027	* function for the filesystem to which pathPtr belongs will be
sl@0	1028	* called. If pathPtr does not belong to any filesystem and if it
sl@0	1029	* is NULL or the empty string, then we assume the pattern is to be
sl@0	1030	* matched in the current working directory. To avoid each
sl@0	1031	* filesystem's Tcl_FSMatchInDirectoryProc having to deal with this
sl@0	1032	* issue, we create a pathPtr on the fly (equal to the cwd), and
sl@0	1033	* then remove it from the results returned. This makes filesystems
sl@0	1034	* easy to write, since they can assume the pathPtr passed to them
sl@0	1035	* is an ordinary path. In fact this means we could remove such
sl@0	1036	* special case handling from Tcl's native filesystems.
sl@0	1037	*
sl@0	1038	* If 'pattern' is NULL, then pathPtr is assumed to be a fully
sl@0	1039	* specified path of a single file/directory which must be
sl@0	1040	* checked for existence and correct type.
sl@0	1041	*
sl@0	1042	* Results:
sl@0	1043	*
sl@0	1044	* The return value is a standard Tcl result indicating whether an
sl@0	1045	* error occurred in globbing. Error messages are placed in
sl@0	1046	* interp, but good results are placed in the resultPtr given.
sl@0	1047	*
sl@0	1048	* Recursive searches, e.g.
sl@0	1049	*
sl@0	1050	* glob -dir $dir -join * pkgIndex.tcl
sl@0	1051	*
sl@0	1052	* which must recurse through each directory matching '*' are
sl@0	1053	* handled internally by Tcl, by passing specific flags in a
sl@0	1054	* modified 'types' parameter. This means the actual filesystem
sl@0	1055	* only ever sees patterns which match in a single directory.
sl@0	1056	*
sl@0	1057	* Side effects:
sl@0	1058	* The interpreter may have an error message inserted into it.
sl@0	1059	*
sl@0	1060	*----------------------------------------------------------------------
sl@0	1061	*/
sl@0	1062
sl@0	1063	EXPORT_C int
sl@0	1064	Tcl_FSMatchInDirectory(interp, result, pathPtr, pattern, types)
sl@0	1065	Tcl_Interp interp; / Interpreter to receive error messages. */
sl@0	1066	Tcl_Obj result; / List object to receive results. */
sl@0	1067	Tcl_Obj pathPtr; / Contains path to directory to search. */
sl@0	1068	CONST char pattern; / Pattern to match against. */
sl@0	1069	Tcl_GlobTypeData types; / Object containing list of acceptable types.
sl@0	1070	* May be NULL. In particular the directory
sl@0	1071	* flag is very important. */
sl@0	1072	{
sl@0	1073	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	1074	if (fsPtr != NULL) {
sl@0	1075	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
sl@0	1076	if (proc != NULL) {
sl@0	1077	int ret = (*proc)(interp, result, pathPtr, pattern, types);
sl@0	1078	if (ret == TCL_OK && pattern != NULL) {
sl@0	1079	result = FsAddMountsToGlobResult(result, pathPtr,
sl@0	1080	pattern, types);
sl@0	1081	}
sl@0	1082	return ret;
sl@0	1083	}
sl@0	1084	} else {
sl@0	1085	Tcl_Obj* cwd;
sl@0	1086	int ret = -1;
sl@0	1087	if (pathPtr != NULL) {
sl@0	1088	int len;
sl@0	1089	Tcl_GetStringFromObj(pathPtr,&len);
sl@0	1090	if (len != 0) {
sl@0	1091	/*
sl@0	1092	* We have no idea how to match files in a directory
sl@0	1093	* which belongs to no known filesystem
sl@0	1094	*/
sl@0	1095	Tcl_SetErrno(ENOENT);
sl@0	1096	return -1;
sl@0	1097	}
sl@0	1098	}
sl@0	1099	/*
sl@0	1100	* We have an empty or NULL path. This is defined to mean we
sl@0	1101	* must search for files within the current 'cwd'. We
sl@0	1102	* therefore use that, but then since the proc we call will
sl@0	1103	* return results which include the cwd we must then trim it
sl@0	1104	* off the front of each path in the result. We choose to deal
sl@0	1105	* with this here (in the generic code), since if we don't,
sl@0	1106	* every single filesystem's implementation of
sl@0	1107	* Tcl_FSMatchInDirectory will have to deal with it for us.
sl@0	1108	*/
sl@0	1109	cwd = Tcl_FSGetCwd(NULL);
sl@0	1110	if (cwd == NULL) {
sl@0	1111	if (interp != NULL) {
sl@0	1112	Tcl_SetResult(interp, "glob couldn't determine "
sl@0	1113	"the current working directory", TCL_STATIC);
sl@0	1114	}
sl@0	1115	return TCL_ERROR;
sl@0	1116	}
sl@0	1117	fsPtr = Tcl_FSGetFileSystemForPath(cwd);
sl@0	1118	if (fsPtr != NULL) {
sl@0	1119	Tcl_FSMatchInDirectoryProc *proc = fsPtr->matchInDirectoryProc;
sl@0	1120	if (proc != NULL) {
sl@0	1121	Tcl_Obj* tmpResultPtr = Tcl_NewListObj(0, NULL);
sl@0	1122	Tcl_IncrRefCount(tmpResultPtr);
sl@0	1123	ret = (*proc)(interp, tmpResultPtr, cwd, pattern, types);
sl@0	1124	if (ret == TCL_OK) {
sl@0	1125	int resLength;
sl@0	1126
sl@0	1127	tmpResultPtr = FsAddMountsToGlobResult(tmpResultPtr, cwd,
sl@0	1128	pattern, types);
sl@0	1129
sl@0	1130	ret = Tcl_ListObjLength(interp, tmpResultPtr, &resLength);
sl@0	1131	if (ret == TCL_OK) {
sl@0	1132	int i;
sl@0	1133
sl@0	1134	for (i = 0; i < resLength; i++) {
sl@0	1135	Tcl_Obj *elt;
sl@0	1136
sl@0	1137	Tcl_ListObjIndex(interp, tmpResultPtr, i, &elt);
sl@0	1138	Tcl_ListObjAppendElement(interp, result,
sl@0	1139	TclFSMakePathRelative(interp, elt, cwd));
sl@0	1140	}
sl@0	1141	}
sl@0	1142	}
sl@0	1143	Tcl_DecrRefCount(tmpResultPtr);
sl@0	1144	}
sl@0	1145	}
sl@0	1146	Tcl_DecrRefCount(cwd);
sl@0	1147	return ret;
sl@0	1148	}
sl@0	1149	Tcl_SetErrno(ENOENT);
sl@0	1150	return -1;
sl@0	1151	}
sl@0	1152
sl@0	1153	/*
sl@0	1154	*----------------------------------------------------------------------
sl@0	1155	*
sl@0	1156	* FsAddMountsToGlobResult --
sl@0	1157	*
sl@0	1158	* This routine is used by the globbing code to take the results
sl@0	1159	* of a directory listing and add any mounted paths to that
sl@0	1160	* listing. This is required so that simple things like
sl@0	1161	* 'glob *' merge mounts and listings correctly.
sl@0	1162	*
sl@0	1163	* Results:
sl@0	1164	*
sl@0	1165	* The passed in 'result' may be modified (in place, if
sl@0	1166	* necessary), and the correct list is returned.
sl@0	1167	*
sl@0	1168	* Side effects:
sl@0	1169	* None.
sl@0	1170	*
sl@0	1171	*----------------------------------------------------------------------
sl@0	1172	*/
sl@0	1173	static Tcl_Obj*
sl@0	1174	FsAddMountsToGlobResult(result, pathPtr, pattern, types)
sl@0	1175	Tcl_Obj result; / The current list of matching paths */
sl@0	1176	Tcl_Obj pathPtr; / The directory in question */
sl@0	1177	CONST char *pattern;
sl@0	1178	Tcl_GlobTypeData *types;
sl@0	1179	{
sl@0	1180	int mLength, gLength, i;
sl@0	1181	int dir = (types == NULL \|\| (types->type & TCL_GLOB_TYPE_DIR));
sl@0	1182	Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);
sl@0	1183
sl@0	1184	if (mounts == NULL) return result;
sl@0	1185
sl@0	1186	if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK \|\| mLength == 0) {
sl@0	1187	goto endOfMounts;
sl@0	1188	}
sl@0	1189	if (Tcl_ListObjLength(NULL, result, &gLength) != TCL_OK) {
sl@0	1190	goto endOfMounts;
sl@0	1191	}
sl@0	1192	for (i = 0; i < mLength; i++) {
sl@0	1193	Tcl_Obj *mElt;
sl@0	1194	int j;
sl@0	1195	int found = 0;
sl@0	1196
sl@0	1197	Tcl_ListObjIndex(NULL, mounts, i, &mElt);
sl@0	1198
sl@0	1199	for (j = 0; j < gLength; j++) {
sl@0	1200	Tcl_Obj *gElt;
sl@0	1201	Tcl_ListObjIndex(NULL, result, j, &gElt);
sl@0	1202	if (Tcl_FSEqualPaths(mElt, gElt)) {
sl@0	1203	found = 1;
sl@0	1204	if (!dir) {
sl@0	1205	/* We don't want to list this */
sl@0	1206	if (Tcl_IsShared(result)) {
sl@0	1207	Tcl_Obj *newList;
sl@0	1208	newList = Tcl_DuplicateObj(result);
sl@0	1209	Tcl_DecrRefCount(result);
sl@0	1210	result = newList;
sl@0	1211	}
sl@0	1212	Tcl_ListObjReplace(NULL, result, j, 1, 0, NULL);
sl@0	1213	gLength--;
sl@0	1214	}
sl@0	1215	/* Break out of for loop */
sl@0	1216	break;
sl@0	1217	}
sl@0	1218	}
sl@0	1219	if (!found && dir) {
sl@0	1220	if (Tcl_IsShared(result)) {
sl@0	1221	Tcl_Obj *newList;
sl@0	1222	newList = Tcl_DuplicateObj(result);
sl@0	1223	Tcl_DecrRefCount(result);
sl@0	1224	result = newList;
sl@0	1225	}
sl@0	1226	Tcl_ListObjAppendElement(NULL, result, mElt);
sl@0	1227	/*
sl@0	1228	* No need to increment gLength, since we
sl@0	1229	* don't want to compare mounts against
sl@0	1230	* mounts.
sl@0	1231	*/
sl@0	1232	}
sl@0	1233	}
sl@0	1234	endOfMounts:
sl@0	1235	Tcl_DecrRefCount(mounts);
sl@0	1236	return result;
sl@0	1237	}
sl@0	1238
sl@0	1239	/*
sl@0	1240	*----------------------------------------------------------------------
sl@0	1241	*
sl@0	1242	* Tcl_FSMountsChanged --
sl@0	1243	*
sl@0	1244	* Notify the filesystem that the available mounted filesystems
sl@0	1245	* (or within any one filesystem type, the number or location of
sl@0	1246	* mount points) have changed.
sl@0	1247	*
sl@0	1248	* Results:
sl@0	1249	* None.
sl@0	1250	*
sl@0	1251	* Side effects:
sl@0	1252	* The global filesystem variable 'theFilesystemEpoch' is
sl@0	1253	* incremented. The effect of this is to make all cached
sl@0	1254	* path representations invalid. Clearly it should only therefore
sl@0	1255	* be called when it is really required! There are a few
sl@0	1256	* circumstances when it should be called:
sl@0	1257	*
sl@0	1258	* (1) when a new filesystem is registered or unregistered.
sl@0	1259	* Strictly speaking this is only necessary if the new filesystem
sl@0	1260	* accepts file paths as is (normally the filesystem itself is
sl@0	1261	* really a shell which hasn't yet had any mount points established
sl@0	1262	* and so its 'pathInFilesystem' proc will always fail). However,
sl@0	1263	* for safety, Tcl always calls this for you in these circumstances.
sl@0	1264	*
sl@0	1265	* (2) when additional mount points are established inside any
sl@0	1266	* existing filesystem (except the native fs)
sl@0	1267	*
sl@0	1268	* (3) when any filesystem (except the native fs) changes the list
sl@0	1269	* of available volumes.
sl@0	1270	*
sl@0	1271	* (4) when the mapping from a string representation of a file to
sl@0	1272	* a full, normalized path changes. For example, if 'env(HOME)'
sl@0	1273	* is modified, then any path containing '~' will map to a different
sl@0	1274	* filesystem location. Therefore all such paths need to have
sl@0	1275	* their internal representation invalidated.
sl@0	1276	*
sl@0	1277	* Tcl has no control over (2) and (3), so any registered filesystem
sl@0	1278	* must make sure it calls this function when those situations
sl@0	1279	* occur.
sl@0	1280	*
sl@0	1281	* (Note: the reason for the exception in 2,3 for the native
sl@0	1282	* filesystem is that the native filesystem by default claims all
sl@0	1283	* unknown files even if it really doesn't understand them or if
sl@0	1284	* they don't exist).
sl@0	1285	*
sl@0	1286	*----------------------------------------------------------------------
sl@0	1287	*/
sl@0	1288
sl@0	1289	EXPORT_C void
sl@0	1290	Tcl_FSMountsChanged(fsPtr)
sl@0	1291	Tcl_Filesystem *fsPtr;
sl@0	1292	{
sl@0	1293	/*
sl@0	1294	* We currently don't do anything with this parameter. We
sl@0	1295	* could in the future only invalidate files for this filesystem
sl@0	1296	* or otherwise take more advanced action.
sl@0	1297	*/
sl@0	1298	(void)fsPtr;
sl@0	1299	/*
sl@0	1300	* Increment the filesystem epoch counter, since existing paths
sl@0	1301	* might now belong to different filesystems.
sl@0	1302	*/
sl@0	1303	Tcl_MutexLock(&filesystemMutex);
sl@0	1304	theFilesystemEpoch++;
sl@0	1305	Tcl_MutexUnlock(&filesystemMutex);
sl@0	1306	}
sl@0	1307
sl@0	1308	/*
sl@0	1309	*----------------------------------------------------------------------
sl@0	1310	*
sl@0	1311	* Tcl_FSData --
sl@0	1312	*
sl@0	1313	* Retrieve the clientData field for the filesystem given,
sl@0	1314	* or NULL if that filesystem is not registered.
sl@0	1315	*
sl@0	1316	* Results:
sl@0	1317	* A clientData value, or NULL. Note that if the filesystem
sl@0	1318	* was registered with a NULL clientData field, this function
sl@0	1319	* will return that NULL value.
sl@0	1320	*
sl@0	1321	* Side effects:
sl@0	1322	* None.
sl@0	1323	*
sl@0	1324	*----------------------------------------------------------------------
sl@0	1325	*/
sl@0	1326
sl@0	1327	EXPORT_C ClientData
sl@0	1328	Tcl_FSData(fsPtr)
sl@0	1329	Tcl_Filesystem fsPtr; / The filesystem record to query. */
sl@0	1330	{
sl@0	1331	ClientData retVal = NULL;
sl@0	1332	FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
sl@0	1333
sl@0	1334	/*
sl@0	1335	* Traverse the 'filesystemList' looking for the particular node
sl@0	1336	* whose 'fsPtr' member matches 'fsPtr' and remove that one from
sl@0	1337	* the list. Ensure that the "default" node cannot be removed.
sl@0	1338	*/
sl@0	1339
sl@0	1340	while ((retVal == NULL) && (fsRecPtr != NULL)) {
sl@0	1341	if (fsRecPtr->fsPtr == fsPtr) {
sl@0	1342	retVal = fsRecPtr->clientData;
sl@0	1343	}
sl@0	1344	fsRecPtr = fsRecPtr->nextPtr;
sl@0	1345	}
sl@0	1346
sl@0	1347	return retVal;
sl@0	1348	}
sl@0	1349
sl@0	1350	/*
sl@0	1351	*---------------------------------------------------------------------------
sl@0	1352	*
sl@0	1353	* TclFSNormalizeAbsolutePath --
sl@0	1354	*
sl@0	1355	* Description:
sl@0	1356	* Takes an absolute path specification and computes a 'normalized'
sl@0	1357	* path from it.
sl@0	1358	*
sl@0	1359	* A normalized path is one which has all '../', './' removed.
sl@0	1360	* Also it is one which is in the 'standard' format for the native
sl@0	1361	* platform. On MacOS, Unix, this means the path must be free of
sl@0	1362	* symbolic links/aliases, and on Windows it means we want the
sl@0	1363	* long form, with that long form's case-dependence (which gives
sl@0	1364	* us a unique, case-dependent path).
sl@0	1365	*
sl@0	1366	* The behaviour of this function if passed a non-absolute path
sl@0	1367	* is NOT defined.
sl@0	1368	*
sl@0	1369	* Results:
sl@0	1370	* The result is returned in a Tcl_Obj with a refCount of 1,
sl@0	1371	* which is therefore owned by the caller. It must be
sl@0	1372	* freed (with Tcl_DecrRefCount) by the caller when no longer needed.
sl@0	1373	*
sl@0	1374	* Side effects:
sl@0	1375	* None (beyond the memory allocation for the result).
sl@0	1376	*
sl@0	1377	* Special note:
sl@0	1378	* This code is based on code from Matt Newman and Jean-Claude
sl@0	1379	* Wippler, with additions from Vince Darley and is copyright
sl@0	1380	* those respective authors.
sl@0	1381	*
sl@0	1382	*---------------------------------------------------------------------------
sl@0	1383	*/
sl@0	1384	static Tcl_Obj *
sl@0	1385	TclFSNormalizeAbsolutePath(interp, pathPtr, clientDataPtr)
sl@0	1386	Tcl_Interp* interp; /* Interpreter to use */
sl@0	1387	Tcl_Obj pathPtr; / Absolute path to normalize */
sl@0	1388	ClientData *clientDataPtr;
sl@0	1389	{
sl@0	1390	int splen = 0, nplen, eltLen, i;
sl@0	1391	char *eltName;
sl@0	1392	Tcl_Obj *retVal;
sl@0	1393	Tcl_Obj *split;
sl@0	1394	Tcl_Obj *elt;
sl@0	1395
sl@0	1396	/* Split has refCount zero */
sl@0	1397	split = Tcl_FSSplitPath(pathPtr, &splen);
sl@0	1398
sl@0	1399	/*
sl@0	1400	* Modify the list of entries in place, by removing '.', and
sl@0	1401	* removing '..' and the entry before -- unless that entry before
sl@0	1402	* is the top-level entry, i.e. the name of a volume.
sl@0	1403	*/
sl@0	1404	nplen = 0;
sl@0	1405	for (i = 0; i < splen; i++) {
sl@0	1406	Tcl_ListObjIndex(NULL, split, nplen, &elt);
sl@0	1407	eltName = Tcl_GetStringFromObj(elt, &eltLen);
sl@0	1408
sl@0	1409	if ((eltLen == 1) && (eltName[0] == '.')) {
sl@0	1410	Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
sl@0	1411	} else if ((eltLen == 2)
sl@0	1412	&& (eltName[0] == '.') && (eltName[1] == '.')) {
sl@0	1413	if (nplen > 1) {
sl@0	1414	nplen--;
sl@0	1415	Tcl_ListObjReplace(NULL, split, nplen, 2, 0, NULL);
sl@0	1416	} else {
sl@0	1417	Tcl_ListObjReplace(NULL, split, nplen, 1, 0, NULL);
sl@0	1418	}
sl@0	1419	} else {
sl@0	1420	nplen++;
sl@0	1421	}
sl@0	1422	}
sl@0	1423	if (nplen > 0) {
sl@0	1424	ClientData clientData = NULL;
sl@0	1425
sl@0	1426	retVal = Tcl_FSJoinPath(split, nplen);
sl@0	1427	/*
sl@0	1428	* Now we have an absolute path, with no '..', '.' sequences,
sl@0	1429	* but it still may not be in 'unique' form, depending on the
sl@0	1430	* platform. For instance, Unix is case-sensitive, so the
sl@0	1431	* path is ok. Windows is case-insensitive, and also has the
sl@0	1432	* weird 'longname/shortname' thing (e.g. C:/Program Files/ and
sl@0	1433	* C:/Progra~1/ are equivalent). MacOS is case-insensitive.
sl@0	1434	*
sl@0	1435	* Virtual file systems which may be registered may have
sl@0	1436	* other criteria for normalizing a path.
sl@0	1437	*/
sl@0	1438	Tcl_IncrRefCount(retVal);
sl@0	1439	TclFSNormalizeToUniquePath(interp, retVal, 0, &clientData);
sl@0	1440	/*
sl@0	1441	* Since we know it is a normalized path, we can
sl@0	1442	* actually convert this object into an "path" object for
sl@0	1443	* greater efficiency
sl@0	1444	*/
sl@0	1445	TclFSMakePathFromNormalized(interp, retVal, clientData);
sl@0	1446	if (clientDataPtr != NULL) {
sl@0	1447	*clientDataPtr = clientData;
sl@0	1448	}
sl@0	1449	} else {
sl@0	1450	/* Init to an empty string */
sl@0	1451	retVal = Tcl_NewStringObj("",0);
sl@0	1452	Tcl_IncrRefCount(retVal);
sl@0	1453	}
sl@0	1454	/*
sl@0	1455	* We increment and then decrement the refCount of split to free
sl@0	1456	* it. We do this right at the end, in case there are
sl@0	1457	* optimisations in Tcl_FSJoinPath(split, nplen) above which would
sl@0	1458	* let it make use of split more effectively if it has a refCount
sl@0	1459	* of zero. Also we can't just decrement the ref count, in case
sl@0	1460	* 'split' was actually returned by the join call above, in a
sl@0	1461	* single-element optimisation when nplen == 1.
sl@0	1462	*/
sl@0	1463	Tcl_IncrRefCount(split);
sl@0	1464	Tcl_DecrRefCount(split);
sl@0	1465
sl@0	1466	/* This has a refCount of 1 for the caller */
sl@0	1467	return retVal;
sl@0	1468	}
sl@0	1469
sl@0	1470	/*
sl@0	1471	*---------------------------------------------------------------------------
sl@0	1472	*
sl@0	1473	* TclFSNormalizeToUniquePath --
sl@0	1474	*
sl@0	1475	* Description:
sl@0	1476	* Takes a path specification containing no ../, ./ sequences,
sl@0	1477	* and converts it into a unique path for the given platform.
sl@0	1478	* On MacOS, Unix, this means the path must be free of
sl@0	1479	* symbolic links/aliases, and on Windows it means we want the
sl@0	1480	* long form, with that long form's case-dependence (which gives
sl@0	1481	* us a unique, case-dependent path).
sl@0	1482	*
sl@0	1483	* Results:
sl@0	1484	* The pathPtr is modified in place. The return value is
sl@0	1485	* the last byte offset which was recognised in the path
sl@0	1486	* string.
sl@0	1487	*
sl@0	1488	* Side effects:
sl@0	1489	* None (beyond the memory allocation for the result).
sl@0	1490	*
sl@0	1491	* Special notes:
sl@0	1492	* If the filesystem-specific normalizePathProcs can re-introduce
sl@0	1493	* ../, ./ sequences into the path, then this function will
sl@0	1494	* not return the correct result. This may be possible with
sl@0	1495	* symbolic links on unix/macos.
sl@0	1496	*
sl@0	1497	* Important assumption: if startAt is non-zero, it must point
sl@0	1498	* to a directory separator that we know exists and is already
sl@0	1499	* normalized (so it is important not to point to the char just
sl@0	1500	* after the separator).
sl@0	1501	*---------------------------------------------------------------------------
sl@0	1502	*/
sl@0	1503	int
sl@0	1504	TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
sl@0	1505	Tcl_Interp *interp;
sl@0	1506	Tcl_Obj *pathPtr;
sl@0	1507	int startAt;
sl@0	1508	ClientData *clientDataPtr;
sl@0	1509	{
sl@0	1510	FilesystemRecord fsRecPtr, firstFsRecPtr;
sl@0	1511	/* Ignore this variable */
sl@0	1512	(void)clientDataPtr;
sl@0	1513
sl@0	1514	/*
sl@0	1515	* Call each of the "normalise path" functions in succession. This is
sl@0	1516	* a special case, in which if we have a native filesystem handler,
sl@0	1517	* we call it first. This is because the root of Tcl's filesystem
sl@0	1518	* is always a native filesystem (i.e. '/' on unix is native).
sl@0	1519	*/
sl@0	1520
sl@0	1521	firstFsRecPtr = FsGetFirstFilesystem();
sl@0	1522
sl@0	1523	fsRecPtr = firstFsRecPtr;
sl@0	1524	while (fsRecPtr != NULL) {
sl@0	1525	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
sl@0	1526	Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
sl@0	1527	if (proc != NULL) {
sl@0	1528	startAt = (*proc)(interp, pathPtr, startAt);
sl@0	1529	}
sl@0	1530	break;
sl@0	1531	}
sl@0	1532	fsRecPtr = fsRecPtr->nextPtr;
sl@0	1533	}
sl@0	1534
sl@0	1535	fsRecPtr = firstFsRecPtr;
sl@0	1536	while (fsRecPtr != NULL) {
sl@0	1537	/* Skip the native system next time through */
sl@0	1538	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
sl@0	1539	Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
sl@0	1540	if (proc != NULL) {
sl@0	1541	startAt = (*proc)(interp, pathPtr, startAt);
sl@0	1542	}
sl@0	1543	/*
sl@0	1544	* We could add an efficiency check like this:
sl@0	1545	*
sl@0	1546	* if (retVal == length-of(pathPtr)) {break;}
sl@0	1547	*
sl@0	1548	* but there's not much benefit.
sl@0	1549	*/
sl@0	1550	}
sl@0	1551	fsRecPtr = fsRecPtr->nextPtr;
sl@0	1552	}
sl@0	1553
sl@0	1554	return startAt;
sl@0	1555	}
sl@0	1556
sl@0	1557	/*
sl@0	1558	*---------------------------------------------------------------------------
sl@0	1559	*
sl@0	1560	* TclGetOpenMode --
sl@0	1561	*
sl@0	1562	* Description:
sl@0	1563	* Computes a POSIX mode mask for opening a file, from a given string,
sl@0	1564	* and also sets a flag to indicate whether the caller should seek to
sl@0	1565	* EOF after opening the file.
sl@0	1566	*
sl@0	1567	* Results:
sl@0	1568	* On success, returns mode to pass to "open". If an error occurs, the
sl@0	1569	* return value is -1 and if interp is not NULL, sets interp's result
sl@0	1570	* object to an error message.
sl@0	1571	*
sl@0	1572	* Side effects:
sl@0	1573	* Sets the integer referenced by seekFlagPtr to 1 to tell the caller
sl@0	1574	* to seek to EOF after opening the file.
sl@0	1575	*
sl@0	1576	* Special note:
sl@0	1577	* This code is based on a prototype implementation contributed
sl@0	1578	* by Mark Diekhans.
sl@0	1579	*
sl@0	1580	*---------------------------------------------------------------------------
sl@0	1581	*/
sl@0	1582
sl@0	1583	int
sl@0	1584	TclGetOpenMode(interp, string, seekFlagPtr)
sl@0	1585	Tcl_Interp interp; / Interpreter to use for error
sl@0	1586	* reporting - may be NULL. */
sl@0	1587	CONST char string; / Mode string, e.g. "r+" or
sl@0	1588	* "RDONLY CREAT". */
sl@0	1589	int seekFlagPtr; / Set this to 1 if the caller
sl@0	1590	* should seek to EOF during the
sl@0	1591	* opening of the file. */
sl@0	1592	{
sl@0	1593	int mode, modeArgc, c, i, gotRW;
sl@0	1594	CONST char *modeArgv, flag;
sl@0	1595	#define RW_MODES (O_RDONLY\|O_WRONLY\|O_RDWR)
sl@0	1596
sl@0	1597	/*
sl@0	1598	* Check for the simpler fopen-like access modes (e.g. "r"). They
sl@0	1599	* are distinguished from the POSIX access modes by the presence
sl@0	1600	* of a lower-case first letter.
sl@0	1601	*/
sl@0	1602
sl@0	1603	*seekFlagPtr = 0;
sl@0	1604	mode = 0;
sl@0	1605
sl@0	1606	/*
sl@0	1607	* Guard against international characters before using byte oriented
sl@0	1608	* routines.
sl@0	1609	*/
sl@0	1610
sl@0	1611	if (!(string[0] & 0x80)
sl@0	1612	&& islower(UCHAR(string[0]))) { /* INTL: ISO only. */
sl@0	1613	switch (string[0]) {
sl@0	1614	case 'r':
sl@0	1615	mode = O_RDONLY;
sl@0	1616	break;
sl@0	1617	case 'w':
sl@0	1618	mode = O_WRONLY\|O_CREAT\|O_TRUNC;
sl@0	1619	break;
sl@0	1620	case 'a':
sl@0	1621	/* [Bug 680143].
sl@0	1622	* Added O_APPEND for proper automatic
sl@0	1623	* seek-to-end-on-write by the OS.
sl@0	1624	*/
sl@0	1625	mode = O_WRONLY\|O_CREAT\|O_APPEND;
sl@0	1626	*seekFlagPtr = 1;
sl@0	1627	break;
sl@0	1628	default:
sl@0	1629	error:
sl@0	1630	if (interp != (Tcl_Interp *) NULL) {
sl@0	1631	Tcl_AppendResult(interp,
sl@0	1632	"illegal access mode \"", string, "\"",
sl@0	1633	(char *) NULL);
sl@0	1634	}
sl@0	1635	return -1;
sl@0	1636	}
sl@0	1637	if (string[1] == '+') {
sl@0	1638	mode &= ~(O_RDONLY\|O_WRONLY);
sl@0	1639	mode \|= O_RDWR;
sl@0	1640	if (string[2] != 0) {
sl@0	1641	goto error;
sl@0	1642	}
sl@0	1643	} else if (string[1] != 0) {
sl@0	1644	goto error;
sl@0	1645	}
sl@0	1646	return mode;
sl@0	1647	}
sl@0	1648
sl@0	1649	/*
sl@0	1650	* The access modes are specified using a list of POSIX modes
sl@0	1651	* such as O_CREAT.
sl@0	1652	*
sl@0	1653	* IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when
sl@0	1654	* a NULL interpreter is passed in.
sl@0	1655	*/
sl@0	1656
sl@0	1657	if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
sl@0	1658	if (interp != (Tcl_Interp *) NULL) {
sl@0	1659	Tcl_AddErrorInfo(interp,
sl@0	1660	"\n while processing open access modes \"");
sl@0	1661	Tcl_AddErrorInfo(interp, string);
sl@0	1662	Tcl_AddErrorInfo(interp, "\"");
sl@0	1663	}
sl@0	1664	return -1;
sl@0	1665	}
sl@0	1666
sl@0	1667	gotRW = 0;
sl@0	1668	for (i = 0; i < modeArgc; i++) {
sl@0	1669	flag = modeArgv[i];
sl@0	1670	c = flag[0];
sl@0	1671	if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
sl@0	1672	mode = (mode & ~RW_MODES) \| O_RDONLY;
sl@0	1673	gotRW = 1;
sl@0	1674	} else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
sl@0	1675	mode = (mode & ~RW_MODES) \| O_WRONLY;
sl@0	1676	gotRW = 1;
sl@0	1677	} else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
sl@0	1678	mode = (mode & ~RW_MODES) \| O_RDWR;
sl@0	1679	gotRW = 1;
sl@0	1680	} else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
sl@0	1681	mode \|= O_APPEND;
sl@0	1682	*seekFlagPtr = 1;
sl@0	1683	} else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
sl@0	1684	mode \|= O_CREAT;
sl@0	1685	} else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
sl@0	1686	mode \|= O_EXCL;
sl@0	1687	} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
sl@0	1688	#ifdef O_NOCTTY
sl@0	1689	mode \|= O_NOCTTY;
sl@0	1690	#else
sl@0	1691	if (interp != (Tcl_Interp *) NULL) {
sl@0	1692	Tcl_AppendResult(interp, "access mode \"", flag,
sl@0	1693	"\" not supported by this system", (char *) NULL);
sl@0	1694	}
sl@0	1695	ckfree((char *) modeArgv);
sl@0	1696	return -1;
sl@0	1697	#endif
sl@0	1698	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
sl@0	1699	#if defined(O_NDELAY) \|\| defined(O_NONBLOCK)
sl@0	1700	# ifdef O_NONBLOCK
sl@0	1701	mode \|= O_NONBLOCK;
sl@0	1702	# else
sl@0	1703	mode \|= O_NDELAY;
sl@0	1704	# endif
sl@0	1705	#else
sl@0	1706	if (interp != (Tcl_Interp *) NULL) {
sl@0	1707	Tcl_AppendResult(interp, "access mode \"", flag,
sl@0	1708	"\" not supported by this system", (char *) NULL);
sl@0	1709	}
sl@0	1710	ckfree((char *) modeArgv);
sl@0	1711	return -1;
sl@0	1712	#endif
sl@0	1713	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
sl@0	1714	mode \|= O_TRUNC;
sl@0	1715	} else {
sl@0	1716	if (interp != (Tcl_Interp *) NULL) {
sl@0	1717	Tcl_AppendResult(interp, "invalid access mode \"", flag,
sl@0	1718	"\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
sl@0	1719	" EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
sl@0	1720	}
sl@0	1721	ckfree((char *) modeArgv);
sl@0	1722	return -1;
sl@0	1723	}
sl@0	1724	}
sl@0	1725	ckfree((char *) modeArgv);
sl@0	1726	if (!gotRW) {
sl@0	1727	if (interp != (Tcl_Interp *) NULL) {
sl@0	1728	Tcl_AppendResult(interp, "access mode must include either",
sl@0	1729	" RDONLY, WRONLY, or RDWR", (char *) NULL);
sl@0	1730	}
sl@0	1731	return -1;
sl@0	1732	}
sl@0	1733	return mode;
sl@0	1734	}
sl@0	1735
sl@0	1736	/*
sl@0	1737	*----------------------------------------------------------------------
sl@0	1738	*
sl@0	1739	* Tcl_FSEvalFile --
sl@0	1740	*
sl@0	1741	* Read in a file and process the entire file as one gigantic
sl@0	1742	* Tcl command.
sl@0	1743	*
sl@0	1744	* Results:
sl@0	1745	* A standard Tcl result, which is either the result of executing
sl@0	1746	* the file or an error indicating why the file couldn't be read.
sl@0	1747	*
sl@0	1748	* Side effects:
sl@0	1749	* Depends on the commands in the file. During the evaluation
sl@0	1750	* of the contents of the file, iPtr->scriptFile is made to
sl@0	1751	* point to pathPtr (the old value is cached and replaced when
sl@0	1752	* this function returns).
sl@0	1753	*
sl@0	1754	*----------------------------------------------------------------------
sl@0	1755	*/
sl@0	1756
sl@0	1757	EXPORT_C int
sl@0	1758	Tcl_FSEvalFile(interp, pathPtr)
sl@0	1759	Tcl_Interp interp; / Interpreter in which to process file. */
sl@0	1760	Tcl_Obj pathPtr; / Path of file to process. Tilde-substitution
sl@0	1761	* will be performed on this name. */
sl@0	1762	{
sl@0	1763	int result, length;
sl@0	1764	Tcl_StatBuf statBuf;
sl@0	1765	Tcl_Obj *oldScriptFile;
sl@0	1766	Interp *iPtr;
sl@0	1767	char *string;
sl@0	1768	Tcl_Channel chan;
sl@0	1769	Tcl_Obj *objPtr;
sl@0	1770
sl@0	1771	if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
sl@0	1772	return TCL_ERROR;
sl@0	1773	}
sl@0	1774
sl@0	1775	result = TCL_ERROR;
sl@0	1776	objPtr = Tcl_NewObj();
sl@0	1777	Tcl_IncrRefCount(objPtr);
sl@0	1778
sl@0	1779	if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
sl@0	1780	Tcl_SetErrno(errno);
sl@0	1781	Tcl_AppendResult(interp, "couldn't read file \"",
sl@0	1782	Tcl_GetString(pathPtr),
sl@0	1783	"\": ", Tcl_PosixError(interp), (char *) NULL);
sl@0	1784	goto end;
sl@0	1785	}
sl@0	1786	chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
sl@0	1787	if (chan == (Tcl_Channel) NULL) {
sl@0	1788	Tcl_ResetResult(interp);
sl@0	1789	Tcl_AppendResult(interp, "couldn't read file \"",
sl@0	1790	Tcl_GetString(pathPtr),
sl@0	1791	"\": ", Tcl_PosixError(interp), (char *) NULL);
sl@0	1792	goto end;
sl@0	1793	}
sl@0	1794	/*
sl@0	1795	* The eofchar is \32 (^Z). This is the usual on Windows, but we
sl@0	1796	* effect this cross-platform to allow for scripted documents.
sl@0	1797	* [Bug: 2040]
sl@0	1798	*/
sl@0	1799	Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
sl@0	1800	if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {
sl@0	1801	Tcl_Close(interp, chan);
sl@0	1802	Tcl_AppendResult(interp, "couldn't read file \"",
sl@0	1803	Tcl_GetString(pathPtr),
sl@0	1804	"\": ", Tcl_PosixError(interp), (char *) NULL);
sl@0	1805	goto end;
sl@0	1806	}
sl@0	1807	if (Tcl_Close(interp, chan) != TCL_OK) {
sl@0	1808	goto end;
sl@0	1809	}
sl@0	1810
sl@0	1811	iPtr = (Interp *) interp;
sl@0	1812	oldScriptFile = iPtr->scriptFile;
sl@0	1813	iPtr->scriptFile = pathPtr;
sl@0	1814	Tcl_IncrRefCount(iPtr->scriptFile);
sl@0	1815	string = Tcl_GetStringFromObj(objPtr, &length);
sl@0	1816
sl@0	1817	#ifdef TCL_TIP280
sl@0	1818	/* TIP #280 Force the evaluator to open a frame for a sourced
sl@0	1819	* file. */
sl@0	1820	iPtr->evalFlags \|= TCL_EVAL_FILE;
sl@0	1821	#endif
sl@0	1822	result = Tcl_EvalEx(interp, string, length, 0);
sl@0	1823	/*
sl@0	1824	* Now we have to be careful; the script may have changed the
sl@0	1825	* iPtr->scriptFile value, so we must reset it without
sl@0	1826	* assuming it still points to 'pathPtr'.
sl@0	1827	*/
sl@0	1828	if (iPtr->scriptFile != NULL) {
sl@0	1829	Tcl_DecrRefCount(iPtr->scriptFile);
sl@0	1830	}
sl@0	1831	iPtr->scriptFile = oldScriptFile;
sl@0	1832
sl@0	1833	if (result == TCL_RETURN) {
sl@0	1834	result = TclUpdateReturnInfo(iPtr);
sl@0	1835	} else if (result == TCL_ERROR) {
sl@0	1836	char msg[200 + TCL_INTEGER_SPACE];
sl@0	1837
sl@0	1838	/*
sl@0	1839	* Record information telling where the error occurred.
sl@0	1840	*/
sl@0	1841
sl@0	1842	sprintf(msg, "\n (file \"%.150s\" line %d)", Tcl_GetString(pathPtr),
sl@0	1843	interp->errorLine);
sl@0	1844	Tcl_AddErrorInfo(interp, msg);
sl@0	1845	}
sl@0	1846
sl@0	1847	end:
sl@0	1848	Tcl_DecrRefCount(objPtr);
sl@0	1849	return result;
sl@0	1850	}
sl@0	1851
sl@0	1852	/*
sl@0	1853	*----------------------------------------------------------------------
sl@0	1854	*
sl@0	1855	* Tcl_GetErrno --
sl@0	1856	*
sl@0	1857	* Gets the current value of the Tcl error code variable. This is
sl@0	1858	* currently the global variable "errno" but could in the future
sl@0	1859	* change to something else.
sl@0	1860	*
sl@0	1861	* Results:
sl@0	1862	* The value of the Tcl error code variable.
sl@0	1863	*
sl@0	1864	* Side effects:
sl@0	1865	* None. Note that the value of the Tcl error code variable is
sl@0	1866	* UNDEFINED if a call to Tcl_SetErrno did not precede this call.
sl@0	1867	*
sl@0	1868	*----------------------------------------------------------------------
sl@0	1869	*/
sl@0	1870
sl@0	1871	EXPORT_C int
sl@0	1872	Tcl_GetErrno()
sl@0	1873	{
sl@0	1874	return errno;
sl@0	1875	}
sl@0	1876
sl@0	1877	/*
sl@0	1878	*----------------------------------------------------------------------
sl@0	1879	*
sl@0	1880	* Tcl_SetErrno --
sl@0	1881	*
sl@0	1882	* Sets the Tcl error code variable to the supplied value.
sl@0	1883	*
sl@0	1884	* Results:
sl@0	1885	* None.
sl@0	1886	*
sl@0	1887	* Side effects:
sl@0	1888	* Modifies the value of the Tcl error code variable.
sl@0	1889	*
sl@0	1890	*----------------------------------------------------------------------
sl@0	1891	*/
sl@0	1892
sl@0	1893	EXPORT_C void
sl@0	1894	Tcl_SetErrno(err)
sl@0	1895	int err; /* The new value. */
sl@0	1896	{
sl@0	1897	errno = err;
sl@0	1898	}
sl@0	1899
sl@0	1900	/*
sl@0	1901	*----------------------------------------------------------------------
sl@0	1902	*
sl@0	1903	* Tcl_PosixError --
sl@0	1904	*
sl@0	1905	* This procedure is typically called after UNIX kernel calls
sl@0	1906	* return errors. It stores machine-readable information about
sl@0	1907	* the error in $errorCode returns an information string for
sl@0	1908	* the caller's use.
sl@0	1909	*
sl@0	1910	* Results:
sl@0	1911	* The return value is a human-readable string describing the
sl@0	1912	* error.
sl@0	1913	*
sl@0	1914	* Side effects:
sl@0	1915	* The global variable $errorCode is reset.
sl@0	1916	*
sl@0	1917	*----------------------------------------------------------------------
sl@0	1918	*/
sl@0	1919
sl@0	1920	EXPORT_C CONST char *
sl@0	1921	Tcl_PosixError(interp)
sl@0	1922	Tcl_Interp interp; / Interpreter whose $errorCode variable
sl@0	1923	* is to be changed. */
sl@0	1924	{
sl@0	1925	CONST char id, msg;
sl@0	1926
sl@0	1927	msg = Tcl_ErrnoMsg(errno);
sl@0	1928	id = Tcl_ErrnoId();
sl@0	1929	if (interp) {
sl@0	1930	Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
sl@0	1931	}
sl@0	1932	return msg;
sl@0	1933	}
sl@0	1934
sl@0	1935	/*
sl@0	1936	*----------------------------------------------------------------------
sl@0	1937	*
sl@0	1938	* Tcl_FSStat --
sl@0	1939	*
sl@0	1940	* This procedure replaces the library version of stat and lsat.
sl@0	1941	*
sl@0	1942	* The appropriate function for the filesystem to which pathPtr
sl@0	1943	* belongs will be called.
sl@0	1944	*
sl@0	1945	* Results:
sl@0	1946	* See stat documentation.
sl@0	1947	*
sl@0	1948	* Side effects:
sl@0	1949	* See stat documentation.
sl@0	1950	*
sl@0	1951	*----------------------------------------------------------------------
sl@0	1952	*/
sl@0	1953
sl@0	1954	EXPORT_C int
sl@0	1955	Tcl_FSStat(pathPtr, buf)
sl@0	1956	Tcl_Obj pathPtr; / Path of file to stat (in current CP). */
sl@0	1957	Tcl_StatBuf buf; / Filled with results of stat call. */
sl@0	1958	{
sl@0	1959	Tcl_Filesystem *fsPtr;
sl@0	1960	#ifdef USE_OBSOLETE_FS_HOOKS
sl@0	1961	struct stat oldStyleStatBuffer;
sl@0	1962	int retVal = -1;
sl@0	1963
sl@0	1964	/*
sl@0	1965	* Call each of the "stat" function in succession. A non-return
sl@0	1966	* value of -1 indicates the particular function has succeeded.
sl@0	1967	*/
sl@0	1968
sl@0	1969	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	1970
sl@0	1971	if (statProcList != NULL) {
sl@0	1972	StatProc *statProcPtr;
sl@0	1973	char *path;
sl@0	1974	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
sl@0	1975	if (transPtr == NULL) {
sl@0	1976	path = NULL;
sl@0	1977	} else {
sl@0	1978	path = Tcl_GetString(transPtr);
sl@0	1979	}
sl@0	1980
sl@0	1981	statProcPtr = statProcList;
sl@0	1982	while ((retVal == -1) && (statProcPtr != NULL)) {
sl@0	1983	retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
sl@0	1984	statProcPtr = statProcPtr->nextPtr;
sl@0	1985	}
sl@0	1986	if (transPtr != NULL) {
sl@0	1987	Tcl_DecrRefCount(transPtr);
sl@0	1988	}
sl@0	1989	}
sl@0	1990
sl@0	1991	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	1992	if (retVal != -1) {
sl@0	1993	/*
sl@0	1994	* Note that EOVERFLOW is not a problem here, and these
sl@0	1995	* assignments should all be widening (if not identity.)
sl@0	1996	*/
sl@0	1997	buf->st_mode = oldStyleStatBuffer.st_mode;
sl@0	1998	buf->st_ino = oldStyleStatBuffer.st_ino;
sl@0	1999	buf->st_dev = oldStyleStatBuffer.st_dev;
sl@0	2000	buf->st_rdev = oldStyleStatBuffer.st_rdev;
sl@0	2001	buf->st_nlink = oldStyleStatBuffer.st_nlink;
sl@0	2002	buf->st_uid = oldStyleStatBuffer.st_uid;
sl@0	2003	buf->st_gid = oldStyleStatBuffer.st_gid;
sl@0	2004	buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size);
sl@0	2005	buf->st_atime = oldStyleStatBuffer.st_atime;
sl@0	2006	buf->st_mtime = oldStyleStatBuffer.st_mtime;
sl@0	2007	buf->st_ctime = oldStyleStatBuffer.st_ctime;
sl@0	2008	#ifdef HAVE_ST_BLOCKS
sl@0	2009	buf->st_blksize = oldStyleStatBuffer.st_blksize;
sl@0	2010	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
sl@0	2011	#endif
sl@0	2012	return retVal;
sl@0	2013	}
sl@0	2014	#endif /* USE_OBSOLETE_FS_HOOKS */
sl@0	2015	fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2016	if (fsPtr != NULL) {
sl@0	2017	Tcl_FSStatProc *proc = fsPtr->statProc;
sl@0	2018	if (proc != NULL) {
sl@0	2019	return (*proc)(pathPtr, buf);
sl@0	2020	}
sl@0	2021	}
sl@0	2022	Tcl_SetErrno(ENOENT);
sl@0	2023	return -1;
sl@0	2024	}
sl@0	2025
sl@0	2026	/*
sl@0	2027	*----------------------------------------------------------------------
sl@0	2028	*
sl@0	2029	* Tcl_FSLstat --
sl@0	2030	*
sl@0	2031	* This procedure replaces the library version of lstat.
sl@0	2032	* The appropriate function for the filesystem to which pathPtr
sl@0	2033	* belongs will be called. If no 'lstat' function is listed,
sl@0	2034	* but a 'stat' function is, then Tcl will fall back on the
sl@0	2035	* stat function.
sl@0	2036	*
sl@0	2037	* Results:
sl@0	2038	* See lstat documentation.
sl@0	2039	*
sl@0	2040	* Side effects:
sl@0	2041	* See lstat documentation.
sl@0	2042	*
sl@0	2043	*----------------------------------------------------------------------
sl@0	2044	*/
sl@0	2045
sl@0	2046	EXPORT_C int
sl@0	2047	Tcl_FSLstat(pathPtr, buf)
sl@0	2048	Tcl_Obj pathPtr; / Path of file to stat (in current CP). */
sl@0	2049	Tcl_StatBuf buf; / Filled with results of stat call. */
sl@0	2050	{
sl@0	2051	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2052	if (fsPtr != NULL) {
sl@0	2053	Tcl_FSLstatProc *proc = fsPtr->lstatProc;
sl@0	2054	if (proc != NULL) {
sl@0	2055	return (*proc)(pathPtr, buf);
sl@0	2056	} else {
sl@0	2057	Tcl_FSStatProc *sproc = fsPtr->statProc;
sl@0	2058	if (sproc != NULL) {
sl@0	2059	return (*sproc)(pathPtr, buf);
sl@0	2060	}
sl@0	2061	}
sl@0	2062	}
sl@0	2063	Tcl_SetErrno(ENOENT);
sl@0	2064	return -1;
sl@0	2065	}
sl@0	2066
sl@0	2067	/*
sl@0	2068	*----------------------------------------------------------------------
sl@0	2069	*
sl@0	2070	* Tcl_FSAccess --
sl@0	2071	*
sl@0	2072	* This procedure replaces the library version of access.
sl@0	2073	* The appropriate function for the filesystem to which pathPtr
sl@0	2074	* belongs will be called.
sl@0	2075	*
sl@0	2076	* Results:
sl@0	2077	* See access documentation.
sl@0	2078	*
sl@0	2079	* Side effects:
sl@0	2080	* See access documentation.
sl@0	2081	*
sl@0	2082	*----------------------------------------------------------------------
sl@0	2083	*/
sl@0	2084
sl@0	2085	EXPORT_C int
sl@0	2086	Tcl_FSAccess(pathPtr, mode)
sl@0	2087	Tcl_Obj pathPtr; / Path of file to access (in current CP). */
sl@0	2088	int mode; /* Permission setting. */
sl@0	2089	{
sl@0	2090	Tcl_Filesystem *fsPtr;
sl@0	2091	#ifdef USE_OBSOLETE_FS_HOOKS
sl@0	2092	int retVal = -1;
sl@0	2093
sl@0	2094	/*
sl@0	2095	* Call each of the "access" function in succession. A non-return
sl@0	2096	* value of -1 indicates the particular function has succeeded.
sl@0	2097	*/
sl@0	2098
sl@0	2099	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	2100
sl@0	2101	if (accessProcList != NULL) {
sl@0	2102	AccessProc *accessProcPtr;
sl@0	2103	char *path;
sl@0	2104	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
sl@0	2105	if (transPtr == NULL) {
sl@0	2106	path = NULL;
sl@0	2107	} else {
sl@0	2108	path = Tcl_GetString(transPtr);
sl@0	2109	}
sl@0	2110
sl@0	2111	accessProcPtr = accessProcList;
sl@0	2112	while ((retVal == -1) && (accessProcPtr != NULL)) {
sl@0	2113	retVal = (*accessProcPtr->proc)(path, mode);
sl@0	2114	accessProcPtr = accessProcPtr->nextPtr;
sl@0	2115	}
sl@0	2116	if (transPtr != NULL) {
sl@0	2117	Tcl_DecrRefCount(transPtr);
sl@0	2118	}
sl@0	2119	}
sl@0	2120
sl@0	2121	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	2122	if (retVal != -1) {
sl@0	2123	return retVal;
sl@0	2124	}
sl@0	2125	#endif /* USE_OBSOLETE_FS_HOOKS */
sl@0	2126	fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2127	if (fsPtr != NULL) {
sl@0	2128	Tcl_FSAccessProc *proc = fsPtr->accessProc;
sl@0	2129	if (proc != NULL) {
sl@0	2130	return (*proc)(pathPtr, mode);
sl@0	2131	}
sl@0	2132	}
sl@0	2133
sl@0	2134	Tcl_SetErrno(ENOENT);
sl@0	2135	return -1;
sl@0	2136	}
sl@0	2137
sl@0	2138	/*
sl@0	2139	*----------------------------------------------------------------------
sl@0	2140	*
sl@0	2141	* Tcl_FSOpenFileChannel --
sl@0	2142	*
sl@0	2143	* The appropriate function for the filesystem to which pathPtr
sl@0	2144	* belongs will be called.
sl@0	2145	*
sl@0	2146	* Results:
sl@0	2147	* The new channel or NULL, if the named file could not be opened.
sl@0	2148	*
sl@0	2149	* Side effects:
sl@0	2150	* May open the channel and may cause creation of a file on the
sl@0	2151	* file system.
sl@0	2152	*
sl@0	2153	*----------------------------------------------------------------------
sl@0	2154	*/
sl@0	2155
sl@0	2156	EXPORT_C Tcl_Channel
sl@0	2157	Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
sl@0	2158	Tcl_Interp interp; / Interpreter for error reporting;
sl@0	2159	* can be NULL. */
sl@0	2160	Tcl_Obj pathPtr; / Name of file to open. */
sl@0	2161	CONST char modeString; / A list of POSIX open modes or
sl@0	2162	* a string such as "rw". */
sl@0	2163	int permissions; /* If the open involves creating a
sl@0	2164	* file, with what modes to create
sl@0	2165	* it? */
sl@0	2166	{
sl@0	2167	Tcl_Filesystem *fsPtr;
sl@0	2168	#ifdef USE_OBSOLETE_FS_HOOKS
sl@0	2169	Tcl_Channel retVal = NULL;
sl@0	2170
sl@0	2171	/*
sl@0	2172	* Call each of the "Tcl_OpenFileChannel" functions in succession.
sl@0	2173	* A non-NULL return value indicates the particular function has
sl@0	2174	* succeeded.
sl@0	2175	*/
sl@0	2176
sl@0	2177	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	2178	if (openFileChannelProcList != NULL) {
sl@0	2179	OpenFileChannelProc *openFileChannelProcPtr;
sl@0	2180	char *path;
sl@0	2181	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
sl@0	2182
sl@0	2183	if (transPtr == NULL) {
sl@0	2184	path = NULL;
sl@0	2185	} else {
sl@0	2186	path = Tcl_GetString(transPtr);
sl@0	2187	}
sl@0	2188
sl@0	2189	openFileChannelProcPtr = openFileChannelProcList;
sl@0	2190
sl@0	2191	while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
sl@0	2192	retVal = (*openFileChannelProcPtr->proc)(interp, path,
sl@0	2193	modeString, permissions);
sl@0	2194	openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
sl@0	2195	}
sl@0	2196	if (transPtr != NULL) {
sl@0	2197	Tcl_DecrRefCount(transPtr);
sl@0	2198	}
sl@0	2199	}
sl@0	2200	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	2201	if (retVal != NULL) {
sl@0	2202	return retVal;
sl@0	2203	}
sl@0	2204	#endif /* USE_OBSOLETE_FS_HOOKS */
sl@0	2205
sl@0	2206	/*
sl@0	2207	* We need this just to ensure we return the correct error messages
sl@0	2208	* under some circumstances.
sl@0	2209	*/
sl@0	2210	if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
sl@0	2211	return NULL;
sl@0	2212	}
sl@0	2213
sl@0	2214	fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2215	if (fsPtr != NULL) {
sl@0	2216	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
sl@0	2217	if (proc != NULL) {
sl@0	2218	int mode, seekFlag;
sl@0	2219	mode = TclGetOpenMode(interp, modeString, &seekFlag);
sl@0	2220	if (mode == -1) {
sl@0	2221	return NULL;
sl@0	2222	}
sl@0	2223	retVal = (*proc)(interp, pathPtr, mode, permissions);
sl@0	2224	if (retVal != NULL) {
sl@0	2225	if (seekFlag) {
sl@0	2226	if (Tcl_Seek(retVal, (Tcl_WideInt)0,
sl@0	2227	SEEK_END) < (Tcl_WideInt)0) {
sl@0	2228	if (interp != (Tcl_Interp *) NULL) {
sl@0	2229	Tcl_AppendResult(interp,
sl@0	2230	"could not seek to end of file while opening \"",
sl@0	2231	Tcl_GetString(pathPtr), "\": ",
sl@0	2232	Tcl_PosixError(interp), (char *) NULL);
sl@0	2233	}
sl@0	2234	Tcl_Close(NULL, retVal);
sl@0	2235	return NULL;
sl@0	2236	}
sl@0	2237	}
sl@0	2238	}
sl@0	2239	return retVal;
sl@0	2240	}
sl@0	2241	}
sl@0	2242	/* File doesn't belong to any filesystem that can open it */
sl@0	2243	Tcl_SetErrno(ENOENT);
sl@0	2244	if (interp != NULL) {
sl@0	2245	Tcl_AppendResult(interp, "couldn't open \"",
sl@0	2246	Tcl_GetString(pathPtr), "\": ",
sl@0	2247	Tcl_PosixError(interp), (char *) NULL);
sl@0	2248	}
sl@0	2249	return NULL;
sl@0	2250	}
sl@0	2251
sl@0	2252	/*
sl@0	2253	*----------------------------------------------------------------------
sl@0	2254	*
sl@0	2255	* Tcl_FSUtime --
sl@0	2256	*
sl@0	2257	* This procedure replaces the library version of utime.
sl@0	2258	* The appropriate function for the filesystem to which pathPtr
sl@0	2259	* belongs will be called.
sl@0	2260	*
sl@0	2261	* Results:
sl@0	2262	* See utime documentation.
sl@0	2263	*
sl@0	2264	* Side effects:
sl@0	2265	* See utime documentation.
sl@0	2266	*
sl@0	2267	*----------------------------------------------------------------------
sl@0	2268	*/
sl@0	2269
sl@0	2270	EXPORT_C int
sl@0	2271	Tcl_FSUtime (pathPtr, tval)
sl@0	2272	Tcl_Obj pathPtr; / File to change access/modification times */
sl@0	2273	struct utimbuf tval; / Structure containing access/modification
sl@0	2274	* times to use. Should not be modified. */
sl@0	2275	{
sl@0	2276	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2277	if (fsPtr != NULL) {
sl@0	2278	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
sl@0	2279	if (proc != NULL) {
sl@0	2280	return (*proc)(pathPtr, tval);
sl@0	2281	}
sl@0	2282	}
sl@0	2283	return -1;
sl@0	2284	}
sl@0	2285
sl@0	2286	/*
sl@0	2287	*----------------------------------------------------------------------
sl@0	2288	*
sl@0	2289	* NativeFileAttrStrings --
sl@0	2290	*
sl@0	2291	* This procedure implements the platform dependent 'file
sl@0	2292	* attributes' subcommand, for the native filesystem, for listing
sl@0	2293	* the set of possible attribute strings. This function is part
sl@0	2294	* of Tcl's native filesystem support, and is placed here because
sl@0	2295	* it is shared by Unix, MacOS and Windows code.
sl@0	2296	*
sl@0	2297	* Results:
sl@0	2298	* An array of strings
sl@0	2299	*
sl@0	2300	* Side effects:
sl@0	2301	* None.
sl@0	2302	*
sl@0	2303	*----------------------------------------------------------------------
sl@0	2304	*/
sl@0	2305
sl@0	2306	static CONST char**
sl@0	2307	NativeFileAttrStrings(pathPtr, objPtrRef)
sl@0	2308	Tcl_Obj *pathPtr;
sl@0	2309	Tcl_Obj** objPtrRef;
sl@0	2310	{
sl@0	2311	return tclpFileAttrStrings;
sl@0	2312	}
sl@0	2313
sl@0	2314	/*
sl@0	2315	*----------------------------------------------------------------------
sl@0	2316	*
sl@0	2317	* NativeFileAttrsGet --
sl@0	2318	*
sl@0	2319	* This procedure implements the platform dependent
sl@0	2320	* 'file attributes' subcommand, for the native
sl@0	2321	* filesystem, for 'get' operations. This function is part
sl@0	2322	* of Tcl's native filesystem support, and is placed here
sl@0	2323	* because it is shared by Unix, MacOS and Windows code.
sl@0	2324	*
sl@0	2325	* Results:
sl@0	2326	* Standard Tcl return code. The object placed in objPtrRef
sl@0	2327	* (if TCL_OK was returned) is likely to have a refCount of zero.
sl@0	2328	* Either way we must either store it somewhere (e.g. the Tcl
sl@0	2329	* result), or Incr/Decr its refCount to ensure it is properly
sl@0	2330	* freed.
sl@0	2331	*
sl@0	2332	* Side effects:
sl@0	2333	* None.
sl@0	2334	*
sl@0	2335	*----------------------------------------------------------------------
sl@0	2336	*/
sl@0	2337
sl@0	2338	static int
sl@0	2339	NativeFileAttrsGet(interp, index, pathPtr, objPtrRef)
sl@0	2340	Tcl_Interp interp; / The interpreter for error reporting. */
sl@0	2341	int index; /* index of the attribute command. */
sl@0	2342	Tcl_Obj pathPtr; / path of file we are operating on. */
sl@0	2343	Tcl_Obj *objPtrRef; / for output. */
sl@0	2344	{
sl@0	2345	return (*tclpFileAttrProcs[index].getProc)(interp, index,
sl@0	2346	pathPtr, objPtrRef);
sl@0	2347	}
sl@0	2348
sl@0	2349	/*
sl@0	2350	*----------------------------------------------------------------------
sl@0	2351	*
sl@0	2352	* NativeFileAttrsSet --
sl@0	2353	*
sl@0	2354	* This procedure implements the platform dependent
sl@0	2355	* 'file attributes' subcommand, for the native
sl@0	2356	* filesystem, for 'set' operations. This function is part
sl@0	2357	* of Tcl's native filesystem support, and is placed here
sl@0	2358	* because it is shared by Unix, MacOS and Windows code.
sl@0	2359	*
sl@0	2360	* Results:
sl@0	2361	* Standard Tcl return code.
sl@0	2362	*
sl@0	2363	* Side effects:
sl@0	2364	* None.
sl@0	2365	*
sl@0	2366	*----------------------------------------------------------------------
sl@0	2367	*/
sl@0	2368
sl@0	2369	static int
sl@0	2370	NativeFileAttrsSet(interp, index, pathPtr, objPtr)
sl@0	2371	Tcl_Interp interp; / The interpreter for error reporting. */
sl@0	2372	int index; /* index of the attribute command. */
sl@0	2373	Tcl_Obj pathPtr; / path of file we are operating on. */
sl@0	2374	Tcl_Obj objPtr; / set to this value. */
sl@0	2375	{
sl@0	2376	return (*tclpFileAttrProcs[index].setProc)(interp, index,
sl@0	2377	pathPtr, objPtr);
sl@0	2378	}
sl@0	2379
sl@0	2380	/*
sl@0	2381	*----------------------------------------------------------------------
sl@0	2382	*
sl@0	2383	* Tcl_FSFileAttrStrings --
sl@0	2384	*
sl@0	2385	* This procedure implements part of the hookable 'file
sl@0	2386	* attributes' subcommand. The appropriate function for the
sl@0	2387	* filesystem to which pathPtr belongs will be called.
sl@0	2388	*
sl@0	2389	* Results:
sl@0	2390	* The called procedure may either return an array of strings,
sl@0	2391	* or may instead return NULL and place a Tcl list into the
sl@0	2392	* given objPtrRef. Tcl will take that list and first increment
sl@0	2393	* its refCount before using it. On completion of that use, Tcl
sl@0	2394	* will decrement its refCount. Hence if the list should be
sl@0	2395	* disposed of by Tcl when done, it should have a refCount of zero,
sl@0	2396	* and if the list should not be disposed of, the filesystem
sl@0	2397	* should ensure it retains a refCount on the object.
sl@0	2398	*
sl@0	2399	* Side effects:
sl@0	2400	* None.
sl@0	2401	*
sl@0	2402	*----------------------------------------------------------------------
sl@0	2403	*/
sl@0	2404
sl@0	2405	EXPORT_C CONST char **
sl@0	2406	Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
sl@0	2407	Tcl_Obj* pathPtr;
sl@0	2408	Tcl_Obj** objPtrRef;
sl@0	2409	{
sl@0	2410	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2411	if (fsPtr != NULL) {
sl@0	2412	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
sl@0	2413	if (proc != NULL) {
sl@0	2414	return (*proc)(pathPtr, objPtrRef);
sl@0	2415	}
sl@0	2416	}
sl@0	2417	Tcl_SetErrno(ENOENT);
sl@0	2418	return NULL;
sl@0	2419	}
sl@0	2420
sl@0	2421	/*
sl@0	2422	*----------------------------------------------------------------------
sl@0	2423	*
sl@0	2424	* Tcl_FSFileAttrsGet --
sl@0	2425	*
sl@0	2426	* This procedure implements read access for the hookable 'file
sl@0	2427	* attributes' subcommand. The appropriate function for the
sl@0	2428	* filesystem to which pathPtr belongs will be called.
sl@0	2429	*
sl@0	2430	* Results:
sl@0	2431	* Standard Tcl return code. The object placed in objPtrRef
sl@0	2432	* (if TCL_OK was returned) is likely to have a refCount of zero.
sl@0	2433	* Either way we must either store it somewhere (e.g. the Tcl
sl@0	2434	* result), or Incr/Decr its refCount to ensure it is properly
sl@0	2435	* freed.
sl@0	2436
sl@0	2437	*
sl@0	2438	* Side effects:
sl@0	2439	* None.
sl@0	2440	*
sl@0	2441	*----------------------------------------------------------------------
sl@0	2442	*/
sl@0	2443
sl@0	2444	EXPORT_C int
sl@0	2445	Tcl_FSFileAttrsGet(interp, index, pathPtr, objPtrRef)
sl@0	2446	Tcl_Interp interp; / The interpreter for error reporting. */
sl@0	2447	int index; /* index of the attribute command. */
sl@0	2448	Tcl_Obj pathPtr; / filename we are operating on. */
sl@0	2449	Tcl_Obj *objPtrRef; / for output. */
sl@0	2450	{
sl@0	2451	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2452	if (fsPtr != NULL) {
sl@0	2453	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
sl@0	2454	if (proc != NULL) {
sl@0	2455	return (*proc)(interp, index, pathPtr, objPtrRef);
sl@0	2456	}
sl@0	2457	}
sl@0	2458	Tcl_SetErrno(ENOENT);
sl@0	2459	return -1;
sl@0	2460	}
sl@0	2461
sl@0	2462	/*
sl@0	2463	*----------------------------------------------------------------------
sl@0	2464	*
sl@0	2465	* Tcl_FSFileAttrsSet --
sl@0	2466	*
sl@0	2467	* This procedure implements write access for the hookable 'file
sl@0	2468	* attributes' subcommand. The appropriate function for the
sl@0	2469	* filesystem to which pathPtr belongs will be called.
sl@0	2470	*
sl@0	2471	* Results:
sl@0	2472	* Standard Tcl return code.
sl@0	2473	*
sl@0	2474	* Side effects:
sl@0	2475	* None.
sl@0	2476	*
sl@0	2477	*----------------------------------------------------------------------
sl@0	2478	*/
sl@0	2479
sl@0	2480	EXPORT_C int
sl@0	2481	Tcl_FSFileAttrsSet(interp, index, pathPtr, objPtr)
sl@0	2482	Tcl_Interp interp; / The interpreter for error reporting. */
sl@0	2483	int index; /* index of the attribute command. */
sl@0	2484	Tcl_Obj pathPtr; / filename we are operating on. */
sl@0	2485	Tcl_Obj objPtr; / Input value. */
sl@0	2486	{
sl@0	2487	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2488	if (fsPtr != NULL) {
sl@0	2489	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
sl@0	2490	if (proc != NULL) {
sl@0	2491	return (*proc)(interp, index, pathPtr, objPtr);
sl@0	2492	}
sl@0	2493	}
sl@0	2494	Tcl_SetErrno(ENOENT);
sl@0	2495	return -1;
sl@0	2496	}
sl@0	2497
sl@0	2498	/*
sl@0	2499	*----------------------------------------------------------------------
sl@0	2500	*
sl@0	2501	* Tcl_FSGetCwd --
sl@0	2502	*
sl@0	2503	* This function replaces the library version of getcwd().
sl@0	2504	*
sl@0	2505	* Most VFS's will not implement a 'cwdProc'. Tcl now maintains
sl@0	2506	* its own record (in a Tcl_Obj) of the cwd, and an attempt
sl@0	2507	* is made to synchronise this with the cwd's containing filesystem,
sl@0	2508	* if that filesystem provides a cwdProc (e.g. the native filesystem).
sl@0	2509	*
sl@0	2510	* Note that if Tcl's cwd is not in the native filesystem, then of
sl@0	2511	* course Tcl's cwd and the native cwd are different: extensions
sl@0	2512	* should therefore ensure they only access the cwd through this
sl@0	2513	* function to avoid confusion.
sl@0	2514	*
sl@0	2515	* If a global cwdPathPtr already exists, it is cached in the thread's
sl@0	2516	* private data structures and reference to the cached copy is returned,
sl@0	2517	* subject to a synchronisation attempt in that cwdPathPtr's fs.
sl@0	2518	*
sl@0	2519	* Otherwise, the chain of functions that have been "inserted"
sl@0	2520	* into the filesystem will be called in succession until either a
sl@0	2521	* value other than NULL is returned, or the entire list is
sl@0	2522	* visited.
sl@0	2523	*
sl@0	2524	* Results:
sl@0	2525	* The result is a pointer to a Tcl_Obj specifying the current
sl@0	2526	* directory, or NULL if the current directory could not be
sl@0	2527	* determined. If NULL is returned, an error message is left in the
sl@0	2528	* interp's result.
sl@0	2529	*
sl@0	2530	* The result already has its refCount incremented for the caller.
sl@0	2531	* When it is no longer needed, that refCount should be decremented.
sl@0	2532	*
sl@0	2533	* Side effects:
sl@0	2534	* Various objects may be freed and allocated.
sl@0	2535	*
sl@0	2536	*----------------------------------------------------------------------
sl@0	2537	*/
sl@0	2538
sl@0	2539	EXPORT_C Tcl_Obj*
sl@0	2540	Tcl_FSGetCwd(interp)
sl@0	2541	Tcl_Interp *interp;
sl@0	2542	{
sl@0	2543	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	2544
sl@0	2545	if (TclFSCwdPointerEquals(NULL)) {
sl@0	2546	FilesystemRecord *fsRecPtr;
sl@0	2547	Tcl_Obj *retVal = NULL;
sl@0	2548
sl@0	2549	/*
sl@0	2550	* We've never been called before, try to find a cwd. Call
sl@0	2551	* each of the "Tcl_GetCwd" function in succession. A non-NULL
sl@0	2552	* return value indicates the particular function has
sl@0	2553	* succeeded.
sl@0	2554	*/
sl@0	2555
sl@0	2556	fsRecPtr = FsGetFirstFilesystem();
sl@0	2557	while ((retVal == NULL) && (fsRecPtr != NULL)) {
sl@0	2558	Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
sl@0	2559	if (proc != NULL) {
sl@0	2560	retVal = (*proc)(interp);
sl@0	2561	}
sl@0	2562	fsRecPtr = fsRecPtr->nextPtr;
sl@0	2563	}
sl@0	2564	/*
sl@0	2565	* Now the 'cwd' may NOT be normalized, at least on some
sl@0	2566	* platforms. For the sake of efficiency, we want a completely
sl@0	2567	* normalized cwd at all times.
sl@0	2568	*
sl@0	2569	* Finally, if retVal is NULL, we do not have a cwd, which
sl@0	2570	* could be problematic.
sl@0	2571	*/
sl@0	2572	if (retVal != NULL) {
sl@0	2573	Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
sl@0	2574	if (norm != NULL) {
sl@0	2575	/*
sl@0	2576	* We found a cwd, which is now in our global storage.
sl@0	2577	* We must make a copy. Norm already has a refCount of 1.
sl@0	2578	*
sl@0	2579	* Threading issue: note that multiple threads at system
sl@0	2580	* startup could in principle call this procedure
sl@0	2581	* simultaneously. They will therefore each set the
sl@0	2582	* cwdPathPtr independently. That behaviour is a bit
sl@0	2583	* peculiar, but should be fine. Once we have a cwd,
sl@0	2584	* we'll always be in the 'else' branch below which
sl@0	2585	* is simpler.
sl@0	2586	*/
sl@0	2587	FsUpdateCwd(norm);
sl@0	2588	Tcl_DecrRefCount(norm);
sl@0	2589	}
sl@0	2590	Tcl_DecrRefCount(retVal);
sl@0	2591	}
sl@0	2592	} else {
sl@0	2593	/*
sl@0	2594	* We already have a cwd cached, but we want to give the
sl@0	2595	* filesystem it is in a chance to check whether that cwd
sl@0	2596	* has changed, or is perhaps no longer accessible. This
sl@0	2597	* allows an error to be thrown if, say, the permissions on
sl@0	2598	* that directory have changed.
sl@0	2599	*/
sl@0	2600	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
sl@0	2601	/*
sl@0	2602	* If the filesystem couldn't be found, or if no cwd function
sl@0	2603	* exists for this filesystem, then we simply assume the cached
sl@0	2604	* cwd is ok. If we do call a cwd, we must watch for errors
sl@0	2605	* (if the cwd returns NULL). This ensures that, say, on Unix
sl@0	2606	* if the permissions of the cwd change, 'pwd' does actually
sl@0	2607	* throw the correct error in Tcl. (This is tested for in the
sl@0	2608	* test suite on unix).
sl@0	2609	*/
sl@0	2610	if (fsPtr != NULL) {
sl@0	2611	Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
sl@0	2612	if (proc != NULL) {
sl@0	2613	Tcl_Obj retVal = (proc)(interp);
sl@0	2614	if (retVal != NULL) {
sl@0	2615	Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal, NULL);
sl@0	2616	/*
sl@0	2617	* Check whether cwd has changed from the value
sl@0	2618	* previously stored in cwdPathPtr. Really 'norm'
sl@0	2619	* shouldn't be null, but we are careful.
sl@0	2620	*/
sl@0	2621	if (norm == NULL) {
sl@0	2622	/* Do nothing */
sl@0	2623	} else if (Tcl_FSEqualPaths(tsdPtr->cwdPathPtr, norm)) {
sl@0	2624	/*
sl@0	2625	* If the paths were equal, we can be more
sl@0	2626	* efficient and retain the old path object
sl@0	2627	* which will probably already be shared. In
sl@0	2628	* this case we can simply free the normalized
sl@0	2629	* path we just calculated.
sl@0	2630	*/
sl@0	2631	Tcl_DecrRefCount(norm);
sl@0	2632	} else {
sl@0	2633	FsUpdateCwd(norm);
sl@0	2634	Tcl_DecrRefCount(norm);
sl@0	2635	}
sl@0	2636	Tcl_DecrRefCount(retVal);
sl@0	2637	} else {
sl@0	2638	/* The 'cwd' function returned an error; reset the cwd */
sl@0	2639	FsUpdateCwd(NULL);
sl@0	2640	}
sl@0	2641	}
sl@0	2642	}
sl@0	2643	}
sl@0	2644
sl@0	2645	if (tsdPtr->cwdPathPtr != NULL) {
sl@0	2646	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
sl@0	2647	}
sl@0	2648
sl@0	2649	return tsdPtr->cwdPathPtr;
sl@0	2650	}
sl@0	2651
sl@0	2652	/*
sl@0	2653	*----------------------------------------------------------------------
sl@0	2654	*
sl@0	2655	* Tcl_FSChdir --
sl@0	2656	*
sl@0	2657	* This function replaces the library version of chdir().
sl@0	2658	*
sl@0	2659	* The path is normalized and then passed to the filesystem
sl@0	2660	* which claims it.
sl@0	2661	*
sl@0	2662	* Results:
sl@0	2663	* See chdir() documentation. If successful, we keep a
sl@0	2664	* record of the successful path in cwdPathPtr for subsequent
sl@0	2665	* calls to getcwd.
sl@0	2666	*
sl@0	2667	* Side effects:
sl@0	2668	* See chdir() documentation. The global cwdPathPtr may
sl@0	2669	* change value.
sl@0	2670	*
sl@0	2671	*----------------------------------------------------------------------
sl@0	2672	*/
sl@0	2673	EXPORT_C int
sl@0	2674	Tcl_FSChdir(pathPtr)
sl@0	2675	Tcl_Obj *pathPtr;
sl@0	2676	{
sl@0	2677	Tcl_Filesystem *fsPtr;
sl@0	2678	int retVal = -1;
sl@0	2679
sl@0	2680	#ifdef WIN32
sl@0	2681	/*
sl@0	2682	* This complete hack addresses the bug tested in winFCmd-16.12,
sl@0	2683	* where having your HOME as "C:" (IOW, a seemingly path relative
sl@0	2684	* dir) would cause a crash when you cd'd to it and requested 'pwd'.
sl@0	2685	* The work-around is to force such a dir into an absolute path by
sl@0	2686	* tacking on '/'.
sl@0	2687	*
sl@0	2688	* We check for '~' specifically because that's what Tcl_CdObjCmd
sl@0	2689	* passes in that triggers the bug. A direct 'cd C:' call will not
sl@0	2690	* because that gets the volumerelative pwd.
sl@0	2691	*
sl@0	2692	* This is not an issue for 8.5 as that has a more elaborate change
sl@0	2693	* that requires the use of TCL_FILESYSTEM_VERSION_2.
sl@0	2694	*/
sl@0	2695	Tcl_Obj *objPtr = NULL;
sl@0	2696	if (pathPtr->bytes && pathPtr->length == 1 && pathPtr->bytes[0] == '~') {
sl@0	2697	int len;
sl@0	2698	char *str;
sl@0	2699
sl@0	2700	objPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
sl@0	2701	if (objPtr == NULL) {
sl@0	2702	Tcl_SetErrno(ENOENT);
sl@0	2703	return -1;
sl@0	2704	}
sl@0	2705	Tcl_IncrRefCount(objPtr);
sl@0	2706	str = Tcl_GetStringFromObj(objPtr, &len);
sl@0	2707	if (len == 2 && str[1] == ':') {
sl@0	2708	pathPtr = Tcl_NewStringObj(str, len);
sl@0	2709	Tcl_AppendToObj(pathPtr, "/", 1);
sl@0	2710	Tcl_IncrRefCount(pathPtr);
sl@0	2711	Tcl_DecrRefCount(objPtr);
sl@0	2712	objPtr = pathPtr;
sl@0	2713	} else {
sl@0	2714	Tcl_DecrRefCount(objPtr);
sl@0	2715	objPtr = NULL;
sl@0	2716	}
sl@0	2717	}
sl@0	2718	#endif
sl@0	2719	if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
sl@0	2720	#ifdef WIN32
sl@0	2721	if (objPtr) { Tcl_DecrRefCount(objPtr); }
sl@0	2722	#endif
sl@0	2723	Tcl_SetErrno(ENOENT);
sl@0	2724	return -1;
sl@0	2725	}
sl@0	2726
sl@0	2727	fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2728	if (fsPtr != NULL) {
sl@0	2729	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
sl@0	2730	if (proc != NULL) {
sl@0	2731	retVal = (*proc)(pathPtr);
sl@0	2732	} else {
sl@0	2733	/* Fallback on stat-based implementation */
sl@0	2734	Tcl_StatBuf buf;
sl@0	2735	/* If the file can be stat'ed and is a directory and
sl@0	2736	* is readable, then we can chdir. */
sl@0	2737	if ((Tcl_FSStat(pathPtr, &buf) == 0)
sl@0	2738	&& (S_ISDIR(buf.st_mode))
sl@0	2739	&& (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
sl@0	2740	/* We allow the chdir */
sl@0	2741	retVal = 0;
sl@0	2742	}
sl@0	2743	}
sl@0	2744	}
sl@0	2745
sl@0	2746	if (retVal != -1) {
sl@0	2747	/*
sl@0	2748	* The cwd changed, or an error was thrown. If an error was
sl@0	2749	* thrown, we can just continue (and that will report the error
sl@0	2750	* to the user). If there was no error we must assume that the
sl@0	2751	* cwd was actually changed to the normalized value we
sl@0	2752	* calculated above, and we must therefore cache that
sl@0	2753	* information.
sl@0	2754	*/
sl@0	2755	if (retVal == 0) {
sl@0	2756	/*
sl@0	2757	* Note that this normalized path may be different to what
sl@0	2758	* we found above (or at least a different object), if the
sl@0	2759	* filesystem epoch changed recently. This can actually
sl@0	2760	* happen with scripted documents very easily. Therefore
sl@0	2761	* we ask for the normalized path again (the correct value
sl@0	2762	* will have been cached as a result of the
sl@0	2763	* Tcl_FSGetFileSystemForPath call above anyway).
sl@0	2764	*/
sl@0	2765	Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);
sl@0	2766	if (normDirName == NULL) {
sl@0	2767	#ifdef WIN32
sl@0	2768	if (objPtr) { Tcl_DecrRefCount(objPtr); }
sl@0	2769	#endif
sl@0	2770	Tcl_SetErrno(ENOENT);
sl@0	2771	return -1;
sl@0	2772	}
sl@0	2773	FsUpdateCwd(normDirName);
sl@0	2774	}
sl@0	2775	} else {
sl@0	2776	Tcl_SetErrno(ENOENT);
sl@0	2777	}
sl@0	2778
sl@0	2779	#ifdef WIN32
sl@0	2780	if (objPtr) { Tcl_DecrRefCount(objPtr); }
sl@0	2781	#endif
sl@0	2782	return (retVal);
sl@0	2783	}
sl@0	2784
sl@0	2785	/*
sl@0	2786	*----------------------------------------------------------------------
sl@0	2787	*
sl@0	2788	* Tcl_FSLoadFile --
sl@0	2789	*
sl@0	2790	* Dynamically loads a binary code file into memory and returns
sl@0	2791	* the addresses of two procedures within that file, if they are
sl@0	2792	* defined. The appropriate function for the filesystem to which
sl@0	2793	* pathPtr belongs will be called.
sl@0	2794	*
sl@0	2795	* Note that the native filesystem doesn't actually assume
sl@0	2796	* 'pathPtr' is a path. Rather it assumes filename is either
sl@0	2797	* a path or just the name of a file which can be found somewhere
sl@0	2798	* in the environment's loadable path. This behaviour is not
sl@0	2799	* very compatible with virtual filesystems (and has other problems
sl@0	2800	* documented in the load man-page), so it is advised that full
sl@0	2801	* paths are always used.
sl@0	2802	*
sl@0	2803	* Results:
sl@0	2804	* A standard Tcl completion code. If an error occurs, an error
sl@0	2805	* message is left in the interp's result.
sl@0	2806	*
sl@0	2807	* Side effects:
sl@0	2808	* New code suddenly appears in memory. This may later be
sl@0	2809	* unloaded by passing the clientData to the unloadProc.
sl@0	2810	*
sl@0	2811	*----------------------------------------------------------------------
sl@0	2812	*/
sl@0	2813
sl@0	2814	EXPORT_C int
sl@0	2815	Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
sl@0	2816	handlePtr, unloadProcPtr)
sl@0	2817	Tcl_Interp interp; / Used for error reporting. */
sl@0	2818	Tcl_Obj pathPtr; / Name of the file containing the desired
sl@0	2819	* code. */
sl@0	2820	CONST char sym1, sym2; /* Names of two procedures to look up in
sl@0	2821	* the file's symbol table. */
sl@0	2822	Tcl_PackageInitProc proc1Ptr, proc2Ptr;
sl@0	2823	/* Where to return the addresses corresponding
sl@0	2824	* to sym1 and sym2. */
sl@0	2825	Tcl_LoadHandle handlePtr; / Filled with token for dynamically loaded
sl@0	2826	* file which will be passed back to
sl@0	2827	* (unloadProcPtr)() to unload the file. /
sl@0	2828	Tcl_FSUnloadFileProc **unloadProcPtr;
sl@0	2829	/* Filled with address of Tcl_FSUnloadFileProc
sl@0	2830	* function which should be used for
sl@0	2831	* this file. */
sl@0	2832	{
sl@0	2833	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	2834	if (fsPtr != NULL) {
sl@0	2835	Tcl_FSLoadFileProc *proc = fsPtr->loadFileProc;
sl@0	2836	if (proc != NULL) {
sl@0	2837	int retVal = (*proc)(interp, pathPtr, handlePtr, unloadProcPtr);
sl@0	2838	if (retVal != TCL_OK) {
sl@0	2839	return retVal;
sl@0	2840	}
sl@0	2841	if (*handlePtr == NULL) {
sl@0	2842	return TCL_ERROR;
sl@0	2843	}
sl@0	2844	if (sym1 != NULL) {
sl@0	2845	proc1Ptr = TclpFindSymbol(interp, handlePtr, sym1);
sl@0	2846	}
sl@0	2847	if (sym2 != NULL) {
sl@0	2848	proc2Ptr = TclpFindSymbol(interp, handlePtr, sym2);
sl@0	2849	}
sl@0	2850	return retVal;
sl@0	2851	} else {
sl@0	2852	Tcl_Filesystem *copyFsPtr;
sl@0	2853	Tcl_Obj *copyToPtr;
sl@0	2854
sl@0	2855	/* First check if it is readable -- and exists! */
sl@0	2856	if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
sl@0	2857	Tcl_AppendResult(interp, "couldn't load library \"",
sl@0	2858	Tcl_GetString(pathPtr), "\": ",
sl@0	2859	Tcl_PosixError(interp), (char *) NULL);
sl@0	2860	return TCL_ERROR;
sl@0	2861	}
sl@0	2862
sl@0	2863	#ifdef TCL_LOAD_FROM_MEMORY
sl@0	2864	/*
sl@0	2865	* The platform supports loading code from memory, so ask for a
sl@0	2866	* buffer of the appropriate size, read the file into it and
sl@0	2867	* load the code from the buffer:
sl@0	2868	*/
sl@0	2869	do {
sl@0	2870	int ret, size;
sl@0	2871	void *buffer;
sl@0	2872	Tcl_StatBuf statBuf;
sl@0	2873	Tcl_Channel data;
sl@0	2874
sl@0	2875	ret = Tcl_FSStat(pathPtr, &statBuf);
sl@0	2876	if (ret < 0) {
sl@0	2877	break;
sl@0	2878	}
sl@0	2879	size = (int) statBuf.st_size;
sl@0	2880	/* Tcl_Read takes an int: check that file size isn't wide */
sl@0	2881	if (size != (Tcl_WideInt)statBuf.st_size) {
sl@0	2882	break;
sl@0	2883	}
sl@0	2884	data = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0666);
sl@0	2885	if (!data) {
sl@0	2886	break;
sl@0	2887	}
sl@0	2888	buffer = TclpLoadMemoryGetBuffer(interp, size);
sl@0	2889	if (!buffer) {
sl@0	2890	Tcl_Close(interp, data);
sl@0	2891	break;
sl@0	2892	}
sl@0	2893	Tcl_SetChannelOption(interp, data, "-translation", "binary");
sl@0	2894	ret = Tcl_Read(data, buffer, size);
sl@0	2895	Tcl_Close(interp, data);
sl@0	2896	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr, unloadProcPtr);
sl@0	2897	if (ret == TCL_OK) {
sl@0	2898	if (*handlePtr == NULL) {
sl@0	2899	break;
sl@0	2900	}
sl@0	2901	if (sym1 != NULL) {
sl@0	2902	proc1Ptr = TclpFindSymbol(interp, handlePtr, sym1);
sl@0	2903	}
sl@0	2904	if (sym2 != NULL) {
sl@0	2905	proc2Ptr = TclpFindSymbol(interp, handlePtr, sym2);
sl@0	2906	}
sl@0	2907	return TCL_OK;
sl@0	2908	}
sl@0	2909	} while (0);
sl@0	2910	Tcl_ResetResult(interp);
sl@0	2911	#endif
sl@0	2912
sl@0	2913	/*
sl@0	2914	* Get a temporary filename to use, first to
sl@0	2915	* copy the file into, and then to load.
sl@0	2916	*/
sl@0	2917	copyToPtr = TclpTempFileName();
sl@0	2918	if (copyToPtr == NULL) {
sl@0	2919	return -1;
sl@0	2920	}
sl@0	2921	Tcl_IncrRefCount(copyToPtr);
sl@0	2922
sl@0	2923	copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
sl@0	2924	if ((copyFsPtr == NULL) \|\| (copyFsPtr == fsPtr)) {
sl@0	2925	/*
sl@0	2926	* We already know we can't use Tcl_FSLoadFile from
sl@0	2927	* this filesystem, and we must avoid a possible
sl@0	2928	* infinite loop. Try to delete the file we
sl@0	2929	* probably created, and then exit.
sl@0	2930	*/
sl@0	2931	Tcl_FSDeleteFile(copyToPtr);
sl@0	2932	Tcl_DecrRefCount(copyToPtr);
sl@0	2933	return -1;
sl@0	2934	}
sl@0	2935
sl@0	2936	if (TclCrossFilesystemCopy(interp, pathPtr,
sl@0	2937	copyToPtr) == TCL_OK) {
sl@0	2938	Tcl_LoadHandle newLoadHandle = NULL;
sl@0	2939	Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
sl@0	2940	FsDivertLoad *tvdlPtr;
sl@0	2941	int retVal;
sl@0	2942
sl@0	2943	#if !defined(__WIN32__) && !defined(MAC_TCL)
sl@0	2944	/*
sl@0	2945	* Do we need to set appropriate permissions
sl@0	2946	* on the file? This may be required on some
sl@0	2947	* systems. On Unix we could loop over
sl@0	2948	* the file attributes, and set any that are
sl@0	2949	* called "-permissions" to 0700. However,
sl@0	2950	* we just do this directly, like this:
sl@0	2951	*/
sl@0	2952
sl@0	2953	Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
sl@0	2954	Tcl_IncrRefCount(perm);
sl@0	2955	Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
sl@0	2956	Tcl_DecrRefCount(perm);
sl@0	2957	#endif
sl@0	2958
sl@0	2959	/*
sl@0	2960	* We need to reset the result now, because the cross-
sl@0	2961	* filesystem copy may have stored the number of bytes
sl@0	2962	* in the result
sl@0	2963	*/
sl@0	2964	Tcl_ResetResult(interp);
sl@0	2965
sl@0	2966	retVal = Tcl_FSLoadFile(interp, copyToPtr, sym1, sym2,
sl@0	2967	proc1Ptr, proc2Ptr,
sl@0	2968	&newLoadHandle,
sl@0	2969	&newUnloadProcPtr);
sl@0	2970	if (retVal != TCL_OK) {
sl@0	2971	/* The file didn't load successfully */
sl@0	2972	Tcl_FSDeleteFile(copyToPtr);
sl@0	2973	Tcl_DecrRefCount(copyToPtr);
sl@0	2974	return retVal;
sl@0	2975	}
sl@0	2976	/*
sl@0	2977	* Try to delete the file immediately -- this is
sl@0	2978	* possible in some OSes, and avoids any worries
sl@0	2979	* about leaving the copy laying around on exit.
sl@0	2980	*/
sl@0	2981	if (Tcl_FSDeleteFile(copyToPtr) == TCL_OK) {
sl@0	2982	Tcl_DecrRefCount(copyToPtr);
sl@0	2983	/*
sl@0	2984	* We tell our caller about the real shared
sl@0	2985	* library which was loaded. Note that this
sl@0	2986	* does mean that the package list maintained
sl@0	2987	* by 'load' will store the original (vfs)
sl@0	2988	* path alongside the temporary load handle
sl@0	2989	* and unload proc ptr.
sl@0	2990	*/
sl@0	2991	(*handlePtr) = newLoadHandle;
sl@0	2992	(*unloadProcPtr) = newUnloadProcPtr;
sl@0	2993	return TCL_OK;
sl@0	2994	}
sl@0	2995	/*
sl@0	2996	* When we unload this file, we need to divert the
sl@0	2997	* unloading so we can unload and cleanup the
sl@0	2998	* temporary file correctly.
sl@0	2999	*/
sl@0	3000	tvdlPtr = (FsDivertLoad*) ckalloc(sizeof(FsDivertLoad));
sl@0	3001
sl@0	3002	/*
sl@0	3003	* Remember three pieces of information. This allows
sl@0	3004	* us to cleanup the diverted load completely, on
sl@0	3005	* platforms which allow proper unloading of code.
sl@0	3006	*/
sl@0	3007	tvdlPtr->loadHandle = newLoadHandle;
sl@0	3008	tvdlPtr->unloadProcPtr = newUnloadProcPtr;
sl@0	3009
sl@0	3010	if (copyFsPtr != &tclNativeFilesystem) {
sl@0	3011	/* copyToPtr is already incremented for this reference */
sl@0	3012	tvdlPtr->divertedFile = copyToPtr;
sl@0	3013
sl@0	3014	/*
sl@0	3015	* This is the filesystem we loaded it into. Since
sl@0	3016	* we have a reference to 'copyToPtr', we already
sl@0	3017	* have a refCount on this filesystem, so we don't
sl@0	3018	* need to worry about it disappearing on us.
sl@0	3019	*/
sl@0	3020	tvdlPtr->divertedFilesystem = copyFsPtr;
sl@0	3021	tvdlPtr->divertedFileNativeRep = NULL;
sl@0	3022	} else {
sl@0	3023	/* We need the native rep */
sl@0	3024	tvdlPtr->divertedFileNativeRep =
sl@0	3025	TclNativeDupInternalRep(Tcl_FSGetInternalRep(copyToPtr,
sl@0	3026	copyFsPtr));
sl@0	3027	/*
sl@0	3028	* We don't need or want references to the copied
sl@0	3029	* Tcl_Obj or the filesystem if it is the native
sl@0	3030	* one.
sl@0	3031	*/
sl@0	3032	tvdlPtr->divertedFile = NULL;
sl@0	3033	tvdlPtr->divertedFilesystem = NULL;
sl@0	3034	Tcl_DecrRefCount(copyToPtr);
sl@0	3035	}
sl@0	3036
sl@0	3037	copyToPtr = NULL;
sl@0	3038	(*handlePtr) = (Tcl_LoadHandle) tvdlPtr;
sl@0	3039	(*unloadProcPtr) = &FSUnloadTempFile;
sl@0	3040	return retVal;
sl@0	3041	} else {
sl@0	3042	/* Cross-platform copy failed */
sl@0	3043	Tcl_FSDeleteFile(copyToPtr);
sl@0	3044	Tcl_DecrRefCount(copyToPtr);
sl@0	3045	return TCL_ERROR;
sl@0	3046	}
sl@0	3047	}
sl@0	3048	}
sl@0	3049	Tcl_SetErrno(ENOENT);
sl@0	3050	return -1;
sl@0	3051	}
sl@0	3052	/*
sl@0	3053	* This function used to be in the platform specific directories, but it
sl@0	3054	* has now been made to work cross-platform
sl@0	3055	*/
sl@0	3056	int
sl@0	3057	TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
sl@0	3058	clientDataPtr, unloadProcPtr)
sl@0	3059	Tcl_Interp interp; / Used for error reporting. */
sl@0	3060	Tcl_Obj pathPtr; / Name of the file containing the desired
sl@0	3061	* code (UTF-8). */
sl@0	3062	CONST char sym1, sym2; /* Names of two procedures to look up in
sl@0	3063	* the file's symbol table. */
sl@0	3064	Tcl_PackageInitProc proc1Ptr, proc2Ptr;
sl@0	3065	/* Where to return the addresses corresponding
sl@0	3066	* to sym1 and sym2. */
sl@0	3067	ClientData clientDataPtr; / Filled with token for dynamically loaded
sl@0	3068	* file which will be passed back to
sl@0	3069	* (unloadProcPtr)() to unload the file. /
sl@0	3070	Tcl_FSUnloadFileProc **unloadProcPtr;
sl@0	3071	/* Filled with address of Tcl_FSUnloadFileProc
sl@0	3072	* function which should be used for
sl@0	3073	* this file. */
sl@0	3074	{
sl@0	3075	Tcl_LoadHandle handle = NULL;
sl@0	3076	int res;
sl@0	3077
sl@0	3078	res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
sl@0	3079
sl@0	3080	if (res != TCL_OK) {
sl@0	3081	return res;
sl@0	3082	}
sl@0	3083
sl@0	3084	if (handle == NULL) {
sl@0	3085	return TCL_ERROR;
sl@0	3086	}
sl@0	3087
sl@0	3088	*clientDataPtr = (ClientData)handle;
sl@0	3089
sl@0	3090	*proc1Ptr = TclpFindSymbol(interp, handle, sym1);
sl@0	3091	*proc2Ptr = TclpFindSymbol(interp, handle, sym2);
sl@0	3092	return TCL_OK;
sl@0	3093	}
sl@0	3094
sl@0	3095	/*
sl@0	3096	*---------------------------------------------------------------------------
sl@0	3097	*
sl@0	3098	* FSUnloadTempFile --
sl@0	3099	*
sl@0	3100	* This function is called when we loaded a library of code via
sl@0	3101	* an intermediate temporary file. This function ensures
sl@0	3102	* the library is correctly unloaded and the temporary file
sl@0	3103	* is correctly deleted.
sl@0	3104	*
sl@0	3105	* Results:
sl@0	3106	* None.
sl@0	3107	*
sl@0	3108	* Side effects:
sl@0	3109	* The effects of the 'unload' function called, and of course
sl@0	3110	* the temporary file will be deleted.
sl@0	3111	*
sl@0	3112	*---------------------------------------------------------------------------
sl@0	3113	*/
sl@0	3114	static void
sl@0	3115	FSUnloadTempFile(loadHandle)
sl@0	3116	Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
sl@0	3117	* to Tcl_FSLoadFile(). The loadHandle is
sl@0	3118	* a token that represents the loaded
sl@0	3119	* file. */
sl@0	3120	{
sl@0	3121	FsDivertLoad tvdlPtr = (FsDivertLoad)loadHandle;
sl@0	3122	/*
sl@0	3123	* This test should never trigger, since we give
sl@0	3124	* the client data in the function above.
sl@0	3125	*/
sl@0	3126	if (tvdlPtr == NULL) { return; }
sl@0	3127
sl@0	3128	/*
sl@0	3129	* Call the real 'unloadfile' proc we actually used. It is very
sl@0	3130	* important that we call this first, so that the shared library
sl@0	3131	* is actually unloaded by the OS. Otherwise, the following
sl@0	3132	* 'delete' may well fail because the shared library is still in
sl@0	3133	* use.
sl@0	3134	*/
sl@0	3135	if (tvdlPtr->unloadProcPtr != NULL) {
sl@0	3136	(*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
sl@0	3137	}
sl@0	3138
sl@0	3139	if (tvdlPtr->divertedFilesystem == NULL) {
sl@0	3140	/*
sl@0	3141	* It was the native filesystem, and we have a special
sl@0	3142	* function available just for this purpose, which we
sl@0	3143	* know works even at this late stage.
sl@0	3144	*/
sl@0	3145	TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
sl@0	3146	NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
sl@0	3147	} else {
sl@0	3148	/*
sl@0	3149	* Remove the temporary file we created. Note, we may crash
sl@0	3150	* here because encodings have been taken down already.
sl@0	3151	*/
sl@0	3152	if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
sl@0	3153	!= TCL_OK) {
sl@0	3154	/*
sl@0	3155	* The above may have failed because the filesystem, or something
sl@0	3156	* it depends upon (e.g. encodings) have been taken down because
sl@0	3157	* Tcl is exiting.
sl@0	3158	*
sl@0	3159	* We may need to work out how to delete this file more
sl@0	3160	* robustly (or give the filesystem the information it needs
sl@0	3161	* to delete the file more robustly).
sl@0	3162	*
sl@0	3163	* In particular, one problem might be that the filesystem
sl@0	3164	* cannot extract the information it needs from the above
sl@0	3165	* path object because Tcl's entire filesystem apparatus
sl@0	3166	* (the code in this file) has been finalized, and it
sl@0	3167	* refuses to pass the internal representation to the
sl@0	3168	* filesystem.
sl@0	3169	*/
sl@0	3170	}
sl@0	3171
sl@0	3172	/*
sl@0	3173	* And free up the allocations. This will also of course remove
sl@0	3174	* a refCount from the Tcl_Filesystem to which this file belongs,
sl@0	3175	* which could then free up the filesystem if we are exiting.
sl@0	3176	*/
sl@0	3177	Tcl_DecrRefCount(tvdlPtr->divertedFile);
sl@0	3178	}
sl@0	3179
sl@0	3180	ckfree((char*)tvdlPtr);
sl@0	3181	}
sl@0	3182
sl@0	3183	/*
sl@0	3184	*---------------------------------------------------------------------------
sl@0	3185	*
sl@0	3186	* Tcl_FSLink --
sl@0	3187	*
sl@0	3188	* This function replaces the library version of readlink() and
sl@0	3189	* can also be used to make links. The appropriate function for
sl@0	3190	* the filesystem to which pathPtr belongs will be called.
sl@0	3191	*
sl@0	3192	* Results:
sl@0	3193	* If toPtr is NULL, then the result is a Tcl_Obj specifying the
sl@0	3194	* contents of the symbolic link given by 'pathPtr', or NULL if
sl@0	3195	* the symbolic link could not be read. The result is owned by
sl@0	3196	* the caller, which should call Tcl_DecrRefCount when the result
sl@0	3197	* is no longer needed.
sl@0	3198	*
sl@0	3199	* If toPtr is non-NULL, then the result is toPtr if the link action
sl@0	3200	* was successful, or NULL if not. In this case the result has no
sl@0	3201	* additional reference count, and need not be freed. The actual
sl@0	3202	* action to perform is given by the 'linkAction' flags, which is
sl@0	3203	* an or'd combination of:
sl@0	3204	*
sl@0	3205	* TCL_CREATE_SYMBOLIC_LINK
sl@0	3206	* TCL_CREATE_HARD_LINK
sl@0	3207	*
sl@0	3208	* Note that most filesystems will not support linking across
sl@0	3209	* to different filesystems, so this function will usually
sl@0	3210	* fail unless toPtr is in the same FS as pathPtr.
sl@0	3211	*
sl@0	3212	* Side effects:
sl@0	3213	* See readlink() documentation. A new filesystem link
sl@0	3214	* object may appear
sl@0	3215	*
sl@0	3216	*---------------------------------------------------------------------------
sl@0	3217	*/
sl@0	3218
sl@0	3219	EXPORT_C Tcl_Obj *
sl@0	3220	Tcl_FSLink(pathPtr, toPtr, linkAction)
sl@0	3221	Tcl_Obj pathPtr; / Path of file to readlink or link */
sl@0	3222	Tcl_Obj toPtr; / NULL or path to be linked to */
sl@0	3223	int linkAction; /* Action to perform */
sl@0	3224	{
sl@0	3225	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	3226	if (fsPtr != NULL) {
sl@0	3227	Tcl_FSLinkProc *proc = fsPtr->linkProc;
sl@0	3228	if (proc != NULL) {
sl@0	3229	return (*proc)(pathPtr, toPtr, linkAction);
sl@0	3230	}
sl@0	3231	}
sl@0	3232	/*
sl@0	3233	* If S_IFLNK isn't defined it means that the machine doesn't
sl@0	3234	* support symbolic links, so the file can't possibly be a
sl@0	3235	* symbolic link. Generate an EINVAL error, which is what
sl@0	3236	* happens on machines that do support symbolic links when
sl@0	3237	* you invoke readlink on a file that isn't a symbolic link.
sl@0	3238	*/
sl@0	3239	#ifndef S_IFLNK
sl@0	3240	errno = EINVAL;
sl@0	3241	#else
sl@0	3242	Tcl_SetErrno(ENOENT);
sl@0	3243	#endif /* S_IFLNK */
sl@0	3244	return NULL;
sl@0	3245	}
sl@0	3246
sl@0	3247	/*
sl@0	3248	*---------------------------------------------------------------------------
sl@0	3249	*
sl@0	3250	* Tcl_FSListVolumes --
sl@0	3251	*
sl@0	3252	* Lists the currently mounted volumes. The chain of functions
sl@0	3253	* that have been "inserted" into the filesystem will be called in
sl@0	3254	* succession; each may return a list of volumes, all of which are
sl@0	3255	* added to the result until all mounted file systems are listed.
sl@0	3256	*
sl@0	3257	* Notice that we assume the lists returned by each filesystem
sl@0	3258	* (if non NULL) have been given a refCount for us already.
sl@0	3259	* However, we are NOT allowed to hang on to the list itself
sl@0	3260	* (it belongs to the filesystem we called). Therefore we
sl@0	3261	* quite naturally add its contents to the result we are
sl@0	3262	* building, and then decrement the refCount.
sl@0	3263	*
sl@0	3264	* Results:
sl@0	3265	* The list of volumes, in an object which has refCount 0.
sl@0	3266	*
sl@0	3267	* Side effects:
sl@0	3268	* None
sl@0	3269	*
sl@0	3270	*---------------------------------------------------------------------------
sl@0	3271	*/
sl@0	3272
sl@0	3273	EXPORT_C Tcl_Obj*
sl@0	3274	Tcl_FSListVolumes(void)
sl@0	3275	{
sl@0	3276	FilesystemRecord *fsRecPtr;
sl@0	3277	Tcl_Obj *resultPtr = Tcl_NewObj();
sl@0	3278
sl@0	3279	/*
sl@0	3280	* Call each of the "listVolumes" function in succession.
sl@0	3281	* A non-NULL return value indicates the particular function has
sl@0	3282	* succeeded. We call all the functions registered, since we want
sl@0	3283	* a list of all drives from all filesystems.
sl@0	3284	*/
sl@0	3285
sl@0	3286	fsRecPtr = FsGetFirstFilesystem();
sl@0	3287	while (fsRecPtr != NULL) {
sl@0	3288	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
sl@0	3289	if (proc != NULL) {
sl@0	3290	Tcl_Obj thisFsVolumes = (proc)();
sl@0	3291	if (thisFsVolumes != NULL) {
sl@0	3292	Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
sl@0	3293	Tcl_DecrRefCount(thisFsVolumes);
sl@0	3294	}
sl@0	3295	}
sl@0	3296	fsRecPtr = fsRecPtr->nextPtr;
sl@0	3297	}
sl@0	3298
sl@0	3299	return resultPtr;
sl@0	3300	}
sl@0	3301
sl@0	3302	/*
sl@0	3303	*---------------------------------------------------------------------------
sl@0	3304	*
sl@0	3305	* FsListMounts --
sl@0	3306	*
sl@0	3307	* List all mounts within the given directory, which match the
sl@0	3308	* given pattern.
sl@0	3309	*
sl@0	3310	* Results:
sl@0	3311	* The list of mounts, in a list object which has refCount 0, or
sl@0	3312	* NULL if we didn't even find any filesystems to try to list
sl@0	3313	* mounts.
sl@0	3314	*
sl@0	3315	* Side effects:
sl@0	3316	* None
sl@0	3317	*
sl@0	3318	*---------------------------------------------------------------------------
sl@0	3319	*/
sl@0	3320
sl@0	3321	static Tcl_Obj*
sl@0	3322	FsListMounts(pathPtr, pattern)
sl@0	3323	Tcl_Obj pathPtr; / Contains path to directory to search. */
sl@0	3324	CONST char pattern; / Pattern to match against. */
sl@0	3325	{
sl@0	3326	FilesystemRecord *fsRecPtr;
sl@0	3327	Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
sl@0	3328	Tcl_Obj *resultPtr = NULL;
sl@0	3329
sl@0	3330	/*
sl@0	3331	* Call each of the "listMounts" functions in succession.
sl@0	3332	* A non-NULL return value indicates the particular function has
sl@0	3333	* succeeded. We call all the functions registered, since we want
sl@0	3334	* a list from each filesystems.
sl@0	3335	*/
sl@0	3336
sl@0	3337	fsRecPtr = FsGetFirstFilesystem();
sl@0	3338	while (fsRecPtr != NULL) {
sl@0	3339	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
sl@0	3340	Tcl_FSMatchInDirectoryProc *proc =
sl@0	3341	fsRecPtr->fsPtr->matchInDirectoryProc;
sl@0	3342	if (proc != NULL) {
sl@0	3343	if (resultPtr == NULL) {
sl@0	3344	resultPtr = Tcl_NewObj();
sl@0	3345	}
sl@0	3346	(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
sl@0	3347	}
sl@0	3348	}
sl@0	3349	fsRecPtr = fsRecPtr->nextPtr;
sl@0	3350	}
sl@0	3351
sl@0	3352	return resultPtr;
sl@0	3353	}
sl@0	3354
sl@0	3355	/*
sl@0	3356	*---------------------------------------------------------------------------
sl@0	3357	*
sl@0	3358	* Tcl_FSSplitPath --
sl@0	3359	*
sl@0	3360	* This function takes the given Tcl_Obj, which should be a valid
sl@0	3361	* path, and returns a Tcl List object containing each segment of
sl@0	3362	* that path as an element.
sl@0	3363	*
sl@0	3364	* Results:
sl@0	3365	* Returns list object with refCount of zero. If the passed in
sl@0	3366	* lenPtr is non-NULL, we use it to return the number of elements
sl@0	3367	* in the returned list.
sl@0	3368	*
sl@0	3369	* Side effects:
sl@0	3370	* None.
sl@0	3371	*
sl@0	3372	*---------------------------------------------------------------------------
sl@0	3373	*/
sl@0	3374
sl@0	3375	EXPORT_C Tcl_Obj*
sl@0	3376	Tcl_FSSplitPath(pathPtr, lenPtr)
sl@0	3377	Tcl_Obj pathPtr; / Path to split. */
sl@0	3378	int lenPtr; / int to store number of path elements. */
sl@0	3379	{
sl@0	3380	Tcl_Obj result = NULL; / Needed only to prevent gcc warnings. */
sl@0	3381	Tcl_Filesystem *fsPtr;
sl@0	3382	char separator = '/';
sl@0	3383	int driveNameLength;
sl@0	3384	char *p;
sl@0	3385
sl@0	3386	/*
sl@0	3387	* Perform platform specific splitting.
sl@0	3388	*/
sl@0	3389
sl@0	3390	if (FSGetPathType(pathPtr, &fsPtr, &driveNameLength)
sl@0	3391	== TCL_PATH_ABSOLUTE) {
sl@0	3392	if (fsPtr == &tclNativeFilesystem) {
sl@0	3393	return TclpNativeSplitPath(pathPtr, lenPtr);
sl@0	3394	}
sl@0	3395	} else {
sl@0	3396	return TclpNativeSplitPath(pathPtr, lenPtr);
sl@0	3397	}
sl@0	3398
sl@0	3399	/* We assume separators are single characters */
sl@0	3400	if (fsPtr->filesystemSeparatorProc != NULL) {
sl@0	3401	Tcl_Obj sep = (fsPtr->filesystemSeparatorProc)(pathPtr);
sl@0	3402	if (sep != NULL) {
sl@0	3403	separator = Tcl_GetString(sep)[0];
sl@0	3404	}
sl@0	3405	}
sl@0	3406
sl@0	3407	/*
sl@0	3408	* Place the drive name as first element of the
sl@0	3409	* result list. The drive name may contain strange
sl@0	3410	* characters, like colons and multiple forward slashes
sl@0	3411	* (for example 'ftp://' is a valid vfs drive name)
sl@0	3412	*/
sl@0	3413	result = Tcl_NewObj();
sl@0	3414	p = Tcl_GetString(pathPtr);
sl@0	3415	Tcl_ListObjAppendElement(NULL, result,
sl@0	3416	Tcl_NewStringObj(p, driveNameLength));
sl@0	3417	p+= driveNameLength;
sl@0	3418
sl@0	3419	/* Add the remaining path elements to the list */
sl@0	3420	for (;;) {
sl@0	3421	char *elementStart = p;
sl@0	3422	int length;
sl@0	3423	while ((p != '\0') && (p != separator)) {
sl@0	3424	p++;
sl@0	3425	}
sl@0	3426	length = p - elementStart;
sl@0	3427	if (length > 0) {
sl@0	3428	Tcl_Obj *nextElt;
sl@0	3429	if (elementStart[0] == '~') {
sl@0	3430	nextElt = Tcl_NewStringObj("./",2);
sl@0	3431	Tcl_AppendToObj(nextElt, elementStart, length);
sl@0	3432	} else {
sl@0	3433	nextElt = Tcl_NewStringObj(elementStart, length);
sl@0	3434	}
sl@0	3435	Tcl_ListObjAppendElement(NULL, result, nextElt);
sl@0	3436	}
sl@0	3437	if (*p++ == '\0') {
sl@0	3438	break;
sl@0	3439	}
sl@0	3440	}
sl@0	3441
sl@0	3442	/*
sl@0	3443	* Compute the number of elements in the result.
sl@0	3444	*/
sl@0	3445
sl@0	3446	if (lenPtr != NULL) {
sl@0	3447	Tcl_ListObjLength(NULL, result, lenPtr);
sl@0	3448	}
sl@0	3449	return result;
sl@0	3450	}
sl@0	3451
sl@0	3452	/* Simple helper function */
sl@0	3453	Tcl_Obj*
sl@0	3454	TclFSInternalToNormalized(fromFilesystem, clientData, fsRecPtrPtr)
sl@0	3455	Tcl_Filesystem *fromFilesystem;
sl@0	3456	ClientData clientData;
sl@0	3457	FilesystemRecord **fsRecPtrPtr;
sl@0	3458	{
sl@0	3459	FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();
sl@0	3460
sl@0	3461	while (fsRecPtr != NULL) {
sl@0	3462	if (fsRecPtr->fsPtr == fromFilesystem) {
sl@0	3463	*fsRecPtrPtr = fsRecPtr;
sl@0	3464	break;
sl@0	3465	}
sl@0	3466	fsRecPtr = fsRecPtr->nextPtr;
sl@0	3467	}
sl@0	3468
sl@0	3469	if ((fsRecPtr != NULL)
sl@0	3470	&& (fromFilesystem->internalToNormalizedProc != NULL)) {
sl@0	3471	return (*fromFilesystem->internalToNormalizedProc)(clientData);
sl@0	3472	} else {
sl@0	3473	return NULL;
sl@0	3474	}
sl@0	3475	}
sl@0	3476
sl@0	3477	/*
sl@0	3478	*----------------------------------------------------------------------
sl@0	3479	*
sl@0	3480	* GetPathType --
sl@0	3481	*
sl@0	3482	* Helper function used by FSGetPathType.
sl@0	3483	*
sl@0	3484	* Results:
sl@0	3485	* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
sl@0	3486	* TCL_PATH_VOLUME_RELATIVE. The filesystem reference will
sl@0	3487	* be set if and only if it is non-NULL and the function's
sl@0	3488	* return value is TCL_PATH_ABSOLUTE.
sl@0	3489	*
sl@0	3490	* Side effects:
sl@0	3491	* None.
sl@0	3492	*
sl@0	3493	*----------------------------------------------------------------------
sl@0	3494	*/
sl@0	3495
sl@0	3496	static Tcl_PathType
sl@0	3497	GetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr, driveNameRef)
sl@0	3498	Tcl_Obj *pathObjPtr;
sl@0	3499	Tcl_Filesystem **filesystemPtrPtr;
sl@0	3500	int *driveNameLengthPtr;
sl@0	3501	Tcl_Obj **driveNameRef;
sl@0	3502	{
sl@0	3503	FilesystemRecord *fsRecPtr;
sl@0	3504	int pathLen;
sl@0	3505	char *path;
sl@0	3506	Tcl_PathType type = TCL_PATH_RELATIVE;
sl@0	3507
sl@0	3508	path = Tcl_GetStringFromObj(pathObjPtr, &pathLen);
sl@0	3509
sl@0	3510	/*
sl@0	3511	* Call each of the "listVolumes" function in succession, checking
sl@0	3512	* whether the given path is an absolute path on any of the volumes
sl@0	3513	* returned (this is done by checking whether the path's prefix
sl@0	3514	* matches).
sl@0	3515	*/
sl@0	3516
sl@0	3517	fsRecPtr = FsGetFirstFilesystem();
sl@0	3518	while (fsRecPtr != NULL) {
sl@0	3519	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
sl@0	3520	/*
sl@0	3521	* We want to skip the native filesystem in this loop because
sl@0	3522	* otherwise we won't necessarily pass all the Tcl testsuite --
sl@0	3523	* this is because some of the tests artificially change the
sl@0	3524	* current platform (between mac, win, unix) but the list
sl@0	3525	* of volumes we get by calling (*proc) will reflect the current
sl@0	3526	* (real) platform only and this may cause some tests to fail.
sl@0	3527	* In particular, on unix '/' will match the beginning of
sl@0	3528	* certain absolute Windows paths starting '//' and those tests
sl@0	3529	* will go wrong.
sl@0	3530	*
sl@0	3531	* Besides these test-suite issues, there is one other reason
sl@0	3532	* to skip the native filesystem --- since the tclFilename.c
sl@0	3533	* code has nice fast 'absolute path' checkers, we don't want
sl@0	3534	* to waste time repeating that effort here, and this
sl@0	3535	* function is actually called quite often, so if we can
sl@0	3536	* save the overhead of the native filesystem returning us
sl@0	3537	* a list of volumes all the time, it is better.
sl@0	3538	*/
sl@0	3539	if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
sl@0	3540	int numVolumes;
sl@0	3541	Tcl_Obj thisFsVolumes = (proc)();
sl@0	3542	if (thisFsVolumes != NULL) {
sl@0	3543	if (Tcl_ListObjLength(NULL, thisFsVolumes,
sl@0	3544	&numVolumes) != TCL_OK) {
sl@0	3545	/*
sl@0	3546	* This is VERY bad; the Tcl_FSListVolumesProc
sl@0	3547	* didn't return a valid list. Set numVolumes to
sl@0	3548	* -1 so that we skip the while loop below and just
sl@0	3549	* return with the current value of 'type'.
sl@0	3550	*
sl@0	3551	* It would be better if we could signal an error
sl@0	3552	* here (but panic seems a bit excessive).
sl@0	3553	*/
sl@0	3554	numVolumes = -1;
sl@0	3555	}
sl@0	3556	while (numVolumes > 0) {
sl@0	3557	Tcl_Obj *vol;
sl@0	3558	int len;
sl@0	3559	char *strVol;
sl@0	3560
sl@0	3561	numVolumes--;
sl@0	3562	Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
sl@0	3563	strVol = Tcl_GetStringFromObj(vol,&len);
sl@0	3564	if (pathLen < len) {
sl@0	3565	continue;
sl@0	3566	}
sl@0	3567	if (strncmp(strVol, path, (size_t) len) == 0) {
sl@0	3568	type = TCL_PATH_ABSOLUTE;
sl@0	3569	if (filesystemPtrPtr != NULL) {
sl@0	3570	*filesystemPtrPtr = fsRecPtr->fsPtr;
sl@0	3571	}
sl@0	3572	if (driveNameLengthPtr != NULL) {
sl@0	3573	*driveNameLengthPtr = len;
sl@0	3574	}
sl@0	3575	if (driveNameRef != NULL) {
sl@0	3576	*driveNameRef = vol;
sl@0	3577	Tcl_IncrRefCount(vol);
sl@0	3578	}
sl@0	3579	break;
sl@0	3580	}
sl@0	3581	}
sl@0	3582	Tcl_DecrRefCount(thisFsVolumes);
sl@0	3583	if (type == TCL_PATH_ABSOLUTE) {
sl@0	3584	/* We don't need to examine any more filesystems */
sl@0	3585	break;
sl@0	3586	}
sl@0	3587	}
sl@0	3588	}
sl@0	3589	fsRecPtr = fsRecPtr->nextPtr;
sl@0	3590	}
sl@0	3591
sl@0	3592	if (type != TCL_PATH_ABSOLUTE) {
sl@0	3593	type = TclpGetNativePathType(pathObjPtr, driveNameLengthPtr,
sl@0	3594	driveNameRef);
sl@0	3595	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
sl@0	3596	*filesystemPtrPtr = &tclNativeFilesystem;
sl@0	3597	}
sl@0	3598	}
sl@0	3599	return type;
sl@0	3600	}
sl@0	3601
sl@0	3602	/*
sl@0	3603	*---------------------------------------------------------------------------
sl@0	3604	*
sl@0	3605	* Tcl_FSRenameFile --
sl@0	3606	*
sl@0	3607	* If the two paths given belong to the same filesystem, we call
sl@0	3608	* that filesystems rename function. Otherwise we simply
sl@0	3609	* return the posix error 'EXDEV', and -1.
sl@0	3610	*
sl@0	3611	* Results:
sl@0	3612	* Standard Tcl error code if a function was called.
sl@0	3613	*
sl@0	3614	* Side effects:
sl@0	3615	* A file may be renamed.
sl@0	3616	*
sl@0	3617	*---------------------------------------------------------------------------
sl@0	3618	*/
sl@0	3619
sl@0	3620	EXPORT_C int
sl@0	3621	Tcl_FSRenameFile(srcPathPtr, destPathPtr)
sl@0	3622	Tcl_Obj* srcPathPtr; /* Pathname of file or dir to be renamed
sl@0	3623	* (UTF-8). */
sl@0	3624	Tcl_Obj destPathPtr; / New pathname of file or directory
sl@0	3625	* (UTF-8). */
sl@0	3626	{
sl@0	3627	int retVal = -1;
sl@0	3628	Tcl_Filesystem fsPtr, fsPtr2;
sl@0	3629	fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
sl@0	3630	fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
sl@0	3631
sl@0	3632	if (fsPtr == fsPtr2 && fsPtr != NULL) {
sl@0	3633	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
sl@0	3634	if (proc != NULL) {
sl@0	3635	retVal = (*proc)(srcPathPtr, destPathPtr);
sl@0	3636	}
sl@0	3637	}
sl@0	3638	if (retVal == -1) {
sl@0	3639	Tcl_SetErrno(EXDEV);
sl@0	3640	}
sl@0	3641	return retVal;
sl@0	3642	}
sl@0	3643
sl@0	3644	/*
sl@0	3645	*---------------------------------------------------------------------------
sl@0	3646	*
sl@0	3647	* Tcl_FSCopyFile --
sl@0	3648	*
sl@0	3649	* If the two paths given belong to the same filesystem, we call
sl@0	3650	* that filesystem's copy function. Otherwise we simply
sl@0	3651	* return the posix error 'EXDEV', and -1.
sl@0	3652	*
sl@0	3653	* Note that in the native filesystems, 'copyFileProc' is defined
sl@0	3654	* to copy soft links (i.e. it copies the links themselves, not
sl@0	3655	* the things they point to).
sl@0	3656	*
sl@0	3657	* Results:
sl@0	3658	* Standard Tcl error code if a function was called.
sl@0	3659	*
sl@0	3660	* Side effects:
sl@0	3661	* A file may be copied.
sl@0	3662	*
sl@0	3663	*---------------------------------------------------------------------------
sl@0	3664	*/
sl@0	3665
sl@0	3666	EXPORT_C int
sl@0	3667	Tcl_FSCopyFile(srcPathPtr, destPathPtr)
sl@0	3668	Tcl_Obj* srcPathPtr; /* Pathname of file to be copied (UTF-8). */
sl@0	3669	Tcl_Obj destPathPtr; / Pathname of file to copy to (UTF-8). */
sl@0	3670	{
sl@0	3671	int retVal = -1;
sl@0	3672	Tcl_Filesystem fsPtr, fsPtr2;
sl@0	3673	fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
sl@0	3674	fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
sl@0	3675
sl@0	3676	if (fsPtr == fsPtr2 && fsPtr != NULL) {
sl@0	3677	Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
sl@0	3678	if (proc != NULL) {
sl@0	3679	retVal = (*proc)(srcPathPtr, destPathPtr);
sl@0	3680	}
sl@0	3681	}
sl@0	3682	if (retVal == -1) {
sl@0	3683	Tcl_SetErrno(EXDEV);
sl@0	3684	}
sl@0	3685	return retVal;
sl@0	3686	}
sl@0	3687
sl@0	3688	/*
sl@0	3689	*---------------------------------------------------------------------------
sl@0	3690	*
sl@0	3691	* TclCrossFilesystemCopy --
sl@0	3692	*
sl@0	3693	* Helper for above function, and for Tcl_FSLoadFile, to copy
sl@0	3694	* files from one filesystem to another. This function will
sl@0	3695	* overwrite the target file if it already exists.
sl@0	3696	*
sl@0	3697	* Results:
sl@0	3698	* Standard Tcl error code.
sl@0	3699	*
sl@0	3700	* Side effects:
sl@0	3701	* A file may be created.
sl@0	3702	*
sl@0	3703	*---------------------------------------------------------------------------
sl@0	3704	*/
sl@0	3705	int
sl@0	3706	TclCrossFilesystemCopy(interp, source, target)
sl@0	3707	Tcl_Interp interp; / For error messages */
sl@0	3708	Tcl_Obj source; / Pathname of file to be copied (UTF-8). */
sl@0	3709	Tcl_Obj target; / Pathname of file to copy to (UTF-8). */
sl@0	3710	{
sl@0	3711	int result = TCL_ERROR;
sl@0	3712	int prot = 0666;
sl@0	3713
sl@0	3714	Tcl_Channel out = Tcl_FSOpenFileChannel(interp, target, "w", prot);
sl@0	3715	if (out != NULL) {
sl@0	3716	/* It looks like we can copy it over */
sl@0	3717	Tcl_Channel in = Tcl_FSOpenFileChannel(interp, source,
sl@0	3718	"r", prot);
sl@0	3719	if (in == NULL) {
sl@0	3720	/* This is very strange, we checked this above */
sl@0	3721	Tcl_Close(interp, out);
sl@0	3722	} else {
sl@0	3723	Tcl_StatBuf sourceStatBuf;
sl@0	3724	struct utimbuf tval;
sl@0	3725	/*
sl@0	3726	* Copy it synchronously. We might wish to add an
sl@0	3727	* asynchronous option to support vfs's which are
sl@0	3728	* slow (e.g. network sockets).
sl@0	3729	*/
sl@0	3730	Tcl_SetChannelOption(interp, in, "-translation", "binary");
sl@0	3731	Tcl_SetChannelOption(interp, out, "-translation", "binary");
sl@0	3732
sl@0	3733	if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
sl@0	3734	result = TCL_OK;
sl@0	3735	}
sl@0	3736	/*
sl@0	3737	* If the copy failed, assume that copy channel left
sl@0	3738	* a good error message.
sl@0	3739	*/
sl@0	3740	Tcl_Close(interp, in);
sl@0	3741	Tcl_Close(interp, out);
sl@0	3742
sl@0	3743	/* Set modification date of copied file */
sl@0	3744	if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
sl@0	3745	tval.actime = sourceStatBuf.st_atime;
sl@0	3746	tval.modtime = sourceStatBuf.st_mtime;
sl@0	3747	Tcl_FSUtime(target, &tval);
sl@0	3748	}
sl@0	3749	}
sl@0	3750	}
sl@0	3751	return result;
sl@0	3752	}
sl@0	3753
sl@0	3754	/*
sl@0	3755	*---------------------------------------------------------------------------
sl@0	3756	*
sl@0	3757	* Tcl_FSDeleteFile --
sl@0	3758	*
sl@0	3759	* The appropriate function for the filesystem to which pathPtr
sl@0	3760	* belongs will be called.
sl@0	3761	*
sl@0	3762	* Results:
sl@0	3763	* Standard Tcl error code.
sl@0	3764	*
sl@0	3765	* Side effects:
sl@0	3766	* A file may be deleted.
sl@0	3767	*
sl@0	3768	*---------------------------------------------------------------------------
sl@0	3769	*/
sl@0	3770
sl@0	3771	EXPORT_C int
sl@0	3772	Tcl_FSDeleteFile(pathPtr)
sl@0	3773	Tcl_Obj pathPtr; / Pathname of file to be removed (UTF-8). */
sl@0	3774	{
sl@0	3775	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	3776	if (fsPtr != NULL) {
sl@0	3777	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
sl@0	3778	if (proc != NULL) {
sl@0	3779	return (*proc)(pathPtr);
sl@0	3780	}
sl@0	3781	}
sl@0	3782	Tcl_SetErrno(ENOENT);
sl@0	3783	return -1;
sl@0	3784	}
sl@0	3785
sl@0	3786	/*
sl@0	3787	*---------------------------------------------------------------------------
sl@0	3788	*
sl@0	3789	* Tcl_FSCreateDirectory --
sl@0	3790	*
sl@0	3791	* The appropriate function for the filesystem to which pathPtr
sl@0	3792	* belongs will be called.
sl@0	3793	*
sl@0	3794	* Results:
sl@0	3795	* Standard Tcl error code.
sl@0	3796	*
sl@0	3797	* Side effects:
sl@0	3798	* A directory may be created.
sl@0	3799	*
sl@0	3800	*---------------------------------------------------------------------------
sl@0	3801	*/
sl@0	3802
sl@0	3803	EXPORT_C int
sl@0	3804	Tcl_FSCreateDirectory(pathPtr)
sl@0	3805	Tcl_Obj pathPtr; / Pathname of directory to create (UTF-8). */
sl@0	3806	{
sl@0	3807	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	3808	if (fsPtr != NULL) {
sl@0	3809	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
sl@0	3810	if (proc != NULL) {
sl@0	3811	return (*proc)(pathPtr);
sl@0	3812	}
sl@0	3813	}
sl@0	3814	Tcl_SetErrno(ENOENT);
sl@0	3815	return -1;
sl@0	3816	}
sl@0	3817
sl@0	3818	/*
sl@0	3819	*---------------------------------------------------------------------------
sl@0	3820	*
sl@0	3821	* Tcl_FSCopyDirectory --
sl@0	3822	*
sl@0	3823	* If the two paths given belong to the same filesystem, we call
sl@0	3824	* that filesystems copy-directory function. Otherwise we simply
sl@0	3825	* return the posix error 'EXDEV', and -1.
sl@0	3826	*
sl@0	3827	* Results:
sl@0	3828	* Standard Tcl error code if a function was called.
sl@0	3829	*
sl@0	3830	* Side effects:
sl@0	3831	* A directory may be copied.
sl@0	3832	*
sl@0	3833	*---------------------------------------------------------------------------
sl@0	3834	*/
sl@0	3835
sl@0	3836	EXPORT_C int
sl@0	3837	Tcl_FSCopyDirectory(srcPathPtr, destPathPtr, errorPtr)
sl@0	3838	Tcl_Obj* srcPathPtr; /* Pathname of directory to be copied
sl@0	3839	* (UTF-8). */
sl@0	3840	Tcl_Obj destPathPtr; / Pathname of target directory (UTF-8). */
sl@0	3841	Tcl_Obj *errorPtr; / If non-NULL, then will be set to a
sl@0	3842	* new object containing name of file
sl@0	3843	* causing error, with refCount 1. */
sl@0	3844	{
sl@0	3845	int retVal = -1;
sl@0	3846	Tcl_Filesystem fsPtr, fsPtr2;
sl@0	3847	fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
sl@0	3848	fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);
sl@0	3849
sl@0	3850	if (fsPtr == fsPtr2 && fsPtr != NULL) {
sl@0	3851	Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
sl@0	3852	if (proc != NULL) {
sl@0	3853	retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
sl@0	3854	}
sl@0	3855	}
sl@0	3856	if (retVal == -1) {
sl@0	3857	Tcl_SetErrno(EXDEV);
sl@0	3858	}
sl@0	3859	return retVal;
sl@0	3860	}
sl@0	3861
sl@0	3862	/*
sl@0	3863	*---------------------------------------------------------------------------
sl@0	3864	*
sl@0	3865	* Tcl_FSRemoveDirectory --
sl@0	3866	*
sl@0	3867	* The appropriate function for the filesystem to which pathPtr
sl@0	3868	* belongs will be called.
sl@0	3869	*
sl@0	3870	* Results:
sl@0	3871	* Standard Tcl error code.
sl@0	3872	*
sl@0	3873	* Side effects:
sl@0	3874	* A directory may be deleted.
sl@0	3875	*
sl@0	3876	*---------------------------------------------------------------------------
sl@0	3877	*/
sl@0	3878
sl@0	3879	EXPORT_C int
sl@0	3880	Tcl_FSRemoveDirectory(pathPtr, recursive, errorPtr)
sl@0	3881	Tcl_Obj pathPtr; / Pathname of directory to be removed
sl@0	3882	* (UTF-8). */
sl@0	3883	int recursive; /* If non-zero, removes directories that
sl@0	3884	* are nonempty. Otherwise, will only remove
sl@0	3885	* empty directories. */
sl@0	3886	Tcl_Obj *errorPtr; / If non-NULL, then will be set to a
sl@0	3887	* new object containing name of file
sl@0	3888	* causing error, with refCount 1. */
sl@0	3889	{
sl@0	3890	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
sl@0	3891	if (fsPtr != NULL) {
sl@0	3892	Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
sl@0	3893	if (proc != NULL) {
sl@0	3894	if (recursive) {
sl@0	3895	/*
sl@0	3896	* We check whether the cwd lies inside this directory
sl@0	3897	* and move it if it does.
sl@0	3898	*/
sl@0	3899	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
sl@0	3900	if (cwdPtr != NULL) {
sl@0	3901	char cwdStr, normPathStr;
sl@0	3902	int cwdLen, normLen;
sl@0	3903	Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
sl@0	3904	if (normPath != NULL) {
sl@0	3905	normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
sl@0	3906	cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
sl@0	3907	if ((cwdLen >= normLen) && (strncmp(normPathStr,
sl@0	3908	cwdStr, (size_t) normLen) == 0)) {
sl@0	3909	/*
sl@0	3910	* the cwd is inside the directory, so we
sl@0	3911	* perform a 'cd [file dirname $path]'
sl@0	3912	*/
sl@0	3913	Tcl_Obj *dirPtr = TclFileDirname(NULL, pathPtr);
sl@0	3914	Tcl_FSChdir(dirPtr);
sl@0	3915	Tcl_DecrRefCount(dirPtr);
sl@0	3916	}
sl@0	3917	}
sl@0	3918	Tcl_DecrRefCount(cwdPtr);
sl@0	3919	}
sl@0	3920	}
sl@0	3921	return (*proc)(pathPtr, recursive, errorPtr);
sl@0	3922	}
sl@0	3923	}
sl@0	3924	Tcl_SetErrno(ENOENT);
sl@0	3925	return -1;
sl@0	3926	}
sl@0	3927
sl@0	3928	/*
sl@0	3929	*---------------------------------------------------------------------------
sl@0	3930	*
sl@0	3931	* Tcl_FSGetFileSystemForPath --
sl@0	3932	*
sl@0	3933	* This function determines which filesystem to use for a
sl@0	3934	* particular path object, and returns the filesystem which
sl@0	3935	* accepts this file. If no filesystem will accept this object
sl@0	3936	* as a valid file path, then NULL is returned.
sl@0	3937	*
sl@0	3938	* Results:
sl@0	3939	.* NULL or a filesystem which will accept this path.
sl@0	3940	*
sl@0	3941	* Side effects:
sl@0	3942	* The object may be converted to a path type.
sl@0	3943	*
sl@0	3944	*---------------------------------------------------------------------------
sl@0	3945	*/
sl@0	3946
sl@0	3947	EXPORT_C Tcl_Filesystem*
sl@0	3948	Tcl_FSGetFileSystemForPath(pathObjPtr)
sl@0	3949	Tcl_Obj* pathObjPtr;
sl@0	3950	{
sl@0	3951	FilesystemRecord *fsRecPtr;
sl@0	3952	Tcl_Filesystem* retVal = NULL;
sl@0	3953
sl@0	3954	/*
sl@0	3955	* If the object has a refCount of zero, we reject it. This
sl@0	3956	* is to avoid possible segfaults or nondeterministic memory
sl@0	3957	* leaks (i.e. the user doesn't know if they should decrement
sl@0	3958	* the ref count on return or not).
sl@0	3959	*/
sl@0	3960
sl@0	3961	if (pathObjPtr->refCount == 0) {
sl@0	3962	panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
sl@0	3963	return NULL;
sl@0	3964	}
sl@0	3965
sl@0	3966	/*
sl@0	3967	* Check if the filesystem has changed in some way since
sl@0	3968	* this object's internal representation was calculated.
sl@0	3969	* Before doing that, assure we have the most up-to-date
sl@0	3970	* copy of the master filesystem. This is accomplished
sl@0	3971	* by the FsGetFirstFilesystem() call.
sl@0	3972	*/
sl@0	3973
sl@0	3974	fsRecPtr = FsGetFirstFilesystem();
sl@0	3975
sl@0	3976	if (TclFSEnsureEpochOk(pathObjPtr, &retVal) != TCL_OK) {
sl@0	3977	return NULL;
sl@0	3978	}
sl@0	3979
sl@0	3980	/*
sl@0	3981	* Call each of the "pathInFilesystem" functions in succession. A
sl@0	3982	* non-return value of -1 indicates the particular function has
sl@0	3983	* succeeded.
sl@0	3984	*/
sl@0	3985
sl@0	3986	while ((retVal == NULL) && (fsRecPtr != NULL)) {
sl@0	3987	Tcl_FSPathInFilesystemProc *proc = fsRecPtr->fsPtr->pathInFilesystemProc;
sl@0	3988	if (proc != NULL) {
sl@0	3989	ClientData clientData = NULL;
sl@0	3990	int ret = (*proc)(pathObjPtr, &clientData);
sl@0	3991	if (ret != -1) {
sl@0	3992	/*
sl@0	3993	* We assume the type of pathObjPtr hasn't been changed
sl@0	3994	* by the above call to the pathInFilesystemProc.
sl@0	3995	*/
sl@0	3996	TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData);
sl@0	3997	retVal = fsRecPtr->fsPtr;
sl@0	3998	}
sl@0	3999	}
sl@0	4000	fsRecPtr = fsRecPtr->nextPtr;
sl@0	4001	}
sl@0	4002
sl@0	4003	return retVal;
sl@0	4004	}
sl@0	4005
sl@0	4006	/*
sl@0	4007	*---------------------------------------------------------------------------
sl@0	4008	*
sl@0	4009	* Tcl_FSGetNativePath --
sl@0	4010	*
sl@0	4011	* This function is for use by the Win/Unix/MacOS native filesystems,
sl@0	4012	* so that they can easily retrieve the native (char* or TCHAR*)
sl@0	4013	* representation of a path. Other filesystems will probably
sl@0	4014	* want to implement similar functions. They basically act as a
sl@0	4015	* safety net around Tcl_FSGetInternalRep. Normally your file-
sl@0	4016	* system procedures will always be called with path objects
sl@0	4017	* already converted to the correct filesystem, but if for
sl@0	4018	* some reason they are called directly (i.e. by procedures
sl@0	4019	* not in this file), then one cannot necessarily guarantee that
sl@0	4020	* the path object pointer is from the correct filesystem.
sl@0	4021	*
sl@0	4022	* Note: in the future it might be desireable to have separate
sl@0	4023	* versions of this function with different signatures, for
sl@0	4024	* example Tcl_FSGetNativeMacPath, Tcl_FSGetNativeUnixPath etc.
sl@0	4025	* Right now, since native paths are all string based, we use just
sl@0	4026	* one function. On MacOS we could possibly use an FSSpec or
sl@0	4027	* FSRef as the native representation.
sl@0	4028	*
sl@0	4029	* Results:
sl@0	4030	* NULL or a valid native path.
sl@0	4031	*
sl@0	4032	* Side effects:
sl@0	4033	* See Tcl_FSGetInternalRep.
sl@0	4034	*
sl@0	4035	*---------------------------------------------------------------------------
sl@0	4036	*/
sl@0	4037
sl@0	4038	EXPORT_C CONST char *
sl@0	4039	Tcl_FSGetNativePath(pathObjPtr)
sl@0	4040	Tcl_Obj *pathObjPtr;
sl@0	4041	{
sl@0	4042	return (CONST char *)Tcl_FSGetInternalRep(pathObjPtr, &tclNativeFilesystem);
sl@0	4043	}
sl@0	4044
sl@0	4045	/*
sl@0	4046	*---------------------------------------------------------------------------
sl@0	4047	*
sl@0	4048	* NativeCreateNativeRep --
sl@0	4049	*
sl@0	4050	* Create a native representation for the given path.
sl@0	4051	*
sl@0	4052	* Results:
sl@0	4053	* None.
sl@0	4054	*
sl@0	4055	* Side effects:
sl@0	4056	* None.
sl@0	4057	*
sl@0	4058	*---------------------------------------------------------------------------
sl@0	4059	*/
sl@0	4060	static ClientData
sl@0	4061	NativeCreateNativeRep(pathObjPtr)
sl@0	4062	Tcl_Obj* pathObjPtr;
sl@0	4063	{
sl@0	4064	char *nativePathPtr;
sl@0	4065	Tcl_DString ds;
sl@0	4066	Tcl_Obj* validPathObjPtr;
sl@0	4067	int len;
sl@0	4068	char *str;
sl@0	4069
sl@0	4070	/* Make sure the normalized path is set */
sl@0	4071	validPathObjPtr = Tcl_FSGetNormalizedPath(NULL, pathObjPtr);
sl@0	4072	if (validPathObjPtr == NULL) {
sl@0	4073	return NULL;
sl@0	4074	}
sl@0	4075
sl@0	4076	str = Tcl_GetStringFromObj(validPathObjPtr, &len);
sl@0	4077	#ifdef __WIN32__
sl@0	4078	Tcl_WinUtfToTChar(str, len, &ds);
sl@0	4079	if (tclWinProcs->useWide) {
sl@0	4080	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
sl@0	4081	} else {
sl@0	4082	len = Tcl_DStringLength(&ds) + sizeof(char);
sl@0	4083	}
sl@0	4084	#else
sl@0	4085	Tcl_UtfToExternalDString(NULL, str, len, &ds);
sl@0	4086	len = Tcl_DStringLength(&ds) + sizeof(char);
sl@0	4087	#endif
sl@0	4088	nativePathPtr = ckalloc((unsigned) len);
sl@0	4089	memcpy((VOID)nativePathPtr, (VOID)Tcl_DStringValue(&ds), (size_t) len);
sl@0	4090
sl@0	4091	Tcl_DStringFree(&ds);
sl@0	4092	return (ClientData)nativePathPtr;
sl@0	4093	}
sl@0	4094
sl@0	4095	/*
sl@0	4096	*---------------------------------------------------------------------------
sl@0	4097	*
sl@0	4098	* TclpNativeToNormalized --
sl@0	4099	*
sl@0	4100	* Convert native format to a normalized path object, with refCount
sl@0	4101	* of zero.
sl@0	4102	*
sl@0	4103	* Results:
sl@0	4104	* A valid normalized path.
sl@0	4105	*
sl@0	4106	* Side effects:
sl@0	4107	* None.
sl@0	4108	*
sl@0	4109	*---------------------------------------------------------------------------
sl@0	4110	*/
sl@0	4111	Tcl_Obj*
sl@0	4112	TclpNativeToNormalized(clientData)
sl@0	4113	ClientData clientData;
sl@0	4114	{
sl@0	4115	Tcl_DString ds;
sl@0	4116	Tcl_Obj *objPtr;
sl@0	4117	CONST char *copy;
sl@0	4118	int len;
sl@0	4119
sl@0	4120	#ifdef __WIN32__
sl@0	4121	Tcl_WinTCharToUtf((CONST char*)clientData, -1, &ds);
sl@0	4122	#else
sl@0	4123	Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
sl@0	4124	#endif
sl@0	4125
sl@0	4126	copy = Tcl_DStringValue(&ds);
sl@0	4127	len = Tcl_DStringLength(&ds);
sl@0	4128
sl@0	4129	#ifdef __WIN32__
sl@0	4130	/*
sl@0	4131	* Certain native path representations on Windows have this special
sl@0	4132	* prefix to indicate that they are to be treated specially. For
sl@0	4133	* example extremely long paths, or symlinks
sl@0	4134	*/
sl@0	4135	if (*copy == '\\') {
sl@0	4136	if (0 == strncmp(copy,"\\??\\",4)) {
sl@0	4137	copy += 4;
sl@0	4138	len -= 4;
sl@0	4139	} else if (0 == strncmp(copy,"\\\\?\\",4)) {
sl@0	4140	copy += 4;
sl@0	4141	len -= 4;
sl@0	4142	}
sl@0	4143	}
sl@0	4144	#endif
sl@0	4145
sl@0	4146	objPtr = Tcl_NewStringObj(copy,len);
sl@0	4147	Tcl_DStringFree(&ds);
sl@0	4148
sl@0	4149	return objPtr;
sl@0	4150	}
sl@0	4151
sl@0	4152
sl@0	4153	/*
sl@0	4154	*---------------------------------------------------------------------------
sl@0	4155	*
sl@0	4156	* TclNativeDupInternalRep --
sl@0	4157	*
sl@0	4158	* Duplicate the native representation.
sl@0	4159	*
sl@0	4160	* Results:
sl@0	4161	* The copied native representation, or NULL if it is not possible
sl@0	4162	* to copy the representation.
sl@0	4163	*
sl@0	4164	* Side effects:
sl@0	4165	* None.
sl@0	4166	*
sl@0	4167	*---------------------------------------------------------------------------
sl@0	4168	*/
sl@0	4169	ClientData
sl@0	4170	TclNativeDupInternalRep(clientData)
sl@0	4171	ClientData clientData;
sl@0	4172	{
sl@0	4173	ClientData copy;
sl@0	4174	size_t len;
sl@0	4175
sl@0	4176	if (clientData == NULL) {
sl@0	4177	return NULL;
sl@0	4178	}
sl@0	4179
sl@0	4180	#ifdef __WIN32__
sl@0	4181	if (tclWinProcs->useWide) {
sl@0	4182	/* unicode representation when running on NT/2K/XP */
sl@0	4183	len = sizeof(WCHAR) + (wcslen((CONST WCHAR)clientData) sizeof(WCHAR));
sl@0	4184	} else {
sl@0	4185	/* ansi representation when running on 95/98/ME */
sl@0	4186	len = sizeof(char) + (strlen((CONST char)clientData) sizeof(char));
sl@0	4187	}
sl@0	4188	#else
sl@0	4189	/* ansi representation when running on Unix/MacOS */
sl@0	4190	len = sizeof(char) + (strlen((CONST char)clientData) sizeof(char));
sl@0	4191	#endif
sl@0	4192
sl@0	4193	copy = (ClientData) ckalloc(len);
sl@0	4194	memcpy((VOID)copy, (VOID)clientData, len);
sl@0	4195	return copy;
sl@0	4196	}
sl@0	4197
sl@0	4198	/*
sl@0	4199	*---------------------------------------------------------------------------
sl@0	4200	*
sl@0	4201	* NativeFreeInternalRep --
sl@0	4202	*
sl@0	4203	* Free a native internal representation, which will be non-NULL.
sl@0	4204	*
sl@0	4205	* Results:
sl@0	4206	* None.
sl@0	4207	*
sl@0	4208	* Side effects:
sl@0	4209	* Memory is released.
sl@0	4210	*
sl@0	4211	*---------------------------------------------------------------------------
sl@0	4212	*/
sl@0	4213	static void
sl@0	4214	NativeFreeInternalRep(clientData)
sl@0	4215	ClientData clientData;
sl@0	4216	{
sl@0	4217	ckfree((char*)clientData);
sl@0	4218	}
sl@0	4219
sl@0	4220	/*
sl@0	4221	*---------------------------------------------------------------------------
sl@0	4222	*
sl@0	4223	* Tcl_FSFileSystemInfo --
sl@0	4224	*
sl@0	4225	* This function returns a list of two elements. The first
sl@0	4226	* element is the name of the filesystem (e.g. "native" or "vfs"),
sl@0	4227	* and the second is the particular type of the given path within
sl@0	4228	* that filesystem.
sl@0	4229	*
sl@0	4230	* Results:
sl@0	4231	* A list of two elements.
sl@0	4232	*
sl@0	4233	* Side effects:
sl@0	4234	* The object may be converted to a path type.
sl@0	4235	*
sl@0	4236	*---------------------------------------------------------------------------
sl@0	4237	*/
sl@0	4238	EXPORT_C Tcl_Obj*
sl@0	4239	Tcl_FSFileSystemInfo(pathObjPtr)
sl@0	4240	Tcl_Obj* pathObjPtr;
sl@0	4241	{
sl@0	4242	Tcl_Obj *resPtr;
sl@0	4243	Tcl_FSFilesystemPathTypeProc *proc;
sl@0	4244	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
sl@0	4245
sl@0	4246	if (fsPtr == NULL) {
sl@0	4247	return NULL;
sl@0	4248	}
sl@0	4249
sl@0	4250	resPtr = Tcl_NewListObj(0,NULL);
sl@0	4251
sl@0	4252	Tcl_ListObjAppendElement(NULL, resPtr,
sl@0	4253	Tcl_NewStringObj(fsPtr->typeName,-1));
sl@0	4254
sl@0	4255	proc = fsPtr->filesystemPathTypeProc;
sl@0	4256	if (proc != NULL) {
sl@0	4257	Tcl_Obj typePtr = (proc)(pathObjPtr);
sl@0	4258	if (typePtr != NULL) {
sl@0	4259	Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
sl@0	4260	}
sl@0	4261	}
sl@0	4262
sl@0	4263	return resPtr;
sl@0	4264	}
sl@0	4265
sl@0	4266	/*
sl@0	4267	*---------------------------------------------------------------------------
sl@0	4268	*
sl@0	4269	* Tcl_FSPathSeparator --
sl@0	4270	*
sl@0	4271	* This function returns the separator to be used for a given
sl@0	4272	* path. The object returned should have a refCount of zero
sl@0	4273	*
sl@0	4274	* Results:
sl@0	4275	* A Tcl object, with a refCount of zero. If the caller
sl@0	4276	* needs to retain a reference to the object, it should
sl@0	4277	* call Tcl_IncrRefCount.
sl@0	4278	*
sl@0	4279	* Side effects:
sl@0	4280	* The path object may be converted to a path type.
sl@0	4281	*
sl@0	4282	*---------------------------------------------------------------------------
sl@0	4283	*/
sl@0	4284	EXPORT_C Tcl_Obj*
sl@0	4285	Tcl_FSPathSeparator(pathObjPtr)
sl@0	4286	Tcl_Obj* pathObjPtr;
sl@0	4287	{
sl@0	4288	Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathObjPtr);
sl@0	4289
sl@0	4290	if (fsPtr == NULL) {
sl@0	4291	return NULL;
sl@0	4292	}
sl@0	4293	if (fsPtr->filesystemSeparatorProc != NULL) {
sl@0	4294	return (*fsPtr->filesystemSeparatorProc)(pathObjPtr);
sl@0	4295	}
sl@0	4296
sl@0	4297	return NULL;
sl@0	4298	}
sl@0	4299
sl@0	4300	/*
sl@0	4301	*---------------------------------------------------------------------------
sl@0	4302	*
sl@0	4303	* NativeFilesystemSeparator --
sl@0	4304	*
sl@0	4305	* This function is part of the native filesystem support, and
sl@0	4306	* returns the separator for the given path.
sl@0	4307	*
sl@0	4308	* Results:
sl@0	4309	* String object containing the separator character.
sl@0	4310	*
sl@0	4311	* Side effects:
sl@0	4312	* None.
sl@0	4313	*
sl@0	4314	*---------------------------------------------------------------------------
sl@0	4315	*/
sl@0	4316	static Tcl_Obj*
sl@0	4317	NativeFilesystemSeparator(pathObjPtr)
sl@0	4318	Tcl_Obj* pathObjPtr;
sl@0	4319	{
sl@0	4320	char separator = NULL; / lint */
sl@0	4321	switch (tclPlatform) {
sl@0	4322	case TCL_PLATFORM_UNIX:
sl@0	4323	separator = "/";
sl@0	4324	break;
sl@0	4325	case TCL_PLATFORM_WINDOWS:
sl@0	4326	separator = "\\";
sl@0	4327	break;
sl@0	4328	case TCL_PLATFORM_MAC:
sl@0	4329	separator = ":";
sl@0	4330	break;
sl@0	4331	}
sl@0	4332	return Tcl_NewStringObj(separator,1);
sl@0	4333	}
sl@0	4334
sl@0	4335	/* Everything from here on is contained in this obsolete ifdef */
sl@0	4336	#ifdef USE_OBSOLETE_FS_HOOKS
sl@0	4337
sl@0	4338	/*
sl@0	4339	*----------------------------------------------------------------------
sl@0	4340	*
sl@0	4341	* TclStatInsertProc --
sl@0	4342	*
sl@0	4343	* Insert the passed procedure pointer at the head of the list of
sl@0	4344	* functions which are used during a call to 'TclStat(...)'. The
sl@0	4345	* passed function should behave exactly like 'TclStat' when called
sl@0	4346	* during that time (see 'TclStat(...)' for more information).
sl@0	4347	* The function will be added even if it already in the list.
sl@0	4348	*
sl@0	4349	* Results:
sl@0	4350	* Normally TCL_OK; TCL_ERROR if memory for a new node in the list
sl@0	4351	* could not be allocated.
sl@0	4352	*
sl@0	4353	* Side effects:
sl@0	4354	* Memory allocated and modifies the link list for 'TclStat'
sl@0	4355	* functions.
sl@0	4356	*
sl@0	4357	*----------------------------------------------------------------------
sl@0	4358	*/
sl@0	4359
sl@0	4360	int
sl@0	4361	TclStatInsertProc (proc)
sl@0	4362	TclStatProc_ *proc;
sl@0	4363	{
sl@0	4364	int retVal = TCL_ERROR;
sl@0	4365
sl@0	4366	if (proc != NULL) {
sl@0	4367	StatProc *newStatProcPtr;
sl@0	4368
sl@0	4369	newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));
sl@0	4370
sl@0	4371	if (newStatProcPtr != NULL) {
sl@0	4372	newStatProcPtr->proc = proc;
sl@0	4373	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	4374	newStatProcPtr->nextPtr = statProcList;
sl@0	4375	statProcList = newStatProcPtr;
sl@0	4376	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	4377
sl@0	4378	retVal = TCL_OK;
sl@0	4379	}
sl@0	4380	}
sl@0	4381
sl@0	4382	return retVal;
sl@0	4383	}
sl@0	4384
sl@0	4385	/*
sl@0	4386	*----------------------------------------------------------------------
sl@0	4387	*
sl@0	4388	* TclStatDeleteProc --
sl@0	4389	*
sl@0	4390	* Removed the passed function pointer from the list of 'TclStat'
sl@0	4391	* functions. Ensures that the built-in stat function is not
sl@0	4392	* removvable.
sl@0	4393	*
sl@0	4394	* Results:
sl@0	4395	* TCL_OK if the procedure pointer was successfully removed,
sl@0	4396	* TCL_ERROR otherwise.
sl@0	4397	*
sl@0	4398	* Side effects:
sl@0	4399	* Memory is deallocated and the respective list updated.
sl@0	4400	*
sl@0	4401	*----------------------------------------------------------------------
sl@0	4402	*/
sl@0	4403
sl@0	4404	int
sl@0	4405	TclStatDeleteProc (proc)
sl@0	4406	TclStatProc_ *proc;
sl@0	4407	{
sl@0	4408	int retVal = TCL_ERROR;
sl@0	4409	StatProc *tmpStatProcPtr;
sl@0	4410	StatProc *prevStatProcPtr = NULL;
sl@0	4411
sl@0	4412	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	4413	tmpStatProcPtr = statProcList;
sl@0	4414	/*
sl@0	4415	* Traverse the 'statProcList' looking for the particular node
sl@0	4416	* whose 'proc' member matches 'proc' and remove that one from
sl@0	4417	* the list. Ensure that the "default" node cannot be removed.
sl@0	4418	*/
sl@0	4419
sl@0	4420	while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
sl@0	4421	if (tmpStatProcPtr->proc == proc) {
sl@0	4422	if (prevStatProcPtr == NULL) {
sl@0	4423	statProcList = tmpStatProcPtr->nextPtr;
sl@0	4424	} else {
sl@0	4425	prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
sl@0	4426	}
sl@0	4427
sl@0	4428	ckfree((char *)tmpStatProcPtr);
sl@0	4429
sl@0	4430	retVal = TCL_OK;
sl@0	4431	} else {
sl@0	4432	prevStatProcPtr = tmpStatProcPtr;
sl@0	4433	tmpStatProcPtr = tmpStatProcPtr->nextPtr;
sl@0	4434	}
sl@0	4435	}
sl@0	4436
sl@0	4437	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	4438
sl@0	4439	return retVal;
sl@0	4440	}
sl@0	4441
sl@0	4442	/*
sl@0	4443	*----------------------------------------------------------------------
sl@0	4444	*
sl@0	4445	* TclAccessInsertProc --
sl@0	4446	*
sl@0	4447	* Insert the passed procedure pointer at the head of the list of
sl@0	4448	* functions which are used during a call to 'TclAccess(...)'.
sl@0	4449	* The passed function should behave exactly like 'TclAccess' when
sl@0	4450	* called during that time (see 'TclAccess(...)' for more
sl@0	4451	* information). The function will be added even if it already in
sl@0	4452	* the list.
sl@0	4453	*
sl@0	4454	* Results:
sl@0	4455	* Normally TCL_OK; TCL_ERROR if memory for a new node in the list
sl@0	4456	* could not be allocated.
sl@0	4457	*
sl@0	4458	* Side effects:
sl@0	4459	* Memory allocated and modifies the link list for 'TclAccess'
sl@0	4460	* functions.
sl@0	4461	*
sl@0	4462	*----------------------------------------------------------------------
sl@0	4463	*/
sl@0	4464
sl@0	4465	int
sl@0	4466	TclAccessInsertProc(proc)
sl@0	4467	TclAccessProc_ *proc;
sl@0	4468	{
sl@0	4469	int retVal = TCL_ERROR;
sl@0	4470
sl@0	4471	if (proc != NULL) {
sl@0	4472	AccessProc *newAccessProcPtr;
sl@0	4473
sl@0	4474	newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));
sl@0	4475
sl@0	4476	if (newAccessProcPtr != NULL) {
sl@0	4477	newAccessProcPtr->proc = proc;
sl@0	4478	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	4479	newAccessProcPtr->nextPtr = accessProcList;
sl@0	4480	accessProcList = newAccessProcPtr;
sl@0	4481	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	4482
sl@0	4483	retVal = TCL_OK;
sl@0	4484	}
sl@0	4485	}
sl@0	4486
sl@0	4487	return retVal;
sl@0	4488	}
sl@0	4489
sl@0	4490	/*
sl@0	4491	*----------------------------------------------------------------------
sl@0	4492	*
sl@0	4493	* TclAccessDeleteProc --
sl@0	4494	*
sl@0	4495	* Removed the passed function pointer from the list of 'TclAccess'
sl@0	4496	* functions. Ensures that the built-in access function is not
sl@0	4497	* removvable.
sl@0	4498	*
sl@0	4499	* Results:
sl@0	4500	* TCL_OK if the procedure pointer was successfully removed,
sl@0	4501	* TCL_ERROR otherwise.
sl@0	4502	*
sl@0	4503	* Side effects:
sl@0	4504	* Memory is deallocated and the respective list updated.
sl@0	4505	*
sl@0	4506	*----------------------------------------------------------------------
sl@0	4507	*/
sl@0	4508
sl@0	4509	int
sl@0	4510	TclAccessDeleteProc(proc)
sl@0	4511	TclAccessProc_ *proc;
sl@0	4512	{
sl@0	4513	int retVal = TCL_ERROR;
sl@0	4514	AccessProc *tmpAccessProcPtr;
sl@0	4515	AccessProc *prevAccessProcPtr = NULL;
sl@0	4516
sl@0	4517	/*
sl@0	4518	* Traverse the 'accessProcList' looking for the particular node
sl@0	4519	* whose 'proc' member matches 'proc' and remove that one from
sl@0	4520	* the list. Ensure that the "default" node cannot be removed.
sl@0	4521	*/
sl@0	4522
sl@0	4523	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	4524	tmpAccessProcPtr = accessProcList;
sl@0	4525	while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
sl@0	4526	if (tmpAccessProcPtr->proc == proc) {
sl@0	4527	if (prevAccessProcPtr == NULL) {
sl@0	4528	accessProcList = tmpAccessProcPtr->nextPtr;
sl@0	4529	} else {
sl@0	4530	prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
sl@0	4531	}
sl@0	4532
sl@0	4533	ckfree((char *)tmpAccessProcPtr);
sl@0	4534
sl@0	4535	retVal = TCL_OK;
sl@0	4536	} else {
sl@0	4537	prevAccessProcPtr = tmpAccessProcPtr;
sl@0	4538	tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
sl@0	4539	}
sl@0	4540	}
sl@0	4541	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	4542
sl@0	4543	return retVal;
sl@0	4544	}
sl@0	4545
sl@0	4546	/*
sl@0	4547	*----------------------------------------------------------------------
sl@0	4548	*
sl@0	4549	* TclOpenFileChannelInsertProc --
sl@0	4550	*
sl@0	4551	* Insert the passed procedure pointer at the head of the list of
sl@0	4552	* functions which are used during a call to
sl@0	4553	* 'Tcl_OpenFileChannel(...)'. The passed function should behave
sl@0	4554	* exactly like 'Tcl_OpenFileChannel' when called during that time
sl@0	4555	* (see 'Tcl_OpenFileChannel(...)' for more information). The
sl@0	4556	* function will be added even if it already in the list.
sl@0	4557	*
sl@0	4558	* Results:
sl@0	4559	* Normally TCL_OK; TCL_ERROR if memory for a new node in the list
sl@0	4560	* could not be allocated.
sl@0	4561	*
sl@0	4562	* Side effects:
sl@0	4563	* Memory allocated and modifies the link list for
sl@0	4564	* 'Tcl_OpenFileChannel' functions.
sl@0	4565	*
sl@0	4566	*----------------------------------------------------------------------
sl@0	4567	*/
sl@0	4568
sl@0	4569	int
sl@0	4570	TclOpenFileChannelInsertProc(proc)
sl@0	4571	TclOpenFileChannelProc_ *proc;
sl@0	4572	{
sl@0	4573	int retVal = TCL_ERROR;
sl@0	4574
sl@0	4575	if (proc != NULL) {
sl@0	4576	OpenFileChannelProc *newOpenFileChannelProcPtr;
sl@0	4577
sl@0	4578	newOpenFileChannelProcPtr =
sl@0	4579	(OpenFileChannelProc *)ckalloc(sizeof(OpenFileChannelProc));
sl@0	4580
sl@0	4581	if (newOpenFileChannelProcPtr != NULL) {
sl@0	4582	newOpenFileChannelProcPtr->proc = proc;
sl@0	4583	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	4584	newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
sl@0	4585	openFileChannelProcList = newOpenFileChannelProcPtr;
sl@0	4586	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	4587
sl@0	4588	retVal = TCL_OK;
sl@0	4589	}
sl@0	4590	}
sl@0	4591
sl@0	4592	return retVal;
sl@0	4593	}
sl@0	4594
sl@0	4595	/*
sl@0	4596	*----------------------------------------------------------------------
sl@0	4597	*
sl@0	4598	* TclOpenFileChannelDeleteProc --
sl@0	4599	*
sl@0	4600	* Removed the passed function pointer from the list of
sl@0	4601	* 'Tcl_OpenFileChannel' functions. Ensures that the built-in
sl@0	4602	* open file channel function is not removable.
sl@0	4603	*
sl@0	4604	* Results:
sl@0	4605	* TCL_OK if the procedure pointer was successfully removed,
sl@0	4606	* TCL_ERROR otherwise.
sl@0	4607	*
sl@0	4608	* Side effects:
sl@0	4609	* Memory is deallocated and the respective list updated.
sl@0	4610	*
sl@0	4611	*----------------------------------------------------------------------
sl@0	4612	*/
sl@0	4613
sl@0	4614	int
sl@0	4615	TclOpenFileChannelDeleteProc(proc)
sl@0	4616	TclOpenFileChannelProc_ *proc;
sl@0	4617	{
sl@0	4618	int retVal = TCL_ERROR;
sl@0	4619	OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
sl@0	4620	OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;
sl@0	4621
sl@0	4622	/*
sl@0	4623	* Traverse the 'openFileChannelProcList' looking for the particular
sl@0	4624	* node whose 'proc' member matches 'proc' and remove that one from
sl@0	4625	* the list.
sl@0	4626	*/
sl@0	4627
sl@0	4628	Tcl_MutexLock(&obsoleteFsHookMutex);
sl@0	4629	tmpOpenFileChannelProcPtr = openFileChannelProcList;
sl@0	4630	while ((retVal == TCL_ERROR) &&
sl@0	4631	(tmpOpenFileChannelProcPtr != NULL)) {
sl@0	4632	if (tmpOpenFileChannelProcPtr->proc == proc) {
sl@0	4633	if (prevOpenFileChannelProcPtr == NULL) {
sl@0	4634	openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
sl@0	4635	} else {
sl@0	4636	prevOpenFileChannelProcPtr->nextPtr =
sl@0	4637	tmpOpenFileChannelProcPtr->nextPtr;
sl@0	4638	}
sl@0	4639
sl@0	4640	ckfree((char *)tmpOpenFileChannelProcPtr);
sl@0	4641
sl@0	4642	retVal = TCL_OK;
sl@0	4643	} else {
sl@0	4644	prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
sl@0	4645	tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
sl@0	4646	}
sl@0	4647	}
sl@0	4648	Tcl_MutexUnlock(&obsoleteFsHookMutex);
sl@0	4649
sl@0	4650	return retVal;
sl@0	4651	}
sl@0	4652	#endif /* USE_OBSOLETE_FS_HOOKS */
sl@0	4653
sl@0	4654
sl@0	4655	/*
sl@0	4656	* Prototypes for procedures defined later in this file.
sl@0	4657	*/
sl@0	4658
sl@0	4659	static void DupFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
sl@0	4660	Tcl_Obj *copyPtr));
sl@0	4661	static void FreeFsPathInternalRep _ANSI_ARGS_((Tcl_Obj *listPtr));
sl@0	4662	static void UpdateStringOfFsPath _ANSI_ARGS_((Tcl_Obj *objPtr));
sl@0	4663	static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp,
sl@0	4664	Tcl_Obj *objPtr));
sl@0	4665	static int FindSplitPos _ANSI_ARGS_((char path, char separator));
sl@0	4666
sl@0	4667
sl@0	4668
sl@0	4669	/*
sl@0	4670	* Define the 'path' object type, which Tcl uses to represent
sl@0	4671	* file paths internally.
sl@0	4672	*/
sl@0	4673	static Tcl_ObjType tclFsPathType = {
sl@0	4674	"path", /* name */
sl@0	4675	FreeFsPathInternalRep, /* freeIntRepProc */
sl@0	4676	DupFsPathInternalRep, /* dupIntRepProc */
sl@0	4677	UpdateStringOfFsPath, /* updateStringProc */
sl@0	4678	SetFsPathFromAny /* setFromAnyProc */
sl@0	4679	};
sl@0	4680
sl@0	4681	/*
sl@0	4682	* struct FsPath --
sl@0	4683	*
sl@0	4684	* Internal representation of a Tcl_Obj of "path" type. This
sl@0	4685	* can be used to represent relative or absolute paths, and has
sl@0	4686	* certain optimisations when used to represent paths which are
sl@0	4687	* already normalized and absolute.
sl@0	4688	*
sl@0	4689	* Note that 'normPathPtr' can be a circular reference to the
sl@0	4690	* container Tcl_Obj of this FsPath.
sl@0	4691	*/
sl@0	4692	typedef struct FsPath {
sl@0	4693	Tcl_Obj translatedPathPtr; / Name without any ~user sequences.
sl@0	4694	* If this is NULL, then this is a
sl@0	4695	* pure normalized, absolute path
sl@0	4696	* object, in which the parent Tcl_Obj's
sl@0	4697	* string rep is already both translated
sl@0	4698	* and normalized. */
sl@0	4699	Tcl_Obj normPathPtr; / Normalized absolute path, without
sl@0	4700	* ., .. or ~user sequences. If the
sl@0	4701	* Tcl_Obj containing
sl@0	4702	* this FsPath is already normalized,
sl@0	4703	* this may be a circular reference back
sl@0	4704	* to the container. If that is NOT the
sl@0	4705	* case, we have a refCount on the object. */
sl@0	4706	Tcl_Obj cwdPtr; / If null, path is absolute, else
sl@0	4707	* this points to the cwd object used
sl@0	4708	* for this path. We have a refCount
sl@0	4709	* on the object. */
sl@0	4710	int flags; /* Flags to describe interpretation */
sl@0	4711	ClientData nativePathPtr; /* Native representation of this path,
sl@0	4712	* which is filesystem dependent. */
sl@0	4713	int filesystemEpoch; /* Used to ensure the path representation
sl@0	4714	* was generated during the correct
sl@0	4715	* filesystem epoch. The epoch changes
sl@0	4716	* when filesystem-mounts are changed. */
sl@0	4717	struct FilesystemRecord *fsRecPtr;
sl@0	4718	/* Pointer to the filesystem record
sl@0	4719	* entry to use for this path. */
sl@0	4720	} FsPath;
sl@0	4721
sl@0	4722	/*
sl@0	4723	* Define some macros to give us convenient access to path-object
sl@0	4724	* specific fields.
sl@0	4725	*/
sl@0	4726	#define PATHOBJ(objPtr) (objPtr->internalRep.otherValuePtr)
sl@0	4727	#define PATHFLAGS(objPtr) \
sl@0	4728	(((FsPath*)(objPtr->internalRep.otherValuePtr))->flags)
sl@0	4729
sl@0	4730	#define TCLPATH_APPENDED 1
sl@0	4731	#define TCLPATH_RELATIVE 2
sl@0	4732
sl@0	4733	/*
sl@0	4734	*----------------------------------------------------------------------
sl@0	4735	*
sl@0	4736	* Tcl_FSGetPathType --
sl@0	4737	*
sl@0	4738	* Determines whether a given path is relative to the current
sl@0	4739	* directory, relative to the current volume, or absolute.
sl@0	4740	*
sl@0	4741	* Results:
sl@0	4742	* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
sl@0	4743	* TCL_PATH_VOLUME_RELATIVE.
sl@0	4744	*
sl@0	4745	* Side effects:
sl@0	4746	* None.
sl@0	4747	*
sl@0	4748	*----------------------------------------------------------------------
sl@0	4749	*/
sl@0	4750
sl@0	4751	EXPORT_C Tcl_PathType
sl@0	4752	Tcl_FSGetPathType(pathObjPtr)
sl@0	4753	Tcl_Obj *pathObjPtr;
sl@0	4754	{
sl@0	4755	return FSGetPathType(pathObjPtr, NULL, NULL);
sl@0	4756	}
sl@0	4757
sl@0	4758	/*
sl@0	4759	*----------------------------------------------------------------------
sl@0	4760	*
sl@0	4761	* FSGetPathType --
sl@0	4762	*
sl@0	4763	* Determines whether a given path is relative to the current
sl@0	4764	* directory, relative to the current volume, or absolute. If the
sl@0	4765	* caller wishes to know which filesystem claimed the path (in the
sl@0	4766	* case for which the path is absolute), then a reference to a
sl@0	4767	* filesystem pointer can be passed in (but passing NULL is
sl@0	4768	* acceptable).
sl@0	4769	*
sl@0	4770	* Results:
sl@0	4771	* Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
sl@0	4772	* TCL_PATH_VOLUME_RELATIVE. The filesystem reference will
sl@0	4773	* be set if and only if it is non-NULL and the function's
sl@0	4774	* return value is TCL_PATH_ABSOLUTE.
sl@0	4775	*
sl@0	4776	* Side effects:
sl@0	4777	* None.
sl@0	4778	*
sl@0	4779	*----------------------------------------------------------------------
sl@0	4780	*/
sl@0	4781
sl@0	4782	static Tcl_PathType
sl@0	4783	FSGetPathType(pathObjPtr, filesystemPtrPtr, driveNameLengthPtr)
sl@0	4784	Tcl_Obj *pathObjPtr;
sl@0	4785	Tcl_Filesystem **filesystemPtrPtr;
sl@0	4786	int *driveNameLengthPtr;
sl@0	4787	{
sl@0	4788	if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
sl@0	4789	return GetPathType(pathObjPtr, filesystemPtrPtr,
sl@0	4790	driveNameLengthPtr, NULL);
sl@0	4791	} else {
sl@0	4792	FsPath fsPathPtr = (FsPath) PATHOBJ(pathObjPtr);
sl@0	4793	if (fsPathPtr->cwdPtr != NULL) {
sl@0	4794	if (PATHFLAGS(pathObjPtr) == 0) {
sl@0	4795	return TCL_PATH_RELATIVE;
sl@0	4796	}
sl@0	4797	return FSGetPathType(fsPathPtr->cwdPtr, filesystemPtrPtr,
sl@0	4798	driveNameLengthPtr);
sl@0	4799	} else {
sl@0	4800	return GetPathType(pathObjPtr, filesystemPtrPtr,
sl@0	4801	driveNameLengthPtr, NULL);
sl@0	4802	}
sl@0	4803	}
sl@0	4804	}
sl@0	4805
sl@0	4806	/*
sl@0	4807	*---------------------------------------------------------------------------
sl@0	4808	*
sl@0	4809	* Tcl_FSJoinPath --
sl@0	4810	*
sl@0	4811	* This function takes the given Tcl_Obj, which should be a valid
sl@0	4812	* list, and returns the path object given by considering the
sl@0	4813	* first 'elements' elements as valid path segments. If elements < 0,
sl@0	4814	* we use the entire list.
sl@0	4815	*
sl@0	4816	* Results:
sl@0	4817	* Returns object with refCount of zero, (or if non-zero, it has
sl@0	4818	* references elsewhere in Tcl). Either way, the caller must
sl@0	4819	* increment its refCount before use.
sl@0	4820	*
sl@0	4821	* Side effects:
sl@0	4822	* None.
sl@0	4823	*
sl@0	4824	*---------------------------------------------------------------------------
sl@0	4825	*/
sl@0	4826	EXPORT_C Tcl_Obj*
sl@0	4827	Tcl_FSJoinPath(listObj, elements)
sl@0	4828	Tcl_Obj *listObj;
sl@0	4829	int elements;
sl@0	4830	{
sl@0	4831	Tcl_Obj *res;
sl@0	4832	int i;
sl@0	4833	Tcl_Filesystem *fsPtr = NULL;
sl@0	4834
sl@0	4835	if (elements < 0) {
sl@0	4836	if (Tcl_ListObjLength(NULL, listObj, &elements) != TCL_OK) {
sl@0	4837	return NULL;
sl@0	4838	}
sl@0	4839	} else {
sl@0	4840	/* Just make sure it is a valid list */
sl@0	4841	int listTest;
sl@0	4842	if (Tcl_ListObjLength(NULL, listObj, &listTest) != TCL_OK) {
sl@0	4843	return NULL;
sl@0	4844	}
sl@0	4845	/*
sl@0	4846	* Correct this if it is too large, otherwise we will
sl@0	4847	* waste our time joining null elements to the path
sl@0	4848	*/
sl@0	4849	if (elements > listTest) {
sl@0	4850	elements = listTest;
sl@0	4851	}
sl@0	4852	}
sl@0	4853
sl@0	4854	res = Tcl_NewObj();
sl@0	4855
sl@0	4856	for (i = 0; i < elements; i++) {
sl@0	4857	Tcl_Obj *elt;
sl@0	4858	int driveNameLength;
sl@0	4859	Tcl_PathType type;
sl@0	4860	char *strElt;
sl@0	4861	int strEltLen;
sl@0	4862	int length;
sl@0	4863	char *ptr;
sl@0	4864	Tcl_Obj *driveName = NULL;
sl@0	4865
sl@0	4866	Tcl_ListObjIndex(NULL, listObj, i, &elt);
sl@0	4867
sl@0	4868	/*
sl@0	4869	* This is a special case where we can be much more
sl@0	4870	* efficient, where we are joining a single relative path
sl@0	4871	* onto an object that is already of path type. The
sl@0	4872	* 'TclNewFSPathObj' call below creates an object which
sl@0	4873	* can be normalized more efficiently. Currently we only
sl@0	4874	* use the special case when we have exactly two elements,
sl@0	4875	* but we could expand that in the future.
sl@0	4876	*/
sl@0	4877	if ((i == (elements-2)) && (i == 0) && (elt->typePtr == &tclFsPathType)
sl@0	4878	&& !(elt->bytes != NULL && (elt->bytes[0] == '\0'))) {
sl@0	4879	Tcl_Obj *tail;
sl@0	4880	Tcl_PathType type;
sl@0	4881	Tcl_ListObjIndex(NULL, listObj, i+1, &tail);
sl@0	4882	type = GetPathType(tail, NULL, NULL, NULL);
sl@0	4883	if (type == TCL_PATH_RELATIVE) {
sl@0	4884	CONST char *str;
sl@0	4885	int len;
sl@0	4886	str = Tcl_GetStringFromObj(tail,&len);
sl@0	4887	if (len == 0) {
sl@0	4888	/*
sl@0	4889	* This happens if we try to handle the root volume
sl@0	4890	* '/'. There's no need to return a special path
sl@0	4891	* object, when the base itself is just fine!
sl@0	4892	*/
sl@0	4893	Tcl_DecrRefCount(res);
sl@0	4894	return elt;
sl@0	4895	}
sl@0	4896	/*
sl@0	4897	* If it doesn't begin with '.' and is a mac or unix
sl@0	4898	* path or it a windows path without backslashes, then we
sl@0	4899	* can be very efficient here. (In fact even a windows
sl@0	4900	* path with backslashes can be joined efficiently, but
sl@0	4901	* the path object would not have forward slashes only,
sl@0	4902	* and this would therefore contradict our 'file join'
sl@0	4903	* documentation).
sl@0	4904	*/
sl@0	4905	if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS)
sl@0	4906	\|\| (strchr(str, '\\') == NULL))) {
sl@0	4907	/*
sl@0	4908	* Finally, on Windows, 'file join' is defined to
sl@0	4909	* convert all backslashes to forward slashes,
sl@0	4910	* so the base part cannot have backslashes either.
sl@0	4911	*/
sl@0	4912	if ((tclPlatform != TCL_PLATFORM_WINDOWS)
sl@0	4913	\|\| (strchr(Tcl_GetString(elt), '\\') == NULL)) {
sl@0	4914	if (res != NULL) {
sl@0	4915	TclDecrRefCount(res);
sl@0	4916	}
sl@0	4917	return TclNewFSPathObj(elt, str, len);
sl@0	4918	}
sl@0	4919	}
sl@0	4920	/*
sl@0	4921	* Otherwise we don't have an easy join, and
sl@0	4922	* we must let the more general code below handle
sl@0	4923	* things
sl@0	4924	*/
sl@0	4925	} else {
sl@0	4926	if (tclPlatform == TCL_PLATFORM_UNIX) {
sl@0	4927	Tcl_DecrRefCount(res);
sl@0	4928	return tail;
sl@0	4929	} else {
sl@0	4930	CONST char *str;
sl@0	4931	int len;
sl@0	4932	str = Tcl_GetStringFromObj(tail,&len);
sl@0	4933	if (tclPlatform == TCL_PLATFORM_WINDOWS) {
sl@0	4934	if (strchr(str, '\\') == NULL) {
sl@0	4935	Tcl_DecrRefCount(res);
sl@0	4936	return tail;
sl@0	4937	}
sl@0	4938	} else if (tclPlatform == TCL_PLATFORM_MAC) {
sl@0	4939	if (strchr(str, '/') == NULL) {
sl@0	4940	Tcl_DecrRefCount(res);
sl@0	4941	return tail;
sl@0	4942	}
sl@0	4943	}
sl@0	4944	}
sl@0	4945	}
sl@0	4946	}
sl@0	4947	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
sl@0	4948	type = GetPathType(elt, &fsPtr, &driveNameLength, &driveName);
sl@0	4949	if (type != TCL_PATH_RELATIVE) {
sl@0	4950	/* Zero out the current result */
sl@0	4951	Tcl_DecrRefCount(res);
sl@0	4952	if (driveName != NULL) {
sl@0	4953	res = Tcl_DuplicateObj(driveName);
sl@0	4954	Tcl_DecrRefCount(driveName);
sl@0	4955	} else {
sl@0	4956	res = Tcl_NewStringObj(strElt, driveNameLength);
sl@0	4957	}
sl@0	4958	strElt += driveNameLength;
sl@0	4959	}
sl@0	4960
sl@0	4961	ptr = Tcl_GetStringFromObj(res, &length);
sl@0	4962
sl@0	4963	/*
sl@0	4964	* Strip off any './' before a tilde, unless this is the
sl@0	4965	* beginning of the path.
sl@0	4966	*/
sl@0	4967	if (length > 0 && strEltLen > 0) {
sl@0	4968	if ((strElt[0] == '.') && (strElt[1] == '/')
sl@0	4969	&& (strElt[2] == '~')) {
sl@0	4970	strElt += 2;
sl@0	4971	}
sl@0	4972	}
sl@0	4973
sl@0	4974	/*
sl@0	4975	* A NULL value for fsPtr at this stage basically means
sl@0	4976	* we're trying to join a relative path onto something
sl@0	4977	* which is also relative (or empty). There's nothing
sl@0	4978	* particularly wrong with that.
sl@0	4979	*/
sl@0	4980	if (*strElt == '\0') continue;
sl@0	4981
sl@0	4982	if (fsPtr == &tclNativeFilesystem \|\| fsPtr == NULL) {
sl@0	4983	TclpNativeJoinPath(res, strElt);
sl@0	4984	} else {
sl@0	4985	char separator = '/';
sl@0	4986	int needsSep = 0;
sl@0	4987
sl@0	4988	if (fsPtr->filesystemSeparatorProc != NULL) {
sl@0	4989	Tcl_Obj sep = (fsPtr->filesystemSeparatorProc)(res);
sl@0	4990	if (sep != NULL) {
sl@0	4991	separator = Tcl_GetString(sep)[0];
sl@0	4992	}
sl@0	4993	}
sl@0	4994
sl@0	4995	if (length > 0 && ptr[length -1] != '/') {
sl@0	4996	Tcl_AppendToObj(res, &separator, 1);
sl@0	4997	length++;
sl@0	4998	}
sl@0	4999	Tcl_SetObjLength(res, length + (int) strlen(strElt));
sl@0	5000
sl@0	5001	ptr = Tcl_GetString(res) + length;
sl@0	5002	for (; *strElt != '\0'; strElt++) {
sl@0	5003	if (*strElt == separator) {
sl@0	5004	while (strElt[1] == separator) {
sl@0	5005	strElt++;
sl@0	5006	}
sl@0	5007	if (strElt[1] != '\0') {
sl@0	5008	if (needsSep) {
sl@0	5009	*ptr++ = separator;
sl@0	5010	}
sl@0	5011	}
sl@0	5012	} else {
sl@0	5013	ptr++ = strElt;
sl@0	5014	needsSep = 1;
sl@0	5015	}
sl@0	5016	}
sl@0	5017	length = ptr - Tcl_GetString(res);
sl@0	5018	Tcl_SetObjLength(res, length);
sl@0	5019	}
sl@0	5020	}
sl@0	5021	return res;
sl@0	5022	}
sl@0	5023
sl@0	5024	/*
sl@0	5025	*---------------------------------------------------------------------------
sl@0	5026	*
sl@0	5027	* Tcl_FSConvertToPathType --
sl@0	5028	*
sl@0	5029	* This function tries to convert the given Tcl_Obj to a valid
sl@0	5030	* Tcl path type, taking account of the fact that the cwd may
sl@0	5031	* have changed even if this object is already supposedly of
sl@0	5032	* the correct type.
sl@0	5033	*
sl@0	5034	* The filename may begin with "~" (to indicate current user's
sl@0	5035	* home directory) or "~<user>" (to indicate any user's home
sl@0	5036	* directory).
sl@0	5037	*
sl@0	5038	* Results:
sl@0	5039	* Standard Tcl error code.
sl@0	5040	*
sl@0	5041	* Side effects:
sl@0	5042	* The old representation may be freed, and new memory allocated.
sl@0	5043	*
sl@0	5044	*---------------------------------------------------------------------------
sl@0	5045	*/
sl@0	5046	EXPORT_C int
sl@0	5047	Tcl_FSConvertToPathType(interp, objPtr)
sl@0	5048	Tcl_Interp interp; / Interpreter in which to store error
sl@0	5049	* message (if necessary). */
sl@0	5050	Tcl_Obj objPtr; / Object to convert to a valid, current
sl@0	5051	* path type. */
sl@0	5052	{
sl@0	5053	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	5054
sl@0	5055	/*
sl@0	5056	* While it is bad practice to examine an object's type directly,
sl@0	5057	* this is actually the best thing to do here. The reason is that
sl@0	5058	* if we are converting this object to FsPath type for the first
sl@0	5059	* time, we don't need to worry whether the 'cwd' has changed.
sl@0	5060	* On the other hand, if this object is already of FsPath type,
sl@0	5061	* and is a relative path, we do have to worry about the cwd.
sl@0	5062	* If the cwd has changed, we must recompute the path.
sl@0	5063	*/
sl@0	5064	if (objPtr->typePtr == &tclFsPathType) {
sl@0	5065	FsPath fsPathPtr = (FsPath) PATHOBJ(objPtr);
sl@0	5066	if (fsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
sl@0	5067	if (objPtr->bytes == NULL) {
sl@0	5068	UpdateStringOfFsPath(objPtr);
sl@0	5069	}
sl@0	5070	FreeFsPathInternalRep(objPtr);
sl@0	5071	objPtr->typePtr = NULL;
sl@0	5072	return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
sl@0	5073	}
sl@0	5074	return TCL_OK;
sl@0	5075	} else {
sl@0	5076	return Tcl_ConvertToType(interp, objPtr, &tclFsPathType);
sl@0	5077	}
sl@0	5078	}
sl@0	5079
sl@0	5080	/*
sl@0	5081	* Helper function for SetFsPathFromAny. Returns position of first
sl@0	5082	* directory delimiter in the path.
sl@0	5083	*/
sl@0	5084	static int
sl@0	5085	FindSplitPos(path, separator)
sl@0	5086	char *path;
sl@0	5087	char *separator;
sl@0	5088	{
sl@0	5089	int count = 0;
sl@0	5090	switch (tclPlatform) {
sl@0	5091	case TCL_PLATFORM_UNIX:
sl@0	5092	case TCL_PLATFORM_MAC:
sl@0	5093	while (path[count] != 0) {
sl@0	5094	if (path[count] == *separator) {
sl@0	5095	return count;
sl@0	5096	}
sl@0	5097	count++;
sl@0	5098	}
sl@0	5099	break;
sl@0	5100
sl@0	5101	case TCL_PLATFORM_WINDOWS:
sl@0	5102	while (path[count] != 0) {
sl@0	5103	if (path[count] == *separator \|\| path[count] == '\\') {
sl@0	5104	return count;
sl@0	5105	}
sl@0	5106	count++;
sl@0	5107	}
sl@0	5108	break;
sl@0	5109	}
sl@0	5110	return count;
sl@0	5111	}
sl@0	5112
sl@0	5113	/*
sl@0	5114	*---------------------------------------------------------------------------
sl@0	5115	*
sl@0	5116	* TclNewFSPathObj --
sl@0	5117	*
sl@0	5118	* Creates a path object whose string representation is
sl@0	5119	* '[file join dirPtr addStrRep]', but does so in a way that
sl@0	5120	* allows for more efficient caching of normalized paths.
sl@0	5121	*
sl@0	5122	* Assumptions:
sl@0	5123	* 'dirPtr' must be an absolute path.
sl@0	5124	* 'len' may not be zero.
sl@0	5125	*
sl@0	5126	* Results:
sl@0	5127	* The new Tcl object, with refCount zero.
sl@0	5128	*
sl@0	5129	* Side effects:
sl@0	5130	* Memory is allocated. 'dirPtr' gets an additional refCount.
sl@0	5131	*
sl@0	5132	*---------------------------------------------------------------------------
sl@0	5133	*/
sl@0	5134
sl@0	5135	Tcl_Obj*
sl@0	5136	TclNewFSPathObj(Tcl_Obj dirPtr, CONST char addStrRep, int len)
sl@0	5137	{
sl@0	5138	FsPath *fsPathPtr;
sl@0	5139	Tcl_Obj *objPtr;
sl@0	5140	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	5141
sl@0	5142	objPtr = Tcl_NewObj();
sl@0	5143	fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
sl@0	5144
sl@0	5145	if (tclPlatform == TCL_PLATFORM_MAC) {
sl@0	5146	/*
sl@0	5147	* Mac relative paths may begin with a directory separator ':'.
sl@0	5148	* If present, we need to skip this ':' because we assume that
sl@0	5149	* we can join dirPtr and addStrRep by concatenating them as
sl@0	5150	* strings (and we ensure that dirPtr is terminated by a ':').
sl@0	5151	*/
sl@0	5152	if (addStrRep[0] == ':') {
sl@0	5153	addStrRep++;
sl@0	5154	len--;
sl@0	5155	}
sl@0	5156	}
sl@0	5157	/* Setup the path */
sl@0	5158	fsPathPtr->translatedPathPtr = NULL;
sl@0	5159	fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
sl@0	5160	Tcl_IncrRefCount(fsPathPtr->normPathPtr);
sl@0	5161	fsPathPtr->cwdPtr = dirPtr;
sl@0	5162	Tcl_IncrRefCount(dirPtr);
sl@0	5163	fsPathPtr->nativePathPtr = NULL;
sl@0	5164	fsPathPtr->fsRecPtr = NULL;
sl@0	5165	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
sl@0	5166
sl@0	5167	PATHOBJ(objPtr) = (VOID *) fsPathPtr;
sl@0	5168	PATHFLAGS(objPtr) = TCLPATH_RELATIVE \| TCLPATH_APPENDED;
sl@0	5169	objPtr->typePtr = &tclFsPathType;
sl@0	5170	objPtr->bytes = NULL;
sl@0	5171	objPtr->length = 0;
sl@0	5172
sl@0	5173	return objPtr;
sl@0	5174	}
sl@0	5175
sl@0	5176	/*
sl@0	5177	*---------------------------------------------------------------------------
sl@0	5178	*
sl@0	5179	* TclFSMakePathRelative --
sl@0	5180	*
sl@0	5181	* Only for internal use.
sl@0	5182	*
sl@0	5183	* Takes a path and a directory, where we _assume_ both path and
sl@0	5184	* directory are absolute, normalized and that the path lies
sl@0	5185	* inside the directory. Returns a Tcl_Obj representing filename
sl@0	5186	* of the path relative to the directory.
sl@0	5187	*
sl@0	5188	* In the case where the resulting path would start with a '~', we
sl@0	5189	* take special care to return an ordinary string. This means to
sl@0	5190	* use that path (and not have it interpreted as a user name),
sl@0	5191	* one must prepend './'. This may seem strange, but that is how
sl@0	5192	* 'glob' is currently defined.
sl@0	5193	*
sl@0	5194	* Results:
sl@0	5195	* NULL on error, otherwise a valid object, typically with
sl@0	5196	* refCount of zero, which it is assumed the caller will
sl@0	5197	* increment.
sl@0	5198	*
sl@0	5199	* Side effects:
sl@0	5200	* The old representation may be freed, and new memory allocated.
sl@0	5201	*
sl@0	5202	*---------------------------------------------------------------------------
sl@0	5203	*/
sl@0	5204
sl@0	5205	Tcl_Obj*
sl@0	5206	TclFSMakePathRelative(interp, objPtr, cwdPtr)
sl@0	5207	Tcl_Interp interp; / Used for error reporting if not NULL. */
sl@0	5208	Tcl_Obj objPtr; / The object we have. */
sl@0	5209	Tcl_Obj cwdPtr; / Make it relative to this. */
sl@0	5210	{
sl@0	5211	int cwdLen, len;
sl@0	5212	CONST char *tempStr;
sl@0	5213	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	5214
sl@0	5215	if (objPtr->typePtr == &tclFsPathType) {
sl@0	5216	FsPath fsPathPtr = (FsPath) PATHOBJ(objPtr);
sl@0	5217	if (PATHFLAGS(objPtr) != 0
sl@0	5218	&& fsPathPtr->cwdPtr == cwdPtr) {
sl@0	5219	objPtr = fsPathPtr->normPathPtr;
sl@0	5220	/* Free old representation */
sl@0	5221	if (objPtr->typePtr != NULL) {
sl@0	5222	if (objPtr->bytes == NULL) {
sl@0	5223	if (objPtr->typePtr->updateStringProc == NULL) {
sl@0	5224	if (interp != NULL) {
sl@0	5225	Tcl_ResetResult(interp);
sl@0	5226	Tcl_AppendResult(interp, "can't find object",
sl@0	5227	"string representation", (char *) NULL);
sl@0	5228	}
sl@0	5229	return NULL;
sl@0	5230	}
sl@0	5231	objPtr->typePtr->updateStringProc(objPtr);
sl@0	5232	}
sl@0	5233	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
sl@0	5234	(*objPtr->typePtr->freeIntRepProc)(objPtr);
sl@0	5235	}
sl@0	5236	}
sl@0	5237	/* Now objPtr is a string object */
sl@0	5238
sl@0	5239	if (Tcl_GetString(objPtr)[0] == '~') {
sl@0	5240	/*
sl@0	5241	* If the first character of the path is a tilde,
sl@0	5242	* we must just return the path as is, to agree
sl@0	5243	* with the defined behaviour of 'glob'.
sl@0	5244	*/
sl@0	5245	return objPtr;
sl@0	5246	}
sl@0	5247
sl@0	5248	fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
sl@0	5249
sl@0	5250	/* Circular reference, by design */
sl@0	5251	fsPathPtr->translatedPathPtr = objPtr;
sl@0	5252	fsPathPtr->normPathPtr = NULL;
sl@0	5253	fsPathPtr->cwdPtr = cwdPtr;
sl@0	5254	Tcl_IncrRefCount(cwdPtr);
sl@0	5255	fsPathPtr->nativePathPtr = NULL;
sl@0	5256	fsPathPtr->fsRecPtr = NULL;
sl@0	5257	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
sl@0	5258
sl@0	5259	PATHOBJ(objPtr) = (VOID *) fsPathPtr;
sl@0	5260	PATHFLAGS(objPtr) = 0;
sl@0	5261	objPtr->typePtr = &tclFsPathType;
sl@0	5262
sl@0	5263	return objPtr;
sl@0	5264	}
sl@0	5265	}
sl@0	5266	/*
sl@0	5267	* We know the cwd is a normalised object which does
sl@0	5268	* not end in a directory delimiter, unless the cwd
sl@0	5269	* is the name of a volume, in which case it will
sl@0	5270	* end in a delimiter! We handle this situation here.
sl@0	5271	* A better test than the '!= sep' might be to simply
sl@0	5272	* check if 'cwd' is a root volume.
sl@0	5273	*
sl@0	5274	* Note that if we get this wrong, we will strip off
sl@0	5275	* either too much or too little below, leading to
sl@0	5276	* wrong answers returned by glob.
sl@0	5277	*/
sl@0	5278	tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
sl@0	5279	/*
sl@0	5280	* Should we perhaps use 'Tcl_FSPathSeparator'?
sl@0	5281	* But then what about the Windows special case?
sl@0	5282	* Perhaps we should just check if cwd is a root
sl@0	5283	* volume.
sl@0	5284	*/
sl@0	5285	switch (tclPlatform) {
sl@0	5286	case TCL_PLATFORM_UNIX:
sl@0	5287	if (tempStr[cwdLen-1] != '/') {
sl@0	5288	cwdLen++;
sl@0	5289	}
sl@0	5290	break;
sl@0	5291	case TCL_PLATFORM_WINDOWS:
sl@0	5292	if (tempStr[cwdLen-1] != '/'
sl@0	5293	&& tempStr[cwdLen-1] != '\\') {
sl@0	5294	cwdLen++;
sl@0	5295	}
sl@0	5296	break;
sl@0	5297	case TCL_PLATFORM_MAC:
sl@0	5298	if (tempStr[cwdLen-1] != ':') {
sl@0	5299	cwdLen++;
sl@0	5300	}
sl@0	5301	break;
sl@0	5302	}
sl@0	5303	tempStr = Tcl_GetStringFromObj(objPtr, &len);
sl@0	5304
sl@0	5305	return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
sl@0	5306	}
sl@0	5307
sl@0	5308	/*
sl@0	5309	*---------------------------------------------------------------------------
sl@0	5310	*
sl@0	5311	* TclFSMakePathFromNormalized --
sl@0	5312	*
sl@0	5313	* Like SetFsPathFromAny, but assumes the given object is an
sl@0	5314	* absolute normalized path. Only for internal use.
sl@0	5315	*
sl@0	5316	* Results:
sl@0	5317	* Standard Tcl error code.
sl@0	5318	*
sl@0	5319	* Side effects:
sl@0	5320	* The old representation may be freed, and new memory allocated.
sl@0	5321	*
sl@0	5322	*---------------------------------------------------------------------------
sl@0	5323	*/
sl@0	5324
sl@0	5325	int
sl@0	5326	TclFSMakePathFromNormalized(interp, objPtr, nativeRep)
sl@0	5327	Tcl_Interp interp; / Used for error reporting if not NULL. */
sl@0	5328	Tcl_Obj objPtr; / The object to convert. */
sl@0	5329	ClientData nativeRep; /* The native rep for the object, if known
sl@0	5330	* else NULL. */
sl@0	5331	{
sl@0	5332	FsPath *fsPathPtr;
sl@0	5333	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	5334
sl@0	5335	if (objPtr->typePtr == &tclFsPathType) {
sl@0	5336	return TCL_OK;
sl@0	5337	}
sl@0	5338
sl@0	5339	/* Free old representation */
sl@0	5340	if (objPtr->typePtr != NULL) {
sl@0	5341	if (objPtr->bytes == NULL) {
sl@0	5342	if (objPtr->typePtr->updateStringProc == NULL) {
sl@0	5343	if (interp != NULL) {
sl@0	5344	Tcl_ResetResult(interp);
sl@0	5345	Tcl_AppendResult(interp, "can't find object",
sl@0	5346	"string representation", (char *) NULL);
sl@0	5347	}
sl@0	5348	return TCL_ERROR;
sl@0	5349	}
sl@0	5350	objPtr->typePtr->updateStringProc(objPtr);
sl@0	5351	}
sl@0	5352	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
sl@0	5353	(*objPtr->typePtr->freeIntRepProc)(objPtr);
sl@0	5354	}
sl@0	5355	}
sl@0	5356
sl@0	5357	fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
sl@0	5358	/* It's a pure normalized absolute path */
sl@0	5359	fsPathPtr->translatedPathPtr = NULL;
sl@0	5360	fsPathPtr->normPathPtr = objPtr;
sl@0	5361	fsPathPtr->cwdPtr = NULL;
sl@0	5362	fsPathPtr->nativePathPtr = nativeRep;
sl@0	5363	fsPathPtr->fsRecPtr = NULL;
sl@0	5364	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
sl@0	5365
sl@0	5366	PATHOBJ(objPtr) = (VOID *) fsPathPtr;
sl@0	5367	PATHFLAGS(objPtr) = 0;
sl@0	5368	objPtr->typePtr = &tclFsPathType;
sl@0	5369
sl@0	5370	return TCL_OK;
sl@0	5371	}
sl@0	5372
sl@0	5373	/*
sl@0	5374	*---------------------------------------------------------------------------
sl@0	5375	*
sl@0	5376	* Tcl_FSNewNativePath --
sl@0	5377	*
sl@0	5378	* This function performs the something like that reverse of the
sl@0	5379	* usual obj->path->nativerep conversions. If some code retrieves
sl@0	5380	* a path in native form (from, e.g. readlink or a native dialog),
sl@0	5381	* and that path is to be used at the Tcl level, then calling
sl@0	5382	* this function is an efficient way of creating the appropriate
sl@0	5383	* path object type.
sl@0	5384	*
sl@0	5385	* Any memory which is allocated for 'clientData' should be retained
sl@0	5386	* until clientData is passed to the filesystem's freeInternalRepProc
sl@0	5387	* when it can be freed. The built in platform-specific filesystems
sl@0	5388	* use 'ckalloc' to allocate clientData, and ckfree to free it.
sl@0	5389	*
sl@0	5390	* Results:
sl@0	5391	* NULL or a valid path object pointer, with refCount zero.
sl@0	5392	*
sl@0	5393	* Side effects:
sl@0	5394	* New memory may be allocated.
sl@0	5395	*
sl@0	5396	*---------------------------------------------------------------------------
sl@0	5397	*/
sl@0	5398
sl@0	5399	EXPORT_C Tcl_Obj *
sl@0	5400	Tcl_FSNewNativePath(fromFilesystem, clientData)
sl@0	5401	Tcl_Filesystem* fromFilesystem;
sl@0	5402	ClientData clientData;
sl@0	5403	{
sl@0	5404	Tcl_Obj *objPtr;
sl@0	5405	FsPath *fsPathPtr;
sl@0	5406
sl@0	5407	FilesystemRecord *fsFromPtr;
sl@0	5408	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	5409
sl@0	5410	objPtr = TclFSInternalToNormalized(fromFilesystem, clientData, &fsFromPtr);
sl@0	5411	if (objPtr == NULL) {
sl@0	5412	return NULL;
sl@0	5413	}
sl@0	5414
sl@0	5415	/*
sl@0	5416	* Free old representation; shouldn't normally be any,
sl@0	5417	* but best to be safe.
sl@0	5418	*/
sl@0	5419	if (objPtr->typePtr != NULL) {
sl@0	5420	if (objPtr->bytes == NULL) {
sl@0	5421	if (objPtr->typePtr->updateStringProc == NULL) {
sl@0	5422	return NULL;
sl@0	5423	}
sl@0	5424	objPtr->typePtr->updateStringProc(objPtr);
sl@0	5425	}
sl@0	5426	if ((objPtr->typePtr->freeIntRepProc) != NULL) {
sl@0	5427	(*objPtr->typePtr->freeIntRepProc)(objPtr);
sl@0	5428	}
sl@0	5429	}
sl@0	5430
sl@0	5431	fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
sl@0	5432
sl@0	5433	fsPathPtr->translatedPathPtr = NULL;
sl@0	5434	/* Circular reference, by design */
sl@0	5435	fsPathPtr->normPathPtr = objPtr;
sl@0	5436	fsPathPtr->cwdPtr = NULL;
sl@0	5437	fsPathPtr->nativePathPtr = clientData;
sl@0	5438	fsPathPtr->fsRecPtr = fsFromPtr;
sl@0	5439	fsPathPtr->fsRecPtr->fileRefCount++;
sl@0	5440	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
sl@0	5441
sl@0	5442	PATHOBJ(objPtr) = (VOID *) fsPathPtr;
sl@0	5443	PATHFLAGS(objPtr) = 0;
sl@0	5444	objPtr->typePtr = &tclFsPathType;
sl@0	5445
sl@0	5446	return objPtr;
sl@0	5447	}
sl@0	5448
sl@0	5449	/*
sl@0	5450	*---------------------------------------------------------------------------
sl@0	5451	*
sl@0	5452	* Tcl_FSGetTranslatedPath --
sl@0	5453	*
sl@0	5454	* This function attempts to extract the translated path
sl@0	5455	* from the given Tcl_Obj. If the translation succeeds (i.e. the
sl@0	5456	* object is a valid path), then it is returned. Otherwise NULL
sl@0	5457	* will be returned, and an error message may be left in the
sl@0	5458	* interpreter (if it is non-NULL)
sl@0	5459	*
sl@0	5460	* Results:
sl@0	5461	* NULL or a valid Tcl_Obj pointer.
sl@0	5462	*
sl@0	5463	* Side effects:
sl@0	5464	* Only those of 'Tcl_FSConvertToPathType'
sl@0	5465	*
sl@0	5466	*---------------------------------------------------------------------------
sl@0	5467	*/
sl@0	5468
sl@0	5469	EXPORT_C Tcl_Obj*
sl@0	5470	Tcl_FSGetTranslatedPath(interp, pathPtr)
sl@0	5471	Tcl_Interp *interp;
sl@0	5472	Tcl_Obj* pathPtr;
sl@0	5473	{
sl@0	5474	Tcl_Obj *retObj = NULL;
sl@0	5475	FsPath *srcFsPathPtr;
sl@0	5476
sl@0	5477	if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
sl@0	5478	return NULL;
sl@0	5479	}
sl@0	5480	srcFsPathPtr = (FsPath*) PATHOBJ(pathPtr);
sl@0	5481	if (srcFsPathPtr->translatedPathPtr == NULL) {
sl@0	5482	if (PATHFLAGS(pathPtr) != 0) {
sl@0	5483	retObj = Tcl_FSGetNormalizedPath(interp, pathPtr);
sl@0	5484	} else {
sl@0	5485	/*
sl@0	5486	* It is a pure absolute, normalized path object.
sl@0	5487	* This is something like being a 'pure list'. The
sl@0	5488	* object's string, translatedPath and normalizedPath
sl@0	5489	* are all identical.
sl@0	5490	*/
sl@0	5491	retObj = srcFsPathPtr->normPathPtr;
sl@0	5492	}
sl@0	5493	} else {
sl@0	5494	/* It is an ordinary path object */
sl@0	5495	retObj = srcFsPathPtr->translatedPathPtr;
sl@0	5496	}
sl@0	5497
sl@0	5498	if (retObj) {
sl@0	5499	Tcl_IncrRefCount(retObj);
sl@0	5500	}
sl@0	5501	return retObj;
sl@0	5502	}
sl@0	5503
sl@0	5504	/*
sl@0	5505	*---------------------------------------------------------------------------
sl@0	5506	*
sl@0	5507	* Tcl_FSGetTranslatedStringPath --
sl@0	5508	*
sl@0	5509	* This function attempts to extract the translated path
sl@0	5510	* from the given Tcl_Obj. If the translation succeeds (i.e. the
sl@0	5511	* object is a valid path), then the path is returned. Otherwise NULL
sl@0	5512	* will be returned, and an error message may be left in the
sl@0	5513	* interpreter (if it is non-NULL)
sl@0	5514	*
sl@0	5515	* Results:
sl@0	5516	* NULL or a valid string.
sl@0	5517	*
sl@0	5518	* Side effects:
sl@0	5519	* Only those of 'Tcl_FSConvertToPathType'
sl@0	5520	*
sl@0	5521	*---------------------------------------------------------------------------
sl@0	5522	*/
sl@0	5523	EXPORT_C CONST char*
sl@0	5524	Tcl_FSGetTranslatedStringPath(interp, pathPtr)
sl@0	5525	Tcl_Interp *interp;
sl@0	5526	Tcl_Obj* pathPtr;
sl@0	5527	{
sl@0	5528	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
sl@0	5529
sl@0	5530	if (transPtr != NULL) {
sl@0	5531	int len;
sl@0	5532	CONST char result, orig;
sl@0	5533	orig = Tcl_GetStringFromObj(transPtr, &len);
sl@0	5534	result = (char*) ckalloc((unsigned)(len+1));
sl@0	5535	memcpy((VOID) result, (VOID) orig, (size_t) (len+1));
sl@0	5536	Tcl_DecrRefCount(transPtr);
sl@0	5537	return result;
sl@0	5538	}
sl@0	5539
sl@0	5540	return NULL;
sl@0	5541	}
sl@0	5542
sl@0	5543	/*
sl@0	5544	*---------------------------------------------------------------------------
sl@0	5545	*
sl@0	5546	* Tcl_FSGetNormalizedPath --
sl@0	5547	*
sl@0	5548	* This important function attempts to extract from the given Tcl_Obj
sl@0	5549	* a unique normalised path representation, whose string value can
sl@0	5550	* be used as a unique identifier for the file.
sl@0	5551	*
sl@0	5552	* Results:
sl@0	5553	* NULL or a valid path object pointer.
sl@0	5554	*
sl@0	5555	* Side effects:
sl@0	5556	* New memory may be allocated. The Tcl 'errno' may be modified
sl@0	5557	* in the process of trying to examine various path possibilities.
sl@0	5558	*
sl@0	5559	*---------------------------------------------------------------------------
sl@0	5560	*/
sl@0	5561
sl@0	5562	EXPORT_C Tcl_Obj*
sl@0	5563	Tcl_FSGetNormalizedPath(interp, pathObjPtr)
sl@0	5564	Tcl_Interp *interp;
sl@0	5565	Tcl_Obj* pathObjPtr;
sl@0	5566	{
sl@0	5567	FsPath *fsPathPtr;
sl@0	5568
sl@0	5569	if (Tcl_FSConvertToPathType(interp, pathObjPtr) != TCL_OK) {
sl@0	5570	return NULL;
sl@0	5571	}
sl@0	5572	fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	5573
sl@0	5574	if (PATHFLAGS(pathObjPtr) != 0) {
sl@0	5575	/*
sl@0	5576	* This is a special path object which is the result of
sl@0	5577	* something like 'file join'
sl@0	5578	*/
sl@0	5579	Tcl_Obj dir, copy;
sl@0	5580	int cwdLen;
sl@0	5581	int pathType;
sl@0	5582	CONST char *cwdStr;
sl@0	5583	ClientData clientData = NULL;
sl@0	5584
sl@0	5585	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
sl@0	5586	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
sl@0	5587	if (dir == NULL) {
sl@0	5588	return NULL;
sl@0	5589	}
sl@0	5590	if (pathObjPtr->bytes == NULL) {
sl@0	5591	UpdateStringOfFsPath(pathObjPtr);
sl@0	5592	}
sl@0	5593	copy = Tcl_DuplicateObj(dir);
sl@0	5594	Tcl_IncrRefCount(copy);
sl@0	5595	Tcl_IncrRefCount(dir);
sl@0	5596	/* We now own a reference on both 'dir' and 'copy' */
sl@0	5597
sl@0	5598	cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
sl@0	5599	/*
sl@0	5600	* Should we perhaps use 'Tcl_FSPathSeparator'?
sl@0	5601	* But then what about the Windows special case?
sl@0	5602	* Perhaps we should just check if cwd is a root volume.
sl@0	5603	* We should never get cwdLen == 0 in this code path.
sl@0	5604	*/
sl@0	5605	switch (tclPlatform) {
sl@0	5606	case TCL_PLATFORM_UNIX:
sl@0	5607	if (cwdStr[cwdLen-1] != '/') {
sl@0	5608	Tcl_AppendToObj(copy, "/", 1);
sl@0	5609	cwdLen++;
sl@0	5610	}
sl@0	5611	break;
sl@0	5612	case TCL_PLATFORM_WINDOWS:
sl@0	5613	if (cwdStr[cwdLen-1] != '/'
sl@0	5614	&& cwdStr[cwdLen-1] != '\\') {
sl@0	5615	Tcl_AppendToObj(copy, "/", 1);
sl@0	5616	cwdLen++;
sl@0	5617	}
sl@0	5618	break;
sl@0	5619	case TCL_PLATFORM_MAC:
sl@0	5620	if (cwdStr[cwdLen-1] != ':') {
sl@0	5621	Tcl_AppendToObj(copy, ":", 1);
sl@0	5622	cwdLen++;
sl@0	5623	}
sl@0	5624	break;
sl@0	5625	}
sl@0	5626	Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
sl@0	5627	/*
sl@0	5628	* Normalize the combined string, but only starting after
sl@0	5629	* the end of the previously normalized 'dir'. This should
sl@0	5630	* be much faster! We use 'cwdLen-1' so that we are
sl@0	5631	* already pointing at the dir-separator that we know about.
sl@0	5632	* The normalization code will actually start off directly
sl@0	5633	* after that separator.
sl@0	5634	*/
sl@0	5635	TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
sl@0	5636	(fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
sl@0	5637	/* Now we need to construct the new path object */
sl@0	5638
sl@0	5639	if (pathType == TCL_PATH_RELATIVE) {
sl@0	5640	FsPath* origDirFsPathPtr;
sl@0	5641	Tcl_Obj *origDir = fsPathPtr->cwdPtr;
sl@0	5642	origDirFsPathPtr = (FsPath*) PATHOBJ(origDir);
sl@0	5643
sl@0	5644	fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
sl@0	5645	Tcl_IncrRefCount(fsPathPtr->cwdPtr);
sl@0	5646
sl@0	5647	Tcl_DecrRefCount(fsPathPtr->normPathPtr);
sl@0	5648	fsPathPtr->normPathPtr = copy;
sl@0	5649	/* That's our reference to copy used */
sl@0	5650	Tcl_DecrRefCount(dir);
sl@0	5651	Tcl_DecrRefCount(origDir);
sl@0	5652	} else {
sl@0	5653	Tcl_DecrRefCount(fsPathPtr->cwdPtr);
sl@0	5654	fsPathPtr->cwdPtr = NULL;
sl@0	5655	Tcl_DecrRefCount(fsPathPtr->normPathPtr);
sl@0	5656	fsPathPtr->normPathPtr = copy;
sl@0	5657	/* That's our reference to copy used */
sl@0	5658	Tcl_DecrRefCount(dir);
sl@0	5659	}
sl@0	5660	if (clientData != NULL) {
sl@0	5661	fsPathPtr->nativePathPtr = clientData;
sl@0	5662	}
sl@0	5663	PATHFLAGS(pathObjPtr) = 0;
sl@0	5664	}
sl@0	5665	/* Ensure cwd hasn't changed */
sl@0	5666	if (fsPathPtr->cwdPtr != NULL) {
sl@0	5667	if (!TclFSCwdPointerEquals(fsPathPtr->cwdPtr)) {
sl@0	5668	if (pathObjPtr->bytes == NULL) {
sl@0	5669	UpdateStringOfFsPath(pathObjPtr);
sl@0	5670	}
sl@0	5671	FreeFsPathInternalRep(pathObjPtr);
sl@0	5672	pathObjPtr->typePtr = NULL;
sl@0	5673	if (Tcl_ConvertToType(interp, pathObjPtr,
sl@0	5674	&tclFsPathType) != TCL_OK) {
sl@0	5675	return NULL;
sl@0	5676	}
sl@0	5677	fsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	5678	} else if (fsPathPtr->normPathPtr == NULL) {
sl@0	5679	int cwdLen;
sl@0	5680	Tcl_Obj *copy;
sl@0	5681	CONST char *cwdStr;
sl@0	5682	ClientData clientData = NULL;
sl@0	5683
sl@0	5684	copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
sl@0	5685	Tcl_IncrRefCount(copy);
sl@0	5686	cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
sl@0	5687	/*
sl@0	5688	* Should we perhaps use 'Tcl_FSPathSeparator'?
sl@0	5689	* But then what about the Windows special case?
sl@0	5690	* Perhaps we should just check if cwd is a root volume.
sl@0	5691	* We should never get cwdLen == 0 in this code path.
sl@0	5692	*/
sl@0	5693	switch (tclPlatform) {
sl@0	5694	case TCL_PLATFORM_UNIX:
sl@0	5695	if (cwdStr[cwdLen-1] != '/') {
sl@0	5696	Tcl_AppendToObj(copy, "/", 1);
sl@0	5697	cwdLen++;
sl@0	5698	}
sl@0	5699	break;
sl@0	5700	case TCL_PLATFORM_WINDOWS:
sl@0	5701	if (cwdStr[cwdLen-1] != '/'
sl@0	5702	&& cwdStr[cwdLen-1] != '\\') {
sl@0	5703	Tcl_AppendToObj(copy, "/", 1);
sl@0	5704	cwdLen++;
sl@0	5705	}
sl@0	5706	break;
sl@0	5707	case TCL_PLATFORM_MAC:
sl@0	5708	if (cwdStr[cwdLen-1] != ':') {
sl@0	5709	Tcl_AppendToObj(copy, ":", 1);
sl@0	5710	cwdLen++;
sl@0	5711	}
sl@0	5712	break;
sl@0	5713	}
sl@0	5714	Tcl_AppendObjToObj(copy, pathObjPtr);
sl@0	5715	/*
sl@0	5716	* Normalize the combined string, but only starting after
sl@0	5717	* the end of the previously normalized 'dir'. This should
sl@0	5718	* be much faster!
sl@0	5719	*/
sl@0	5720	TclFSNormalizeToUniquePath(interp, copy, cwdLen-1,
sl@0	5721	(fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
sl@0	5722	fsPathPtr->normPathPtr = copy;
sl@0	5723	if (clientData != NULL) {
sl@0	5724	fsPathPtr->nativePathPtr = clientData;
sl@0	5725	}
sl@0	5726	}
sl@0	5727	}
sl@0	5728	if (fsPathPtr->normPathPtr == NULL) {
sl@0	5729	ClientData clientData = NULL;
sl@0	5730	Tcl_Obj *useThisCwd = NULL;
sl@0	5731	/*
sl@0	5732	* Since normPathPtr is NULL, but this is a valid path
sl@0	5733	* object, we know that the translatedPathPtr cannot be NULL.
sl@0	5734	*/
sl@0	5735	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
sl@0	5736	char *path = Tcl_GetString(absolutePath);
sl@0	5737
sl@0	5738	/*
sl@0	5739	* We have to be a little bit careful here to avoid infinite loops
sl@0	5740	* we're asking Tcl_FSGetPathType to return the path's type, but
sl@0	5741	* that call can actually result in a lot of other filesystem
sl@0	5742	* action, which might loop back through here.
sl@0	5743	*/
sl@0	5744	if (path[0] != '\0') {
sl@0	5745	Tcl_PathType type = Tcl_FSGetPathType(pathObjPtr);
sl@0	5746	if (type == TCL_PATH_RELATIVE) {
sl@0	5747	useThisCwd = Tcl_FSGetCwd(interp);
sl@0	5748
sl@0	5749	if (useThisCwd == NULL) return NULL;
sl@0	5750
sl@0	5751	absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
sl@0	5752	Tcl_IncrRefCount(absolutePath);
sl@0	5753	/* We have a refCount on the cwd */
sl@0	5754	#ifdef __WIN32__
sl@0	5755	} else if (type == TCL_PATH_VOLUME_RELATIVE) {
sl@0	5756	/*
sl@0	5757	* Only Windows has volume-relative paths. These
sl@0	5758	* paths are rather rare, but is is nice if Tcl can
sl@0	5759	* handle them. It is much better if we can
sl@0	5760	* handle them here, rather than in the native fs code,
sl@0	5761	* because we really need to have a real absolute path
sl@0	5762	* just below.
sl@0	5763	*
sl@0	5764	* We do not let this block compile on non-Windows
sl@0	5765	* platforms because the test suite's manual forcing
sl@0	5766	* of tclPlatform can otherwise cause this code path
sl@0	5767	* to be executed, causing various errors because
sl@0	5768	* volume-relative paths really do not exist.
sl@0	5769	*/
sl@0	5770	useThisCwd = Tcl_FSGetCwd(interp);
sl@0	5771	if (useThisCwd == NULL) return NULL;
sl@0	5772
sl@0	5773	if (path[0] == '/') {
sl@0	5774	/*
sl@0	5775	* Path of form /foo/bar which is a path in the
sl@0	5776	* root directory of the current volume.
sl@0	5777	*/
sl@0	5778	CONST char *drive = Tcl_GetString(useThisCwd);
sl@0	5779	absolutePath = Tcl_NewStringObj(drive,2);
sl@0	5780	Tcl_AppendToObj(absolutePath, path, -1);
sl@0	5781	Tcl_IncrRefCount(absolutePath);
sl@0	5782	/* We have a refCount on the cwd */
sl@0	5783	} else {
sl@0	5784	/*
sl@0	5785	* Path of form C:foo/bar, but this only makes
sl@0	5786	* sense if the cwd is also on drive C.
sl@0	5787	*/
sl@0	5788	CONST char *drive = Tcl_GetString(useThisCwd);
sl@0	5789	char drive_c = path[0];
sl@0	5790	if (drive_c >= 'a') {
sl@0	5791	drive_c -= ('a' - 'A');
sl@0	5792	}
sl@0	5793	if (drive[0] == drive_c) {
sl@0	5794	absolutePath = Tcl_DuplicateObj(useThisCwd);
sl@0	5795	/* We have a refCount on the cwd */
sl@0	5796	} else {
sl@0	5797	Tcl_DecrRefCount(useThisCwd);
sl@0	5798	useThisCwd = NULL;
sl@0	5799	/*
sl@0	5800	* The path is not in the current drive, but
sl@0	5801	* is volume-relative. The way Tcl 8.3 handles
sl@0	5802	* this is that it treats such a path as
sl@0	5803	* relative to the root of the drive. We
sl@0	5804	* therefore behave the same here.
sl@0	5805	*/
sl@0	5806	absolutePath = Tcl_NewStringObj(path, 2);
sl@0	5807	}
sl@0	5808	Tcl_IncrRefCount(absolutePath);
sl@0	5809	Tcl_AppendToObj(absolutePath, "/", 1);
sl@0	5810	Tcl_AppendToObj(absolutePath, path+2, -1);
sl@0	5811	}
sl@0	5812	#endif /* __WIN32__ */
sl@0	5813	}
sl@0	5814	}
sl@0	5815	/* Already has refCount incremented */
sl@0	5816	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp, absolutePath,
sl@0	5817	(fsPathPtr->nativePathPtr == NULL ? &clientData : NULL));
sl@0	5818	if (0 && (clientData != NULL)) {
sl@0	5819	fsPathPtr->nativePathPtr =
sl@0	5820	(*fsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc)(clientData);
sl@0	5821	}
sl@0	5822	if (!strcmp(Tcl_GetString(fsPathPtr->normPathPtr),
sl@0	5823	Tcl_GetString(pathObjPtr))) {
sl@0	5824	/*
sl@0	5825	* The path was already normalized.
sl@0	5826	* Get rid of the duplicate.
sl@0	5827	*/
sl@0	5828	Tcl_DecrRefCount(fsPathPtr->normPathPtr);
sl@0	5829	/*
sl@0	5830	* We do not increment the refCount for
sl@0	5831	* this circular reference
sl@0	5832	*/
sl@0	5833	fsPathPtr->normPathPtr = pathObjPtr;
sl@0	5834	}
sl@0	5835	if (useThisCwd != NULL) {
sl@0	5836	/* This was returned by Tcl_FSJoinToPath above */
sl@0	5837	Tcl_DecrRefCount(absolutePath);
sl@0	5838	fsPathPtr->cwdPtr = useThisCwd;
sl@0	5839	}
sl@0	5840	}
sl@0	5841
sl@0	5842	return fsPathPtr->normPathPtr;
sl@0	5843	}
sl@0	5844
sl@0	5845	/*
sl@0	5846	*---------------------------------------------------------------------------
sl@0	5847	*
sl@0	5848	* Tcl_FSGetInternalRep --
sl@0	5849	*
sl@0	5850	* Extract the internal representation of a given path object,
sl@0	5851	* in the given filesystem. If the path object belongs to a
sl@0	5852	* different filesystem, we return NULL.
sl@0	5853	*
sl@0	5854	* If the internal representation is currently NULL, we attempt
sl@0	5855	* to generate it, by calling the filesystem's
sl@0	5856	* 'Tcl_FSCreateInternalRepProc'.
sl@0	5857	*
sl@0	5858	* Results:
sl@0	5859	* NULL or a valid internal representation.
sl@0	5860	*
sl@0	5861	* Side effects:
sl@0	5862	* An attempt may be made to convert the object.
sl@0	5863	*
sl@0	5864	*---------------------------------------------------------------------------
sl@0	5865	*/
sl@0	5866
sl@0	5867	EXPORT_C ClientData
sl@0	5868	Tcl_FSGetInternalRep(pathObjPtr, fsPtr)
sl@0	5869	Tcl_Obj* pathObjPtr;
sl@0	5870	Tcl_Filesystem *fsPtr;
sl@0	5871	{
sl@0	5872	FsPath *srcFsPathPtr;
sl@0	5873
sl@0	5874	if (Tcl_FSConvertToPathType(NULL, pathObjPtr) != TCL_OK) {
sl@0	5875	return NULL;
sl@0	5876	}
sl@0	5877	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	5878
sl@0	5879	/*
sl@0	5880	* We will only return the native representation for the caller's
sl@0	5881	* filesystem. Otherwise we will simply return NULL. This means
sl@0	5882	* that there must be a unique bi-directional mapping between paths
sl@0	5883	* and filesystems, and that this mapping will not allow 'remapped'
sl@0	5884	* files -- files which are in one filesystem but mapped into
sl@0	5885	* another. Another way of putting this is that 'stacked'
sl@0	5886	* filesystems are not allowed. We recognise that this is a
sl@0	5887	* potentially useful feature for the future.
sl@0	5888	*
sl@0	5889	* Even something simple like a 'pass through' filesystem which
sl@0	5890	* logs all activity and passes the calls onto the native system
sl@0	5891	* would be nice, but not easily achievable with the current
sl@0	5892	* implementation.
sl@0	5893	*/
sl@0	5894	if (srcFsPathPtr->fsRecPtr == NULL) {
sl@0	5895	/*
sl@0	5896	* This only usually happens in wrappers like TclpStat which
sl@0	5897	* create a string object and pass it to TclpObjStat. Code
sl@0	5898	* which calls the Tcl_FS.. functions should always have a
sl@0	5899	* filesystem already set. Whether this code path is legal or
sl@0	5900	* not depends on whether we decide to allow external code to
sl@0	5901	* call the native filesystem directly. It is at least safer
sl@0	5902	* to allow this sub-optimal routing.
sl@0	5903	*/
sl@0	5904	Tcl_FSGetFileSystemForPath(pathObjPtr);
sl@0	5905
sl@0	5906	/*
sl@0	5907	* If we fail through here, then the path is probably not a
sl@0	5908	* valid path in the filesystsem, and is most likely to be a
sl@0	5909	* use of the empty path "" via a direct call to one of the
sl@0	5910	* objectified interfaces (e.g. from the Tcl testsuite).
sl@0	5911	*/
sl@0	5912	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	5913	if (srcFsPathPtr->fsRecPtr == NULL) {
sl@0	5914	return NULL;
sl@0	5915	}
sl@0	5916	}
sl@0	5917
sl@0	5918	if (fsPtr != srcFsPathPtr->fsRecPtr->fsPtr) {
sl@0	5919	/*
sl@0	5920	* There is still one possibility we should consider; if the
sl@0	5921	* file belongs to a different filesystem, perhaps it is
sl@0	5922	* actually linked through to a file in our own filesystem
sl@0	5923	* which we do care about. The way we can check for this
sl@0	5924	* is we ask what filesystem this path belongs to.
sl@0	5925	*/
sl@0	5926	Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathObjPtr);
sl@0	5927	if (actualFs == fsPtr) {
sl@0	5928	return Tcl_FSGetInternalRep(pathObjPtr, fsPtr);
sl@0	5929	}
sl@0	5930	return NULL;
sl@0	5931	}
sl@0	5932
sl@0	5933	if (srcFsPathPtr->nativePathPtr == NULL) {
sl@0	5934	Tcl_FSCreateInternalRepProc *proc;
sl@0	5935	char *nativePathPtr;
sl@0	5936
sl@0	5937	proc = srcFsPathPtr->fsRecPtr->fsPtr->createInternalRepProc;
sl@0	5938	if (proc == NULL) {
sl@0	5939	return NULL;
sl@0	5940	}
sl@0	5941
sl@0	5942	nativePathPtr = (*proc)(pathObjPtr);
sl@0	5943	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	5944	srcFsPathPtr->nativePathPtr = nativePathPtr;
sl@0	5945	}
sl@0	5946
sl@0	5947	return srcFsPathPtr->nativePathPtr;
sl@0	5948	}
sl@0	5949
sl@0	5950	/*
sl@0	5951	*---------------------------------------------------------------------------
sl@0	5952	*
sl@0	5953	* TclFSEnsureEpochOk --
sl@0	5954	*
sl@0	5955	* This will ensure the pathObjPtr is up to date and can be
sl@0	5956	* converted into a "path" type, and that we are able to generate a
sl@0	5957	* complete normalized path which is used to determine the
sl@0	5958	* filesystem match.
sl@0	5959	*
sl@0	5960	* Results:
sl@0	5961	* Standard Tcl return code.
sl@0	5962	*
sl@0	5963	* Side effects:
sl@0	5964	* An attempt may be made to convert the object.
sl@0	5965	*
sl@0	5966	*---------------------------------------------------------------------------
sl@0	5967	*/
sl@0	5968
sl@0	5969	int
sl@0	5970	TclFSEnsureEpochOk(pathObjPtr, fsPtrPtr)
sl@0	5971	Tcl_Obj* pathObjPtr;
sl@0	5972	Tcl_Filesystem **fsPtrPtr;
sl@0	5973	{
sl@0	5974	FsPath *srcFsPathPtr;
sl@0	5975	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	5976
sl@0	5977	/*
sl@0	5978	* SHOULD BE ABLE TO IMPROVE EFFICIENCY HERE.
sl@0	5979	*/
sl@0	5980
sl@0	5981	if (Tcl_FSGetNormalizedPath(NULL, pathObjPtr) == NULL) {
sl@0	5982	return TCL_ERROR;
sl@0	5983	}
sl@0	5984
sl@0	5985	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	5986
sl@0	5987	/*
sl@0	5988	* Check if the filesystem has changed in some way since
sl@0	5989	* this object's internal representation was calculated.
sl@0	5990	*/
sl@0	5991	if (srcFsPathPtr->filesystemEpoch != tsdPtr->filesystemEpoch) {
sl@0	5992	/*
sl@0	5993	* We have to discard the stale representation and
sl@0	5994	* recalculate it
sl@0	5995	*/
sl@0	5996	if (pathObjPtr->bytes == NULL) {
sl@0	5997	UpdateStringOfFsPath(pathObjPtr);
sl@0	5998	}
sl@0	5999	FreeFsPathInternalRep(pathObjPtr);
sl@0	6000	pathObjPtr->typePtr = NULL;
sl@0	6001	if (SetFsPathFromAny(NULL, pathObjPtr) != TCL_OK) {
sl@0	6002	return TCL_ERROR;
sl@0	6003	}
sl@0	6004	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	6005	}
sl@0	6006	/* Check whether the object is already assigned to a fs */
sl@0	6007	if (srcFsPathPtr->fsRecPtr != NULL) {
sl@0	6008	*fsPtrPtr = srcFsPathPtr->fsRecPtr->fsPtr;
sl@0	6009	}
sl@0	6010
sl@0	6011	return TCL_OK;
sl@0	6012	}
sl@0	6013
sl@0	6014	void
sl@0	6015	TclFSSetPathDetails(pathObjPtr, fsRecPtr, clientData)
sl@0	6016	Tcl_Obj *pathObjPtr;
sl@0	6017	FilesystemRecord *fsRecPtr;
sl@0	6018	ClientData clientData;
sl@0	6019	{
sl@0	6020	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	6021	/* We assume pathObjPtr is already of the correct type */
sl@0	6022	FsPath *srcFsPathPtr;
sl@0	6023
sl@0	6024	srcFsPathPtr = (FsPath*) PATHOBJ(pathObjPtr);
sl@0	6025	srcFsPathPtr->fsRecPtr = fsRecPtr;
sl@0	6026	srcFsPathPtr->nativePathPtr = clientData;
sl@0	6027	srcFsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
sl@0	6028	fsRecPtr->fileRefCount++;
sl@0	6029	}
sl@0	6030
sl@0	6031	/*
sl@0	6032	*---------------------------------------------------------------------------
sl@0	6033	*
sl@0	6034	* Tcl_FSEqualPaths --
sl@0	6035	*
sl@0	6036	* This function tests whether the two paths given are equal path
sl@0	6037	* objects. If either or both is NULL, 0 is always returned.
sl@0	6038	*
sl@0	6039	* Results:
sl@0	6040	* 1 or 0.
sl@0	6041	*
sl@0	6042	* Side effects:
sl@0	6043	* None.
sl@0	6044	*
sl@0	6045	*---------------------------------------------------------------------------
sl@0	6046	*/
sl@0	6047
sl@0	6048	EXPORT_C int
sl@0	6049	Tcl_FSEqualPaths(firstPtr, secondPtr)
sl@0	6050	Tcl_Obj* firstPtr;
sl@0	6051	Tcl_Obj* secondPtr;
sl@0	6052	{
sl@0	6053	if (firstPtr == secondPtr) {
sl@0	6054	return 1;
sl@0	6055	} else {
sl@0	6056	char firstStr, secondStr;
sl@0	6057	int firstLen, secondLen, tempErrno;
sl@0	6058
sl@0	6059	if (firstPtr == NULL \|\| secondPtr == NULL) {
sl@0	6060	return 0;
sl@0	6061	}
sl@0	6062	firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
sl@0	6063	secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
sl@0	6064	if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
sl@0	6065	return 1;
sl@0	6066	}
sl@0	6067	/*
sl@0	6068	* Try the most thorough, correct method of comparing fully
sl@0	6069	* normalized paths
sl@0	6070	*/
sl@0	6071
sl@0	6072	tempErrno = Tcl_GetErrno();
sl@0	6073	firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
sl@0	6074	secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
sl@0	6075	Tcl_SetErrno(tempErrno);
sl@0	6076
sl@0	6077	if (firstPtr == NULL \|\| secondPtr == NULL) {
sl@0	6078	return 0;
sl@0	6079	}
sl@0	6080	firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
sl@0	6081	secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
sl@0	6082	if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
sl@0	6083	return 1;
sl@0	6084	}
sl@0	6085	}
sl@0	6086
sl@0	6087	return 0;
sl@0	6088	}
sl@0	6089
sl@0	6090	/*
sl@0	6091	*---------------------------------------------------------------------------
sl@0	6092	*
sl@0	6093	* SetFsPathFromAny --
sl@0	6094	*
sl@0	6095	* This function tries to convert the given Tcl_Obj to a valid
sl@0	6096	* Tcl path type.
sl@0	6097	*
sl@0	6098	* The filename may begin with "~" (to indicate current user's
sl@0	6099	* home directory) or "~<user>" (to indicate any user's home
sl@0	6100	* directory).
sl@0	6101	*
sl@0	6102	* Results:
sl@0	6103	* Standard Tcl error code.
sl@0	6104	*
sl@0	6105	* Side effects:
sl@0	6106	* The old representation may be freed, and new memory allocated.
sl@0	6107	*
sl@0	6108	*---------------------------------------------------------------------------
sl@0	6109	*/
sl@0	6110
sl@0	6111	static int
sl@0	6112	SetFsPathFromAny(interp, objPtr)
sl@0	6113	Tcl_Interp interp; / Used for error reporting if not NULL. */
sl@0	6114	Tcl_Obj objPtr; / The object to convert. */
sl@0	6115	{
sl@0	6116	int len;
sl@0	6117	FsPath *fsPathPtr;
sl@0	6118	Tcl_Obj *transPtr;
sl@0	6119	char *name;
sl@0	6120	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0	6121
sl@0	6122	if (objPtr->typePtr == &tclFsPathType) {
sl@0	6123	return TCL_OK;
sl@0	6124	}
sl@0	6125
sl@0	6126	/*
sl@0	6127	* First step is to translate the filename. This is similar to
sl@0	6128	* Tcl_TranslateFilename, but shouldn't convert everything to
sl@0	6129	* windows backslashes on that platform. The current
sl@0	6130	* implementation of this piece is a slightly optimised version
sl@0	6131	* of the various Tilde/Split/Join stuff to avoid multiple
sl@0	6132	* split/join operations.
sl@0	6133	*
sl@0	6134	* We remove any trailing directory separator.
sl@0	6135	*
sl@0	6136	* However, the split/join routines are quite complex, and
sl@0	6137	* one has to make sure not to break anything on Unix, Win
sl@0	6138	* or MacOS (fCmd.test, fileName.test and cmdAH.test exercise
sl@0	6139	* most of the code).
sl@0	6140	*/
sl@0	6141	name = Tcl_GetStringFromObj(objPtr,&len);
sl@0	6142
sl@0	6143	/*
sl@0	6144	* Handle tilde substitutions, if needed.
sl@0	6145	*/
sl@0	6146	if (name[0] == '~') {
sl@0	6147	char *expandedUser;
sl@0	6148	Tcl_DString temp;
sl@0	6149	int split;
sl@0	6150	char separator='/';
sl@0	6151
sl@0	6152	if (tclPlatform==TCL_PLATFORM_MAC) {
sl@0	6153	if (strchr(name, ':') != NULL) separator = ':';
sl@0	6154	}
sl@0	6155
sl@0	6156	split = FindSplitPos(name, &separator);
sl@0	6157	if (split != len) {
sl@0	6158	/* We have multiple pieces '~user/foo/bar...' */
sl@0	6159	name[split] = '\0';
sl@0	6160	}
sl@0	6161	/* Do some tilde substitution */
sl@0	6162	if (name[1] == '\0') {
sl@0	6163	/* We have just '~' */
sl@0	6164	CONST char *dir;
sl@0	6165	Tcl_DString dirString;
sl@0	6166	if (split != len) { name[split] = separator; }
sl@0	6167
sl@0	6168	dir = TclGetEnv("HOME", &dirString);
sl@0	6169	if (dir == NULL) {
sl@0	6170	if (interp) {
sl@0	6171	Tcl_ResetResult(interp);
sl@0	6172	Tcl_AppendResult(interp, "couldn't find HOME environment ",
sl@0	6173	"variable to expand path", (char *) NULL);
sl@0	6174	}
sl@0	6175	return TCL_ERROR;
sl@0	6176	}
sl@0	6177	Tcl_DStringInit(&temp);
sl@0	6178	Tcl_JoinPath(1, &dir, &temp);
sl@0	6179	Tcl_DStringFree(&dirString);
sl@0	6180	} else {
sl@0	6181	/* We have a user name '~user' */
sl@0	6182	Tcl_DStringInit(&temp);
sl@0	6183	if (TclpGetUserHome(name+1, &temp) == NULL) {
sl@0	6184	if (interp != NULL) {
sl@0	6185	Tcl_ResetResult(interp);
sl@0	6186	Tcl_AppendResult(interp, "user \"", (name+1),
sl@0	6187	"\" doesn't exist", (char *) NULL);
sl@0	6188	}
sl@0	6189	Tcl_DStringFree(&temp);
sl@0	6190	if (split != len) { name[split] = separator; }
sl@0	6191	return TCL_ERROR;
sl@0	6192	}
sl@0	6193	if (split != len) { name[split] = separator; }
sl@0	6194	}
sl@0	6195
sl@0	6196	expandedUser = Tcl_DStringValue(&temp);
sl@0	6197	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));
sl@0	6198
sl@0	6199	if (split != len) {
sl@0	6200	/* Join up the tilde substitution with the rest */
sl@0	6201	if (name[split+1] == separator) {
sl@0	6202
sl@0	6203	/*
sl@0	6204	* Somewhat tricky case like ~//foo/bar.
sl@0	6205	* Make use of Split/Join machinery to get it right.
sl@0	6206	* Assumes all paths beginning with ~ are part of the
sl@0	6207	* native filesystem.
sl@0	6208	*/
sl@0	6209
sl@0	6210	int objc;
sl@0	6211	Tcl_Obj **objv;
sl@0	6212	Tcl_Obj *parts = TclpNativeSplitPath(objPtr, NULL);
sl@0	6213	Tcl_ListObjGetElements(NULL, parts, &objc, &objv);
sl@0	6214	/* Skip '~'. It's replaced by its expansion */
sl@0	6215	objc--; objv++;
sl@0	6216	while (objc--) {
sl@0	6217	TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
sl@0	6218	}
sl@0	6219	Tcl_DecrRefCount(parts);
sl@0	6220	} else {
sl@0	6221	/* Simple case. "rest" is relative path. Just join it. */
sl@0	6222	Tcl_Obj *rest = Tcl_NewStringObj(name+split+1,-1);
sl@0	6223	transPtr = Tcl_FSJoinToPath(transPtr, 1, &rest);
sl@0	6224	}
sl@0	6225	}
sl@0	6226	Tcl_DStringFree(&temp);
sl@0	6227	} else {
sl@0	6228	transPtr = Tcl_FSJoinToPath(objPtr,0,NULL);
sl@0	6229	}
sl@0	6230
sl@0	6231	#if defined(__CYGWIN__) && defined(__WIN32__)
sl@0	6232	{
sl@0	6233	extern int cygwin_conv_to_win32_path
sl@0	6234	_ANSI_ARGS_((CONST char , char ));
sl@0	6235	char winbuf[MAX_PATH+1];
sl@0	6236
sl@0	6237	/*
sl@0	6238	* In the Cygwin world, call conv_to_win32_path in order to use the
sl@0	6239	* mount table to translate the file name into something Windows will
sl@0	6240	* understand. Take care when converting empty strings!
sl@0	6241	*/
sl@0	6242	name = Tcl_GetStringFromObj(transPtr, &len);
sl@0	6243	if (len > 0) {
sl@0	6244	cygwin_conv_to_win32_path(name, winbuf);
sl@0	6245	TclWinNoBackslash(winbuf);
sl@0	6246	Tcl_SetStringObj(transPtr, winbuf, -1);
sl@0	6247	}
sl@0	6248	}
sl@0	6249	#endif /* __CYGWIN__ && __WIN32__ */
sl@0	6250
sl@0	6251	/*
sl@0	6252	* Now we have a translated filename in 'transPtr'. This will have
sl@0	6253	* forward slashes on Windows, and will not contain any ~user
sl@0	6254	* sequences.
sl@0	6255	*/
sl@0	6256
sl@0	6257	fsPathPtr = (FsPath*)ckalloc((unsigned)sizeof(FsPath));
sl@0	6258
sl@0	6259	fsPathPtr->translatedPathPtr = transPtr;
sl@0	6260	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
sl@0	6261	fsPathPtr->normPathPtr = NULL;
sl@0	6262	fsPathPtr->cwdPtr = NULL;
sl@0	6263	fsPathPtr->nativePathPtr = NULL;
sl@0	6264	fsPathPtr->fsRecPtr = NULL;
sl@0	6265	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
sl@0	6266
sl@0	6267	/*
sl@0	6268	* Free old representation before installing our new one.
sl@0	6269	*/
sl@0	6270	if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
sl@0	6271	(objPtr->typePtr->freeIntRepProc)(objPtr);
sl@0	6272	}
sl@0	6273	PATHOBJ(objPtr) = (VOID *) fsPathPtr;
sl@0	6274	PATHFLAGS(objPtr) = 0;
sl@0	6275	objPtr->typePtr = &tclFsPathType;
sl@0	6276
sl@0	6277	return TCL_OK;
sl@0	6278	}
sl@0	6279
sl@0	6280	static void
sl@0	6281	FreeFsPathInternalRep(pathObjPtr)
sl@0	6282	Tcl_Obj pathObjPtr; / Path object with internal rep to free. */
sl@0	6283	{
sl@0	6284	FsPath fsPathPtr = (FsPath) PATHOBJ(pathObjPtr);
sl@0	6285
sl@0	6286	if (fsPathPtr->translatedPathPtr != NULL) {
sl@0	6287	if (fsPathPtr->translatedPathPtr != pathObjPtr) {
sl@0	6288	Tcl_DecrRefCount(fsPathPtr->translatedPathPtr);
sl@0	6289	}
sl@0	6290	}
sl@0	6291	if (fsPathPtr->normPathPtr != NULL) {
sl@0	6292	if (fsPathPtr->normPathPtr != pathObjPtr) {
sl@0	6293	Tcl_DecrRefCount(fsPathPtr->normPathPtr);
sl@0	6294	}
sl@0	6295	fsPathPtr->normPathPtr = NULL;
sl@0	6296	}
sl@0	6297	if (fsPathPtr->cwdPtr != NULL) {
sl@0	6298	Tcl_DecrRefCount(fsPathPtr->cwdPtr);
sl@0	6299	}
sl@0	6300	if (fsPathPtr->nativePathPtr != NULL) {
sl@0	6301	if (fsPathPtr->fsRecPtr != NULL) {
sl@0	6302	if (fsPathPtr->fsRecPtr->fsPtr->freeInternalRepProc != NULL) {
sl@0	6303	(*fsPathPtr->fsRecPtr->fsPtr
sl@0	6304	->freeInternalRepProc)(fsPathPtr->nativePathPtr);
sl@0	6305	fsPathPtr->nativePathPtr = NULL;
sl@0	6306	}
sl@0	6307	}
sl@0	6308	}
sl@0	6309	if (fsPathPtr->fsRecPtr != NULL) {
sl@0	6310	fsPathPtr->fsRecPtr->fileRefCount--;
sl@0	6311	if (fsPathPtr->fsRecPtr->fileRefCount <= 0) {
sl@0	6312	/* It has been unregistered already, so simply free it */
sl@0	6313	ckfree((char *)fsPathPtr->fsRecPtr);
sl@0	6314	}
sl@0	6315	}
sl@0	6316
sl@0	6317	ckfree((char*) fsPathPtr);
sl@0	6318	}
sl@0	6319
sl@0	6320
sl@0	6321	static void
sl@0	6322	DupFsPathInternalRep(srcPtr, copyPtr)
sl@0	6323	Tcl_Obj srcPtr; / Path obj with internal rep to copy. */
sl@0	6324	Tcl_Obj copyPtr; / Path obj with internal rep to set. */
sl@0	6325	{
sl@0	6326	FsPath srcFsPathPtr = (FsPath) PATHOBJ(srcPtr);
sl@0	6327	FsPath copyFsPathPtr = (FsPath) ckalloc((unsigned)sizeof(FsPath));
sl@0	6328
sl@0	6329	Tcl_FSDupInternalRepProc *dupProc;
sl@0	6330
sl@0	6331	PATHOBJ(copyPtr) = (VOID *) copyFsPathPtr;
sl@0	6332
sl@0	6333	if (srcFsPathPtr->translatedPathPtr != NULL) {
sl@0	6334	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
sl@0	6335	if (copyFsPathPtr->translatedPathPtr != copyPtr) {
sl@0	6336	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
sl@0	6337	}
sl@0	6338	} else {
sl@0	6339	copyFsPathPtr->translatedPathPtr = NULL;
sl@0	6340	}
sl@0	6341
sl@0	6342	if (srcFsPathPtr->normPathPtr != NULL) {
sl@0	6343	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
sl@0	6344	if (copyFsPathPtr->normPathPtr != copyPtr) {
sl@0	6345	Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
sl@0	6346	}
sl@0	6347	} else {
sl@0	6348	copyFsPathPtr->normPathPtr = NULL;
sl@0	6349	}
sl@0	6350
sl@0	6351	if (srcFsPathPtr->cwdPtr != NULL) {
sl@0	6352	copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
sl@0	6353	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
sl@0	6354	} else {
sl@0	6355	copyFsPathPtr->cwdPtr = NULL;
sl@0	6356	}
sl@0	6357
sl@0	6358	copyFsPathPtr->flags = srcFsPathPtr->flags;
sl@0	6359
sl@0	6360	if (srcFsPathPtr->fsRecPtr != NULL
sl@0	6361	&& srcFsPathPtr->nativePathPtr != NULL) {
sl@0	6362	dupProc = srcFsPathPtr->fsRecPtr->fsPtr->dupInternalRepProc;
sl@0	6363	if (dupProc != NULL) {
sl@0	6364	copyFsPathPtr->nativePathPtr =
sl@0	6365	(*dupProc)(srcFsPathPtr->nativePathPtr);
sl@0	6366	} else {
sl@0	6367	copyFsPathPtr->nativePathPtr = NULL;
sl@0	6368	}
sl@0	6369	} else {
sl@0	6370	copyFsPathPtr->nativePathPtr = NULL;
sl@0	6371	}
sl@0	6372	copyFsPathPtr->fsRecPtr = srcFsPathPtr->fsRecPtr;
sl@0	6373	copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
sl@0	6374	if (copyFsPathPtr->fsRecPtr != NULL) {
sl@0	6375	copyFsPathPtr->fsRecPtr->fileRefCount++;
sl@0	6376	}
sl@0	6377
sl@0	6378	copyPtr->typePtr = &tclFsPathType;
sl@0	6379	}
sl@0	6380
sl@0	6381	/*
sl@0	6382	*---------------------------------------------------------------------------
sl@0	6383	*
sl@0	6384	* UpdateStringOfFsPath --
sl@0	6385	*
sl@0	6386	* Gives an object a valid string rep.
sl@0	6387	*
sl@0	6388	* Results:
sl@0	6389	* None.
sl@0	6390	*
sl@0	6391	* Side effects:
sl@0	6392	* Memory may be allocated.
sl@0	6393	*
sl@0	6394	*---------------------------------------------------------------------------
sl@0	6395	*/
sl@0	6396
sl@0	6397	static void
sl@0	6398	UpdateStringOfFsPath(objPtr)
sl@0	6399	register Tcl_Obj objPtr; / path obj with string rep to update. */
sl@0	6400	{
sl@0	6401	FsPath fsPathPtr = (FsPath) PATHOBJ(objPtr);
sl@0	6402	CONST char *cwdStr;
sl@0	6403	int cwdLen;
sl@0	6404	Tcl_Obj *copy;
sl@0	6405
sl@0	6406	if (PATHFLAGS(objPtr) == 0 \|\| fsPathPtr->cwdPtr == NULL) {
sl@0	6407	panic("Called UpdateStringOfFsPath with invalid object");
sl@0	6408	}
sl@0	6409
sl@0	6410	copy = Tcl_DuplicateObj(fsPathPtr->cwdPtr);
sl@0	6411	Tcl_IncrRefCount(copy);
sl@0	6412
sl@0	6413	cwdStr = Tcl_GetStringFromObj(copy, &cwdLen);
sl@0	6414	/*
sl@0	6415	* Should we perhaps use 'Tcl_FSPathSeparator'?
sl@0	6416	* But then what about the Windows special case?
sl@0	6417	* Perhaps we should just check if cwd is a root volume.
sl@0	6418	* We should never get cwdLen == 0 in this code path.
sl@0	6419	*/
sl@0	6420	switch (tclPlatform) {
sl@0	6421	case TCL_PLATFORM_UNIX:
sl@0	6422	if (cwdStr[cwdLen-1] != '/') {
sl@0	6423	Tcl_AppendToObj(copy, "/", 1);
sl@0	6424	cwdLen++;
sl@0	6425	}
sl@0	6426	break;
sl@0	6427	case TCL_PLATFORM_WINDOWS:
sl@0	6428	/*
sl@0	6429	* We need the extra 'cwdLen != 2', and ':' checks because
sl@0	6430	* a volume relative path doesn't get a '/'. For example
sl@0	6431	* 'glob C:cat.exe' will return 'C:cat32.exe'
sl@0	6432	*/
sl@0	6433	if (cwdStr[cwdLen-1] != '/'
sl@0	6434	&& cwdStr[cwdLen-1] != '\\') {
sl@0	6435	if (cwdLen != 2 \|\| cwdStr[1] != ':') {
sl@0	6436	Tcl_AppendToObj(copy, "/", 1);
sl@0	6437	cwdLen++;
sl@0	6438	}
sl@0	6439	}
sl@0	6440	break;
sl@0	6441	case TCL_PLATFORM_MAC:
sl@0	6442	if (cwdStr[cwdLen-1] != ':') {
sl@0	6443	Tcl_AppendToObj(copy, ":", 1);
sl@0	6444	cwdLen++;
sl@0	6445	}
sl@0	6446	break;
sl@0	6447	}
sl@0	6448	Tcl_AppendObjToObj(copy, fsPathPtr->normPathPtr);
sl@0	6449	objPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
sl@0	6450	objPtr->length = cwdLen;
sl@0	6451	copy->bytes = tclEmptyStringRep;
sl@0	6452	copy->length = 0;
sl@0	6453	Tcl_DecrRefCount(copy);
sl@0	6454	}
sl@0	6455
sl@0	6456	/*
sl@0	6457	*---------------------------------------------------------------------------
sl@0	6458	*
sl@0	6459	* NativePathInFilesystem --
sl@0	6460	*
sl@0	6461	* Any path object is acceptable to the native filesystem, by
sl@0	6462	* default (we will throw errors when illegal paths are actually
sl@0	6463	* tried to be used).
sl@0	6464	*
sl@0	6465	* However, this behavior means the native filesystem must be
sl@0	6466	* the last filesystem in the lookup list (otherwise it will
sl@0	6467	* claim all files belong to it, and other filesystems will
sl@0	6468	* never get a look in).
sl@0	6469	*
sl@0	6470	* Results:
sl@0	6471	* TCL_OK, to indicate 'yes', -1 to indicate no.
sl@0	6472	*
sl@0	6473	* Side effects:
sl@0	6474	* None.
sl@0	6475	*
sl@0	6476	*---------------------------------------------------------------------------
sl@0	6477	*/
sl@0	6478	static int
sl@0	6479	NativePathInFilesystem(pathPtr, clientDataPtr)
sl@0	6480	Tcl_Obj *pathPtr;
sl@0	6481	ClientData *clientDataPtr;
sl@0	6482	{
sl@0	6483	/*
sl@0	6484	* A special case is required to handle the empty path "".
sl@0	6485	* This is a valid path (i.e. the user should be able
sl@0	6486	* to do 'file exists ""' without throwing an error), but
sl@0	6487	* equally the path doesn't exist. Those are the semantics
sl@0	6488	* of Tcl (at present anyway), so we have to abide by them
sl@0	6489	* here.
sl@0	6490	*/
sl@0	6491	if (pathPtr->typePtr == &tclFsPathType) {
sl@0	6492	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
sl@0	6493	/* We reject the empty path "" */
sl@0	6494	return -1;
sl@0	6495	}
sl@0	6496	/* Otherwise there is no way this path can be empty */
sl@0	6497	} else {
sl@0	6498	/*
sl@0	6499	* It is somewhat unusual to reach this code path without
sl@0	6500	* the object being of tclFsPathType. However, we do
sl@0	6501	* our best to deal with the situation.
sl@0	6502	*/
sl@0	6503	int len;
sl@0	6504	Tcl_GetStringFromObj(pathPtr,&len);
sl@0	6505	if (len == 0) {
sl@0	6506	/* We reject the empty path "" */
sl@0	6507	return -1;
sl@0	6508	}
sl@0	6509	}
sl@0	6510	/*
sl@0	6511	* Path is of correct type, or is of non-zero length,
sl@0	6512	* so we accept it.
sl@0	6513	*/
sl@0	6514	return TCL_OK;
sl@0	6515	}

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--