Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | New version of practcl.tcl from tcllib.
New version of the tclZipfs.c file. Now an identical file is checked into set core itself. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | practcl |
Files: | files | file ages | folders |
SHA3-256: |
3785abe65886471e7fbb566d5b8d9613 |
User & Date: | hypnotoad 2018-01-16 23:27:26.805 |
Context
2018-01-17
| ||
00:22 | Separated the indexing of zip contents from the opening of the zip file stream check-in: af56cbe24a user: hypnotoad tags: practcl | |
2018-01-16
| ||
23:27 |
New version of practcl.tcl from tcllib.
New version of the tclZipfs.c file. Now an identical file is checked into set core itself. check-in: 3785abe658 user: hypnotoad tags: practcl | |
2018-01-11
| ||
19:38 | Updated practcl from tcllib check-in: f6a89ef414 user: hypnotoad tags: practcl | |
Changes
Changes to compat/tclZipfs.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * tclZipfs.c -- * * Implementation of the ZIP filesystem used in TIP 430 * Adapted from the implentation for AndroWish. * * Coptright (c) 2016-2017 Sean Woods <[email protected]> * Copyright (c) 2013-2015 Christian Werner <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | /* * tclZipfs.c -- * * Implementation of the ZIP filesystem used in TIP 430 * Adapted from the implentation for AndroWish. * * Coptright (c) 2016-2017 Sean Woods <[email protected]> * Copyright (c) 2013-2015 Christian Werner <[email protected]> * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * This file is distributed in two ways: * generic/tclZipfs.c file in the TIP430 enabled tcl cores * compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430 projects */ #include "tclInt.h" #include "tclFileSystem.h" #if !defined(_WIN32) && !defined(_WIN64) #include <sys/mman.h> |
︙ | ︙ | |||
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | #define MAP_FILE 0 #endif #ifdef HAVE_ZLIB #include "zlib.h" #include "crypt.h" /* ** Pre TIP430 style zipfs prefix ** //zipfs:/ doesn't work straight out of the box on either windows or Unix */ #define ZIPFS_VOLUME "zipfs:/" #define ZIPFS_VOLUME_LEN 7 #define ZIPFS_APP_MOUNT "zipfs:/app" #define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" /* * Various constants and offsets found in ZIP archive files */ #define ZIP_SIG_LEN 4 /* Local header of ZIP archive member (at very beginning of each member). */ | > > > > > > > > > > > > > | 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | #define MAP_FILE 0 #endif #ifdef HAVE_ZLIB #include "zlib.h" #include "crypt.h" #ifdef CFG_RUNTIME_DLLFILE /* ** We are compiling as part of the core. ** TIP430 style zipfs prefix */ #define ZIPFS_VOLUME "//zipfs:/" #define ZIPFS_VOLUME_LEN 9 #define ZIPFS_APP_MOUNT "//zipfs:/app" #define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl" #else /* ** We are compiling from the /compat folder of tclconfig ** Pre TIP430 style zipfs prefix ** //zipfs:/ doesn't work straight out of the box on either windows or Unix ** without other changes made to tip 430 */ #define ZIPFS_VOLUME "zipfs:/" #define ZIPFS_VOLUME_LEN 7 #define ZIPFS_APP_MOUNT "zipfs:/app" #define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl" #endif /* * Various constants and offsets found in ZIP archive files */ #define ZIP_SIG_LEN 4 /* Local header of ZIP archive member (at very beginning of each member). */ |
︙ | ︙ | |||
156 157 158 159 160 161 162 | typedef struct ZipFile { char *name; /* Archive name */ Tcl_Channel chan; /* Channel handle or NULL */ unsigned char *data; /* Memory mapped or malloc'ed file */ long length; /* Length of memory mapped file */ unsigned char *tofree; /* Non-NULL if malloc'ed file */ int nfiles; /* Number of files in archive */ | | | | | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | typedef struct ZipFile { char *name; /* Archive name */ Tcl_Channel chan; /* Channel handle or NULL */ unsigned char *data; /* Memory mapped or malloc'ed file */ long length; /* Length of memory mapped file */ unsigned char *tofree; /* Non-NULL if malloc'ed file */ int nfiles; /* Number of files in archive */ unsigned long baseoffs; /* Archive start */ long baseoffsp; /* Password start */ unsigned long centoffs; /* Archive directory start */ unsigned char pwbuf[264]; /* Password buffer */ #if defined(_WIN32) || defined(_WIN64) HANDLE mh; #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 */ |
︙ | ︙ | |||
250 251 252 253 254 255 256 | 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 }; /* * Table to compute CRC32. */ | | | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 }; /* * Table to compute CRC32. */ static const z_crc_t crc32tab[256] = { 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419, 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4, 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07, 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de, 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856, 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9, 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4, |
︙ | ︙ | |||
307 308 309 310 311 312 313 | 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8, 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, 0x2d02ef8d, }; const char *zipfs_literal_tcl_library=NULL; | > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 | 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8, 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( Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions ); static int Zip_FSMatchInDirectoryProc( Tcl_Interp* interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types ); static Tcl_Obj *Zip_FSListVolumesProc(void); static const char *const *Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef); static int Zip_FSFileAttrsGetProc( Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef ); static int Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr); static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); static void TclZipfs_C_Init(void); /* * Define the ZIP filesystem dispatch table. */ MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem; const Tcl_Filesystem zipfsFilesystem = { "zipfs", sizeof (Tcl_Filesystem), TCL_FILESYSTEM_VERSION_2, Zip_FSPathInFilesystemProc, NULL, /* dupInternalRepProc */ NULL, /* freeInternalRepProc */ NULL, /* internalToNormalizedProc */ NULL, /* createInternalRepProc */ NULL, /* normalizePathProc */ Zip_FSFilesystemPathTypeProc, Zip_FSFilesystemSeparatorProc, Zip_FSStatProc, Zip_FSAccessProc, Zip_FSOpenFileChannelProc, Zip_FSMatchInDirectoryProc, NULL, /* utimeProc */ NULL, /* linkProc */ Zip_FSListVolumesProc, Zip_FSFileAttrStringsProc, Zip_FSFileAttrsGetProc, Zip_FSFileAttrsSetProc, NULL, /* createDirectoryProc */ NULL, /* removeDirectoryProc */ NULL, /* deleteFileProc */ NULL, /* copyFileProc */ NULL, /* renameFileProc */ NULL, /* copyDirectoryProc */ NULL, /* lstatProc */ (Tcl_FSLoadFileProc *) Zip_FSLoadFile, NULL, /* getCwdProc */ NULL, /* chdirProc*/ }; /* *------------------------------------------------------------------------- * * ReadLock, WriteLock, Unlock -- * |
︙ | ︙ | |||
1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 | } return TCL_OK; error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; } /* *------------------------------------------------------------------------- * * TclZipfs_Mount -- * * This procedure is invoked to mount a given ZIP archive file on | > > > > > > > > > > > > > > > > > > > | 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 | } return TCL_OK; error: ZipFSCloseArchive(interp, zf); return TCL_ERROR; } static void TclZipfs_C_Init(void) { static const Tcl_Time t = { 0, 0 }; if (!ZipFS.initialized) { #ifdef TCL_THREADS /* * Inflate condition variable. */ Tcl_MutexLock(&ZipFSMutex); Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t); Tcl_MutexUnlock(&ZipFSMutex); #endif Tcl_FSRegister(NULL, &zipfsFilesystem); Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS); Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS); ZipFS.initialized = ZipFS.idCount = 1; } } /* *------------------------------------------------------------------------- * * TclZipfs_Mount -- * * This procedure is invoked to mount a given ZIP archive file on |
︙ | ︙ | |||
1080 1081 1082 1083 1084 1085 1086 | unsigned char *q; #if HAS_DRIVES int drive = 0; #endif ReadLock(); if (!ZipFS.initialized) { | < | < | 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 | 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); |
︙ | ︙ | |||
1715 1716 1717 1718 1719 1720 1721 | if (Tcl_Write(out, buf, len) != len) { wrerr: Tcl_AppendResult(interp, "write error", (char *) NULL); Tcl_Close(interp, in); return TCL_ERROR; } if ((len + pos[0]) & 3) { | | | | 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 | if (Tcl_Write(out, buf, len) != len) { wrerr: Tcl_AppendResult(interp, "write error", (char *) NULL); Tcl_Close(interp, in); return TCL_ERROR; } if ((len + pos[0]) & 3) { unsigned char abuf[8]; /* * Align payload to next 4-byte boundary using a dummy extra * entry similar to the zipalign tool from Android's SDK. */ align = 4 + ((len + pos[0]) & 3); zip_write_short(abuf, 0xffff); zip_write_short(abuf + 2, align - 4); zip_write_int(abuf + 4, 0x03020100); if (Tcl_Write(out, (const char *)abuf, align) != align) { goto wrerr; } } if (passwd != NULL) { int i, ch, tmp; unsigned char kvbuf[24]; Tcl_Obj *ret; |
︙ | ︙ | |||
2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 | Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } Unlock(); return TCL_OK; } /* *------------------------------------------------------------------------- * * ZipFSTclLibraryObjCmd -- * * This procedure is invoked to process the "zipfs::root" command. It * returns the root that all zipfs file systems are mounted under. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 | Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); } } Unlock(); return TCL_OK; } Tcl_Obj *TclZipfs_TclLibrary(void) { if(zipfs_literal_tcl_library) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } else { Tcl_Obj *vfsinitscript; int found=0; /* Look for the library file system within the executable */ vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1); Tcl_IncrRefCount(vfsinitscript); found=Tcl_FSAccess(vfsinitscript,F_OK); Tcl_DecrRefCount(vfsinitscript); if(found==TCL_OK) { zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library"; return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #if defined(_WIN32) || defined(_WIN64) HMODULE hModule = TclWinGetTclInstance(); WCHAR wName[MAX_PATH + LIBRARY_SIZE]; char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { GetModuleFileNameA(hModule, dllname, MAX_PATH); } else { ToUtf(wName, dllname); } /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #else #ifdef CFG_RUNTIME_DLLFILE /* Mount zip file and dll before releasing to search */ if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #endif #endif #ifdef CFG_RUNTIME_ZIPFILE if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } #endif } if(zipfs_literal_tcl_library) { return Tcl_NewStringObj(zipfs_literal_tcl_library,-1); } return NULL; } /* *------------------------------------------------------------------------- * * ZipFSTclLibraryObjCmd -- * * This procedure is invoked to process the "zipfs::root" command. It * returns the root that all zipfs file systems are mounted under. |
︙ | ︙ | |||
3927 3928 3929 3930 3931 3932 3933 | if (altPath != NULL) { Tcl_DecrRefCount(altPath); } return ret; #endif } | | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 | if (altPath != NULL) { Tcl_DecrRefCount(altPath); } return ret; #endif } #endif /* HAVE_ZLIB */ /* *------------------------------------------------------------------------- * * TclZipfs_Init -- * * Perform per interpreter initialization of this module. * |
︙ | ︙ | |||
3992 3993 3994 3995 3996 3997 3998 | */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp) { #ifdef HAVE_ZLIB /* one-time initialization */ | > | < < < < < < < < < < | < < < | 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 | */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp) { #ifdef HAVE_ZLIB /* one-time initialization */ WriteLock(); /* Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); */ if (!ZipFS.initialized) { TclZipfs_C_Init(); } Unlock(); if(interp != NULL) { static const EnsembleImplMap initMap[] = { {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, |
︙ | ︙ | |||
4121 4122 4123 4124 4125 4126 4127 | /* * Tclkit_MainHook -- * Performs the argument munging for the shell */ char *archive; Tcl_FindExecutable(*argv[0]); | | | 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 | /* * Tclkit_MainHook -- * Performs the argument munging for the shell */ char *archive; 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; |
︙ | ︙ | |||
4194 4195 4196 4197 4198 4199 4200 | } } } } return TCL_OK; } | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 | } } } } return TCL_OK; } #ifndef HAVE_ZLIB /* *------------------------------------------------------------------------- * |
︙ | ︙ |
Changes to practcl.tcl.
︙ | ︙ | |||
5450 5451 5452 5453 5454 5455 5456 | method clean {} { set builddir [file normalize [my define get builddir]] if {![file exists $builddir]} return if {[file exists [file join $builddir make.tcl]]} { ::practcl::domake.tcl $builddir clean } else { | | | 5450 5451 5452 5453 5454 5455 5456 5457 5458 5459 5460 5461 5462 5463 5464 | method clean {} { set builddir [file normalize [my define get builddir]] if {![file exists $builddir]} return if {[file exists [file join $builddir make.tcl]]} { ::practcl::domake.tcl $builddir clean } else { catch {::practcl::domake $builddir clean} } } method env-install {} { ### # Handle tea installs ### |
︙ | ︙ | |||
5824 5825 5826 5827 5828 5829 5830 | } method env-install {} { my unpack set os [::practcl::local_os] switch [my define get name] { tcl { | | | > | 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 5834 5835 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 | } method env-install {} { my unpack set os [::practcl::local_os] switch [my define get name] { tcl { set options [::practcl::platform::tcl_core_options [dict get $os TEACUP_OS]] } tk { set options [::practcl::platform::tk_core_options [dict get $os TEACUP_OS]] } default { set options {} } } set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix my define set config_opts $options puts [list [self] OS [dict get $os TEACUP_OS] options $options] my go my compile ::practcl::domake [my define get builddir] install } method go {} { set name [my define get name] |
︙ | ︙ |