summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--[-rwxr-xr-x]compat/zlib/win32/zdll.libbin17152 -> 17152 bytes
-rw-r--r--doc/zipfs.361
-rw-r--r--doc/zipfs.n118
-rw-r--r--generic/tclIOUtil.c34
-rw-r--r--generic/tclZipfs.h48
-rw-r--r--generic/zcrypt.h131
-rw-r--r--generic/zipfs.c3349
-rw-r--r--[-rwxr-xr-x]library/clock.tcl0
-rw-r--r--tests/zipfs.test116
-rw-r--r--unix/Makefile.in10
-rw-r--r--unix/tclAppInit.c5
-rw-r--r--win/Makefile.in6
-rw-r--r--win/makefile.vc7
-rw-r--r--win/tclAppInit.c5
14 files changed, 3885 insertions, 5 deletions
diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib
index a3e9a39..a3e9a39 100755..100644
--- a/compat/zlib/win32/zdll.lib
+++ b/compat/zlib/win32/zdll.lib
Binary files differ
diff --git a/doc/zipfs.3 b/doc/zipfs.3
new file mode 100644
index 0000000..6846f58
--- /dev/null
+++ b/doc/zipfs.3
@@ -0,0 +1,61 @@
+'\"
+'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
+'\" Copyright (c) 2015 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.
+'\"
+.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tclzipfs_Init, Tclzipfs_SafeInit, Tclzipfs_Mount, Tclzipfs_Unmount \- handle ZIP files as VFS
+.SH SYNOPSIS
+.nf
+\fB#include <tclZipfs.h>\fR
+.sp
+int
+\fBTclzipfs_Init\fR(\fIinterp\fR)
+.sp
+int
+\fBTclzipfs_SafeInit\fR(\fIinterp\fR)
+.sp
+int
+\fBTclzipfs_Mount\fR(\fIinterp, zipname, mntpt, passwd\fR)
+.sp
+int
+\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp **termPtr
+.AP Tcl_Interp *interp in
+Interpreter in which the zip file system is mounted. The interpreter's result is
+modified to hold the result or error message from the script.
+.AP "const char" *zipname in
+Name of a zipfile.
+.AP "const char" *mntpt in
+Name of a mount point.
+.AP "const char" *passwd in
+An (optional) password.
+.BE
+.SH DESCRIPTION
+\fBTclzipfs_Init()\fR performs one-time initialization of the file system
+and registers it process wide. Additionally, a package named \fIzipfs\fR
+is provided and supplemental Tcl commands are created in the given
+interpreter \fIinterp\fR.
+.PP
+\fBTclzipfs_SafeInit()\fR is the version of \fBTclzipfs_Init()\fR for
+safe interpreters. It exposes only uncritical supplemental Tcl commands
+in the given interpreter \fIinterp\fR.
+.PP
+\fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount
+point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR.
+Errors during that process are reported in the interpreter \fIinterp\fR.
+If \fIzipname\fR is a NULL pointer, information on all currently mounted
+ZIP file systems is written into \fIinterp\fR's result as a sequence of
+mount points and ZIP file names.
+.PP
+\fBTclzipfs_Unmount()\fR undoes the effect of \fBTclzipfs_Mount()\fR,
+i.e. it unmounts the mounted ZIP archive file \fIzipname\fR. Errors are
+reported in the interpreter \fIinterp\fR.
+.SH KEYWORDS
+compress, filesystem, zip
diff --git a/doc/zipfs.n b/doc/zipfs.n
new file mode 100644
index 0000000..838a898
--- /dev/null
+++ b/doc/zipfs.n
@@ -0,0 +1,118 @@
+'\"
+'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
+'\" Copyright (c) 2015 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.
+'\"
+.TH zipfs n 1.0 Zipfs "zipfs Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+zipfs \- Mount and work with ZIP files within Tcl
+.SH SYNOPSIS
+.nf
+\fBpackage require zipfs \fR?\fB1.0\fR?
+.sp
+\fBzipfs exists\fR \fIfilename\fR
+\fBzipfs find\fR \fIdir\fR
+\fBzipfs info\fR \fIfilename\fR
+\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
+\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
+\fBzipfs mkkey\fR \fIpassword\fR
+\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
+\fBzipfs mount\fR \fI?zipfile?\fR \fI?mountpoint?\fR \fI?password?\fR
+\fBzipfs unmount\fR \fIzipfile\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBzipfs\fR package provides tcl with the ability to mount
+the contents of a zip file as a virtual file system.
+.TP
+\fBzipfs exists\fR \fIfilename\fR
+.
+Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
+.TP
+\fBzipfs find\fR \fIdir\fR
+.
+Recursively lists files including and below the directory \fIdir\fR.
+The result list consists of relative path names starting from the
+given directory. This command is also used by the \fBzipfs mkzip\fR
+and \fBzipfs mkimg\fR commands.
+.TP
+\fBzipfs info\fR \fIfile\fR
+.
+Return information about the given file in the mounted zipfs. The information
+consists of (1) the name of the ZIP archive file that contains the file,
+(2) the size of the file after decompressions, (3) the compressed size of
+the file, and (4) the offset of the compressed data in the ZIP archive file.
+.RS
+.PP
+Note: querying the mount point gives the start of zip data offset in (4),
+which can be used to truncate the zip info off an executable.
+.RE
+.TP
+\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
+.
+Return a list of all files in the mounted zipfs. The order of the names
+in the list is arbitrary.
+.TP
+\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
+.
+Creates an image (potentially a new executable file) similar to
+\fBzipfs mkzip\fR. If the \fIinfile\fR parameter is specified,
+this file is prepended in front of the ZIP archive, otherwise the file
+returned by \fBTcl_NameOfExecutable(3)\fR (i.e. the executable file of
+the running process) is used. If the \fIpassword\fR parameter is not empty,
+an obfuscated version of that password is placed between the image and ZIP
+chunks of the output file and the contents of the ZIP chunk are protected
+with that password.
+.RS
+.PP
+Caution: highly experimental, not usable on Android, only partially tested
+on Linux and Windows.
+.RE
+.TP
+\fBzipfs mkkey\fR \fIpassword\fR
+.
+For the clear text \fIpassword\fR argument an obfuscated string version
+is returned with the same format used in the \fBzipfs mkimg\fR command.
+.TP
+\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
+.
+Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
+directory \fIindir\fR (contained regular files only) with optional ZIP
+password \fIpassword\fR. While processing the files below \fIindir\fR the
+optional file name prefix given in \fIstrip\fR is stripped off the beginning
+of the respective file name.
+.RS
+.PP
+Caution: the choice of the \fIindir\fR parameter
+(less the optional stripped prefix) determines the later root name of the
+archive's content.
+.RE
+.TP
+\fBzipfs mount ?\fIzipfile\fR? ?\fImountpoint\fR? ?\fIpassword\fR?
+.
+The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS.
+After this command executes, files contained in \fIzipfile\fR
+will appear to Tcl to be regular files at the mount point.
+.RS
+.PP
+With no \fImountpoint\fR, returns the mount point for \fIzipfile\fR.
+With no \fIzipfile\fR, return all zipfile/mount pairs.
+If \fImountpoint\fR is specified as an empty string, mount on file path.
+.RE
+.TP
+\fBzipfs unmount \fIzipfile\fR
+.
+Unmounts a previously mounted ZIP archive file \fIzipfile\fR.
+.SH "SEE ALSO"
+tclsh(1), file(n), zlib(n)
+.SH "KEYWORDS"
+compress, filesystem, zip
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index e00b9ac..6364346 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -190,6 +190,8 @@ const Tcl_Filesystem tclNativeFilesystem = {
TclpObjChdir
};
+MODULE_SCOPE Tcl_Filesystem zipfsFilesystem;
+
/*
* Define the tail of the linked list. Note that for unconventional uses of
* Tcl without a native filesystem, we may in the future wish to modify the
@@ -1410,6 +1412,22 @@ TclFSNormalizeToUniquePath(
Claim();
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
+ if (fsRecPtr->fsPtr == &zipfsFilesystem) {
+ ClientData clientData = NULL;
+ /*
+ * Allow mounted zipfs filesystem to overtake entire normalisation.
+ * This is needed on unix for mounts on symlinks right below root.
+ */
+
+ if (fsRecPtr->fsPtr->pathInFilesystemProc != NULL) {
+ if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr,
+ &clientData)!=-1) {
+ TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
+ break;
+ }
+ }
+ continue;
+ }
if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
continue;
}
@@ -1434,6 +1452,9 @@ TclFSNormalizeToUniquePath(
if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
continue;
}
+ if (fsRecPtr->fsPtr == &zipfsFilesystem) {
+ continue;
+ }
if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
@@ -2914,6 +2935,19 @@ Tcl_FSChdir(
}
fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
+
+ if ((fsPtr != NULL) && (fsPtr != &tclNativeFilesystem)) {
+ /*
+ * Watch out for tilde substitution.
+ * Only valid in native filesystem.
+ */
+ char *name = Tcl_GetString(pathPtr);
+
+ if ((name != NULL) && (*name == '~')) {
+ fsPtr = &tclNativeFilesystem;
+ }
+ }
+
if (fsPtr != NULL) {
if (fsPtr->chdirProc != NULL) {
/*
diff --git a/generic/tclZipfs.h b/generic/tclZipfs.h
new file mode 100644
index 0000000..01c9e96
--- /dev/null
+++ b/generic/tclZipfs.h
@@ -0,0 +1,48 @@
+/*
+ * tclZipfs.h --
+ *
+ * This header file describes the interface of the ZIPFS filesystem
+ *
+ * Copyright (c) 2013-2015 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.
+ */
+
+#ifndef _ZIPFS_H
+#define _ZIPFS_H
+
+#include "tcl.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifndef ZIPFSAPI
+# define ZIPFSAPI extern
+#endif
+
+#ifdef BUILD_tcl
+# undef ZIPFSAPI
+# define ZIPFSAPI DLLEXPORT
+#endif
+
+ZIPFSAPI int Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname,
+ const char *mntpt, const char *passwd);
+ZIPFSAPI int Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname);
+ZIPFSAPI int Tclzipfs_Init(Tcl_Interp *interp);
+ZIPFSAPI int Tclzipfs_SafeInit(Tcl_Interp *interp);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* _ZIPFS_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/zcrypt.h b/generic/zcrypt.h
new file mode 100644
index 0000000..eb9865b
--- /dev/null
+++ b/generic/zcrypt.h
@@ -0,0 +1,131 @@
+/* crypt.h -- base code for crypt/uncrypt ZIPfile
+
+
+ Version 1.01e, February 12th, 2005
+
+ Copyright (C) 1998-2005 Gilles Vollant
+
+ This code is a modified version of crypting code in Infozip distribution
+
+ The encryption/decryption parts of this source code (as opposed to the
+ non-echoing password parts) were originally written in Europe. The
+ whole source package can be freely distributed, including from the USA.
+ (Prior to January 2000, re-export from the US was a violation of US law.)
+
+ This encryption code is a direct transcription of the algorithm from
+ Roger Schlafly, described by Phil Katz in the file appnote.txt. This
+ file (appnote.txt) is distributed with the PKZIP program (even in the
+ version without encryption capabilities).
+
+ If you don't need crypting in your application, just define symbols
+ NOCRYPT and NOUNCRYPT.
+
+ This code support the "Traditional PKWARE Encryption".
+
+ The new AES encryption added on Zip format by Winzip (see the page
+ http://www.winzip.com/aes_info.htm ) and PKWare PKZip 5.x Strong
+ Encryption is not supported.
+*/
+
+#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8))
+
+/***********************************************************************
+ * Return the next byte in the pseudo-random sequence
+ */
+static int decrypt_byte(unsigned long* pkeys, const unsigned int* pcrc_32_tab)
+{
+ unsigned temp; /* POTENTIAL BUG: temp*(temp^1) may overflow in an
+ * unpredictable manner on 16-bit systems; not a problem
+ * with any known compiler so far, though */
+
+ temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2;
+ return (int)(((temp * (temp ^ 1)) >> 8) & 0xff);
+}
+
+/***********************************************************************
+ * Update the encryption keys with the next byte of plain text
+ */
+static int update_keys(unsigned long* pkeys,const unsigned int* pcrc_32_tab,int c)
+{
+ (*(pkeys+0)) = CRC32((*(pkeys+0)), c);
+ (*(pkeys+1)) += (*(pkeys+0)) & 0xff;
+ (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1;
+ {
+ register int keyshift = (int)((*(pkeys+1)) >> 24);
+ (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift);
+ }
+ return c;
+}
+
+
+/***********************************************************************
+ * Initialize the encryption keys and the random header according to
+ * the given password.
+ */
+static void init_keys(const char* passwd,unsigned long* pkeys,const unsigned int* pcrc_32_tab)
+{
+ *(pkeys+0) = 305419896L;
+ *(pkeys+1) = 591751049L;
+ *(pkeys+2) = 878082192L;
+ while (*passwd != '\0') {
+ update_keys(pkeys,pcrc_32_tab,(int)*passwd);
+ passwd++;
+ }
+}
+
+#define zdecode(pkeys,pcrc_32_tab,c) \
+ (update_keys(pkeys,pcrc_32_tab,c ^= decrypt_byte(pkeys,pcrc_32_tab)))
+
+#define zencode(pkeys,pcrc_32_tab,c,t) \
+ (t=decrypt_byte(pkeys,pcrc_32_tab), update_keys(pkeys,pcrc_32_tab,c), t^(c))
+
+#ifdef INCLUDECRYPTINGCODE_IFCRYPTALLOWED
+
+#define RAND_HEAD_LEN 12
+ /* "last resort" source for second part of crypt seed pattern */
+# ifndef ZCR_SEED2
+# define ZCR_SEED2 3141592654UL /* use PI as default pattern */
+# endif
+
+static int crypthead(const char* passwd, /* password string */
+ unsigned char* buf, /* where to write header */
+ int bufSize,
+ unsigned long* pkeys,
+ const unsigned int* pcrc_32_tab,
+ unsigned long crcForCrypting)
+{
+ int n; /* index in random header */
+ int t; /* temporary */
+ int c; /* random byte */
+ unsigned char header[RAND_HEAD_LEN-2]; /* random header */
+ static unsigned calls = 0; /* ensure different random header each time */
+
+ if (bufSize<RAND_HEAD_LEN)
+ return 0;
+
+ /* First generate RAND_HEAD_LEN-2 random bytes. We encrypt the
+ * output of rand() to get less predictability, since rand() is
+ * often poorly implemented.
+ */
+ if (++calls == 1)
+ {
+ srand((unsigned)(time(NULL) ^ ZCR_SEED2));
+ }
+ init_keys(passwd, pkeys, pcrc_32_tab);
+ for (n = 0; n < RAND_HEAD_LEN-2; n++)
+ {
+ c = (rand() >> 7) & 0xff;
+ header[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, c, t);
+ }
+ /* Encrypt random header (last two bytes is high word of crc) */
+ init_keys(passwd, pkeys, pcrc_32_tab);
+ for (n = 0; n < RAND_HEAD_LEN-2; n++)
+ {
+ buf[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, header[n], t);
+ }
+ buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 16) & 0xff, t);
+ buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 24) & 0xff, t);
+ return n;
+}
+
+#endif
diff --git a/generic/zipfs.c b/generic/zipfs.c
new file mode 100644
index 0000000..b47ded7
--- /dev/null
+++ b/generic/zipfs.c
@@ -0,0 +1,3349 @@
+/*
+ * zipfs.c --
+ *
+ * Implementation of the ZIP filesystem used in AndroWish.
+ *
+ * Copyright (c) 2013-2015 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 "tclZipfs.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>
+
+#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 zip_read_int(p) \
+ ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
+#define zip_read_short(p) \
+ ((p)[0] | ((p)[1] << 8))
+
+#define zip_write_int(p, v) \
+ (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \
+ (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff;
+#define zip_write_short(p, v) \
+ (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff;
+
+/*
+ * 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 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 */
+ 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 */
+ 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 */
+} ZipEntry;
+
+/*
+ * 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 */
+ int iscompr; /* True if data is compressed */
+ int isdir; /* Set to 1 if directory */
+ int isenc; /* True if data is encrypted */
+ int iswr; /* True if open for writing */
+ unsigned long keys[3]; /* Key for decryption */
+} ZipChannel;
+
+/*
+ * Global variables.
+ *
+ * Most are kept in single ZipFS struct. When build with threading
+ * support this struct is protected by the ZipFSMutex (see below).
+ *
+ * The "fileHash" component is the process wide global table of all known
+ * ZIP archive members in all mounted ZIP archives.
+ *
+ * The "zipHash" components is the process wide global table of all mounted
+ * ZIP archive files.
+ */
+
+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 fileHash; /* File name to ZipEntry mapping */
+ Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
+} 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,
+};
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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_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 & 0x7e) >> 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;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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);
+ while (hPtr != NULL) {
+ if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
+#if HAS_DRIVES
+ if (drive && (drive != zf->mntdrv)) {
+ hPtr = Tcl_NextHashEntry(&search);
+ continue;
+ }
+#endif
+ if (strcmp(zf->mntpt, realname) == 0) {
+ match = 1;
+ break;
+ }
+ }
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ 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)) {
+ UnmapViewOfFile(zf->data);
+ zf->data = NULL;
+ }
+ if (zf->mh != INVALID_HANDLE_VALUE) {
+ CloseHandle(zf->mh);
+ }
+#else
+ if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) {
+ munmap(zf->data, zf->length);
+ zf->data = MAP_FAILED;
+ }
+#endif
+ if (zf->tofree != NULL) {
+ Tcl_Free((char *) zf->tofree);
+ zf->tofree = NULL;
+ }
+ Tcl_Close(interp, zf->chan);
+ zf->chan = NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSOpenArchive --
+ *
+ * This function opens a ZIP archive file for reading. An attempt
+ * is made to memory map that file. Otherwise it is read into
+ * an allocated memory buffer. The ZIP archive header is verified
+ * and 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,
+ * the given ZipFile struct is filled with information about
+ * the ZIP archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip,
+ ZipFile *zf)
+{
+ int i;
+ ClientData handle;
+ unsigned char *p, *q;
+
+#if defined(_WIN32) || defined(_WIN64)
+ zf->data = NULL;
+ zf->mh = INVALID_HANDLE_VALUE;
+#else
+ zf->data = MAP_FAILED;
+#endif
+ zf->length = 0;
+ zf->nfiles = 0;
+ zf->baseoffs = zf->baseoffsp = 0;
+ zf->tofree = NULL;
+ zf->pwbuf[0] = 0;
+ 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;
+ }
+#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;
+ }
+#endif
+ }
+ p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
+ while (p >= zf->data) {
+ if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
+ if (zip_read_int(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 = zip_read_short(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 + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS);
+ p -= zip_read_int(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 (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("wrong header signature", -1));
+ }
+ goto error;
+ }
+ pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS);
+ comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
+ extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS);
+ q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
+ }
+ q = zf->data + zf->baseoffs;
+ if ((zf->baseoffs >= 6) &&
+ (zip_read_int(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;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tclzipfs_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
+Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,
+ const char *passwd)
+{
+ char *realname, *p;
+ int i, pwlen, isNew;
+ ZipFile *zf, zf0;
+ ZipEntry *z;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString ds, dsm, fpBuf;
+ unsigned char *q;
+#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) {
+ Tcl_HashSearch search;
+ int ret = TCL_OK;
+
+ i = 0;
+ hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+ while (hPtr != NULL) {
+ if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
+ if (interp != NULL) {
+ Tcl_AppendElement(interp, zf->mntpt);
+ Tcl_AppendElement(interp, zf->name);
+ }
+ ++i;
+ }
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ if (interp == NULL) {
+ ret = (i > 0) ? TCL_OK : TCL_BREAK;
+ }
+ Unlock();
+ return ret;
+ }
+ if (mntpt == NULL) {
+ if (interp == NULL) {
+ Unlock();
+ return TCL_OK;
+ }
+ 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) {
+ if ((zf = Tcl_GetHashValue(hPtr)) != 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, 2);
+ 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;
+ }
+ Tcl_DStringInit(&ds);
+#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);
+#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) {
+ Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ?
+ zf->mntpt : "/", "\"", (char *) NULL);
+ }
+ Unlock();
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsm);
+ ZipFSCloseArchive(interp, &zf0);
+ return TCL_ERROR;
+ }
+ if (strcmp(mntpt, "/") == 0) {
+ mntpt = "";
+ }
+ zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1);
+ if (zf == NULL) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+ }
+ Unlock();
+ 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 ((zf->pwbuf[0] == 0) && pwlen) {
+ int k = 0;
+
+ i = pwlen;
+ zf->pwbuf[k++] = i;
+ while (i > 0) {
+ zf->pwbuf[k] = (passwd[i - 1] & 0x0f) |
+ pwrot[(passwd[i - 1] >> 4) & 0x0f];
+ k++;
+ i--;
+ }
+ zf->pwbuf[k] = '\0';
+ }
+ if (mntpt[0] != '\0') {
+ z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
+ z->name = NULL;
+ z->tnext = NULL;
+ z->depth = CountSlashes(mntpt);
+ z->zipfile = zf;
+ z->isdir = 1;
+ z->isenc = 0;
+ z->offset = zf->baseoffs;
+ z->crc32 = 0;
+ z->timestamp = 0;
+ z->nbyte = z->nbytecompr = 0;
+ z->cmeth = ZIP_COMPMETH_STORED;
+ z->data = NULL;
+ hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew);
+ if (!isNew) {
+ /* skip it */
+ Tcl_Free((char *) z);
+ } else {
+ Tcl_SetHashValue(hPtr, (ClientData) z);
+ z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+ z->next = zf->entries;
+ zf->entries = z;
+ }
+ }
+ q = zf->data + zf->centoffs;
+ Tcl_DStringInit(&fpBuf);
+ for (i = 0; i < zf->nfiles; i++) {
+ int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs;
+ unsigned char *lq, *gq = NULL;
+ char *fullpath, *path;
+
+ pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS);
+ comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
+ extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS);
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
+ path = Tcl_DStringValue(&ds);
+ if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
+ Tcl_DStringSetLength(&ds, pathlen - 1);
+ path = Tcl_DStringValue(&ds);
+ isdir = 1;
+ }
+ if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
+ goto nextent;
+ }
+ lq = zf->data + zf->baseoffs +
+ zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS);
+ if ((lq < zf->data) || (lq > (zf->data + zf->length))) {
+ goto nextent;
+ }
+ nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS);
+ if (!isdir && (nbcompr == 0) &&
+ (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) &&
+ (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
+ gq = q;
+ nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS);
+ }
+ offs = (lq - zf->data)
+ + ZIP_LOCAL_HEADER_LEN
+ + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS)
+ + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS);
+ if ((offs + nbcompr) > zf->length) {
+ goto nextent;
+ }
+ if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) {
+#ifdef ANDROID
+ /*
+ * When mounting the ZIP archive on the root directory try
+ * to remap top level regular files of the archive to
+ * /assets/.root/... since this directory should not be
+ * in a valid APK due to the leading dot in the file name
+ * component. This trick should make the files
+ * AndroidManifest.xml, resources.arsc, and classes.dex
+ * visible to Tcl.
+ */
+ Tcl_DString ds2;
+
+ Tcl_DStringInit(&ds2);
+ Tcl_DStringAppend(&ds2, "assets/.root/", -1);
+ Tcl_DStringAppend(&ds2, path, -1);
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
+ if (hPtr != NULL) {
+ /* should not happen but skip it anyway */
+ Tcl_DStringFree(&ds2);
+ goto nextent;
+ }
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
+ Tcl_DStringLength(&ds2));
+ path = Tcl_DStringValue(&ds);
+ Tcl_DStringFree(&ds2);
+#else
+ /*
+ * Regular files skipped when mounting on root.
+ */
+ goto nextent;
+#endif
+ }
+ Tcl_DStringSetLength(&fpBuf, 0);
+ fullpath = CanonicalPath(mntpt, path, &fpBuf);
+ z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
+ z->name = NULL;
+ z->tnext = NULL;
+ z->depth = CountSlashes(fullpath);
+ z->zipfile = zf;
+ z->isdir = isdir;
+ z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
+ && (nbcompr > 12);
+ z->offset = offs;
+ if (gq != NULL) {
+ z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS);
+ dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS);
+ dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS);
+ z->timestamp = DosTimeDate(dosDate, dosTime);
+ z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
+ z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS);
+ } else {
+ z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS);
+ dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS);
+ dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS);
+ z->timestamp = DosTimeDate(dosDate, dosTime);
+ z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
+ z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS);
+ }
+ z->nbytecompr = nbcompr;
+ z->data = NULL;
+ hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
+ if (!isNew) {
+ /* should not happen but skip it anyway */
+ Tcl_Free((char *) z);
+ } else {
+ Tcl_SetHashValue(hPtr, (ClientData) z);
+ z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+ z->next = zf->entries;
+ zf->entries = z;
+ if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) {
+ z->tnext = zf->topents;
+ zf->topents = z;
+ }
+ if (!z->isdir && (z->depth > 1)) {
+ char *dir, *end;
+ ZipEntry *zd;
+
+ Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, z->name, -1);
+ dir = Tcl_DStringValue(&ds);
+ end = strrchr(dir, '/');
+ while ((end != NULL) && (end != dir)) {
+ Tcl_DStringSetLength(&ds, end - dir);
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir);
+ if (hPtr != NULL) {
+ break;
+ }
+ zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd));
+ zd->name = NULL;
+ zd->tnext = NULL;
+ zd->depth = CountSlashes(dir);
+ zd->zipfile = zf;
+ zd->isdir = 1;
+ zd->isenc = 0;
+ zd->offset = z->offset;
+ zd->crc32 = 0;
+ zd->timestamp = z->timestamp;
+ zd->nbyte = zd->nbytecompr = 0;
+ zd->cmeth = ZIP_COMPMETH_STORED;
+ zd->data = NULL;
+ hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
+ if (!isNew) {
+ /* should not happen but skip it anyway */
+ Tcl_Free((char *) zd);
+ } else {
+ Tcl_SetHashValue(hPtr, (ClientData) zd);
+ zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+ zd->next = zf->entries;
+ zf->entries = zd;
+ if ((mntpt[0] == '\0') && (zd->depth == 1)) {
+ zd->tnext = zf->topents;
+ zf->topents = zd;
+ }
+ }
+ end = strrchr(dir, '/');
+ }
+ }
+ }
+nextent:
+ q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
+ }
+ Unlock();
+ Tcl_DStringFree(&fpBuf);
+ Tcl_DStringFree(&ds);
+ Tcl_DStringFree(&dsm);
+ Tcl_FSMountsChanged(NULL);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tclzipfs_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
+Tclzipfs_Unmount(Tcl_Interp *interp, const char *zipname)
+{
+ char *realname;
+ ZipFile *zf;
+ ZipEntry *z, *znext;
+ 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) {
+ /* don't report error */
+ goto done;
+ }
+ zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+#if HAS_DRIVES
+ if (drive != zf->mntdrv) {
+ /* don't report error */
+ goto done;
+ }
+#endif
+ if (zf->nopen > 0) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("filesystem is busy", -1));
+ }
+ ret = TCL_ERROR;
+ goto done;
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ for (z = zf->entries; z; z = znext) {
+ znext = z->next;
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ if (z->data != NULL) {
+ Tcl_Free((char *) z->data);
+ }
+ Tcl_Free((char *) z);
+ }
+ ZipFSCloseArchive(interp, zf);
+ Tcl_Free((char *) zf);
+ unmounted = 1;
+done:
+ Unlock();
+ 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[])
+{
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?zipfile? ?mountpoint? ?password?");
+ return TCL_ERROR;
+ }
+ return Tclzipfs_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 Tclzipfs_Unmount(interp, Tcl_GetString(objv[1]));
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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;
+
+ if (info->iscompr && (info->ubuf != NULL)) {
+ Tcl_Free((char *) info->ubuf);
+ info->ubuf = NULL;
+ }
+ if (info->isenc) {
+ info->isenc = 0;
+ memset(info->keys, 0, sizeof (info->keys));
+ }
+ if (info->iswr) {
+ ZipEntry *z = info->zipentry;
+ unsigned char *newdata;
+
+ 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;
+ } else {
+ Tcl_Free((char *) info->ubuf);
+ }
+ }
+ WriteLock();
+ info->zipfile->nopen--;
+ Unlock();
+ 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) {
+ *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;
+ }
+ if (info->isenc) {
+ int i, ch;
+
+ for (i = 0; i < toRead; i++) {
+ ch = info->ubuf[i + info->nread];
+ buf[i] = zdecode(info->keys, crc32tab, ch);
+ }
+ } else {
+ 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;
+
+ if (info->isdir) {
+ *errloc = EINVAL;
+ return -1;
+ }
+ switch (mode) {
+ case SEEK_CUR:
+ offset += info->nread;
+ break;
+ case SEEK_END:
+ offset += info->nbyte;
+ 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 > info->nbyte) {
+ *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)
+{
+ return;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ * The channel type/driver definition used for ZIP archive members.
+ */
+
+static Tcl_ChannelType ZipChannelType = {
+ "zip", /* Type name. */
+ 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 */
+ NULL, /* 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 */
+ NULL, /* Thread action function, NULL'able */
+};
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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;
+ char cname[128];
+
+ 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;
+ }
+ 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 (*info));
+ 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;
+ if (wr) {
+ flags |= TCL_WRITABLE;
+ info->iswr = 1;
+ info->isdir = 0;
+ info->nmax = ZipFS.wrmax;
+ info->iscompr = 0;
+ info->isenc = 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;
+ }
+ 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];
+ 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, info->keys, crc32tab);
+ memset(pwbuf, 0, sizeof (pwbuf));
+ for (i = 0; i < 12; i++) {
+ ch = info->ubuf[i];
+ zdecode(info->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) {
+ goto merror0;
+ }
+ for (j = 0; j < stream.avail_in; j++) {
+ ch = info->ubuf[j];
+ cbuf[j] = zdecode(info->keys, crc32tab, ch);
+ }
+ 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) {
+ memset(info->keys, 0, sizeof (info->keys));
+ Tcl_Free((char *) cbuf);
+ }
+ goto wrapchan;
+ }
+cerror0:
+ if (cbuf != NULL) {
+ memset(info->keys, 0, sizeof (info->keys));
+ 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(info->keys, crc32tab, ch);
+ }
+ } else {
+ memcpy(info->ubuf, zbuf, z->nbyte);
+ }
+ memset(info->keys, 0, sizeof (info->keys));
+ goto wrapchan;
+ }
+ }
+ } else if (z->data != NULL) {
+ flags |= TCL_READABLE;
+ info->iswr = 0;
+ info->iscompr = 0;
+ info->isdir = 0;
+ info->isenc = 0;
+ info->nbyte = z->nbyte;
+ info->nmax = 0;
+ info->ubuf = z->data;
+ } 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->isenc = z->isenc;
+ info->nbyte = z->nbyte;
+ info->nmax = 0;
+ if (info->isenc) {
+ int len = z->zipfile->pwbuf[0];
+ 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, info->keys, crc32tab);
+ memset(pwbuf, 0, sizeof (pwbuf));
+ for (i = 0; i < 12; i++) {
+ ch = info->ubuf[i];
+ zdecode(info->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 (info->isenc) {
+ stream.avail_in -= 12;
+ ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in);
+ if (ubuf == NULL) {
+ info->ubuf = NULL;
+ goto merror;
+ }
+ for (j = 0; j < stream.avail_in; j++) {
+ ch = info->ubuf[j];
+ ubuf[j] = zdecode(info->keys, crc32tab, ch);
+ }
+ 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) {
+ info->isenc = 0;
+ memset(info->keys, 0, sizeof (info->keys));
+ Tcl_Free((char *) ubuf);
+ }
+ Tcl_Free((char *) info);
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("out of memory", -1));
+ }
+ goto error;
+ }
+ 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) {
+ info->isenc = 0;
+ memset(info->keys, 0, sizeof (info->keys));
+ Tcl_Free((char *) ubuf);
+ }
+ goto wrapchan;
+ }
+cerror:
+ if (ubuf != NULL) {
+ info->isenc = 0;
+ memset(info->keys, 0, sizeof (info->keys));
+ 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;
+ }
+ }
+wrapchan:
+ sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, ZipFS.idCount++);
+ z->zipfile->nopen++;
+ Unlock();
+ return Tcl_CreateChannel(&ZipChannelType, cname, (ClientData) info, flags);
+
+error:
+ Unlock();
+ return NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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, l, dirOnly = -1, prefixLen, strip = 0, matchHidden = 0;
+ char *pat, *prefix, *path, *p;
+#if HAS_DRIVES
+ 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 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);
+#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)) {
+ l = CountSlashes(path);
+ if (path[len - 1] == '/') {
+ len--;
+ } else {
+ l++;
+ }
+ if ((pattern == NULL) || (pattern[0] == '\0')) {
+ pattern = "*";
+ }
+ hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+ while (hPtr != NULL) {
+ ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+
+ if (zf->mntptlen == 0) {
+ ZipEntry *z = zf->topents;
+
+ while (z != NULL) {
+ int lenz = strlen(z->name);
+
+ if ((lenz > len + 1) &&
+ (strncmp(z->name, path, len) == 0) &&
+ (z->name[len] == '/') &&
+ (CountSlashes(z->name) == l) &&
+ Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)) {
+ if (!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) == l) &&
+ 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));
+ }
+ }
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ goto end;
+ }
+ if ((pattern == NULL) || (pattern[0] == '\0')) {
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
+ if (hPtr != NULL) {
+ ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+
+ if ((dirOnly < 0) ||
+ (!dirOnly && !z->isdir) ||
+ (dirOnly && z->isdir)) {
+ if (prefix != NULL) {
+ Tcl_DStringAppend(&dsPref, z->name, -1);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+ Tcl_DStringLength(&dsPref)));
+ Tcl_DStringSetLength(&dsPref, prefixLen);
+ } else {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(z->name, -1));
+ }
+ }
+ }
+ goto end;
+ }
+ l = strlen(pattern);
+ pat = Tcl_Alloc(len + l + 2);
+ memcpy(pat, path, len);
+ while ((len > 1) && (pat[len - 1] == '/')) {
+ --len;
+ }
+ if ((len > 1) || (pat[0] != '/')) {
+ pat[len] = '/';
+ ++len;
+ }
+ memcpy(pat + len, pattern, l + 1);
+ scnt = CountSlashes(pat);
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+
+ if ((dirOnly >= 0) &&
+ ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))) {
+ continue;
+ }
+ if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
+ if (!matchHidden) {
+ p = strrchr(z->name, '/');
+ if ((p != NULL) && (p[1] == '.')) {
+ 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));
+ }
+ }
+ }
+ Tcl_Free(pat);
+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)) {
+ ret = TCL_OK;
+ goto endloop;
+ }
+ z = z->tnext;
+ }
+ } else if ((len >= zf->mntptlen) &&
+ (strncmp(path, zf->mntpt, zf->mntptlen) == 0)) {
+ 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->mtntp);
+ 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, -1 otherwise with error number set.
+ *
+ * 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 manger 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);
+ return -1;
+#else
+ Tcl_Obj *altPath = NULL;
+ int ret = -1;
+
+ if (Tcl_FSAccess(path, R_OK) == 0) {
+ /*
+ * EXDEV should trigger loading by copying to temp store.
+ */
+ Tcl_SetErrno(EXDEV);
+ 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);
+ 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 (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},
+ {"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}
+ };
+
+ /* 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.fileHash, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
+ ZipFS.initialized = ZipFS.idCount = 1;
+ Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit);
+ }
+ Unlock();
+ 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
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tclzipfs_Init, Tclzipfs_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
+Tclzipfs_Init(Tcl_Interp *interp)
+{
+ return Zipfs_doInit(interp, 0);
+}
+
+int
+Tclzipfs_SafeInit(Tcl_Interp *interp)
+{
+ return Zipfs_doInit(interp, 1);
+}
+
+#ifndef HAVE_ZLIB
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Tclzipfs_Mount, Tclzipfs_Unmount --
+ *
+ * Dummy version when no ZLIB support available.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+Tclzipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,
+ const char *passwd)
+{
+ return Zipfs_doInit(interp, 1);
+}
+
+int
+Tclzipfs_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:
+ */
diff --git a/library/clock.tcl b/library/clock.tcl
index 8e4b657..8e4b657 100755..100644
--- a/library/clock.tcl
+++ b/library/clock.tcl
diff --git a/tests/zipfs.test b/tests/zipfs.test
new file mode 100644
index 0000000..adacbde
--- /dev/null
+++ b/tests/zipfs.test
@@ -0,0 +1,116 @@
+# The file tests the tclZlib.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
+#
+# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.1
+ namespace import -force ::tcltest::*
+}
+
+testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}]
+
+test zipfs-1.1 {zipfs basics} -constraints zipfs -body {
+ load {} zipfs
+} -result {}
+
+test zipfs-1.2 {zipfs basics} -constraints zipfs -body {
+ package require zipfs
+} -result {1.0}
+
+test zipfs-1.3 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs mount a b c d e f
+} -result {wrong # args: should be "zipfs mount ?zipfile? ?mountpoint? ?password?"}
+
+test zipfs-1.4 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs unmount a b c d e f
+} -result {wrong # args: should be "zipfs unmount zipfile"}
+
+test zipfs-1.5 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs mkkey a b c d e f
+} -result {wrong # args: should be "zipfs mkkey password"}
+
+test zipfs-1.6 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs mkimg a b c d e f
+} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
+
+test zipfs-1.7 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs mkzip a b c d e f
+} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
+
+test zipfs-1.8 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs exists a b c d e f
+} -result {wrong # args: should be "zipfs exists filename"}
+
+test zipfs-1.9 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs info a b c d e f
+} -result {wrong # args: should be "zipfs info filename"}
+
+test zipfs-1.10 {zipfs basics} -constraints zipfs -returnCodes error -body {
+ zipfs list a b c d e f
+} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}
+
+
+test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
+ zipfs mkzip abc.zip $tcl_library/xxxx
+} -result {empty archive}
+
+test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body {
+ set pwd [pwd]
+ cd $tcl_library/encoding
+ zipfs mkzip abc.zip .
+ zipfs mount abc.zip /abc
+ zipfs list -glob /abc/cp850.*
+} -cleanup {
+ cd $pwd
+} -result {/abc/cp850.enc}
+
+test zipfs-2.3 {zipfs unmount} -constraints zipfs -body {
+ zipfs info /abc/cp850.enc
+} -result [list $tcl_library/encoding/abc.zip 1090 527 39434]
+
+test zipfs-2.4 {zipfs unmount} -constraints zipfs -body {
+ set f [open /abc/cp850.enc]
+ read $f
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+}
+
+test zipfs-2.5 {zipfs exists} -constraints zipfs -body {
+ zipfs unmount abc.zip
+ zipfs exists /abc/cp850.enc
+} -cleanup {
+ file delete abc.zip
+} -result 1
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 9ad106c..3010176 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -308,7 +308,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclStrToD.o tclThread.o \
tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
- tclTomMathInterface.o
+ tclTomMathInterface.o zipfs.o
OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
tclOOMethod.o tclOOStubInit.o
@@ -373,6 +373,7 @@ GENERIC_HDRS = \
$(GENERIC_DIR)/tclInt.h \
$(GENERIC_DIR)/tclIntDecls.h \
$(GENERIC_DIR)/tclIntPlatDecls.h \
+ $(GENERIC_DIR)/tclZipfs.h \
$(GENERIC_DIR)/tclTomMath.h \
$(GENERIC_DIR)/tclTomMathDecls.h \
$(GENERIC_DIR)/tclOO.h \
@@ -463,7 +464,8 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclUtil.c \
$(GENERIC_DIR)/tclVar.c \
$(GENERIC_DIR)/tclAssembly.c \
- $(GENERIC_DIR)/tclZlib.c
+ $(GENERIC_DIR)/tclZlib.c \
+ $(GENERIC_DIR)/zipfs.c
OO_SRCS = \
$(GENERIC_DIR)/tclOO.c \
@@ -952,6 +954,7 @@ install-headers:
@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
$(GENERIC_DIR)/tclPlatDecls.h \
+ $(GENERIC_DIR)/tclZipfs.h \
$(GENERIC_DIR)/tclTomMath.h \
$(GENERIC_DIR)/tclTomMathDecls.h ; \
do \
@@ -1321,6 +1324,9 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c
tclZlib.o: $(GENERIC_DIR)/tclZlib.c
$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
+zipfs.o: $(GENERIC_DIR)/zipfs.c
+ $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/zipfs.c
+
tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 9bbc88b..40b10f3 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -17,6 +17,7 @@
#include "tcl.h"
#ifdef TCL_TEST
+#include "tclZipfs.h"
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */
@@ -123,6 +124,10 @@ Tcl_AppInit(
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
+ if (Tclzipfs_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit);
#endif /* TCL_TEST */
/*
diff --git a/win/Makefile.in b/win/Makefile.in
index 0ab4204..821afeb 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -302,7 +302,8 @@ GENERIC_OBJS = \
tclUtf.$(OBJEXT) \
tclUtil.$(OBJEXT) \
tclVar.$(OBJEXT) \
- tclZlib.$(OBJEXT)
+ tclZlib.$(OBJEXT) \
+ zipfs.$(OBJEXT)
TOMMATH_OBJS = \
bncore.${OBJEXT} \
@@ -635,6 +636,7 @@ install-libraries: libraries install-tzdata install-msgs
@echo "Installing header files";
@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
"$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
+ "$(GENERIC_DIR)/tclZipfs.h" \
"$(GENERIC_DIR)/tclPlatDecls.h" \
"$(GENERIC_DIR)/tclTomMath.h" \
"$(GENERIC_DIR)/tclTomMathDecls.h"; \
@@ -749,7 +751,7 @@ clean: cleanhelp clean-packages
distclean: distclean-packages clean
$(RM) Makefile config.status config.cache config.log tclConfig.sh \
- tcl.hpj config.status.lineno
+ tcl.hpj config.status.lineno tclsh.exe.manifest
#
# Bundled package targets
diff --git a/win/makefile.vc b/win/makefile.vc
index 8cbae2e..533e821 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -344,7 +344,8 @@ COREOBJS = \
$(TMP_DIR)\tclUtf.obj \
$(TMP_DIR)\tclUtil.obj \
$(TMP_DIR)\tclVar.obj \
- $(TMP_DIR)\tclZlib.obj
+ $(TMP_DIR)\tclZlib.obj \
+ $(TMP_DIR)\zipfs.obj
ZLIBOBJS = \
$(TMP_DIR)\adler32.obj \
@@ -944,6 +945,9 @@ $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
$(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
+$(TMP_DIR)\zipfs.obj: $(GENERICDIR)\zipfs.c
+ $(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
+
$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
$(cc32) -DBUILD_tcl $(TCL_CFLAGS) \
-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
@@ -1117,6 +1121,7 @@ install-libraries: tclConfig install-msgs install-tzdata
@$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclOO.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclOODecls.h" "$(INCLUDE_INSTALL_DIR)\"
+ @$(CPY) "$(GENERICDIR)\tclZipfs.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclTomMath.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index e06eaf5..b821ca7 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -25,6 +25,7 @@
#include <tchar.h>
#ifdef TCL_TEST
+#include "tclZipfs.h"
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */
@@ -174,6 +175,10 @@ Tcl_AppInit(
return TCL_ERROR;
}
Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
+ if (Tclzipfs_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "zipfs", Tclzipfs_Init, Tclzipfs_SafeInit);
#endif /* TCL_TEST */
/*
generated by cgit v0.12 at 2024-10-11 14:02:14 (GMT)