diff options
38 files changed, 8121 insertions, 160 deletions
diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c index 4288962..b5c67cc 100644 --- a/compat/zlib/contrib/minizip/minizip.c +++ b/compat/zlib/contrib/minizip/minizip.c @@ -12,7 +12,6 @@ Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com ) */ - #if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__)) #ifndef __USE_FILE_OFFSET64 #define __USE_FILE_OFFSET64 @@ -39,8 +38,7 @@ #define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin) #endif - - +#include "tinydir.h" #include <stdio.h> #include <stdlib.h> #include <string.h> @@ -172,6 +170,7 @@ void do_banner() void do_help() { printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \ + " -r Scan directories recursively\n" \ " -o Overwrite existing file.zip\n" \ " -a Append to existing file.zip\n" \ " -0 Store only\n" \ @@ -243,12 +242,153 @@ int isLargeFile(const char* filename) return largeFile; } +void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { + FILE * fin; + int size_read; + const char *savefilenameinzip; + zip_fileinfo zi; + unsigned long crcFile=0; + int zip64 = 0; + int err=0; + int size_buf=WRITEBUFFERSIZE; + unsigned char buf[WRITEBUFFERSIZE]; + zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour = + zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0; + zi.dosDate = 0; + zi.internal_fa = 0; + zi.external_fa = 0; + filetime(filenameinzip,&zi.tmz_date,&zi.dosDate); + +/* + err = zipOpenNewFileInZip(zf,filenameinzip,&zi, + NULL,0,NULL,0,NULL / * comment * /, + (opt_compress_level != 0) ? Z_DEFLATED : 0, + opt_compress_level); +*/ + if ((password != NULL) && (err==ZIP_OK)) + err = getFileCrc(filenameinzip,buf,size_buf,&crcFile); + + zip64 = isLargeFile(filenameinzip); + + /* The path name saved, should not include a leading slash. */ + /*if it did, windows/xp and dynazip couldn't read the zip file. */ + savefilenameinzip = filenameinzip; + while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' ) + { + savefilenameinzip++; + } + + /*should the zip file contain any path at all?*/ + if( opt_exclude_path ) + { + const char *tmpptr; + const char *lastslash = 0; + for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++) + { + if( *tmpptr == '\\' || *tmpptr == '/') + { + lastslash = tmpptr; + } + } + if( lastslash != NULL ) + { + savefilenameinzip = lastslash+1; // base filename follows last slash. + } + } + + /**/ + err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi, + NULL,0,NULL,0,NULL /* comment*/, + (opt_compress_level != 0) ? Z_DEFLATED : 0, + opt_compress_level,0, + /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */ + -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, + password,crcFile, zip64); + + if (err != ZIP_OK) + printf("error in opening %s in zipfile\n",filenameinzip); + else + { + fin = FOPEN_FUNC(filenameinzip,"rb"); + if (fin==NULL) + { + err=ZIP_ERRNO; + printf("error in opening %s for reading\n",filenameinzip); + } + } + + if (err == ZIP_OK) + do + { + err = ZIP_OK; + size_read = (int)fread(buf,1,size_buf,fin); + if (size_read < size_buf) + if (feof(fin)==0) + { + printf("error in reading %s\n",filenameinzip); + err = ZIP_ERRNO; + } + + if (size_read>0) + { + err = zipWriteInFileInZip (zf,buf,size_read); + if (err<0) + { + printf("error in writing %s in the zipfile\n", + filenameinzip); + } + + } + } while ((err == ZIP_OK) && (size_read>0)); + + if (fin) + fclose(fin); + + if (err<0) + err=ZIP_ERRNO; + else + { + err = zipCloseFileInZip(zf); + if (err!=ZIP_OK) + printf("error in closing %s in the zipfile\n", + filenameinzip); + } +} + + +void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { + tinydir_dir dir; + int i; + char *newname[512]; + + tinydir_open_sorted(&dir, filenameinzip); + + for (i = 0; i < dir.n_files; i++) + { + tinydir_file file; + tinydir_readfile_n(&dir, &file, i); + if(strcmp(file.name,".")==0) continue; + if(strcmp(file.name,"..")==0) continue; + sprintf(newname,"%s/%s",dir.path,file.name); + if (file.is_dir) + { + addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level); + } else { + addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level); + } + } + + tinydir_close(&dir); +} + + int main(argc,argv) int argc; char *argv[]; { int i; - int opt_overwrite=0; + int opt_recursive=0; + int opt_overwrite=1; int opt_compress_level=Z_DEFAULT_COMPRESSION; int opt_exclude_path=0; int zipfilenamearg = 0; @@ -285,7 +425,8 @@ int main(argc,argv) opt_compress_level = c-'0'; if ((c=='j') || (c=='J')) opt_exclude_path = 1; - + if ((c=='r') || (c=='R')) + opt_recursive = 1; if (((c=='p') || (c=='P')) && (i+1<argc)) { password=argv[i+1]; @@ -392,117 +533,14 @@ int main(argc,argv) ((argv[i][1]=='o') || (argv[i][1]=='O') || (argv[i][1]=='a') || (argv[i][1]=='A') || (argv[i][1]=='p') || (argv[i][1]=='P') || + (argv[i][1]=='r') || (argv[i][1]=='R') || ((argv[i][1]>='0') || (argv[i][1]<='9'))) && (strlen(argv[i]) == 2))) { - FILE * fin; - int size_read; - const char* filenameinzip = argv[i]; - const char *savefilenameinzip; - zip_fileinfo zi; - unsigned long crcFile=0; - int zip64 = 0; - - zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour = - zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0; - zi.dosDate = 0; - zi.internal_fa = 0; - zi.external_fa = 0; - filetime(filenameinzip,&zi.tmz_date,&zi.dosDate); - -/* - err = zipOpenNewFileInZip(zf,filenameinzip,&zi, - NULL,0,NULL,0,NULL / * comment * /, - (opt_compress_level != 0) ? Z_DEFLATED : 0, - opt_compress_level); -*/ - if ((password != NULL) && (err==ZIP_OK)) - err = getFileCrc(filenameinzip,buf,size_buf,&crcFile); - - zip64 = isLargeFile(filenameinzip); - - /* The path name saved, should not include a leading slash. */ - /*if it did, windows/xp and dynazip couldn't read the zip file. */ - savefilenameinzip = filenameinzip; - while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' ) - { - savefilenameinzip++; - } - - /*should the zip file contain any path at all?*/ - if( opt_exclude_path ) - { - const char *tmpptr; - const char *lastslash = 0; - for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++) - { - if( *tmpptr == '\\' || *tmpptr == '/') - { - lastslash = tmpptr; - } - } - if( lastslash != NULL ) - { - savefilenameinzip = lastslash+1; // base filename follows last slash. - } - } - - /**/ - err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi, - NULL,0,NULL,0,NULL /* comment*/, - (opt_compress_level != 0) ? Z_DEFLATED : 0, - opt_compress_level,0, - /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */ - -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, - password,crcFile, zip64); - - if (err != ZIP_OK) - printf("error in opening %s in zipfile\n",filenameinzip); - else - { - fin = FOPEN_FUNC(filenameinzip,"rb"); - if (fin==NULL) - { - err=ZIP_ERRNO; - printf("error in opening %s for reading\n",filenameinzip); - } - } - - if (err == ZIP_OK) - do - { - err = ZIP_OK; - size_read = (int)fread(buf,1,size_buf,fin); - if (size_read < size_buf) - if (feof(fin)==0) - { - printf("error in reading %s\n",filenameinzip); - err = ZIP_ERRNO; - } - - if (size_read>0) - { - err = zipWriteInFileInZip (zf,buf,size_read); - if (err<0) - { - printf("error in writing %s in the zipfile\n", - filenameinzip); - } - - } - } while ((err == ZIP_OK) && (size_read>0)); - - if (fin) - fclose(fin); - - if (err<0) - err=ZIP_ERRNO; - else - { - err = zipCloseFileInZip(zf); - if (err!=ZIP_OK) - printf("error in closing %s in the zipfile\n", - filenameinzip); + if(opt_recursive) { + addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level); + } else { + addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level); } } } diff --git a/compat/zlib/contrib/minizip/tinydir.h b/compat/zlib/contrib/minizip/tinydir.h new file mode 100755 index 0000000..eb34399 --- /dev/null +++ b/compat/zlib/contrib/minizip/tinydir.h @@ -0,0 +1,816 @@ +/* +Copyright (c) 2013-2017, tinydir authors: +- Cong Xu +- Lautis Sun +- Baudouin Feildel +- Andargor <andargor@yahoo.com> +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*/ +#ifndef TINYDIR_H +#define TINYDIR_H + +#ifdef __cplusplus +extern "C" { +#endif + +#if ((defined _UNICODE) && !(defined UNICODE)) +#define UNICODE +#endif + +#if ((defined UNICODE) && !(defined _UNICODE)) +#define _UNICODE +#endif + +#include <errno.h> +#include <stdlib.h> +#include <string.h> +#ifdef _MSC_VER +# define WIN32_LEAN_AND_MEAN +# include <windows.h> +# include <tchar.h> +# pragma warning(push) +# pragma warning (disable : 4996) +#else +# include <dirent.h> +# include <libgen.h> +# include <sys/stat.h> +# include <stddef.h> +#endif +#ifdef __MINGW32__ +# include <tchar.h> +#endif + + +/* types */ + +/* Windows UNICODE wide character support */ +#if defined _MSC_VER || defined __MINGW32__ +# define _tinydir_char_t TCHAR +# define TINYDIR_STRING(s) _TEXT(s) +# define _tinydir_strlen _tcslen +# define _tinydir_strcpy _tcscpy +# define _tinydir_strcat _tcscat +# define _tinydir_strcmp _tcscmp +# define _tinydir_strrchr _tcsrchr +# define _tinydir_strncmp _tcsncmp +#else +# define _tinydir_char_t char +# define TINYDIR_STRING(s) s +# define _tinydir_strlen strlen +# define _tinydir_strcpy strcpy +# define _tinydir_strcat strcat +# define _tinydir_strcmp strcmp +# define _tinydir_strrchr strrchr +# define _tinydir_strncmp strncmp +#endif + +#if (defined _MSC_VER || defined __MINGW32__) +# include <windows.h> +# define _TINYDIR_PATH_MAX MAX_PATH +#elif defined __linux__ +# include <limits.h> +# define _TINYDIR_PATH_MAX PATH_MAX +#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__)) +# include <sys/param.h> +# if defined(BSD) +# include <limits.h> +# define _TINYDIR_PATH_MAX PATH_MAX +# endif +#endif + +#ifndef _TINYDIR_PATH_MAX +#define _TINYDIR_PATH_MAX 4096 +#endif + +#ifdef _MSC_VER +/* extra chars for the "\\*" mask */ +# define _TINYDIR_PATH_EXTRA 2 +#else +# define _TINYDIR_PATH_EXTRA 0 +#endif + +#define _TINYDIR_FILENAME_MAX 256 + +#if (defined _MSC_VER || defined __MINGW32__) +#define _TINYDIR_DRIVE_MAX 3 +#endif + +#ifdef _MSC_VER +# define _TINYDIR_FUNC static __inline +#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L +# define _TINYDIR_FUNC static __inline__ +#else +# define _TINYDIR_FUNC static inline +#endif + +/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */ +#ifdef TINYDIR_USE_READDIR_R + +/* readdir_r is a POSIX-only function, and may not be available under various + * environments/settings, e.g. MinGW. Use readdir fallback */ +#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\ + _POSIX_SOURCE +# define _TINYDIR_HAS_READDIR_R +#endif +#if _POSIX_C_SOURCE >= 200112L +# define _TINYDIR_HAS_FPATHCONF +# include <unistd.h> +#endif +#if _BSD_SOURCE || _SVID_SOURCE || \ + (_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700) +# define _TINYDIR_HAS_DIRFD +# include <sys/types.h> +#endif +#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\ + defined _PC_NAME_MAX +# define _TINYDIR_USE_FPATHCONF +#endif +#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\ + !(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX) +# define _TINYDIR_USE_READDIR +#endif + +/* Use readdir by default */ +#else +# define _TINYDIR_USE_READDIR +#endif + +/* MINGW32 has two versions of dirent, ASCII and UNICODE*/ +#ifndef _MSC_VER +#if (defined __MINGW32__) && (defined _UNICODE) +#define _TINYDIR_DIR _WDIR +#define _tinydir_dirent _wdirent +#define _tinydir_opendir _wopendir +#define _tinydir_readdir _wreaddir +#define _tinydir_closedir _wclosedir +#else +#define _TINYDIR_DIR DIR +#define _tinydir_dirent dirent +#define _tinydir_opendir opendir +#define _tinydir_readdir readdir +#define _tinydir_closedir closedir +#endif +#endif + +/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */ +#if defined(_TINYDIR_MALLOC) && defined(_TINYDIR_FREE) +#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE) +#else +#error "Either define both alloc and free or none of them!" +#endif + +#if !defined(_TINYDIR_MALLOC) + #define _TINYDIR_MALLOC(_size) malloc(_size) + #define _TINYDIR_FREE(_ptr) free(_ptr) +#endif /* !defined(_TINYDIR_MALLOC) */ + +typedef struct tinydir_file +{ + _tinydir_char_t path[_TINYDIR_PATH_MAX]; + _tinydir_char_t name[_TINYDIR_FILENAME_MAX]; + _tinydir_char_t *extension; + int is_dir; + int is_reg; + +#ifndef _MSC_VER +#ifdef __MINGW32__ + struct _stat _s; +#else + struct stat _s; +#endif +#endif +} tinydir_file; + +typedef struct tinydir_dir +{ + _tinydir_char_t path[_TINYDIR_PATH_MAX]; + int has_next; + size_t n_files; + + tinydir_file *_files; +#ifdef _MSC_VER + HANDLE _h; + WIN32_FIND_DATA _f; +#else + _TINYDIR_DIR *_d; + struct _tinydir_dirent *_e; +#ifndef _TINYDIR_USE_READDIR + struct _tinydir_dirent *_ep; +#endif +#endif +} tinydir_dir; + + +/* declarations */ + +_TINYDIR_FUNC +int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path); +_TINYDIR_FUNC +int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path); +_TINYDIR_FUNC +void tinydir_close(tinydir_dir *dir); + +_TINYDIR_FUNC +int tinydir_next(tinydir_dir *dir); +_TINYDIR_FUNC +int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file); +_TINYDIR_FUNC +int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i); +_TINYDIR_FUNC +int tinydir_open_subdir_n(tinydir_dir *dir, size_t i); + +_TINYDIR_FUNC +int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path); +_TINYDIR_FUNC +void _tinydir_get_ext(tinydir_file *file); +_TINYDIR_FUNC +int _tinydir_file_cmp(const void *a, const void *b); +#ifndef _MSC_VER +#ifndef _TINYDIR_USE_READDIR +_TINYDIR_FUNC +size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp); +#endif +#endif + + +/* definitions*/ + +_TINYDIR_FUNC +int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path) +{ +#ifndef _MSC_VER +#ifndef _TINYDIR_USE_READDIR + int error; + int size; /* using int size */ +#endif +#else + _tinydir_char_t path_buf[_TINYDIR_PATH_MAX]; +#endif + _tinydir_char_t *pathp; + + if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0) + { + errno = EINVAL; + return -1; + } + if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) + { + errno = ENAMETOOLONG; + return -1; + } + + /* initialise dir */ + dir->_files = NULL; +#ifdef _MSC_VER + dir->_h = INVALID_HANDLE_VALUE; +#else + dir->_d = NULL; +#ifndef _TINYDIR_USE_READDIR + dir->_ep = NULL; +#endif +#endif + tinydir_close(dir); + + _tinydir_strcpy(dir->path, path); + /* Remove trailing slashes */ + pathp = &dir->path[_tinydir_strlen(dir->path) - 1]; + while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/'))) + { + *pathp = TINYDIR_STRING('\0'); + pathp++; + } +#ifdef _MSC_VER + _tinydir_strcpy(path_buf, dir->path); + _tinydir_strcat(path_buf, TINYDIR_STRING("\\*")); +#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP) + dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0); +#else + dir->_h = FindFirstFile(path_buf, &dir->_f); +#endif + if (dir->_h == INVALID_HANDLE_VALUE) + { + errno = ENOENT; +#else + dir->_d = _tinydir_opendir(path); + if (dir->_d == NULL) + { +#endif + goto bail; + } + + /* read first file */ + dir->has_next = 1; +#ifndef _MSC_VER +#ifdef _TINYDIR_USE_READDIR + dir->_e = _tinydir_readdir(dir->_d); +#else + /* allocate dirent buffer for readdir_r */ + size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */ + if (size == -1) return -1; + dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size); + if (dir->_ep == NULL) return -1; + + error = readdir_r(dir->_d, dir->_ep, &dir->_e); + if (error != 0) return -1; +#endif + if (dir->_e == NULL) + { + dir->has_next = 0; + } +#endif + + return 0; + +bail: + tinydir_close(dir); + return -1; +} + +_TINYDIR_FUNC +int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path) +{ + /* Count the number of files first, to pre-allocate the files array */ + size_t n_files = 0; + if (tinydir_open(dir, path) == -1) + { + return -1; + } + while (dir->has_next) + { + n_files++; + if (tinydir_next(dir) == -1) + { + goto bail; + } + } + tinydir_close(dir); + + if (tinydir_open(dir, path) == -1) + { + return -1; + } + + dir->n_files = 0; + dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files); + if (dir->_files == NULL) + { + goto bail; + } + while (dir->has_next) + { + tinydir_file *p_file; + dir->n_files++; + + p_file = &dir->_files[dir->n_files - 1]; + if (tinydir_readfile(dir, p_file) == -1) + { + goto bail; + } + + if (tinydir_next(dir) == -1) + { + goto bail; + } + + /* Just in case the number of files has changed between the first and + second reads, terminate without writing into unallocated memory */ + if (dir->n_files == n_files) + { + break; + } + } + + qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp); + + return 0; + +bail: + tinydir_close(dir); + return -1; +} + +_TINYDIR_FUNC +void tinydir_close(tinydir_dir *dir) +{ + if (dir == NULL) + { + return; + } + + memset(dir->path, 0, sizeof(dir->path)); + dir->has_next = 0; + dir->n_files = 0; + _TINYDIR_FREE(dir->_files); + dir->_files = NULL; +#ifdef _MSC_VER + if (dir->_h != INVALID_HANDLE_VALUE) + { + FindClose(dir->_h); + } + dir->_h = INVALID_HANDLE_VALUE; +#else + if (dir->_d) + { + _tinydir_closedir(dir->_d); + } + dir->_d = NULL; + dir->_e = NULL; +#ifndef _TINYDIR_USE_READDIR + _TINYDIR_FREE(dir->_ep); + dir->_ep = NULL; +#endif +#endif +} + +_TINYDIR_FUNC +int tinydir_next(tinydir_dir *dir) +{ + if (dir == NULL) + { + errno = EINVAL; + return -1; + } + if (!dir->has_next) + { + errno = ENOENT; + return -1; + } + +#ifdef _MSC_VER + if (FindNextFile(dir->_h, &dir->_f) == 0) +#else +#ifdef _TINYDIR_USE_READDIR + dir->_e = _tinydir_readdir(dir->_d); +#else + if (dir->_ep == NULL) + { + return -1; + } + if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0) + { + return -1; + } +#endif + if (dir->_e == NULL) +#endif + { + dir->has_next = 0; +#ifdef _MSC_VER + if (GetLastError() != ERROR_SUCCESS && + GetLastError() != ERROR_NO_MORE_FILES) + { + tinydir_close(dir); + errno = EIO; + return -1; + } +#endif + } + + return 0; +} + +_TINYDIR_FUNC +int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file) +{ + if (dir == NULL || file == NULL) + { + errno = EINVAL; + return -1; + } +#ifdef _MSC_VER + if (dir->_h == INVALID_HANDLE_VALUE) +#else + if (dir->_e == NULL) +#endif + { + errno = ENOENT; + return -1; + } + if (_tinydir_strlen(dir->path) + + _tinydir_strlen( +#ifdef _MSC_VER + dir->_f.cFileName +#else + dir->_e->d_name +#endif + ) + 1 + _TINYDIR_PATH_EXTRA >= + _TINYDIR_PATH_MAX) + { + /* the path for the file will be too long */ + errno = ENAMETOOLONG; + return -1; + } + if (_tinydir_strlen( +#ifdef _MSC_VER + dir->_f.cFileName +#else + dir->_e->d_name +#endif + ) >= _TINYDIR_FILENAME_MAX) + { + errno = ENAMETOOLONG; + return -1; + } + + _tinydir_strcpy(file->path, dir->path); + _tinydir_strcat(file->path, TINYDIR_STRING("/")); + _tinydir_strcpy(file->name, +#ifdef _MSC_VER + dir->_f.cFileName +#else + dir->_e->d_name +#endif + ); + _tinydir_strcat(file->path, file->name); +#ifndef _MSC_VER +#ifdef __MINGW32__ + if (_tstat( +#else + if (stat( +#endif + file->path, &file->_s) == -1) + { + return -1; + } +#endif + _tinydir_get_ext(file); + + file->is_dir = +#ifdef _MSC_VER + !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY); +#else + S_ISDIR(file->_s.st_mode); +#endif + file->is_reg = +#ifdef _MSC_VER + !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) || + ( + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) && + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) && + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) && +#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) && +#endif +#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) && +#endif + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) && + !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY)); +#else + S_ISREG(file->_s.st_mode); +#endif + + return 0; +} + +_TINYDIR_FUNC +int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i) +{ + if (dir == NULL || file == NULL) + { + errno = EINVAL; + return -1; + } + if (i >= dir->n_files) + { + errno = ENOENT; + return -1; + } + + memcpy(file, &dir->_files[i], sizeof(tinydir_file)); + _tinydir_get_ext(file); + + return 0; +} + +_TINYDIR_FUNC +int tinydir_open_subdir_n(tinydir_dir *dir, size_t i) +{ + _tinydir_char_t path[_TINYDIR_PATH_MAX]; + if (dir == NULL) + { + errno = EINVAL; + return -1; + } + if (i >= dir->n_files || !dir->_files[i].is_dir) + { + errno = ENOENT; + return -1; + } + + _tinydir_strcpy(path, dir->_files[i].path); + tinydir_close(dir); + if (tinydir_open_sorted(dir, path) == -1) + { + return -1; + } + + return 0; +} + +/* Open a single file given its path */ +_TINYDIR_FUNC +int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path) +{ + tinydir_dir dir; + int result = 0; + int found = 0; + _tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX]; + _tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX]; + _tinydir_char_t *dir_name; + _tinydir_char_t *base_name; +#if (defined _MSC_VER || defined __MINGW32__) + _tinydir_char_t drive_buf[_TINYDIR_PATH_MAX]; + _tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX]; +#endif + + if (file == NULL || path == NULL || _tinydir_strlen(path) == 0) + { + errno = EINVAL; + return -1; + } + if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX) + { + errno = ENAMETOOLONG; + return -1; + } + + /* Get the parent path */ +#if (defined _MSC_VER || defined __MINGW32__) +#if ((defined _MSC_VER) && (_MSC_VER >= 1400)) + _tsplitpath_s( + path, + drive_buf, _TINYDIR_DRIVE_MAX, + dir_name_buf, _TINYDIR_FILENAME_MAX, + file_name_buf, _TINYDIR_FILENAME_MAX, + ext_buf, _TINYDIR_FILENAME_MAX); +#else + _tsplitpath( + path, + drive_buf, + dir_name_buf, + file_name_buf, + ext_buf); +#endif + +/* _splitpath_s not work fine with only filename and widechar support */ +#ifdef _UNICODE + if (drive_buf[0] == L'\xFEFE') + drive_buf[0] = '\0'; + if (dir_name_buf[0] == L'\xFEFE') + dir_name_buf[0] = '\0'; +#endif + + if (errno) + { + errno = EINVAL; + return -1; + } + /* Emulate the behavior of dirname by returning "." for dir name if it's + empty */ + if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0') + { + _tinydir_strcpy(dir_name_buf, TINYDIR_STRING(".")); + } + /* Concatenate the drive letter and dir name to form full dir name */ + _tinydir_strcat(drive_buf, dir_name_buf); + dir_name = drive_buf; + /* Concatenate the file name and extension to form base name */ + _tinydir_strcat(file_name_buf, ext_buf); + base_name = file_name_buf; +#else + _tinydir_strcpy(dir_name_buf, path); + dir_name = dirname(dir_name_buf); + _tinydir_strcpy(file_name_buf, path); + base_name =basename(file_name_buf); +#endif + + /* Open the parent directory */ + if (tinydir_open(&dir, dir_name) == -1) + { + return -1; + } + + /* Read through the parent directory and look for the file */ + while (dir.has_next) + { + if (tinydir_readfile(&dir, file) == -1) + { + result = -1; + goto bail; + } + if (_tinydir_strcmp(file->name, base_name) == 0) + { + /* File found */ + found = 1; + break; + } + tinydir_next(&dir); + } + if (!found) + { + result = -1; + errno = ENOENT; + } + +bail: + tinydir_close(&dir); + return result; +} + +_TINYDIR_FUNC +void _tinydir_get_ext(tinydir_file *file) +{ + _tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.')); + if (period == NULL) + { + file->extension = &(file->name[_tinydir_strlen(file->name)]); + } + else + { + file->extension = period + 1; + } +} + +_TINYDIR_FUNC +int _tinydir_file_cmp(const void *a, const void *b) +{ + const tinydir_file *fa = (const tinydir_file *)a; + const tinydir_file *fb = (const tinydir_file *)b; + if (fa->is_dir != fb->is_dir) + { + return -(fa->is_dir - fb->is_dir); + } + return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX); +} + +#ifndef _MSC_VER +#ifndef _TINYDIR_USE_READDIR +/* +The following authored by Ben Hutchings <ben@decadent.org.uk> +from https://womble.decadent.org.uk/readdir_r-advisory.html +*/ +/* Calculate the required buffer size (in bytes) for directory * +* entries read from the given directory handle. Return -1 if this * +* this cannot be done. * +* * +* This code does not trust values of NAME_MAX that are less than * +* 255, since some systems (including at least HP-UX) incorrectly * +* define it to be a smaller value. */ +_TINYDIR_FUNC +size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp) +{ + long name_max; + size_t name_end; + /* parameter may be unused */ + (void)dirp; + +#if defined _TINYDIR_USE_FPATHCONF + name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX); + if (name_max == -1) +#if defined(NAME_MAX) + name_max = (NAME_MAX > 255) ? NAME_MAX : 255; +#else + return (size_t)(-1); +#endif +#elif defined(NAME_MAX) + name_max = (NAME_MAX > 255) ? NAME_MAX : 255; +#else +#error "buffer size for readdir_r cannot be determined" +#endif + name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1; + return (name_end > sizeof(struct _tinydir_dirent) ? + name_end : sizeof(struct _tinydir_dirent)); +} +#endif +#endif + +#ifdef __cplusplus +} +#endif + +# if defined (_MSC_VER) +# pragma warning(pop) +# endif + +#endif diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib Binary files differindex a3e9a39..a3e9a39 100755..100644 --- a/compat/zlib/win32/zdll.lib +++ b/compat/zlib/win32/zdll.lib diff --git a/doc/tclsh.1 b/doc/tclsh.1 index 0e59b4f..c37eb81 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -143,6 +143,15 @@ incomplete commands. .SH "STANDARD CHANNELS" .PP See \fBTcl_StandardChannels\fR for more explanations. +.SH ZIPVFS +.PP +When a zipfile is concatenated to the end of a \fBtclsh\fR, on +startup the contents of the zip archive will be mounted as the +virtual file system /zvfs. If a top level directory tcl8.6 is +present in the zip archive, it will become the directory loaded +as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present +in the top level directory of the zip archive, it will be sourced +instead of the shell's normal command line handing. .SH "SEE ALSO" auto_path(n), encoding(n), env(n), fconfigure(n) .SH KEYWORDS diff --git a/doc/zipfs.3 b/doc/zipfs.3 new file mode 100644 index 0000000..7514525 --- /dev/null +++ b/doc/zipfs.3 @@ -0,0 +1,66 @@ +'\" +'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com> +'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de> +'\" Copyright (c) 2017 Sean Woods <yoda@etoyoc.com> +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures" +.so man.macros +.BS +.SH NAME +TclZipfs_AppHook, Tclzipfs_Mount, Tclzipfs_Unmount, \- handle ZIP files as VFS +.SH SYNOPSIS +.nf +.sp +int +\fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR) +.sp +int +\fBTclzipfs_Mount\fR(\fIinterp, mntpt, zipname, passwd\fR) +.sp +int +\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR) +.SH ARGUMENTS +.AP "int" *argc in +Number of command line arguments from main() +.AP "char" ***argv in +Pointer to an array of strings containing the command +line arguments to main() +.AS Tcl_Interp **termPtr +.AP Tcl_Interp *interp in +Interpreter in which the zip file system is mounted. The interpreter's result is +modified to hold the result or error message from the script. +.AP "const char" *zipname in +Name of a zipfile. +.AP "const char" *mntpt in +Name of a mount point. +.AP "const char" *passwd in +An (optional) password. +.BE +.SH DESCRIPTION +\fBTclZipfs_AppHook()\fR is a utility function to perform standard +application initialization procedures. If the current application has +a mountable zip file system, that file system is mounted under \fIZIPROOT\fR\fB/app\fR. +If a file named \fBmain.tcl\fR is located in that file system, it is treated +as the startup script for the process. If the file \fIZIPROOT\fR\fB/app/tcl_library/init.tcl\fR +is present, \fBtcl_library\fR is set to \fIZIPROOT\fR\fB/app/tcl_library. +.PP +If the \fBtcl_library\fR was not found in the application, the system will then search for it +as either a VFS attached to the application dynamic library, or as a zip archive named +libtcl_\fIMAJOR\fR_\fIMINOR\fR_\fIpatchLevel\fR.zip either in the present working directory +or in the standard tcl install location. +.PP +\fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount +point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR. +Errors during that process are reported in the interpreter \fIinterp\fR. +If \fImountpoint\fR is a NULL pointer, information on all currently mounted +ZIP file systems is written into \fIinterp\fR's result as a sequence of +mount points and ZIP file names. +.PP +\fBTclzipfs_Unmount()\fR undoes the effect of \fBTclzipfs_Mount()\fR, +i.e. it unmounts the mounted ZIP file system at \fImountpoint\fR. Errors are +reported in the interpreter \fIinterp\fR. +.SH KEYWORDS +compress, filesystem, zip diff --git a/doc/zipfs.n b/doc/zipfs.n new file mode 100644 index 0000000..31a0707 --- /dev/null +++ b/doc/zipfs.n @@ -0,0 +1,125 @@ +'\" +'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com> +'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de> +'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com> +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH zipfs n 1.0 Zipfs "zipfs Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +zipfs \- Mount and work with ZIP files within Tcl +.SH SYNOPSIS +.nf +\fBpackage require zipfs \fR?\fB1.0\fR? +.sp +\fBzipfs exists\fR \fIfilename\fR +\fBzipfs find\fR \fIdir\fR +\fBzipfs info\fR \fIfilename\fR +\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR +\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR +\fBzipfs mkkey\fR \fIpassword\fR +\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR +\fBzipfs mount\fR \fI?mountpoint?\fR \fI?zipfile?\fR \fI?password?\fR +\fBzipfs root\fR +\fBzipfs unmount\fR \fImountpoint\fR +.fi +.BE +.SH DESCRIPTION +.PP +The \fBzipfs\fR package provides tcl with the ability to mount +the contents of a zip file as a virtual file system. +.TP +\fBzipfs exists\fR \fIfilename\fR +. +Return 1 if the given filename exists in the mounted zipfs and 0 if it does not. +.TP +\fBzipfs find\fR \fIdir\fR +. +Recursively lists files including and below the directory \fIdir\fR. +The result list consists of relative path names starting from the +given directory. This command is also used by the \fBzipfs mkzip\fR +and \fBzipfs mkimg\fR commands. +.TP +\fBzipfs info\fR \fIfile\fR +. +Return information about the given file in the mounted zipfs. The information +consists of (1) the name of the ZIP archive file that contains the file, +(2) the size of the file after decompressions, (3) the compressed size of +the file, and (4) the offset of the compressed data in the ZIP archive file. +.RS +.PP +Note: querying the mount point gives the start of zip data offset in (4), +which can be used to truncate the zip info off an executable. +.RE +.TP +\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR +. +Return a list of all files in the mounted zipfs. The order of the names +in the list is arbitrary. +.TP +\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR +. +Creates an image (potentially a new executable file) similar to +\fBzipfs mkzip\fR. If the \fIinfile\fR parameter is specified, +this file is prepended in front of the ZIP archive, otherwise the file +returned by \fBTcl_NameOfExecutable(3)\fR (i.e. the executable file of +the running process) is used. If the \fIpassword\fR parameter is not empty, +an obfuscated version of that password is placed between the image and ZIP +chunks of the output file and the contents of the ZIP chunk are protected +with that password. +.RS +.PP +Caution: highly experimental, not usable on Android, only partially tested +on Linux and Windows. +.RE +.TP +\fBzipfs mkkey\fR \fIpassword\fR +. +For the clear text \fIpassword\fR argument an obfuscated string version +is returned with the same format used in the \fBzipfs mkimg\fR command. +.TP +\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR +. +Creates a ZIP archive file named \fIoutfile\fR from the contents of the input +directory \fIindir\fR (contained regular files only) with optional ZIP +password \fIpassword\fR. While processing the files below \fIindir\fR the +optional file name prefix given in \fIstrip\fR is stripped off the beginning +of the respective file name. +.RS +.PP +Caution: the choice of the \fIindir\fR parameter +(less the optional stripped prefix) determines the later root name of the +archive's content. +.RE +.TP +\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR? +. +The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS. +After this command executes, files contained in \fIzipfile\fR +will appear to Tcl to be regular files at the mount point. +.RS +.PP +With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR. +With no \fImountpoint\fR, return all zipfile/mount pairs. +If \fImountpoint\fR is specified as an empty string, mount on file path. +.RE +.TP +\fBzipfs root\fR +Returns a constant string which indicates the mount point for zipfs volumes +for the current platform. On Windows, this value is zipfs:/. On Unux, //zipfs:/ +.RE +.TP +\fBzipfs unmount \fImountpoint\fR +. +Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR. +.SH "SEE ALSO" +tclsh(1), file(n), zlib(n) +.SH "KEYWORDS" +compress, filesystem, zip +'\" Local Variables: +'\" mode: nroff +'\" End: diff --git a/generic/tcl.decls b/generic/tcl.decls index da551bb..1bd6bdc 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2332,8 +2332,28 @@ declare 631 { # ----- BASELINE -- FOR -- 8.7.0 ----- # - - +# TIP #430 +declare 632 { + int TclZipfs_Mount( + Tcl_Interp *interp, + const char *mntpt, + const char *zipname, + const char *passwd) +} +declare 633 { + int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) +} +declare 634 { + Tcl_Obj *TclZipfs_TclLibrary(void) +} +declare 635 { + int TclZipfs_Mount_Buffer( + Tcl_Interp *interp, + const char *mntpt, + unsigned char *data, + size_t datalen, + int copy) +} ############################################################################## # Define the platform specific public Tcl interface. These functions are only @@ -2344,6 +2364,9 @@ interface tclPlat ################################ # Unix specific functions # (none) +declare 0 unix { + int TclZipfs_AppHook(int *argc, char ***argv) +} ################################ # Windows specific functions @@ -2356,7 +2379,9 @@ declare 0 win { declare 1 win { char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr) } - +declare 2 win { + int TclZipfs_AppHook(int *argc, TCHAR ***argv) +} ################################ # Mac OS X specific functions diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9c2736c..1fb683f 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -999,6 +999,9 @@ Tcl_CreateInterp(void) if (TclZlibInit(interp) != TCL_OK) { Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp))); } + if (TclZipfs_Init(interp) != TCL_OK) { + Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp))); + } #endif TOP_CB(iPtr) = NULL; diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 592d945..b7c716b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1838,6 +1838,18 @@ EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); +/* 632 */ +EXTERN int TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, + const char *zipname, const char *passwd); +/* 633 */ +EXTERN int TclZipfs_Unmount(Tcl_Interp *interp, + const char *zipname); +/* 634 */ +EXTERN Tcl_Obj * TclZipfs_TclLibrary(void); +/* 635 */ +EXTERN int TclZipfs_Mount_Buffer(Tcl_Interp *interp, + const char *mntpt, unsigned char *data, + size_t datalen, int copy); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2505,6 +2517,10 @@ typedef struct TclStubs { int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */ void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */ + int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); /* 632 */ + int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */ + Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */ + int (*tclZipfs_Mount_Buffer) (Tcl_Interp *interp, const char *mntpt, unsigned char *data, size_t datalen, int copy); /* 635 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3799,6 +3815,14 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */ #define Tcl_OpenTcpServerEx \ (tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */ +#define TclZipfs_Mount \ + (tclStubsPtr->tclZipfs_Mount) /* 632 */ +#define TclZipfs_Unmount \ + (tclStubsPtr->tclZipfs_Unmount) /* 633 */ +#define TclZipfs_TclLibrary \ + (tclStubsPtr->tclZipfs_TclLibrary) /* 634 */ +#define TclZipfs_Mount_Buffer \ + (tclStubsPtr->tclZipfs_Mount_Buffer) /* 635 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 15fcde7..015cfc3 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1881,7 +1881,7 @@ TclGlob( separators = "/\\"; } else if (tclPlatform == TCL_PLATFORM_UNIX) { - if (pathPrefix == NULL && tail[0] == '/') { + if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') { pathPrefix = Tcl_NewStringObj(tail, 1); tail++; Tcl_IncrRefCount(pathPrefix); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 3382825..f5ff2a6 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1391,31 +1391,62 @@ TclFSNormalizeToUniquePath( { FilesystemRecord *fsRecPtr, *firstFsRecPtr; + int i; + int isVfsPath = 0; + char *path; + /* - * Call each of the "normalise path" functions in succession. This is a - * special case, in which if we have a native filesystem handler, we call - * it first. This is because the root of Tcl's filesystem is always a - * native filesystem (i.e., '/' on unix is native). + * Paths starting with a UNC prefix whose final character is a colon + * are reserved for VFS use. These names can not conflict with real + * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx + * and rfc3986's definition of reg-name. + * + * We check these first to avoid useless calls to the native filesystem's + * normalizePathProc. */ + path = Tcl_GetStringFromObj(pathPtr, &i); + + if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/') + || (path[0] == '\\' && path[1] == '\\') ) ) { + for ( i = 2; ; i++) { + if (path[i] == '\0') break; + if (path[i] == path[0]) break; + } + --i; + if (path[i] == ':') isVfsPath = 1; + } + /* + * Call each of the "normalise path" functions in succession. + */ firstFsRecPtr = FsGetFirstFilesystem(); Claim(); - for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { - if (fsRecPtr->fsPtr != &tclNativeFilesystem) { - continue; - } + + if (!isVfsPath) { /* - * TODO: Assume that we always find the native file system; it should - * always be there... + * If we have a native filesystem handler, we call it first. This is + * because the root of Tcl's filesystem is always a native filesystem + * (i.e., '/' on unix is native). */ - if (fsRecPtr->fsPtr->normalizePathProc != NULL) { - startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, - startAt); + for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { + if (fsRecPtr->fsPtr != &tclNativeFilesystem) { + continue; + } + + /* + * TODO: Assume that we always find the native file system; it should + * always be there... + */ + + if (fsRecPtr->fsPtr->normalizePathProc != NULL) { + startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr, + startAt); + } + break; } - break; } for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) { diff --git a/generic/tclInt.h b/generic/tclInt.h index 64e7c67..a88e012 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3255,12 +3255,20 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks); #endif MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp); +MODULE_SCOPE int TclZipfsInit(Tcl_Interp *interp); +MODULE_SCOPE int TclZipfsMount(Tcl_Interp *interp, const char *zipname, + const char *mntpt, const char *passwd); +MODULE_SCOPE int TclZipfsUnmount(Tcl_Interp *interp, const char *zipname); MODULE_SCOPE void * TclpThreadCreateKey(void); MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length); +/* Tip 430 */ +MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); +MODULE_SCOPE int TclZipfs_SafeInit(Tcl_Interp *interp); + /* *---------------------------------------------------------------- diff --git a/generic/tclInterp.c b/generic/tclInterp.c index d4bf465..92ff8d9 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -402,6 +402,7 @@ Tcl_Init( " set scripts {{set tcl_library}}\n" " } else {\n" " set scripts {}\n" +" lappend scripts {zipfs tcl_library}\n" " if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n" " lappend scripts {set env(TCL_LIBRARY)}\n" " lappend scripts {\n" diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c index 9e194c8..96b6962 100644 --- a/generic/tclPkgConfig.c +++ b/generic/tclPkgConfig.c @@ -105,6 +105,8 @@ static Tcl_Config const cfg[] = { {"scriptdir,runtime", CFG_RUNTIME_SCRDIR}, {"includedir,runtime", CFG_RUNTIME_INCDIR}, {"docdir,runtime", CFG_RUNTIME_DOCDIR}, + {"dllfile,runtime", CFG_RUNTIME_DLLFILE}, + {"zipfile,runtime", CFG_RUNTIME_ZIPFILE}, /* Installation paths to various stuff */ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index abc8ee8..e746a6d 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -50,6 +50,10 @@ extern "C" { * Exported function declarations: */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +/* 0 */ +EXTERN int TclZipfs_AppHook(int *argc, char ***argv); +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, @@ -57,12 +61,12 @@ EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, /* 1 */ EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); +/* 2 */ +EXTERN int TclZipfs_AppHook(int *argc, TCHAR ***argv); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, - const char *bundleName, int hasResourceFile, - int maxPathLen, char *libraryPath); +EXTERN int TclZipfs_AppHook(int *argc, char ***argv); /* 1 */ EXTERN int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, @@ -75,12 +79,16 @@ typedef struct TclPlatStubs { int magic; void *hooks; +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + int (*tclZipfs_AppHook) (int *argc, char ***argv); /* 0 */ +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */ char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */ + int (*tclZipfs_AppHook) (int *argc, TCHAR ***argv); /* 2 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */ + int (*tclZipfs_AppHook) (int *argc, char ***argv); /* 0 */ int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ #endif /* MACOSX */ } TclPlatStubs; @@ -97,15 +105,21 @@ extern const TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ +#define TclZipfs_AppHook \ + (tclPlatStubsPtr->tclZipfs_AppHook) /* 0 */ +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ #define Tcl_WinUtfToTChar \ (tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */ #define Tcl_WinTCharToUtf \ (tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */ +#define TclZipfs_AppHook \ + (tclPlatStubsPtr->tclZipfs_AppHook) /* 2 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ +#define TclZipfs_AppHook \ + (tclPlatStubsPtr->tclZipfs_AppHook) /* 0 */ #define Tcl_MacOSXOpenVersionedBundleResources \ (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ #endif /* MACOSX */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 7ce0758..82adde9 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -835,12 +835,16 @@ static const TclIntPlatStubs tclIntPlatStubs = { static const TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, 0, +#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ + TclZipfs_AppHook, /* 0 */ +#endif /* UNIX */ #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ + TclZipfs_AppHook, /* 2 */ #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ - Tcl_MacOSXOpenBundleResources, /* 0 */ + TclZipfs_AppHook, /* 0 */ Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ #endif /* MACOSX */ }; @@ -1587,6 +1591,10 @@ const TclStubs tclStubs = { Tcl_FSUnloadFile, /* 629 */ Tcl_ZlibStreamSetCompressionDictionary, /* 630 */ Tcl_OpenTcpServerEx, /* 631 */ + TclZipfs_Mount, /* 632 */ + TclZipfs_Unmount, /* 633 */ + TclZipfs_TclLibrary, /* 634 */ + TclZipfs_Mount_Buffer, /* 635 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c new file mode 100644 index 0000000..e934490 --- /dev/null +++ b/generic/tclZipfs.c @@ -0,0 +1,4593 @@ +/* + * tclZipfs.c -- + * + * Implementation of the ZIP filesystem used in TIP 430 + * Adapted from the implentation for AndroWish. + * + * Coptright (c) 2016-2017 Sean Woods <yoda@etoyoc.com> + * Copyright (c) 2013-2015 Christian Werner <chw@ch-werner.de> + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * 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> +#else +#include <winbase.h> +#endif +#include <errno.h> +#include <string.h> +#include <sys/stat.h> +#include <time.h> +#include <stdlib.h> +#include <fcntl.h> + +#ifndef MAP_FILE +#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). */ +#define ZIP_LOCAL_HEADER_SIG 0x04034b50 +#define ZIP_LOCAL_HEADER_LEN 30 +#define ZIP_LOCAL_SIG_OFFS 0 +#define ZIP_LOCAL_VERSION_OFFS 4 +#define ZIP_LOCAL_FLAGS_OFFS 6 +#define ZIP_LOCAL_COMPMETH_OFFS 8 +#define ZIP_LOCAL_MTIME_OFFS 10 +#define ZIP_LOCAL_MDATE_OFFS 12 +#define ZIP_LOCAL_CRC32_OFFS 14 +#define ZIP_LOCAL_COMPLEN_OFFS 18 +#define ZIP_LOCAL_UNCOMPLEN_OFFS 22 +#define ZIP_LOCAL_PATHLEN_OFFS 26 +#define ZIP_LOCAL_EXTRALEN_OFFS 28 + +/* Central header of ZIP archive member at end of ZIP file. */ +#define ZIP_CENTRAL_HEADER_SIG 0x02014b50 +#define ZIP_CENTRAL_HEADER_LEN 46 +#define ZIP_CENTRAL_SIG_OFFS 0 +#define ZIP_CENTRAL_VERSIONMADE_OFFS 4 +#define ZIP_CENTRAL_VERSION_OFFS 6 +#define ZIP_CENTRAL_FLAGS_OFFS 8 +#define ZIP_CENTRAL_COMPMETH_OFFS 10 +#define ZIP_CENTRAL_MTIME_OFFS 12 +#define ZIP_CENTRAL_MDATE_OFFS 14 +#define ZIP_CENTRAL_CRC32_OFFS 16 +#define ZIP_CENTRAL_COMPLEN_OFFS 20 +#define ZIP_CENTRAL_UNCOMPLEN_OFFS 24 +#define ZIP_CENTRAL_PATHLEN_OFFS 28 +#define ZIP_CENTRAL_EXTRALEN_OFFS 30 +#define ZIP_CENTRAL_FCOMMENTLEN_OFFS 32 +#define ZIP_CENTRAL_DISKFILE_OFFS 34 +#define ZIP_CENTRAL_IATTR_OFFS 36 +#define ZIP_CENTRAL_EATTR_OFFS 38 +#define ZIP_CENTRAL_LOCALHDR_OFFS 42 + +/* Central end signature at very end of ZIP file. */ +#define ZIP_CENTRAL_END_SIG 0x06054b50 +#define ZIP_CENTRAL_END_LEN 22 +#define ZIP_CENTRAL_END_SIG_OFFS 0 +#define ZIP_CENTRAL_DISKNO_OFFS 4 +#define ZIP_CENTRAL_DISKDIR_OFFS 6 +#define ZIP_CENTRAL_ENTS_OFFS 8 +#define ZIP_CENTRAL_TOTALENTS_OFFS 10 +#define ZIP_CENTRAL_DIRSIZE_OFFS 12 +#define ZIP_CENTRAL_DIRSTART_OFFS 16 +#define ZIP_CENTRAL_COMMENTLEN_OFFS 20 + +#define ZIP_MIN_VERSION 20 +#define ZIP_COMPMETH_STORED 0 +#define ZIP_COMPMETH_DEFLATED 8 + +#define ZIP_PASSWORD_END_SIG 0x5a5a4b50 + +/* Macro to report errors only if an interp is present */ +#define ZIPFS_ERROR(interp,errstr) \ + if(interp != NULL) Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); + +/* + * Macros to read and write 16 and 32 bit integers from/to ZIP archives. + */ + +#define zip_read_int(p) \ + ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24)) +#define zip_read_short(p) \ + ((p)[0] | ((p)[1] << 8)) + +#define zip_write_int(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; \ + (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff; +#define zip_write_short(p, v) \ + (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff; + +/* + * Windows drive letters. + */ + +#if defined(_WIN32) || defined(_WIN64) +#define HAS_DRIVES 1 +static const char drvletters[] = + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; +#else +#define HAS_DRIVES 0 +#endif + +/* + * Mutex to protect localtime(3) when no reentrant version available. + */ + +#if !defined(_WIN32) && !defined(_WIN64) +#ifndef HAVE_LOCALTIME_R +#ifdef TCL_THREADS +TCL_DECLARE_MUTEX(localtimeMutex) +#endif +#endif +#endif + +/* + * In-core description of mounted ZIP archive file. + */ + +typedef struct ZipFile { + char *name; /* Archive name */ + size_t namelen; + char is_membuf; /* When true, not a file but a memory buffer */ + 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; + char *mntpt; /* Mount point */ +} ZipFile; + +/* + * In-core description of file contained in mounted ZIP archive. + */ + +typedef struct ZipEntry { + char *name; /* The full pathname of the virtual file */ + ZipFile *zipfile; /* The ZIP file holding this virtual file */ + long offset; /* Data offset into memory mapped ZIP file */ + int nbyte; /* Uncompressed size of the virtual file */ + int nbytecompr; /* Compressed size of the virtual file */ + int cmeth; /* Compress method */ + int isdir; /* Set to 1 if directory, or -1 if root */ + int depth; /* Number of slashes in path. */ + int crc32; /* CRC-32 */ + int timestamp; /* Modification time */ + int isenc; /* True if data is encrypted */ + unsigned char *data; /* File data if written */ + struct ZipEntry *next; /* Next file in the same archive */ + struct ZipEntry *tnext; /* Next top-level dir in archive */ +} ZipEntry; + +/* + * File channel for file contained in mounted ZIP archive. + */ + +typedef struct ZipChannel { + ZipFile *zipfile; /* The ZIP file holding this channel */ + ZipEntry *zipentry; /* Pointer back to virtual file */ + unsigned long nmax; /* Max. size for write */ + unsigned long nbyte; /* Number of bytes of uncompressed data */ + unsigned long nread; /* Pos of next byte to be read from the channel */ + unsigned char *ubuf; /* Pointer to the uncompressed data */ + int iscompr; /* True if data is compressed */ + int isdir; /* Set to 1 if directory, or -1 if root */ + int isenc; /* True if data is encrypted */ + int iswr; /* True if open for writing */ + unsigned long keys[3]; /* Key for decryption */ +} ZipChannel; + +/* + * Global variables. + * + * Most are kept in single ZipFS struct. When build with threading + * support this struct is protected by the ZipFSMutex (see below). + * + * The "fileHash" component is the process wide global table of all known + * ZIP archive members in all mounted ZIP archives. + * + * The "zipHash" components is the process wide global table of all mounted + * ZIP archive files. + */ + +static struct { + int initialized; /* True when initialized */ + int lock; /* RW lock, see below */ + int waiters; /* RW lock, see below */ + int wrmax; /* Maximum write size of a file */ + int idCount; /* Counter for channel names */ + Tcl_HashTable fileHash; /* File name to ZipEntry mapping */ + Tcl_HashTable zipHash; /* Mount to ZipFile mapping */ +} ZipFS = { + 0, 0, 0, 0, 0, +}; + +/* + * For password rotation. + */ + +static const char pwrot[16] = { + 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0, + 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0 +}; + +/* + * Table to compute CRC32. + */ + +static const 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, + 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b, + 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3, + 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a, + 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599, + 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924, + 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190, + 0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f, + 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e, + 0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01, + 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed, + 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950, + 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3, + 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2, + 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a, + 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5, + 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010, + 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f, + 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17, + 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6, + 0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615, + 0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8, + 0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344, + 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb, + 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a, + 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5, + 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1, + 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c, + 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef, + 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236, + 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe, + 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31, + 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c, + 0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713, + 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b, + 0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242, + 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1, + 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c, + 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278, + 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7, + 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66, + 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9, + 0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605, + 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8, + 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b, + 0x2d02ef8d, +}; + +const char *zipfs_literal_tcl_library=NULL; + +/* Function prototypes */ +int TclZipfs_Mount( + Tcl_Interp *interp, + const char *mntpt, + const char *zipname, + const char *passwd +); +int TclZipfs_Mount_Buffer( + Tcl_Interp *interp, + const char *mntpt, + unsigned char *data, + size_t datalen, + int copy +); +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 -- + * + * POSIX like rwlock functions to support multiple readers + * and single writer on internal structs. + * + * Limitations: + * - a read lock cannot be promoted to a write lock + * - a write lock may not be nested + * + *------------------------------------------------------------------------- + */ + +TCL_DECLARE_MUTEX(ZipFSMutex) + +#ifdef TCL_THREADS + +static Tcl_Condition ZipFSCond; + +static void +ReadLock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + while (ZipFS.lock < 0) { + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; + } + ZipFS.lock++; + Tcl_MutexUnlock(&ZipFSMutex); +} + +static void +WriteLock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + while (ZipFS.lock != 0) { + ZipFS.waiters++; + Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL); + ZipFS.waiters--; + } + ZipFS.lock = -1; + Tcl_MutexUnlock(&ZipFSMutex); +} + +static void +Unlock(void) +{ + Tcl_MutexLock(&ZipFSMutex); + if (ZipFS.lock > 0) { + --ZipFS.lock; + } else if (ZipFS.lock < 0) { + ZipFS.lock = 0; + } + if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) { + Tcl_ConditionNotify(&ZipFSCond); + } + Tcl_MutexUnlock(&ZipFSMutex); +} + +#else + +#define ReadLock() do {} while (0) +#define WriteLock() do {} while (0) +#define Unlock() do {} while (0) + +#endif + +/* + *------------------------------------------------------------------------- + * + * DosTimeDate, ToDosTime, ToDosDate -- + * + * Functions to perform conversions between DOS time stamps + * and POSIX time_t. + * + *------------------------------------------------------------------------- + */ + +static time_t +DosTimeDate(int dosDate, int dosTime) +{ + struct tm tm; + time_t ret; + + memset(&tm, 0, sizeof (tm)); + tm.tm_year = (((dosDate & 0xfe00) >> 9) + 80); + tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1; + tm.tm_mday = dosDate & 0x1f; + tm.tm_hour = (dosTime & 0xf800) >> 11; + tm.tm_min = (dosTime & 0x7e) >> 5; + tm.tm_sec = (dosTime & 0x1f) << 1; + ret = mktime(&tm); + if (ret == (time_t) -1) { + /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */ + ret = (time_t) 315532800; + } + return ret; +} + +static int +ToDosTime(time_t when) +{ + struct tm *tmp, tm; + +#ifdef TCL_THREADS +#if defined(_WIN32) || defined(_WIN64) + /* Win32 uses thread local storage */ + tmp = localtime(&when); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&when, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&when); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif +#else + tmp = localtime(&when); + tm = *tmp; +#endif + return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1); +} + +static int +ToDosDate(time_t when) +{ + struct tm *tmp, tm; + +#ifdef TCL_THREADS +#if defined(_WIN32) || defined(_WIN64) + /* Win32 uses thread local storage */ + tmp = localtime(&when); + tm = *tmp; +#else +#ifdef HAVE_LOCALTIME_R + tmp = &tm; + localtime_r(&when, tmp); +#else + Tcl_MutexLock(&localtimeMutex); + tmp = localtime(&when); + tm = *tmp; + Tcl_MutexUnlock(&localtimeMutex); +#endif +#endif +#else + tmp = localtime(&when); + tm = *tmp; +#endif + return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday; +} + +/* + *------------------------------------------------------------------------- + * + * CountSlashes -- + * + * This function counts the number of slashes in a pathname string. + * + * Results: + * Number of slashes found in string. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +CountSlashes(const char *string) +{ + int count = 0; + const char *p = string; + + while (*p != '\0') { + if (*p == '/') { + count++; + } + p++; + } + return count; +} + +/* + *------------------------------------------------------------------------- + * + * CanonicalPath -- + * + * This function computes the canonical path from a directory + * and file name components into the specified Tcl_DString. + * + * Results: + * Returns the pointer to the canonical path contained in the + * specified Tcl_DString. + * + * Side effects: + * Modifies the specified Tcl_DString. + * + *------------------------------------------------------------------------- + */ + +static char * +CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPATH) +{ + char *path; + char *result; + int i, j, c, isunc = 0, isvfs=0, n=0; +#if HAS_DRIVES + int zipfspath=1; + if ( + (tail[0] != '\0') + && (strchr(drvletters, tail[0]) != NULL) + && (tail[1] == ':') + ) { + tail += 2; + zipfspath=0; + } + /* UNC style path */ + if (tail[0] == '\\') { + root = ""; + ++tail; + zipfspath=0; + } + if (tail[0] == '\\') { + root = "/"; + ++tail; + zipfspath=0; + } + if(zipfspath) { +#endif + /* UNC style path */ + if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) { + isvfs=1; + } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) { + isvfs=2; + } + if(isvfs!=1) { + if ((root[0] == '/') && (root[1] == '/')) { + isunc = 1; + } + } +#if HAS_DRIVES + } +#endif + if(isvfs!=2) { + if (tail[0] == '/') { + if(isvfs!=1) { + root = ""; + } + ++tail; + isunc = 0; + } + if (tail[0] == '/') { + if(isvfs!=1) { + root = "/"; + } + ++tail; + isunc = 1; + } + } + i = strlen(root); + j = strlen(tail); + if(isvfs==1) { + if(i>ZIPFS_VOLUME_LEN) { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + memcpy(path + i, tail, j); + } + } else if(isvfs==2) { + Tcl_DStringSetLength(dsPtr, j); + path = Tcl_DStringValue(dsPtr); + memcpy(path, tail, j); + } else { + if (ZIPFSPATH) { + Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN); + path = Tcl_DStringValue(dsPtr); + memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN); + memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j); + } else { + Tcl_DStringSetLength(dsPtr, i + j + 1); + path = Tcl_DStringValue(dsPtr); + memcpy(path, root, i); + path[i++] = '/'; + memcpy(path + i, tail, j); + } + } +#if HAS_DRIVES + for (i = 0; path[i] != '\0'; i++) { + if (path[i] == '\\') { + path[i] = '/'; + } + } +#endif + if(ZIPFSPATH) { + n=ZIPFS_VOLUME_LEN; + } else { + n=0; + } + for (i = j = n; (c = path[i]) != '\0'; i++) { + if (c == '/') { + int c2 = path[i + 1]; + if (c2 == '/') { + continue; + } + if (c2 == '.') { + int c3 = path[i + 2]; + if ((c3 == '/') || (c3 == '\0')) { + i++; + continue; + } + if ( + (c3 == '.') + && ((path[i + 3] == '/') || (path [i + 3] == '\0')) + ) { + i += 2; + while ((j > 0) && (path[j - 1] != '/')) { + j--; + } + if (j > isunc) { + --j; + while ((j > 1 + isunc) && (path[j - 2] == '/')) { + j--; + } + } + continue; + } + } + } + path[j++] = c; + } + if (j == 0) { + path[j++] = '/'; + } + path[j] = 0; + Tcl_DStringSetLength(dsPtr, j); + result=Tcl_DStringValue(dsPtr); + return result; +} + + +/* + *------------------------------------------------------------------------- + * + * AbsolutePath -- + * + * This function computes the absolute path from a given + * (relative) path name into the specified Tcl_DString. + * + * Results: + * Returns the pointer to the absolute path contained in the + * specified Tcl_DString. + * + * Side effects: + * Modifies the specified Tcl_DString. + * + *------------------------------------------------------------------------- + */ + +static char * +AbsolutePath(const char *path, +#if HAS_DRIVES + int *drvPtr, +#endif + Tcl_DString *dsPtr) +{ + char *result; + +#if HAS_DRIVES + if (drvPtr != NULL) { + *drvPtr = 0; + } +#endif + if (*path == '~') { + Tcl_DStringAppend(dsPtr, path, -1); + return Tcl_DStringValue(dsPtr); + } + if ((*path != '/') +#if HAS_DRIVES + && (*path != '\\') && + (((*path != '\0') && (strchr(drvletters, *path) == NULL)) || + (path[1] != ':')) +#endif + ) { + Tcl_DString pwd; + + /* relative path */ + Tcl_DStringInit(&pwd); + Tcl_GetCwd(NULL, &pwd); + result = Tcl_DStringValue(&pwd); +#if HAS_DRIVES + if ((result[0] != '\0') && (strchr(drvletters, result[0]) != NULL) && + (result[1] == ':')) { + if (drvPtr != NULL) { + drvPtr[0] = result[0]; + if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) { + drvPtr[0] -= 'a' - 'A'; + } + } + result += 2; + } +#endif + result = CanonicalPath(result, path, dsPtr, 0); + Tcl_DStringFree(&pwd); + } else { + /* absolute path */ +#if HAS_DRIVES + if ((path[0] != '\0') && (strchr(drvletters, path[0]) != NULL) && + (path[1] == ':')) { + if (drvPtr != NULL) { + drvPtr[0] = path[0]; + if ((drvPtr[0] >= 'a') && (drvPtr[0] <= 'z')) { + drvPtr[0] -= 'a' - 'A'; + } + } + } +#endif + result = CanonicalPath("", path, dsPtr, 0); + } + return result; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSLookup -- + * + * This function returns the ZIP entry struct corresponding to + * the ZIP archive member of the given file name. + * + * Results: + * Returns the pointer to ZIP entry struct or NULL if the + * the given file name could not be found in the global list + * of ZIP archive members. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static ZipEntry * +ZipFSLookup(char *filename) +{ + Tcl_HashEntry *hPtr; + ZipEntry *z; + Tcl_DString ds; + Tcl_DStringInit(&ds); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename); + z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL; + Tcl_DStringFree(&ds); + return z; +} + +#ifdef NEVER_USED + +/* + *------------------------------------------------------------------------- + * + * ZipFSLookupMount -- + * + * This function returns an indication if the given file name + * corresponds to a mounted ZIP archive file. + * + * Results: + * Returns true, if the given file name is a mounted ZIP archive file. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSLookupMount(char *filename) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + int match = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) == NULL) continue; + if (strcmp(zf->mntpt, filename) == 0) { + match = 1; + break; + } + hPtr = Tcl_NextHashEntry(&search); + } + return match; +} +#endif + +/* + *------------------------------------------------------------------------- + * + * ZipFSCloseArchive -- + * + * This function closes a mounted ZIP archive file. + * + * Results: + * None. + * + * Side effects: + * A memory mapped ZIP archive is unmapped, allocated memory is + * released. + * + *------------------------------------------------------------------------- + */ + +static void +ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf) +{ + if(zf->namelen) { + free(zf->name); //Allocated by strdup + } + if(zf->is_membuf==1) { + /* Pointer to memory */ + if (zf->tofree != NULL) { + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; + } + zf->data = NULL; + return; + } +#if defined(_WIN32) || defined(_WIN64) + if ((zf->data != NULL) && (zf->tofree == NULL)) { + UnmapViewOfFile(zf->data); + zf->data = NULL; + } + if (zf->mh != INVALID_HANDLE_VALUE) { + CloseHandle(zf->mh); + } +#else + if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) { + munmap(zf->data, zf->length); + zf->data = MAP_FAILED; + } +#endif + if (zf->tofree != NULL) { + Tcl_Free((char *) zf->tofree); + zf->tofree = NULL; + } + if(zf->chan != NULL) { + Tcl_Close(interp, zf->chan); + zf->chan = NULL; + } +} + +/* + *------------------------------------------------------------------------- + * + * ZipFS_Find_TOC -- + * + * This function takes a memory mapped zip file and indexes the contents. + * When "needZip" is zero an embedded ZIP archive in an executable file is accepted. + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. + * + * Side effects: + * The given ZipFile struct is filled with information about the ZIP archive file. + * + *------------------------------------------------------------------------- + */ +static int +ZipFS_Find_TOC(Tcl_Interp *interp, int needZip, ZipFile *zf) +{ + int i; + unsigned char *p, *q; + p = zf->data + zf->length - ZIP_CENTRAL_END_LEN; + while (p >= zf->data) { + if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) { + if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) { + break; + } + p -= ZIP_SIG_LEN; + } else { + --p; + } + } + if (p < zf->data) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"wrong end signature"); + goto error; + } + zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS); + if (zf->nfiles == 0) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"empty archive"); + goto error; + } + q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS); + p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS); + if ( + (p < zf->data) || (p > (zf->data + zf->length)) || + (q < zf->data) || (q > (zf->data + zf->length)) + ) { + if (!needZip) { + zf->baseoffs = zf->baseoffsp = zf->length; + return TCL_OK; + } + ZIPFS_ERROR(interp,"archive directory not found"); + goto error; + } + zf->baseoffs = zf->baseoffsp = p - q; + zf->centoffs = p - zf->data; + q = p; + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra; + + if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) { + ZIPFS_ERROR(interp,"wrong header length"); + goto error; + } + if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) { + ZIPFS_ERROR(interp,"wrong header signature"); + goto error; + } + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + q = zf->data + zf->baseoffs; + if ((zf->baseoffs >= 6) && (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) { + i = q[-5]; + if (q - 5 - i > zf->data) { + zf->pwbuf[0] = i; + memcpy(zf->pwbuf + 1, q - 5 - i, i); + zf->baseoffsp -= i ? (5 + i) : 0; + } + } + + return TCL_OK; + +error: + ZipFSCloseArchive(interp, zf); + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSOpenArchive -- + * + * This function opens a ZIP archive file for reading. An attempt + * is made to memory map that file. Otherwise it is read into + * an allocated memory buffer. The ZIP archive header is verified + * and must be valid for the function to succeed. When "needZip" + * is zero an embedded ZIP archive in an executable file is accepted. + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. + * + * Side effects: + * ZIP archive is memory mapped or read into allocated memory, + * the given ZipFile struct is filled with information about + * the ZIP archive file. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile *zf) +{ + int i; + ClientData handle; + zf->namelen=0; + zf->is_membuf=0; +#if defined(_WIN32) || defined(_WIN64) + zf->data = NULL; + zf->mh = INVALID_HANDLE_VALUE; +#else + zf->data = MAP_FAILED; +#endif + zf->length = 0; + zf->nfiles = 0; + zf->baseoffs = zf->baseoffsp = 0; + zf->tofree = NULL; + zf->pwbuf[0] = 0; + zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0); + if (zf->chan == NULL) { + return TCL_ERROR; + } + if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) { + if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") != TCL_OK) { + goto error; + } + if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") != TCL_OK) { + goto error; + } + zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); + if ((zf->length <= 0) || (zf->length > 64 * 1024 * 1024)) { + ZIPFS_ERROR(interp,"illegal file size"); + goto error; + } + Tcl_Seek(zf->chan, 0, SEEK_SET); + zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length); + if (zf->tofree == NULL) { + ZIPFS_ERROR(interp,"out of memory") + goto error; + } + i = Tcl_Read(zf->chan, (char *) zf->data, zf->length); + if (i != zf->length) { + ZIPFS_ERROR(interp,"file read error"); + goto error; + } + Tcl_Close(interp, zf->chan); + zf->chan = NULL; + } else { +#if defined(_WIN32) || defined(_WIN64) + zf->length = GetFileSize((HANDLE) handle, 0); + if ( + (zf->length == INVALID_FILE_SIZE) || + (zf->length < ZIP_CENTRAL_END_LEN) + ) { + ZIPFS_ERROR(interp,"invalid file size"); + goto error; + } + zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0, + zf->length, 0); + if (zf->mh == INVALID_HANDLE_VALUE) { + ZIPFS_ERROR(interp,"file mapping failed"); + goto error; + } + zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length); + if (zf->data == NULL) { + ZIPFS_ERROR(interp,"file mapping failed"); + goto error; + } +#else + zf->length = lseek((int) (long) handle, 0, SEEK_END); + if ((zf->length == -1) || (zf->length < ZIP_CENTRAL_END_LEN)) { + ZIPFS_ERROR(interp,"invalid file size"); + goto error; + } + lseek((int) (long) handle, 0, SEEK_SET); + zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ, + MAP_FILE | MAP_PRIVATE, + (int) (long) handle, 0); + if (zf->data == MAP_FAILED) { + ZIPFS_ERROR(interp,"file mapping failed"); + goto error; + } +#endif + } + return ZipFS_Find_TOC(interp,needZip,zf); + +error: + ZipFSCloseArchive(interp, zf); + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSRootNode -- + * + * This function generates the root node for a ZIPFS filesystem + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise with an error message + * placed into the given "interp" if it is not NULL. + * + * Side effects: + *------------------------------------------------------------------------- + */ + +static int +ZipFS_Catalogue_Filesystem(Tcl_Interp *interp, ZipFile *zf0, const char *mntpt, const char *passwd, const char *zipname) +{ + int i, pwlen, isNew; + ZipFile *zf; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_DString ds, dsm, fpBuf; + unsigned char *q; +#if HAS_DRIVES + int drive = 0; +#endif + WriteLock(); + + pwlen = 0; + if (passwd != NULL) { + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; + } + } + /* + * Mount point sometimes is a relative or otherwise denormalized path. + * But an absolute name is needed as mount point here. + */ + Tcl_DStringInit(&ds); + Tcl_DStringInit(&dsm); + if (strcmp(mntpt, "/") == 0) { + mntpt = ""; + } else { + mntpt = CanonicalPath("",mntpt, &dsm, 1); + } + hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mntpt, &isNew); + if (!isNew) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (interp != NULL) { + Tcl_AppendResult(interp, zf->name, " is already mounted on ", mntpt, (char *) NULL); + } + Unlock(); + ZipFSCloseArchive(interp, zf0); + return TCL_ERROR; + } + 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; + } + Unlock(); + *zf = *zf0; + zf->mntpt = Tcl_GetHashKey(&ZipFS.zipHash, hPtr); + zf->mntptlen=strlen(zf->mntpt); + zf->name = strdup(zipname); + zf->namelen= strlen(zipname); + zf->entries = NULL; + zf->topents = NULL; + zf->nopen = 0; + Tcl_SetHashValue(hPtr, (ClientData) zf); + if ((zf->pwbuf[0] == 0) && pwlen) { + int k = 0; + i = pwlen; + zf->pwbuf[k++] = i; + while (i > 0) { + zf->pwbuf[k] = (passwd[i - 1] & 0x0f) | + pwrot[(passwd[i - 1] >> 4) & 0x0f]; + k++; + i--; + } + zf->pwbuf[k] = '\0'; + } + if (mntpt[0] != '\0') { + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(mntpt); + z->zipfile = zf; + z->isdir = (zf->baseoffs == 0) ? 1 : -1; /* root marker */ + z->isenc = 0; + z->offset = zf->baseoffs; + z->crc32 = 0; + z->timestamp = 0; + z->nbyte = z->nbytecompr = 0; + z->cmeth = ZIP_COMPMETH_STORED; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew); + if (!isNew) { + /* skip it */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + } + } + q = zf->data + zf->centoffs; + Tcl_DStringInit(&fpBuf); + for (i = 0; i < zf->nfiles; i++) { + int pathlen, comlen, extra, isdir = 0, dosTime, dosDate, nbcompr, offs; + unsigned char *lq, *gq = NULL; + char *fullpath, *path; + + pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS); + comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS); + extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen); + path = Tcl_DStringValue(&ds); + if ((pathlen > 0) && (path[pathlen - 1] == '/')) { + Tcl_DStringSetLength(&ds, pathlen - 1); + path = Tcl_DStringValue(&ds); + isdir = 1; + } + if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) { + goto nextent; + } + lq = zf->data + zf->baseoffs + zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS); + if ((lq < zf->data) || (lq > (zf->data + zf->length))) { + goto nextent; + } + nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS); + if ( + !isdir && (nbcompr == 0) + && (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0) + && (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0) + ) { + gq = q; + nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS); + } + offs = (lq - zf->data) + + ZIP_LOCAL_HEADER_LEN + + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS) + + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS); + if ((offs + nbcompr) > zf->length) { + goto nextent; + } + if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) { +#ifdef ANDROID + /* + * When mounting the ZIP archive on the root directory try + * to remap top level regular files of the archive to + * /assets/.root/... since this directory should not be + * in a valid APK due to the leading dot in the file name + * component. This trick should make the files + * AndroidManifest.xml, resources.arsc, and classes.dex + * visible to Tcl. + */ + Tcl_DString ds2; + + Tcl_DStringInit(&ds2); + Tcl_DStringAppend(&ds2, "assets/.root/", -1); + Tcl_DStringAppend(&ds2, path, -1); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2)); + if (hPtr != NULL) { + /* should not happen but skip it anyway */ + Tcl_DStringFree(&ds2); + goto nextent; + } + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), Tcl_DStringLength(&ds2)); + path = Tcl_DStringValue(&ds); + Tcl_DStringFree(&ds2); +#else + /* + * Regular files skipped when mounting on root. + */ + goto nextent; +#endif + } + Tcl_DStringSetLength(&fpBuf, 0); + fullpath = CanonicalPath(mntpt, path, &fpBuf, 1); + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = CountSlashes(fullpath); + z->zipfile = zf; + z->isdir = isdir; + z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) && (nbcompr > 12); + z->offset = offs; + if (gq != NULL) { + z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS); + dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS); + dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS); + } else { + z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS); + dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS); + dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS); + z->timestamp = DosTimeDate(dosDate, dosTime); + z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS); + z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS); + } + z->nbytecompr = nbcompr; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) z); + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + z->next = zf->entries; + zf->entries = z; + if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) { + z->tnext = zf->topents; + zf->topents = z; + } + if (!z->isdir && (z->depth > 1)) { + char *dir, *end; + ZipEntry *zd; + + Tcl_DStringSetLength(&ds, strlen(z->name) + 8); + Tcl_DStringSetLength(&ds, 0); + Tcl_DStringAppend(&ds, z->name, -1); + dir = Tcl_DStringValue(&ds); + end = strrchr(dir, '/'); + while ((end != NULL) && (end != dir)) { + Tcl_DStringSetLength(&ds, end - dir); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir); + if (hPtr != NULL) { + break; + } + zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd)); + zd->name = NULL; + zd->tnext = NULL; + zd->depth = CountSlashes(dir); + zd->zipfile = zf; + zd->isdir = 1; + zd->isenc = 0; + zd->offset = z->offset; + zd->crc32 = 0; + zd->timestamp = z->timestamp; + zd->nbyte = zd->nbytecompr = 0; + zd->cmeth = ZIP_COMPMETH_STORED; + zd->data = NULL; + hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew); + if (!isNew) { + /* should not happen but skip it anyway */ + Tcl_Free((char *) zd); + } else { + Tcl_SetHashValue(hPtr, (ClientData) zd); + zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr); + zd->next = zf->entries; + zf->entries = zd; + if ((mntpt[0] == '\0') && (zd->depth == 1)) { + zd->tnext = zf->topents; + zf->topents = zd; + } + } + end = strrchr(dir, '/'); + } + } + } +nextent: + q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN; + } + Tcl_DStringFree(&fpBuf); + Tcl_DStringFree(&ds); + Tcl_FSMountsChanged(NULL); + Unlock(); + return TCL_OK; +} + +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 + * a given mountpoint with optional ZIP password. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is read, analyzed and mounted, resources are + * allocated. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfs_Mount( + Tcl_Interp *interp, + const char *mntpt, + const char *zipname, + const char *passwd +) { + int i, pwlen; + ZipFile *zf; + + ReadLock(); + if (!ZipFS.initialized) { + TclZipfs_C_Init(); + } + if (mntpt == NULL) { + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int ret = TCL_OK; + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + + if (zipname == NULL) { + Tcl_HashEntry *hPtr; + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); + } + } + Unlock(); + return TCL_OK; + } + Unlock(); + pwlen = 0; + if (passwd != NULL) { + pwlen = strlen(passwd); + if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) { + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + } + return TCL_ERROR; + } + } + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + return TCL_ERROR; + } + if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) { + return TCL_ERROR; + } + return ZipFS_Catalogue_Filesystem(interp,zf,mntpt,passwd,zipname); +} + +/* + *------------------------------------------------------------------------- + * + * TclZipfs_Mount_Buffer -- + * + * This procedure is invoked to mount a given ZIP archive file on + * a given mountpoint with optional ZIP password. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is read, analyzed and mounted, resources are + * allocated. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfs_Mount_Buffer( + Tcl_Interp *interp, + const char *mntpt, + unsigned char *data, + size_t datalen, + int copy +) { + int i; + ZipFile *zf; + + ReadLock(); + if (!ZipFS.initialized) { + TclZipfs_C_Init(); + } + if (mntpt == NULL) { + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int ret = TCL_OK; + + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + + if (data == NULL) { + Tcl_HashEntry *hPtr; + + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); + } + } + Unlock(); + return TCL_OK; + } + Unlock(); + zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1); + if (zf == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + return TCL_ERROR; + } + zf->is_membuf=1; + zf->length=datalen; + if(copy) { + zf->data=(unsigned char *)Tcl_AttemptAlloc(datalen); + if (zf->data == NULL) { + if (interp != NULL) { + Tcl_AppendResult(interp, "out of memory", (char *) NULL); + } + return TCL_ERROR; + } + memcpy(zf->data,data,datalen); + zf->tofree=zf->data; + } else { + zf->data=data; + zf->tofree=NULL; + } + if(ZipFS_Find_TOC(interp,0,zf)!=TCL_OK) { + return TCL_ERROR; + } + return ZipFS_Catalogue_Filesystem(interp,zf,mntpt,NULL,"Memory Buffer"); +} + +/* + *------------------------------------------------------------------------- + * + * TclZipfs_Unmount -- + * + * This procedure is invoked to unmount a given ZIP archive. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A mounted ZIP archive file is unmounted, resources are free'd. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfs_Unmount(Tcl_Interp *interp, const char *mntpt) +{ + ZipFile *zf; + ZipEntry *z, *znext; + Tcl_HashEntry *hPtr; + Tcl_DString dsm; + int ret = TCL_OK, unmounted = 0; + + WriteLock(); + if (!ZipFS.initialized) goto done; + /* + * 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); + + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + + /* don't report error */ + if (hPtr == NULL) goto done; + + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->nopen > 0) { + ZIPFS_ERROR(interp,"filesystem is busy"); + ret = TCL_ERROR; + goto done; + } + Tcl_DeleteHashEntry(hPtr); + for (z = zf->entries; z; z = znext) { + znext = z->next; + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name); + if (hPtr) { + Tcl_DeleteHashEntry(hPtr); + } + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + Tcl_Free((char *) z); + } + ZipFSCloseArchive(interp, zf); + Tcl_Free((char *) zf); + unmounted = 1; +done: + Unlock(); + if (unmounted) { + Tcl_FSMountsChanged(NULL); + } + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMountObjCmd -- + * + * This procedure is invoked to process the "zipfs::mount" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is mounted, resources are allocated. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMountObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + if (objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, + "?mountpoint? ?zipfile? ?password?"); + return TCL_ERROR; + } + return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL, + (objc > 2) ? Tcl_GetString(objv[2]) : NULL, + (objc > 3) ? Tcl_GetString(objv[3]) : NULL); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMountObjCmd -- + * + * This procedure is invoked to process the "zipfs::mount" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A ZIP archive file is mounted, resources are allocated. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMountBufferObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + const char *mntpt; + unsigned char *data; + int length; + if (objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); + return TCL_ERROR; + } + if(objc<2) { + int i; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + int ret = TCL_OK; + ZipFile *zf; + + ReadLock(); + i = 0; + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (interp != NULL) { + Tcl_AppendElement(interp, zf->mntpt); + Tcl_AppendElement(interp, zf->name); + } + ++i; + } + hPtr = Tcl_NextHashEntry(&search); + } + if (interp == NULL) { + ret = (i > 0) ? TCL_OK : TCL_BREAK; + } + Unlock(); + return ret; + } + mntpt=Tcl_GetString(objv[1]); + if(objc<3) { + Tcl_HashEntry *hPtr; + ZipFile *zf; + + if (interp == NULL) { + Unlock(); + return TCL_OK; + } + hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt); + if (hPtr != NULL) { + if ((zf = Tcl_GetHashValue(hPtr)) != NULL) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1)); + } + } + Unlock(); + return TCL_OK; + } + data=Tcl_GetByteArrayFromObj(objv[2],&length); + return TclZipfs_Mount_Buffer(interp, mntpt,data,length,1); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSRootObjCmd -- + * + * This procedure is invoked to process the "zipfs::root" command. It + * returns the root that all zipfs file systems are mounted under. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSRootObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + Tcl_SetObjResult(interp,Tcl_NewStringObj(ZIPFS_VOLUME, -1)); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSUnmountObjCmd -- + * + * This procedure is invoked to process the "zipfs::unmount" command. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A mounted ZIP archive file is unmounted, resources are free'd. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSUnmountObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "zipfile"); + return TCL_ERROR; + } + return TclZipfs_Unmount(interp, Tcl_GetString(objv[1])); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkKeyObjCmd -- + * + * This procedure is invoked to process the "zipfs::mkkey" command. + * It produces a rotated password to be embedded into an image file. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkKeyObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + int len, i = 0; + char *pw, pwbuf[264]; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "password"); + return TCL_ERROR; + } + pw = Tcl_GetString(objv[1]); + len = strlen(pw); + if (len == 0) { + return TCL_OK; + } + if ((len > 255) || (strchr(pw, 0xff) != NULL)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; + } + while (len > 0) { + int ch = pw[len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + Tcl_AppendResult(interp, pwbuf, (char *) NULL); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipAddFile -- + * + * This procedure is used by ZipFSMkZipOrImgCmd() to add a single + * file to the output ZIP archive file being written. A ZipEntry + * struct about the input file is added to the given fileHash table + * for later creation of the central ZIP directory. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Input file is read and (compressed and) written to the output + * ZIP archive file. + * + *------------------------------------------------------------------------- + */ + +static int +ZipAddFile( + Tcl_Interp *interp, const char *path, const char *name, + Tcl_Channel out, const char *passwd, + char *buf, int bufsize, Tcl_HashTable *fileHash +) { + Tcl_Channel in; + Tcl_HashEntry *hPtr; + ZipEntry *z; + z_stream stream; + const char *zpath; + int nbyte, nbytecompr, len, crc, flush, pos[3], zpathlen, olen; + int mtime = 0, isNew, align = 0, cmeth; + unsigned long keys[3], keys0[3]; + char obuf[4096]; + + zpath = name; + while (zpath != NULL && zpath[0] == '/') { + zpath++; + } + if ((zpath == NULL) || (zpath[0] == '\0')) { + return TCL_OK; + } + zpathlen = strlen(zpath); + if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { + Tcl_AppendResult(interp, "path too long for \"", path, "\"", (char *) NULL); + return TCL_ERROR; + } + in = Tcl_OpenFileChannel(interp, path, "r", 0); + if ( + (in == NULL) + || (Tcl_SetChannelOption(interp, in, "-translation", "binary") != TCL_OK) + || (Tcl_SetChannelOption(interp, in, "-encoding", "binary") != TCL_OK) + ) { +#if defined(_WIN32) || defined(_WIN64) + /* hopefully a directory */ + if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } +#endif + Tcl_Close(interp, in); + return TCL_ERROR; + } else { + Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1); + Tcl_StatBuf statBuf; + + Tcl_IncrRefCount(pathObj); + if (Tcl_FSStat(pathObj, &statBuf) != -1) { + mtime = statBuf.st_mtime; + } + Tcl_DecrRefCount(pathObj); + } + Tcl_ResetResult(interp); + crc = 0; + nbyte = nbytecompr = 0; + while ((len = Tcl_Read(in, buf, bufsize)) > 0) { + crc = crc32(crc, (unsigned char *) buf, len); + nbyte += len; + } + if (len == -1) { + if (nbyte == 0) { + if (strcmp("illegal operation on a directory", + Tcl_PosixError(interp)) == 0) { + Tcl_Close(interp, in); + return TCL_OK; + } + } + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + if (Tcl_Seek(in, 0, SEEK_SET) == -1) { + Tcl_AppendResult(interp, "seek error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + pos[0] = Tcl_Tell(out); + memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); + memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen); + len = zpathlen + ZIP_LOCAL_HEADER_LEN; + 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; + + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) { + Tcl_AppendResult(interp, "PRNG error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + ret = Tcl_GetObjResult(interp); + if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) { + Tcl_Close(interp, in); + return TCL_ERROR; + } + kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp); + } + Tcl_ResetResult(interp); + init_keys(passwd, keys, crc32tab); + for (i = 0; i < 12 - 2; i++) { + kvbuf[i] = (unsigned char) zencode(keys, crc32tab, kvbuf[i + 12], tmp); + } + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp); + kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp); + len = Tcl_Write(out, (char *) kvbuf, 12); + memset(kvbuf, 0, 24); + if (len != 12) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + memcpy(keys0, keys, sizeof (keys0)); + nbytecompr += 12; + } + Tcl_Flush(out); + pos[2] = Tcl_Tell(out); + cmeth = ZIP_COMPMETH_DEFLATED; + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) { + Tcl_AppendResult(interp, "compression init error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + do { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + stream.avail_in = len; + stream.next_in = (unsigned char *) buf; + flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH; + do { + stream.avail_out = sizeof (obuf); + stream.next_out = (unsigned char *) obuf; + len = deflate(&stream, flush); + if (len == Z_STREAM_ERROR) { + Tcl_AppendResult(interp, "deflate error on \"", path, "\"", + (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + olen = sizeof (obuf) - stream.avail_out; + if (passwd != NULL) { + int i, tmp; + + for (i = 0; i < olen; i++) { + obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); + } + } + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + deflateEnd(&stream); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += olen; + } while (stream.avail_out == 0); + } while (flush != Z_FINISH); + deflateEnd(&stream); + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + if (nbyte - nbytecompr <= 0) { + /* + * Compressed file larger than input, + * write it again uncompressed. + */ + if ((int) Tcl_Seek(in, 0, SEEK_SET) != 0) { + goto seekErr; + } + if ((int) Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) { +seekErr: + Tcl_Close(interp, in); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + nbytecompr = (passwd != NULL) ? 12 : 0; + while (1) { + len = Tcl_Read(in, buf, bufsize); + if (len == -1) { + Tcl_AppendResult(interp, "read error on \"", path, "\"", + (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } else if (len == 0) { + break; + } + if (passwd != NULL) { + int i, tmp; + + for (i = 0; i < len; i++) { + buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); + } + } + if (Tcl_Write(out, buf, len) != len) { + Tcl_AppendResult(interp, "write error", (char *) NULL); + Tcl_Close(interp, in); + return TCL_ERROR; + } + nbytecompr += len; + } + cmeth = ZIP_COMPMETH_STORED; + Tcl_Flush(out); + pos[1] = Tcl_Tell(out); + Tcl_TruncateChannel(out, pos[1]); + } + Tcl_Close(interp, in); + + z = (ZipEntry *) Tcl_Alloc(sizeof (*z)); + z->name = NULL; + z->tnext = NULL; + z->depth = 0; + z->zipfile = NULL; + z->isdir = 0; + z->isenc = (passwd != NULL) ? 1 : 0; + z->offset = pos[0]; + z->crc32 = crc; + z->timestamp = mtime; + z->nbyte = nbyte; + z->nbytecompr = nbytecompr; + z->cmeth = cmeth; + z->data = NULL; + hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew); + if (!isNew) { + Tcl_AppendResult(interp, "non-unique path name \"", path, "\"", + (char *) NULL); + Tcl_Free((char *) z); + return TCL_ERROR; + } else { + Tcl_SetHashValue(hPtr, (ClientData) z); + z->name = Tcl_GetHashKey(fileHash, hPtr); + z->next = NULL; + } + + /* + * Write final local header information. + */ + zip_write_int(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG); + zip_write_short(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_LOCAL_FLAGS_OFFS, z->isenc); + zip_write_short(buf + ZIP_LOCAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_LOCAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen); + zip_write_short(buf + ZIP_LOCAL_EXTRALEN_OFFS, align); + if ((int) Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "write error", (char *) NULL); + return TCL_ERROR; + } + Tcl_Flush(out); + if ((int) Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) { + Tcl_DeleteHashEntry(hPtr); + Tcl_Free((char *) z); + Tcl_AppendResult(interp, "seek error", (char *) NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkZipOrImgObjCmd -- + * + * This procedure is creates a new ZIP archive file or image file + * given output filename, input directory of files to be archived, + * optional password, and optional image to be prepended to the + * output ZIP archive file. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * A new ZIP archive file or image file is written. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int isImg, int isList, int objc, Tcl_Obj *const objv[]) +{ + Tcl_Channel out; + int len = 0, pwlen = 0, slen = 0, i, count, ret = TCL_ERROR, lobjc, pos[3]; + Tcl_Obj **lobjv, *list = NULL; + ZipEntry *z; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_HashTable fileHash; + char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096]; + + if (isList) { + if ((objc < 3) || (objc > (isImg ? 5 : 4))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile inlist ?password infile?" : + "outfile inlist ?password?"); + return TCL_ERROR; + } + } else { + if ((objc < 3) || (objc > (isImg ? 6 : 5))) { + Tcl_WrongNumArgs(interp, 1, objv, isImg ? + "outfile indir ?strip? ?password? ?infile?" : + "outfile indir ?strip? ?password?"); + return TCL_ERROR; + } + } + pwbuf[0] = 0; + if (objc > (isList ? 3 : 4)) { + pw = Tcl_GetString(objv[isList ? 3 : 4]); + pwlen = strlen(pw); + if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("illegal password", -1)); + return TCL_ERROR; + } + } + if (isList) { + list = objv[2]; + Tcl_IncrRefCount(list); + } else { + Tcl_Obj *cmd[3]; + + cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1); + cmd[2] = objv[2]; + cmd[0] = Tcl_NewListObj(2, cmd + 1); + Tcl_IncrRefCount(cmd[0]); + if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) { + Tcl_DecrRefCount(cmd[0]); + return TCL_ERROR; + } + Tcl_DecrRefCount(cmd[0]); + list = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(list); + } + if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) { + Tcl_DecrRefCount(list); + return TCL_ERROR; + } + if (isList && (lobjc % 2)) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, + Tcl_NewStringObj("need even number of elements", -1)); + return TCL_ERROR; + } + if (lobjc == 0) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1)); + return TCL_ERROR; + } + out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755); + if ( + (out == NULL) + || (Tcl_SetChannelOption(interp, out, "-translation", "binary") != TCL_OK) + || (Tcl_SetChannelOption(interp, out, "-encoding", "binary") != TCL_OK) + ) { + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + if (pwlen <= 0) { + pw = NULL; + pwlen = 0; + } + if (isImg) { + ZipFile *zf, zf0; + int isMounted = 0; + const char *imgName; + + if (isList) { + imgName = (objc > 4) ? Tcl_GetString(objv[4]) : Tcl_GetNameOfExecutable(); + } else { + imgName = (objc > 5) ? Tcl_GetString(objv[5]) : Tcl_GetNameOfExecutable(); + } + if (pwlen) { + i = 0; + len = pwlen; + while (len > 0) { + int ch = pw[len - 1]; + + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + i++; + len--; + } + pwbuf[i] = i; + ++i; + pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG; + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16); + pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24); + pwbuf[i] = '\0'; + } + /* Check for mounted image */ + WriteLock(); + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) { + if (strcmp(zf->name, imgName) == 0) { + isMounted = 1; + zf->nopen++; + break; + } + } + hPtr = Tcl_NextHashEntry(&search); + } + Unlock(); + if (!isMounted) { + zf = &zf0; + } + if (isMounted || + (ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK)) { + i = Tcl_Write(out, (char *) zf->data, zf->baseoffsp); + if (i != zf->baseoffsp) { + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + if (zf == &zf0) { + ZipFSCloseArchive(interp, zf); + } else { + WriteLock(); + zf->nopen--; + Unlock(); + } + return TCL_ERROR; + } + if (zf == &zf0) { + ZipFSCloseArchive(interp, zf); + } else { + WriteLock(); + zf->nopen--; + Unlock(); + } + } else { + int k, n, m; + Tcl_Channel in; + const char *errMsg = "seek error"; + + /* + * Fall back to read it as plain file which + * hopefully is a static tclsh or wish binary + * with proper zipfs infrastructure built in. + */ + Tcl_ResetResult(interp); + in = Tcl_OpenFileChannel(interp, imgName, "r", 0644); + if (in == NULL) { + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_DecrRefCount(list); + Tcl_Close(interp, out); + return TCL_ERROR; + } + Tcl_SetChannelOption(interp, in, "-translation", "binary"); + Tcl_SetChannelOption(interp, in, "-encoding", "binary"); + i = Tcl_Seek(in, 0, SEEK_END); + if (i == -1) { +cperr: + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); + Tcl_Close(interp, out); + Tcl_Close(interp, in); + return TCL_ERROR; + } + Tcl_Seek(in, 0, SEEK_SET); + k = 0; + while (k < i) { + m = i - k; + if (m > sizeof (buf)) { + m = sizeof (buf); + } + n = Tcl_Read(in, buf, m); + if (n == -1) { + errMsg = "read error"; + goto cperr; + } else if (n == 0) { + break; + } + m = Tcl_Write(out, buf, n); + if (m != n) { + errMsg = "write error"; + goto cperr; + } + k += m; + } + Tcl_Close(interp, in); + } + len = strlen(pwbuf); + if (len > 0) { + i = Tcl_Write(out, pwbuf, len); + if (i != len) { + Tcl_DecrRefCount(list); + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + Tcl_Close(interp, out); + return TCL_ERROR; + } + } + memset(pwbuf, 0, sizeof (pwbuf)); + Tcl_Flush(out); + } + Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS); + pos[0] = Tcl_Tell(out); + if (!isList && (objc > 3)) { + strip = Tcl_GetString(objv[3]); + slen = strlen(strip); + } + for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { + const char *path, *name; + + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; + } + } + while (name[0] == '/') { + ++name; + } + if (name[0] == '\0') { + continue; + } + if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf), + &fileHash) != TCL_OK) { + goto done; + } + } + pos[1] = Tcl_Tell(out); + count = 0; + for (i = 0; i < lobjc; i += (isList ? 2 : 1)) { + const char *path, *name; + + path = Tcl_GetString(lobjv[i]); + if (isList) { + name = Tcl_GetString(lobjv[i + 1]); + } else { + name = path; + if (slen > 0) { + len = strlen(name); + if ((len <= slen) || (strncmp(strip, name, slen) != 0)) { + continue; + } + name += slen; + } + } + while (name[0] == '/') { + ++name; + } + if (name[0] == '\0') { + continue; + } + hPtr = Tcl_FindHashEntry(&fileHash, name); + if (hPtr == NULL) { + continue; + } + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + len = strlen(z->name); + zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG); + zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION); + zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0); + zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth); + zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp)); + zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp)); + zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32); + zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr); + zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte); + zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len); + zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0); + zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]); + if ( + (Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) + || (Tcl_Write(out, z->name, len) != len) + ) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + goto done; + } + count++; + } + Tcl_Flush(out); + pos[2] = Tcl_Tell(out); + zip_write_int(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG); + zip_write_short(buf + ZIP_CENTRAL_DISKNO_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0); + zip_write_short(buf + ZIP_CENTRAL_ENTS_OFFS, count); + zip_write_short(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count); + zip_write_int(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]); + zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]); + zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0); + if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1)); + goto done; + } + Tcl_Flush(out); + ret = TCL_OK; +done: + if (ret == TCL_OK) { + ret = Tcl_Close(interp, out); + } else { + Tcl_Close(interp, out); + } + Tcl_DecrRefCount(list); + hPtr = Tcl_FirstHashEntry(&fileHash, &search); + while (hPtr != NULL) { + z = (ZipEntry *) Tcl_GetHashValue(hPtr); + Tcl_Free((char *) z); + Tcl_DeleteHashEntry(hPtr); + hPtr = Tcl_NextHashEntry(&search); + } + Tcl_DeleteHashTable(&fileHash); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSMkZipObjCmd -- + * + * This procedure is invoked to process the "zipfs::mkzip" command. + * See description of ZipFSMkZipOrImgCmd(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See description of ZipFSMkZipOrImgCmd(). + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkZipObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv); +} + +static int +ZipFSLMkZipObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSZipFSOpenArchiveObjCmd -- + * + * This procedure is invoked to process the "zipfs::mkimg" command. + * See description of ZipFSMkZipOrImgCmd(). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See description of ZipFSMkZipOrImgCmd(). + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv); +} + +static int +ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv); +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSCanonicalObjCmd -- + * + * This procedure is invoked to process the "zipfs::canonical" command. + * It returns the canonical name for a file within zipfs + * + * Results: + * Always TCL_OK. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSCanonicalObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + char *mntpoint=NULL; + char *filename=NULL; + char *result; + Tcl_DString dPath; + + if (objc != 2 && objc != 3 && objc!=4) { + Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?"); + return TCL_ERROR; + } + Tcl_DStringInit(&dPath); + if(objc==2) { + filename = Tcl_GetString(objv[1]); + result=CanonicalPath("",filename,&dPath,1); + } else if (objc==3) { + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,1); + } else { + int zipfs=0; + if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) { + return TCL_ERROR; + } + mntpoint = Tcl_GetString(objv[1]); + filename = Tcl_GetString(objv[2]); + result=CanonicalPath(mntpoint,filename,&dPath,zipfs); + } + Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1)); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSExistsObjCmd -- + * + * This procedure is invoked to process the "zipfs::exists" command. + * It tests for the existence of a file in the ZIP filesystem and + * places a boolean into the interp's result. + * + * Results: + * Always TCL_OK. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSExistsObjCmd( + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[] +) { + char *filename; + int exists; + Tcl_DString ds; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; + } + + /* prepend ZIPFS_VOLUME to filename, eliding the final / */ + filename = Tcl_GetStringFromObj(objv[1], 0); + Tcl_DStringInit(&ds); + Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN-1); + Tcl_DStringAppend(&ds, filename, -1); + filename = Tcl_DStringValue(&ds); + + ReadLock(); + exists = ZipFSLookup(filename) != NULL; + Unlock(); + + Tcl_SetObjResult(interp,Tcl_NewBooleanObj(exists)); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSInfoObjCmd -- + * + * This procedure is invoked to process the "zipfs::info" command. + * On success, it returns a Tcl list made up of name of ZIP archive + * file, size uncompressed, size compressed, and archive offset of + * a file in the ZIP filesystem. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSInfoObjCmd( + ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[] +) { + char *filename; + ZipEntry *z; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "filename"); + return TCL_ERROR; + } + filename = Tcl_GetStringFromObj(objv[1], 0); + ReadLock(); + z = ZipFSLookup(filename); + if (z != NULL) { + Tcl_Obj *result = Tcl_GetObjResult(interp); + + Tcl_ListObjAppendElement(interp, result, + Tcl_NewStringObj(z->zipfile->name, -1)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbyte)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->nbytecompr)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(z->offset)); + } + Unlock(); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipFSListObjCmd -- + * + * This procedure is invoked to process the "zipfs::list" command. + * On success, it returns a Tcl list of files of the ZIP filesystem + * which match a search pattern (glob or regexp). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSListObjCmd( + ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[] +) { + char *pattern = NULL; + Tcl_RegExp regexp = NULL; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *result = Tcl_GetObjResult(interp); + + if (objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?"); + return TCL_ERROR; + } + if (objc == 3) { + int n; + char *what = Tcl_GetStringFromObj(objv[1], &n); + + if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) { + pattern = Tcl_GetString(objv[2]); + } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) { + regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2])); + if (regexp == NULL) { + return TCL_ERROR; + } + } else { + Tcl_AppendResult(interp, "unknown option \"", what,"\"", (char *) NULL); + return TCL_ERROR; + } + } else if (objc == 2) { + pattern = Tcl_GetStringFromObj(objv[1], 0); + } + ReadLock(); + if (pattern != NULL) { + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if (Tcl_StringMatch(z->name, pattern)) { + Tcl_ListObjAppendElement(interp, result,Tcl_NewStringObj(z->name, -1)); + } + } + } else if (regexp != NULL) { + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { + Tcl_ListObjAppendElement(interp, result,Tcl_NewStringObj(z->name, -1)); + } + } + } else { + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1)); + } + } + Unlock(); + return TCL_OK; +} + +#if defined(_WIN32) || defined(_WIN64) +#define LIBRARY_SIZE 64 +static int +ToUtf( + const WCHAR *wSrc, + char *dst) +{ + char *start; + + start = dst; + while (*wSrc != '\0') { + dst += Tcl_UniCharToUtf(*wSrc, dst); + wSrc++; + } + *dst = '\0'; + return (int) (dst - start); +} +#endif + +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. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static int +ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]) +{ + Tcl_Obj *pResult; + + pResult=TclZipfs_TclLibrary(); + if(!pResult) { + pResult=Tcl_NewObj(); + } + Tcl_SetObjResult(interp,pResult); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelClose -- + * + * This function is called to close a channel. + * + * Results: + * Always TCL_OK. + * + * Side effects: + * Resources are free'd. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelClose(ClientData instanceData, Tcl_Interp *interp) +{ + ZipChannel *info = (ZipChannel *) instanceData; + + if (info->iscompr && (info->ubuf != NULL)) { + Tcl_Free((char *) info->ubuf); + info->ubuf = NULL; + } + if (info->isenc) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + } + if (info->iswr) { + ZipEntry *z = info->zipentry; + unsigned char *newdata; + + newdata = (unsigned char *) Tcl_AttemptRealloc((char *) info->ubuf, info->nread); + if (newdata != NULL) { + if (z->data != NULL) { + Tcl_Free((char *) z->data); + } + z->data = newdata; + z->nbyte = z->nbytecompr = info->nbyte; + z->cmeth = ZIP_COMPMETH_STORED; + z->timestamp = time(NULL); + z->isdir = 0; + z->isenc = 0; + z->offset = 0; + z->crc32 = 0; + } else { + Tcl_Free((char *) info->ubuf); + } + } + WriteLock(); + info->zipfile->nopen--; + Unlock(); + Tcl_Free((char *) info); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelRead -- + * + * This function is called to read data from channel. + * + * Results: + * Number of bytes read or -1 on error with error number set. + * + * Side effects: + * Data is read and file pointer is advanced. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long nextpos; + + if (info->isdir < 0) { + /* + * Special case: when executable combined with ZIP archive file + * read data in front of ZIP, i.e. the executable itself. + */ + nextpos = info->nread + toRead; + if (nextpos > info->zipfile->baseoffs) { + toRead = info->zipfile->baseoffs - info->nread; + nextpos = info->zipfile->baseoffs; + } + if (toRead == 0) { + return 0; + } + memcpy(buf, info->zipfile->data, toRead); + info->nread = nextpos; + *errloc = 0; + return toRead; + } + if (info->isdir) { + *errloc = EISDIR; + return -1; + } + nextpos = info->nread + toRead; + if (nextpos > info->nbyte) { + toRead = info->nbyte - info->nread; + nextpos = info->nbyte; + } + if (toRead == 0) { + return 0; + } + if (info->isenc) { + int i, ch; + + for (i = 0; i < toRead; i++) { + ch = info->ubuf[i + info->nread]; + buf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(buf, info->ubuf + info->nread, toRead); + } + info->nread = nextpos; + *errloc = 0; + return toRead; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelWrite -- + * + * This function is called to write data into channel. + * + * Results: + * Number of bytes written or -1 on error with error number set. + * + * Side effects: + * Data is written and file pointer is advanced. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelWrite(ClientData instanceData, const char *buf, + int toWrite, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long nextpos; + + if (!info->iswr) { + *errloc = EINVAL; + return -1; + } + nextpos = info->nread + toWrite; + if (nextpos > info->nmax) { + toWrite = info->nmax - info->nread; + nextpos = info->nmax; + } + if (toWrite == 0) { + return 0; + } + memcpy(info->ubuf + info->nread, buf, toWrite); + info->nread = nextpos; + if (info->nread > info->nbyte) { + info->nbyte = info->nread; + } + *errloc = 0; + return toWrite; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelSeek -- + * + * This function is called to position file pointer of channel. + * + * Results: + * New file position or -1 on error with error number set. + * + * Side effects: + * File pointer is repositioned according to offset and mode. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc) +{ + ZipChannel *info = (ZipChannel *) instanceData; + unsigned long end; + + if (!info->iswr && (info->isdir < 0)) { + /* + * Special case: when executable combined with ZIP archive file, + * seek within front of ZIP, i.e. the executable itself. + */ + end = info->zipfile->baseoffs; + } else if (info->isdir) { + *errloc = EINVAL; + return -1; + } else { + end = info->nbyte; + } + switch (mode) { + case SEEK_CUR: + offset += info->nread; + break; + case SEEK_END: + offset += end; + break; + case SEEK_SET: + break; + default: + *errloc = EINVAL; + return -1; + } + if (offset < 0) { + *errloc = EINVAL; + return -1; + } + if (info->iswr) { + if ((unsigned long) offset > info->nmax) { + *errloc = EINVAL; + return -1; + } + if ((unsigned long) offset > info->nbyte) { + info->nbyte = offset; + } + } else if ((unsigned long) offset > end) { + *errloc = EINVAL; + return -1; + } + info->nread = (unsigned long) offset; + return info->nread; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelWatchChannel -- + * + * This function is called for event notifications on channel. + * + * Results: + * None. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static void +ZipChannelWatchChannel(ClientData instanceData, int mask) +{ + return; +} + +/* + *------------------------------------------------------------------------- + * + * ZipChannelGetFile -- + * + * This function is called to retrieve OS handle for channel. + * + * Results: + * Always TCL_ERROR since there's never an OS handle for a + * file within a ZIP archive. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +ZipChannelGetFile( + ClientData instanceData, int direction,ClientData *handlePtr +) { + return TCL_ERROR; +} + +/* + * The channel type/driver definition used for ZIP archive members. + */ + +static Tcl_ChannelType ZipChannelType = { + "zip", /* Type name. */ +#ifdef TCL_CHANNEL_VERSION_4 + TCL_CHANNEL_VERSION_4, + ZipChannelClose, /* Close channel, clean instance data */ + ZipChannelRead, /* Handle read request */ + ZipChannelWrite, /* Handle write request */ + ZipChannelSeek, /* Move location of access point, NULL'able */ + NULL, /* Set options, NULL'able */ + NULL, /* Get options, NULL'able */ + ZipChannelWatchChannel, /* Initialize notifier */ + ZipChannelGetFile, /* Get OS handle from the channel */ + NULL, /* 2nd version of close channel, NULL'able */ + NULL, /* Set blocking mode for raw channel, NULL'able */ + NULL, /* Function to flush channel, NULL'able */ + NULL, /* Function to handle event, NULL'able */ + NULL, /* Wide seek function, NULL'able */ + NULL, /* Thread action function, NULL'able */ +#else + NULL, /* Set blocking/nonblocking behaviour, NULL'able */ + ZipChannelClose, /* Close channel, clean instance data */ + ZipChannelRead, /* Handle read request */ + ZipChannelWrite, /* Handle write request */ + ZipChannelSeek, /* Move location of access point, NULL'able */ + NULL, /* Set options, NULL'able */ + NULL, /* Get options, NULL'able */ + ZipChannelWatchChannel, /* Initialize notifier */ + ZipChannelGetFile, /* Get OS handle from the channel */ +#endif +}; + +/* + *------------------------------------------------------------------------- + * + * ZipChannelOpen -- + * + * This function opens a Tcl_Channel on a file from a mounted ZIP + * archive according to given open mode. + * + * Results: + * Tcl_Channel on success, or NULL on error. + * + * Side effects: + * Memory is allocated, the file from the ZIP archive is uncompressed. + * + *------------------------------------------------------------------------- + */ + +static Tcl_Channel +ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions) +{ + ZipEntry *z; + ZipChannel *info; + int i, ch, trunc, wr, flags = 0; + char cname[128]; + + if ( + (mode & O_APPEND) + || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR))) + ) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1)); + } + return NULL; + } + WriteLock(); + z = ZipFSLookup(filename); + if (z == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1)); + Tcl_AppendResult(interp, " \"", filename, "\"", NULL); + } + goto error; + } + trunc = (mode & O_TRUNC) != 0; + wr = (mode & (O_WRONLY | O_RDWR)) != 0; + if ((z->cmeth != ZIP_COMPMETH_STORED) && (z->cmeth != ZIP_COMPMETH_DEFLATED)) { + ZIPFS_ERROR(interp,"unsupported compression method"); + goto error; + } + if (wr && z->isdir) { + ZIPFS_ERROR(interp,"unsupported file type"); + goto error; + } + if (!trunc) { + flags |= TCL_READABLE; + if (z->isenc && (z->zipfile->pwbuf[0] == 0)) { + ZIPFS_ERROR(interp,"decryption failed"); + goto error; + } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) { + ZIPFS_ERROR(interp,"file too large"); + goto error; + } + } else { + flags = TCL_WRITABLE; + } + info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info)); + if (info == NULL) { + ZIPFS_ERROR(interp,"out of memory"); + goto error; + } + info->zipfile = z->zipfile; + info->zipentry = z; + info->nread = 0; + if (wr) { + flags |= TCL_WRITABLE; + info->iswr = 1; + info->isdir = 0; + info->nmax = ZipFS.wrmax; + info->iscompr = 0; + info->isenc = 0; + info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax); + if (info->ubuf == NULL) { +merror0: + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + ZIPFS_ERROR(interp,"out of memory"); + goto error; + } + memset(info->ubuf, 0, info->nmax); + if (trunc) { + info->nbyte = 0; + } else { + if (z->data != NULL) { + unsigned int j = z->nbyte; + + if (j > info->nmax) { + j = info->nmax; + } + memcpy(info->ubuf, z->data, j); + info->nbyte = j; + } else { + unsigned char *zbuf = z->zipfile->data + z->offset; + + if (z->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + zbuf += i; + } + if (z->cmeth == ZIP_COMPMETH_DEFLATED) { + z_stream stream; + int err; + unsigned char *cbuf = NULL; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (z->isenc) { + unsigned int j; + + stream.avail_in -= 12; + cbuf = (unsigned char *) + Tcl_AttemptAlloc(stream.avail_in); + if (cbuf == NULL) { + goto merror0; + } + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + cbuf[j] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = cbuf; + } else { + stream.next_in = zbuf; + } + stream.next_out = info->ubuf; + stream.avail_out = info->nmax; + if (inflateInit2(&stream, -15) != Z_OK) goto cerror0; + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + goto wrapchan; + } +cerror0: + if (cbuf != NULL) { + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) cbuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + ZIPFS_ERROR(interp,"decompression error"); + goto error; + } else if (z->isenc) { + for (i = 0; i < z->nbyte - 12; i++) { + ch = zbuf[i]; + info->ubuf[i] = zdecode(info->keys, crc32tab, ch); + } + } else { + memcpy(info->ubuf, zbuf, z->nbyte); + } + memset(info->keys, 0, sizeof (info->keys)); + goto wrapchan; + } + } + } else if (z->data != NULL) { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = 0; + info->isdir = 0; + info->isenc = 0; + info->nbyte = z->nbyte; + info->nmax = 0; + info->ubuf = z->data; + } else { + flags |= TCL_READABLE; + info->iswr = 0; + info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED; + info->ubuf = z->zipfile->data + z->offset; + info->isdir = z->isdir; + info->isenc = z->isenc; + info->nbyte = z->nbyte; + info->nmax = 0; + if (info->isenc) { + int len = z->zipfile->pwbuf[0]; + char pwbuf[260]; + + for (i = 0; i < len; i++) { + ch = z->zipfile->pwbuf[len - i]; + pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f]; + } + pwbuf[i] = '\0'; + init_keys(pwbuf, info->keys, crc32tab); + memset(pwbuf, 0, sizeof (pwbuf)); + for (i = 0; i < 12; i++) { + ch = info->ubuf[i]; + zdecode(info->keys, crc32tab, ch); + } + info->ubuf += i; + } + if (info->iscompr) { + z_stream stream; + int err; + unsigned char *ubuf = NULL; + unsigned int j; + + memset(&stream, 0, sizeof (stream)); + stream.zalloc = Z_NULL; + stream.zfree = Z_NULL; + stream.opaque = Z_NULL; + stream.avail_in = z->nbytecompr; + if (info->isenc) { + stream.avail_in -= 12; + ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in); + if (ubuf == NULL) { + info->ubuf = NULL; + goto merror; + } + for (j = 0; j < stream.avail_in; j++) { + ch = info->ubuf[j]; + ubuf[j] = zdecode(info->keys, crc32tab, ch); + } + stream.next_in = ubuf; + } else { + stream.next_in = info->ubuf; + } + stream.next_out = info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nbyte); + if (info->ubuf == NULL) { +merror: + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + Tcl_Free((char *) info); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("out of memory", -1)); + } + goto error; + } + stream.avail_out = info->nbyte; + if (inflateInit2(&stream, -15) != Z_OK) { + goto cerror; + } + err = inflate(&stream, Z_SYNC_FLUSH); + inflateEnd(&stream); + if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) { + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + goto wrapchan; + } +cerror: + if (ubuf != NULL) { + info->isenc = 0; + memset(info->keys, 0, sizeof (info->keys)); + Tcl_Free((char *) ubuf); + } + if (info->ubuf != NULL) { + Tcl_Free((char *) info->ubuf); + } + Tcl_Free((char *) info); + ZIPFS_ERROR(interp,"decompression error"); + goto error; + } + } +wrapchan: + sprintf(cname, "zipfs_%lx_%d", (unsigned long) z->offset, ZipFS.idCount++); + z->zipfile->nopen++; + Unlock(); + return Tcl_CreateChannel(&ZipChannelType, cname, (ClientData) info, flags); + +error: + Unlock(); + return NULL; +} + +/* + *------------------------------------------------------------------------- + * + * ZipEntryStat -- + * + * This function implements the ZIP filesystem specific version + * of the library version of stat. + * + * Results: + * See stat documentation. + * + * Side effects: + * See stat documentation. + * + *------------------------------------------------------------------------- + */ + +static int +ZipEntryStat(char *path, Tcl_StatBuf *buf) +{ + ZipEntry *z; + int ret = -1; + + ReadLock(); + z = ZipFSLookup(path); + if (z == NULL) goto done; + + memset(buf, 0, sizeof (Tcl_StatBuf)); + if (z->isdir) { + buf->st_mode = S_IFDIR | 0555; + } else { + buf->st_mode = S_IFREG | 0555; + } + buf->st_size = z->nbyte; + buf->st_mtime = z->timestamp; + buf->st_ctime = z->timestamp; + buf->st_atime = z->timestamp; + ret = 0; +done: + Unlock(); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * ZipEntryAccess -- + * + * This function implements the ZIP filesystem specific version + * of the library version of access. + * + * Results: + * See access documentation. + * + * Side effects: + * See access documentation. + * + *------------------------------------------------------------------------- + */ + +static int +ZipEntryAccess(char *path, int mode) +{ + ZipEntry *z; + + if (mode & 3) return -1; + ReadLock(); + z = ZipFSLookup(path); + Unlock(); + return (z != NULL) ? 0 : -1; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSOpenFileChannelProc -- + * + * Results: + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static Tcl_Channel +Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode, int permissions) +{ + int len; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return NULL; + return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, permissions); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSStatProc -- + * + * This function implements the ZIP filesystem specific version + * of the library version of stat. + * + * Results: + * See stat documentation. + * + * Side effects: + * See stat documentation. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf) +{ + int len; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSAccessProc -- + * + * This function implements the ZIP filesystem specific version + * of the library version of access. + * + * Results: + * See access documentation. + * + * Side effects: + * See access documentation. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode) +{ + int len; + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFilesystemSeparatorProc -- + * + * This function returns the separator to be used for a given path. The + * object returned should have a refCount of zero + * + * Results: + * A Tcl object, with a refCount of zero. If the caller needs to retain a + * reference to the object, it should call Tcl_IncrRefCount, and should + * otherwise free the object. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static Tcl_Obj * +Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr) +{ + return Tcl_NewStringObj("/", -1); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSMatchInDirectoryProc -- + * + * This routine is used by the globbing code to search a directory for + * all files which match a given pattern. + * + * Results: + * The return value is a standard Tcl result indicating whether an + * error occurred in globbing. Errors are left in interp, good + * results are lappend'ed to resultPtr (which must be a valid object). + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ +static int +Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result, + Tcl_Obj *pathPtr, const char *pattern, + Tcl_GlobTypeData *types) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + Tcl_Obj *normPathPtr; + int scnt, len, l, dirOnly = -1, prefixLen, strip = 0; + char *pat, *prefix, *path; + Tcl_DString dsPref; + + if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + + if (types != NULL) { + dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR; + } + + /* the prefix that gets prepended to results */ + prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen); + + /* the (normalized) path we're searching */ + path = Tcl_GetStringFromObj(normPathPtr, &len); + + Tcl_DStringInit(&dsPref); + Tcl_DStringAppend(&dsPref, prefix, prefixLen); + + if (strcmp(prefix, path) == 0) { + prefix = NULL; + } else { + strip = len + 1; + } + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, "/", 1); + prefixLen++; + prefix = Tcl_DStringValue(&dsPref); + } + ReadLock(); + if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) { + l = CountSlashes(path); + if (path[len - 1] == '/') { + len--; + } else { + l++; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + pattern = "*"; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr); + + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + if ( + (lenz > len + 1) + && (strncmp(z->name, path, len) == 0) + && (z->name[len] == '/') + && (CountSlashes(z->name) == l) + && Tcl_StringCaseMatch(z->name + len + 1, pattern, 0) + ) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, lenz); + Tcl_ListObjAppendElement( + NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref)) + ); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name, lenz)); + } + } + z = z->tnext; + } + } else if ( + (zf->mntptlen > len + 1) + && (strncmp(zf->mntpt, path, len) == 0) + && (zf->mntpt[len] == '/') + && (CountSlashes(zf->mntpt) == l) + && Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0) + ) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(zf->mntpt, zf->mntptlen)); + } + } + hPtr = Tcl_NextHashEntry(&search); + } + goto end; + } + if ((pattern == NULL) || (pattern[0] == '\0')) { + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + + if ((dirOnly < 0) || + (!dirOnly && !z->isdir) || + (dirOnly && z->isdir)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name, -1); + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref))); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, + Tcl_NewStringObj(z->name, -1)); + } + } + } + goto end; + } + l = strlen(pattern); + pat = Tcl_Alloc(len + l + 2); + memcpy(pat, path, len); + while ((len > 1) && (pat[len - 1] == '/')) { + --len; + } + if ((len > 1) || (pat[0] != '/')) { + pat[len] = '/'; + ++len; + } + memcpy(pat + len, pattern, l + 1); + scnt = CountSlashes(pat); + for ( + hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&search) + ) { + ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); + if ( + (dirOnly >= 0) && ((dirOnly && !z->isdir) || (!dirOnly && z->isdir)) + ) { + continue; + } + if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { + if (prefix != NULL) { + Tcl_DStringAppend(&dsPref, z->name + strip, -1); + Tcl_ListObjAppendElement( + NULL, result, + Tcl_NewStringObj(Tcl_DStringValue(&dsPref), + Tcl_DStringLength(&dsPref)) + ); + Tcl_DStringSetLength(&dsPref, prefixLen); + } else { + Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name + strip, -1)); + } + } + } + Tcl_Free(pat); +end: + Unlock(); + Tcl_DStringFree(&dsPref); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSPathInFilesystemProc -- + * + * This function determines if the given path object is in the + * ZIP filesystem. + * + * Results: + * TCL_OK when the path object is in the ZIP filesystem, -1 otherwise. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr) +{ + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; + ZipFile *zf; + int ret = -1, len; + char *path; + + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + + path = Tcl_GetStringFromObj(pathPtr, &len); + if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) { + return -1; + } + + len = strlen(path); + + ReadLock(); + hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path); + if (hPtr != NULL) { + ret = TCL_OK; + goto endloop; + } + hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); + while (hPtr != NULL) { + zf = (ZipFile *) Tcl_GetHashValue(hPtr); + if (zf->mntptlen == 0) { + ZipEntry *z = zf->topents; + while (z != NULL) { + int lenz = strlen(z->name); + if ( + (len >= lenz) && (strncmp(path, z->name, lenz) == 0) + ) { + ret = TCL_OK; + goto endloop; + } + z = z->tnext; + } + } else if ( + (len >= zf->mntptlen) && (strncmp(path, zf->mntpt, zf->mntptlen) == 0) + ) { + ret = TCL_OK; + goto endloop; + } + hPtr = Tcl_NextHashEntry(&search); + } +endloop: + Unlock(); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSListVolumesProc -- + * + * Lists the currently mounted ZIP filesystem volumes. + * + * Results: + * The list of volumes. + * + * Side effects: + * None + * + *------------------------------------------------------------------------- + */ +static Tcl_Obj * +Zip_FSListVolumesProc(void) { + return Tcl_NewStringObj(ZIPFS_VOLUME, -1); +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFileAttrStringsProc -- + * + * This function implements the ZIP filesystem dependent 'file attributes' + * subcommand, for listing the set of possible attribute strings. + * + * Results: + * An array of strings + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static const char *const * +Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef) +{ + static const char *const attrs[] = { + "-uncompsize", + "-compsize", + "-offset", + "-mount", + "-archive", + "-permissions", + NULL, + }; + return attrs; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFileAttrsGetProc -- + * + * This function implements the ZIP filesystem specific + * 'file attributes' subcommand, for 'get' operations. + * + * Results: + * Standard Tcl return code. The object placed in objPtrRef (if TCL_OK + * was returned) is likely to have a refCount of zero. Either way we must + * either store it somewhere (e.g. the Tcl result), or Incr/Decr its + * refCount to ensure it is properly freed. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, + Tcl_Obj **objPtrRef) +{ + int len, ret = TCL_OK; + char *path; + ZipEntry *z; + + if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1; + path = Tcl_GetStringFromObj(pathPtr, &len); + ReadLock(); + z = ZipFSLookup(path); + if (z == NULL) { + ZIPFS_ERROR(interp,"file not found"); + ret = TCL_ERROR; + goto done; + } + switch (index) { + case 0: + *objPtrRef = Tcl_NewIntObj(z->nbyte); + goto done; + case 1: + *objPtrRef= Tcl_NewIntObj(z->nbytecompr); + goto done; + case 2: + *objPtrRef= Tcl_NewLongObj(z->offset); + goto done; + case 3: + *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, z->zipfile->mntptlen); + goto done; + case 4: + *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1); + goto done; + case 5: + *objPtrRef= Tcl_NewStringObj("0555", -1); + goto done; + } + ZIPFS_ERROR(interp,"unknown attribute"); + ret = TCL_ERROR; +done: + Unlock(); + return ret; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFileAttrsSetProc -- + * + * This function implements the ZIP filesystem specific + * 'file attributes' subcommand, for 'set' operations. + * + * Results: + * Standard Tcl return code. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr) +{ + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1)); + } + return TCL_ERROR; +} + +/* + *------------------------------------------------------------------------- + * + * Zip_FSFilesystemPathTypeProc -- + * + * Results: + * + * Side effects: + * + *------------------------------------------------------------------------- + */ + +static Tcl_Obj * +Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr) +{ + return Tcl_NewStringObj("zip", -1); +} + + +/* + *------------------------------------------------------------------------- + * + * Zip_FSLoadFile -- + * + * This functions deals with loading native object code. If + * the given path object refers to a file within the ZIP + * filesystem, an approriate error code is returned to delegate + * loading to the caller (by copying the file to temp store + * and loading from there). As fallback when the file refers + * to the ZIP file system but is not present, it is looked up + * relative to the executable and loaded from there when available. + * + * Results: + * TCL_OK on success, TCL_ERROR otherwise with error message left. + * + * Side effects: + * Loads native code into the process address space. + * + *------------------------------------------------------------------------- + */ + +static int +Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle, + Tcl_FSUnloadFileProc **unloadProcPtr, int flags) +{ + Tcl_FSLoadFileProc2 *loadFileProc; +#ifdef ANDROID + /* + * Force loadFileProc to native implementation since the + * package manager already extracted the shared libraries + * from the APK at install time. + */ + + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + if (loadFileProc != NULL) { + return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + } + Tcl_SetErrno(ENOENT); + ZIPFS_ERROR(interp,Tcl_PosixError(interp)); + return TCL_ERROR; +#else + Tcl_Obj *altPath = NULL; + int ret = TCL_ERROR; + + if (Tcl_FSAccess(path, R_OK) == 0) { + /* + * EXDEV should trigger loading by copying to temp store. + */ + + Tcl_SetErrno(EXDEV); + ZIPFS_ERROR(interp,Tcl_PosixError(interp)); + return ret; + } else { + Tcl_Obj *objs[2] = { NULL, NULL }; + + objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME); + if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) { + const char *execName = Tcl_GetNameOfExecutable(); + + /* + * Shared object is not in ZIP but its path prefix is, + * thus try to load from directory where the executable + * came from. + */ + TclDecrRefCount(objs[1]); + objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL); + /* + * Get directory name of executable manually to deal + * with cases where [file dirname [info nameofexecutable]] + * is equal to [info nameofexecutable] due to VFS effects. + */ + if (execName != NULL) { + const char *p = strrchr(execName, '/'); + + if (p > execName + 1) { + --p; + objs[0] = Tcl_NewStringObj(execName, p - execName); + } + } + if (objs[0] == NULL) { + objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(), + TCL_PATH_DIRNAME); + } + if (objs[0] != NULL) { + altPath = TclJoinPath(2, objs); + if (altPath != NULL) { + Tcl_IncrRefCount(altPath); + if (Tcl_FSAccess(altPath, R_OK) == 0) { + path = altPath; + } + } + } + } + if (objs[0] != NULL) { + Tcl_DecrRefCount(objs[0]); + } + if (objs[1] != NULL) { + Tcl_DecrRefCount(objs[1]); + } + } + loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc; + if (loadFileProc != NULL) { + ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags); + } else { + Tcl_SetErrno(ENOENT); + ZIPFS_ERROR(interp,Tcl_PosixError(interp)); + } + if (altPath != NULL) { + Tcl_DecrRefCount(altPath); + } + return ret; +#endif +} + +#endif /* HAVE_ZLIB */ + + + +/* + *------------------------------------------------------------------------- + * + * TclZipfs_Init -- + * + * Perform per interpreter initialization of this module. + * + * Results: + * The return value is a standard Tcl result. + * + * Side effects: + * Initializes this module if not already initialized, and adds + * module related commands to the given interpreter. + * + *------------------------------------------------------------------------- + */ + +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}, + {"mount_data", ZipFSMountBufferObjCmd, NULL, NULL, NULL, 0}, + {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, + {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, + {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, + {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, + {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, + {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, + {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, + {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, + {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, + {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1}, + {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 1}, + {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 0}, + + {NULL, NULL, NULL, NULL, NULL, 0} + }; + static const char findproc[] = + "namespace eval ::tcl::zipfs::zipfs {}\n" + "proc ::tcl::zipfs::find dir {\n" + " set result {}\n" + " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n" + " return $result\n" + " }\n" + " foreach file $list {\n" + " if {$file eq \".\" || $file eq \"..\"} {\n" + " continue\n" + " }\n" + " set file [file join $dir $file]\n" + " lappend result $file\n" + " foreach file [::tcl::zipfs::find $file] {\n" + " lappend result $file\n" + " }\n" + " }\n" + " return [lsort $result]\n" + "}\n"; + Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL); + Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,TCL_LINK_INT); + TclMakeEnsemble(interp, "zipfs", initMap); + Tcl_PkgProvide(interp, "zipfs", "2.0"); + } + return TCL_OK; +#else + ZIPFS_ERROR(interp,"no zlib available"); + return TCL_ERROR; +#endif +} + +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, ZIPFS_ZIP_MOUNT, archive, 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); + if(found==0) { + zipfs_literal_tcl_library=ZIPFS_ZIP_MOUNT; + return TCL_OK; + } + vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl",-1); + Tcl_IncrRefCount(vfsinitscript); + found=Tcl_FSAccess(vfsinitscript,F_OK); + Tcl_DecrRefCount(vfsinitscript); + if(found==0) { + zipfs_literal_tcl_library=ZIPFS_ZIP_MOUNT "/tcl_library"; + return TCL_OK; + } + return TCL_ERROR; +} + +#if defined(_WIN32) || defined(_WIN64) +int TclZipfs_AppHook(int *argc, TCHAR ***argv) +#else +int TclZipfs_AppHook(int *argc, char ***argv) +#endif +{ + /* + * 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, ZIPFS_APP_MOUNT, archive, 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); + } else { + Tcl_DecrRefCount(vfsinitscript); + } + /* Set Tcl Encodings */ + if(!zipfs_literal_tcl_library) { + 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_OK; + } + } + } else if (*argc>1) { +#if defined(_WIN32) || defined(_WIN64) + Tcl_DString ds; + strcpy(archive, Tcl_WinTCharToUtf((*argv)[1], -1, &ds)); + Tcl_DStringFree(&ds); +#else + archive=(*argv)[1]; +#endif + if(strcmp(archive,"install")==0) { + /* If the first argument is mkzip, run the mkzip program */ + Tcl_Obj *vfsinitscript; + /* Run this now to ensure the file is present by the time Tcl_Main wants it */ + TclZipfs_TclLibrary(); + 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, ZIPFS_APP_MOUNT, archive, 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); + } else { + Tcl_DecrRefCount(vfsinitscript); + } + /* Set Tcl Encodings */ + 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_OK; + } + } + } + } + return TCL_OK; +} + + + +#ifndef HAVE_ZLIB + +/* + *------------------------------------------------------------------------- + * + * TclZipfs_Mount, TclZipfs_Unmount -- + * + * Dummy version when no ZLIB support available. + * + *------------------------------------------------------------------------- + */ + +int +TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname, + const char *passwd) +{ + return TclZipfs_Init(interp, 1); +} + +int +TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname) +{ + return TclZipfs_Init(interp, 1); +} + +#endif + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/library/auto.tcl b/library/auto.tcl index a7a8979..d8f9d88 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -74,6 +74,54 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { lappend dirs $env($enVarName) } + catch { + set found 0 + set root [zipfs root] + set mountpoint [file join $root lib [string tolower $basename]] + lappend dirs [file join $root app ${basename}_library] + lappend dirs [file join $root lib $mountpoint ${basename}_library] + lappend dirs [file join $root lib $mountpoint] + if {![zipfs exists [file join $root app ${basename}_library]] && ![zipfs exists $mountpoint]} { + set found 0 + foreach pkgdat [info loaded] { + lassign $pkgdat dllfile dllpkg + if {[string tolower $dllpkg] ne [string tolower $basename]} continue + if {$dllfile eq {}} { + # Loaded statically + break + } + set found 1 + zipfs mount $dllfile $mountpoint + break + } + if {!$found} { + set paths {} + lappend paths [file join $root app] + lappend paths [::${basename}::pkgconfig get libdir,runtime] + lappend paths [::${basename}::pkgconfig get bindir,runtime] + if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} { + set zipfile [string tolower "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"] + } + foreach path $paths { + set archive [file join $path $zipfile] + if {![file exists $archive]} continue + zipfs mount $archive $mountpoint + if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} { + lappend dirs [file join $mountpoint ${basename}_library] + set found 1 + break + } elseif {[zipfs exists [file join $mountpoint $initScript]]} { + lappend dirs [file join $mountpoint $initScript] + set found 1 + break + } else { + catch {zipfs unmount $archive} + } + } + } + } + } + # 2. In the package script directory registered within the # configuration of the package itself. diff --git a/library/init.tcl b/library/init.tcl index 530ce58..61f2c12 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -6,7 +6,10 @@ # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 Scriptics Corporation. -# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved. +# Copyright (c) 2004 by Kevin B. Kenny. +# Copyright (c) 2018 by Sean Woods +# +# All rights reserved. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -795,3 +798,20 @@ proc tcl::CopyDirectory {action src dest} { } return } +set isafe [interp issafe] +### +# Package manifest for all Tcl packages included in the /library file system +### +set isafe [interp issafe] +set dir [file dirname [info script]] +foreach {safe package version file} { + 0 http 2.8.13 {http http.tcl} + 1 msgcat 1.7.0 {msgcat msgcat.tcl} + 1 opt 0.4.7 {opt optparse.tcl} + 0 platform 1.0.14 {platform platform.tcl} + 0 platform::shell 1.1.4 {platform shell.tcl} + 1 tcltest 2.4.1 {tcltest tcltest.tcl} +} { + if {$isafe && !$safe} continue + package ifneeded $package $version [list source [file join $dir {*}$file]] +} diff --git a/library/install.tcl b/library/install.tcl new file mode 100644 index 0000000..e62226e --- /dev/null +++ b/library/install.tcl @@ -0,0 +1,244 @@ +### +# Installer actions built into tclsh and invoked +# if the first command line argument is "install" +### +if {[llength $argv] < 2} { + exit 0 +} +namespace eval ::practcl {} +### +# Installer tools +### +proc ::practcl::_isdirectory name { + return [file isdirectory $name] +} +### +# Return true if the pkgindex file contains +# any statement other than "package ifneeded" +# and/or if any package ifneeded loads a DLL +### +proc ::practcl::_pkgindex_directory {path} { + set buffer {} + set pkgidxfile [file join $path pkgIndex.tcl] + if {![file exists $pkgidxfile]} { + # No pkgIndex file, read the source + foreach file [glob -nocomplain $path/*.tm] { + set file [file normalize $file] + set fname [file rootname [file tail $file]] + ### + # We used to be able to ... Assume the package is correct in the filename + # No hunt for a "package provides" + ### + set package [lindex [split $fname -] 0] + set version [lindex [split $fname -] 1] + ### + # Read the file, and override assumptions as needed + ### + set fin [open $file r] + set dat [read $fin] + close $fin + # Look for a teapot style Package statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 9] != "# Package " } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + break + } + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + } + foreach file [glob -nocomplain $path/*.tcl] { + if { [file tail $file] == "version_info.tcl" } continue + set fin [open $file r] + set dat [read $fin] + close $fin + if {![regexp "package provide" $dat]} continue + set fname [file rootname [file tail $file]] + # Look for a package provide statement + foreach line [split $dat \n] { + set line [string trim $line] + if { [string range $line 0 14] != "package provide" } continue + set package [lindex $line 2] + set version [lindex $line 3] + if {[string index $package 0] in "\$ \[ @"} continue + if {[string index $version 0] in "\$ \[ @"} continue + append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n + break + } + } + return $buffer + } + set fin [open $pkgidxfile r] + set dat [read $fin] + close $fin + set trace 0 + #if {[file tail $path] eq "tool"} { + # set trace 1 + #} + set thisline {} + foreach line [split $dat \n] { + append thisline $line \n + if {![info complete $thisline]} continue + set line [string trim $line] + if {[string length $line]==0} { + set thisline {} ; continue + } + if {[string index $line 0] eq "#"} { + set thisline {} ; continue + } + if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} { + if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"} + set thisline {} ; continue + } + if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} { + if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" } + set thisline {} ; continue + } + if {![regexp "package.*ifneeded" $thisline]} { + # This package index contains arbitrary code + # source instead of trying to add it to the master + # package index + if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" } + return {source [file join $dir pkgIndex.tcl]} + } + append buffer $thisline \n + set thisline {} + } + if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]} + return $buffer +} + + +proc ::practcl::_pkgindex_path_subdir {path} { + set result {} + foreach subpath [glob -nocomplain [file join $path *]] { + if {[file isdirectory $subpath]} { + lappend result $subpath {*}[_pkgindex_path_subdir $subpath] + } + } + return $result +} +### +# Index all paths given as though they will end up in the same +# virtual file system +### +proc ::practcl::pkgindex_path args { + set stack {} + set buffer { +lappend ::PATHSTACK $dir + } + foreach base $args { + set base [file normalize $base] + set paths {} + foreach dir [glob -nocomplain [file join $base *]] { + if {[file tail $dir] eq "teapot"} continue + lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir] + } + set i [string length $base] + # Build a list of all of the paths + if {[llength $paths]} { + foreach path $paths { + if {$path eq $base} continue + set path_indexed($path) 0 + } + } else { + puts [list WARNING: NO PATHS FOUND IN $base] + } + set path_indexed($base) 1 + set path_indexed([file join $base boot tcl]) 1 + foreach teapath [glob -nocomplain [file join $base teapot *]] { + set pkg [file tail $teapath] + append buffer [list set pkg $pkg] + append buffer { +set pkginstall [file join $::g(HOME) teapot $pkg] +if {![file exists $pkginstall]} { + installDir [file join $dir teapot $pkg] $pkginstall +} +} + } + foreach path $paths { + if {$path_indexed($path)} continue + set thisdir [file_relative $base $path] + set idxbuf [::practcl::_pkgindex_directory $path] + if {[string length $idxbuf]} { + incr path_indexed($path) + append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n + append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n + } + } + } + append buffer { +set dir [lindex $::PATHSTACK end] +set ::PATHSTACK [lrange $::PATHSTACK 0 end-1] +} + return $buffer +} + +### +# topic: 64319f4600fb63c82b2258d908f9d066 +# description: Script to build the VFS file system +### +proc ::practcl::installDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]] + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + installDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +proc ::practcl::copyDir {d1 d2 {toplevel 1}} { + #if {$toplevel} { + # puts [list ::practcl::copyDir $d1 -> $d2] + #} + #file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] 0 + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + } + } +} + +switch [lindex $argv 1] { + mkzip { + zipfs mkzip {*}[lrange $argv 2 end] + } + mkzip { + zipfs mkimg {*}[lrange $argv 2 end] + } + default { + ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end] + } +} +exit 0 diff --git a/tests/config.test b/tests/config.test index d14837e..468a1df 100644 --- a/tests/config.test +++ b/tests/config.test @@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { test pkgconfig-1.1 {query keys} { lsort [::tcl::pkgconfig list] -} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded} +} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime} test pkgconfig-1.2 {query keys multiple times} { string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list] } 0 diff --git a/tests/zipfs.test b/tests/zipfs.test new file mode 100644 index 0000000..5f5b93c --- /dev/null +++ b/tests/zipfs.test @@ -0,0 +1,283 @@ +# The file tests the tclZlib.c file. +# +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. +# +# Copyright (c) 1996-1998 by Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.1 + namespace import -force ::tcltest::* +} + +testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}] + +# Removed in tip430 - zipfs is no longer a static package +#test zipfs-0.0 {zipfs basics} -constraints zipfs -body { +# load {} zipfs +#} -result {} + +set ziproot [zipfs root] +set CWD [pwd] +set tmpdir [file join $CWD tmp] +file mkdir $tmpdir + +test zipfs-0.1 {zipfs basics} -constraints zipfs -body { + package require zipfs +} -result {2.0} + +test zipfs-0.1 {zipfs basics} -constraints zipfs -body { + expr {${ziproot} in [file volumes]} +} -result 1 + +if {![string match ${ziproot}* $tcl_library]} { + ### + # "make test" does not map tcl_library from the dynamic library on Unix + # + # Hack the environment to pretend we did pull tcl_library from a zip + # archive + ### + set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]] + if {[file exists $tclzip]} { + zipfs mount /lib/tcl $tclzip + set ::tcl_library ${ziproot}lib/tcl/tcl_library + } else { + tcltest::skip zipfs-0.* + } +} + +test zipfs-0.2 {zipfs basics} -constraints zipfs -body { + string match ${ziproot}* $tcl_library +} -result 1 + +test zipfs-0.3 {zipfs basics: glob} -constraints zipfs -body { + set pwd [pwd] + cd $tcl_library + lsort [glob -dir . http*] +} -cleanup { + cd $pwd +} -result {./http ./http1.0} + +test zipfs-0.4 {zipfs basics: glob} -constraints zipfs -body { + set pwd [pwd] + cd $tcl_library + lsort [glob -dir [pwd] http*] +} -cleanup { + cd $pwd +} -result [list $tcl_library/http $tcl_library/http1.0] + +test zipfs-0.5 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -dir $tcl_library http*] +} -result [list $tcl_library/http $tcl_library/http1.0] + +test zipfs-0.6 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob $tcl_library/http*] +} -result [list $tcl_library/http $tcl_library/http1.0] + +test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -tails -dir $tcl_library http*] +} -result {http http1.0} + +test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -nocomplain -tails -types d -dir $tcl_library http*] +} -result {http http1.0} + +test zipfs-0.9 {zipfs basics: glob} -constraints zipfs -body { + lsort [glob -nocomplain -tails -types f -dir $tcl_library http*] +} -result {} + +test zipfs-0.10 {zipfs basics: join} -constraints zipfs -body { + file join [zipfs root] bar baz +} -result "[zipfs root]bar/baz" + +test zipfs-0.11 {zipfs basics: join} -constraints zipfs -body { + file normalize [zipfs root] +} -result "[zipfs root]" + +test zipfs-0.12 {zipfs basics: join} -constraints zipfs -body { + file normalize [zipfs root]//bar/baz//qux/../ +} -result "[zipfs root]bar/baz" + +test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs mount a b c d e f +} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"} + +test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs unmount a b c d e f +} -result {wrong # args: should be "zipfs unmount zipfile"} + +test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs mkkey a b c d e f +} -result {wrong # args: should be "zipfs mkkey password"} + +test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs mkimg a b c d e f +} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"} + +test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs mkzip a b c d e f +} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"} + +test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs exists a b c d e f +} -result {wrong # args: should be "zipfs exists filename"} + +test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs info a b c d e f +} -result {wrong # args: should be "zipfs info filename"} + +test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body { + zipfs list a b c d e f +} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"} + +file mkdir tmp + +test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body { + zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx +} -result {empty archive} + +### +# The 2.2 series of tests operate within +# a zipfile created a temporary directory +### +set zipfile [file join $tmpdir abc.zip] +if {[file exists $zipfile]} { + file delete $zipfile +} + +test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body { + cd $tcl_library/encoding + zipfs mkzip $zipfile . + zipfs mount ${ziproot}abc $zipfile + zipfs list -glob ${ziproot}abc/cp850.* +} -cleanup { + cd $CWD +} -result "[zipfs root]abc/cp850.enc" + +if {![zipfs exists /abc/cp850.enc]} { + skip [concat [skip] zipfs-2.2.*] +} + +test zipfs-2.2.1 {zipfs info} -constraints zipfs -body { + set r [zipfs info ${ziproot}abc/cp850.enc] + lrange $r 0 2 +} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable + +test zipfs-2.2.3 {zipfs data} -constraints zipfs -body { + set zipfd [open ${ziproot}/abc/cp850.enc] ;# FIXME: leave open - see later test + read $zipfd +} -result {# Encoding file: cp850, single-byte +S +003F 0 1 +00 +0000000100020003000400050006000700080009000A000B000C000D000E000F +0010001100120013001400150016001700180019001A001B001C001D001E001F +0020002100220023002400250026002700280029002A002B002C002D002E002F +0030003100320033003400350036003700380039003A003B003C003D003E003F +0040004100420043004400450046004700480049004A004B004C004D004E004F +0050005100520053005400550056005700580059005A005B005C005D005E005F +0060006100620063006400650066006700680069006A006B006C006D006E006F +0070007100720073007400750076007700780079007A007B007C007D007E007F +00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5 +00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192 +00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB +2591259225932502252400C100C200C000A9256325512557255D00A200A52510 +25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4 +00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 +00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 +00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 +} ;# FIXME: result depends on content of encodings dir + +test zipfs-2.2.4 {zipfs exists} -constraints zipfs -body { + zipfs exists /abc/cp850.enc +} -result 1 + +test zipfs-2.2.5 {zipfs unmount while busy} -constraints zipfs -body { + zipfs unmount /abc +} -returnCodes error -result {filesystem is busy} + +test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body { + close $zipfd + zipfs unmount /abc + zipfs exists /abc/cp850.enc +} -result 0 + + +### +# Repeat the tests for a buffer mounted archive +### +test zipfs-2.3.0 {zipfs mkzip} -constraints zipfs -body { + cd $tcl_library/encoding + zipfs mkzip $zipfile . + set fin [open $zipfile r] + fconfigure $fin -translation binary + set dat [read $fin] + close $fin + zipfs mount_data def $dat + zipfs list -glob ${ziproot}def/cp850.* +} -cleanup { + cd $CWD +} -result "[zipfs root]def/cp850.enc" + +if {![zipfs exists /def/cp850.enc]} { + skip [concat [skip] zipfs-2.3.*] +} + +test zipfs-2.3.1 {zipfs info} -constraints zipfs -body { + set r [zipfs info ${ziproot}def/cp850.enc] + lrange $r 0 2 +} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable + +test zipfs-2.3.3 {zipfs data} -constraints zipfs -body { + set zipfd [open ${ziproot}/def/cp850.enc] ;# FIXME: leave open - see later test + read $zipfd +} -result {# Encoding file: cp850, single-byte +S +003F 0 1 +00 +0000000100020003000400050006000700080009000A000B000C000D000E000F +0010001100120013001400150016001700180019001A001B001C001D001E001F +0020002100220023002400250026002700280029002A002B002C002D002E002F +0030003100320033003400350036003700380039003A003B003C003D003E003F +0040004100420043004400450046004700480049004A004B004C004D004E004F +0050005100520053005400550056005700580059005A005B005C005D005E005F +0060006100620063006400650066006700680069006A006B006C006D006E006F +0070007100720073007400750076007700780079007A007B007C007D007E007F +00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5 +00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192 +00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB +2591259225932502252400C100C200C000A9256325512557255D00A200A52510 +25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4 +00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580 +00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4 +00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0 +} ;# FIXME: result depends on content of encodings dir + +test zipfs-2.3.4 {zipfs exists} -constraints zipfs -body { + zipfs exists /def/cp850.enc +} -result 1 + +test zipfs-2.3.5 {zipfs unmount while busy} -constraints zipfs -body { + zipfs unmount /def +} -returnCodes error -result {filesystem is busy} + +test zipfs-2.3.6 {zipfs unmount} -constraints zipfs -body { + close $zipfd + zipfs unmount /def + zipfs exists /def/cp850.enc +} -result 0 + +catch {file delete -force $tmpdir} + + +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl new file mode 100644 index 0000000..cbfb81e --- /dev/null +++ b/tools/mkVfs.tcl @@ -0,0 +1,99 @@ +proc cat fname { + set fname [open $fname r] + set data [read $fname] + close $fname + return $data +} + +proc pkgIndexDir {root fout d1} { + + puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \ + [file tail $d1]] + set idx [string length $root] + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + pkgIndexDir $root $fout $f + } elseif {[file tail $f] eq "pkgIndex.tcl"} { + puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]" + puts $fout [cat $f] + } + } +} + +### +# Script to build the VFS file system +### +proc copyDir {d1 d2} { + + puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \ + [file tail $d2]] + + file delete -force -- $d2 + file mkdir $d2 + + foreach ftail [glob -directory $d1 -nocomplain -tails *] { + set f [file join $d1 $ftail] + if {[file isdirectory $f] && [string compare CVS $ftail]} { + copyDir $f [file join $d2 $ftail] + } elseif {[file isfile $f]} { + file copy -force $f [file join $d2 $ftail] + if {$::tcl_platform(platform) eq {unix}} { + file attributes [file join $d2 $ftail] -permissions 0644 + } else { + file attributes [file join $d2 $ftail] -readonly 1 + } + } + } + + if {$::tcl_platform(platform) eq {unix}} { + file attributes $d2 -permissions 0755 + } else { + file attributes $d2 -readonly 1 + } +} + +if {[llength $argv] < 3} { + puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM" + exit 1 +} +set TCL_SCRIPT_DIR [lindex $argv 0] +set TCLSRC_ROOT [lindex $argv 1] +set PLATFORM [lindex $argv 2] +set TKDLL [lindex $argv 3] +set TKVER [lindex $argv 4] + +puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM" +copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR} + +if {$PLATFORM == "windows"} { + set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll] + puts "DDE DLL $ddedll" + if {$ddedll != {}} { + file copy $ddedll ${TCL_SCRIPT_DIR}/dde + } + set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll] + puts "REG DLL $ddedll" + if {$regdll != {}} { + file copy $regdll ${TCL_SCRIPT_DIR}/reg + } +} else { + # Remove the dde and reg package paths + file delete -force ${TCL_SCRIPT_DIR}/dde + file delete -force ${TCL_SCRIPT_DIR}/reg +} + +# For the following packages, cat their pkgIndex files to tclIndex +file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0 +set fout [open ${TCL_SCRIPT_DIR}/tclIndex a] +puts $fout {# +# MANIFEST OF INCLUDED PACKAGES +# +set VFSROOT $dir +} +if {$TKDLL ne {} && [file exists $TKDLL]} { + file copy $TKDLL ${TCL_SCRIPT_DIR} + puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"] +} +pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR} +close $fout diff --git a/unix/Makefile.in b/unix/Makefile.in index f044e41..cb98773 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -242,6 +242,8 @@ ZLIB_DIR = ${COMPAT_DIR}/zlib ZLIB_INCLUDE = @ZLIB_INCLUDE@ CC = @CC@ +OBJEXT = @OBJEXT@ + #CC = purify -best-effort @CC@ -DPURIFY # Flags to be passed to installManPage to control how the manpages should be @@ -308,7 +310,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ tclStrToD.o tclThread.o \ tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \ tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \ - tclTomMathInterface.o + tclTomMathInterface.o tclZipfs.o OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \ tclOOMethod.o tclOOStubInit.o @@ -464,7 +466,8 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/tclUtil.c \ $(GENERIC_DIR)/tclVar.c \ $(GENERIC_DIR)/tclAssembly.c \ - $(GENERIC_DIR)/tclZlib.c + $(GENERIC_DIR)/tclZlib.c \ + $(GENERIC_DIR)/tclZipfs.c OO_SRCS = \ $(GENERIC_DIR)/tclOO.c \ @@ -617,6 +620,44 @@ ZLIB_SRCS = \ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ $(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ +### +# Tip 430 - ZipFS Modifications +### + +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + +HOST_CC = @CC_FOR_BUILD@ +HOST_EXEEXT = @EXEEXT_FOR_BUILD@ +HOST_OBJEXT = @OBJEXT_FOR_BUILD@ +ZIPFS_BUILD = @ZIPFS_BUILD@ +NATIVE_ZIP = @ZIP_PROG@ +ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ +ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ +SHARED_BUILD = @SHARED_BUILD@ +INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ +INSTALL_MSGS = @INSTALL_MSGS@ + +# Minizip +MINIZIP_OBJS = \ + adler32.$(HOST_OBJEXT) \ + compress.$(HOST_OBJEXT) \ + crc32.$(HOST_OBJEXT) \ + deflate.$(HOST_OBJEXT) \ + infback.$(HOST_OBJEXT) \ + inffast.$(HOST_OBJEXT) \ + inflate.$(HOST_OBJEXT) \ + inftrees.$(HOST_OBJEXT) \ + ioapi.$(HOST_OBJEXT) \ + trees.$(HOST_OBJEXT) \ + uncompr.$(HOST_OBJEXT) \ + zip.$(HOST_OBJEXT) \ + zutil.$(HOST_OBJEXT) \ + minizip.$(HOST_OBJEXT) + +ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ + #-------------------------------------------------------------------------- # Start of rules #-------------------------------------------------------------------------- @@ -629,11 +670,23 @@ libraries: doc: +tclzipfile: ${TCL_ZIP_FILE} + + +${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} + rm -rf ${TCL_VFS_ROOT} + mkdir -p ${TCL_VFS_PATH} + cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH} + cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} + # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. -${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} +${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE} rm -f $@ @MAKE_LIB@ +ifeq (${ZIPFS_BUILD},1) + cat ${TCL_ZIP_FILE} >> ${LIB_FILE} +endif ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ @@ -667,7 +720,8 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: clean-packages rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ - errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ + errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \ + minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs cd dltest ; $(MAKE) clean distclean: distclean-packages clean @@ -777,7 +831,7 @@ trace-test: ${TCLTEST_EXE} # Installation rules #-------------------------------------------------------------------------- -INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA) +INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) INSTALL_DOC_TARGETS = install-doc INSTALL_PACKAGE_TARGETS = install-packages INSTALL_DEV_TARGETS = install-headers @@ -821,6 +875,25 @@ install-binaries: binaries @$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig @$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc +install-libraries-zipfs-shared: libraries + @for i in "$(SCRIPT_INSTALL_DIR)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"; + @for i in \ + $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \ + do \ + $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \ + done; + +install-libraries-zipfs-static: install-libraries-zipfs-shared + $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" ;\ + install-libraries: libraries @for i in "$(SCRIPT_INSTALL_DIR)"; \ do \ @@ -870,6 +943,7 @@ install-libraries: libraries echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \ "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \ fi + end install-tzdata: @for i in tzdata; \ @@ -1277,6 +1351,8 @@ tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ -DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \ -DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ \ $(GENERIC_DIR)/tclPkgConfig.c @@ -1328,6 +1404,14 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c tclZlib.o: $(GENERIC_DIR)/tclZlib.c $(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c +tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \ + $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c + tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c @@ -1736,6 +1820,54 @@ tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c $(CC) -c $(CC_SWITCHES) $< #-------------------------------------------------------------------------- +# Minizip implementation +#-------------------------------------------------------------------------- +adler32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c + +compress.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c + +crc32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c + +deflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c + +ioapi.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + +infback.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c + +inffast.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c + +inflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c + +inftrees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c + +trees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c + +uncompr.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c + +zip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c + +zutil.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c + +minizip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + +minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) + $(HOST_CC) -o $@ $(MINIZIP_OBJS) + +#-------------------------------------------------------------------------- # Bundled Package targets #-------------------------------------------------------------------------- @@ -2141,6 +2273,7 @@ BUILD_HTML = \ .PHONY: install-tzdata install-msgs .PHONY: packages configure-packages test-packages clean-packages .PHONY: dist-packages distclean-packages install-packages +.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile #-------------------------------------------------------------------------- # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/unix/configure b/unix/configure index 9eba7f9..6800261 100755 --- a/unix/configure +++ b/unix/configure @@ -664,6 +664,16 @@ TCL_PATCH_LEVEL TCL_MINOR_VERSION TCL_MAJOR_VERSION TCL_VERSION +INSTALL_MSGS +INSTALL_LIBRARIES +TCL_ZIP_FILE +ZIPFS_BUILD +ZIP_INSTALL_OBJS +ZIP_PROG_VFSSEARCH +ZIP_PROG_OPTIONS +ZIP_PROG +EXEEXT_FOR_BUILD +CC_FOR_BUILD DTRACE LDFLAGS_DEFAULT CFLAGS_DEFAULT @@ -699,6 +709,7 @@ ZLIB_INCLUDE ZLIB_SRCS ZLIB_OBJS TCLSH_PROG +SHARED_BUILD EGREP GREP CPP @@ -747,7 +758,8 @@ PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR -SHELL' +SHELL +OBJEXT_FOR_BUILD' ac_subst_files='' ac_user_opts=' enable_option_checking @@ -766,6 +778,7 @@ enable_langinfo enable_dll_unloading with_tzdata enable_dtrace +enable_zipfs enable_framework ' ac_precious_vars='build_alias @@ -1405,6 +1418,7 @@ Optional Features: startup, otherwise use old heuristic (default: on) --enable-dll-unloading enable the 'unload' command (default: on) --enable-dtrace build with DTrace support (default: off) + --enable-zipfs build with Zipfs support (default: on) --enable-framework package shared libraries in MacOSX frameworks (default: off) @@ -3270,6 +3284,7 @@ _ACEOF esac + #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or @@ -4432,6 +4447,7 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi + #-------------------------------------------------------------------- # Look for a native installed tclsh binary (if available) # If one cannot be found then use the binary we build (fails for @@ -10048,6 +10064,186 @@ fi $as_echo "$tcl_ok" >&6; } #-------------------------------------------------------------------- +# Zipfs support - Tip 430 +#-------------------------------------------------------------------- +# Check whether --enable-zipfs was given. +if test "${enable_zipfs+set}" = set; then : + enableval=$enable_zipfs; tcl_ok=$enableval +else + tcl_ok=yes +fi + +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + # Put a plausible default for CC_FOR_BUILD in Makefile. + if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 +$as_echo_n "checking for gcc... " >&6; } + if ${ac_cv_path_cc+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + +fi + + fi + fi + + # Also set EXEEXT_FOR_BUILD. + if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' + else + OBJEXT_FOR_BUILD='.no' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 +$as_echo_n "checking for build system executable suffix... " >&6; } +if ${bfd_cv_build_exeext+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 +$as_echo "$bfd_cv_build_exeext" >&6; } + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} + fi + + # + # Find a native zip implementation + # + + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + if $TCLSH_PROG install; then : + + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Can use Native Tclsh for Zip encoding" >&5 +$as_echo "Can use Native Tclsh for Zip encoding" >&6; } + +fi + + if test "x$ZIP_PROG" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 +$as_echo "Found INFO Zip in environment" >&6; } + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 +$as_echo "No zip found on PATH building minizip" >&6; } + fi + fi + + + + + + ZIPFS_BUILD=1 + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else + ZIPFS_BUILD=0 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 +$as_echo_n "checking for building with zipfs... " >&6; } +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + +$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h + + INSTALL_LIBRARIES=install-libraries-zipfs-static + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + +$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h +\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + fi +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi + + + + + + +#-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- @@ -10333,6 +10529,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD} + ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in" cat >confcache <<\_ACEOF diff --git a/unix/configure.ac b/unix/configure.ac index 609312b..bd8ea97 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -86,6 +86,7 @@ fi AC_PROG_CC AC_C_INLINE + #-------------------------------------------------------------------- # Supply substitutes for missing POSIX header files. Special notes: # - stdlib.h doesn't define strtol, strtoul, or @@ -782,6 +783,52 @@ fi AC_MSG_RESULT([$tcl_ok]) #-------------------------------------------------------------------- +# Zipfs support - Tip 430 +#-------------------------------------------------------------------- +AC_ARG_ENABLE(zipfs, + AC_HELP_STRING([--enable-zipfs], + [build with Zipfs support (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + AX_CC_FOR_BUILD + # + # Find a native zip implementation + # + SC_ZIPFS_SUPPORT + ZIPFS_BUILD=1 + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else + ZIPFS_BUILD=0 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +AC_MSG_CHECKING([for building with zipfs]) +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) + INSTALL_LIBRARIES=install-libraries-zipfs-static + AC_MSG_RESULT([yes]) + else + AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + AC_MSG_RESULT([yes]) + fi +else +AC_MSG_RESULT([no]) +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi +AC_SUBST(ZIPFS_BUILD) +AC_SUBST(TCL_ZIP_FILE) +AC_SUBST(INSTALL_LIBRARIES) +AC_SUBST(INSTALL_MSGS) + + +#-------------------------------------------------------------------- # The check below checks whether the cpuid instruction is usable. #-------------------------------------------------------------------- @@ -951,6 +998,7 @@ AC_SUBST(TCL_PATCH_LEVEL) AC_SUBST(TCL_YEAR) AC_SUBST(PKG_CFG_ARGS) +AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index cf6345f..d705480 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -542,6 +542,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi + AC_SUBST(SHARED_BUILD) ]) #------------------------------------------------------------------------ @@ -2953,6 +2954,140 @@ if test "x$NEED_FAKE_RFC2553" = "x1"; then AC_CHECK_FUNC(strlcpy) fi ]) + +#------------------------------------------------------------------------ +# SC_CC_FOR_BUILD +# For cross compiles, locate a C compiler that can generate native binaries. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# CC_FOR_BUILD +# EXEEXT_FOR_BUILD +#------------------------------------------------------------------------ + +dnl Get a default for CC_FOR_BUILD to put into Makefile. +AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile. + if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + AC_MSG_CHECKING([for gcc]) + AC_CACHE_VAL(ac_cv_path_cc, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + ]) + fi + fi + AC_SUBST(CC_FOR_BUILD) + # Also set EXEEXT_FOR_BUILD. + if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' + else + OBJEXT_FOR_BUILD='.no' + AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, + [rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} + fi + AC_SUBST(EXEEXT_FOR_BUILD)])dnl + AC_SUBST(OBJEXT_FOR_BUILD)])dnl +]) + + +#------------------------------------------------------------------------ +# SC_ZIPFS_SUPPORT +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +# ZIP_PROG_OPTIONS +# ZIP_PROG_VFSSEARCH +# ZIP_INSTALL_OBJS +#------------------------------------------------------------------------ + +AC_DEFUN([SC_ZIPFS_SUPPORT], [ + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + AC_MSG_CHECKING([for zip]) + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + AS_IF([$TCLSH_PROG install],[ + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Can use Native Tclsh for Zip encoding]) + ]) + + if test "x$ZIP_PROG" = "x" ; then + AC_MSG_CHECKING([for zip]) + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + AC_MSG_RESULT([No zip found on PATH building minizip]) + fi + fi + AC_SUBST(ZIP_PROG) + AC_SUBST(ZIP_PROG_OPTIONS) + AC_SUBST(ZIP_PROG_VFSSEARCH) + AC_SUBST(ZIP_INSTALL_OBJS) +]) + # Local Variables: # mode: autoconf # End: diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in index 846cb11..ca932d2 100644 --- a/unix/tcl.pc.in +++ b/unix/tcl.pc.in @@ -4,6 +4,8 @@ prefix=@prefix@ exec_prefix=@exec_prefix@ libdir=@libdir@ includedir=@includedir@ +libfile=@TCL_LIB_FILE@ +zipfile=@TCL_ZIP_FILE@ Name: Tool Command Language Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses. diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 9bbc88b..3587f35 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -79,6 +79,8 @@ main( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#else + TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in index 1edee2f..743b5a5 100644 --- a/unix/tclConfig.sh.in +++ b/unix/tclConfig.sh.in @@ -39,6 +39,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' +# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library): +TCL_ZIP_FILE='@TCL_ZIP_FILE@' + # Additional libraries to use when linking Tcl. TCL_LIBS='@TCL_LIBS@' diff --git a/unix/tclKitInit.c b/unix/tclKitInit.c new file mode 100644 index 0000000..96861de --- /dev/null +++ b/unix/tclKitInit.c @@ -0,0 +1,86 @@ +/*
+** This file implements the main routine for a standalone Tcl/Tk shell.
+*/
+#include <tcl.h>
+#include "tclInt.h"
+#define TCLKIT_INIT "main.tcl"
+#define TCLKIT_VFSMOUNT "/zvfs"
+
+#define TCL_LOCAL_APPINIT Tclkit_AppInit
+MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
+MODULE_SCOPE int main(int, char **);
+
+/*
+** This routine runs first.
+*/
+int main(int argc, char **argv){
+ Tcl_FindExecutable(argv[0]);
+ Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL);
+ Tcl_Main(argc,argv,&Tclkit_AppInit);
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tclkit_AppInit --
+ *
+ * This procedure performs application-specific initialization. Most
+ * applications, especially those that incorporate additional packages,
+ * will have their own version of this procedure.
+ *
+ * Results:
+ * Returns a standard Tcl completion code, and leaves an error message in
+ * the interp's result if an error occurs.
+ *
+ * Side effects:
+ * Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tclkit_AppInit(
+ Tcl_Interp *interp) /* Interpreter for application. */
+{
+ Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT);
+
+ if ((Tcl_Init)(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call the init procedures for included packages. Each call should look
+ * like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module. (Dynamically-loadable packages
+ * should have the same entry-point name.)
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if they
+ * weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application is
+ * run interactively. Typically the startup file is "~/.apprc" where "app"
+ * is the name of the application. If this line is deleted then no
+ * user-specific startup file will be run under any conditions.
+ */
+
+#ifdef DJGPP
+ (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY);
+#else
+ (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+ Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY);
+#endif
+
+ return TCL_OK;
+}
\ No newline at end of file diff --git a/win/Makefile.in b/win/Makefile.in index 4e75b06..a7be485 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -137,6 +137,11 @@ DDEDOTVER = @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@ REGVER = @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@ REGDOTVER = @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@ +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + + TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@ TCL_DLL_FILE = @TCL_DLL_FILE@ TCL_LIB_FILE = @TCL_LIB_FILE@ @@ -196,6 +201,45 @@ SHELL = @SHELL@ RM = rm -f COPY = cp +### +# Tip 430 - ZipFS Modifications +### + +TCL_ZIP_FILE = @TCL_ZIP_FILE@ +TCL_VFS_PATH = libtcl.vfs/tcl_library +TCL_VFS_ROOT = libtcl.vfs + +HOST_CC = @CC_FOR_BUILD@ +HOST_EXEEXT = @EXEEXT_FOR_BUILD@ +HOST_OBJEXT = @OBJEXT_FOR_BUILD@ +ZIPFS_BUILD = @ZIPFS_BUILD@ +NATIVE_ZIP = @ZIP_PROG@ +ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@ +ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@ +SHARED_BUILD = @SHARED_BUILD@ +INSTALL_MSGS = @INSTALL_MSGS@ +INSTALL_LIBRARIES = @INSTALL_LIBRARIES@ + +# Minizip +MINIZIP_OBJS = \ + adler32.$(HOST_OBJEXT) \ + compress.$(HOST_OBJEXT) \ + crc32.$(HOST_OBJEXT) \ + deflate.$(HOST_OBJEXT) \ + infback.$(HOST_OBJEXT) \ + inffast.$(HOST_OBJEXT) \ + inflate.$(HOST_OBJEXT) \ + inftrees.$(HOST_OBJEXT) \ + ioapi.$(HOST_OBJEXT) \ + iowin32.$(HOST_OBJEXT) \ + trees.$(HOST_OBJEXT) \ + uncompr.$(HOST_OBJEXT) \ + zip.$(HOST_OBJEXT) \ + zutil.$(HOST_OBJEXT) \ + minizip.$(HOST_OBJEXT) + +ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@ + CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \ -I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \ -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \ @@ -303,6 +347,7 @@ GENERIC_OBJS = \ tclUtf.$(OBJEXT) \ tclUtil.$(OBJEXT) \ tclVar.$(OBJEXT) \ + tclZipfs.$(OBJEXT) \ tclZlib.$(OBJEXT) TOMMATH_OBJS = \ @@ -435,9 +480,17 @@ libraries: doc: +tclzipfile: ${TCL_ZIP_FILE} + +${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} + rm -rf ${TCL_VFS_ROOT} + mkdir -p ${TCL_VFS_PATH} + $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH} + cd ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} + $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) $(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \ - tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) + tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE) @VC_MANIFEST_EMBED_EXE@ cat32.$(OBJEXT): cat.c @@ -454,10 +507,13 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ -${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ +${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE} @$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE) @MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS) @VC_MANIFEST_EMBED_DLL@ +ifeq (${ZIPFS_BUILD},1) + cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE} +endif ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @$(RM) ${TCL_LIB_FILE} @@ -503,6 +559,17 @@ testMain.${OBJEXT}: tclAppInit.c tclMain2.${OBJEXT}: tclMain.c $(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME) +# TIP #430, ZipFS Support +tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c + $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \ + -DCFG_RUNTIME_PATH=\"$(bindir_native)\" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ + -DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \ + -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \ + $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip @DEPARG@ $(CC_OBJNAME) + + # TIP #59, embedding of configuration information into the binary library. # # Part of Tcl's configuration information are the paths where it was installed @@ -524,6 +591,8 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c -DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \ -DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \ -DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \ + -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \ + -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \ -DBUILD_tcl \ @DEPARG@ $(CC_OBJNAME) @@ -550,6 +619,59 @@ tclWinPanic.${OBJEXT}: tclWinPanic.c .rc.$(RES): $(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@ + + +#-------------------------------------------------------------------------- +# Minizip implementation +#-------------------------------------------------------------------------- +adler32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c + +compress.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c + +crc32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c + +deflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c + +ioapi.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c + +iowin32.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c + +infback.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c + +inffast.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c + +inflate.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c + +inftrees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c + +trees.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c + +uncompr.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c + +zip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c + +zutil.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c + +minizip.$(HOST_OBJEXT): + $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c + +minizip${HOST_EXEEXT}: $(MINIZIP_OBJS) + $(HOST_CC) -o $@ $(MINIZIP_OBJS) + # The following target generates the file generic/tclDate.c from the yacc # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is # not available in all environments. The name of the .c file is different than @@ -570,7 +692,15 @@ gentommath_h: "$(TOMMATH_DIR_NATIVE)/tommath.h" \ > "$(GENERIC_DIR_NATIVE)/tclTomMath.h" -install: all install-binaries install-libraries install-doc install-packages +INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA) +INSTALL_DOC_TARGETS = install-doc +INSTALL_PACKAGE_TARGETS = install-packages +INSTALL_DEV_TARGETS = install-headers +INSTALL_EXTRA_TARGETS = +INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \ + $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS) + +install: $(INSTALL_TARGETS) install-binaries: binaries @for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \ @@ -625,6 +755,11 @@ install-binaries: binaries $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \ fi +install-libraries-zipfs-shared: libraries + +install-libraries-zipfs-static: install-libraries-zipfs-shared + $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" + install-libraries: libraries install-tzdata install-msgs @for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \ $(SCRIPT_INSTALL_DIR); \ @@ -643,15 +778,6 @@ install-libraries: libraries install-tzdata install-msgs else true; \ fi; \ done; - @echo "Installing header files"; - @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \ - "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \ - "$(GENERIC_DIR)/tclPlatDecls.h" \ - "$(GENERIC_DIR)/tclTomMath.h" \ - "$(GENERIC_DIR)/tclTomMathDecls.h"; \ - do \ - $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \ - done; @echo "Installing library files to $(SCRIPT_INSTALL_DIR)"; @for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \ do \ @@ -689,6 +815,25 @@ install-msgs: install-doc: doc +install-headers: + @for i in "$(INCLUDE_INSTALL_DIR)"; \ + do \ + if [ ! -d "$$i" ] ; then \ + echo "Making directory $$i"; \ + $(INSTALL_DATA_DIR) "$$i"; \ + else true; \ + fi; \ + done; + @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/"; + @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \ + $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \ + $(GENERIC_DIR)/tclPlatDecls.h \ + $(GENERIC_DIR)/tclTomMath.h \ + $(GENERIC_DIR)/tclTomMathDecls.h ; \ + do \ + $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \ + done; + # Optional target to install private headers install-private-headers: libraries @for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \ @@ -752,10 +897,13 @@ clean: cleanhelp clean-packages $(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out $(RM) $(TCLSH) $(CAT32) $(RM) *.pch *.ilk *.pdb + $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT} + $(RM) *.zip + $(RMDIR) *.vfs distclean: distclean-packages clean $(RM) Makefile config.status config.cache config.log tclConfig.sh \ - tcl.hpj config.status.lineno + tcl.hpj config.status.lineno tclsh.exe.manifest # # Bundled package targets @@ -884,5 +1032,6 @@ html-tk: $(TCLSH) .PHONY: gdb depend cleanhelp clean distclean packages install-packages .PHONY: test-packages clean-packages distclean-packages genstubs html .PHONY: html-tcl html-tk +.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile # DO NOT DELETE THIS LINE -- make depend depends on it. diff --git a/win/configure b/win/configure index 7ab33b0..0e672d1 100755 --- a/win/configure +++ b/win/configure @@ -699,6 +699,17 @@ VC_MANIFEST_EMBED_EXE VC_MANIFEST_EMBED_DLL LDFLAGS_DEFAULT CFLAGS_DEFAULT +INSTALL_MSGS +INSTALL_LIBRARIES +TCL_ZIP_FILE +ZIPFS_BUILD +ZIP_INSTALL_OBJS +ZIP_PROG_VFSSEARCH +ZIP_PROG_OPTIONS +ZIP_PROG +TCLSH_PROG +EXEEXT_FOR_BUILD +CC_FOR_BUILD ZLIB_OBJS ZLIB_LIBS ZLIB_DLL_FILE @@ -707,6 +718,7 @@ CFLAGS_OPTIMIZE CFLAGS_DEBUG DL_LIBS CYGPATH +SHARED_BUILD SET_MAKE RC RANLIB @@ -758,13 +770,15 @@ PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR -SHELL' +SHELL +OBJEXT_FOR_BUILD' ac_subst_files='' ac_user_opts=' enable_option_checking with_encoding enable_shared enable_64bit +enable_zipfs enable_symbols enable_embedded_manifest ' @@ -1386,6 +1400,7 @@ Optional Features: --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-shared build and link with shared libraries (default: on) --enable-64bit enable 64bit support (where applicable) + --enable-zipfs build with Zipfs support (default: on) --enable-symbols build with debugging symbols (default: off) --enable-embedded-manifest embed manifest if possible (default: yes) @@ -3731,6 +3746,7 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h fi + #-------------------------------------------------------------------- # The statements below define a collection of compile flags. This # macro depends on the value of SHARED_BUILD, and should be called @@ -4660,6 +4676,223 @@ _ACEOF fi + +#-------------------------------------------------------------------- +# Zipfs support - Tip 430 +#-------------------------------------------------------------------- +# Check whether --enable-zipfs was given. +if test "${enable_zipfs+set}" = set; then : + enableval=$enable_zipfs; tcl_ok=$enableval +else + tcl_ok=yes +fi + +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + # Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5 +$as_echo_n "checking for gcc... " >&6; } + if ${ac_cv_path_cc+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + +fi + + fi +fi + +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5 +$as_echo_n "checking for build system executable suffix... " >&6; } +if ${bfd_cv_build_exeext+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5 +$as_echo "$bfd_cv_build_exeext" >&6; } + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi + + # + # Find a native zip implementation + # + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 +$as_echo_n "checking for tclsh... " >&6; } + + if ${ac_cv_path_tclsh+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \ + `ls -r $dir/tclsh* 2> /dev/null` ; do + if test x"$ac_cv_path_tclsh" = x ; then + if test -f "$j" ; then + ac_cv_path_tclsh=$j + break + fi + fi + done + done + +fi + + + if test -f "$ac_cv_path_tclsh" ; then + TCLSH_PROG="$ac_cv_path_tclsh" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5 +$as_echo "$TCLSH_PROG" >&6; } + else + # It is not an error if an installed version of Tcl can't be located. + TCLSH_PROG="" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5 +$as_echo "No tclsh found on PATH" >&6; } + fi + + + + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + if $TCLSH_PROG install; then : + + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Can use Native Tclsh for Zip encoding" >&5 +$as_echo "Can use Native Tclsh for Zip encoding" >&6; } + +fi + + if test "x$ZIP_PROG" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5 +$as_echo_n "checking for zip... " >&6; } + if ${ac_cv_path_zip+:} false; then : + $as_echo_n "(cached) " >&6 +else + + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + +fi + + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5 +$as_echo "$ZIP_PROG" >&6; } + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5 +$as_echo "Found INFO Zip in environment" >&6; } + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5 +$as_echo "No zip found on PATH building minizip" >&6; } + fi + fi + + + + + + ZIPFS_BUILD=1 + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else + ZIPFS_BUILD=0 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5 +$as_echo_n "checking for building with zipfs... " >&6; } +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + +$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h + + INSTALL_LIBRARIES=install-libraries-zipfs-static + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + +$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h +\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + fi +else +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi + + + + + + #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- diff --git a/win/configure.ac b/win/configure.ac index 179f151..5fcbe24 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -168,6 +168,54 @@ AC_CHECK_TYPE([uintptr_t], [ fi ]) + +#-------------------------------------------------------------------- +# Zipfs support - Tip 430 +#-------------------------------------------------------------------- +AC_ARG_ENABLE(zipfs, + AC_HELP_STRING([--enable-zipfs], + [build with Zipfs support (default: on)]), + [tcl_ok=$enableval], [tcl_ok=yes]) +if test "$tcl_ok" = "yes" ; then + # + # Find a native compiler + # + AX_CC_FOR_BUILD + # + # Find a native zip implementation + # + SC_PROG_TCLSH + SC_ZIPFS_SUPPORT + ZIPFS_BUILD=1 + TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip +else + ZIPFS_BUILD=0 + TCL_ZIP_FILE= +fi +# Do checking message here to not mess up interleaved configure output +AC_MSG_CHECKING([for building with zipfs]) +if test "${ZIPFS_BUILD}" = 1; then + if test "${SHARED_BUILD}" = 0; then + ZIPFS_BUILD=2; + AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?]) + INSTALL_LIBRARIES=install-libraries-zipfs-static + AC_MSG_RESULT([yes]) + else + AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\ + INSTALL_LIBRARIES=install-libraries-zipfs-shared + AC_MSG_RESULT([yes]) + fi +else +AC_MSG_RESULT([no]) +INSTALL_LIBRARIES=install-libraries +INSTALL_MSGS=install-msgs +fi +AC_SUBST(ZIPFS_BUILD) +AC_SUBST(TCL_ZIP_FILE) +AC_SUBST(INSTALL_LIBRARIES) +AC_SUBST(INSTALL_MSGS) + + #-------------------------------------------------------------------- # Perform additinal compiler tests. #-------------------------------------------------------------------- @@ -251,6 +251,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE +# TCL_ZIP_FILE # #------------------------------------------------------------------------ @@ -283,6 +284,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ # eval is required to do the TCL_DBGX substitution # + eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\"" eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\"" eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\"" eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\"" @@ -295,6 +297,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [ AC_SUBST(TCL_BIN_DIR) AC_SUBST(TCL_SRC_DIR) + AC_SUBST(TCL_ZIP_FILE) AC_SUBST(TCL_LIB_FILE) AC_SUBST(TCL_LIB_FLAG) AC_SUBST(TCL_LIB_SPEC) @@ -380,6 +383,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [ SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?]) fi + AC_SUBST(SHARED_BUILD) ]) #------------------------------------------------------------------------ @@ -1159,3 +1163,137 @@ print("manifest needed") AC_SUBST(VC_MANIFEST_EMBED_DLL) AC_SUBST(VC_MANIFEST_EMBED_EXE) ]) + +#------------------------------------------------------------------------ +# SC_CC_FOR_BUILD +# For cross compiles, locate a C compiler that can generate native binaries. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# CC_FOR_BUILD +# EXEEXT_FOR_BUILD +#------------------------------------------------------------------------ + +dnl Get a default for CC_FOR_BUILD to put into Makefile. +AC_DEFUN([AX_CC_FOR_BUILD], +[# Put a plausible default for CC_FOR_BUILD in Makefile. +if test -z "$CC_FOR_BUILD"; then + if test "x$cross_compiling" = "xno"; then + CC_FOR_BUILD='$(CC)' + else + AC_MSG_CHECKING([for gcc]) + AC_CACHE_VAL(ac_cv_path_cc, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/gcc 2> /dev/null` \ + `ls -r $dir/gcc 2> /dev/null` ; do + if test x"$ac_cv_path_cc" = x ; then + if test -f "$j" ; then + ac_cv_path_cc=$j + break + fi + fi + done + done + ]) + fi +fi +AC_SUBST(CC_FOR_BUILD) +# Also set EXEEXT_FOR_BUILD. +if test "x$cross_compiling" = "xno"; then + EXEEXT_FOR_BUILD='$(EXEEXT)' + OBJEXT_FOR_BUILD='$(OBJEXT)' +else + OBJEXT_FOR_BUILD='.no' + AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext, + [rm -f conftest* + echo 'int main () { return 0; }' > conftest.c + bfd_cv_build_exeext= + ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5 + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + rm -f conftest* + test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no]) + EXEEXT_FOR_BUILD="" + test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext} +fi +AC_SUBST(EXEEXT_FOR_BUILD)])dnl +AC_SUBST(OBJEXT_FOR_BUILD)])dnl + + + +#------------------------------------------------------------------------ +# SC_ZIPFS_SUPPORT +# Locate a zip encoder installed on the system path, or none. +# +# Arguments: +# none +# +# Results: +# Substitutes the following vars: +# ZIP_PROG +# ZIP_PROG_OPTIONS +# ZIP_PROG_VFSSEARCH +# ZIP_INSTALL_OBJS +#------------------------------------------------------------------------ + +AC_DEFUN([SC_ZIPFS_SUPPORT], [ + ZIP_PROG="" + ZIP_PROG_OPTIONS="" + ZIP_PROG_VFSSEARCH="" + ZIP_INSTALL_OBJS="" + AC_MSG_CHECKING([for zip]) + # If our native tclsh processes the "install" command line option + # we can use it to mint zip files + AS_IF([$TCLSH_PROG install],[ + ZIP_PROG=${TCLSH_PROG} + ZIP_PROG_OPTIONS="install mkzip" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Can use Native Tclsh for Zip encoding]) + ]) + + if test "x$ZIP_PROG" = "x" ; then + AC_MSG_CHECKING([for zip]) + AC_CACHE_VAL(ac_cv_path_zip, [ + search_path=`echo ${PATH} | sed -e 's/:/ /g'` + for dir in $search_path ; do + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done + done + ]) + if test -f "$ac_cv_path_zip" ; then + ZIP_PROG="$ac_cv_path_zip " + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="." + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip + else + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="." + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + AC_MSG_RESULT([No zip found on PATH building minizip]) + fi + fi + AC_SUBST(ZIP_PROG) + AC_SUBST(ZIP_PROG_OPTIONS) + AC_SUBST(ZIP_PROG_VFSSEARCH) + AC_SUBST(ZIP_INSTALL_OBJS) +]) diff --git a/win/tclAppInit.c b/win/tclAppInit.c index ef9f98b..bbe727f 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -124,6 +124,8 @@ _tmain( #ifdef TCL_LOCAL_MAIN_HOOK TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#else + TclZipfs_AppHook(&argc, &argv); #endif Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in index 8aa25f8..5dc6833 100644 --- a/win/tclConfig.sh.in +++ b/win/tclConfig.sh.in @@ -41,6 +41,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@ # The name of the Tcl library (may be either a .a file or a shared library): TCL_LIB_FILE='@TCL_LIB_FILE@' +# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library): +TCL_ZIP_FILE='@TCL_ZIP_FILE@' + # Flag to indicate whether shared libraries need export files. TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@ diff --git a/win/tclKitInit.c b/win/tclKitInit.c new file mode 100644 index 0000000..9531ab5 --- /dev/null +++ b/win/tclKitInit.c @@ -0,0 +1,325 @@ +/* + * tclAppInit.c -- + * + * Provides a default version of the main program and TclKit_AppInit + * procedure for tclsh and other Tcl-based applications (without Tk). + * Note that this program must be built in Win32 console mode to work + * properly. + * + * Copyright (c) 1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-1999 Scriptics Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclWinInt.h" + +#define WIN32_LEAN_AND_MEAN +#include <windows.h> +#undef WIN32_LEAN_AND_MEAN +#include <locale.h> +#include <stdlib.h> +#include <tchar.h> + +extern Tcl_PackageInitProc Registry_Init; +extern Tcl_PackageInitProc Dde_Init; +extern Tcl_PackageInitProc Dde_SafeInit; + +#ifdef TCL_BROKEN_MAINARGS +int _CRT_glob = 0; +static void setargv(int *argcPtr, TCHAR ***argvPtr); +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * The following #if block allows you to change the AppInit function by using + * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The + * #if checks for that #define and uses TclKit_AppInit if it does not exist. + */ +#define TCLKIT_INIT "main.tcl" +#define TCLKIT_VFSMOUNT "/zvfs" +#ifndef TCL_LOCAL_APPINIT +#define TCL_LOCAL_APPINIT TclKit_AppInit +#endif +#ifndef MODULE_SCOPE +# define MODULE_SCOPE extern +#endif +MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *); + +/* + * The following #if block allows you to change how Tcl finds the startup + * script, prime the library or encoding paths, fiddle with the argv, etc., + * without needing to rewrite Tcl_Main() + */ + +#ifdef TCL_LOCAL_MAIN_HOOK +MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv); +#endif + +/* + *---------------------------------------------------------------------- + * + * main -- + * + * This is the main program for the application. + * + * Results: + * None: Tcl_Main never returns here, so this procedure never returns + * either. + * + * Side effects: + * Just about anything, since from here we call arbitrary Tcl code. + * + *---------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +int +main( + int argc, /* Number of command-line arguments. */ + char *dummy[]) /* Not used. */ +{ + TCHAR **argv; +#else +int +_tmain( + int argc, /* Number of command-line arguments. */ + TCHAR *argv[]) /* Values of command-line arguments. */ +{ +#endif + TCHAR *p; + + /* + * Set up the default locale to be standard "C" locale so parsing is + * performed correctly. + */ + + setlocale(LC_ALL, "C"); + +#ifdef TCL_BROKEN_MAINARGS + /* + * Get our args from the c-runtime. Ignore command line. + */ + + setargv(&argc, &argv); +#endif + + /* + * Forward slashes substituted for backslashes. + */ + + for (p = argv[0]; *p != '\0'; p++) { + if (*p == '\\') { + *p = '/'; + } + } + +#ifdef TCL_LOCAL_MAIN_HOOK + TCL_LOCAL_MAIN_HOOK(&argc, &argv); +#endif + /* This voodoo ensures that Tcl_Main does not eat the first argument */ + Tcl_FindExecutable(argv[0]); + Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL); + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT); + return 0; /* Needed only to prevent compiler warning. */ +} + +/* + *---------------------------------------------------------------------- + * + * TclKit_AppInit -- + * + * This procedure performs application-specific initialization. Most + * applications, especially those that incorporate additional packages, + * will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error message in + * the interp's result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int +TclKit_AppInit( + Tcl_Interp *interp) /* Interpreter for application. */ +{ + Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT); + if ((Tcl_Init)(interp) == TCL_ERROR) { + return TCL_ERROR; + } + +// if (Registry_Init(interp) == TCL_ERROR) { +// return TCL_ERROR; +// } +// Tcl_StaticPackage(interp, "registry", Registry_Init, NULL); +// +// if (Dde_Init(interp) == TCL_ERROR) { +// return TCL_ERROR; +// } +// Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit); + + /* + * Call the init procedures for included packages. Each call should look + * like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. (Dynamically-loadable packages + * should have the same entry-point name.) + */ + + /* + * Call Tcl_CreateCommand for application-specific commands, if they + * weren't already created by the init procedures called above. + */ + + /* + * Specify a user-specific startup file to invoke if the application is + * run interactively. Typically the startup file is "~/.apprc" where "app" + * is the name of the application. If this line is deleted then no + * user-specific startup file will be run under any conditions. + */ + + (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL, + Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY); + return TCL_OK; +} + +/* + *------------------------------------------------------------------------- + * + * setargv -- + * + * Parse the Windows command line string into argc/argv. Done here + * because we don't trust the builtin argument parser in crt0. Windows + * applications are responsible for breaking their command line into + * arguments. + * + * 2N backslashes + quote -> N backslashes + begin quoted string + * 2N + 1 backslashes + quote -> literal + * N backslashes + non-quote -> literal + * quote + quote in a quoted string -> single quote + * quote + quote not in quoted string -> empty string + * quote -> begin quoted string + * + * Results: + * Fills argcPtr with the number of arguments and argvPtr with the array + * of arguments. + * + * Side effects: + * Memory allocated. + * + *-------------------------------------------------------------------------- + */ + +#ifdef TCL_BROKEN_MAINARGS +static void +setargv( + int *argcPtr, /* Filled with number of argument strings. */ + TCHAR ***argvPtr) /* Filled with argument strings (malloc'd). */ +{ + TCHAR *cmdLine, *p, *arg, *argSpace; + TCHAR **argv; + int argc, size, inquote, copy, slashes; + + cmdLine = GetCommandLine(); + + /* + * Precompute an overly pessimistic guess at the number of arguments in + * the command line by counting non-space spans. + */ + + size = 2; + for (p = cmdLine; *p != '\0'; p++) { + if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + size++; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + } + } + + /* Make sure we don't call ckalloc through the (not yet initialized) stub table */ + #undef Tcl_Alloc + #undef Tcl_DbCkalloc + + argSpace = ckalloc(size * sizeof(char *) + + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR)); + argv = (TCHAR **) argSpace; + argSpace += size * (sizeof(char *)/sizeof(TCHAR)); + size--; + + p = cmdLine; + for (argc = 0; argc < size; argc++) { + argv[argc] = arg = argSpace; + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */ + p++; + } + if (*p == '\0') { + break; + } + + inquote = 0; + slashes = 0; + while (1) { + copy = 1; + while (*p == '\\') { + slashes++; + p++; + } + if (*p == '"') { + if ((slashes & 1) == 0) { + copy = 0; + if ((inquote) && (p[1] == '"')) { + p++; + copy = 1; + } else { + inquote = !inquote; + } + } + slashes >>= 1; + } + + while (slashes) { + *arg = '\\'; + arg++; + slashes--; + } + + if ((*p == '\0') || (!inquote && + ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */ + break; + } + if (copy != 0) { + *arg = *p; + arg++; + } + p++; + } + *arg = '\0'; + argSpace = arg + 1; + } + argv[argc] = NULL; + + *argcPtr = argc; + *argvPtr = argv; +} +#endif /* TCL_BROKEN_MAINARGS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |