Artifact [02f3c2065f]
Not logged in

Artifact 02f3c2065ff5fa3ed1e6299580b9b330bf1c0904:


/*
 * zipfs.c --
 *
 *	Implementation of the ZIP filesystem used in AndroWish.
 *
 * Copyright (c) 2013-2019 Christian Werner <chw@ch-werner.de>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclFileSystem.h"
#include "zipfs.h"

#if !defined(_WIN32) && !defined(_WIN64)
#include <sys/mman.h>
#endif
#include <errno.h>
#include <string.h>
#include <sys/stat.h>
#include <time.h>
#include <stdlib.h>
#include <fcntl.h>
#ifndef MAP_FILE
#define MAP_FILE 0
#endif

#ifdef __FreeBSD__
/*
 * On FreeBSD the fdlopen(3) can be used in conjunction with shm_open(3)
 * for loading native code.
 */

#define ZIPFS_MEMLOAD 1

#include <dlfcn.h>
#endif

#if defined(linux) && !defined(ANDROID)
/*
 * On Linux >= 3.17 the memfd_create(2) system call can be
 * potentially used in combination with dlopen(3) for loading
 * native code. Otherwise, shm_open(3) can be used, too.
 */

#define ZIPFS_MEMLOAD 1

#include <sys/syscall.h>
#include <sys/utsname.h>
#include <dlfcn.h>

#ifndef __NR_memfd_create
#define __NR_memfd_create 319
#endif

/* Wrapper to call memfd_create(2). */
static inline int
memfd_create(const char *name, unsigned int flags)
{
    return syscall(__NR_memfd_create, name, flags);
}
#endif

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

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

#define ZIP_SIG_LEN                     4

/* Local header of ZIP archive member (at very beginning of each member). */
#define ZIP_LOCAL_HEADER_SIG            0x04034b50
#define ZIP_LOCAL_HEADER_LEN            30
#define ZIP_LOCAL_SIG_OFFS              0
#define ZIP_LOCAL_VERSION_OFFS          4
#define ZIP_LOCAL_FLAGS_OFFS            6
#define ZIP_LOCAL_COMPMETH_OFFS         8
#define ZIP_LOCAL_MTIME_OFFS            10
#define ZIP_LOCAL_MDATE_OFFS            12
#define ZIP_LOCAL_CRC32_OFFS            14
#define ZIP_LOCAL_COMPLEN_OFFS          18
#define ZIP_LOCAL_UNCOMPLEN_OFFS        22
#define ZIP_LOCAL_PATHLEN_OFFS          26
#define ZIP_LOCAL_EXTRALEN_OFFS         28

/* Central header of ZIP archive member at end of ZIP file. */
#define ZIP_CENTRAL_HEADER_SIG          0x02014b50
#define ZIP_CENTRAL_HEADER_LEN          46
#define ZIP_CENTRAL_SIG_OFFS            0
#define ZIP_CENTRAL_VERSIONMADE_OFFS    4
#define ZIP_CENTRAL_VERSION_OFFS        6
#define ZIP_CENTRAL_FLAGS_OFFS          8
#define ZIP_CENTRAL_COMPMETH_OFFS       10
#define ZIP_CENTRAL_MTIME_OFFS          12
#define ZIP_CENTRAL_MDATE_OFFS          14
#define ZIP_CENTRAL_CRC32_OFFS          16
#define ZIP_CENTRAL_COMPLEN_OFFS        20
#define ZIP_CENTRAL_UNCOMPLEN_OFFS      24
#define ZIP_CENTRAL_PATHLEN_OFFS        28
#define ZIP_CENTRAL_EXTRALEN_OFFS       30
#define ZIP_CENTRAL_FCOMMENTLEN_OFFS    32
#define ZIP_CENTRAL_DISKFILE_OFFS       34
#define ZIP_CENTRAL_IATTR_OFFS          36
#define ZIP_CENTRAL_EATTR_OFFS          38
#define ZIP_CENTRAL_LOCALHDR_OFFS       42

/* Central end signature at very end of ZIP file. */
#define ZIP_CENTRAL_END_SIG             0x06054b50
#define ZIP_CENTRAL_END_LEN             22
#define ZIP_CENTRAL_END_SIG_OFFS        0
#define ZIP_CENTRAL_DISKNO_OFFS         4
#define ZIP_CENTRAL_DISKDIR_OFFS        6
#define ZIP_CENTRAL_ENTS_OFFS           8
#define ZIP_CENTRAL_TOTALENTS_OFFS      10
#define ZIP_CENTRAL_DIRSIZE_OFFS        12
#define ZIP_CENTRAL_DIRSTART_OFFS       16
#define ZIP_CENTRAL_COMMENTLEN_OFFS     20

#define ZIP_MIN_VERSION                 20
#define ZIP_COMPMETH_STORED             0
#define ZIP_COMPMETH_DEFLATED           8

#define ZIP_PASSWORD_END_SIG            0x5a5a4b50

/*
 * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
 */

#define ZipReadInt(p) \
    ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
#define ZipReadShort(p) \
    ((p)[0] | ((p)[1] << 8))

#define ZipWriteInt(p, v)		\
    do {				\
	(p)[0] = (v) & 0xff;		\
	(p)[1] = ((v) >> 8) & 0xff;	\
	(p)[2] = ((v) >> 16) & 0xff;	\
	(p)[3] = ((v) >> 24) & 0xff;	\
    } while (0)
#define ZipWriteShort(p, v)		\
    do {				\
	(p)[0] = (v) & 0xff;		\
	(p)[1] = ((v) >> 8) & 0xff;	\
    } while (0)

/*
 * Windows drive letters.
 */

#if defined(_WIN32) || defined(_WIN64)
#define HAS_DRIVES 1
static const char drvletters[] =
    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
#else
#define HAS_DRIVES 0
#endif

/*
 * Mutex to protect localtime(3) when no reentrant version are available.
 */

#if !defined(_WIN32) && !defined(_WIN64)
#ifndef HAVE_LOCALTIME_R
#ifdef TCL_THREADS
TCL_DECLARE_MUTEX(localtimeMutex)
#endif
#endif
#endif

/*
 * In-core description of mounted ZIP archive file.
 */

typedef struct ZipFile {
    char *name;               /* Archive name */
    Tcl_Channel chan;         /* Channel handle or NULL */
    unsigned char *data;      /* Memory mapped or malloc'ed file */
    long length;              /* Length of memory mapped file */
    int ismapped;             /* True when data must be unmapped */
    unsigned char *tofree;    /* Non-NULL if malloc'ed file */
    int nfiles;               /* Number of files in archive */
    int baseoffs;             /* Archive start */
    int baseoffsp;            /* Password start */
    int centoffs;             /* Archive directory start */
    char pwbuf[264];          /* Password buffer */
#if defined(_WIN32) || defined(_WIN64)
    HANDLE mh;
#endif
    int nopen;                /* Number of open files on archive */
    struct ZipEntry *entries; /* List of files in archive */
    struct ZipEntry *topents; /* List of top-level dirs in archive */
#if HAS_DRIVES
    int mntdrv;	              /* Drive letter of mount point */
#endif
    int mntptlen;             /* Length of mount point */
    char mntpt[1];            /* Mount point */
} ZipFile;

/*
 * In-core description of file contained in mounted ZIP archive.
 */

typedef struct ZipEntry {
    char *name;               /* The full pathname of the virtual file */
    ZipFile *zipfile;         /* The ZIP file holding this virtual file */
    long offset;              /* Data offset into memory mapped ZIP file */
    int nbyte;                /* Uncompressed size of the virtual file */
    int nbytecompr;           /* Compressed size of the virtual file */
    int cmeth;                /* Compress method */
    int isdir;	              /* Set to 1 if directory, -1 if root */
    int depth; 	              /* Number of slashes in path. */
    int crc32;                /* CRC-32 */
    int timestamp;            /* Modification time */
    int isenc;                /* True if data is encrypted */
    unsigned char *data;      /* File data if written */
    struct ZipEntry *next;    /* Next file in the same archive */
    struct ZipEntry *tnext;   /* Next top-level dir in archive */
    struct ZipDirEntry *parent;  /* Pointer to parent directory */
} ZipEntry;

/*
 * In-core description of directory contained in mounted ZIP archive.
 */

typedef struct ZipDirEntry {
    struct ZipEntry entry;    /* See above */
    Tcl_HashTable children;   /* List of children of directory,
			       * with ZipEntry pointer keys */
} ZipDirEntry;

/*
 * File channel for file contained in mounted ZIP archive.
 */

typedef struct ZipChannel {
    ZipFile *zipfile;         /* The ZIP file holding this channel */
    ZipEntry *zipentry;       /* Pointer back to virtual file */
    unsigned long nmax;       /* Max. size for write */
    unsigned long nbyte;      /* Number of bytes of uncompressed data */
    unsigned long nread;      /* Pos of next byte to be read from the channel */
    unsigned char *ubuf;      /* Pointer to the uncompressed data */
    unsigned char *tofree;    /* Pointer to free on close or NULL */
    int iscompr;              /* True if data is compressed */
    int isdir;	              /* Set to 1 if directory, -1 if root */
    int iswr;                 /* True if open for writing */
    Tcl_Channel chan;         /* Tcl core's channel structure */
    int evmask;               /* TCL_READABLE and friends */
} ZipChannel;

/*
 * List of ZipChannels in thread.
 */

typedef struct ThreadSpecificData {
    int initialized;
    Tcl_HashTable chanTab;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Additional bits in ZipChannel.evmask.
 */

#define ZIPCHANNEL_NONBLOCK (TCL_EXCEPTION << 8)
#define ZIPCHANNEL_PENDING  (TCL_EXCEPTION << 9)

/*
 * Structure describing file event on ZipChannel.
 */

typedef struct ZipEvent {
    Tcl_Event header;           /* Standard event information */
    ZipChannel *info;           /* Pointer to ZipChannel */
} ZipEvent;

/*
 * Global variables.
 *
 * Most are kept in single ZipFS struct. When build with threading
 * support this struct is protected by the ZipFSMutex (see below).
 *
 * The "zipHash" component is the process wide global table of all mounted
 * ZIP archive files; keys are mount point path names.
 *
 * The "fileHash" component is the process wide global table of all known
 * ZIP archive members in all mounted ZIP archives; keys are path names.
 *
 * The "dirHash" component is the process wide global table of all known
 * ZIP directory archive members in all mounted ZIP archives; keys are
 * ZipDirEntry pointers.
 */

static struct {
    int initialized;		/* True when initialized */
    int lock;			/* RW lock, see below */
    int waiters;		/* RW lock, see below */
    int wrmax;			/* Maximum write size of a file */
    int idCount;		/* Counter for channel names */
    Tcl_HashTable zipHash;	/* Mount to ZipFile mapping */
    Tcl_HashTable fileHash;	/* File name to ZipEntry mapping */
    Tcl_HashTable dirHash;	/* Like fileHash but directories only */
} ZipFS = {
    0, 0, 0, 0, 0,
};

/*
 * For password rotation.
 */

static const char pwrot[16] = {
    0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
    0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0
};

/*
 * Table to compute CRC32.
 */

static const unsigned int crc32tab[256] = {
    0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
    0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
    0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
    0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
    0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
    0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
    0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
    0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
    0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
    0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
    0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
    0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
    0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
    0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
    0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
    0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
    0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
    0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
    0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
    0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
    0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
    0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
    0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
    0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
    0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
    0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
    0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
    0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
    0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
    0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
    0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
    0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
    0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
    0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
    0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
    0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
    0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
    0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
    0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
    0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
    0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
    0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
    0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
    0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
    0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
    0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
    0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
    0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
    0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
    0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
    0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
    0x2d02ef8d,
};

/*
 * Forward declarations.
 */

static ZipEntry *		ZipFSLookup(char *filename);
static ThreadSpecificData *	ZipChannelInit(void);
static int			ZipEventProc(Tcl_Event *evPtr, int flags);

/*
 * For embedding a ZIP in the binary.
 */

#if defined(ZIPFS_IN_TCL) || defined(ZIPFS_IN_TK)
#if defined(MAC_OSX_TCL)
#define ZIPFS_USE_ZEMBED 1
#include <dlfcn.h>
#include <mach-o/getsect.h>
static unsigned char *_binary_zembed_start = NULL;
static unsigned char *_binary_zembed_end = NULL;
#else
#if defined(__GNUC__) && !defined(ANDROID)
#define ZIPFS_USE_ZEMBED 1
typedef unsigned char zembed_data[0];
	const zembed_data _binary_zembed_start
		__attribute__((weak));
extern	const zembed_data _binary_zembed_end
		__attribute__((weak, alias("_binary_zembed_start")));
#endif
#endif
#endif


/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers
 *	and single writer on internal structs.
 *
 *	Limitations:
 *	- a read lock cannot be promoted to a write lock
 *	- a write lock may not be nested
 *
 *-------------------------------------------------------------------------
 */

TCL_DECLARE_MUTEX(ZipFSMutex)

#ifdef TCL_THREADS

static Tcl_Condition ZipFSCond;

static void
ReadLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock < 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock++;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
WriteLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock != 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock = -1;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
Unlock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    if (ZipFS.lock > 0) {
	--ZipFS.lock;
    } else if (ZipFS.lock < 0) {
	ZipFS.lock = 0;
    }
    if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) {
	Tcl_ConditionNotify(&ZipFSCond);
    }
    Tcl_MutexUnlock(&ZipFSMutex);
}

#else

#define ReadLock()	do {} while (0)
#define WriteLock()	do {} while (0)
#define Unlock()	do {} while (0)

#endif

/*
 *-------------------------------------------------------------------------
 *
 * DosTimeDate, ToDosTime, ToDosDate --
 *
 *	Functions to perform conversions between DOS time stamps
 *	and POSIX time_t.
 *
 *-------------------------------------------------------------------------
 */

static time_t
DosTimeDate(int dosDate, int dosTime)
{
    struct tm tm;
    time_t ret;

    memset(&tm, 0, sizeof(tm));
    tm.tm_isdst = -1;			/* let mktime() deal with DST */
    tm.tm_year = ((dosDate & 0xfe00) >> 9) + 80;
    tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1;
    tm.tm_mday = dosDate & 0x1f;
    tm.tm_hour = (dosTime & 0xf800) >> 11;
    tm.tm_min = (dosTime & 0x7e0) >> 5;
    tm.tm_sec = (dosTime & 0x1f) << 1;
    ret = mktime(&tm);
    if (ret == (time_t) -1) {
	/* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */
	ret = (time_t) 315532800;
    }
    return ret;
}

static int
ToDosTime(time_t when)
{
    struct tm *tmp, tm;

#ifdef TCL_THREADS
#if defined(_WIN32) || defined(_WIN64)
    /* Win32 uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#else
#ifdef HAVE_LOCALTIME_R
    tmp = &tm;
    localtime_r(&when, tmp);
#else
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
#endif
#else
    tmp = localtime(&when);
    tm = *tmp;
#endif
    return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1);
}

static int
ToDosDate(time_t when)
{
    struct tm *tmp, tm;

#ifdef TCL_THREADS
#if defined(_WIN32) || defined(_WIN64)
    /* Win32 uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#else
#ifdef HAVE_LOCALTIME_R
    tmp = &tm;
    localtime_r(&when, tmp);
#else
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
#endif
#else
    tmp = localtime(&when);
    tm = *tmp;
#endif
    return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday;
}

/*
 *-------------------------------------------------------------------------
 *
 * MemUnload --
 *
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Code removed from memory.
 *
 *-------------------------------------------------------------------------
 */

#ifdef ZIPFS_MEMLOAD
static void
MemUnload(Tcl_LoadHandle loadHandle)
{
    void *handle = loadHandle->clientData;
    int shm_fd = ((int *)(loadHandle + 1))[0];

    dlclose(handle);
    ckfree(loadHandle);
    if (shm_fd >= 0) {
	close(shm_fd);
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * MemSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

#ifdef ZIPFS_MEMLOAD
static void *
MemSymbol(
    Tcl_Interp *interp,		/* Place to put error messages. */
    Tcl_LoadHandle loadHandle,	/* Value from TcpDlopen(). */
    const char *symbol)		/* Symbol to look up. */
{
    const char *native;		/* Name of the library to be loaded, in
				 * system encoding */
    Tcl_DString newName, ds;	/* Buffers for converting the name to
				 * system encoding and prepending an
				 * underscore*/
    void *handle = (void *) loadHandle->clientData;
				/* Native handle to the loaded library */
    void *proc;			/* Address corresponding to the resolved
				 * symbol */

    /*
     * Some platforms still add an underscore to the beginning of symbol
     * names. If we can't find a name without an underscore, try again with
     * the underscore.
     */

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    proc = dlsym(handle, native);	/* INTL: Native. */
    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
    Tcl_DStringFree(&ds);
    if (proc == NULL) {
	const char *errorStr = dlerror();

	if (interp) {
	    if (!errorStr) {
		errorStr = "unknown";
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot find symbol \"%s\": %s", symbol, errorStr));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
		    NULL);
	}
    }
    return proc;
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * MemLoad --
 *
 *	Load a shared library using dlopen(3) and the memfd_create(2)
 *	system call available since kernel version 3.17. The technique
 *	is borrowed from
 *	https://x-c3ll.github.io/posts/fileless-memfd_create
 *
 * Results:
 *	A standard Tcl completion code.
 *
 * Side effects:
 *	New code may suddenly appear in memory.
 *
 *-------------------------------------------------------------------------
 */

#ifdef ZIPFS_MEMLOAD
static int
MemLoad(Tcl_Obj *pathPtr, Tcl_LoadHandle *loadHandle,
	Tcl_FSUnloadFileProc **unloadProcPtr, int flags)
{
#ifdef linux
    struct utsname uts;
    int major, minor;
#endif
    int shm_fd = -1, i, ch, dlopenFlags = 0, isshm = -1;
    ZipEntry *z = NULL;
    unsigned long keys[3];
    void *handle;
    Tcl_LoadHandle newHandle;
    unsigned char *in, *mbuf = MAP_FAILED;
    char path0[256], *path = NULL, *name, *tail;

#ifdef linux
    memset(&uts, 0, sizeof(uts));
    uname(&uts);
    if ((sscanf(uts.release, "%d.%d", &major, &minor) != 2) || (major < 3) ||
	((major == 3) && (minor < 17))) {
	/* Kernel version is less than 3.17, use shm_open(3). */
	isshm = 1;
    } else {
	isshm = 0;
    }
#endif

    /* Use (RTLD_NOW|RTLD_LOCAL) as default. */
    if (flags & TCL_LOAD_GLOBAL) {
	dlopenFlags |= RTLD_GLOBAL;
    } else {
	dlopenFlags |= RTLD_LOCAL;
    }
    if (flags & TCL_LOAD_LAZY) {
	dlopenFlags |= RTLD_LAZY;
    } else {
	dlopenFlags |= RTLD_NOW;
    }
    strcpy(path0, "/dev/shm");		/* Used for dlopen(3). */
    path = path0 + strlen(path0);	/* Used for shm_open(3). */
    name = Tcl_GetString(pathPtr);
    WriteLock();
    z = ZipFSLookup(name);
    if ((z == NULL) || z->isdir ||
	((z->cmeth != ZIP_COMPMETH_STORED) &&
	 (z->cmeth != ZIP_COMPMETH_DEFLATED))) {
	goto error;
    }
    if (z->data == NULL) {
	in = z->zipfile->data + z->offset;
    } else {
	in = z->data;
    }
    tail = strrchr(name, '/');
    if (tail != NULL) {
	++tail;
    } else {
	tail = name;
    }
#ifdef linux
    if (!isshm) {
	shm_fd = memfd_create(tail, 1); /* MFD_CLOEXEC */
	if (shm_fd < 0) {
	    /* Fall back to shm_open(3). */
	    isshm = 1;
	}
    }
#endif
    if (isshm) {
	sprintf(path, "/%d_%.230s", getpid(), tail);
	shm_fd = shm_open(path, O_RDWR | O_CREAT | O_TRUNC | O_EXCL, 0600);
    }
    if (shm_fd < 0) {
	goto error;
    }
    if (ftruncate(shm_fd, z->nbyte) < 0) {
	goto error;
    }
    mbuf = (unsigned char *) mmap(0, z->nbyte, PROT_READ | PROT_WRITE,
				  MAP_FILE | MAP_SHARED, shm_fd, 0);
    if (mbuf == MAP_FAILED) {
	goto error;
    }
    if (z->isenc) {
	int len = z->zipfile->pwbuf[0] & 0xff;
	char pwbuf[260];

	for (i = 0; i < len; i++) {
	    ch = z->zipfile->pwbuf[len - i];
	    pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	}
	pwbuf[i] = '\0';
	init_keys(pwbuf, keys, crc32tab);
	memset(pwbuf, 0, sizeof(pwbuf));
	for (i = 0; i < 12; i++) {
	    ch = in[i];
	    zdecode(keys, crc32tab, ch);
	}
	in += i;
    }
    if (z->cmeth == ZIP_COMPMETH_DEFLATED) {
	z_stream stream;
	int err;
	unsigned char *ubuf = NULL;
	unsigned int j;

	memset(&stream, 0, sizeof(stream));
	stream.zalloc = Z_NULL;
	stream.zfree = Z_NULL;
	stream.opaque = Z_NULL;
	stream.avail_in = z->nbytecompr;
	if (z->isenc) {
	    stream.avail_in -= 12;
	    ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in);
	    if (ubuf == NULL) {
		goto error;
	    }
	    for (j = 0; j < stream.avail_in; j++) {
		ch = in[j];
		ubuf[j] = zdecode(keys, crc32tab, ch);
	    }
	    memset(keys, 0, sizeof(keys));
	    stream.next_in = ubuf;
	} else {
	    stream.next_in = in;
	}
	stream.next_out = mbuf;
	stream.avail_out = z->nbyte;
	if (inflateInit2(&stream, -15) != Z_OK) {
	    goto inflError;
	}
	err = inflate(&stream, Z_SYNC_FLUSH);
	inflateEnd(&stream);
	if ((err == Z_STREAM_END) ||
	    ((err == Z_OK) && (stream.avail_in == 0))) {
	    if (ubuf != NULL) {
		Tcl_Free((char *) ubuf);
	    }
	    goto success;
	}
inflError:
	if (ubuf != NULL) {
	    Tcl_Free((char *) ubuf);
	}
	goto error;
    } else if (z->isenc) {
	unsigned int j, len;

	len = z->nbytecompr - 12;
	for (j = 0; j < len; j++) {
	    ch = in[j];
	    mbuf[j] = zdecode(keys, crc32tab, ch);
	}
	memset(keys, 0, sizeof(keys));
    } else {
	memcpy(mbuf, in, z->nbyte);
    }
success:
    munmap(mbuf, z->nbyte);
    Unlock();
    if (!isshm) {
	sprintf(path0, "/proc/%d/fd/%d", getpid(), shm_fd);
    }
#ifdef __FreeBSD__
    handle = fdlopen(shm_fd, dlopenFlags);
#else
    handle = dlopen(path0, dlopenFlags);
#endif
    if (isshm) {
	close(shm_fd);
	shm_fd = -1;
	shm_unlink(path);
    }
    if (handle == NULL) {
	if (shm_fd >= 0) {
	    close(shm_fd);
	}
	return TCL_ERROR;
    }
    newHandle = ckalloc(sizeof(*newHandle) + sizeof(int));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &MemSymbol;
    newHandle->unloadFileProcPtr = &MemUnload;
    /* Keep the memfd file descriptor; it's closed on unload. */
    ((int *)(newHandle + 1))[0] = shm_fd;
    *unloadProcPtr = &MemUnload;
    *loadHandle = newHandle;
    return TCL_OK;
error:
    if (mbuf != MAP_FAILED) {
	munmap(mbuf, z->nbyte);
    }
    Unlock();
    if (shm_fd >= 0) {
	close(shm_fd);
    }
    if (isshm && (shm_fd >= 0) && (path[0] != '\0')) {
	shm_unlink(path);
    }
    return TCL_ERROR;
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * CountSlashes --
 *
 *	This function counts the number of slashes in a pathname string.
 *
 * Results:
 *	Number of slashes found in string.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
CountSlashes(const char *string)
{
    int count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;
    }
    return count;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanonicalPath --
 *
 *	This function computes the canonical path from a directory
 *	and file name components into the specified Tcl_DString.
 *
 * Results:
 *	Returns the pointer to the canonical path contained in the
 *	specified Tcl_DString.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *-------------------------------------------------------------------------
 */

static char *
CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr)
{
    char *path;
    int i, j, c, isunc = 0;

#if HAS_DRIVES
    if ((tail[0] != '\0') && (strchr(drvletters, tail[0]) != NULL) &&
	(tail[1] == ':')) {
	tail += 2;
    }
    /* UNC style path */
    if (tail[0] == '\\') {
	root = "";
	++tail;
    }
    if (tail[0] == '\\') {
	root = "/";
	++tail;
    }
#endif
    /* UNC style path */
    if ((root[0] == '/') && (root[1] == '/')) {
	isunc = 1;
    }
    if (tail[0] == '/') {
	root = "";
	++tail;
	isunc = 0;
    }
    if (tail[0] == '/') {
	root = "/";
	++tail;
	isunc = 1;
    }
    i = strlen(root);
    j = strlen(tail);
    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
    for (i = j = 0; (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);
    return Tcl_DStringValue(dsPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * AbsolutePath --
 *
 *	This function computes the absolute path from a given
 *	(relative) path name into the specified Tcl_DString.
 *
 * Results:
 *	Returns the pointer to the absolute path contained in the
 *	specified Tcl_DString.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *-------------------------------------------------------------------------
 */

static char *
AbsolutePath(const char *path,
#if HAS_DRIVES
	     int *drvPtr,
#endif
	     Tcl_DString *dsPtr)
{
    char *result;

#if HAS_DRIVES
    if (drvPtr != NULL) {
	*drvPtr = 0;
    }
#endif
    if (*path == '~') {
	Tcl_DStringAppend(dsPtr, path, -1);
	return Tcl_DStringValue(dsPtr);
    }
    if ((*path != '/')
#if HAS_DRIVES
	&& (*path != '\\') &&
	(((*path != '\0') && (strchr(drvletters, *path) == NULL)) ||
	 (path[1] != ':'))
#endif
	) {
	Tcl_DString pwd;

	/* relative path */
	Tcl_DStringInit(&pwd);
	Tcl_GetCwd(NULL, &pwd);
	result = Tcl_DStringValue(&pwd);
#if HAS_DRIVES
	if ((result[0] != '\0') && (strchr(drvletters, result[0]) != NULL) &&
	    (result[1] == ':')) {
	    if (drvPtr != NULL) {
		drvPtr[0] = result[0];
		if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) {
		    drvPtr[0] -= 'a' - 'A';
		}
	    }
	    result += 2;
	}
#endif
	result = CanonicalPath(result, path, dsPtr);
	Tcl_DStringFree(&pwd);
    } else {
	/* absolute path */
#if HAS_DRIVES
	if ((path[0] != '\0') && (strchr(drvletters, path[0]) != NULL) &&
	    (path[1] == ':')) {
	    if (drvPtr != NULL) {
		drvPtr[0] = path[0];
		if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) {
		    drvPtr[0] -= 'a' - 'A';
		}
	    }
	}
#endif
	result = CanonicalPath("", path, dsPtr);
    }
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookup --
 *
 *	This function returns the ZIP entry struct corresponding to
 *	the ZIP archive member of the given file name.
 *
 * Results:
 *	Returns the pointer to ZIP entry struct or NULL if the
 *	the given file name could not be found in the global list
 *	of ZIP archive members.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static ZipEntry *
ZipFSLookup(char *filename)
{
    char *realname;
    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    Tcl_DString ds;
#if HAS_DRIVES
    int drive = 0;
#endif

    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    realname = AbsolutePath(filename, &drive, &ds);
#else
    realname = AbsolutePath(filename, &ds);
#endif
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, realname);
    z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL;
    Tcl_DStringFree(&ds);
#if HAS_DRIVES
    if ((z != NULL) && drive && (drive != z->zipfile->mntdrv)) {
	z = NULL;
    }
#endif
    return z;
}

#ifdef NEVER_USED

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookupMount --
 *
 *	This function returns an indication if the given file name
 *	corresponds to a mounted ZIP archive file.
 *
 * Results:
 *	Returns true, if the given file name is a mounted ZIP archive file.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSLookupMount(char *filename)
{
    char *realname;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;
    Tcl_DString ds;
    int match = 0;
#if HAS_DRIVES
    int drive = 0;
#endif

    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    realname = AbsolutePath(filename, &drive, &ds);
#else
    realname = AbsolutePath(filename, &ds);
#endif
    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search);) {
	if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
#if HAS_DRIVES
	    if (drive && (drive != zf->mntdrv)) {
		continue;
	    }
#endif
	    if (strcmp(zf->mntpt, realname) == 0) {
		match = 1;
		break;
	    }
	}
    }
    Tcl_DStringFree(&ds);
    return match;
}
#endif

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCloseArchive --
 *
 *	This function closes a mounted ZIP archive file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A memory mapped ZIP archive is unmapped, allocated memory is
 *	released.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf)
{
#if defined(_WIN32) || defined(_WIN64)
    if ((zf->data != NULL) && (zf->tofree == NULL)) {
	if (zf->ismapped) {
	    UnmapViewOfFile(zf->data);
	}
	zf->data = NULL;
    }
    if (zf->mh != INVALID_HANDLE_VALUE) {
	CloseHandle(zf->mh);
    }
#else
    if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) {
	if (zf->ismapped) {
	    munmap(zf->data, zf->length);
	}
	zf->data = MAP_FAILED;
    }
#endif
    if (zf->tofree != NULL) {
	Tcl_Free((char *) zf->tofree);
	zf->tofree = zf->data = NULL;
    }
    if (zf->chan != NULL) {
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenCommon, ZipFSOpenArchive, ZipFSOpenBuffer --
 *
 *	These functions open a ZIP archive file for reading.
 *	ZipFSOpenArchive attemtps to memory map the archive file.
 *	Otherwise it is read into an allocated memory buffer.
 *	ZipFSOpenBuffer works on a user provided memory buffer,
 *	which optionally is copied to a private buffer.
 *	The common part verifies the ZIP archive header which
 *	must be valid for the function to succeed. When "needZip"
 *	is zero an embedded ZIP archive in an executable file is
 *	accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message
 *	placed into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	ZIP archive is memory mapped or read into allocated memory,
 *	or taken from a user provided memory buffer; the given ZipFile
 *	struct is filled with information about the ZIP archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSOpenCommon(Tcl_Interp *interp, int needZip, ZipFile *zf)
{
    int i;
    unsigned char *p, *q;

    p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
    while (p >= zf->data) {
	if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
		break;
	    }
	    p -= ZIP_SIG_LEN;
	} else {
	    --p;
	}
    }
    if (p < zf->data) {
	if (!needZip) {
	    zf->baseoffs = zf->baseoffsp = zf->length;
	    return TCL_OK;
	}
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("wrong end signature", -1));
	}
	goto error;
    }
    zf->nfiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
    if (zf->nfiles == 0) {
	if (!needZip) {
	    zf->baseoffs = zf->baseoffsp = zf->length;
	    return TCL_OK;
	}
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("empty archive", -1));
	}
	goto error;
    }
    q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
    p -= ZipReadInt(p + ZIP_CENTRAL_DIRSIZE_OFFS);
    if ((p < zf->data) || (p > (zf->data + zf->length)) ||
	(q < zf->data) || (q > (zf->data + zf->length))) {
	if (!needZip) {
	    zf->baseoffs = zf->baseoffsp = zf->length;
	    return TCL_OK;
	}
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
		Tcl_NewStringObj("archive directory not found", -1));
	}
	goto error;
    }
    zf->baseoffs = zf->baseoffsp = p - q;
    zf->centoffs = p - zf->data;
    q = p;
    for (i = 0; i < zf->nfiles; i++) {
	int pathlen, comlen, extra;

	if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("wrong header length", -1));
	    }
	    goto error;
	}
	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("wrong header signature", -1));
	    }
	    goto error;
	}
	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    q = zf->data + zf->baseoffs;
    if ((zf->baseoffs >= 6) &&
	(ZipReadInt(q - 4) == ZIP_PASSWORD_END_SIG)) {
	i = q[-5];
	if (q - 5 - i > zf->data) {
	    zf->pwbuf[0] = i;
	    memcpy(zf->pwbuf + 1, q - 5 - i, i);
	    zf->baseoffsp -= i ? (5 + i) : 0;
	}
    }
    return TCL_OK;

error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

static int
ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip,
		 ZipFile *zf)
{
    int i;
    ClientData handle;

    memset(zf, 0, sizeof(*zf));
#if defined(_WIN32) || defined(_WIN64)
    zf->data = NULL;
    zf->mh = INVALID_HANDLE_VALUE;
#else
    zf->data = MAP_FAILED;
#endif
    zf->length = 0;
    zf->ismapped = 0;
    zf->nfiles = 0;
    zf->baseoffs = zf->baseoffsp = 0;
    zf->tofree = NULL;
    zf->pwbuf[0] = 0;

#ifdef ZIPFS_USE_ZEMBED
    /*
     * Mount from embedded memory buffer in special case.
     */
#if defined(MAC_OSX_TCL)
    if (strcmp(zipname, Tcl_GetNameOfExecutable()) == 0) {
	Dl_info dlinfo;
	unsigned char *data = NULL;
	unsigned long size = 0;

	memset(&dlinfo, 0, sizeof(dlinfo));
	dladdr(Zipfs_Init, &dlinfo);
	data = getsectiondata(dlinfo.dli_fbase, "__TEXT", "__zipfs", &size);
	if ((data != NULL) && (size > 0)) {
	    _binary_zembed_start = data;
	    _binary_zembed_end = _binary_zembed_start + size;
	    zf->chan = NULL;
	    zf->data = _binary_zembed_start;
	    zf->length = _binary_zembed_end - _binary_zembed_start;
	    needZip = 1;
	    goto gotZembed;
	}
    }
#else
    if ((_binary_zembed_end - _binary_zembed_start > 0) &&
	(strcmp(zipname, Tcl_GetNameOfExecutable()) == 0)) {
	zf->chan = NULL;
	zf->data = (unsigned char *) _binary_zembed_start;
	zf->length = _binary_zembed_end - _binary_zembed_start;
	needZip = 1;
	goto gotZembed;
    }
#endif
#endif

    zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0);
    if (zf->chan == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
	if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary")
	    != TCL_OK) {
	    goto error;
	}
	if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary")
	    != TCL_OK) {
	    goto error;
	}
	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("illegal file size", -1));
	    }
	    goto error;
	}
	Tcl_Seek(zf->chan, 0, SEEK_SET);
	zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length);
	if (zf->tofree == NULL) {
	    if (interp) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("out of memory", -1));
	    }
	    goto error;
	}
	i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
	if (i != zf->length) {
	    if (interp) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("file read error", -1));
	    }
	    goto error;
	}
	Tcl_Close(interp, zf->chan);
	zf->chan = NULL;
    } else {
#if defined(_WIN32) || defined(_WIN64)
	zf->length = GetFileSize((HANDLE) handle, 0);
	if ((zf->length == INVALID_FILE_SIZE) ||
	    (zf->length < ZIP_CENTRAL_END_LEN)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("invalid file size", -1));
	    }
	    goto error;
	}
	zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0,
				   zf->length, 0);
	if (zf->mh == INVALID_HANDLE_VALUE) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("file mapping failed", -1));
	    }
	    goto error;
	}
	zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length);
	if (zf->data == NULL) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("file mapping failed", -1));
	    }
	    goto error;
	}
	zf->ismapped = 1;
#else
	zf->length = lseek((int) (long) handle, 0, SEEK_END);
	if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("invalid file size", -1));
	    }
	    goto error;
	}
	lseek((int) (long) handle, 0, SEEK_SET);
	zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
					  MAP_FILE | MAP_PRIVATE,
					  (int) (long) handle, 0);
	if (zf->data == MAP_FAILED) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
				 Tcl_NewStringObj("file mapping failed", -1));
	    }
	    goto error;
	}
	zf->ismapped = 1;
#endif
    }

#ifdef ZIPFS_USE_ZEMBED
gotZembed:
#endif

    return ZipFSOpenCommon(interp, needZip, zf);

error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

static int
ZipFSOpenBuffer(Tcl_Interp *interp, unsigned char *data, int length,
		int copy, ZipFile *zf)
{
    memset(zf, 0, sizeof(*zf));
#if defined(_WIN32) || defined(_WIN64)
    zf->mh = INVALID_HANDLE_VALUE;
#endif
    if (copy) {
	zf->data = (unsigned char *) Tcl_AttemptAlloc(length);
	if (zf->data == NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("out of memory", -1));
	    return TCL_ERROR;
	}
	memcpy(zf->data, data, length);
	zf->tofree = zf->data;
    } else {
	zf->data = data;
	zf->tofree = NULL;
    }
    zf->length = length;
    zf->ismapped = 0;
    zf->nfiles = 0;
    zf->baseoffs = zf->baseoffsp = 0;
    zf->pwbuf[0] = 0;
    zf->chan = NULL;
    return ZipFSOpenCommon(interp, 1, zf);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_ListMountInfo --
 *
 *      Write information about mounted ZIP file systems to
 *	interp's result.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *-------------------------------------------------------------------------
 */

static int
Zipfs_ListMountInfo(Tcl_Interp *interp)
{
    int i, ret = TCL_OK;
    ZipFile *zf;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    i = 0;
    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
    while (hPtr != NULL) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	if (zf != NULL) {
	    if (interp != NULL) {
#if HAS_DRIVES
		Tcl_DString ds;
		char drvbuf[3];

		Tcl_DStringInit(&ds);
		drvbuf[0] = zf->mntdrv;
		drvbuf[1] = ':';
		drvbuf[2] = '\0';
		Tcl_DStringAppend(&ds, drvbuf, -1);
		Tcl_DStringAppend(&ds, zf->mntpt, zf->mntptlen);
		Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
		Tcl_DStringFree(&ds);
#else
		Tcl_AppendElement(interp, zf->mntpt);
#endif
		Tcl_AppendElement(interp, zf->name);
	    }
	    ++i;
	}
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (interp == NULL) {
	ret = (i > 0) ? TCL_OK : TCL_BREAK;
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_MountCommon --
 *
 *      Common part of mounting a ZIP archive file.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
Zipfs_MountCommon(Tcl_Interp *interp, const char *zipname,
		  const char *mntpt, int isBuffer, ZipFile *zf0)
{
    char *realname;
    int i, isNew;
    ZipFile *zf;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, dsm, fpBuf;
    unsigned char *q;
#if HAS_DRIVES
    char *p;
    int drive = 0;
#endif

    Tcl_DStringInit(&ds);
    if (isBuffer) {
	Tcl_DStringAppend(&ds, zipname, -1);
	realname = Tcl_DStringValue(&ds);
    } else {
#if HAS_DRIVES
	realname = AbsolutePath(zipname, NULL, &ds);
#else
	realname = AbsolutePath(zipname, &ds);
#endif
    }
    /*
     * 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.
     */
    Tcl_DStringInit(&dsm);
#if HAS_DRIVES
    mntpt = AbsolutePath(mntpt, &drive, &dsm);
    if (drive == 0) {
	/*
	 * Enforce a drive letter by using [pwd] information.
	 */
	Tcl_DString pwd;

	Tcl_DStringInit(&pwd);
	Tcl_GetCwd(NULL, &pwd);
	if (Tcl_DStringValue(&pwd)[1] == ':') {
	    drive = Tcl_DStringValue(&pwd)[0];
	    if ((drive >= 'a') && (drive <= 'z')) {
		drive -= 'a' - 'A';
	    }
	}
	Tcl_DStringFree(&pwd);
    }
#else
    mntpt = AbsolutePath(mntpt, &dsm);
#endif
    WriteLock();
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, realname, &isNew);
    Tcl_DStringSetLength(&ds, 0);
    if (!isNew) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	if (interp != NULL) {
#if HAS_DRIVES
	    char drvbuf[3];

	    drvbuf[0] = zf->mntdrv;
	    drvbuf[1] = ':';
	    drvbuf[2] = '\0';
	    Tcl_AppendResult(interp, "already mounted on \"", drvbuf,
			     zf->mntptlen ? zf->mntpt : "/", "\"",
			     (char *) NULL);
#else
	    Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ?
			     zf->mntpt : "/", "\"", (char *) NULL);
#endif
	}
	Unlock();
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&dsm);
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    if (strcmp(mntpt, "/") == 0) {
	mntpt = "";
    }
    zf = (ZipFile *) Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mntpt) + 1);
    if (zf == NULL) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	}
	Unlock();
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&dsm);
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    *zf = *zf0;
    zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    strcpy(zf->mntpt, mntpt);
    zf->mntptlen = strlen(zf->mntpt);
#if HAS_DRIVES
    for (p = zf->mntpt; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    zf->mntdrv = drive;
#endif
    zf->entries = NULL;
    zf->topents = NULL;
    zf->nopen = 0;
    Tcl_SetHashValue(hPtr, (ClientData) zf);
    if (mntpt[0] != '\0') {
	z = (ZipEntry *) Tcl_Alloc(sizeof(ZipDirEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->parent = NULL;
	z->depth = CountSlashes(mntpt);
	z->zipfile = zf;
	z->isdir = (zf->baseoffs == 0) ? 1 : -1;	/* root marker */
	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, but increment number of open files in
	     * referenced file system.
	     */
	    Tcl_Free((char *) z);
	    z = (ZipEntry *) Tcl_GetHashValue(hPtr);
	    z->zipfile->nopen++;
	} else {
	    Tcl_SetHashValue(hPtr, (ClientData) z);
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	    hPtr = Tcl_CreateHashEntry(&ZipFS.dirHash, (ClientData) z, &isNew);
	    Tcl_SetHashValue(hPtr, (ClientData) z);
	    Tcl_InitHashTable(&((ZipDirEntry *) z)->children,
			      TCL_ONE_WORD_KEYS);
	}
    }
    q = zf->data + zf->centoffs;
    Tcl_DStringInit(&fpBuf);
    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 = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(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 +
	     ZipReadInt(q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < zf->data) || (lq > (zf->data + zf->length))) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0) &&
	    (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) &&
	    (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	}
	offs = (lq - zf->data)
	     + ZIP_LOCAL_HEADER_LEN
	     + ZipReadShort(lq + ZIP_LOCAL_PATHLEN_OFFS)
	     + ZipReadShort(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);
	z = (ZipEntry *) Tcl_Alloc(isdir ?
				   sizeof(ZipDirEntry) : sizeof(ZipEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->parent = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipfile = zf;
	z->isdir = isdir;
	z->isenc = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
	    && (nbcompr > 12);
	z->offset = offs;
	if (gq != NULL) {
	    z->crc32 = ZipReadInt(gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = ZipReadShort(gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = ZipReadShort(gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->nbyte = ZipReadInt(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->cmeth = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);
	} else {
	    z->crc32 = ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = ZipReadShort(lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = ZipReadShort(lq + ZIP_LOCAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->nbyte = ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->cmeth = ZipReadShort(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 (z->isdir) {
		hPtr = Tcl_CreateHashEntry(&ZipFS.dirHash,
					   (ClientData) z, &isNew);
		Tcl_SetHashValue(hPtr, (ClientData) z);
		Tcl_InitHashTable(&((ZipDirEntry *) z)->children,
				  TCL_ONE_WORD_KEYS);
	    }
	    if (z->isdir && (mntpt[0] == '\0') && (z->depth == 1)) {
		z->tnext = zf->topents;
		zf->topents = z;
	    }
	    if (z->depth > 1) {
		char *dir, *end;
		ZipDirEntry *zd;
		ZipEntry *addChild = z;

		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) {
			zd = (ZipDirEntry *) Tcl_GetHashValue(hPtr);
			hPtr = Tcl_CreateHashEntry(&zd->children,
					   (ClientData) addChild, &isNew);
			if (isNew) {
			    addChild->parent = zd;
			    Tcl_SetHashValue(hPtr, (ClientData) addChild);
			}
			break;
		    }
		    zd = (ZipDirEntry *) Tcl_Alloc(sizeof(ZipDirEntry));
		    zd->entry.name = NULL;
		    zd->entry.tnext = NULL;
		    zd->entry.parent = NULL;
		    zd->entry.depth = CountSlashes(dir);
		    zd->entry.zipfile = zf;
		    zd->entry.isdir = 1;
		    zd->entry.isenc = 0;
		    zd->entry.offset = z->offset;
		    zd->entry.crc32 = 0;
		    zd->entry.timestamp = z->timestamp;
		    zd->entry.nbyte = zd->entry.nbytecompr = 0;
		    zd->entry.cmeth = ZIP_COMPMETH_STORED;
		    zd->entry.data = NULL;
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {
			/* should not happen but skip it anyway */
			Tcl_Free((char *) zd);
			zd = (ZipDirEntry *) Tcl_GetHashValue(hPtr);
		    } else {
			Tcl_SetHashValue(hPtr, (ClientData) zd);
			zd->entry.name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
			zd->entry.next = zf->entries;
			zf->entries = &zd->entry;
			hPtr = Tcl_CreateHashEntry(&ZipFS.dirHash,
						   (ClientData) zd, &isNew);
			Tcl_SetHashValue(hPtr, (ClientData) zd);
			Tcl_InitHashTable(&zd->children, TCL_ONE_WORD_KEYS);
		    }
		    hPtr = Tcl_CreateHashEntry(&zd->children,
					       (ClientData) addChild, &isNew);
		    if (isNew) {
			addChild->parent = zd;
			Tcl_SetHashValue(hPtr, (ClientData) addChild);
		    }
		    if ((mntpt[0] == '\0') && (zd->entry.depth == 1)) {
			zd->entry.tnext = zf->topents;
			zf->topents = &zd->entry;
		    }
		    addChild = &zd->entry;
		    end = strrchr(dir, '/');
		}
	    }
	}
nextent:
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    Unlock();
    Tcl_DStringFree(&fpBuf);
    Tcl_DStringFree(&ds);
    Tcl_DStringFree(&dsm);
    Tcl_FSMountsChanged(NULL);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_Mount --
 *
 *      This procedure is invoked to mount a given ZIP archive file on
 *	a given mountpoint with optional ZIP password.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
Zipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,
	    const char *passwd)
{
    int i, pwlen, ret;
    ZipFile *zf, zf0;
    Tcl_HashEntry *hPtr;
#if HAS_DRIVES
    int drive = 0;
#endif

    ReadLock();
    if (!ZipFS.initialized) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("not initialized", -1));
	}
	Unlock();
	return TCL_ERROR;
    }
    if (zipname == NULL) {
	ret = Zipfs_ListMountInfo(interp);
	Unlock();
	return ret;
    }
    if (mntpt == NULL) {
	char *p;
	Tcl_DString ds;

	if (interp == NULL) {
	    Unlock();
	    return TCL_OK;
	}
	Tcl_DStringInit(&ds);
#if HAS_DRIVES
	p = AbsolutePath(zipname, &drive, &ds);
#else
	p = AbsolutePath(zipname, &ds);
#endif
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, p);
	if (hPtr == NULL) {
	    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname);
	}
	if (hPtr != NULL) {
	    zf = Tcl_GetHashValue(hPtr);
	    if (zf != NULL) {
#if HAS_DRIVES
		if (drive == zf->mntdrv) {
		    Tcl_Obj *string;
		    char drvbuf[3];

		    drvbuf[0] = zf->mntdrv;
		    drvbuf[1] = ':';
		    drvbuf[2] = '\0';
		    string = Tcl_NewStringObj(drvbuf, -1);
		    Tcl_AppendToObj(string, zf->mntpt, zf->mntptlen);
		    Tcl_SetObjResult(interp, string);
		}
#else
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(zf->mntpt, zf->mntptlen));
#endif
	    }
	}
	Unlock();
	Tcl_DStringFree(&ds);
	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;
    }
    if ((zf0.pwbuf[0] == 0) && pwlen) {
	int k = 0;

	i = pwlen;
	zf0.pwbuf[k++] = i;
	while (i > 0) {
	    zf0.pwbuf[k] = (passwd[i - 1] & 0x0f) |
		pwrot[(passwd[i - 1] >> 4) & 0x0f];
	    k++;
	    i--;
	}
	zf0.pwbuf[k] = '\0';
    }
    ret = Zipfs_MountCommon(interp, zipname, mntpt, 0, &zf0);
    if (zf0.pwbuf[0]) {
	memset(&zf0, 0, sizeof(zf0));
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_MountBuffer --
 *
 *      This procedure is invoked to mount a given ZIP archive contained
 *	in a memory buffer on a given mountpoint.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A ZIP archive from memory is analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
Zipfs_MountBuffer(Tcl_Interp *interp, const char *mntpt,
		  unsigned char *data, size_t length, int copy)
{
    int ret;
    ZipFile zf0;
    char namebuf[64];

    ReadLock();
    if (!ZipFS.initialized) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("not initialized", -1));
	}
	Unlock();
	return TCL_ERROR;
    }
    if (mntpt == NULL) {
	ret = Zipfs_ListMountInfo(interp);
	Unlock();
	return ret;
    }
    if ((data == NULL) || (length == 0)) {
	Unlock();
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("empty data provided", -1));
	}
	return TCL_ERROR;
    }
    Unlock();
    if (ZipFSOpenBuffer(interp, data, length, 0, &zf0) != TCL_OK) {
	return TCL_ERROR;
    }
    sprintf(namebuf, "memory_%ld_%d", (long) length, ZipFS.idCount++);
    ret = Zipfs_MountCommon(interp, namebuf, mntpt, 1, &zf0);
    if (ret == TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(namebuf, -1));
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_Unmount --
 *
 *      This procedure is invoked to unmount a given ZIP archive.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

int
Zipfs_Unmount(Tcl_Interp *interp, const char *zipname)
{
    char *realname;
    ZipFile *zf;
    ZipEntry *z, *znext;
    ZipDirEntry *zd, *zdirs = NULL;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds;
    int ret = TCL_OK, unmounted = 0;
#if HAS_DRIVES
    int drive = 0;
#endif

    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    realname = AbsolutePath(zipname, &drive, &ds);
#else
    realname = AbsolutePath(zipname, &ds);
#endif
    WriteLock();
    if (!ZipFS.initialized) {
	goto done;
    }
    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, realname);
    if (hPtr == NULL) {
#if HASH_DRIVES
	drive = 0;
#endif
	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);
	}
	hPtr = Tcl_FindHashEntry(&ZipFS.dirHash, (ClientData) z);
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
	if (z->parent != NULL) {
	    hPtr = Tcl_FindHashEntry(&z->parent->children, (ClientData) z);
	    if (hPtr != NULL) {
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
	if (z->data != NULL) {
	    Tcl_Free((char *) z->data);
	}
	if (z->isdir) {
	    z->next = (ZipEntry *) zdirs;
	    zdirs = (ZipDirEntry *) z;
	} else {
	    Tcl_Free((char *) z);
	}
    }
    while (zdirs != NULL) {
	zd = zdirs;
	zdirs = (ZipDirEntry *) zd->entry.next;
	Tcl_DeleteHashTable(&zd->children);
	Tcl_Free((char *) zd);
    }
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, zf->mntpt);
    if (hPtr != NULL) {
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);
	if (z->zipfile != zf) {
	    z->zipfile->nopen--;
	}
    }
    ZipFSCloseArchive(interp, zf);
    Tcl_Free((char *) zf);
    unmounted = 1;
done:
    Unlock();
    Tcl_DStringFree(&ds);
    if (unmounted) {
	Tcl_FSMountsChanged(NULL);
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::mount" command.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountObjCmd(ClientData clientData, Tcl_Interp *interp,
		 int objc, Tcl_Obj *const objv[])
{
    int optLen;
    const char *option;

    if (objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
			 "?-option ?arg? ?mountpoint? ?password?");
	return TCL_ERROR;
    }
    if (objc > 3) {
	option = Tcl_GetString(objv[1]);
	optLen = strlen(option);
	if ((optLen > 1) && strncmp(option, "-data", 5) == 0) {
	    unsigned char *data;
	    int length;

	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 1, objv,
				 "-data bytearray mountpoint");
		return TCL_ERROR;
	    }
	    data = Tcl_GetByteArrayFromObj(objv[2], &length);
	    return Zipfs_MountBuffer(interp, Tcl_GetString(objv[3]),
				     data, length, 1);
	} else if ((optLen > 1) && strncmp(option, "-chan", 5) == 0) {
	    unsigned char *data;
	    int length, ret;
	    Tcl_Channel chan;
	    Tcl_Obj *dataObj;

	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 1, objv,
				 "-chan channelId mountpoint");
		return TCL_ERROR;
	    }
	    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[2]), NULL);
	    if (chan == NULL) {
		return TCL_ERROR;
	    }
	    dataObj = Tcl_NewObj();
	    Tcl_IncrRefCount(dataObj);
	    if (Tcl_ReadChars(chan, dataObj, -1, 0) == -1) {
		Tcl_DecrRefCount(dataObj);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error: %s", Tcl_PosixError(interp)));
 		return TCL_ERROR;
	    }
	    data = Tcl_GetByteArrayFromObj(dataObj, &length);
	    ret = Zipfs_MountBuffer(interp, Tcl_GetString(objv[3]),
				    data, length, 1);
	    Tcl_DecrRefCount(dataObj);
	    return ret;
	} else if ((optLen > 1) && ((strncmp(option, "-file", 5) == 0) ||
				    (strcmp(option, "--") == 0))) {
	    return Zipfs_Mount(interp, Tcl_GetString(objv[2]),
			       Tcl_GetString(objv[3]),
			       (objc > 4) ? Tcl_GetString(objv[4]) : NULL);
	}
    } else if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
			 "?zipfile? ?mountpoint? ?password?");
	return TCL_ERROR;
    }
    return Zipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
		       (objc > 2) ? Tcl_GetString(objv[2]) : NULL,
		       (objc > 3) ? Tcl_GetString(objv[3]) : NULL);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSUnmountObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::unmount" command.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSUnmountObjCmd(ClientData clientData, Tcl_Interp *interp,
		   int objc, Tcl_Obj *const objv[])
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
	return TCL_ERROR;
    }
    return Zipfs_Unmount(interp, Tcl_GetString(objv[1]));
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkKeyObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::mkkey" command.
 *	It produces a rotated password to be embedded into an image file.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkKeyObjCmd(ClientData clientData, Tcl_Interp *interp,
		 int objc, Tcl_Obj *const objv[])
{
    int len, i = 0;
    char *pw, pwbuf[264];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = Tcl_GetString(objv[1]);
    len = strlen(pw);
    if (len == 0) {
	return TCL_OK;
    }
    if ((len > 255) || (strchr(pw, 0xff) != NULL)) {
	Tcl_SetObjResult(interp,
			 Tcl_NewStringObj("illegal password", -1));
	return TCL_ERROR;
    }
    while (len > 0) {
	int ch = pw[len - 1];

	pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	i++;
	len--;
    }
    pwbuf[i] = i;
    ++i;
    pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG;
    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
    pwbuf[i] = '\0';
    Tcl_AppendResult(interp, pwbuf, (char *) NULL);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipAddFile --
 *
 *      This procedure is used by ZipFSMkZipOrImgCmd() to add a single
 *	file to the output ZIP archive file being written. A ZipEntry
 *	struct about the input file is added to the given fileHash table
 *	for later creation of the central ZIP directory.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	Input file is read and (compressed and) written to the output
 *	ZIP archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipAddFile(Tcl_Interp *interp, const char *path, const char *name,
	   Tcl_Channel out, const char *passwd,
	   char *buf, int bufsize, Tcl_HashTable *fileHash)
{
    Tcl_Channel in;
    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    z_stream stream;
    const char *zpath;
    int nbyte, nbytecompr, len, crc, flush, pos[3], zpathlen, olen;
    int mtime = 0, isNew, align = 0, cmeth;
    unsigned long keys[3], keys0[3];
    char obuf[4096];

    zpath = name;
    while (zpath != NULL && zpath[0] == '/') {
	zpath++;
    }
    if ((zpath == NULL) || (zpath[0] == '\0')) {
	return TCL_OK;
    }
    zpathlen = strlen(zpath);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_AppendResult(interp, "path too long for \"", path, "\"",
			 (char *) NULL);
	return TCL_ERROR;
    }
    in = Tcl_OpenFileChannel(interp, path, "r", 0);
    if ((in == NULL) ||
	(Tcl_SetChannelOption(interp, in, "-translation", "binary")
	 != TCL_OK) ||
	(Tcl_SetChannelOption(interp, in, "-encoding", "binary")
	 != TCL_OK)) {
#if defined(_WIN32) || defined(_WIN64)
	 /* hopefully a directory */
	 if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
	    Tcl_Close(interp, in);
	    return TCL_OK;
	}
#endif
	Tcl_Close(interp, in);
	return TCL_ERROR;
    } else {
	Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
	Tcl_StatBuf statBuf;

	Tcl_IncrRefCount(pathObj);
	if (Tcl_FSStat(pathObj, &statBuf) != -1) {
	    mtime = statBuf.st_mtime;
	}
	Tcl_DecrRefCount(pathObj);
    }
    Tcl_ResetResult(interp);
    crc = 0;
    nbyte = nbytecompr = 0;
    while ((len = Tcl_Read(in, buf, bufsize)) > 0) {
	crc = crc32(crc, (unsigned char *) buf, len);
	nbyte += len;
    }
    if (len == -1) {
	if (nbyte == 0) {
	    if (strcmp("illegal operation on a directory",
		       Tcl_PosixError(interp)) == 0) {
		Tcl_Close(interp, in);
		return TCL_OK;
	    }
	}
	Tcl_AppendResult(interp, "read error on \"", path, "\"",
			 (char *) NULL);
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
	Tcl_AppendResult(interp, "seek error on \"", path, "\"",
			 (char *) NULL);
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    pos[0] = Tcl_Tell(out);
    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
wrerr:
	Tcl_AppendResult(interp, "write error", (char *) NULL);
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    if ((len + pos[0]) & 3) {
	char abuf[8];

	/*
	 * Align payload to next 4-byte boundary using a dummy extra
	 * entry similar to the zipalign tool from Android's SDK.
	 */
	align = 0xffff;
	ZipWriteShort(abuf, align);
	align = 4 + ((len + pos[0]) & 3);
	ZipWriteShort(abuf + 2, align - 4);
	ZipWriteInt(abuf + 4, 0x03020100);
	if (Tcl_Write(out, abuf, align) != align) {
	    goto wrerr;
	}
    }
    if (passwd != NULL) {
	int i, ch, tmp;
	unsigned char kvbuf[24];
	Tcl_Obj *ret;

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    if (Tcl_EvalEx(interp, "expr {int(rand() * 256) % 256}", -1, 0)
		!= TCL_OK) {
		Tcl_AppendResult(interp, "PRNG error", (char *) NULL);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    ret = Tcl_GetObjResult(interp);
	    if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) {
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    kvbuf[i + 12] = (unsigned char)
		    zencode(keys, crc32tab, ch & 0xff, tmp);
	}
	Tcl_ResetResult(interp);
	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    kvbuf[i] = (unsigned char) zencode(keys, crc32tab,
					       kvbuf[i + 12], tmp);
	}
	kvbuf[i++] = (unsigned char)
		zencode(keys, crc32tab, (crc >> 16) & 0xff, tmp);
	kvbuf[i++] = (unsigned char)
		zencode(keys, crc32tab, (crc >> 24) & 0xff, tmp);
	len = Tcl_Write(out, (char *) kvbuf, 12);
	memset(kvbuf, 0, 24);
	if (len != 12) {
	    Tcl_AppendResult(interp, "write error", (char *) NULL);
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	memcpy(keys0, keys, sizeof(keys0));
	nbytecompr += 12;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    cmeth = ZIP_COMPMETH_DEFLATED;
    memset(&stream, 0, sizeof(stream));
    stream.zalloc = Z_NULL;
    stream.zfree = Z_NULL;
    stream.opaque = Z_NULL;
    if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY)
	!= Z_OK) {
	Tcl_AppendResult(interp, "compression init error on \"", path, "\"",
			 (char *) NULL);
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }
    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == -1) {
	    Tcl_AppendResult(interp, "read error on \"", path, "\"",
			     (char *) NULL);
	    deflateEnd(&stream);
	    Tcl_Close(interp, in);
	    return TCL_ERROR;
	}
	stream.avail_in = len;
	stream.next_in = (unsigned char *) buf;
	flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
	do {
	    stream.avail_out = sizeof(obuf);
	    stream.next_out = (unsigned char *) obuf;
	    len = deflate(&stream, flush);
	    if (len == Z_STREAM_ERROR) {
		Tcl_AppendResult(interp, "deflate error on \"", path, "\"",
				 (char *) NULL);
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    olen = sizeof(obuf) - stream.avail_out;
	    if (passwd != NULL) {
		int i, tmp;

		for (i = 0; i < olen; i++) {
		    obuf[i] = (char)
			    zencode(keys, crc32tab, obuf[i] & 0xff, tmp);
		}
	    }
	    if (olen && (Tcl_Write(out, obuf, olen) != olen)) {
		Tcl_AppendResult(interp, "write error", (char *) NULL);
		deflateEnd(&stream);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += olen;
	    if (len == Z_STREAM_END) {
		flush = Z_FINISH;
		break;
	    }
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);
    Tcl_Flush(out);
    pos[1] = Tcl_Tell(out);
    if (nbyte - nbytecompr <= 0) {
	/*
	 * Compressed file larger than input,
	 * write it again uncompressed.
	 */
	if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) {
	    goto seekErr;
	}
	if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
seekErr:
	    Tcl_Close(interp, in);
	    Tcl_AppendResult(interp, "seek error", (char *) NULL);
	    return TCL_ERROR;
	}
	nbytecompr = (passwd != NULL) ? 12 : 0;
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
	    if (len == -1) {
		Tcl_AppendResult(interp, "read error on \"", path, "\"",
				 (char *) NULL);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    } else if (len == 0) {
		break;
	    }
	    if (passwd != NULL) {
		int i, tmp;

		for (i = 0; i < len; i++) {
		    buf[i] = (char)
			    zencode(keys0, crc32tab, buf[i] & 0xff, tmp);
		}
	    }
	    if (Tcl_Write(out, buf, len) != len) {
		Tcl_AppendResult(interp, "write error", (char *) NULL);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    nbytecompr += len;
	}
	cmeth = ZIP_COMPMETH_STORED;
	Tcl_Flush(out);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
    }
    Tcl_Close(interp, in);

    z = (ZipEntry *) Tcl_Alloc(sizeof(ZipEntry));
    z->name = NULL;
    z->tnext = NULL;
    z->parent = NULL;
    z->depth = 0;
    z->zipfile = NULL;
    z->isdir = 0;
    z->isenc = (passwd != NULL) ? 1 : 0;
    z->offset = pos[0];
    z->crc32 = crc;
    z->timestamp = mtime;
    z->nbyte = nbyte;
    z->nbytecompr = nbytecompr;
    z->cmeth = cmeth;
    z->data = NULL;
    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
    if (!isNew) {
	Tcl_AppendResult(interp, "non-unique path name \"", path, "\"",
			 (char *) NULL);
	Tcl_Free((char *) z);
	return TCL_ERROR;
    } else {
	Tcl_SetHashValue(hPtr, (ClientData) z);
	z->name = Tcl_GetHashKey(fileHash, hPtr);
	z->next = NULL;
    }

    /*
     * Write final local header information.
     */
    ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(buf + ZIP_LOCAL_FLAGS_OFFS, z->isenc);
    ZipWriteShort(buf + ZIP_LOCAL_COMPMETH_OFFS, z->cmeth);
    ZipWriteShort(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
    ZipWriteShort(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
    ZipWriteInt(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(buf + ZIP_LOCAL_COMPLEN_OFFS, z->nbytecompr);
    ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->nbyte);
    ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
    ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
    if ((int) Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free((char *) z);
	Tcl_AppendResult(interp, "seek error", (char *) NULL);
	return TCL_ERROR;
    }
    if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free((char *) z);
	Tcl_AppendResult(interp, "write error", (char *) NULL);
	return TCL_ERROR;
    }
    Tcl_Flush(out);
    if ((int) Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free((char *) z);
	Tcl_AppendResult(interp, "seek error", (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipOrImgObjCmd --
 *
 *      This procedure is creates a new ZIP archive file or image file
 *	given output filename, input directory of files to be archived,
 *	optional password, and optional image to be prepended to the
 *	output ZIP archive file.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	A new ZIP archive file or image file is written.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp,
		      int isImg, int isList, int objc, Tcl_Obj *const objv[])
{
    Tcl_Channel out;
    int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3];
    Tcl_Obj **lobjv, *list = NULL;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096];

    if (isList) {
	if ((objc < 3) || (objc > (isImg ? 5 : 4))) {
	    Tcl_WrongNumArgs(interp, 1, objv, isImg ?
			     "outfile inlist ?password infile?" :
			     "outfile inlist ?password?");
	    return TCL_ERROR;
	}
    } else {
	if ((objc < 3) || (objc > (isImg ? 6 : 5))) {
	    Tcl_WrongNumArgs(interp, 1, objv, isImg ?
			     "outfile indir ?strip? ?password? ?infile?" :
			     "outfile indir ?strip? ?password?");
	    return TCL_ERROR;
	}
    }
    pwbuf[0] = 0;
    if (objc > (isList ? 3 : 4)) {
	pw = Tcl_GetString(objv[isList ? 3 : 4]);
	pwlen = strlen(pw);
	if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("illegal password", -1));
	    return TCL_ERROR;
	}
    }
    if (isList) {
	list = objv[2];
	Tcl_IncrRefCount(list);
    } else {
	Tcl_Obj *cmd[3];

	cmd[1] = Tcl_NewStringObj("::zipfs::find", -1);
	cmd[2] = objv[2];
	cmd[0] = Tcl_NewListObj(2, cmd + 1);
	Tcl_IncrRefCount(cmd[0]);
	if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
	    Tcl_DecrRefCount(cmd[0]);
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(cmd[0]);
	list = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(list);
    }
    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (isList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("need even number of elements", -1));
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
	return TCL_ERROR;
    }
    out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755);
    if ((out == NULL) ||
	(Tcl_SetChannelOption(interp, out, "-translation", "binary")
	 != TCL_OK) ||
	(Tcl_SetChannelOption(interp, out, "-encoding", "binary")
	 != TCL_OK)) {
	Tcl_DecrRefCount(list);
	Tcl_Close(interp, out);
	return TCL_ERROR;
    }
    if (pwlen <= 0) {
	pw = NULL;
	pwlen = 0;
    }
    if (isImg) {
	ZipFile *zf, zf0;
	int isMounted = 0;
	const char *imgName;

	if (isList) {
	    imgName = (objc > 4) ? Tcl_GetString(objv[4]) :
		Tcl_GetNameOfExecutable();
	} else {
	    imgName = (objc > 5) ? Tcl_GetString(objv[5]) :
		Tcl_GetNameOfExecutable();
	}
	if (pwlen) {
	    i = 0;
	    len = pwlen;
	    while (len > 0) {
		int ch = pw[len - 1];

		pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		i++;
		len--;
	    }
	    pwbuf[i] = i;
	    ++i;
	    pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG;
	    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
	    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
	    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
	    pwbuf[i] = '\0';
	}
	/* Check for mounted image */
	WriteLock();
	hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
	while (hPtr != NULL) {
	    if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
		if (strcmp(zf->name, imgName) == 0) {
		    isMounted = 1;
		    zf->nopen++;
		    break;
		}
	    }
	    hPtr = Tcl_NextHashEntry(&search);
	}
	Unlock();
	if (!isMounted) {
	    zf = &zf0;
	}
	if (isMounted ||
	    (ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK)) {
	    i = Tcl_Write(out, (char *) zf->data, zf->baseoffsp);
	    if (i != zf->baseoffsp) {
		memset(pwbuf, 0, sizeof(pwbuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
		Tcl_Close(interp, out);
		if (zf == &zf0) {
		    ZipFSCloseArchive(interp, zf);
		} else {
		    WriteLock();
		    zf->nopen--;
		    Unlock();
		}
		return TCL_ERROR;
	    }
	    if (zf == &zf0) {
		ZipFSCloseArchive(interp, zf);
	    } else {
		WriteLock();
		zf->nopen--;
		Unlock();
	    }
	} else {
	    int k, n, m;
	    Tcl_Channel in;
	    const char *errMsg = "seek error";

	    /*
	     * Fall back to read it as plain file which
	     * hopefully is a static tclsh or wish binary
	     * with proper zipfs infrastructure built in.
	     */
	    Tcl_ResetResult(interp);
	    in = Tcl_OpenFileChannel(interp, imgName, "r", 0644);
	    if (in == NULL) {
		memset(pwbuf, 0, sizeof(pwbuf));
		Tcl_DecrRefCount(list);
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	    Tcl_SetChannelOption(interp, in, "-translation", "binary");
	    Tcl_SetChannelOption(interp, in, "-encoding", "binary");
	    i = Tcl_Seek(in, 0, SEEK_END);
	    if (i == -1) {
cperr:
		memset(pwbuf, 0, sizeof(pwbuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
		Tcl_Close(interp, out);
		Tcl_Close(interp, in);
		return TCL_ERROR;
	    }
	    Tcl_Seek(in, 0, SEEK_SET);
	    k = 0;
	    while (k < i) {
		m = i - k;
		if (m > sizeof(buf)) {
		    m = sizeof(buf);
		}
		n = Tcl_Read(in, buf, m);
		if (n == -1) {
		    errMsg = "read error";
		    goto cperr;
		} else if (n == 0) {
		    break;
		}
		m = Tcl_Write(out, buf, n);
		if (m != n) {
		    errMsg = "write error";
		    goto cperr;
		}
		k += m;
	    }
	    Tcl_Close(interp, in);
	}
	len = strlen(pwbuf);
	if (len > 0) {
	    i = Tcl_Write(out, pwbuf, len);
	    if (i != len) {
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
		Tcl_Close(interp, out);
		return TCL_ERROR;
	    }
	}
	memset(pwbuf, 0, sizeof(pwbuf));
	Tcl_Flush(out);
    }
    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    pos[0] = Tcl_Tell(out);
    if (!isList && (objc > 3)) {
	strip = Tcl_GetString(objv[3]);
	slen = strlen(strip);
    }
    for (i = 0; i < lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, path, name, out, pw, buf, sizeof(buf),
		       &fileHash) != TCL_OK) {
	    goto done;
	}
    }
    pos[1] = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = Tcl_GetString(lobjv[i]);
	if (isList) {
	    name = Tcl_GetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (hPtr == NULL) {
	    continue;
	}
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);
	len = strlen(z->name);
	ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0);
	ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth);
	ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
	ZipWriteShort(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
	ZipWriteInt(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
	ZipWriteInt(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr);
	ZipWriteInt(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte);
	ZipWriteShort(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
	ZipWriteShort(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
	if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) !=
	     ZIP_CENTRAL_HEADER_LEN) ||
	    (Tcl_Write(out, z->name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
	    goto done;
	}
	count++;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    ZipWriteInt(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_ENTS_OFFS, count);
    ZipWriteShort(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
    ZipWriteShort(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;
done:
    if (ret == TCL_OK) {
	ret = Tcl_Close(interp, out);
    } else {
	Tcl_Close(interp, out);
    }
    Tcl_DecrRefCount(list);
    hPtr = Tcl_FirstHashEntry(&fileHash, &search);
    while (hPtr != NULL) {
	z = (ZipEntry *) Tcl_GetHashValue(hPtr);
	Tcl_Free((char *) z);
	Tcl_DeleteHashEntry(hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&fileHash);
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::mkzip" command.
 *	See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipObjCmd(ClientData clientData, Tcl_Interp *interp,
		 int objc, Tcl_Obj *const objv[])
{
    return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv);
}

static int
ZipFSLMkZipObjCmd(ClientData clientData, Tcl_Interp *interp,
		  int objc, Tcl_Obj *const objv[])
{
    return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkImgObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::mkimg" command.
 *	See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp,
		 int objc, Tcl_Obj *const objv[])
{
    return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv);
}

static int
ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp,
		  int objc, Tcl_Obj *const objv[])
{
    return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSExistsObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::exists" command.
 *	It tests for the existence of a file in the ZIP filesystem and
 *	places a boolean into the interp's result.
 *
 * Results:
 *      Always TCL_OK.
 *
 * Side effects:
 *      None.
 *
 *-------------------------------------------------------------------------
 */

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

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetStringFromObj(objv[1], 0);
    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
    Unlock();
    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), exists);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSInfoObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::info" command.
 *	On success, it returns a Tcl list made up of name of ZIP archive
 *	file, size uncompressed, size compressed, and archive offset of
 *	a file in the ZIP filesystem.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSInfoObjCmd(ClientData clientData, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetStringFromObj(objv[1], 0);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z != NULL) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
				 Tcl_NewStringObj(z->zipfile->name, -1));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset));
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListObjCmd --
 *
 *      This procedure is invoked to process the "zipfs::list" command.
 *	On success, it returns a Tcl list of files of the ZIP filesystem
 *	which match a search pattern (glob or regexp).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSListObjCmd(ClientData clientData, Tcl_Interp *interp,
		int objc, Tcl_Obj *const objv[])
{
    char *pattern = NULL;
    Tcl_RegExp regexp = NULL;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *result = Tcl_GetObjResult(interp);

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	int n;
	char *what = Tcl_GetStringFromObj(objv[1], &n);

	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
	    pattern = Tcl_GetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
	    regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2]));
	    if (regexp == NULL) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "unknown option \"", what,
			     "\"", (char *) NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = Tcl_GetStringFromObj(objv[1], 0);
    }
    ReadLock();
    if (pattern != NULL) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    if (Tcl_StringMatch(z->name, pattern)) {
		Tcl_ListObjAppendElement(interp, result,
					 Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else if (regexp != NULL) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
		Tcl_ListObjAppendElement(interp, result,
					 Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	    Tcl_ListObjAppendElement(interp, result,
				     Tcl_NewStringObj(z->name, -1));
	}
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelClose --
 *
 *	This function is called to close a channel.
 *
 * Results:
 *	Always TCL_OK.
 *
 * Side effects:
 *	Resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelClose(ClientData instanceData, Tcl_Interp *interp)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    ThreadSpecificData *tsdPtr =
	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);

    WriteLock();
    if (info->iswr) {
	ZipEntry *z = info->zipentry;
	unsigned char *newdata;

	/*
	 * If opened for writing, commit the entire file
	 * to the mounted archive now.
	 */

	newdata = (unsigned char *)
	    Tcl_AttemptRealloc((char *) info->ubuf, info->nread);
	if (newdata != NULL) {
	    if (z->data != NULL) {
		Tcl_Free((char *) z->data);
	    }
	    z->data = newdata;
	    z->nbyte = z->nbytecompr = info->nbyte;
	    z->cmeth = ZIP_COMPMETH_STORED;
	    z->timestamp = time(NULL);
	    z->isdir = 0;
	    z->isenc = 0;
	    z->offset = 0;
	    z->crc32 = 0;
	    info->tofree = info->ubuf = NULL;
	}
    }
    info->zipfile->nopen--;
    Unlock();
    if (info->tofree != NULL) {
	Tcl_Free((char *) info->tofree);
    }
    if ((tsdPtr != NULL) && tsdPtr->initialized) {
	Tcl_HashEntry *hPtr;

	hPtr = Tcl_FindHashEntry(&tsdPtr->chanTab, (ClientData) info);
	if (hPtr != NULL) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
    Tcl_Free((char *) info);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelRead --
 *
 *	This function is called to read data from channel.
 *
 * Results:
 *	Number of bytes read or -1 on error with error number set.
 *
 * Side effects:
 *	Data is read and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (info->isdir < 0) {
	/*
	 * Special case: when executable combined with ZIP archive file
	 * read data in front of ZIP, i.e. the executable itself.
	 */
	nextpos = info->nread + toRead;
	if (nextpos > info->zipfile->baseoffs) {
	    toRead = info->zipfile->baseoffs - info->nread;
	    nextpos = info->zipfile->baseoffs;
	}
	if (toRead == 0) {
	    return 0;
	}
	memcpy(buf, info->zipfile->data + info->nread, toRead);
	info->nread = nextpos;
	*errloc = 0;
	return toRead;
    }
    if (info->isdir) {
	*errloc = EISDIR;
	return -1;
    }
    nextpos = info->nread + toRead;
    if (nextpos > info->nbyte) {
	toRead = info->nbyte - info->nread;
	nextpos = info->nbyte;
    }
    if (toRead == 0) {
	return 0;
    }
    memcpy(buf, info->ubuf + info->nread, toRead);
    info->nread = nextpos;
    *errloc = 0;
    return toRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWrite --
 *
 *	This function is called to write data into channel.
 *
 * Results:
 *	Number of bytes written or -1 on error with error number set.
 *
 * Side effects:
 *	Data is written and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelWrite(ClientData instanceData, const char *buf,
		int toWrite, int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (!info->iswr) {
	*errloc = EINVAL;
	return -1;
    }
    nextpos = info->nread + toWrite;
    if (nextpos > info->nmax) {
	toWrite = info->nmax - info->nread;
	nextpos = info->nmax;
    }
    if (toWrite == 0) {
	return 0;
    }
    memcpy(info->ubuf + info->nread, buf, toWrite);
    info->nread = nextpos;
    if (info->nread > info->nbyte) {
	info->nbyte = info->nread;
    }
    *errloc = 0;
    return toWrite;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelSeek --
 *
 *	This function is called to position file pointer of channel.
 *
 * Results:
 *	New file position or -1 on error with error number set.
 *
 * Side effects:
 *	File pointer is repositioned according to offset and mode.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long end;

    if (!info->iswr && (info->isdir < 0)) {
	/*
	 * Special case: when executable combined with ZIP archive file,
	 * seek within front of ZIP, i.e. the executable itself.
	 */
	end = info->zipfile->baseoffs;
    } else if (info->isdir) {
	*errloc = EINVAL;
	return -1;
    } else {
	end = info->nbyte;
    }
    switch (mode) {
    case SEEK_CUR:
	offset += info->nread;
	break;
    case SEEK_END:
	offset += end;
	break;
    case SEEK_SET:
	break;
    default:
	*errloc = EINVAL;
	return -1;
    }
    if (offset < 0) {
	*errloc = EINVAL;
	return -1;
    }
    if (info->iswr) {
	if ((unsigned long) offset > info->nmax) {
	    *errloc = EINVAL;
	    return -1;
	}
	if ((unsigned long) offset > info->nbyte) {
	    info->nbyte = offset;
	}
    } else if ((unsigned long) offset > end) {
	*errloc = EINVAL;
	return -1;
    }
    info->nread = (unsigned long) offset;
    return info->nread;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWatchChannel --
 *
 *	This function is called for event notifications on channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipChannelWatchChannel(ClientData instanceData, int mask)
{
    ZipEvent *event;
    ZipChannel *info = (ZipChannel *) instanceData;
    Tcl_HashEntry *hPtr;
    int isNew;
    ThreadSpecificData *tsdPtr =
	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);

    mask &= ~TCL_EXCEPTION; /* not supported at all */
    if ((mask & TCL_WRITABLE) && !info->iswr) {
	mask &= ~TCL_WRITABLE;
    }
    info->evmask &= ~(TCL_READABLE | TCL_WRITABLE);
    info->evmask |= mask & (TCL_READABLE | TCL_WRITABLE);
    if (info->evmask & (TCL_READABLE | TCL_WRITABLE)) {
	if ((tsdPtr != NULL) && tsdPtr->initialized) {
	    hPtr = Tcl_CreateHashEntry(&tsdPtr->chanTab,
				       (ClientData) info, &isNew);
	    if (isNew) {
		Tcl_SetHashValue(hPtr, (ClientData) info);
		event = ckalloc(sizeof(ZipEvent));
		event->header.proc = ZipEventProc;
		event->info = info;
		Tcl_QueueEvent((Tcl_Event *) event, TCL_QUEUE_TAIL);
	    }
	}
    } else {
	info->evmask &= ~(ZIPCHANNEL_NONBLOCK);
	if ((tsdPtr != NULL) && tsdPtr->initialized) {
	    hPtr = Tcl_FindHashEntry(&tsdPtr->chanTab, (ClientData) info);
	    if (hPtr != NULL) {
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelGetFile --
 *
 *	This function is called to retrieve OS handle for channel.
 *
 * Results:
 *	Always TCL_ERROR since there's never an OS handle for a
 *	file within a ZIP archive.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelGetFile(ClientData instanceData, int direction,
		  ClientData *handlePtr)
{
    return TCL_ERROR;
}

#ifdef TCL_CHANNEL_VERSION_4
/*
 *----------------------------------------------------------------------
 *
 * ZipChannelBlockMode --
 *
 *	Set blocking or non-blocking mode on channel.
 *
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the channel into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
ZipChannelBlockMode(ClientData instanceData, int mode)
{
    ZipChannel *info = (ZipChannel *) instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	info->evmask |= ZIPCHANNEL_NONBLOCK;
    } else {
	info->evmask &= ~(ZIPCHANNEL_NONBLOCK);
    }
    return 0;
}
#endif

#ifdef TCL_CHANNEL_VERSION_4
/*
 *----------------------------------------------------------------------
 *
 * ZipChannelThreadAction --
 *
 *	Insert or remove any thread local refs to this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Changes thread local info of valid channels.
 *
 *----------------------------------------------------------------------
 */

static void
ZipChannelThreadAction(ClientData instanceData, int action)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    Tcl_HashEntry *hPtr;
    int isNew;
    ThreadSpecificData *tsdPtr =
	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
    static const Tcl_Time blockTime = { 0, 0 };

    if (tsdPtr == NULL) {
	return;
    }
    if (action == TCL_CHANNEL_THREAD_INSERT) {
	if (info->evmask & (TCL_READABLE | TCL_WRITABLE)) {
	    hPtr = Tcl_CreateHashEntry(&tsdPtr->chanTab,
				       (ClientData) info, &isNew);
	    if (isNew) {
		Tcl_SetHashValue(hPtr, (ClientData) info);
		Tcl_SetMaxBlockTime(&blockTime);
	    }
	}
    } else {
	hPtr = Tcl_FindHashEntry(&tsdPtr->chanTab, (ClientData) info);
	if (hPtr != NULL) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
}
#endif

/*
 * The channel type/driver definition used for ZIP archive members.
 */

static Tcl_ChannelType ZipChannelType = {
    "zip",                  /* Type name. */
#ifdef TCL_CHANNEL_VERSION_4
    TCL_CHANNEL_VERSION_4,
    ZipChannelClose,        /* Close channel, clean instance data */
    ZipChannelRead,         /* Handle read request */
    ZipChannelWrite,        /* Handle write request */
    ZipChannelSeek,         /* Move location of access point, NULL'able */
    NULL,                   /* Set options, NULL'able */
    NULL,                   /* Get options, NULL'able */
    ZipChannelWatchChannel, /* Initialize notifier */
    ZipChannelGetFile,      /* Get OS handle from the channel */
    NULL,                   /* 2nd version of close channel, NULL'able */
    ZipChannelBlockMode,    /* Set blocking mode for raw channel, NULL'able */
    NULL,                   /* Function to flush channel, NULL'able */
    NULL,                   /* Function to handle event, NULL'able */
    NULL,                   /* Wide seek function, NULL'able */
    ZipChannelThreadAction, /* Thread action function, NULL'able */
#else
    NULL,                   /* Set blocking/nonblocking behaviour, NULL'able */
    ZipChannelClose,        /* Close channel, clean instance data */
    ZipChannelRead,         /* Handle read request */
    ZipChannelWrite,        /* Handle write request */
    ZipChannelSeek,         /* Move location of access point, NULL'able */
    NULL,                   /* Set options, NULL'able */
    NULL,                   /* Get options, NULL'able */
    ZipChannelWatchChannel, /* Initialize notifier */
    ZipChannelGetFile,      /* Get OS handle from the channel */
#endif
};

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelOpen --
 *
 *	This function opens a Tcl_Channel on a file from a mounted ZIP
 *	archive according to given open mode.
 *
 * Results:
 *	Tcl_Channel on success, or NULL on error.
 *
 * Side effects:
 *	Memory is allocated, the file from the ZIP archive is uncompressed.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions)
{
    ZipEntry *z;
    ZipChannel *info;
    int i, ch, trunc, wr, flags = 0;
    unsigned long keys[3];
    char cname[128];

    ZipChannelInit();	/* Ensure TSD is initialized. */

    if ((mode & O_APPEND) ||
	((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1));
	}
	return NULL;
    }
    WriteLock();
    z = ZipFSLookup(filename);
    if (z == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1));
	}
	goto error;
    }
    z->zipfile->nopen++;
    trunc = (mode & O_TRUNC) != 0;
    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
    if ((z->cmeth != ZIP_COMPMETH_STORED) &&
	(z->cmeth != ZIP_COMPMETH_DEFLATED)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unsupported compression method", -1));
	}
	goto error;
    }
    if (wr && z->isdir) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
		Tcl_NewStringObj("unsupported file type", -1));
	}
	goto error;
    }
    if (!trunc) {
	flags |= TCL_READABLE;
	if (z->isenc && (z->zipfile->pwbuf[0] == 0)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("decryption failed", -1));
	    }
	    goto error;
	} else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("file too large", -1));
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = (ZipChannel *) Tcl_AttemptAlloc(sizeof(ZipChannel));
    if (info == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1));
	}
	goto error;
    }
    info->zipfile = z->zipfile;
    info->zipentry = z;
    info->nread = 0;
    info->chan = NULL;
    info->evmask = 0;
    if (wr) {
	flags |= TCL_WRITABLE;
	info->iswr = 1;
	info->isdir = 0;
	info->nbyte = 0;
	info->nmax = ZipFS.wrmax;
	info->iscompr = 0;
	info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax);
	if (info->ubuf == NULL) {
merror0:
	    if (info->ubuf != NULL) {
		Tcl_Free((char *) info->ubuf);
	    }
	    Tcl_Free((char *) info);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("out of memory", -1));
	    }
	    goto error;
	}
	info->tofree = info->ubuf;
	memset(info->ubuf, 0, info->nmax);
	if (trunc) {
	    info->nbyte = 0;
	} else {
	    if (z->data != NULL) {
		unsigned int j = z->nbyte;

		if (j > info->nmax) {
		    j = info->nmax;
		}
		memcpy(info->ubuf, z->data, j);
		info->nbyte = j;
	    } else {
		unsigned char *zbuf = z->zipfile->data + z->offset;

		if (z->isenc) {
		    int len = z->zipfile->pwbuf[0] & 0xff;
		    char pwbuf[260];

		    for (i = 0; i < len; i++) {
			ch = z->zipfile->pwbuf[len - i];
			pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		    }
		    pwbuf[i] = '\0';
		    init_keys(pwbuf, keys, crc32tab);
		    memset(pwbuf, 0, sizeof(pwbuf));
		    for (i = 0; i < 12; i++) {
			ch = zbuf[i];
			zdecode(keys, crc32tab, ch);
		    }
		    zbuf += i;
		}
		if (z->cmeth == ZIP_COMPMETH_DEFLATED) {
		    z_stream stream;
		    int err;
		    unsigned char *cbuf = NULL;

		    memset(&stream, 0, sizeof(stream));
		    stream.zalloc = Z_NULL;
		    stream.zfree = Z_NULL;
		    stream.opaque = Z_NULL;
		    stream.avail_in = z->nbytecompr;
		    if (z->isenc) {
			unsigned int j;

			stream.avail_in -= 12;
			cbuf = (unsigned char *)
			    Tcl_AttemptAlloc(stream.avail_in);
			if (cbuf == NULL) {
			    memset(keys, 0, sizeof(keys));
			    goto merror0;
			}
			for (j = 0; j < stream.avail_in; j++) {
			    ch = zbuf[j];
			    cbuf[j] = zdecode(keys, crc32tab, ch);
			}
			memset(keys, 0, sizeof(keys));
			stream.next_in = cbuf;
		    } else {
			stream.next_in = zbuf;
		    }
		    stream.next_out = info->ubuf;
		    stream.avail_out = info->nmax;
		    if (inflateInit2(&stream, -15) != Z_OK) {
			goto cerror0;
		    }
		    err = inflate(&stream, Z_SYNC_FLUSH);
		    inflateEnd(&stream);
		    if ((err == Z_STREAM_END) ||
			((err == Z_OK) && (stream.avail_in == 0))) {
			if (cbuf != NULL) {
			    Tcl_Free((char *) cbuf);
			}
			info->nbyte = z->nbyte;
			goto wrapchan;
		    }
cerror0:
		    if (cbuf != NULL) {
			Tcl_Free((char *) cbuf);
		    }
		    if (info->ubuf != NULL) {
			Tcl_Free((char *) info->ubuf);
		    }
		    Tcl_Free((char *) info);
		    if (interp != NULL) {
			Tcl_SetObjResult(interp,
			    Tcl_NewStringObj("decompression error", -1));
		    }
		    goto error;
		} else if (z->isenc) {
		    for (i = 0; i < z->nbyte - 12; i++) {
			ch = zbuf[i];
			info->ubuf[i] = zdecode(keys, crc32tab, ch);
		    }
		    memset(keys, 0, sizeof(keys));
		    info->nbyte = i;
		} else {
		    memcpy(info->ubuf, zbuf, z->nbyte);
		    info->nbyte = z->nbyte;
		}
	    }
	}
    } else if (z->data != NULL) {
	flags |= TCL_READABLE;
	info->iswr = 0;
	info->iscompr = 0;
	info->isdir = 0;
	info->nbyte = z->nbyte;
	info->nmax = 0;
	/*
	 * Must copy data since other channel to same archive member
	 * in another thread may write and close its channel and thus
	 * invalidate z->data.
	 */
	info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nbyte);
	if (info->ubuf == NULL) {
	    goto merror0;
	}
	memcpy(info->ubuf, z->data, info->nbyte);
	info->tofree = info->ubuf;
    } else {
	flags |= TCL_READABLE;
	info->iswr = 0;
	info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED;
	info->ubuf = z->zipfile->data + z->offset;
	info->isdir = z->isdir;
	info->nbyte = z->nbyte;
	info->nmax = 0;
	info->tofree = NULL;
	if (z->isenc) {
	    int len = z->zipfile->pwbuf[0] & 0xff;
	    char pwbuf[260];

	    for (i = 0; i < len; i++) {
		ch = z->zipfile->pwbuf[len - i];
		pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	    }
	    pwbuf[i] = '\0';
	    init_keys(pwbuf, keys, crc32tab);
	    memset(pwbuf, 0, sizeof(pwbuf));
	    for (i = 0; i < 12; i++) {
		ch = info->ubuf[i];
		zdecode(keys, crc32tab, ch);
	    }
	    info->ubuf += i;
	}
	if (info->iscompr) {
	    z_stream stream;
	    int err;
	    unsigned char *ubuf = NULL;
	    unsigned int j;

	    memset(&stream, 0, sizeof(stream));
	    stream.zalloc = Z_NULL;
	    stream.zfree = Z_NULL;
	    stream.opaque = Z_NULL;
	    stream.avail_in = z->nbytecompr;
	    if (z->isenc) {
		stream.avail_in -= 12;
		ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in);
		if (ubuf == NULL) {
		    info->ubuf = NULL;
		    memset(keys, 0, sizeof(keys));
		    goto merror;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = info->ubuf[j];
		    ubuf[j] = zdecode(keys, crc32tab, ch);
		}
		memset(keys, 0, sizeof(keys));
		stream.next_in = ubuf;
	    } else {
		stream.next_in = info->ubuf;
	    }
	    stream.next_out = info->ubuf =
		(unsigned char *) Tcl_AttemptAlloc(info->nbyte);
	    if (info->ubuf == NULL) {
merror:
		if (ubuf != NULL) {
		    Tcl_Free((char *) ubuf);
		}
		Tcl_Free((char *) info);
		if (interp != NULL) {
		    Tcl_SetObjResult(interp,
			Tcl_NewStringObj("out of memory", -1));
		}
		goto error;
	    }
	    info->tofree = info->ubuf;
	    stream.avail_out = info->nbyte;
	    if (inflateInit2(&stream, -15) != Z_OK) {
		goto cerror;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err == Z_STREAM_END) ||
		((err == Z_OK) && (stream.avail_in == 0))) {
		if (ubuf != NULL) {
		    Tcl_Free((char *) ubuf);
		}
		goto wrapchan;
	    }
cerror:
	    if (ubuf != NULL) {
		Tcl_Free((char *) ubuf);
	    }
	    if (info->ubuf != NULL) {
		Tcl_Free((char *) info->ubuf);
	    }
	    Tcl_Free((char *) info);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("decompression error", -1));
	    }
	    goto error;
	} else if (z->isenc) {
	    unsigned char *ubuf = NULL;
	    unsigned int j, len;

	    /*
	     * Decode encrypted but uncompressed file, since we support
	     * Tcl_Seek() on it, and it can be randomly accessed later.
	     */

	    len = z->nbytecompr - 12;
	    ubuf = (unsigned char *) Tcl_AttemptAlloc(len);
	    if (ubuf == NULL) {
		memset(keys, 0, sizeof(keys));
		Tcl_Free((char *) info);
		if (interp != NULL) {
		    Tcl_SetObjResult(interp,
			Tcl_NewStringObj("out of memory", -1));
		}
		goto error;
	    }
	    for (j = 0; j < len; j++) {
		ch = info->ubuf[j];
		ubuf[j] = zdecode(keys, crc32tab, ch);
	    }
	    memset(keys, 0, sizeof(keys));
	    info->tofree = info->ubuf = ubuf;
	}
    }
wrapchan:
    Unlock();
    sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, ZipFS.idCount++);
    info->chan = Tcl_CreateChannel(&ZipChannelType, cname,
				   (ClientData) info, flags);
    return info->chan;

error:
    if (z != NULL) {
	z->zipfile->nopen--;
    }
    Unlock();
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ZipEventProc --
 *
 *	This function is invoked by Tcl_ServiceEvent when a channel
 *	event reaches the front of the event queue. This function
 *	invokes Tcl_NotifyChannel on the ZIP channel.
 *
 * Results:
 *	Returns 1 if the event was handled, meaning it should be
 *	removed from the queue. Returns 0 if the event was not handled,
 *	meaning it should stay on the queue. The only time the event
 *	isn't handled is if the	TCL_FILE_EVENTS flag bit isn't set.
 *
 * Side effects:
 *	Whatever the notifier callback does.
 *
 *----------------------------------------------------------------------
 */

static int
ZipEventProc(Tcl_Event *evPtr, int flags)
{
    ZipEvent *event = (ZipEvent *) evPtr;
    ZipChannel *info;
    Tcl_HashEntry *hPtr;
    ThreadSpecificData *tsdPtr =
	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
    int mask;

    if ((tsdPtr == NULL) || !tsdPtr->initialized) {
	return 1;
    }
    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }
    hPtr = Tcl_FindHashEntry(&tsdPtr->chanTab, (ClientData) event->info);
    if (hPtr != NULL) {
	info = (ZipChannel *) Tcl_GetHashValue(hPtr);
	info->evmask &= ~ZIPCHANNEL_PENDING;
	mask = info->evmask & (TCL_READABLE | TCL_WRITABLE);
	if (mask) {
	    Tcl_NotifyChannel(info->chan, mask);
	}
    }
    return 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelExitHandler --
 *
 *	This function is called to cleanup thread specific channel
 *	information.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipChannelExitHandler(ClientData clientData)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->initialized) {
	Tcl_DeleteHashTable(&tsdPtr->chanTab);
	tsdPtr->initialized = 0;
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelInit --
 *
 *	This function is called to setup thread specific channel
 *	information.
 *
 * Results:
 *	Pointer to thread specific data.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static ThreadSpecificData *
ZipChannelInit(void)
{
    ThreadSpecificData *tsdPtr =
	(ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);

    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_InitHashTable(&tsdPtr->chanTab, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(ZipChannelExitHandler, NULL);
	tsdPtr->initialized = 1;
    }
    return tsdPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryStat --
 *
 *	This function implements the ZIP filesystem specific version
 *	of the library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryStat(char *path, Tcl_StatBuf *buf)
{
    ZipEntry *z;
    int ret = -1;

    ReadLock();
    z = ZipFSLookup(path);
    if (z == NULL) {
	goto done;
    }
    memset(buf, 0, sizeof(Tcl_StatBuf));
    if (z->isdir) {
	buf->st_mode = S_IFDIR | 0555;
    } else {
	buf->st_mode = S_IFREG | 0555;
    }
    buf->st_size = z->nbyte;
    buf->st_mtime = z->timestamp;
    buf->st_ctime = z->timestamp;
    buf->st_atime = z->timestamp;
    ret = 0;
done:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryAccess --
 *
 *	This function implements the ZIP filesystem specific version
 *	of the library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryAccess(char *path, int mode)
{
    ZipEntry *z;

    if (mode & 3) {
	return -1;
    }
    ReadLock();
    z = ZipFSLookup(path);
    Unlock();
    return (z != NULL) ? 0 : -1;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSOpenFileChannelProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

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

    return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len),
			  mode, permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSStatProc --
 *
 *	This function implements the ZIP filesystem specific version
 *	of the library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

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

    return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSAccessProc --
 *
 *	This function implements the ZIP filesystem specific version
 *	of the library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

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

    return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSFilesystemSeparatorProc --
 *
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero
 *
 * Results:
 *	A Tcl object, with a refCount of zero. If the caller needs to retain a
 *	reference to the object, it should call Tcl_IncrRefCount, and should
 *	otherwise free the object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr)
{
    return Tcl_NewStringObj("/", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSMatchInDirectoryProc --
 *
 *	This routine is used by the globbing code to search a directory for
 *	all files which match a given pattern.
 *
 * Results:
 *	The return value is a standard Tcl result indicating whether an
 *	error occurred in globbing. Errors are left in interp, good
 *	results are lappend'ed to resultPtr (which must be a valid object).
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

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;
    int scnt, len, dirOnly = -1, prefixLen, strip = 0, matchHidden = 0;
    char *prefix, *path, *p;
#if HAS_DRIVES
    int drive = 0;
    char drivePrefix[3];
#endif
    Tcl_DString ds, dsPref;

#if HAS_DRIVES
    if ((pattern != NULL) && (pattern[0] != '\0') &&
	(strchr(drvletters, pattern[0]) != NULL) && (pattern[1] == ':')) {
	pattern += 2;
    }
#endif
    if (types != NULL) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
    }
    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&dsPref);
    prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);
    prefix = Tcl_DStringValue(&dsPref);
#if HAS_DRIVES
    path = AbsolutePath(prefix, NULL, &ds);
#else
    path = AbsolutePath(prefix, &ds);
#endif
    len = Tcl_DStringLength(&ds);
    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else if (strcmp(prefix, path + len - prefixLen) == 0) {
	strip = len - prefixLen;
	prefix = NULL;
    } else {
#if HAS_DRIVES
	if ((strchr(drvletters, prefix[0]) != NULL) && (prefix[1] == ':')) {
	    if (strcmp(prefix + 2, path) == 0) {
		strncpy(drivePrefix, prefix, 3);
		drivePrefix[2] = '\0';
		prefix = drivePrefix;
	    }
	} else {
	    strip = len + 1;
	}
#else
	strip = len + 1;
#endif
    }
    if (prefix != NULL) {
#if HAS_DRIVES
	if (prefix == drivePrefix) {
	    Tcl_DStringSetLength(&dsPref, 0);
	    Tcl_DStringAppend(&dsPref, drivePrefix, -1);
	    prefixLen = Tcl_DStringLength(&dsPref);
	} else {
	    Tcl_DStringAppend(&dsPref, "/", 1);
	    prefixLen++;
	}
	prefix = Tcl_DStringValue(&dsPref);
	drive = prefix[0];
	if ((drive >= 'a') && (drive <= 'z')) {
	    drive -= 'a' - 'A';
	}
#else
	Tcl_DStringAppend(&dsPref, "/", 1);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);
#endif
    }
    if ((pattern != NULL) && ((pattern[0] == '.') ||
	      ((pattern[0] == '\\') && (pattern[1] == '.')))) {
	matchHidden = 1;
    }
    ReadLock();
    if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) {
	scnt = CountSlashes(path);
	if (path[len - 1] == '/') {
	    len--;
	} else {
	    scnt++;
	}
	if ((pattern == NULL) || (pattern[0] == '\0')) {
	    pattern = "*";
	}
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
	     hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);

#if HAS_DRIVES
	    if (drive && (drive != zf->mntdrv)) {
		continue;
	    }
#endif
	    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) == scnt) &&
			Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) {
			if (!matchHidden) {
			    p = strrchr(z->name, '/');
			    if ((p != NULL) && (p[1] == '.')) {
				goto nextent;
			    }
			}
			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));
			}
		    }
nextent:
		    z = z->tnext;
		}
	    } else if ((zf->mntptlen > len + 1) &&
		       (strncmp(zf->mntpt, path, len) == 0) &&
		       (zf->mntpt[len] == '/') &&
		       (CountSlashes(zf->mntpt) == scnt) &&
		       Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)) {
		if (!matchHidden) {
		    p = strrchr(zf->mntpt, '/');
		    if ((p != NULL) && (p[1] == '.')) {
			goto end;
		    }
		}
		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));
		}
	    }
	}
	goto end;
    }
    if ((pattern == NULL) || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr != NULL) {
	    ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

#if HAS_DRIVES
	    if (drive && (drive != z->zipfile->mntdrv)) {
		goto end;
	    }
#endif
	    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 + strip, -1));
		}
	    }
	}
	goto end;
    }
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr != NULL) {
	ZipDirEntry *zd = (ZipDirEntry *) Tcl_GetHashValue(hPtr);

	if (!zd->entry.isdir) {
	    goto end;
	}
	hPtr = Tcl_FirstHashEntry(&zd->children, &search);
    }
    Tcl_DStringAppend(&ds, "/", 1);
    path = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);
    while ((len > 1) && (path[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (path[0] != '/')) {
	path[len] = '/';
	++len;
    }
    Tcl_DStringSetLength(&ds, len);
    Tcl_DStringAppend(&ds, pattern, -1);
    path = Tcl_DStringValue(&ds);
    scnt = CountSlashes(path);
    for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	if ((dirOnly >= 0) &&
	    ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) {
	    continue;
	}
#if HAS_DRIVES
	if (drive && (drive != z->zipfile->mntdrv)) {
	    continue;
	}
#endif
	if ((z->depth == scnt) && (strncmp(z->name, path, len) == 0) &&
	    Tcl_StringCaseMatch(z->name + len, path + len, 0)) {
	    if (!matchHidden && (z->name[len] == '.')) {
		continue;
	    }
	    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));
	    }
	}
    }
end:
    Unlock();
    Tcl_DStringFree(&dsPref);
    Tcl_DStringFree(&ds);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSNormalizePathProc --
 *
 *	Function to normalize given path object.
 *
 * Results:
 *	Length of final absolute path name.
 *
 * Side effects:
 *	Path object gets converted to an absolute path.
 *
 *-------------------------------------------------------------------------
 */

static int
Zip_FSNormalizePathProc(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			int nextCheckpoint)
{
    char *path;
    Tcl_DString ds;
    int len;

    path = Tcl_GetStringFromObj(pathPtr, &len);
    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    path = AbsolutePath(path, NULL, &ds);
#else
    path = AbsolutePath(path, &ds);
#endif
    nextCheckpoint = Tcl_DStringLength(&ds);
    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds),
		     Tcl_DStringLength(&ds));
    Tcl_DStringFree(&ds);
    return nextCheckpoint;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSPathInFilesystemProc --
 *
 *	This function determines if the given path object is in the
 *	ZIP filesystem.
 *
 * Results:
 *	TCL_OK when the path object is in the ZIP filesystem, -1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;
    int ret = -1, len;
    char *path;
    Tcl_DString ds;
#if HAS_DRIVES
    int drive = 0;
#endif

    path = Tcl_GetStringFromObj(pathPtr, &len);
    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    path = AbsolutePath(path, &drive, &ds);
#else
    path = AbsolutePath(path, &ds);
#endif
    len = Tcl_DStringLength(&ds);
#if HAS_DRIVES
    if (len && (strchr(drvletters, path[0]) != NULL) && (path[1] == ':')) {
	path += 2;
	len -= 2;
    }
#endif
    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr != NULL) {
#if HAS_DRIVES
	ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);

	if (drive == z->zipfile->mntdrv) {
	    ret = TCL_OK;
	    goto endloop;
	}
#else
	ret = TCL_OK;
	goto endloop;
#endif
    }
    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
    while (hPtr != NULL) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
#if HAS_DRIVES
	if (drive != zf->mntdrv) {
	    hPtr = Tcl_NextHashEntry(&search);
	    continue;
	}
#endif
	if (zf->mntptlen == 0) {
	    ZipEntry *z = zf->topents;

	    while (z != NULL) {
		int lenz = strlen(z->name);

		if ((len >= lenz) &&
		    (strncmp(path, z->name, lenz) == 0)) {
		    if ((len == lenz) || (path[lenz] == '/')) {
			ret = TCL_OK;
			goto endloop;
		    }
		}
		z = z->tnext;
	    }
	} else if ((len >= zf->mntptlen) &&
		   (strncmp(path, zf->mntpt, zf->mntptlen) == 0)) {
	    if ((len == zf->mntptlen) || (path[zf->mntptlen] == '/')) {
		ret = TCL_OK;
		goto endloop;
	    }
	}
	hPtr = Tcl_NextHashEntry(&search);
    }
endloop:
    Unlock();
    Tcl_DStringFree(&ds);
    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)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;
    Tcl_Obj *vols = Tcl_NewObj(), *vol;

    ReadLock();
    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
    while (hPtr != NULL) {
	zf = (ZipFile *) Tcl_GetHashValue(hPtr);
	/*
	 * Volumes which overlay root are hidden.
	 */
#if HAS_DRIVES
	if (zf->mntpt[0]) {
	    vol = Tcl_ObjPrintf("%c:%s", zf->mntdrv, zf->mntpt);
	    Tcl_ListObjAppendElement(NULL, vols, vol);
	}
#else
	if (zf->mntpt[0]) {
	    vol = Tcl_NewStringObj(zf->mntpt, zf->mntptlen);
	    Tcl_ListObjAppendElement(NULL, vols, vol);
	}
#endif
	hPtr = Tcl_NextHashEntry(&search);
    }
    Unlock();
    Tcl_IncrRefCount(vols);
    return vols;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSChdirProc --
 *
 *	If the path object refers to a directory within the ZIP
 *	filesystem the current directory is set to this directory.
 *
 * Results:
 *	TCL_OK on success, -1 on error with error number set.
 *
 * Side effects:
 *	The global cwdPathPtr may change value.
 *
 *-------------------------------------------------------------------------
 */

static int
Zip_FSChdirProc(Tcl_Obj *pathPtr)
{
    int len;
    char *path;
    Tcl_DString ds;
    ZipEntry *z;
    int ret = TCL_OK;
#if HAS_DRIVES
    int drive = 0;
#endif

    path = Tcl_GetStringFromObj(pathPtr, &len);
    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    path = AbsolutePath(path, &drive, &ds);
#else
    path = AbsolutePath(path, &ds);
#endif
    ReadLock();
    z = ZipFSLookup(path);
    if ((z == NULL) || !z->isdir) {
	Tcl_SetErrno(ENOENT);
	ret = -1;
    }
#if HAS_DRIVES
    if ((z != NULL) && (drive != z->zipfile->mntdrv)) {
	Tcl_SetErrno(ENOENT);
	ret = -1;
    }
#endif
    Unlock();
    Tcl_DStringFree(&ds);
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSFileAttrStringsProc --
 *
 *	This function implements the ZIP filesystem dependent 'file attributes'
 *	subcommand, for listing the set of possible attribute strings.
 *
 * Results:
 *	An array of strings
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static const char *const *
Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef)
{
    static const char *const attrs[] = {
	"-uncompsize",
	"-compsize",
	"-offset",
	"-mount",
	"-archive",
	"-permissions",
	NULL,
    };

    return attrs;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSFileAttrsGetProc --
 *
 *	This function implements the ZIP filesystem specific
 *	'file attributes' subcommand, for 'get' operations.
 *
 * Results:
 *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
 *	was returned) is likely to have a refCount of zero. Either way we must
 *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
 *	refCount to ensure it is properly freed.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

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

    path = Tcl_GetStringFromObj(pathPtr, &len);
    ReadLock();
    z = ZipFSLookup(path);
    if (z == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1));
	}
	ret = TCL_ERROR;
	goto done;
    }
    switch (index) {
    case 0:
	*objPtrRef = Tcl_NewIntObj(z->nbyte);
	goto done;
    case 1:
	*objPtrRef= Tcl_NewIntObj(z->nbytecompr);
	goto done;
    case 2:
	*objPtrRef= Tcl_NewLongObj(z->offset);
	goto done;
    case 3:
	*objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, -1);
	goto done;
    case 4:
	*objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1);
	goto done;
    case 5:
	*objPtrRef= Tcl_NewStringObj("0555", -1);
	goto done;
    }
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unknown attribute", -1));
    }
    ret = TCL_ERROR;
done:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSFileAttrsSetProc --
 *
 *	This function implements the ZIP filesystem specific
 *	'file attributes' subcommand, for 'set' operations.
 *
 * Results:
 *	Standard Tcl return code.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,
		       Tcl_Obj *objPtr)
{
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
    }
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSFilesystemPathTypeProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr)
{
    return Tcl_NewStringObj("zip", -1);
}


/*
 *-------------------------------------------------------------------------
 *
 * Zip_FSLoadFile --
 *
 *	This functions deals with loading native object code. If
 *	the given path object refers to a file within the ZIP
 *	filesystem, an approriate error code is returned to delegate
 *	loading to the caller (by copying the file to temp store
 *	and loading from there). As fallback when the file refers
 *	to the ZIP file system but is not present, it is looked up
 *	relative to the executable and loaded from there when available.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with error message left.
 *
 * Side effects:
 *	Loads native code into the process address space.
 *
 *-------------------------------------------------------------------------
 */

static int
Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle,
	       Tcl_FSUnloadFileProc **unloadProcPtr, int flags)
{
    Tcl_FSLoadFileProc2 *loadFileProc;
#ifdef ANDROID
    /*
     * Force loadFileProc to native implementation since the
     * package manager already extracted the shared libraries
     * from the APK at install time.
     */

    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc != NULL) {
	return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    }
    Tcl_SetErrno(ENOENT);
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1));
    }
    return TCL_ERROR;
#else
    Tcl_Obj *altPath = NULL;
    int ret = TCL_ERROR;

    if (Tcl_FSAccess(path, R_OK) == 0) {

#ifdef ZIPFS_MEMLOAD
	ret = MemLoad(path, loadHandle, unloadProcPtr, flags);
	if (ret == TCL_OK) {
	    return ret;
	}
#endif

	/*
	 * EXDEV should trigger loading by copying to temp store.
	 */

	Tcl_SetErrno(EXDEV);
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
	}
	return ret;
    } else {
	Tcl_Obj *objs[2] = { NULL, NULL };

	objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME);
	if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) {
	    const char *execName = Tcl_GetNameOfExecutable();

	    /*
	     * Shared object is not in ZIP but its path prefix is,
	     * thus try to load from directory where the executable
	     * came from.
	     */
	    TclDecrRefCount(objs[1]);
	    objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL);
	    /*
	     * Get directory name of executable manually to deal
	     * with cases where [file dirname [info nameofexecutable]]
	     * is equal to [info nameofexecutable] due to VFS effects.
	     */
	    if (execName != NULL) {
		const char *p = strrchr(execName, '/');

		if (p > execName + 1) {
		    --p;
		    objs[0] = Tcl_NewStringObj(execName, p - execName);
		}
	    }
	    if (objs[0] == NULL) {
		objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
					  TCL_PATH_DIRNAME);
	    }
	    if (objs[0] != NULL) {
		altPath = TclJoinPath(2, objs, 0);
		if (altPath != NULL) {
		    Tcl_IncrRefCount(altPath);
		    if (Tcl_FSAccess(altPath, R_OK) == 0) {
			path = altPath;
		    }
		}
	    }
	}
	if (objs[0] != NULL) {
	    Tcl_DecrRefCount(objs[0]);
	}
	if (objs[1] != NULL) {
	    Tcl_DecrRefCount(objs[1]);
	}
    }
    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc != NULL) {
	ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    } else {
	Tcl_SetErrno(ENOENT);
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
	}
    }
    if (altPath != NULL) {
	Tcl_DecrRefCount(altPath);
    }
    return ret;
#endif
}


/*
 * Define the ZIP filesystem dispatch table.
 */

MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem;

const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    Zip_FSPathInFilesystemProc,
    NULL, /* dupInternalRepProc */
    NULL, /* freeInternalRepProc */
    NULL, /* internalToNormalizedProc */
    NULL, /* createInternalRepProc */
    Zip_FSNormalizePathProc,
    Zip_FSFilesystemPathTypeProc,
    Zip_FSFilesystemSeparatorProc,
    Zip_FSStatProc,
    Zip_FSAccessProc,
    Zip_FSOpenFileChannelProc,
    Zip_FSMatchInDirectoryProc,
    NULL, /* utimeProc */
    NULL, /* linkProc */
    Zip_FSListVolumesProc,
    Zip_FSFileAttrStringsProc,
    Zip_FSFileAttrsGetProc,
    Zip_FSFileAttrsSetProc,
    NULL, /* createDirectoryProc */
    NULL, /* removeDirectoryProc */
    NULL, /* deleteFileProc */
    NULL, /* copyFileProc */
    NULL, /* renameFileProc */
    NULL, /* copyDirectoryProc */
    NULL, /* lstatProc */
    (Tcl_FSLoadFileProc *) Zip_FSLoadFile,
    NULL, /* getCwdProc */
    Zip_FSChdirProc,
};

#endif /* HAVE_ZLIB */


/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_doInit --
 *
 *	Perform per interpreter initialization of this module.
 *
 * Results:
 *	The return value is a standard Tcl result.
 *
 * Side effects:
 *	Initializes this module if not already initialized, and adds
 *	module related commands to the given interpreter.
 *
 *-------------------------------------------------------------------------
 */

static int
Zipfs_doInit(Tcl_Interp *interp, int safe)
{
#ifdef HAVE_ZLIB
    static const EnsembleImplMap initMap[] = {
	{"mount",	ZipFSMountObjCmd,	NULL, NULL, NULL, 0},
	{"unmount",	ZipFSUnmountObjCmd,	NULL, NULL, NULL, 0},
	{"mkkey",	ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 0},
	{"mkimg",	ZipFSMkImgObjCmd,	NULL, NULL, NULL, 0},
	{"mkzip",	ZipFSMkZipObjCmd,	NULL, NULL, NULL, 0},
	{"lmkimg",	ZipFSLMkImgObjCmd,	NULL, NULL, NULL, 0},
	{"lmkzip",	ZipFSLMkZipObjCmd,	NULL, NULL, NULL, 0},
	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 0},
	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 0},
	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };

    static const EnsembleImplMap initSafeMap[] = {
	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 0},
	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 0},
	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };

    static const char findproc[] =
	"proc ::zipfs::find dir {\n"
	" set result {}\n"
	" if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n"
	"  return $result\n"
	" }\n"
	" foreach file $list {\n"
	"  if {$file eq \".\" || $file eq \"..\"} {\n"
	"   continue\n"
	"  }\n"
	"  set file [file join $dir $file]\n"
	"  lappend result $file\n"
	"  foreach file [::zipfs::find $file] {\n"
	"   lappend result $file\n"
	"  }\n"
	" }\n"
	" return [lsort $result]\n"
	"}\n";

    /* one-time initialization */
    WriteLock();
    if (!ZipFS.initialized) {
#ifdef TCL_THREADS
	static const Tcl_Time t = { 0, 0 };

	/*
	 * Inflate condition variable.
	 */
	Tcl_MutexLock(&ZipFSMutex);
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t);
	Tcl_MutexUnlock(&ZipFSMutex);
#endif
	Tcl_FSRegister(NULL, &zipfsFilesystem);
	Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
	Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
	Tcl_InitHashTable(&ZipFS.dirHash, TCL_ONE_WORD_KEYS);
	ZipFS.initialized = ZipFS.idCount = 1;
#if defined(ZIPFS_IN_TCL) || defined(ZIPFS_IN_TK)
	if (interp != NULL) {
	    Tcl_StaticPackage(interp, "zipfs", Zipfs_Init, Zipfs_SafeInit);
	}
#endif
    }
    Unlock();
    if (interp != NULL) {
	if (!safe) {
	    Tcl_CreateObjCommand(interp, "::zipfs::mount",
				 ZipFSMountObjCmd, 0, 0);
	    Tcl_CreateObjCommand(interp, "::zipfs::unmount",
				 ZipFSUnmountObjCmd, 0, 0);
	    Tcl_CreateObjCommand(interp, "::zipfs::mkkey",
				 ZipFSMkKeyObjCmd, 0, 0);
	    Tcl_CreateObjCommand(interp, "::zipfs::mkimg",
				 ZipFSMkImgObjCmd, 0, 0);
	    Tcl_CreateObjCommand(interp, "::zipfs::mkzip",
				 ZipFSMkZipObjCmd, 0, 0);
	    Tcl_CreateObjCommand(interp, "::zipfs::lmkimg",
				 ZipFSLMkImgObjCmd, 0, 0);
	    Tcl_CreateObjCommand(interp, "::zipfs::lmkzip",
				 ZipFSLMkZipObjCmd, 0, 0);
	    Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
	}
	Tcl_CreateObjCommand(interp, "::zipfs::exists",
			     ZipFSExistsObjCmd, 0, 0);
	Tcl_CreateObjCommand(interp, "::zipfs::info",
			     ZipFSInfoObjCmd, 0, 0);
	Tcl_CreateObjCommand(interp, "::zipfs::list",
			     ZipFSListObjCmd, 0, 0);
	if (!safe) {
	    Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax,
			TCL_LINK_INT);
	}

	TclMakeEnsemble(interp, "zipfs", safe ? initSafeMap : initMap);

	Tcl_PkgProvide(interp, "zipfs", "1.0");
    }
    return TCL_OK;
#else
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("no zlib available", -1));
    }
    return TCL_ERROR;
#endif
}

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_Init, Zipfs_SafeInit --
 *
 *	These functions are invoked to perform per interpreter initialization
 *	of this module.
 *
 * Results:
 *	The return value is a standard Tcl result.
 *
 * Side effects:
 *	Initializes this module if not already initialized, and adds
 *	module related commands to the given interpreter.
 *
 *-------------------------------------------------------------------------
 */

int
Zipfs_Init(Tcl_Interp *interp)
{
    return Zipfs_doInit(interp, 0);
}

int
Zipfs_SafeInit(Tcl_Interp *interp)
{
    return Zipfs_doInit(interp, 1);
}

#ifndef HAVE_ZLIB

/*
 *-------------------------------------------------------------------------
 *
 * Zipfs_Mount, Zipfs_Unmount --
 *
 *	Dummy version when no ZLIB support available.
 *
 *-------------------------------------------------------------------------
 */

int
Zipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,
	    const char *passwd)
{
    return Zipfs_doInit(interp, 1);
}

int
Zipfs_Unmount(Tcl_Interp *interp, const char *zipname)
{
    return Zipfs_doInit(interp, 1);
}

#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */