/*
** Copyright (c) 2000 D. Richard Hipp
**
** This program is free software; you can redistribute it and/or
** modify it under the terms of the GNU General Public
** License as published by the Free Software Foundation; either
** version 2 of the License, or (at your option) any later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
** General Public License for more details.
**
** You should have received a copy of the GNU General Public
** License along with this library; if not, write to the
** Free Software Foundation, Inc., 59 Temple Place - Suite 330,
** Boston, MA 02111-1307, USA.
**
** Author contact information:
** [email protected]
** http://www.hwaci.com/drh/
**
*************************************************************************
** A ZIP archive virtual filesystem for Tcl.
**
** This package of routines enables Tcl to use a Zip file as
** a virtual file system. Each of the content files of the Zip
** archive appears as a real file to Tcl.
**
** Modified to use Tcl VFS hooks by Peter MacDonald
** [email protected]
** http://pdqi.com
**
** @(#) $Id: zvfs.c,v 1.1.1.1 2002/01/27 17:44:02 cvs Exp $
**
** Revison Date Author Description
** ------- ------------- ----------------- ----------------------------------------------
** Jan 8, 2006 Dennis R. LaBelle Modified to support encrypted files
**
** Dec 16, 2009 Dennis R. LaBelle Corrected Tobe_FSMatchInDirectoryProc() for
** proper operation of glob command on ZVFS files
** under TCL 8.5.
** Oct 19, 2014 Sean D. Woods Corrected Tobe_FSMatchInDirectoryProc() to work around
** issues resolving global file paths under Windows.
** Wrapped FreeWrap specific calls inside of macros.
** Wrapped calls that implement encryption inside of macros. (The supporting
** library for this is part of Zip, and not distributed with Tcl.)
** Reconciled this edition of Zvfs with parallel work on the Odie project.
*/
#include <ctype.h>
#include <zlib.h>
#include <errno.h>
#include <string.h>
#include <sys/stat.h>
#include <time.h>
#include <stdlib.h>
#include "tcl.h"
TCL_DECLARE_MUTEX(ArchiveFileAccess)
#undef ZIPVFSCRYPT
#ifdef ZIPVFSCRYPT
/* Some modifications to support encrypted files */
#define update_keys zp_update_keys
#define init_keys zp_init_keys
#define decrypt_byte zp_decrypt_byte
/* some prototype definitions */
extern void init_keys(char *pwd);
extern int update_keys(int c);
extern unsigned char decrypt_byte();
extern char *getPwdKey(char *keybuf);
extern const unsigned long *crc_32_tab;
#endif
/* End of modifications to support encrypted files. */
/*
** Size of the decompression input buffer
*/
#define COMPR_BUF_SIZE 32768
static int openarch = 0; /* Set to 1 when opening archive. */
#ifdef __WIN32__
static int maptolower=0;
#endif
/*
** All static variables are collected into a structure named "local".
** That way, it is clear in the code when we are using a static
** variable because its name begins with "local.".
*/
static struct {
Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The
** The key is the virtual filename. The data
** an an instance of the ZvfsFile structure. */
Tcl_HashTable archiveHash; /* One entry for each archive. Key is the name.
** data is the ZvfsArchive structure */
int isInit; /* True after initialization */
char *firstMount; /* The path to to the first mounted file. */
} local;
/*
** Each ZIP archive file that is mounted is recorded as an instance
** of this structure
*/
typedef struct ZvfsArchive {
char *zName; /* Name of the archive */
char *zMountPoint; /* Where this archive is mounted */
struct ZvfsFile *pFiles; /* List of files in that archive */
} ZvfsArchive;
/*
** Particulars about each virtual file are recorded in an instance
** of the following structure.
*/
typedef struct ZvfsFile {
char *zName; /* The full pathname of the virtual file */
ZvfsArchive *pArchive; /* The ZIP archive holding this file data */
int iOffset; /* Offset into the ZIP archive of the data */
int nByte; /* Uncompressed size of the virtual file */
int nByteCompr; /* Compressed size of the virtual file */
int isdir; /* Set to 1 if directory */
int depth; /* Number of slashes in path. */
int timestamp; /* Modification time */
int permissions; /* File permissions. */
struct ZvfsFile *pNext; /* Next file in the same archive */
struct ZvfsFile *pNextName; /* A doubly-linked list of files with the same */
struct ZvfsFile *pPrevName; /* name. Only the first is in local.fileHash */
/* The following would be used for writable zips. */
int nExtra; /* Extra space in the TOC header */
int isSpecial; /* Not really a file in the ZIP archive */
int dosTime; /* Modification time (DOS format) */
int dosDate; /* Modification date (DOS format) */
int iCRC; /* Cyclic Redundancy Check of the data */
} ZvfsFile;
/*
** Macros to read 16-bit and 32-bit big-endian integers into the
** native format of this local processor. B is an array of
** characters and the integer begins at the N-th character of
** the array.
*/
#define INT16(B, N) (B[N] + (B[N+1]<<8))
#define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24))
/* Convert DOS time to unix time. */
static time_t DosTimeDate(int dosDate, int dosTime){
time_t now;
struct tm *tm;
now=time(NULL);
tm = localtime(&now);
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);
return mktime(tm);
}
/* Return count of char ch in str */
static int strchrcnt(char *str, char ch) {
int cnt=0;
char *cp=str;
while ((cp=strchr(cp,ch))) { cp++; cnt++; }
return cnt;
}
/*
** Concatenate zTail onto zRoot to form a pathname. zRoot will begin
** with "/". After concatenation, simplify the pathname be removing
** unnecessary ".." and "." directories. Under windows, make all
** characters lower case.
**
** Resulting pathname is returned. Space to hold the returned path is
** obtained from Tcl_Alloc() and should be freed by the calling function.
*/
static char *
CanonicalPath(
const char *zRoot,
const char *zTail)
{
char *zPath;
int i, j, c;
#ifdef __WIN32__
if (isalpha(zTail[0]) && zTail[1] == ':') {
zTail += 2;
}
if (zTail[0] == '\\') {
zRoot = "";
zTail++;
}
#endif
if (zTail[0] == '/') {
zRoot = "";
zTail++;
}
zPath = Tcl_Alloc(strlen(zRoot) + strlen(zTail) + 2);
if (zTail[0]) {
sprintf(zPath, "%s/%s", zRoot, zTail);
} else {
strcpy(zPath, zRoot);
}
for (i=j=0 ; (c = zPath[i]) != 0 ; i++) {
#ifdef __WIN32__
if (isupper(c)) {
c = tolower(c);
} else if (c == '\\') {
c = '/';
}
#endif
if (c == '/') {
int c2 = zPath[i+1];
if (c2 == '/') {
continue;
}
if (c2 == '.') {
int c3 = zPath[i+2];
if (c3 == '/' || c3 == 0) {
i++;
continue;
}
if (c3 == '.' && (zPath[i+3] == '.' || zPath[i+3] == 0)) {
i += 2;
while (j > 0 && zPath[j-1] != '/') {
j--;
}
continue;
}
}
}
zPath[j++] = c;
}
if (j == 0) {
zPath[j++] = '/';
}
/* if (j>1 && zPath[j-1] == '/') j--; */
zPath[j] = 0;
return zPath;
}
/*
* Construct an absolute pathname where memory is obtained from Tcl_Alloc that
* means the same file as the pathname given.
*/
static char *
AbsolutePath(
const char *zRelative)
{
Tcl_DString pwd;
char *zResult;
int len;
Tcl_DStringInit(&pwd);
if (zRelative[0] == '~' && zRelative[1] == '/') {
/* TODO: do this for all paths??? */
if (Tcl_TranslateFileName(0, zRelative, &pwd) != NULL) {
zResult = CanonicalPath("", Tcl_DStringValue(&pwd));
goto done;
}
} else if (zRelative[0] != '/') {
#ifdef __WIN32__
if (!(zRelative[0]=='\\' || (zRelative[0] && zRelative[1] == ':'))) {
/*Tcl_GetCwd(0, &pwd); */
}
#else
Tcl_GetCwd(0, &pwd);
#endif
}
zResult = CanonicalPath(Tcl_DStringValue(&pwd), zRelative);
done:
Tcl_DStringFree(&pwd);
len = strlen(zResult);
if (len > 0 && zResult[len-1] == '/') {
zResult[len-1] = 0;
}
return zResult;
}
/*
** Read a ZIP archive and make entries in the virutal file hash table for all
** content files of that ZIP archive. Also initialize the ZVFS if this
** routine has not been previously called.
*/
int Zvfs_Mount(
Tcl_Interp *interp, /* Leave error messages in this interpreter */
const char *zArchive, /* The ZIP archive file */
const char *zMountPoint /* Mount contents at this directory */
) {
Tcl_Channel chan; /* Used for reading the ZIP archive file */
char *zArchiveName = 0; /* A copy of zArchive */
char *zTrueName = 0; /* A copy of zMountPoint */
int nFile; /* Number of files in the archive */
int iPos; /* Current position in the archive file */
ZvfsArchive *pArchive; /* The ZIP archive being mounted */
Tcl_HashEntry *pEntry; /* Hash table entry */
int isNew; /* Flag to tell use when a hash entry is
* new */
unsigned char zBuf[100]; /* Space into which to read from the ZIP
* archive */
Tcl_HashSearch zSearch; /* Search all mount points */
unsigned int startZip;
if (!local.isInit) {
return TCL_ERROR;
}
/*
* If null archive name, return all current mounts.
*/
if (!zArchive) {
Tcl_DString dStr;
Tcl_DStringInit(&dStr);
pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
while (pEntry) {
pArchive = Tcl_GetHashValue(pEntry);
if (pArchive) {
Tcl_DStringAppendElement(&dStr, pArchive->zName);
Tcl_DStringAppendElement(&dStr, pArchive->zMountPoint);
}
pEntry = Tcl_NextHashEntry(&zSearch);
}
Tcl_DStringResult(interp, &dStr);
return TCL_OK;
}
/*
* If null mount, return mount point.
*/
/*TODO: cleanup allocations of Absolute() path.*/
if (!zMountPoint) {
zTrueName = AbsolutePath(zArchive);
pEntry = Tcl_FindHashEntry(&local.archiveHash, zTrueName);
if (pEntry) {
pArchive = Tcl_GetHashValue(pEntry);
if (pArchive && interp) {
Tcl_AppendResult(interp, pArchive->zMountPoint, 0);
}
}
Tcl_Free((char *)zTrueName);
return TCL_OK;
}
Tcl_MutexLock(&ArchiveFileAccess);
chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0);
if (!chan) {
Tcl_MutexUnlock(&ArchiveFileAccess);
return TCL_ERROR;
}
if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){
goto closeReleaseDie;
}
if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) {
goto closeReleaseDie;
}
/*
* Read the "End Of Central Directory" record from the end of the ZIP
* archive.
*/
iPos = Tcl_Seek(chan, -22, SEEK_END);
Tcl_Read(chan, (char *) zBuf, 22);
if (memcmp(zBuf, "\120\113\05\06", 4)) {
if(interp) Tcl_AppendResult(interp, "not a ZIP archive", NULL);
goto closeReleaseDie;
}
/*
* Construct the archive record.
*/
zArchiveName = AbsolutePath(zArchive);
pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew);
if (!isNew) {
pArchive = Tcl_GetHashValue(pEntry);
if (interp) {
Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint,0);
}
goto closeReleaseDie;
}
/*
* Empty string is the special case of mounting on itself.
*/
if (!*zMountPoint) {
zMountPoint = zTrueName = AbsolutePath(zArchive);
}
pArchive = (void *) Tcl_Alloc(sizeof(*pArchive) + strlen(zMountPoint)+1);
pArchive->zName = zArchiveName;
pArchive->zMountPoint = (char *) &pArchive[1];
strcpy(pArchive->zMountPoint, zMountPoint);
pArchive->pFiles = 0;
Tcl_SetHashValue(pEntry, pArchive);
/*
* Compute the starting location of the directory for the ZIP archive in
* iPos then seek to that location.
*/
nFile = INT16(zBuf, 8);
iPos -= INT32(zBuf, 12);
Tcl_Seek(chan, iPos, SEEK_SET);
startZip = iPos;
while (1) {
int lenName; /* Length of the next filename */
int lenExtra=0; /* Length of "extra" data for next file */
int iData; /* Offset to start of file data */
int dosTime;
int dosDate;
int isdir;
ZvfsFile *pZvfs; /* A new virtual file */
char *zFullPath; /* Full pathname of the virtual file */
char zName[1024]; /* Space to hold the filename */
if (nFile-- <= 0) {
isdir = 1;
zFullPath = CanonicalPath(zMountPoint, "");
iData = startZip;
goto addentry;
}
/*
* Read the next directory entry. Extract the size of the filename,
* the size of the "extra" information, and the offset into the
* archive file of the file data.
*/
Tcl_Read(chan, (char *) zBuf, 46);
if (memcmp(zBuf, "\120\113\01\02", 4)) {
if(interp) {
Tcl_AppendResult(interp, "ill-formed central directory entry",NULL);
}
if (zTrueName) {
Tcl_Free(zTrueName);
}
return TCL_ERROR;
}
lenName = INT16(zBuf, 28);
lenExtra = INT16(zBuf, 30) + INT16(zBuf, 32);
iData = INT32(zBuf, 42);
/*
* If the virtual filename is too big to fit in zName[], then skip
* this file
*/
if (lenName >= sizeof(zName)) {
Tcl_Seek(chan, lenName + lenExtra, SEEK_CUR);
continue;
}
/*
* Construct an entry in local.fileHash for this virtual file.
*/
Tcl_Read(chan, zName, lenName);
isdir = 0;
if (lenName > 0 && zName[lenName-1] == '/') {
lenName--;
isdir = 2;
}
zName[lenName] = 0;
zFullPath = CanonicalPath(zMountPoint, zName);
addentry:
pZvfs = (void *) Tcl_Alloc(sizeof(*pZvfs));
pZvfs->zName = zFullPath;
pZvfs->pArchive = pArchive;
pZvfs->isdir = isdir;
pZvfs->depth = strchrcnt(zFullPath, '/');
pZvfs->iOffset = iData;
if (iData < startZip) {
startZip = iData;
}
dosDate = INT16(zBuf, 14);
dosTime = INT16(zBuf, 12);
pZvfs->timestamp = DosTimeDate(dosDate, dosTime);
pZvfs->nByte = INT32(zBuf, 24);
pZvfs->nByteCompr = INT32(zBuf, 20);
pZvfs->pNext = pArchive->pFiles;
pZvfs->permissions = 0xffff & (INT32(zBuf, 38) >> 16);
pArchive->pFiles = pZvfs;
pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullPath, &isNew);
if (isNew) {
pZvfs->pNextName = 0;
} else {
ZvfsFile *pOld = Tcl_GetHashValue(pEntry);
pOld->pPrevName = pZvfs;
pZvfs->pNextName = pOld;
}
pZvfs->pPrevName = 0;
Tcl_SetHashValue(pEntry, pZvfs);
if (nFile < 0) {
break;
}
/*
* Skip over the extra information so that the next read will be from
* the beginning of the next directory entry.
*/
Tcl_Seek(chan, lenExtra, SEEK_CUR);
}
Tcl_Close(interp, chan);
if (zTrueName) {
Tcl_Free(zTrueName);
}
Tcl_MutexUnlock(&ArchiveFileAccess);
return TCL_OK;
closeReleaseDie:
Tcl_Close(interp, chan);
Tcl_MutexUnlock(&ArchiveFileAccess);
return TCL_ERROR;
}
/*
** Locate the ZvfsFile structure that corresponds to the file named.
** Return NULL if there is no such ZvfsFile.
*/
static ZvfsFile *ZvfsLookup(char *zFilename){
char *zTrueName;
Tcl_HashEntry *pEntry;
ZvfsFile *pFile;
if( local.isInit==0 ) return 0;
zTrueName = AbsolutePath(zFilename);
pEntry = Tcl_FindHashEntry(&local.fileHash, zTrueName);
pFile = pEntry ? Tcl_GetHashValue(pEntry) : 0;
Tcl_Free(zTrueName);
return pFile;
}
/*
** Unmount all the files in the given ZIP archive.
*/
static int Zvfs_Unmount(
const char *zArchive
) {
char *zArchiveName;
ZvfsArchive *pArchive;
ZvfsFile *pFile, *pNextFile;
Tcl_HashEntry *pEntry;
zArchiveName = AbsolutePath(zArchive);
pEntry = Tcl_FindHashEntry(&local.archiveHash, zArchiveName);
Tcl_Free(zArchiveName);
if (pEntry == 0) {
return 0;
}
Tcl_MutexLock(&ArchiveFileAccess);
pArchive = Tcl_GetHashValue(pEntry);
Tcl_DeleteHashEntry(pEntry);
Tcl_Free(pArchive->zName);
for(pFile=pArchive->pFiles ; pFile; pFile=pNextFile) {
pNextFile = pFile->pNext;
if (pFile->pNextName) {
pFile->pNextName->pPrevName = pFile->pPrevName;
}
if (pFile->pPrevName) {
pFile->pPrevName->pNextName = pFile->pNextName;
} else {
pEntry = Tcl_FindHashEntry(&local.fileHash, pFile->zName);
if (pEntry == 0) {
Tcl_Panic("This should never happen");
} else if (pFile->pNextName) {
Tcl_SetHashValue(pEntry, pFile->pNextName);
} else {
Tcl_DeleteHashEntry(pEntry);
}
}
Tcl_Free(pFile->zName);
Tcl_Free((void *) pFile);
}
Tcl_MutexUnlock(&ArchiveFileAccess);
return 1;
}
/*
* zvfs::mount Zip-archive-name mount-point
*
* Create a new mount point on the given ZIP archive. After this command
* executes, files contained in the ZIP archive will appear to Tcl to be
* regular files at the mount point.
*
* With no mount-point, return mount point for archive. With no archive,
* return all archive/mount pairs. If mount-point is specified as an empty
* string, mount on file path.
*/
static int
ZvfsMountObjCmd(
ClientData clientData, /* Client data for this command */
Tcl_Interp *interp, /* The interpreter used to report errors */
int objc, /* Number of arguments */
Tcl_Obj *const* objv) /* Values of all arguments */
{
/*TODO: Convert to Tcl_Obj API!*/
if (objc > 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", Tcl_GetString(objv[0]),
" ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0);
return TCL_ERROR;
}
return Zvfs_Mount(interp, objc>1?Tcl_GetString(objv[1]):NULL, objc>2?Tcl_GetString(objv[2]):NULL);
}
/*
* zvfs::unmount Zip-archive-name
*
* Undo the effects of zvfs::mount.
*/
static int
ZvfsUnmountObjCmd(
ClientData clientData, /* Client data for this command */
Tcl_Interp *interp, /* The interpreter used to report errors */
int objc, /* Number of arguments */
Tcl_Obj *const* objv) /* Values of all arguments */
{
ZvfsArchive *pArchive; /* The ZIP archive being mounted */
Tcl_HashEntry *pEntry; /* Hash table entry */
Tcl_HashSearch zSearch; /* Search all mount points */
char *zFilename;
if (objc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", Tcl_GetString(objv[0]),
" ZIP-FILE\"", 0);
return TCL_ERROR;
}
if (!local.isInit) {
return TCL_ERROR;
}
zFilename=Tcl_GetString(objv[1]);
if (Zvfs_Unmount(zFilename)) {
return TCL_OK;
}
pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
while (pEntry) {
pArchive = Tcl_GetHashValue(pEntry);
if (pArchive && pArchive->zMountPoint[0]
&& (strcmp(pArchive->zMountPoint, zFilename) == 0)) {
if (Zvfs_Unmount(pArchive->zName)) {
return TCL_OK;
}
break;
}
pEntry = Tcl_NextHashEntry(&zSearch);
}
Tcl_AppendResult(interp, "unknown zvfs mount point or file: ", zFilename,
NULL);
return TCL_ERROR;
}
/*
* zvfs::exists filename
*
* Return TRUE if the given filename exists in the ZVFS and FALSE if it does
* not.
*/
static int
ZvfsExistsObjCmd(
ClientData clientData, /* Client data for this command */
Tcl_Interp *interp, /* The interpreter used to report errors */
int objc, /* Number of arguments */
Tcl_Obj *const* objv) /* Values of all arguments */
{
char *zFilename;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "FILENAME");
return TCL_ERROR;
}
zFilename = Tcl_GetString(objv[1]);
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), ZvfsLookup(zFilename)!=0);
return TCL_OK;
}
/*
* zvfs::info filename
*
* Return information about the given file in the ZVFS. The information
* consists of (1) the name of the ZIP archive 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 archive.
*
* 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.
*/
static int
ZvfsInfoObjCmd(
ClientData clientData, /* Client data for this command */
Tcl_Interp *interp, /* The interpreter used to report errors */
int objc, /* Number of arguments */
Tcl_Obj *const* objv) /* Values of all arguments */
{
char *zFilename;
ZvfsFile *pFile;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "FILENAME");
return TCL_ERROR;
}
zFilename = Tcl_GetString(objv[1]);
pFile = ZvfsLookup(zFilename);
if (pFile) {
Tcl_Obj *pResult = Tcl_GetObjResult(interp);
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewStringObj(pFile->pArchive->zName, -1));
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewIntObj(pFile->nByte));
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewIntObj(pFile->nByteCompr));
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewIntObj(pFile->iOffset));
}
return TCL_OK;
}
/*
* zvfs::list
*
* Return a list of all files in the ZVFS. The order of the names in the list
* is arbitrary.
*/
static int
ZvfsListObjCmd(
ClientData clientData, /* Client data for this command */
Tcl_Interp *interp, /* The interpreter used to report errors */
int objc, /* Number of arguments */
Tcl_Obj *const* objv) /* Values of all arguments */
{
char *zPattern = 0;
Tcl_RegExp pRegexp = 0;
Tcl_HashEntry *pEntry;
Tcl_HashSearch sSearch;
Tcl_Obj *pResult = Tcl_GetObjResult(interp);
if (objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?PATTERN?");
return TCL_ERROR;
}
if (local.isInit == 0) {
return TCL_OK;
}
if (objc == 3) {
int n;
char *zSwitch = Tcl_GetStringFromObj(objv[1], &n);
if (n >= 2 && strncmp(zSwitch,"-glob",n) == 0) {
zPattern = Tcl_GetString(objv[2]);
} else if (n >= 2 && strncmp(zSwitch,"-regexp",n) == 0) {
pRegexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2]));
if (pRegexp == 0) {
return TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "unknown option: ", zSwitch, 0);
return TCL_ERROR;
}
} else if (objc == 2) {
zPattern = Tcl_GetString(objv[1]);
}
/*
* Do the listing.
*/
if (zPattern) {
for (pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch);
pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){
ZvfsFile *pFile = Tcl_GetHashValue(pEntry);
char *z = pFile->zName;
if (Tcl_StringCaseMatch(z, zPattern, 1)) {
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewStringObj(z, -1));
}
}
} else if (pRegexp) {
for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch);
pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){
ZvfsFile *pFile = Tcl_GetHashValue(pEntry);
char *z = pFile->zName;
if (Tcl_RegExpExec(interp, pRegexp, z, z)) {
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewStringObj(z, -1));
}
}
} else {
for (pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch);
pEntry; pEntry = Tcl_NextHashEntry(&sSearch)){
ZvfsFile *pFile = Tcl_GetHashValue(pEntry);
char *z = pFile->zName;
Tcl_ListObjAppendElement(interp, pResult,
Tcl_NewStringObj(z, -1));
}
}
return TCL_OK;
}
/*
** Whenever a ZVFS file is opened, an instance of this structure is
** attached to the open channel where it will be available to the
** ZVFS I/O routines below. All state information about an open
** ZVFS file is held in this structure.
*/
typedef struct ZvfsChannelInfo {
unsigned long nByte; /* number of bytes of uncompressed data */
unsigned long nByteCompr; /* number of bytes of unread compressed data */
unsigned long nData; /* total number of bytes of compressed data */
unsigned long readSoFar; /* position of next byte to be read from the channel */
long startOfData; /* File position of start of data in ZIP archive */
Tcl_Channel chan; /* Open file handle to the archive file */
unsigned char *zBuf; /* buffer used by the decompressor */
unsigned char *uBuf; /* pointer to the uncompressed, unencrypted data */
z_stream stream; /* state of the decompressor */
int isEncrypted; /* file is encrypted */
int isCompressed; /* True data is compressed */
} ZvfsChannelInfo;
/*
** This routine is called as an exit handler. If we do not set
** ZvfsChannelInfo.chan to NULL, then Tcl_Close() will be called on
** that channel a second time when Tcl_Exit runs. This will lead to a
** core dump.
*/
static void vfsExit(void *pArg){
ZvfsChannelInfo *pInfo = (ZvfsChannelInfo*)pArg;
pInfo->chan = 0;
}
/*
** This routine is called when the ZVFS channel is closed
*/
static int vfsClose(
ClientData instanceData, /* A ZvfsChannelInfo structure */
Tcl_Interp *interp /* The TCL interpreter */
){
ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*)instanceData;
if( pInfo->zBuf ){
Tcl_Free((char *)pInfo->zBuf);
Tcl_Free((char *)pInfo->uBuf);
inflateEnd(&pInfo->stream);
}
if( pInfo->chan ){
Tcl_Close(interp, pInfo->chan);
Tcl_DeleteExitHandler(vfsExit, pInfo);
}
Tcl_MutexUnlock(&ArchiveFileAccess);
Tcl_Free((char*)pInfo);
return TCL_OK;
}
static int vfsInput (
ClientData instanceData, /* The channel to read from */
char *buf, /* Buffer to fill */
int toRead, /* Requested number of bytes */
int *pErrorCode /* Location of error flag */
){ /* The TCL I/O system calls this function to actually read information
* from a ZVFS file.
*/
ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData;
unsigned long nextpos;
nextpos = pInfo->readSoFar + toRead;
if (nextpos > pInfo->nByte) {
toRead = pInfo->nByte - pInfo->readSoFar;
nextpos = pInfo->nByte;
}
if( toRead == 0 )
return 0;
memcpy(buf, pInfo->uBuf + pInfo->readSoFar, toRead);
pInfo->readSoFar = nextpos;
*pErrorCode = 0;
return toRead;
}
static int vfsRead (
ClientData instanceData, /* The channel to read from */
char *buf, /* Buffer to fill */
int toRead, /* Requested number of bytes */
int *pErrorCode /* Location of error flag */
){ /* Read and decompress all data for the associated file into the specified buffer */
ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData;
int len;
#ifdef ZIPVFSCRYPT
unsigned char encryptHdr[12];
int C;
int temp;
int i;
char pwdbuf[20];
#endif
if( (unsigned long)toRead > pInfo->nByte ){
toRead = pInfo->nByte;
}
if( toRead == 0 ){
return 0;
}
if (pInfo->isEncrypted) {
#ifdef ZIPVFSCRYPT
/* Make preparations to decrypt the data. */
/* Read and decrypt the encryption header. */
crc_32_tab = get_crc_table();
init_keys(getPwdKey(pwdbuf));
len = Tcl_Read(pInfo->chan, encryptHdr, sizeof(encryptHdr));
if (len == sizeof(encryptHdr)) {
for (i = 0; i < sizeof(encryptHdr); ++i) {
C = encryptHdr[i] ^ decrypt_byte();
update_keys(C);
}
}
#endif
}
if( pInfo->isCompressed ){
int err = Z_OK;
z_stream *stream = &pInfo->stream;
stream->next_out = (unsigned char *)buf;
stream->avail_out = toRead;
while (stream->avail_out) {
if (!stream->avail_in) {
len = pInfo->nByteCompr;
if (len > COMPR_BUF_SIZE) {
len = COMPR_BUF_SIZE;
}
len = Tcl_Read(pInfo->chan, (char *)pInfo->zBuf, len);
#ifdef ZIPVFSCRYPT
if (pInfo->isEncrypted) {
/* Decrypt the bytes we have just read. */
for (i = 0; i < len; ++i) {
C = pInfo->zBuf[i];
temp = C ^ decrypt_byte();
update_keys(temp);
pInfo->zBuf[i] = temp;
}
}
#endif
pInfo->nByteCompr -= len;
stream->next_in = pInfo->zBuf;
stream->avail_in = len;
}
err = inflate(stream, Z_NO_FLUSH);
if (err) break;
}
if (err == Z_STREAM_END) {
if ((stream->avail_out != 0)) {
*pErrorCode = err; /* premature end */
return -1;
}
}else if( err ){
*pErrorCode = err; /* some other zlib error */
return -1;
}
}else{
toRead = Tcl_Read(pInfo->chan, buf, toRead);
#ifdef ZIPVFSCRYPT
if (pInfo->isEncrypted) {
/* Decrypt the bytes we have just read. */
for (i = 0; i < toRead; ++i) {
C = buf[i];
temp = C ^ decrypt_byte();
update_keys(temp);
buf[i] = temp;
}
}
#endif
}
pInfo->nByte = toRead;
pInfo->readSoFar = 0;
*pErrorCode = 0;
return toRead;
}
/*
** Write to a ZVFS file. ZVFS files are always read-only, so this routine
** always returns an error.
*/
static int vfsOutput(
ClientData instanceData, /* The channel to write to */
CONST char *buf, /* Data to be stored. */
int toWrite, /* Number of bytes to write. */
int *pErrorCode /* Location of error flag. */
){
*pErrorCode = EINVAL;
return -1;
}
static int vfsSeek(
ClientData instanceData, /* The file structure */
long offset, /* Offset to seek to */
int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */
int *pErrorCode /* Write the error code here */
){ /* Move the file pointer so that the next byte read will be "offset". */
ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData;
switch( mode ){
case SEEK_CUR: {
offset += pInfo->readSoFar;
break;
}
case SEEK_END: {
offset += pInfo->nByte - 1;
break;
}
default: {
/* Do nothing */
break;
}
}
/* Don't seek past end of data */
if (pInfo->nByte < (unsigned long)offset)
return -1;
/* Don't seek before the start of data */
if (offset < 0)
return -1;
pInfo->readSoFar = (unsigned long)offset;
return pInfo->readSoFar;
}
/*
** Handle events on the channel. ZVFS files do not generate events,
** so this is a no-op.
*/
static void vfsWatchChannel(
ClientData instanceData, /* Channel to watch */
int mask /* Events of interest */
){
return;
}
/*
** Called to retrieve the underlying file handle for this ZVFS file.
** As the ZVFS file has no underlying file handle, this is a no-op.
*/
static int vfsGetFile(
ClientData instanceData, /* Channel to query */
int direction, /* Direction of interest */
ClientData* handlePtr /* Space to the handle into */
){
return TCL_ERROR;
}
/*
** This structure describes the channel type structure for
** access to the ZVFS.
*/
static Tcl_ChannelType vfsChannelType = {
"vfs", /* Type name. */
NULL, /* Set blocking/nonblocking behaviour. NULL'able */
vfsClose, /* Close channel, clean instance data */
vfsInput, /* Handle read request */
vfsOutput, /* Handle write request */
vfsSeek, /* Move location of access point. NULL'able */
NULL, /* Set options. NULL'able */
NULL, /* Get options. NULL'able */
vfsWatchChannel, /* Initialize notifier */
vfsGetFile /* Get OS handle from the channel. */
};
/*
** This routine attempts to do an open of a file. Check to see
** if the file is located in the ZVFS. If so, then open a channel
** for reading the file. If not, return NULL.
*/
static Tcl_Channel ZvfsFileOpen(
Tcl_Interp *interp, /* The TCL interpreter doing the open */
char *zFilename, /* Name of the file to open */
char *modeString, /* Mode string for the open (ignored) */
int permissions /* Permissions for a newly created file (ignored) */
){
ZvfsFile *pFile;
ZvfsChannelInfo *pInfo;
Tcl_Channel chan;
static int count = 1;
char zName[50];
unsigned char zBuf[50];
int errCode;
pFile = ZvfsLookup(zFilename);
if( pFile==0 ) {
return NULL;
}
openarch = 1;
Tcl_MutexLock(&ArchiveFileAccess);
chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0);
openarch = 0;
if (local.firstMount == NULL) {
local.firstMount = pFile->pArchive->zName;
}
if( chan==0 ){
Tcl_MutexUnlock(&ArchiveFileAccess);
return 0;
}
if( Tcl_SetChannelOption(interp, chan, "-translation", "binary")
|| Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
){
/* this should never happen */
goto closeReleaseDie;
}
Tcl_Seek(chan, pFile->iOffset, SEEK_SET);
Tcl_Read(chan, (char *)zBuf, 30);
if( memcmp(zBuf, "\120\113\03\04", 4) ){
if( interp ){
Tcl_AppendResult(interp, "local header mismatch: ", NULL);
}
goto closeReleaseDie;
}
pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) );
pInfo->chan = chan;
Tcl_CreateExitHandler(vfsExit, pInfo);
#ifdef ZIPVFSCRYPT
pInfo->isEncrypted = zBuf[6] & 1;
if (pFile->pArchive->zName == local.firstMount) {
/* FreeWrap specific.
We are opening a file from the executable.
All such files must be encrypted.
*/
if (!pInfo->isEncrypted) {
/* The file is not encrypted.
Someone must have tampered with the application.
Let's exit the program.
*/
printf("This application has an unauthorized modification. Exiting immediately\n");
exit(-10);
}
}
#endif
pInfo->isCompressed = INT16(zBuf, 8);
if (pInfo->isCompressed ){
z_stream *stream = &pInfo->stream;
pInfo->zBuf = (void *)Tcl_Alloc(COMPR_BUF_SIZE);
stream->zalloc = (alloc_func)0;
stream->zfree = (free_func)0;
stream->opaque = (voidpf)0;
stream->avail_in = 2;
stream->next_in = pInfo->zBuf;
pInfo->zBuf[0] = 0x78;
pInfo->zBuf[1] = 0x01;
inflateInit(&pInfo->stream);
} else {
pInfo->zBuf = 0;
}
pInfo->nByte = INT32(zBuf,22);
pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18);
pInfo->readSoFar = 0;
Tcl_Seek(chan, INT16(zBuf,26)+INT16(zBuf,28), SEEK_CUR);
pInfo->startOfData = Tcl_Tell(chan);
sprintf(zName,"vfs_%x_%x",((int)pFile)>>12,count++);
chan = Tcl_CreateChannel(&vfsChannelType, zName,
(ClientData)pInfo, TCL_READABLE);
pInfo->uBuf = (void *)Tcl_Alloc(pInfo->nByte);
/* Read and decompress the file contents */
if (pInfo->uBuf) {
pInfo->uBuf[0] = 0;
vfsRead(pInfo, (char *)pInfo->uBuf, pInfo->nByte, &errCode);
pInfo->readSoFar = 0;
}
return chan;
closeReleaseDie:
Tcl_Close(interp, chan);
Tcl_MutexUnlock(&ArchiveFileAccess);
return NULL;
}
Tcl_Channel Tobe_FSOpenFileChannelProc (
Tcl_Interp *interp,
Tcl_Obj *pathPtr,
int mode,
int permissions
) {
int len;
/* if (mode != O_RDONLY) return NULL; */
return ZvfsFileOpen(interp, Tcl_GetStringFromObj(pathPtr,&len), 0,
permissions);
}
/*
** This routine does a stat() system call for a ZVFS file.
*/
int Tobe_FSStatProc (
Tcl_Obj *pathPtr,
Tcl_StatBuf *buf
) {
char *path=Tcl_GetString(pathPtr);
ZvfsFile *pFile;
pFile = ZvfsLookup(path);
if (pFile == 0) {
return -1;
}
memset(buf, 0, sizeof(*buf));
if (pFile->isdir) {
buf->st_mode = 040555;
} else {
buf->st_mode = (0100000|pFile->permissions);
}
buf->st_ino = 0;
buf->st_size = pFile->nByte;
buf->st_mtime = pFile->timestamp;
buf->st_ctime = pFile->timestamp;
buf->st_atime = pFile->timestamp;
return 0;
}
/*
** This routine does an access() system call for a ZVFS file.
*/
int Tobe_FSAccessProc (Tcl_Obj *pathPtr, int mode) {
char *path=Tcl_GetString(pathPtr);
ZvfsFile *pFile;
if (mode & 3) {
return -1;
}
pFile = ZvfsLookup(path);
if (pFile == 0) {
return -1;
}
return 0;
}
Tcl_Obj* Tobe_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) {
return Tcl_NewStringObj("/",-1);;
}
/* Function to process a
* 'Tobe_FSMatchInDirectory()'. If not
* implemented, then glob and recursive
* copy functionality will be lacking in
* the filesystem. */
int Tobe_FSMatchInDirectoryProc (
Tcl_Interp* interp,
Tcl_Obj *result,
Tcl_Obj *pathPtr,
const char *pattern,
Tcl_GlobTypeData * types
) {
Tcl_HashEntry *pEntry;
Tcl_HashSearch sSearch;
int scnt=0, pathlen=0, patternlen=0, dirglob=0, fileglob=0, mntglob=0;
int nullpattern=(pattern == NULL || (*pattern=='\0'));
char *zPattern = NULL;
char *zp=NULL;
if(types && types->type) {
dirglob = (types->type&TCL_GLOB_TYPE_DIR);
fileglob = (types->type & TCL_GLOB_TYPE_FILE);
mntglob = (types->type&TCL_GLOB_TYPE_MOUNT);
}
if(!nullpattern) {
patternlen=strlen(pattern);
}
if(pathPtr) {
zp=Tcl_GetStringFromObj(pathPtr,&pathlen);
#ifdef __WIN32__
if (isalpha(zp[0]) && zp[1]==':') {
zp+=2;
}
#endif
}
if(mntglob) { return TCL_OK; }
if (mntglob) {
/* Look for a directory mount */
Tcl_HashEntry *pEntry; /* Hash table entry */
Tcl_HashSearch zSearch; /* Search all mount points */
ZvfsArchive *pArchive; /* The ZIP archive being mounted */
char mountpt[200];
int i=1;
mountpt[0]='/';
if(pathPtr) {
for(i=1;i<pathlen && i<200;i++) {
if(zp[i]=='/' || zp[i]=='\0') break;
mountpt[i]=zp[i];
}
}
mountpt[i]='\0';
for(
pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
pEntry;
pEntry=Tcl_NextHashEntry(&zSearch)
) {
pArchive = Tcl_GetHashValue(pEntry);
if (pArchive) {
char *z = pArchive->zMountPoint;
Tcl_Obj *pTail=NULL;
int match=0;
match=(strcmp(mountpt, z)==0);
if(!match) continue;
pTail=Tcl_NewStringObj(z, -1);
Tcl_ListObjAppendElement(interp, result, pTail);
//Tcl_DecrRefCount(pTail);
}
}
} else {
int idx=0;
if(!zp && nullpattern) {
zPattern=NULL;
} else {
Tcl_DString dTempPath;
Tcl_DStringInit(&dTempPath);
zPattern=(char*)Tcl_Alloc(pathlen+patternlen+3);
memset(zPattern,0,pathlen+patternlen+3);
if(zp) {
Tcl_DStringAppend(&dTempPath,zp,-1);
}
if (zp && !nullpattern) {
if (pathlen > 1 || zPattern[0] != '/') {
Tcl_DStringAppend(&dTempPath,"/",-1);
idx++;
}
}
if (!nullpattern) {
Tcl_DStringAppend(&dTempPath,pattern,patternlen);
}
zPattern=strdup(Tcl_DStringValue(&dTempPath));
Tcl_DStringFree(&dTempPath);
scnt = strchrcnt(zPattern, '/');
}
for (
pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch);
pEntry;
pEntry = Tcl_NextHashEntry(&sSearch)
){
ZvfsFile *pFile = Tcl_GetHashValue(pEntry);
if(pFile) {
char *z = pFile->zName;
Tcl_Obj *pTail=NULL;
int match=0;
if (dirglob && !pFile->isdir) continue;
if (fileglob && pFile->isdir) continue;
if(scnt != pFile->depth) continue;
match=Tcl_StringCaseMatch(z, zPattern, 0);
if(!match) continue;
pTail=Tcl_NewStringObj(z, -1);
Tcl_ListObjAppendElement(interp, result, pTail);
}
}
}
if (zPattern) {
free(zPattern);
}
return TCL_OK;
}
/* Function to check whether a path is in
* this filesystem. This is the most
* important filesystem procedure. */
int Tobe_FSPathInFilesystemProc (
Tcl_Obj *pathPtr,
ClientData *clientDataPtr
) {
ZvfsFile *zFile;
char *path = Tcl_GetString(pathPtr);
if (openarch) {
return -1;
}
zFile = ZvfsLookup(path);
if (zFile != NULL && strcmp(path, zFile->pArchive->zName)) {
return TCL_OK;
}
return -1;
}
Tcl_Obj *Tobe_FSListVolumesProc (void) {
Tcl_HashEntry *pEntry; /* Hash table entry */
Tcl_HashSearch zSearch; /* Search all mount points */
ZvfsArchive *pArchive; /* The ZIP archive being mounted */
Tcl_Obj *pVols=0, *pVol;
char mountpt[200];
pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
while (pEntry) {
pArchive = Tcl_GetHashValue(pEntry);
if (pArchive) {
if (!pVols) {
pVols=Tcl_NewListObj(0,0);
Tcl_IncrRefCount(pVols);
}
sprintf(mountpt, "zvfs:%s", pArchive->zMountPoint);
pVol=Tcl_NewStringObj(mountpt,-1);
Tcl_IncrRefCount(pVol);
Tcl_ListObjAppendElement(NULL, pVols,pVol);
/* Tcl_AppendResult(interp,pArchive->zMountPoint," ",pArchive->zName," ",0);*/
}
pEntry=Tcl_NextHashEntry(&zSearch);
}
return pVols;
}
int Tobe_FSChdirProc (Tcl_Obj *pathPtr) {
/* Someday, we should actually check if this is a valid path. */
return TCL_OK;
}
const char * const*
Tobe_FSFileAttrStringsProc(
Tcl_Obj *pathPtr,
Tcl_Obj** objPtrRef)
{
char *path = Tcl_GetString(pathPtr);
#ifdef __WIN32__
static const char *attrs[] = {
"uncompsize", "compsize", "offset", "mount", "archive","-archive", "-hidden", "-readonly", "-system", "-shortname", 0
};
#else
static const char *attrs[] = {
"uncompsize", "compsize", "offset", "mount", "archive","-group", "-owner", "-permissions", 0
};
#endif
if (ZvfsLookup(path) == 0) {
return NULL;
}
return attrs;
}
int Tobe_FSFileAttrsGetProc (
Tcl_Interp *interp,
int index,
Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef
) {
char *zFilename;
ZvfsFile *pFile;
zFilename = Tcl_GetString(pathPtr);
pFile = ZvfsLookup(zFilename);
if(!pFile)
return TCL_ERROR;
switch (index) {
case 0:
*objPtrRef=Tcl_NewIntObj(pFile->nByteCompr);
return TCL_OK;
case 1:
*objPtrRef= Tcl_NewIntObj(pFile->nByte);
return TCL_OK;
case 2:
*objPtrRef= Tcl_NewIntObj(pFile->nByte);
return TCL_OK;
case 3:
*objPtrRef= Tcl_NewStringObj(pFile->pArchive->zMountPoint,-1);
return TCL_OK;
case 4:
*objPtrRef= Tcl_NewStringObj(pFile->pArchive->zName,-1);
return TCL_OK;
#ifdef __WIN32__
case 5: /* -archive */
*objPtrRef = Tcl_NewStringObj("0", -1); break;
case 6: /* -hidden */
*objPtrRef = Tcl_NewStringObj("0", -1); break;
case 7: /* -readonly */
*objPtrRef = Tcl_NewStringObj("", -1); break;
case 8: /* -system */
*objPtrRef = Tcl_NewStringObj("", -1); break;
case 9: /* -shortname */
*objPtrRef = Tcl_NewStringObj("", -1);
#else
case 5: /* -group */
*objPtrRef = Tcl_NewStringObj("", -1); break;
case 6: /* -owner */
*objPtrRef = Tcl_NewStringObj("", -1); break;
case 7: /* -permissions */ {
char buf[32];
sprintf(buf, "%03o", pFile->permissions);
*objPtrRef = Tcl_NewStringObj(buf, -1); break;
}
#endif
default:
return TCL_ERROR;
}
return TCL_OK;
}
int Tobe_FSFileAttrsSetProc (
Tcl_Interp *interp,
int index,
Tcl_Obj *pathPtr,
Tcl_Obj *objPtr) { return TCL_ERROR; }
Tcl_Obj* Tobe_FSFilesystemPathTypeProc (Tcl_Obj *pathPtr) {
return Tcl_NewStringObj("zip",-1);
}
/****************************************************/
static Tcl_Filesystem Tobe_Filesystem = {
"zvfs", /* The name of the filesystem. */
sizeof(Tcl_Filesystem), /* Length of this structure, so future
* binary compatibility can be assured. */
TCL_FILESYSTEM_VERSION_1,
/* Version of the filesystem type. */
Tobe_FSPathInFilesystemProc,
/* Function to check whether a path is in
* this filesystem. This is the most
* important filesystem procedure. */
NULL,
/* Function to duplicate internal fs rep. May
* be NULL (but then fs is less efficient). */
NULL,
/* Function to free internal fs rep. Must
* be implemented, if internal representations
* need freeing, otherwise it can be NULL. */
NULL,
/* Function to convert internal representation
* to a normalized path. Only required if
* the fs creates pure path objects with no
* string/path representation. */
NULL,
/* Function to create a filesystem-specific
* internal representation. May be NULL
* if paths have no internal representation,
* or if the Tobe_FSPathInFilesystemProc
* for this filesystem always immediately
* creates an internal representation for
* paths it accepts. */
NULL,
/* Tobe_FSNormalizePathProc (Not needed)
* Function to normalize a path. Should
* be implemented for all filesystems
* which can have multiple string
* representations for the same path
* object. */
Tobe_FSFilesystemPathTypeProc,
/* Function to determine the type of a
* path in this filesystem. May be NULL. */
Tobe_FSFilesystemSeparatorProc,
/* Function to return the separator
* character(s) for this filesystem. Must
* be implemented. */
Tobe_FSStatProc,
/*
* Function to process a 'Tobe_FSStat()'
* call. Must be implemented for any
* reasonable filesystem.
*/
Tobe_FSAccessProc,
/*
* Function to process a 'Tobe_FSAccess()'
* call. Must be implemented for any
* reasonable filesystem.
*/
Tobe_FSOpenFileChannelProc,
/*
* Function to process a
* 'Tobe_FSOpenFileChannel()' call. Must be
* implemented for any reasonable
* filesystem.
*/
Tobe_FSMatchInDirectoryProc,
/* Function to process a
* 'Tobe_FSMatchInDirectory()'. If not
* implemented, then glob and recursive
* copy functionality will be lacking in
* the filesystem. */
NULL,
/* Function to process a
* 'Tobe_FSUtime()' call. Required to
* allow setting (not reading) of times
* with 'file mtime', 'file atime' and
* the open-r/open-w/fcopy implementation
* of 'file copy'. */
NULL,
/* Function to process a
* 'Tobe_FSLink()' call. Should be
* implemented only if the filesystem supports
* links. */
Tobe_FSListVolumesProc,
/* Function to list any filesystem volumes
* added by this filesystem. Should be
* implemented only if the filesystem adds
* volumes at the head of the filesystem. */
Tobe_FSFileAttrStringsProc,
/* Function to list all attributes strings
* which are valid for this filesystem.
* If not implemented the filesystem will
* not support the 'file attributes' command.
* This allows arbitrary additional information
* to be attached to files in the filesystem. */
Tobe_FSFileAttrsGetProc,
/* Function to process a
* 'Tobe_FSFileAttrsGet()' call, used by
* 'file attributes'. */
Tobe_FSFileAttrsSetProc,
/* Function to process a
* 'Tobe_FSFileAttrsSet()' call, used by
* 'file attributes'. */
NULL,
/* Function to process a
* 'Tobe_FSCreateDirectory()' call. Should
* be implemented unless the FS is
* read-only. */
NULL,
/* Function to process a
* 'Tobe_FSRemoveDirectory()' call. Should
* be implemented unless the FS is
* read-only. */
NULL,
/* Function to process a
* 'Tobe_FSDeleteFile()' call. Should
* be implemented unless the FS is
* read-only. */
NULL,
/* Function to process a
* 'Tobe_FSCopyFile()' call. If not
* implemented Tcl will fall back
* on open-r, open-w and fcopy as
* a copying mechanism. */
NULL,
/* Function to process a
* 'Tobe_FSRenameFile()' call. If not
* implemented, Tcl will fall back on
* a copy and delete mechanism. */
NULL,
/* Function to process a
* 'Tobe_FSCopyDirectory()' call. If
* not implemented, Tcl will fall back
* on a recursive create-dir, file copy
* mechanism. */
NULL,
/* Function to process a
* 'Tobe_FSLoadFile()' call. If not
* implemented, Tcl will fall back on
* a copy to native-temp followed by a
* Tobe_FSLoadFile on that temporary copy. */
NULL,
/* Function to unload a previously
* successfully loaded file. If load was
* implemented, then this should also be
* implemented, if there is any cleanup
* action required. */
NULL,
/*
* Function to process a 'Tobe_FSGetCwd()'
* call. Most filesystems need not
* implement this. It will usually only be
* called once, if 'getcwd' is called
* before 'chdir'. May be NULL.
*/
NULL,
/*
* Function to process a 'Tobe_FSChdir()'
* call. If filesystems do not implement
* this, it will be emulated by a series of
* directory access checks. Otherwise,
* virtual filesystems which do implement
* it need only respond with a positive
* return result if the dirName is a valid
* directory in their filesystem. They
* need not remember the result, since that
* will be automatically remembered for use
* by GetCwd. Real filesystems should
* carry out the correct action (i.e. call
* the correct system 'chdir' api). If not
* implemented, then 'cd' and 'pwd' will
* fail inside the filesystem.
*/
};
void (*Zvfs_PostInit)(Tcl_Interp *)=0;
int Zvfs_Common_Init(Tcl_Interp *interp) {
if( !local.isInit ){
/* One-time initialization of the ZVFS */
Tcl_FSRegister(0, &Tobe_Filesystem);
Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS);
Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS);
local.isInit = 1;
}
return TCL_OK;
}
int Zvfs_Init(Tcl_Interp *interp){
#ifdef USE_TCL_STUBS
if( Tcl_InitStubs(interp,"8.0",0)==0 ){
return TCL_ERROR;
}
#endif
Tcl_PkgProvide(interp, "zvfs", "1.0");
Zvfs_Common_Init(interp);
Tcl_CreateObjCommand(interp, "zvfs::mount", ZvfsMountObjCmd, 0, 0);
Tcl_CreateObjCommand(interp, "zvfs::unmount", ZvfsUnmountObjCmd, 0, 0);
Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0);
Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0);
Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0);
if (Zvfs_PostInit) Zvfs_PostInit(interp);
return TCL_OK;
}
int Zvfs_SafeInit(Tcl_Interp *interp){
#ifdef USE_TCL_STUBS
if( Tcl_InitStubs(interp,"8.0",0)==0 ){
return TCL_ERROR;
}
#endif
Zvfs_Common_Init(interp);
Tcl_PkgProvide(interp, "zvfs", "1.0");
Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0);
Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0);
Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0);
if (Zvfs_PostInit) Zvfs_PostInit(interp);
return TCL_OK;
}