Tcl Source Code

}
declare 265 {
    int Tcl_DumpActiveMemory(const char *fileName)
}
declare 266 {
    void Tcl_ValidateAllMemory(const char *file, int line)
}
declare 267 {deprecated {see TIP #422}} {
    void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
declare 268 {deprecated {see TIP #422}} {
    void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 {
    char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
    CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,

	    const char *version)
}
# TIP #268: The internally used new Require function is in slot 573.
declare 274 {
    CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)
}
declare 275 {deprecated {see TIP #422}} {
    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
declare 276 {deprecated {see TIP #422}} {
    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 277 {
    Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 {deprecated {see TIP #422}} {
    TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
    void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
declare 280 {
    void Tcl_InitMemory(Tcl_Interp *interp)

EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
/* 265 */
EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
TCL_DEPRECATED("see TIP #422")
void			Tcl_AppendResultVA(Tcl_Interp *interp,
				va_list argList);
/* 268 */
TCL_DEPRECATED("see TIP #422")
void			Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
				va_list argList);
/* 269 */
EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
				const char *start, CONST84 char **termPtr);
/* 271 */

EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
				const char *version);
/* 274 */
EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact);
/* 275 */
TCL_DEPRECATED("see TIP #422")
void			Tcl_SetErrorCodeVA(Tcl_Interp *interp,
				va_list argList);
/* 276 */
TCL_DEPRECATED("see TIP #422")
int			Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
TCL_DEPRECATED("see TIP #422")
TCL_NORETURN void	Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
/* 280 */
EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
/* 281 */
EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,

    int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
    int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
    CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
    CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
    CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
    CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
    TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
    TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
    void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
    void (*reserved285)(void);

	 * ':' no longer needed as a separator. It is only relevant to the
	 * beginning of the path.
	 */

	separators = "/\\";

    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
	if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    tail++;
	    Tcl_IncrRefCount(pathPrefix);
	}
    }

    /*

#   define TclWinGetServByName 0
#   define TclWinGetSockOpt 0
#   define TclWinSetSockOpt 0
#   define TclWinNToHS 0
#   define TclBNInitBignumFromWideUInt 0
#   define TclBNInitBignumFromWideInt 0
#   define TclBNInitBignumFromLong 0
#   define Tcl_AppendResultVA 0
#   define Tcl_AppendStringsToObjVA 0
#   define Tcl_SetErrorCodeVA 0
#   define Tcl_PanicVA 0
#   define Tcl_VarEvalVA 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
    Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath

#include <stdlib.h>
#include <fcntl.h>

#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"

#define ZIPFS_VOLUME      "//zipfs:/"
#define ZIPFS_APP_MOUNT   "//zipfs:/app"
#define ZIPFS_ZIP_MOUNT   "//zipfs:/lib/tcl"

#define ZIPFS_VOLUME_LEN 9

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN                     4

 *
 *-------------------------------------------------------------------------
 */

static char *
CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPATH)
{
    char *path;
    char *result;
    int i, j, c, isunc = 0, isvfs=0, n=0;
#if HAS_DRIVES
    int zipfspath=1;
    if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) &&
	    (tail[1] == ':')) {
	tail += 2;
	zipfspath=0;
    }
    /* UNC style path */
    if (tail[0] == '\\') {
	root = "";
	++tail;
	zipfspath=0;
    }
    if (tail[0] == '\\') {
	root = "/";
	++tail;
	zipfspath=0;
    }
    if(zipfspath) {
#endif
	/* UNC style path */
	if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) {
	    isvfs=1;
	} else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) {
	    isvfs=2;
	}
	if(isvfs!=1) {
	    if ((root[0] == '/') && (root[1] == '/')) {
		isunc = 1;
	    }
	}
#if HAS_DRIVES
    }
#endif
    if(isvfs!=2) {
	if (tail[0] == '/') {
	    if(isvfs!=1) {
		root = "";
	    }
	    ++tail;
	    isunc = 0;
	}
	if (tail[0] == '/') {
	    if(isvfs!=1) {
		root = "/";
	    }
	    ++tail;
	    isunc = 1;
	}
    }
    i = strlen(root);
    j = strlen(tail);
    if(isvfs==1) {
	if(i>ZIPFS_VOLUME_LEN) {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    memcpy(path + i, tail, j);
	}
    } else if(isvfs==2) {
	Tcl_DStringSetLength(dsPtr, j);
	path = Tcl_DStringValue(dsPtr);
	memcpy(path, tail, j);
    } else {
	if (ZIPFSPATH) {
	    Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN);
	    memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	}
    }
#if HAS_DRIVES
    for (i = 0; path[i] != '\0'; i++) {
	if (path[i] == '\\') {
	    path[i] = '/';
	}
    }
#endif
    if(ZIPFSPATH) {
	n=ZIPFS_VOLUME_LEN;
    } else {
	n=0;
    }
    for (i = j = n; (c = path[i]) != '\0'; i++) {
	if (c == '/') {
	    int c2 = path[i + 1];
	    if (c2 == '/') {
		continue;
	    }
	    if (c2 == '.') {
		int c3 = path[i + 2];
		if ((c3 == '/') || (c3 == '\0')) {
		    i++;
		    continue;
		}
		if ((c3 == '.') &&
			((path[i + 3] == '/') || (path [i + 3] == '\0'))) {
		    i += 2;
		    while ((j > 0) && (path[j - 1] != '/')) {
			j--;
		    }
		    if (j > isunc) {
			--j;
			while ((j > 1 + isunc) && (path[j - 2] == '/')) {
			    j--;
			}
		    }
		    continue;
		}
	    }
	}
	path[j++] = c;
    }
    if (j == 0) {
	path[j++] = '/';
    }
    path[j] = 0;
    Tcl_DStringSetLength(dsPtr, j);
    result=Tcl_DStringValue(dsPtr);
    return result;
}















































/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookup --
 *
 *	This function returns the ZIP entry struct corresponding to

 *
 *-------------------------------------------------------------------------
 */

static ZipEntry *
ZipFSLookup(char *filename)
{


    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    Tcl_DString ds;
    Tcl_DStringInit(&ds);

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL;
    Tcl_DStringFree(&ds);
    return z;
}

#ifdef NEVER_USED

/*
 *-------------------------------------------------------------------------
 *

 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSLookupMount(char *filename)
{

    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;

    int match = 0;


    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
    while (hPtr != NULL) {
	if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
	    if (strcmp(zf->mntpt, filename) == 0) {
		match = 1;
		break;
	    }
	}
	hPtr = Tcl_NextHashEntry(&search);
    }

    return match;
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCloseArchive --

 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,
	    const char *passwd)
{

    int i, pwlen, isNew;
    ZipFile *zf, zf0;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, fpBuf;
    unsigned char *q;

    ReadLock();
    if (!ZipFS.initialized) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("not initialized", -1));
	}
	Unlock();
	return TCL_ERROR;
    }
    if (zipname == NULL) {
	Tcl_HashSearch search;
	int ret = TCL_OK;

	i = 0;
	hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
	while (hPtr != NULL) {
	    if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
		if (interp != NULL) {
		    Tcl_AppendElement(interp, zf->mntpt);
		    Tcl_AppendElement(interp, zf->name);
		}
		++i;
	    }
	    hPtr = Tcl_NextHashEntry(&search);
	}
	if (interp == NULL) {
	    ret = (i > 0) ? TCL_OK : TCL_BREAK;
	}
	Unlock();
	return ret;
    }
    if (mntpt == NULL) {
	if (interp == NULL) {
	    Unlock();
	    return TCL_OK;
	}


	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname);
	if (hPtr != NULL) {
	    if ((zf = Tcl_GetHashValue(hPtr)) != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(zf->mntpt, zf->mntptlen));
	    }
	}
	Unlock();

	return TCL_OK;
    }
    Unlock();
    pwlen = 0;
    if (passwd != NULL) {
	pwlen = strlen(passwd);
	if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
	    }
	    return TCL_ERROR;
	}
    }
    if (ZipFSOpenArchive(interp, zipname, 1, &zf0) != TCL_OK) {
	return TCL_ERROR;
    }


    /*
     * Mount point can come from Tcl_GetNameOfExecutable()
     * which sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */


    WriteLock();
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew);

    if (!isNew) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ?
		    zf->mntpt : "/", "\"", (char *) NULL);
	}
	Unlock();


	ZipFSCloseArchive(interp, &zf0);
	return TCL_ERROR;
    }
    if (strcmp(mntpt, "/") == 0) {
	mntpt = "";
    }
    zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1);
    if (zf == NULL) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	}
	Unlock();


	ZipFSCloseArchive(interp, &zf0);
	return TCL_ERROR;
    }
    *zf = zf0;
    zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    strcpy(zf->mntpt, mntpt);
    zf->mntptlen = strlen(zf->mntpt);
    zf->entries = NULL;
    zf->topents = NULL;
    zf->nopen = 0;
    Tcl_SetHashValue(hPtr, (ClientData) zf);
    if ((zf->pwbuf[0] == 0) && pwlen) {
	int k = 0;
	i = pwlen;
	zf->pwbuf[k++] = i;
	while (i > 0) {
	    zf->pwbuf[k] = (passwd[i - 1] & 0x0f) |
		pwrot[(passwd[i - 1] >> 4) & 0x0f];
	    k++;
	    i--;
	}
	zf->pwbuf[k] = '\0';
    }
    if (mntpt[0] != '\0') {
	z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(mntpt);
	z->zipfile = zf;
	z->isdir = 1;
	z->isenc = 0;
	z->offset = zf->baseoffs;
	z->crc32 = 0;
	z->timestamp = 0;
	z->nbyte = z->nbytecompr = 0;
	z->cmeth = ZIP_COMPMETH_STORED;
	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew);
	if (!isNew) {
	    /* skip it */
	    Tcl_Free((char *) z);
	} else {
	    Tcl_SetHashValue(hPtr, (ClientData) z);
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	}
    }
    q = zf->data + zf->centoffs;
    Tcl_DStringInit(&fpBuf);
    Tcl_DStringInit(&ds);
    for (i = 0; i < zf->nfiles; i++) {
	int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs;
	unsigned char *lq, *gq = NULL;
	char *fullpath, *path;

	pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	Tcl_DStringSetLength(&ds, 0);
	Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
	path = Tcl_DStringValue(&ds);
	if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
	    Tcl_DStringSetLength(&ds, pathlen - 1);
	    path = Tcl_DStringValue(&ds);
	    isdir = 1;
	}
	if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
	    goto nextent;
	}
	lq = zf->data + zf->baseoffs +
	    zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < zf->data) || (lq > (zf->data + zf->length))) {
	    goto nextent;
	}
	nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0) &&
		(zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) &&
		(zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	}
	offs = (lq - zf->data)
	    + ZIP_LOCAL_HEADER_LEN
	    + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS)
	    + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS);
	if ((offs + nbcompr) > zf->length) {
	    goto nextent;
	}
	if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) {
#ifdef ANDROID
	    /*
	     * When mounting the ZIP archive on the root directory try
	     * to remap top level regular files of the archive to
	     * /assets/.root/... since this directory should not be
	     * in a valid APK due to the leading dot in the file name
	     * component. This trick should make the files
	     * AndroidManifest.xml, resources.arsc, and classes.dex
	     * visible to Tcl.
	     */
	    Tcl_DString ds2;

	    Tcl_DStringInit(&ds2);
	    Tcl_DStringAppend(&ds2, "assets/.root/", -1);
	    Tcl_DStringAppend(&ds2, path, -1);
	    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
	    if (hPtr != NULL) {
		/* should not happen but skip it anyway */
		Tcl_DStringFree(&ds2);
		goto nextent;
	    }
	    Tcl_DStringSetLength(&ds, 0);
	    Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
		    Tcl_DStringLength(&ds2));
	    path = Tcl_DStringValue(&ds);
	    Tcl_DStringFree(&ds2);
#else
	    /*
	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif
	}
	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = CanonicalPath(mntpt, path, &fpBuf, 1);
	z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipfile = zf;
	z->isdir = isdir;
	z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
	    && (nbcompr > 12);
	z->offset = offs;
	if (gq != NULL) {
	    z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS);
	} else {
	    z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS);
	}
	z->nbytecompr = nbcompr;
	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    Tcl_Free((char *) z);
	} else {
	    Tcl_SetHashValue(hPtr, (ClientData) z);
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	    if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) {
		z->tnext = zf->topents;
		zf->topents = z;
	    }
	    if (!z->isdir && (z->depth > 1)) {
		char *dir, *end;
		ZipEntry *zd;

		Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
		Tcl_DStringSetLength(&ds, 0);
		Tcl_DStringAppend(&ds, z->name, -1);
		dir = Tcl_DStringValue(&ds);
		end = strrchr(dir, '/');
		while ((end != NULL) && (end != dir)) {
		    Tcl_DStringSetLength(&ds, end - dir);
		    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir);
		    if (hPtr != NULL) {
			break;
		    }
		    zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd));
		    zd->name = NULL;
		    zd->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipfile = zf;
		    zd->isdir = 1;
		    zd->isenc = 0;
		    zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		    zd->nbyte = zd->nbytecompr = 0;
		    zd->cmeth = ZIP_COMPMETH_STORED;
		    zd->data = NULL;
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {
			/* should not happen but skip it anyway */
			Tcl_Free((char *) zd);
		    } else {
			Tcl_SetHashValue(hPtr, (ClientData) zd);
			zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
			zd->next = zf->entries;
			zf->entries = zd;
			if ((mntpt[0] == '\0') && (zd->depth == 1)) {
			    zd->tnext = zf->topents;
			    zf->topents = zd;
			}
		    }
		    end = strrchr(dir, '/');
		}
	    }
	}
nextent:
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    Unlock();
    Tcl_DStringFree(&fpBuf);
    Tcl_DStringFree(&ds);

    Tcl_FSMountsChanged(NULL);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Unmount --
 *

 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
{

    ZipFile *zf;
    ZipEntry *z, *znext;
    Tcl_HashEntry *hPtr;

    int ret = TCL_OK, unmounted = 0;



    WriteLock();
    if (!ZipFS.initialized) {
	goto done;
    }
    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname);
    if (hPtr == NULL) {
	/* don't report error */
	goto done;
    }
    zf = (ZipFile *) Tcl_GetHashValue(hPtr);
    if (zf->nopen > 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("filesystem is busy", -1));
	}
	ret = TCL_ERROR;
	goto done;
    }
    Tcl_DeleteHashEntry(hPtr);
    for (z = zf->entries; z; z = znext) {
	znext = z->next;
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
	if (z->data != NULL) {
	    Tcl_Free((char *) z->data);
	}
	Tcl_Free((char *) z);
    }


    ZipFSCloseArchive(interp, zf);
    Tcl_Free((char *) zf);
    unmounted = 1;
done:
    Unlock();

    if (unmounted) {
	Tcl_FSMountsChanged(NULL);
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountObjCmd --
 *

 *-------------------------------------------------------------------------
 */

static int
ZipFSCanonicalObjCmd(ClientData clientData, Tcl_Interp *interp,
		  int objc, Tcl_Obj *const objv[])
{
    char *mntpoint=NULL;
    char *filename=NULL;
    char *result;
    Tcl_DString dPath;

    if (objc != 2 && objc != 3 && objc!=4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?");
	return TCL_ERROR;
    }
    Tcl_DStringInit(&dPath);
    if(objc==2) {
	filename = Tcl_GetString(objv[1]);
	result=CanonicalPath("",filename,&dPath,1);
    } else if (objc==3) {
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result=CanonicalPath(mntpoint,filename,&dPath,1);
    } else {
	int zipfs=0;
	if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) {
	    return TCL_ERROR;
	}
	mntpoint = Tcl_GetString(objv[1]);
	filename = Tcl_GetString(objv[2]);
	result=CanonicalPath(mntpoint,filename,&dPath,zipfs);
    }
    Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSExistsObjCmd --
 *

static int
ZipFSExistsObjCmd(ClientData clientData, Tcl_Interp *interp,
		  int objc, Tcl_Obj *const objv[])
{
    char *filename;
    int exists;
    Tcl_DString ds;

    if (objc != 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "filename");
      return TCL_ERROR;
    }

    /* prepend ZIPFS_VOLUME to filename, eliding the final / */
    filename = Tcl_GetStringFromObj(objv[1], 0);
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN-1);
    Tcl_DStringAppend(&ds, filename, -1);
    filename = Tcl_DStringValue(&ds);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
    Unlock();

    Tcl_SetObjResult(interp,Tcl_NewBooleanObj(exists));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *

	return NULL;
    }
    WriteLock();
    z = ZipFSLookup(filename);
    if (z == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1));
	    Tcl_AppendResult(interp, " \"", filename, "\"", NULL);
	}
	goto error;
    }
    trunc = (mode & O_TRUNC) != 0;
    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
    if ((z->cmeth != ZIP_COMPMETH_STORED) &&
	(z->cmeth != ZIP_COMPMETH_DEFLATED)) {

static Tcl_Channel
Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			  int mode, int permissions)
{
    int len;

    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return NULL;

    return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len),
			  mode, permissions);
}

/*
 *-------------------------------------------------------------------------
 *

 */

static int
Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
{
    int len;

    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;

    return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSAccessProc --

 *-------------------------------------------------------------------------
 */

static int
Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode)
{
    int len;

    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;

    return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
}

/*
 *-------------------------------------------------------------------------
 *

 *-------------------------------------------------------------------------
 */
static int
Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result,
			   Tcl_Obj *pathPtr, const char *pattern,
			   Tcl_GlobTypeData *types)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr;
    int scnt, len, l, dirOnly = -1, prefixLen, strip = 0;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;

    if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;

    if (types != NULL) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
    }


    /* the prefix that gets prepended to results */
    prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);

    /* the (normalized) path we're searching */
    path = Tcl_GetStringFromObj(normPathPtr, &len);

    Tcl_DStringInit(&dsPref);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);



    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else {
	strip = len + 1;
    }
    if (prefix != NULL) {
	Tcl_DStringAppend(&dsPref, "/", 1);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);
    }
    ReadLock();
    if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) {
	l = CountSlashes(path);
	if (path[len - 1] == '/') {
	    len--;
	} else {
	    l++;
	}
	if ((pattern == NULL) || (pattern[0] == '\0')) {
	    pattern = "*";
	}
	hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
	while (hPtr != NULL) {
	    ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);

	    if (zf->mntptlen == 0) {
		ZipEntry *z = zf->topents;
		while (z != NULL) {
		    int lenz = strlen(z->name);
		    if ((lenz > len + 1) &&
			    (strncmp(z->name, path, len) == 0) &&
			    (z->name[len] == '/') &&
			    (CountSlashes(z->name) == l) &&
			    Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) {
			if (prefix != NULL) {
			    Tcl_DStringAppend(&dsPref, z->name, lenz);
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
					Tcl_DStringLength(&dsPref)));
			    Tcl_DStringSetLength(&dsPref, prefixLen);
			} else {
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(z->name, lenz));
			}
		    }
		    z = z->tnext;
		}
	    } else if ((zf->mntptlen > len + 1) &&
		    (strncmp(zf->mntpt, path, len) == 0) &&
		    (zf->mntpt[len] == '/') &&
		    (CountSlashes(zf->mntpt) == l) &&
		    Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) {
		if (prefix != NULL) {
		    Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(zf->mntpt, zf->mntptlen));
		}
	    }
	    hPtr = Tcl_NextHashEntry(&search);
	}
	goto end;
    }
    if ((pattern == NULL) || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr != NULL) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    if ((dirOnly < 0) ||
		    (!dirOnly && !z->isdir) ||
		    (dirOnly && z->isdir)) {
		if (prefix != NULL) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(z->name, -1));
		}
	    }
	}
	goto end;
    }
    l = strlen(pattern);
    pat = Tcl_Alloc(len + l + 2);
    memcpy(pat, path, len);
    while ((len > 1) && (pat[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (pat[0] != '/')) {
	pat[len] = '/';
	++len;
    }
    memcpy(pat + len, pattern, l + 1);
    scnt = CountSlashes(pat);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
	if ((dirOnly >= 0) &&
		((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) {
	    continue;
	}
	if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
	    if (prefix != NULL) {
		Tcl_DStringAppend(&dsPref, z->name + strip, -1);
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
			    Tcl_DStringLength(&dsPref)));
		Tcl_DStringSetLength(&dsPref, prefixLen);
	    } else {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(z->name + strip, -1));
	    }
	}
    }
    Tcl_Free(pat);
end:
    Unlock();
    Tcl_DStringFree(&dsPref);

    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSPathInFilesystemProc --
 *

Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;
    int ret = -1, len;
    char *path;

    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;

    path = Tcl_GetStringFromObj(pathPtr, &len);
    if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) {
      return -1;
    }


    len = strlen(path);

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr != NULL) {
      ret = TCL_OK;
      goto endloop;
    }
    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);

        ret = TCL_OK;
        goto endloop;
      }
      hPtr = Tcl_NextHashEntry(&search);
    }
endloop:
    Unlock();

    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSListVolumesProc --
 *
 *	Lists the currently mounted ZIP filesystem volumes.
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------------
 */
static Tcl_Obj *
Zip_FSListVolumesProc(void) {
    return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSFileAttrStringsProc --
 *

static int
Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,
		       Tcl_Obj **objPtrRef)
{
    int len, ret = TCL_OK;
    char *path;
    ZipEntry *z;

    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;

    path = Tcl_GetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (z == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1));

    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}]

# Removed in tip430 - zipfs is no longer a static package
#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
#    load {} zipfs
#} -result {}

test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
    package require zipfs
} -result {1.0}

test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
    expr {"//zipfs:/" in [file volumes]}
} -result 1

test zipfs-0.2 {zipfs basics} -constraints zipfs -body {
    string match //zipfs:/* $tcl_library
} -result 1

test zipfs-0.3 {zipfs basics: glob} -constraints zipfs -body {
    set pwd [pwd]
    cd $tcl_library
    lsort [glob -dir . http*]
} -cleanup {
    cd $pwd
} -result {./http ./http1.0}

test zipfs-0.4 {zipfs basics: glob} -constraints zipfs -body {
    set pwd [pwd]
    cd $tcl_library
    lsort [glob -dir [pwd] http*]
} -cleanup {
    cd $pwd
} -result [list $tcl_library/http $tcl_library/http1.0]

test zipfs-0.5 {zipfs basics: glob} -constraints zipfs -body {
    lsort [glob -dir $tcl_library http*]
} -result [list $tcl_library/http $tcl_library/http1.0]

test zipfs-0.6 {zipfs basics: glob} -constraints zipfs -body {
    lsort [glob $tcl_library/http*]
} -result [list $tcl_library/http $tcl_library/http1.0]

test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body {
    lsort [glob -tails -dir $tcl_library http*]
} -result {http http1.0}

test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body {
    lsort [glob -nocomplain -tails -types d -dir $tcl_library http*]
} -result {http http1.0}

test zipfs-0.9 {zipfs basics: glob} -constraints zipfs -body {
    lsort [glob -nocomplain -tails -types f -dir $tcl_library http*]
} -result {}


test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mount a b c d e f
} -result {wrong # args: should be "zipfs mount ?zipfile? ?mountpoint? ?password?"}

test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs unmount a b c d e f
} -result {wrong # args: should be "zipfs unmount zipfile"}

test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkkey a b c d e f
} -result {wrong # args: should be "zipfs mkkey password"}

test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkimg a b c d e f
} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}

test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkzip a b c d e f
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}

test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs exists a b c d e f
} -result {wrong # args: should be "zipfs exists filename"}

test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs info a b c d e f
} -result {wrong # args: should be "zipfs info filename"}

test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs list a b c d e f
} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}



test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
    zipfs mkzip /tmp/abc.zip $tcl_library/xxxx      ;# FIXME: test independence
} -result {empty archive}

test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body {
    set pwd [pwd]
    cd $tcl_library/encoding
    zipfs mkzip /tmp/abc.zip .
    zipfs mount /tmp/abc.zip //zipfs:/abc       ;# FIXME: test independence
    zipfs list -glob //zipfs:/abc/cp850.*
} -cleanup {
    cd $pwd
} -result {//zipfs:/abc/cp850.enc}

test zipfs-2.3 {zipfs info} -constraints zipfs -body {
    zipfs info //zipfs:/abc/cp850.enc
} -result [list /tmp/abc.zip 1090 527 39318] ;# FIXME: result depends on content of encodings dir

test zipfs-2.4 {zipfs data} -constraints zipfs -body {
    set zipfd [open //zipfs:/abc/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir

test zipfs-2.5 {zipfs exists} -constraints zipfs -body {
    zipfs exists /abc/cp850.enc
} -result 1

test zipfs-2.6 {zipfs unmount while busy} -constraints zipfs -body {
    zipfs unmount /tmp/abc.zip
} -returnCodes error -result {filesystem is busy}

test zipfs-2.7 {zipfs unmount} -constraints zipfs -body {
    close $zipfd
    zipfs unmount /tmp/abc.zip
    zipfs exists /abc/cp850.enc
} -cleanup {
    file delete /tmp/abc.zip        ;# FIXME: test independence
} -result 0

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: