TEA (tclconfig) Source Code

#endif
    unsigned long 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 {

    0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
    0x2d02ef8d,
};

const char *zipfs_literal_tcl_library=NULL;

/* Function prototypes */
int TclZipfs_Mount(Tcl_Interp *interp, const char *zipname, const char *mntpt,const char *passwd);
static int TclZipfs_AppHook_FindTclInit(const char *archive);
static int Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr);
static Tcl_Obj *Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
static Tcl_Obj *Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
static int Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
static int Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode);
static Tcl_Channel Zip_FSOpenFileChannelProc(

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

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) {
        TclZipfs_C_Init();
    }
    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) {
            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 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
            if ((zf = Tcl_GetHashValue(hPtr)) != NULL) {
                Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->mntpt, zf->mntptlen));
            }
#endif
        }
        Unlock();
        return TCL_OK;
    }
    Unlock();
    pwlen = 0;
    if (passwd != NULL) {

    }
    Tcl_DStringInit(&ds);
#if HAS_DRIVES
    realname = AbsolutePath(zipname, NULL, &ds);
#else
    realname = AbsolutePath(zipname, &ds);
#endif
    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */
    Tcl_DStringInit(&dsm);
    mntpt = CanonicalPath("",mntpt, &dsm, 1);

    WriteLock();
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, zipname, &isNew);
    if (!isNew) {
        zf = (ZipFile *) Tcl_GetHashValue(hPtr);
        if (interp != NULL) {
            Tcl_AppendResult(interp, "already mounted on \"", zf->mntptlen ?
                zf->mntpt : "/", "\"", (char *) NULL);
        }
        Unlock();
        ZipFSCloseArchive(interp, &zf0);
        return TCL_ERROR;
    }
    if (strcmp(mntpt, "/") == 0) {
        mntpt = "";
    }
    zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1);
    if (zf == NULL) {
        if (interp != NULL) {
            Tcl_AppendResult(interp, "out of memory", (char *) NULL);
        }
        Unlock();
        ZipFSCloseArchive(interp, &zf0);
        return TCL_ERROR;
        }
        *zf = zf0;
        zf->name = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
        strcpy(zf->mntpt, mntpt);
        zf->mntptlen = strlen(zf->mntpt);

        zf->entries = NULL;
        zf->topents = NULL;
        zf->nopen = 0;
        Tcl_SetHashValue(hPtr, (ClientData) zf);
        if ((zf->pwbuf[0] == 0) && pwlen) {
        int k = 0;
        i = pwlen;

 * Side effects:
 *      A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
{
    ZipFile *zf;
    ZipEntry *z, *znext;
    Tcl_HashEntry *hPtr;

    int ret = TCL_OK, unmounted = 0;

    WriteLock();
    if (!ZipFS.initialized) goto done;







    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, zipname);

    /* don't report error */
    if (hPtr == NULL) goto done;

    zf = (ZipFile *) Tcl_GetHashValue(hPtr);
    if (zf->nopen > 0) {
        ZIPFS_ERROR(interp,"filesystem is busy");

        }
        if (z->data != NULL) {
            Tcl_Free((char *) z->data);
        }
        Tcl_Free((char *) z);
    }
    ZipFSCloseArchive(interp, zf);

    Tcl_Free((char *) zf);
    unmounted = 1;
done:
    Unlock();
    if (unmounted) {
        Tcl_FSMountsChanged(NULL);
    }

        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;

static int TclZipfs_AppHook_FindTclInit(const char *archive){
    Tcl_Obj *vfsinitscript;
    int found;
    if(zipfs_literal_tcl_library) {
        return TCL_ERROR;
    }
    if(TclZipfs_Mount(NULL, archive, ZIPFS_ZIP_MOUNT, NULL)) {
        /* Either the file doesn't exist or it is not a zip archive */
        return TCL_ERROR;
    }
    vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/init.tcl",-1);
    Tcl_IncrRefCount(vfsinitscript);
    found=Tcl_FSAccess(vfsinitscript,F_OK);
    Tcl_DecrRefCount(vfsinitscript);

    Tcl_FindExecutable(*argv[0]);
    archive=(char *)Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);
    /*
    ** Look for init.tcl in one of the locations mounted later in this function
    */
    if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) {
        int found;
        Tcl_Obj *vfsinitscript;
        vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1);
        Tcl_IncrRefCount(vfsinitscript);
        if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
            /* Startup script should be set before calling Tcl_AppInit */
            Tcl_SetStartupScript(vfsinitscript,NULL);

            vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1);
            Tcl_IncrRefCount(vfsinitscript);
            if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
             Tcl_SetStartupScript(vfsinitscript,NULL);
            }
            return TCL_OK;
        } else {
            if(!TclZipfs_Mount(NULL, archive, ZIPFS_APP_MOUNT, NULL)) {
                int found;
                Tcl_Obj *vfsinitscript;
                vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1);
                Tcl_IncrRefCount(vfsinitscript);
                if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
                    /* Startup script should be set before calling Tcl_AppInit */
                    Tcl_SetStartupScript(vfsinitscript,NULL);

 *
 *    Dummy version when no ZLIB support available.
 *
 *-------------------------------------------------------------------------
 */

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

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

  Tcl_FindExecutable(*argv[0]);
  archive=Tcl_GetNameOfExecutable();
}
    # We have to initialize the virtual filesystem before calling
    # Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
    # its startup script files.
    if {![$PROJECT define get tip_430 0]} {





      ::practcl::cputs zvfsboot {  TclZipfs_Init(NULL);}
    }
    ::practcl::cputs zvfsboot "  if(!TclZipfs_Mount(NULL, archive, \"app\", NULL)) \x7B "
    ::practcl::cputs zvfsboot {
      Tcl_Obj *vfsinitscript;
      vfsinitscript=Tcl_NewStringObj("%vfs_main%",-1);
      Tcl_IncrRefCount(vfsinitscript);
      if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
        /* Startup script should be set before calling Tcl_AppInit */
        Tcl_SetStartupScript(vfsinitscript,NULL);