path: root/tclzvfs/zvfs.c

/*
 *  Smithsonian Astrophysical Observatory, Cambridge, MA, USA
 *  This code has been modified under the terms listed below and is made
 *  available under the same terms.
 */

/*
** 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:
**   drh@hwaci.com
**   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
**   peter@pdqi.com
**   http://pdqi.com
**
** @(#) $Id$
** 
**   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.
*/

#include <ctype.h>
#include <zlib.h>
#include <errno.h>
#include <string.h>
#include <sys/stat.h>
#include <time.h>
#include <stdlib.h>
/*#include <malloc.h>*/
#include "tcl.h"

/*
** Size of the decompression input buffer
*/
#define COMPR_BUF_SIZE   32768

/*
** 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 */
  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 */
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++; }
  if( zTail[0]=='\\' ){ zRoot = "/"; zTail++; }	// account for UNC style path
#endif
  if( zTail[0]=='/' ){ zRoot = ""; zTail++; }
  if( zTail[0]=='/' ){ zRoot = "/"; zTail++; }		// account for UNC style path
  zPath = Tcl_Alloc( strlen(zRoot) + strlen(zTail) + 2 );
  if( zPath==0 ) return 0;
  sprintf(zPath, "%s/%s", zRoot, zTail);
  for(i=j=0; (c = zPath[i])!=0; i++){
#ifdef __WIN32__
    if( isupper(c) ) { if (maptolower) 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++] = '/'; }
  zPath[j] = 0;
  return zPath;
}

/*
** Construct an absolute pathname in memory obtained from Tcl_Alloc
** that means the same file as the pathname given.
**
** Under windows, all backslash (\) charaters are converted to foward
** slash (/) and all upper case letters are converted to lower case.
** The drive letter (if present) is preserved.
*/
static char *AbsolutePath(const char *z)
{
  Tcl_DString pwd;
  char *zResult;
  Tcl_DStringInit(&pwd);
  if( *z!='/'
#ifdef __WIN32__
      && *z!='\\' && (!isalpha(*z) || z[1]!=':')
#endif
      ){
    /* Case 1:  "z" is a relative path.  So prepend the current working
    ** directory in order to generate an absolute path.  Note that the
    ** CanonicalPath() function takes care of converting upper to lower
    ** case and (\) to (/) under windows.
    */
    Tcl_GetCwd(0, &pwd);
    zResult = CanonicalPath( Tcl_DStringValue(&pwd), z);
    Tcl_DStringFree(&pwd);
  } else {
    /* Case 2:  "z" is an absolute path already.  We just need to make
    ** a copy of it.  Under windows, we need to convert upper to lower
    ** case and (\) into (/) on the copy.
    */
    zResult = Tcl_Alloc( strlen(z) + 1 );
    if( zResult==0 ) return 0;
    strcpy(zResult, z);
#ifdef __WIN32__
    {
      int i, c;
      for(i=0; (c=zResult[i])!=0; i++){
        if( isupper(c) ) {
	  // zResult[i] = tolower(c);
	}
        else if( c=='\\' ) zResult[i] = '/';
      }
    }
#endif
  }
  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 */
  int nFile;                 /* Number of files in the archive */
  long 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 */

  if( !local.isInit ) return TCL_ERROR;
  if (!zArchive) {
    pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
    while (pEntry) {
      if ((pArchive = Tcl_GetHashValue(pEntry))) {
        Tcl_AppendResult(interp,pArchive->zMountPoint," ",pArchive->zName," ",0);
      }
      pEntry=Tcl_NextHashEntry(&zSearch);
    }
    return TCL_OK;
  }
  if (!zMountPoint) {
    pEntry = Tcl_FindHashEntry(&local.archiveHash,AbsolutePath(zArchive));
    if (pEntry) {
      if ((pArchive = Tcl_GetHashValue(pEntry))) {
        Tcl_AppendResult(interp, pArchive->zMountPoint, 0);
      }
    }
    return TCL_OK;
  }

  chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0);
  if (!chan) {
    return TCL_ERROR;
  }
  if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){
    return TCL_ERROR;
  }
  if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) {
    return TCL_ERROR;
  }

  /* 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)) {
    Tcl_AppendResult(interp, "not a ZIP archive", NULL);
    return TCL_ERROR;
  }

  /* Construct the archive record
   */
  zArchiveName = AbsolutePath(zArchive);
  pEntry = Tcl_CreateHashEntry(&local.archiveHash, zArchiveName, &isNew);
  if( !isNew ){
    pArchive = Tcl_GetHashValue(pEntry);
    Tcl_AppendResult(interp, "already mounted at ", pArchive->zMountPoint, 0);
    Tcl_Free(zArchiveName);
    Tcl_Close(interp, chan);
    return TCL_ERROR;
  }
  pArchive = (ZvfsArchive*)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);

  while( nFile-- > 0 ){
    int lenName;            /* Length of the next filename */
    int lenExtra;           /* 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 */

    /* 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)) {
      Tcl_AppendResult(interp, "ill-formed central directory entry", NULL);
      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=1;
    }
    zName[lenName] = 0;
    zFullPath = CanonicalPath(zMountPoint, zName);
    pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) );
    pZvfs->zName = zFullPath;
    pZvfs->pArchive = pArchive;
    pZvfs->isdir = isdir;
    pZvfs->depth=strchrcnt(zFullPath,'/');
    pZvfs->iOffset = 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;
    pArchive->pFiles = pZvfs;
    pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullPath, &isNew);
    if( isNew ){
      pZvfs->pNextName = 0;
    }else{
      ZvfsFile *pOld = (ZvfsFile*)Tcl_GetHashValue(pEntry);
      pOld->pPrevName = pZvfs;
      pZvfs->pNextName = pOld;
    }
    pZvfs->pPrevName = 0;
    Tcl_SetHashValue(pEntry, (ClientData) pZvfs);

    /* 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);
  return TCL_OK;
}

/*
** 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;
}

static int ZvfsLookupMount(char *zFilename)
{
  char *zTrueName;
  Tcl_HashEntry *pEntry;     /* Hash table entry */
  Tcl_HashSearch zSearch;   /* Search all mount points */
  ZvfsArchive *pArchive;     /* The ZIP archive being mounted */
  int match=0;
  if( local.isInit==0 ) return 0;
  zTrueName = AbsolutePath(zFilename);
  pEntry=Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
  while (pEntry) {
    if ((pArchive = Tcl_GetHashValue(pEntry))) {
      if (!strcmp(pArchive->zMountPoint,zTrueName)) {
	match=1;
	break;
      }
    }
    pEntry=Tcl_NextHashEntry(&zSearch);
  }
  Tcl_Free(zTrueName);
  return match;
}


/*
** Unmount all the files in the given ZIP archive.
*/
static void 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;
  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 ){
        /* This should never happen */
      }else if( pFile->pNextName ){
        Tcl_SetHashValue(pEntry, pFile->pNextName);
      }else{
        Tcl_DeleteHashEntry(pEntry);
      }
    }
    Tcl_Free(pFile->zName);
    Tcl_Free((char*)pFile);
  }
}

/*
** 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.
*/
static int ZvfsMountCmd(ClientData clientData, Tcl_Interp *interp,
			int argc,CONST char *argv[])
{
  if( argc>3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		     " ? ZIP-FILE ? MOUNT-POINT ? ?\"", 0);
    return TCL_ERROR;
  }
  return Zvfs_Mount(interp, argc>1?argv[1]:0, argc>2?argv[2]:0);
}

/*
** zvfs::unmount  Zip-archive-name
**
** Undo the effects of zvfs::mount.
*/
static int ZvfsUnmountCmd(ClientData clientData, Tcl_Interp *interp,
			  int argc, CONST char *argv[])
{
  if( argc!=2 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		     " ZIP-FILE\"", 0);
    return TCL_ERROR;
  }
  Zvfs_Unmount(argv[1]);
  return TCL_OK;
}

/*
** zvfs::exists  filename
**
** Return TRUE if the given filename exists in the ZVFS and FALSE if
** it does not.
*/
static int ZvfsExistsObjCmd(void *NotUsed, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const* objv)
{
  char *zFilename;
  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "FILENAME");
    return TCL_ERROR;
  }
  zFilename = Tcl_GetStringFromObj(objv[1], 0);
  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.
*/
static int ZvfsInfoObjCmd(void *NotUsed, Tcl_Interp *interp,
			  int objc, Tcl_Obj *const* objv)
{
  char *zFilename;
  ZvfsFile *pFile;
  if( objc!=2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "FILENAME");
    return TCL_ERROR;
  }
  zFilename = Tcl_GetStringFromObj(objv[1], 0);
  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(void *NotUsed, Tcl_Interp *interp,
			  int objc, Tcl_Obj *const* objv)
{
  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_GetStringFromObj(objv[1], 0);
  }
  if( zPattern ){
    for(pEntry = Tcl_FirstHashEntry(&local.fileHash, &sSearch);
        pEntry;
        pEntry = Tcl_NextHashEntry(&sSearch)
	){
      ZvfsFile *pFile = (ZvfsFile *)Tcl_GetHashValue(pEntry);
      char *z = pFile->zName;
      if( Tcl_StringMatch(z, zPattern) ){
        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 = (ZvfsFile *)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 = (ZvfsFile *)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, Tcl_Interp *interp)
{
  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_Free((char*)pInfo);
  return TCL_OK;
}

static int vfsInput(ClientData instanceData, char *buf, int toRead,
		    int *pErrorCode)
{
  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, unsigned char *buf, int toRead,
		    int *pErrorCode)
{
  ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData;
  int len;

  if( (unsigned long)toRead > pInfo->nByte ){
    toRead = pInfo->nByte;
  }
  if( toRead == 0 ){
    return 0;
  }
  if (pInfo->isEncrypted) {
    /* 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);
      }

      }
    */
  }

  if( pInfo->isCompressed ){
    int err = Z_OK;
    z_stream *stream = &pInfo->stream;
    stream->next_out = 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);

	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;
	    }
	  */
	}

        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, (char*)buf, toRead);
    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;
	}
      */
    }
  }
  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, CONST char *buf, int toWrite,
		     int *pErrorCode)
{
  *pErrorCode = EINVAL;
  return -1;
}

static int vfsSeek(ClientData instanceData, long offset, int mode,
		   int *pErrorCode)
{
  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, int mask)
{
  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, int direction,
		      ClientData* handlePtr)
{
  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, char *zFilename,
				char *modeString, int permissions)
{
  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;
  chan = Tcl_OpenFileChannel(interp, pFile->pArchive->zName, "r", 0);
  if (local.firstMount == NULL)
    local.firstMount = pFile->pArchive->zName;
  if( chan==0 ){
    return 0;
  }
  if(  Tcl_SetChannelOption(interp, chan, "-translation", "binary")
       || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
       ){
    /* this should never happen */
    Tcl_Close(0, chan);
    return 0;
  }
  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);
    }
    Tcl_Close(interp, chan);
    return 0;
  }
  pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) );
  pInfo->chan = chan;
  Tcl_CreateExitHandler(vfsExit, pInfo);
  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);
      */
    }
  }
  pInfo->isCompressed = INT16(zBuf, 8);
  if (pInfo->isCompressed ){
    z_stream *stream = &pInfo->stream;
    pInfo->zBuf = (unsigned char*)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 = (unsigned char*)Tcl_Alloc(pInfo->nByte);
  /* Read and decompress the file contents */
  if (pInfo->uBuf) {
    pInfo->uBuf[0] = 0;
    vfsRead(pInfo, pInfo->uBuf, pInfo->nByte, &errCode);
    pInfo->readSoFar = 0;
  }

  return chan;
}

/*
** This routine does a stat() system call for a ZVFS file.
*/
static int ZvfsFileStat(char *path, Tcl_StatBuf *buf)
{
  ZvfsFile *pFile;

  pFile = ZvfsLookup(path);
  if( pFile==0 ){
    return -1;
  }
  memset(buf, 0, sizeof(Tcl_StatBuf));
  if (pFile->isdir)
    buf->st_mode = 040555;
  else
    buf->st_mode = 0100555;
  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.
*/
static int ZvfsFileAccess(char *path, int mode)
{
  ZvfsFile *pFile;

  if( mode & 3 ){
    return -1;
  }
  pFile = ZvfsLookup(path);
  if( pFile==0 ){
    return -1;
  }
  return 0; 
}

Tcl_Channel Tobe_FSOpenFileChannelProc _ANSI_ARGS_((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 _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf))
{
  int len;
  return ZvfsFileStat(Tcl_GetStringFromObj(pathPtr,&len), buf);
}

/*
** This routine does an access() system call for a ZVFS file.
*/
int Tobe_FSAccessProc _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode))
{
  int len;
  return ZvfsFileAccess(Tcl_GetStringFromObj(pathPtr,&len), mode);
}


/* Tcl_Obj* Tobe_FSFilesystemSeparatorProc
   _ANSI_ARGS_((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 _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData * types))
{
  Tcl_HashEntry *pEntry;
  Tcl_HashSearch sSearch;
  int scnt, len, l;
  char *zPattern, *z=Tcl_GetStringFromObj(pathPtr,&len);

  if (!pattern) return TCL_ERROR;
  l=strlen(pattern);
  if (!z)
    zPattern=strdup(pattern);
  else {
    zPattern=(char*)malloc(len+l+2);
    memcpy(zPattern,z,len);
    if (len > 1 || zPattern[0] != '/')
      {
        zPattern[len] = '/';
        ++len;
      }
    memcpy(zPattern+len,pattern,l+1);
  }
  scnt=strchrcnt(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, 0) && scnt==pFile->depth) {
      Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z, -1));
    }
  }
  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 _ANSI_ARGS_((Tcl_Obj *pathPtr, ClientData *clientDataPtr))
{
  int len;
  char *path; 
    
  path = Tcl_GetStringFromObj(pathPtr,&len);
  if (ZvfsLookup(path)!=0)
    return TCL_OK;
 
  return -1;
}

Tcl_Obj *Tobe_FSListVolumesProc _ANSI_ARGS_((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) {
    if ((pArchive = Tcl_GetHashValue(pEntry))) {
      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 _ANSI_ARGS_((Tcl_Obj *pathPtr))
{
  /* Someday, we should actually check if this is a valid path. */
  return TCL_OK;
}

static CONST char *TobeAttrs[] = { "uncompsize", "compsize", "offset", "mount", "archive", 0 };

CONST char* const *Tobe_FSFileAttrStringsProc _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef))
{
  return TobeAttrs;
}

int Tobe_FSFileAttrsGetProc _ANSI_ARGS_((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;
  default:
    return TCL_ERROR;
  }
  return TCL_OK;
}

int Tobe_FSFileAttrsSetProc _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr))
{
  return TCL_ERROR; 
}

Tcl_Obj* Tobe_FSFilesystemPathTypeProc _ANSI_ARGS_((Tcl_Obj *pathPtr))
{
  return Tcl_NewStringObj("zip",-1);
}
/****************************************************/

// At some point, some of the following might get implemented?

#define Tobe_FSFilesystemSeparatorProc 0
#define Tobe_FSLoadFileProc 0
#define Tobe_FSUnloadFileProc 0
#define Tobe_FSGetCwdProc 0
#define Tobe_FSGetCwdProc 0
#define Tobe_FSCreateDirectoryProc 0
#define Tobe_FSDeleteFileProc 0
#define Tobe_FSCopyDirectoryProc 0
#define Tobe_FSCopyFileProc 0
#define Tobe_FSRemoveDirectoryProc 0
#define Tobe_FSNormalizePathProc 0
#define Tobe_FSUtimeProc 0
#define Tobe_FSRenameFileProc 0
#define Tobe_FSCreateInternalRepProc 0
#define Tobe_FSInternalToNormalizedProc 0
#define Tobe_FSDupInternalRepProc 0
#define Tobe_FSFreeInternalRepProc 0
#define Tobe_FSLinkProc  0

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. */
  Tobe_FSDupInternalRepProc,
  /* Function to duplicate internal fs rep.  May
   * be NULL (but then fs is less efficient). */
  Tobe_FSFreeInternalRepProc,
  /* Function to free internal fs rep.  Must
   * be implemented, if internal representations
   * need freeing, otherwise it can be NULL. */
  Tobe_FSInternalToNormalizedProc,
  /* Function to convert internal representation
   * to a normalized path.  Only required if
   * the fs creates pure path objects with no
   * string/path representation. */
  Tobe_FSCreateInternalRepProc,
  /* 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. */
  Tobe_FSNormalizePathProc,
  /* 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. */
  Tobe_FSUtimeProc,
  /* 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'. */
  Tobe_FSLinkProc,
  /* 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'.  */
  Tobe_FSCreateDirectoryProc,
  /* Function to process a 
   * 'Tobe_FSCreateDirectory()' call. Should
   * be implemented unless the FS is
   * read-only. */
  Tobe_FSRemoveDirectoryProc,
  /* Function to process a 
   * 'Tobe_FSRemoveDirectory()' call. Should
   * be implemented unless the FS is
   * read-only. */
  Tobe_FSDeleteFileProc,
  /* Function to process a 
   * 'Tobe_FSDeleteFile()' call.  Should
   * be implemented unless the FS is
   * read-only. */
  Tobe_FSCopyFileProc,
  /* 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. */
  Tobe_FSRenameFileProc,
  /* Function to process a 
   * 'Tobe_FSRenameFile()' call.  If not
   * implemented, Tcl will fall back on
   * a copy and delete mechanism. */
  Tobe_FSCopyDirectoryProc,
  /* Function to process a 
   * 'Tobe_FSCopyDirectory()' call.  If
   * not implemented, Tcl will fall back
   * on a recursive create-dir, file copy
   * mechanism. */
  Tobe_FSLoadFileProc,
  /* 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. */
  Tobe_FSUnloadFileProc,
  /* 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. */
  Tobe_FSGetCwdProc,
  /* 
   * 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.
   */
  Tobe_FSChdirProc,
  /* 
   * 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;

/*
** Initialize the ZVFS system.
*/
int Zvfs_doInit(Tcl_Interp *interp, int safe)
{
  int n;

  if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL)
    return TCL_ERROR;

  if (!safe) {
    Tcl_CreateCommand(interp, "zvfs::mount", ZvfsMountCmd,
		      (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateCommand(interp, "zvfs::unmount", ZvfsUnmountCmd,
		      (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  }

  if (Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK)
    return TCL_ERROR;

  if( !local.isInit ){
    /* One-time initialization of the ZVFS */
    n = Tcl_FSRegister(0, &Tobe_Filesystem);
    Tcl_InitHashTable(&local.fileHash, TCL_STRING_KEYS);
    Tcl_InitHashTable(&local.archiveHash, TCL_STRING_KEYS);
    Tcl_CreateObjCommand(interp, "zvfs::exists", ZvfsExistsObjCmd, 0, 0);
    Tcl_CreateObjCommand(interp, "zvfs::info", ZvfsInfoObjCmd, 0, 0);
    Tcl_CreateObjCommand(interp, "zvfs::list", ZvfsListObjCmd, 0, 0);

    local.isInit = 1;
  }

  if (Zvfs_PostInit)
    Zvfs_PostInit(interp);

  return TCL_OK;
}

int Zvfs_Init(Tcl_Interp *interp){
  return Zvfs_doInit(interp,0);
}

int Zvfs_SafeInit(Tcl_Interp *interp){
  return Zvfs_doInit(interp,1);
}