source: trunk/kitgen/zvfs.c

Last change on this file was 196, checked in by demin, 10 years ago

fix pointer arithmetics in zvfs.c and add STDC_HEADERS=1 for zvfs.c compilation in makefile.include
File size: 53.5 KB
Line 
1/*
2** By the overt act of typing this comment, the author of this code
3** releases it into the public domain. No claim of copyright is made.
4** In place of a legal notice, here is a blessing:
5**
6** May you do good and not evil.
7** May you find forgiveness for yourself and forgive others.
8** May you share freely, never taking more than you give.
9**
10***************************************************************************
11** A ZIP archive virtual filesystem for Tcl.
12**
13** This package of routines enables Tcl to use a Zip file as
14** a virtual file system. Each of the content files of the Zip
15** archive appears as a real file to Tcl.
16**
17** Converted to Tcl VFS by Peter MacDonald
18** peter@pdqi.com
19** http://pdqi.com
20**
21**
22** Modified by Damon Courtney to complete the VFS work.
23**
24** @(#) $Id: zvfs.c,v 1.1.1.1 2002/01/27 17:44:02 cvs Exp $
25*/
26
27#include "tclInt.h"
28#include "tclPort.h"
29#include <zlib.h>
30
31/*
32 * Size of the decompression input buffer
33 */
34#define COMPR_BUF_SIZE 8192
35
36#ifdef __WIN32__
37#define NOCASE_PATHS 1
38#else
39#define NOCASE_PATHS 0
40#endif
41
42/*
43 * All static variables are collected into a structure named "local".
44 * That way, it is clear in the code when we are using a static
45 * variable because its name begins with "local.".
46 */
47static struct {
48 Tcl_HashTable fileHash; /* One entry for each file in the ZVFS. The
49 * The key is the virtual filename. The data
50 * an an instance of the ZvfsFile structure.
51 */
52 Tcl_HashTable archiveHash; /* One entry for each archive.
53 * Key is the name.
54 * Data is the ZvfsArchive structure.
55 */
56 int isInit; /* True after initialization */
57} local;
58
59/*
60 * Each ZIP archive file that is mounted is recorded as an instance
61 * of this structure
62 */
63typedef struct ZvfsArchive {
64 int refCount;
65 Tcl_Obj *zName; /* Name of the archive */
66 Tcl_Obj *zMountPoint; /* Where this archive is mounted */
67} ZvfsArchive;
68
69/*
70 * Particulars about each virtual file are recorded in an instance
71 * of the following structure.
72 */
73typedef struct ZvfsFile {
74 int refCount; /* Reference count */
75 Tcl_Obj *zName; /* The full pathname of the virtual file */
76 ZvfsArchive *pArchive; /* The ZIP archive holding this file data */
77 int iOffset; /* Offset into the ZIP archive of the data */
78 int nByte; /* Uncompressed size of the virtual file */
79 int nByteCompr; /* Compressed size of the virtual file */
80 int isdir; /* Set to 1 if directory */
81 int timestamp; /* Modification time */
82 int iCRC; /* Cyclic Redundancy Check of the data */
83 struct ZvfsFile *parent; /* Parent directory. */
84 Tcl_HashTable children; /* For directory entries, a hash table of
85 * all of the files in the directory.
86 */
87} ZvfsFile;
88
89/*
90 * Whenever a ZVFS file is opened, an instance of this structure is
91 * attached to the open channel where it will be available to the
92 * ZVFS I/O routines below. All state information about an open
93 * ZVFS file is held in this structure.
94 */
95typedef struct ZvfsChannelInfo {
96 unsigned int nByte; /* number of bytes of read uncompressed data */
97 unsigned int nByteCompr; /* number of bytes of unread compressed data */
98 unsigned int nData; /* total number of bytes of compressed data */
99 int readSoFar; /* Number of bytes read so far */
100 long startOfData; /* File position of data in ZIP archive */
101 int isCompressed; /* True data is compressed */
102 Tcl_Channel chan; /* Open to the archive file */
103 unsigned char *zBuf; /* buffer used by the decompressor */
104 z_stream stream; /* state of the decompressor */
105} ZvfsChannelInfo;
106
107/* The attributes defined for each file in the archive.
108 * These are accessed via the 'file attributes' command in Tcl.
109 */
110static CONST char *ZvfsAttrs[] = {
111 "-archive", "-compressedsize", "-crc", "-mount", "-offset",
112 "-uncompressedsize", (char *)NULL
113};
114
115enum {
116 ZVFS_ATTR_ARCHIVE, ZVFS_ATTR_COMPSIZE, ZVFS_ATTR_CRC,
117 ZVFS_ATTR_MOUNT, ZVFS_ATTR_OFFSET, ZVFS_ATTR_UNCOMPSIZE
118};
119
120/* Forward declarations for the callbacks to the Tcl filesystem. */
121
122static Tcl_FSPathInFilesystemProc PathInFilesystem;
123static Tcl_FSDupInternalRepProc DupInternalRep;
124static Tcl_FSFreeInternalRepProc FreeInternalRep;
125static Tcl_FSInternalToNormalizedProc InternalToNormalized;
126static Tcl_FSFilesystemPathTypeProc FilesystemPathType;
127static Tcl_FSFilesystemSeparatorProc FilesystemSeparator;
128static Tcl_FSStatProc Stat;
129static Tcl_FSAccessProc Access;
130static Tcl_FSOpenFileChannelProc OpenFileChannel;
131static Tcl_FSMatchInDirectoryProc MatchInDirectory;
132static Tcl_FSListVolumesProc ListVolumes;
133static Tcl_FSFileAttrStringsProc FileAttrStrings;
134static Tcl_FSFileAttrsGetProc FileAttrsGet;
135static Tcl_FSFileAttrsSetProc FileAttrsSet;
136static Tcl_FSChdirProc Chdir;
137
138static Tcl_Filesystem zvfsFilesystem = {
139 "zvfs",
140 sizeof(Tcl_Filesystem),
141 TCL_FILESYSTEM_VERSION_1,
142 &PathInFilesystem,
143 &DupInternalRep,
144 &FreeInternalRep,
145 &InternalToNormalized,
146 NULL, /* &CreateInternalRep, */
147 NULL, /* &NormalizePath, */
148 &FilesystemPathType,
149 &FilesystemSeparator,
150 &Stat,
151 &Access,
152 &OpenFileChannel,
153 &MatchInDirectory,
154 NULL, /* &Utime, */
155 NULL, /* &Link, */
156 &ListVolumes,
157 &FileAttrStrings,
158 &FileAttrsGet,
159 &FileAttrsSet,
160 NULL, /* &CreateDirectory, */
161 NULL, /* &RemoveDirectory, */
162 NULL, /* &DeleteFile, */
163 NULL, /* &CopyFile, */
164 NULL, /* &RenameFile, */
165 NULL, /* &CopyDirectory, */
166 NULL, /* &Lstat, */
167 NULL, /* &LoadFile, */
168 NULL, /* &GetCwd, */
169 &Chdir
170};
171
172
173/*
174 * Forward declarations describing the channel type structure for
175 * opening and reading files inside of an archive.
176 */
177static Tcl_DriverCloseProc DriverClose;
178static Tcl_DriverInputProc DriverInput;
179static Tcl_DriverOutputProc DriverOutput;
180static Tcl_DriverSeekProc DriverSeek;
181static Tcl_DriverWatchProc DriverWatch;
182static Tcl_DriverGetHandleProc DriverGetHandle;
183
184static Tcl_ChannelType vfsChannelType = {
185 "zvfs", /* Type name. */
186 TCL_CHANNEL_VERSION_2, /* Set blocking/nonblocking behaviour. NULL'able */
187 DriverClose, /* Close channel, clean instance data */
188 DriverInput, /* Handle read request */
189 DriverOutput, /* Handle write request */
190 DriverSeek, /* Move location of access point. NULL'able */
191 NULL, /* Set options. NULL'able */
192 NULL, /* Get options. NULL'able */
193 DriverWatch, /* Initialize notifier */
194 DriverGetHandle /* Get OS handle from the channel. */
195};
196
197/*
198 * Macros to read 16-bit and 32-bit big-endian integers into the
199 * native format of this local processor. B is an array of
200 * characters and the integer begins at the N-th character of
201 * the array.
202 */
203#define INT16(B, N) (B[N] + (B[N+1]<<8))
204#define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24))
205
206
207
208/*
209 *----------------------------------------------------------------------
210 *
211 * DosTimeDate --
212 *
213 * Convert DOS date and time from a zip archive into clock seconds.
214 *
215 * Results:
216 * Clock seconds
217 *
218 *----------------------------------------------------------------------
219 */
220
221static time_t
222DosTimeDate( int dosDate, int dosTime )
223{
224 time_t now;
225 struct tm *tm;
226 now=time(NULL);
227 tm = localtime(&now);
228 tm->tm_year=(((dosDate&0xfe00)>>9) + 80);
229 tm->tm_mon=((dosDate&0x1e0)>>5)-1;
230 tm->tm_mday=(dosDate & 0x1f);
231 tm->tm_hour=(dosTime&0xf800)>>11;
232 tm->tm_min=(dosTime&0x7e)>>5;
233 tm->tm_sec=(dosTime&0x1f);
234 return mktime(tm);
235}
236
237
238/*
239 *----------------------------------------------------------------------
240 *
241 * StrDup --
242 *
243 * Create a copy of the given string and lower it if necessary.
244 *
245 * Results:
246 * Pointer to the new string. Space to hold the returned
247 * string is obtained from Tcl_Alloc() and should be freed
248 * by the calling function.
249 *
250 *----------------------------------------------------------------------
251 */
252
253char *
254StrDup( char *str, int lower )
255{
256 int i, c, len;
257 char *newstr;
258
259 len = strlen(str);
260
261 newstr = Tcl_Alloc( len + 1 );
262 memcpy( newstr, str, len );
263 newstr[len] = '\0';
264
265 if( lower ) {
266 for( i = 0; (c = newstr[i]) != 0; ++i )
267 {
268 if( isupper(c) ) {
269 newstr[i] = tolower(c);
270 }
271 }
272 }
273
274 return newstr;
275}
276
277
278/*
279 *----------------------------------------------------------------------
280 *
281 * CanonicalPath --
282 *
283 * Concatenate zTail onto zRoot to form a pathname. After
284 * concatenation, simplify the pathname by removing ".." and
285 * "." directories.
286 *
287 * Results:
288 * Pointer to the new pathname. Space to hold the returned
289 * path is obtained from Tcl_Alloc() and should be freed by
290 * the calling function.
291 *
292 *----------------------------------------------------------------------
293 */
294
295static char *
296CanonicalPath( const char *zRoot, const char *zTail )
297{
298 char *zPath;
299 int i, j, c;
300 int len = strlen(zRoot) + strlen(zTail) + 2;
301
302#ifdef __WIN32__
303 if( isalpha(zTail[0]) && zTail[1]==':' ){ zTail += 2; }
304 if( zTail[0]=='\\' ){ zRoot = ""; zTail++; }
305 if( zTail[0]=='\\' ){ zRoot = "/"; zTail++; } // account for UNC style path
306#endif
307 if( zTail[0]=='/' ){ zRoot = ""; zTail++; }
308 if( zTail[0]=='/' ){ zRoot = "/"; zTail++; } // account for UNC style path
309
310 zPath = Tcl_Alloc( len );
311 if( !zPath ) return NULL;
312
313 sprintf( zPath, "%s/%s", zRoot, zTail );
314 for( i = j = 0; (c = zPath[i]) != 0; i++ )
315 {
316#ifdef __WIN32__
317 if( c == '\\' ) {
318 c = '/';
319 }
320#endif
321 if( c == '/' ) {
322 int c2 = zPath[i+1];
323 if( c2 == '/' ) continue;
324 if( c2 == '.' ) {
325 int c3 = zPath[i+2];
326 if( c3 == '/' || c3 == 0 ) {
327 i++;
328 continue;
329 }
330 if( c3 == '.' && (zPath[i+3] == '.' || zPath[i+3] == 0) ) {
331 i += 2;
332 while( j > 0 && zPath[j-1] != '/' ) { j--; }
333 continue;
334 }
335 }
336 }
337 zPath[j++] = c;
338 }
339
340 if( j == 0 ) {
341 zPath[j++] = '/';
342 }
343
344 zPath[j] = 0;
345
346 return zPath;
347}
348
349
350/*
351 *----------------------------------------------------------------------
352 *
353 * AbsolutePath --
354 *
355 * Construct an absolute pathname from the given pathname. On
356 * Windows, all backslash (\) characters are converted to
357 * forward slash (/), and if NOCASE_PATHS is true, all letters
358 * are converted to lowercase. The drive letter, if present, is
359 * preserved.
360 *
361 * Results:
362 * Pointer to the new pathname. Space to hold the returned
363 * path is obtained from Tcl_Alloc() and should be freed by
364 * the calling function.
365 *
366 *----------------------------------------------------------------------
367 */
368
369static char *
370AbsolutePath( const char *z )
371{
372 int len;
373 char *zResult;
374
375 if( *z != '/'
376#ifdef __WIN32__
377 && *z != '\\' && (!isalpha(*z) || z[1] != ':' )
378#endif
379 ) {
380 /* Case 1: "z" is a relative path, so prepend the current
381 * working directory in order to generate an absolute path.
382 */
383 Tcl_Obj *pwd = Tcl_FSGetCwd(NULL);
384 zResult = CanonicalPath( Tcl_GetString(pwd), z );
385 Tcl_DecrRefCount(pwd);
386 } else {
387 /* Case 2: "z" is an absolute path already, so we
388 * just need to make a copy of it.
389 */
390 zResult = StrDup( (char *)z, 0);
391 }
392
393 /* If we're on Windows, we want to convert all backslashes to
394 * forward slashes. If NOCASE_PATHS is true, we want to also
395 * lower the alpha characters in the path.
396 */
397#if NOCASE_PATHS || defined(__WIN32__)
398 {
399 int i, c;
400 for( i = 0; (c = zResult[i]) != 0; i++ )
401 {
402#if NOCASE_PATHS
403 if( isupper(c) ) {
404 zResult[i] = tolower(c);
405 }
406#endif
407#ifdef __WIN32__
408 if( c == '\\' ) {
409 zResult[i] = '/';
410 }
411#endif
412 }
413 }
414#endif /* NOCASE_PATHS || defined(__WIN32__) */
415
416 len = strlen(zResult);
417 /* Strip the trailing / from any directory. */
418 if( zResult[len-1] == '/' ) {
419 zResult[len-1] = 0;
420 }
421
422 return zResult;
423}
424
425
426/*
427 *----------------------------------------------------------------------
428 *
429 * AddPathToArchive --
430 *
431 * Add the given pathname to the given archive. zName is usually
432 * the pathname pulled from the file header in a zip archive. We
433 * concatenate it onto the archive's mount point to obtain a full
434 * path before adding it to our hash table.
435 *
436 * All parent directories of the given path will be created and
437 * added to the hash table.
438 *
439 * Results:
440 * Pointer to the new file structure or to the old file structure
441 * if it already existed. newPath will be true if this path is
442 * new to this archive or false if we already had it.
443 *
444 *----------------------------------------------------------------------
445 */
446
447static ZvfsFile *
448AddPathToArchive( ZvfsArchive *pArchive, char *zName, int *newPath )
449{
450 int i, len, isNew;
451 char *zFullPath, *izFullPath;
452 char *zParentPath, *izParentPath;
453 Tcl_HashEntry *pEntry;
454 Tcl_Obj *nameObj, *pathObj, *listObj;
455 ZvfsFile *pZvfs, *parent = NULL;
456
457 zFullPath = CanonicalPath( Tcl_GetString(pArchive->zMountPoint), zName );
458 izFullPath = zFullPath;
459
460 pathObj = Tcl_NewStringObj( zFullPath, -1 );
461 Tcl_IncrRefCount( pathObj );
462
463 listObj = Tcl_FSSplitPath( pathObj, &len );
464 Tcl_IncrRefCount( listObj );
465 Tcl_DecrRefCount( pathObj );
466
467 /* Walk through all the parent directories of this
468 * file and add them all to our archive. This is
469 * because some zip files don't store directory
470 * entries in the archive, but we need to know all
471 * of the directories to create the proper filesystem.
472 */
473 for( i = 1; i < len; ++i )
474 {
475 pathObj = Tcl_FSJoinPath( listObj, i );
476
477 izParentPath = zParentPath = Tcl_GetString(pathObj);
478#if NOCASE_PATHS
479 izParentPath = StrDup( zParentPath, 1 );
480#endif
481 pEntry = Tcl_CreateHashEntry( &local.fileHash, izParentPath, &isNew );
482#if NOCASE_PATHS
483 Tcl_Free( izParentPath );
484#endif
485
486 if( !isNew ) {
487 /* We already have this directory in our archive. */
488 parent = Tcl_GetHashValue( pEntry );
489 continue;
490 }
491
492 Tcl_ListObjIndex( NULL, listObj, i-1, &nameObj );
493 Tcl_IncrRefCount(nameObj);
494
495 /* We don't have this directory in our archive yet. Add it. */
496 pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) );
497 pZvfs->refCount = 1;
498 pZvfs->zName = nameObj;
499 pZvfs->pArchive = pArchive;
500 pZvfs->isdir = 1;
501 pZvfs->iOffset = 0;
502 pZvfs->timestamp = 0;
503 pZvfs->iCRC = 0;
504 pZvfs->nByteCompr = 0;
505 pZvfs->nByte = 0;
506 pZvfs->parent = parent;
507 Tcl_InitHashTable( &pZvfs->children, TCL_STRING_KEYS );
508
509 Tcl_SetHashValue( pEntry, pZvfs );
510
511 if( parent ) {
512 /* Add this directory to its parent's list of children. */
513 pEntry = Tcl_CreateHashEntry(&parent->children,zParentPath,&isNew);
514 if( isNew ) {
515 Tcl_SetHashValue( pEntry, pZvfs );
516 }
517 }
518
519 parent = pZvfs;
520 }
521
522 /* Check to see if we already have this file in our archive. */
523#if NOCASE_PATHS
524 izFullPath = StrDup( zFullPath, 1 );
525#endif
526 pEntry = Tcl_CreateHashEntry(&local.fileHash, izFullPath, newPath);
527#if NOCASE_PATHS
528 Tcl_Free( izFullPath );
529#endif
530
531 if( *newPath ) {
532 /* We don't have this file in our archive. Add it. */
533 Tcl_ListObjIndex( NULL, listObj, len-1, &nameObj );
534 Tcl_IncrRefCount(nameObj);
535
536 pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) );
537 pZvfs->refCount = 1;
538 pZvfs->zName = nameObj;
539 pZvfs->pArchive = pArchive;
540
541 Tcl_SetHashValue( pEntry, pZvfs );
542
543 /* Add this path to its parent's list of children. */
544 pEntry = Tcl_CreateHashEntry(&parent->children, zFullPath, &isNew);
545
546 if( isNew ) {
547 Tcl_SetHashValue( pEntry, pZvfs );
548 }
549 } else {
550 /* We already have this file. Set the pointer and return. */
551 pZvfs = Tcl_GetHashValue( pEntry );
552 }
553
554 Tcl_DecrRefCount(listObj);
555 Tcl_Free(zFullPath);
556
557 return pZvfs;
558}
559
560
561/*
562 *----------------------------------------------------------------------
563 *
564 * Zvfs_Mount --
565 *
566 * Read a zip archive and make entries in the file hash table for
567 * all of the files in the archive. If Zvfs has not been initialized,
568 * it will be initialized here before mounting the archive.
569 *
570 * Results:
571 * Standard Tcl result.
572 *
573 *----------------------------------------------------------------------
574 */
575
576int
577Zvfs_Mount(
578 Tcl_Interp *interp, /* Leave error messages in this interpreter */
579 CONST char *zArchive, /* The ZIP archive file */
580 CONST char *zMountPoint /* Mount contents at this directory */
581) {
582 Tcl_Channel chan = NULL; /* Used for reading the ZIP archive file */
583 char *zArchiveName = 0; /* A copy of zArchive */
584 char *zFullMountPoint = 0; /* Absolute path to the mount point */
585 int nFile; /* Number of files in the archive */
586 int iPos; /* Current position in the archive file */
587 int code = TCL_ERROR; /* Return code */
588 int update = 1; /* Whether to update the mounts */
589 ZvfsArchive *pArchive; /* The ZIP archive being mounted */
590 Tcl_HashEntry *pEntry; /* Hash table entry */
591 int isNew; /* Flag to tell use when a hash entry is new */
592 unsigned char zBuf[100]; /* Buffer to read from the ZIP archive */
593 ZvfsFile *pZvfs; /* A new virtual file */
594 Tcl_Obj *hashKeyObj = NULL;
595 Tcl_Obj *resultObj = Tcl_GetObjResult(interp);
596 Tcl_Obj *readObj = Tcl_NewObj();
597 Tcl_IncrRefCount(readObj);
598
599 if( !local.isInit ) {
600 if( Zvfs_Init( interp ) == TCL_ERROR ) {
601 Tcl_SetStringObj( resultObj, "failed to initialize zvfs", -1 );
602 return TCL_ERROR;
603 }
604 }
605
606 /* If zArchive is NULL, set the result to a list of all
607 * mounted files.
608 */
609 if( !zArchive ) {
610 Tcl_HashSearch zSearch;
611
612 for( pEntry = Tcl_FirstHashEntry( &local.archiveHash,&zSearch );
613 pEntry; pEntry = Tcl_NextHashEntry(&zSearch) )
614 {
615 if( (pArchive = Tcl_GetHashValue(pEntry)) ) {
616 Tcl_ListObjAppendElement( interp, resultObj,
617 Tcl_DuplicateObj(pArchive->zName) );
618 }
619 }
620 code = TCL_OK;
621 update = 0;
622 goto done;
623 }
624
625 /* If zMountPoint is NULL, set the result to the mount point
626 * for the specified archive file.
627 */
628 if( !zMountPoint ) {
629 int found = 0;
630 Tcl_HashSearch zSearch;
631
632 zArchiveName = AbsolutePath( zArchive );
633 for( pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
634 pEntry; pEntry = Tcl_NextHashEntry(&zSearch) )
635 {
636 pArchive = Tcl_GetHashValue(pEntry);
637 if ( !strcmp( Tcl_GetString(pArchive->zName), zArchiveName ) ) {
638 ++found;
639 Tcl_SetStringObj( resultObj,
640 Tcl_GetString(pArchive->zMountPoint), -1 );
641 break;
642 }
643 }
644
645 if( !found ) {
646 Tcl_SetStringObj( resultObj, "archive not mounted by zvfs", -1 );
647 }
648
649 code = found ? TCL_OK : TCL_ERROR;
650 update = 0;
651 goto done;
652 }
653
654 if( !(chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0)) ) {
655 goto done;
656 }
657
658 if(Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK) {
659 goto done;
660 }
661
662 /* Read the "End Of Central Directory" record from the end of the
663 * ZIP archive.
664 */
665 iPos = Tcl_Seek( chan, -22, SEEK_END );
666 Tcl_Read( chan, zBuf, 22 );
667 if( memcmp(zBuf, "\120\113\05\06", 4) ) {
668 Tcl_SetStringObj( resultObj, "bad end of central directory record", -1);
669 goto done;
670 }
671
672 zArchiveName = AbsolutePath( zArchive );
673 zFullMountPoint = AbsolutePath( zMountPoint );
674
675 hashKeyObj = Tcl_NewObj();
676 Tcl_IncrRefCount(hashKeyObj);
677 Tcl_AppendStringsToObj( hashKeyObj, zArchiveName, ":", zFullMountPoint,
678 (char *)NULL );
679
680 pEntry = Tcl_CreateHashEntry( &local.archiveHash,
681 Tcl_GetString(hashKeyObj), &isNew );
682
683 if( !isNew ) {
684 /* This archive is already mounted. Set the result to
685 * the current mount point and return.
686 */
687 pArchive = Tcl_GetHashValue(pEntry);
688 code = TCL_OK;
689 update = 0;
690 goto done;
691 }
692
693 pArchive = (ZvfsArchive*)Tcl_Alloc(sizeof(*pArchive));
694 pArchive->refCount = 1;
695 pArchive->zName = Tcl_NewStringObj(zArchiveName,-1);
696 pArchive->zMountPoint = Tcl_NewStringObj(zFullMountPoint,-1);
697 Tcl_SetHashValue(pEntry, pArchive);
698
699 /* Add the root mount point to our list of archive files as a directory. */
700 pEntry = Tcl_CreateHashEntry(&local.fileHash, zFullMountPoint, &isNew);
701
702 if( isNew ) {
703 pZvfs = (ZvfsFile*)Tcl_Alloc( sizeof(*pZvfs) );
704 pZvfs->refCount = 1;
705 pZvfs->zName = Tcl_NewStringObj(zFullMountPoint,-1);
706 pZvfs->pArchive = pArchive;
707 pZvfs->isdir = 1;
708 pZvfs->iOffset = 0;
709 pZvfs->timestamp = 0;
710 pZvfs->iCRC = 0;
711 pZvfs->nByteCompr = 0;
712 pZvfs->nByte = 0;
713 pZvfs->parent = NULL;
714 Tcl_InitHashTable( &pZvfs->children, TCL_STRING_KEYS );
715
716 Tcl_SetHashValue( pEntry, pZvfs );
717 }
718
719 /* Compute the starting location of the directory for the
720 * ZIP archive in iPos then seek to that location.
721 */
722 nFile = INT16(zBuf,8);
723 iPos -= INT32(zBuf,12);
724 Tcl_Seek( chan, iPos, SEEK_SET );
725
726 while( nFile-- > 0 )
727 {
728 int isdir = 0;
729 int iData; /* Offset to start of file data */
730 int lenName; /* Length of the next filename */
731 int lenExtra; /* Length of "extra" data for next file */
732 int attributes; /* DOS attributes */
733 char *zName;
734 char *zFullPath; /* Full pathname of the virtual file */
735 char *izFullPath; /* Lowercase full pathname */
736 ZvfsFile *parent;
737
738 /* Read the next directory entry. Extract the size of the filename,
739 * the size of the "extra" information, and the offset into the archive
740 * file of the file data.
741 */
742 Tcl_Read( chan, zBuf, 46 );
743 if( memcmp(zBuf, "\120\113\01\02", 4) ) {
744 Zvfs_Unmount( interp, zArchiveName );
745 Tcl_SetStringObj( resultObj, "bad central file record", -1 );
746 goto done;
747 }
748
749 lenName = INT16(zBuf,28);
750 lenExtra = INT16(zBuf,30) + INT16(zBuf,32);
751 iData = INT32(zBuf,42);
752
753 /* Construct an entry in local.fileHash for this virtual file. */
754 Tcl_ReadChars( chan, readObj, lenName, 0 );
755
756 zName = Tcl_GetString(readObj);
757
758 if( zName[--lenName] == '/' ) {
759 isdir = 1;
760 Tcl_SetObjLength( readObj, lenName );
761 }
762
763 pZvfs = AddPathToArchive( pArchive, zName, &isNew );
764
765 pZvfs->isdir = isdir;
766 pZvfs->iOffset = iData;
767 pZvfs->timestamp = DosTimeDate(INT16(zBuf, 14), INT16(zBuf, 12));
768 pZvfs->iCRC = INT32(zBuf, 16);
769 pZvfs->nByteCompr = INT32(zBuf, 20);
770 pZvfs->nByte = INT32(zBuf, 24);
771
772 /* If this is a directory we want to initialize the
773 * hash table to store its children if it has any.
774 */
775 if( isNew && isdir ) {
776 Tcl_InitHashTable( &pZvfs->children, TCL_STRING_KEYS );
777 }
778
779 /* Skip over the extra information so that the next read
780 * will be from the beginning of the next directory entry.
781 */
782 Tcl_Seek( chan, lenExtra, SEEK_CUR );
783 }
784
785 code = TCL_OK;
786
787done:
788 if( chan ) Tcl_Close( interp, chan );
789
790 if( readObj ) Tcl_DecrRefCount(readObj);
791 if( hashKeyObj ) Tcl_DecrRefCount(hashKeyObj);
792
793 if( zArchiveName ) Tcl_Free(zArchiveName);
794 if( zFullMountPoint ) Tcl_Free(zFullMountPoint);
795
796 if( code == TCL_OK && update ) {
797 Tcl_FSMountsChanged( &zvfsFilesystem );
798 Tcl_SetStringObj( resultObj, zMountPoint, -1 );
799 }
800
801 return code;
802}
803
804
805/*
806 *----------------------------------------------------------------------
807 *
808 * Zvfs_Unmount --
809 *
810 * Unmount all the files in the given zip archive. All the
811 * entries in the file hash table for the archive are deleted
812 * as well as the entry in the archive hash table.
813 *
814 * Any memory associated with the entries will be freed as well.
815 *
816 * Results:
817 * Standard Tcl result.
818 *
819 *----------------------------------------------------------------------
820 */
821
822int
823Zvfs_Unmount( Tcl_Interp *interp, CONST char *zMountPoint )
824{
825 int found = 0;
826 ZvfsFile *pFile;
827 ZvfsArchive *pArchive;
828 Tcl_HashEntry *pEntry;
829 Tcl_HashSearch zSearch;
830 Tcl_HashEntry *fEntry;
831 Tcl_HashSearch fSearch;
832
833 for( pEntry = Tcl_FirstHashEntry( &local.archiveHash, &zSearch );
834 pEntry; pEntry = Tcl_NextHashEntry(&zSearch) )
835 {
836 pArchive = Tcl_GetHashValue(pEntry);
837 if( !Tcl_StringCaseMatch( zMountPoint,
838 Tcl_GetString(pArchive->zMountPoint), NOCASE_PATHS ) ) continue;
839
840 found++;
841
842 for( fEntry = Tcl_FirstHashEntry( &local.fileHash, &fSearch );
843 fEntry; fEntry = Tcl_NextHashEntry(&fSearch) )
844 {
845 pFile = Tcl_GetHashValue(fEntry);
846 if( pFile->pArchive == pArchive ) {
847 FreeInternalRep( (ClientData)pFile );
848 Tcl_DeleteHashEntry(fEntry);
849 }
850 }
851
852 Tcl_DeleteHashEntry(pEntry);
853 Tcl_DecrRefCount(pArchive->zName);
854 Tcl_DecrRefCount(pArchive->zMountPoint);
855 Tcl_Free( (char *)pArchive );
856 }
857
858 if( !found ) {
859 if( interp ) {
860 Tcl_AppendStringsToObj( Tcl_GetObjResult(interp),
861 zMountPoint, " is not a zvfs mount", (char *)NULL );
862 }
863 return TCL_ERROR;
864 }
865
866 Tcl_FSMountsChanged( &zvfsFilesystem );
867
868 return TCL_OK;
869}
870
871
872/*
873 *----------------------------------------------------------------------
874 *
875 * ZvfsLookup --
876 *
877 * Part of the "zvfs" Tcl_Filesystem.
878 * Look into the file hash table for a given path and see if
879 * it belongs to our filesystem.
880 *
881 * Results:
882 * Pointer to the file structure or NULL if it was not found.
883 *
884 *----------------------------------------------------------------------
885 */
886
887static ZvfsFile *
888ZvfsLookup( Tcl_Obj *pathPtr )
889{
890 char *zTrueName;
891 Tcl_HashEntry *pEntry;
892
893 zTrueName = AbsolutePath( Tcl_GetString(pathPtr) );
894 pEntry = Tcl_FindHashEntry( &local.fileHash, zTrueName );
895 Tcl_Free(zTrueName);
896
897 return pEntry ? Tcl_GetHashValue(pEntry) : NULL;
898}
899
900
901/*
902 *----------------------------------------------------------------------
903 *
904 * GetZvfsFile --
905 *
906 * Part of the "zvfs" Tcl_Filesystem.
907 * For a given pathPtr, return the internal representation
908 * of the path for our filesystem.
909 *
910 * Results:
911 * Pointer to the file structure or NULL if it was not found.
912 *
913 *----------------------------------------------------------------------
914 */
915
916static ZvfsFile *
917GetZvfsFile( Tcl_Obj *pathPtr )
918{
919 ZvfsFile *pFile = (ZvfsFile *)Tcl_FSGetInternalRep(pathPtr,&zvfsFilesystem);
920 return pFile == NULL || pFile->pArchive->refCount == 0 ? NULL : pFile;
921}
922
923
924/*
925 *----------------------------------------------------------------------
926 *
927 * ZvfsFileMatchesType --
928 *
929 * Part of the "zvfs" Tcl_Filesystem.
930 * See if the given ZvfsFile matches the type data given.
931 *
932 * Results:
933 * 1 if true, 0 if false
934 *
935 *----------------------------------------------------------------------
936 */
937
938static int
939ZvfsFileMatchesType( ZvfsFile *pFile, Tcl_GlobTypeData *types )
940{
941 if( types ) {
942 if( types->type & TCL_GLOB_TYPE_FILE && pFile->isdir ) {
943 return 0;
944 }
945
946 if( types->type & (TCL_GLOB_TYPE_DIR | TCL_GLOB_TYPE_MOUNT)
947 && !pFile->isdir ) {
948 return 0;
949 }
950
951 if( types->type & TCL_GLOB_TYPE_MOUNT && pFile->parent ) {
952 return 0;
953 }
954 }
955
956 return 1;
957}
958
959
960/*
961 *----------------------------------------------------------------------
962 *
963 * DriverExit --
964 *
965 * This function is called as an exit handler for the channel
966 * driver. If we do not set pInfo.chan to NULL, Tcl_Close()
967 * will be called twice on that channel when Tcl_Exit runs.
968 * This will lead to a core dump
969 *
970 * Results:
971 * None
972 *
973 *----------------------------------------------------------------------
974 */
975
976static void
977DriverExit( void *pArg )
978{
979 ZvfsChannelInfo *pInfo = (ZvfsChannelInfo*)pArg;
980 pInfo->chan = 0;
981}
982
983
984
985/*
986 *----------------------------------------------------------------------
987 *
988 * DriverClose --
989 *
990 * Called when a channel is closed.
991 *
992 * Results:
993 * Returns TCL_OK.
994 *
995 *----------------------------------------------------------------------
996 */
997
998static int
999DriverClose(
1000 ClientData instanceData, /* A ZvfsChannelInfo structure */
1001 Tcl_Interp *interp /* The TCL interpreter */
1002) {
1003 ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*)instanceData;
1004
1005 if( pInfo->zBuf ){
1006 Tcl_Free(pInfo->zBuf);
1007 inflateEnd(&pInfo->stream);
1008 }
1009
1010 if( pInfo->chan ){
1011 Tcl_Close(interp, pInfo->chan);
1012 Tcl_DeleteExitHandler(DriverExit, pInfo);
1013 }
1014
1015 Tcl_Free((char*)pInfo);
1016
1017 return TCL_OK;
1018}
1019
1020
1021/*
1022 *----------------------------------------------------------------------
1023 *
1024 * DriverInput --
1025 *
1026 * The Tcl channel system calls this function on each read
1027 * from a channel. The channel is opened into the actual
1028 * archive file, but the data is read from the individual
1029 * file entry inside the zip archive.
1030 *
1031 * Results:
1032 * Number of bytes read.
1033 *
1034 *----------------------------------------------------------------------
1035 */
1036
1037static int
1038DriverInput (
1039 ClientData instanceData, /* The channel to read from */
1040 char *buf, /* Buffer to fill */
1041 int toRead, /* Requested number of bytes */
1042 int *pErrorCode /* Location of error flag */
1043) {
1044 ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData;
1045
1046 if( toRead > pInfo->nByte ) {
1047 toRead = pInfo->nByte;
1048 }
1049
1050 if( toRead == 0 ) {
1051 return 0;
1052 }
1053
1054 if( pInfo->isCompressed ) {
1055 int err = Z_OK;
1056 z_stream *stream = &pInfo->stream;
1057 stream->next_out = buf;
1058 stream->avail_out = toRead;
1059 while (stream->avail_out) {
1060 if (!stream->avail_in) {
1061 int len = pInfo->nByteCompr;
1062 if (len > COMPR_BUF_SIZE) {
1063 len = COMPR_BUF_SIZE;
1064 }
1065 len = Tcl_Read(pInfo->chan, pInfo->zBuf, len);
1066 pInfo->nByteCompr -= len;
1067 stream->next_in = pInfo->zBuf;
1068 stream->avail_in = len;
1069 }
1070
1071 err = inflate(stream, Z_NO_FLUSH);
1072 if (err) break;
1073 }
1074
1075 if (err == Z_STREAM_END) {
1076 if ((stream->avail_out != 0)) {
1077 *pErrorCode = err; /* premature end */
1078 return -1;
1079 }
1080 } else if( err ) {
1081 *pErrorCode = err; /* some other zlib error */
1082 return -1;
1083 }
1084 } else {
1085 toRead = Tcl_Read(pInfo->chan, buf, toRead);
1086 }
1087
1088 pInfo->nByte -= toRead;
1089 pInfo->readSoFar += toRead;
1090 *pErrorCode = 0;
1091
1092 return toRead;
1093}
1094
1095
1096/*
1097 *----------------------------------------------------------------------
1098 *
1099 * DriverOutput --
1100 *
1101 * Called to write to a file. Since this is a read-only file
1102 * system, this function will always return an error.
1103 *
1104 * Results:
1105 * Returns -1.
1106 *
1107 *----------------------------------------------------------------------
1108 */
1109
1110static int
1111DriverOutput(
1112 ClientData instanceData, /* The channel to write to */
1113 CONST char *buf, /* Data to be stored. */
1114 int toWrite, /* Number of bytes to write. */
1115 int *pErrorCode /* Location of error flag. */
1116) {
1117 *pErrorCode = EINVAL;
1118 return -1;
1119}
1120
1121
1122/*
1123 *----------------------------------------------------------------------
1124 *
1125 * DriverSeek --
1126 *
1127 * Seek along the open channel to another point.
1128 *
1129 * Results:
1130 * Offset into the file.
1131 *
1132 *----------------------------------------------------------------------
1133 */
1134
1135static int
1136DriverSeek(
1137 ClientData instanceData, /* The file structure */
1138 long offset, /* Offset to seek to */
1139 int mode, /* One of SEEK_CUR, SEEK_SET or SEEK_END */
1140 int *pErrorCode /* Write the error code here */
1141){
1142 ZvfsChannelInfo* pInfo = (ZvfsChannelInfo*) instanceData;
1143
1144 switch( mode ) {
1145 case SEEK_CUR:
1146 offset += pInfo->readSoFar;
1147 break;
1148 case SEEK_END:
1149 offset += pInfo->readSoFar + pInfo->nByte;
1150 break;
1151 default:
1152 /* Do nothing */
1153 break;
1154 }
1155
1156 if( !pInfo->isCompressed ){
1157 /* dont seek behind end of data */
1158 if (pInfo->nData < (unsigned long)offset) {
1159 return -1;
1160 }
1161
1162 /* do the job, save and check the result */
1163 offset = Tcl_Seek(pInfo->chan, offset + pInfo->startOfData, SEEK_SET);
1164 if (offset == -1) {
1165 return -1;
1166 }
1167
1168 /* adjust the counters (use real offset) */
1169 pInfo->readSoFar = offset - pInfo->startOfData;
1170 pInfo->nByte = pInfo->nData - pInfo->readSoFar;
1171 } else {
1172 if( offset<pInfo->readSoFar ) {
1173 z_stream *stream = &pInfo->stream;
1174 inflateEnd(stream);
1175 stream->zalloc = (alloc_func)0;
1176 stream->zfree = (free_func)0;
1177 stream->opaque = (voidpf)0;
1178 stream->avail_in = 2;
1179 stream->next_in = pInfo->zBuf;
1180 pInfo->zBuf[0] = 0x78;
1181 pInfo->zBuf[1] = 0x01;
1182 inflateInit(&pInfo->stream);
1183 Tcl_Seek(pInfo->chan, pInfo->startOfData, SEEK_SET);
1184 pInfo->nByte += pInfo->readSoFar;
1185 pInfo->nByteCompr = pInfo->nData;
1186 pInfo->readSoFar = 0;
1187 }
1188
1189 while( pInfo->readSoFar < offset )
1190 {
1191 int toRead, errCode;
1192 char zDiscard[100];
1193 toRead = offset - pInfo->readSoFar;
1194 if( toRead>sizeof(zDiscard) ) toRead = sizeof(zDiscard);
1195 DriverInput(instanceData, zDiscard, toRead, &errCode);
1196 }
1197 }
1198
1199 return pInfo->readSoFar;
1200}
1201
1202
1203/*
1204 *----------------------------------------------------------------------
1205 *
1206 * DriverWatch --
1207 *
1208 * Called to handle events on the channel. Since zvfs files
1209 * don't generate events, this is a no-op.
1210 *
1211 * Results:
1212 * None
1213 *
1214 *----------------------------------------------------------------------
1215 */
1216
1217static void
1218DriverWatch(
1219 ClientData instanceData, /* Channel to watch */
1220 int mask /* Events of interest */
1221) {
1222 return;
1223}
1224
1225
1226/*
1227 *----------------------------------------------------------------------
1228 *
1229 * DriverGetHandle --
1230 *
1231 * Retrieve a device-specific handle from the given channel.
1232 * Since we don't have a device-specific handle, this is a no-op.
1233 *
1234 * Results:
1235 * Returns TCL_ERROR.
1236 *
1237 *----------------------------------------------------------------------
1238 */
1239
1240static int
1241DriverGetHandle(
1242 ClientData instanceData, /* Channel to query */
1243 int direction, /* Direction of interest */
1244 ClientData* handlePtr /* Space to the handle into */
1245) {
1246 return TCL_ERROR;
1247}
1248
1249
1250/*
1251 *----------------------------------------------------------------------
1252 *
1253 * PathInFilesystem --
1254 *
1255 * Part of the "zvfs" Tcl_Filesystem.
1256 * Check to see if the given path is part of our filesystem.
1257 * We check the file hash table for the path, and if we find
1258 * it, set clientDataPtr to the ZvfsFile pointer so that Tcl
1259 * will cache it for later.
1260 *
1261 * Results:
1262 * TCL_OK on success, or -1 on failure
1263 *
1264 *----------------------------------------------------------------------
1265 */
1266
1267static int
1268PathInFilesystem( Tcl_Obj *pathPtr, ClientData *clientDataPtr )
1269{
1270 ZvfsFile *pFile = ZvfsLookup(pathPtr);
1271
1272 if( pFile ) {
1273 *clientDataPtr = DupInternalRep((ClientData)pFile);
1274 return TCL_OK;
1275 }
1276 return -1;
1277}
1278
1279
1280/*
1281 *----------------------------------------------------------------------
1282 *
1283 * DupInternalRep --
1284 *
1285 * Part of the "zvfs" Tcl_Filesystem.
1286 * Duplicate the ZvfsFile "native" rep of a path.
1287 *
1288 * Results:
1289 * Returns clientData, with refcount incremented.
1290 *
1291 *----------------------------------------------------------------------
1292 */
1293
1294static ClientData
1295DupInternalRep( ClientData clientData )
1296{
1297 ZvfsFile *pFile = (ZvfsFile *)clientData;
1298 pFile->refCount++;
1299 return (ClientData)pFile;
1300}
1301
1302
1303/*
1304 *----------------------------------------------------------------------
1305 *
1306 * FreeInternalRep --
1307 *
1308 * Part of the "zvfs" Tcl_Filesystem.
1309 * Free one reference to the ZvfsFile "native" rep of a path.
1310 * When all references are gone, free the struct.
1311 *
1312 * Side effects:
1313 * May free memory.
1314 *
1315 *----------------------------------------------------------------------
1316 */
1317
1318static void
1319FreeInternalRep( ClientData clientData )
1320{
1321 ZvfsFile *pFile = (ZvfsFile *)clientData;
1322
1323 if (--pFile->refCount <= 0) {
1324 if( pFile->isdir ) {
1325 /* Delete the hash table containing the children
1326 * of this directory. We don't need to free the
1327 * data for each entry in the table because they're
1328 * just pointers to the ZvfsFiles, and those will
1329 * be freed below.
1330 */
1331 Tcl_DeleteHashTable( &pFile->children );
1332 }
1333 Tcl_DecrRefCount(pFile->zName);
1334 Tcl_Free((char *)pFile);
1335 }
1336}
1337
1338
1339/*
1340 *----------------------------------------------------------------------
1341 *
1342 * InternalToNormalized --
1343 *
1344 * Part of the "zvfs" Tcl_Filesystem.
1345 * From a ZvfsFile representation, produce the path string rep.
1346 *
1347 * Results:
1348 * Returns a Tcl_Obj holding the string rep.
1349 *
1350 *----------------------------------------------------------------------
1351 */
1352
1353static Tcl_Obj *
1354InternalToNormalized( ClientData clientData )
1355{
1356 ZvfsFile *pFile = (ZvfsFile *)clientData;
1357 if( !pFile->parent ) {
1358 return Tcl_DuplicateObj( pFile->zName );
1359 } else {
1360 return Tcl_FSJoinToPath( pFile->parent->zName, 1, &pFile->zName );
1361 }
1362}
1363
1364
1365/*
1366 *----------------------------------------------------------------------
1367 *
1368 * FilesystemPathType --
1369 *
1370 * Part of the "zvfs" Tcl_Filesystem.
1371 * Used for informational purposes only. Return a Tcl_Obj
1372 * which describes the "type" of path this is. For our
1373 * little filesystem, they're all "zip".
1374 *
1375 * Results:
1376 * Tcl_Obj with 0 refCount
1377 *
1378 *----------------------------------------------------------------------
1379 */
1380
1381static Tcl_Obj *
1382FilesystemPathType( Tcl_Obj *pathPtr )
1383{
1384 return Tcl_NewStringObj( "zip", -1 );
1385}
1386
1387
1388/*
1389 *----------------------------------------------------------------------
1390 *
1391 * FileSystemSeparator --
1392 *
1393 * Part of the "zvfs" Tcl_Filesystem.
1394 * Return a Tcl_Obj describing the separator character for
1395 * our filesystem. We like things the old-fashioned way,
1396 * so we'll just use /.
1397 *
1398 * Results:
1399 * Tcl_Obj with 0 refCount
1400 *
1401 *----------------------------------------------------------------------
1402 */
1403
1404static Tcl_Obj *
1405FilesystemSeparator( Tcl_Obj *pathPtr )
1406{
1407 return Tcl_NewStringObj( "/", -1 );
1408}
1409
1410
1411/*
1412 *----------------------------------------------------------------------
1413 *
1414 * Stat --
1415 *
1416 * Part of the "zvfs" Tcl_Filesystem.
1417 * Does a stat() system call for a zvfs file. Fill the stat
1418 * buf with as much information as we have.
1419 *
1420 * Results:
1421 * 0 on success, -1 on failure.
1422 *
1423 *----------------------------------------------------------------------
1424 */
1425
1426static int
1427Stat( Tcl_Obj *pathPtr, Tcl_StatBuf *buf )
1428{
1429 ZvfsFile *pFile;
1430
1431 if( !(pFile = GetZvfsFile(pathPtr)) ) {
1432 return -1;
1433 }
1434
1435 memset(buf, 0, sizeof(*buf));
1436 if (pFile->isdir) {
1437 buf->st_mode = 040555;
1438 } else {
1439 buf->st_mode = 0100555;
1440 }
1441
1442 buf->st_size = pFile->nByte;
1443 buf->st_mtime = pFile->timestamp;
1444 buf->st_ctime = pFile->timestamp;
1445 buf->st_atime = pFile->timestamp;
1446
1447 return 0;
1448}
1449
1450
1451/*
1452 *----------------------------------------------------------------------
1453 *
1454 * Access --
1455 *
1456 * Part of the "zvfs" Tcl_Filesystem.
1457 * Does an access() system call for a zvfs file.
1458 *
1459 * Results:
1460 * 0 on success, -1 on failure.
1461 *
1462 *----------------------------------------------------------------------
1463 */
1464
1465static int
1466Access( Tcl_Obj *pathPtr, int mode )
1467{
1468 if( mode & 3 || !GetZvfsFile(pathPtr) ) return -1;
1469 return 0;
1470}
1471
1472
1473/*
1474 *----------------------------------------------------------------------
1475 *
1476 * OpenFileChannel --
1477 *
1478 * Part of the "zvfs" Tcl_Filesystem.
1479 * Called when Tcl wants to open a file inside a zvfs file system.
1480 * We actually open the zip file back up and seek to the offset
1481 * of the given file. The channel driver will take care of the
1482 * rest.
1483 *
1484 * Results:
1485 * New channel on success, NULL on failure.
1486 *
1487 *----------------------------------------------------------------------
1488 */
1489
1490static Tcl_Channel
1491OpenFileChannel( Tcl_Interp *interp, Tcl_Obj *pathPtr,
1492 int mode, int permissions )
1493{
1494 ZvfsFile *pFile;
1495 ZvfsChannelInfo *pInfo;
1496 Tcl_Channel chan;
1497 static int count = 1;
1498 char zName[50];
1499 unsigned char zBuf[50];
1500
1501 if( !(pFile = GetZvfsFile(pathPtr)) ) {
1502 return NULL;
1503 }
1504
1505 if(!(chan = Tcl_OpenFileChannel(interp,
1506 Tcl_GetString(pFile->pArchive->zName), "r", 0))) {
1507 return NULL;
1508 }
1509
1510 if( Tcl_SetChannelOption(interp, chan, "-translation", "binary") ) {
1511 /* this should never happen */
1512 Tcl_Close( NULL, chan );
1513 return NULL;
1514 }
1515
1516 Tcl_Seek(chan, pFile->iOffset, SEEK_SET);
1517 Tcl_Read(chan, zBuf, 30);
1518
1519 if( memcmp(zBuf, "\120\113\03\04", 4) ){
1520 if( interp ) {
1521 Tcl_SetStringObj( Tcl_GetObjResult(interp),
1522 "bad central file record", -1 );
1523 }
1524 Tcl_Close( interp, chan );
1525 return NULL;
1526 }
1527
1528 pInfo = (ZvfsChannelInfo*)Tcl_Alloc( sizeof(*pInfo) );
1529 pInfo->chan = chan;
1530 Tcl_CreateExitHandler(DriverExit, pInfo);
1531 pInfo->isCompressed = INT16(zBuf, 8);
1532
1533 if( pInfo->isCompressed ) {
1534 z_stream *stream = &pInfo->stream;
1535 pInfo->zBuf = Tcl_Alloc(COMPR_BUF_SIZE);
1536 stream->zalloc = (alloc_func)0;
1537 stream->zfree = (free_func)0;
1538 stream->opaque = (voidpf)0;
1539 stream->avail_in = 2;
1540 stream->next_in = pInfo->zBuf;
1541 pInfo->zBuf[0] = 0x78;
1542 pInfo->zBuf[1] = 0x01;
1543 inflateInit(&pInfo->stream);
1544 } else {
1545 pInfo->zBuf = 0;
1546 }
1547
1548 pInfo->nByte = INT32(zBuf,22);
1549 pInfo->nByteCompr = pInfo->nData = INT32(zBuf,18);
1550 pInfo->readSoFar = 0;
1551 Tcl_Seek( chan, INT16(zBuf,26) + INT16(zBuf,28), SEEK_CUR );
1552 pInfo->startOfData = Tcl_Tell(chan);
1553 sprintf( zName, "zvfs%x%x", ((uintptr_t)pFile)>>12, count++ );
1554
1555 return Tcl_CreateChannel( &vfsChannelType, zName,
1556 (ClientData)pInfo, TCL_READABLE );
1557}
1558
1559
1560/*
1561 *----------------------------------------------------------------------
1562 *
1563 * MatchInDirectory --
1564 *
1565 * Part of the "zvfs" Tcl_Filesystem.
1566 * Called when Tcl is globbing around through the filesystem.
1567 * This function can be called when Tcl is looking for mount
1568 * points or when it is looking for files within a mount point
1569 * that it has already determined belongs to us.
1570 *
1571 * Any matching file in our filesystem is appended to the
1572 * result pointer.
1573 *
1574 * Results:
1575 * Standard Tcl result
1576 *
1577 *----------------------------------------------------------------------
1578 */
1579
1580/* Function to process a 'MatchInDirectory()'.
1581 * If not implemented, then glob and recursive
1582 * copy functionality will be lacking in the filesystem.
1583 */
1584static int
1585MatchInDirectory(
1586 Tcl_Interp* interp,
1587 Tcl_Obj *result,
1588 Tcl_Obj *pathPtr,
1589 CONST char *pattern,
1590 Tcl_GlobTypeData *types
1591) {
1592 ZvfsFile *pFile;
1593 Tcl_HashEntry *pEntry;
1594 Tcl_HashSearch sSearch;
1595
1596 if( types && types->type & TCL_GLOB_TYPE_MOUNT ) {
1597 /* Tcl is looking for a list of our mount points that
1598 * match the given pattern. This is so that Tcl can
1599 * append vfs mounted directories to a list of actual
1600 * filesystem directories.
1601 */
1602 char *path, *zPattern;
1603 ZvfsArchive *pArchive;
1604 Tcl_Obj *patternObj = Tcl_NewObj();
1605
1606 path = AbsolutePath( Tcl_GetString(pathPtr) );
1607 Tcl_AppendStringsToObj( patternObj, path, "/", pattern, (char *)NULL );
1608 Tcl_Free(path);
1609 zPattern = Tcl_GetString( patternObj );
1610
1611 for( pEntry = Tcl_FirstHashEntry( &local.archiveHash, &sSearch );
1612 pEntry; pEntry = Tcl_NextHashEntry( &sSearch ) )
1613 {
1614 pArchive = Tcl_GetHashValue(pEntry);
1615 if( Tcl_StringCaseMatch( Tcl_GetString(pArchive->zMountPoint),
1616 zPattern, NOCASE_PATHS ) ) {
1617 Tcl_ListObjAppendElement( NULL, result,
1618 Tcl_DuplicateObj(pArchive->zMountPoint) );
1619 }
1620 }
1621
1622 Tcl_DecrRefCount(patternObj);
1623
1624 return TCL_OK;
1625 }
1626
1627 if( !(pFile = GetZvfsFile(pathPtr)) ) {
1628 Tcl_SetStringObj( Tcl_GetObjResult(interp), "stale file handle", -1 );
1629 return TCL_ERROR;
1630 }
1631
1632 if( !pattern ) {
1633 /* If pattern is null, Tcl is actually just checking to
1634 * see if this file exists in our filesystem. Check to
1635 * make sure the path matches any type data and then
1636 * append it to the result and return.
1637 */
1638 if( ZvfsFileMatchesType( pFile, types ) ) {
1639 Tcl_ListObjAppendElement( NULL, result, pathPtr );
1640 }
1641 return TCL_OK;
1642 }
1643
1644 /* We've determined that the requested path is in our filesystem,
1645 * so now we want to walk through the children of the directory
1646 * and find any that match the given pattern and type. Any we
1647 * find will be appended to the result.
1648 */
1649
1650 for( pEntry = Tcl_FirstHashEntry(&pFile->children, &sSearch);
1651 pEntry; pEntry = Tcl_NextHashEntry(&sSearch) )
1652 {
1653 char *zName;
1654 pFile = Tcl_GetHashValue(pEntry);
1655 zName = Tcl_GetString(pFile->zName);
1656
1657 if( ZvfsFileMatchesType( pFile, types )
1658 && Tcl_StringCaseMatch(zName, pattern, NOCASE_PATHS) ) {
1659 Tcl_ListObjAppendElement( NULL, result,
1660 Tcl_FSJoinToPath(pathPtr, 1, &pFile->zName ) );
1661 }
1662 }
1663
1664 return TCL_OK;
1665}
1666
1667
1668/*
1669 *----------------------------------------------------------------------
1670 *
1671 * ListVolumes --
1672 *
1673 * Part of the "zvfs" Tcl_Filesystem.
1674 * Called when Tcl is looking for a list of open volumes
1675 * for our filesystem. The mountpoint for each open archive
1676 * is appended to a list object.
1677 *
1678 * Results:
1679 * A Tcl_Obj with 0 refCount
1680 *
1681 *----------------------------------------------------------------------
1682 */
1683
1684static Tcl_Obj *
1685ListVolumes(void)
1686{
1687 Tcl_HashEntry *pEntry; /* Hash table entry */
1688 Tcl_HashSearch zSearch; /* Search all mount points */
1689 ZvfsArchive *pArchive; /* The ZIP archive being mounted */
1690 Tcl_Obj *pVols = Tcl_NewObj();
1691
1692 for( pEntry = Tcl_FirstHashEntry(&local.archiveHash,&zSearch);
1693 pEntry; pEntry = Tcl_NextHashEntry(&zSearch) )
1694 {
1695 pArchive = Tcl_GetHashValue(pEntry);
1696
1697 Tcl_ListObjAppendElement( NULL, pVols,
1698 Tcl_DuplicateObj(pArchive->zMountPoint) );
1699 }
1700
1701 return pVols;
1702}
1703
1704
1705/*
1706 *----------------------------------------------------------------------
1707 *
1708 * FileAttrStrings --
1709 *
1710 * Part of the "zvfs" Tcl_Filesystem.
1711 * Return an array of strings for all of the possible
1712 * attributes for a file in zvfs.
1713 *
1714 * Results:
1715 * Pointer to ZvfsAttrs
1716 *
1717 *----------------------------------------------------------------------
1718 */
1719
1720static CONST char **
1721FileAttrStrings( Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef )
1722{
1723 return ZvfsAttrs;
1724}
1725
1726
1727/*
1728 *----------------------------------------------------------------------
1729 *
1730 * FileAttrsGet --
1731 *
1732 * Part of the "zvfs" Tcl_Filesystem.
1733 * Called for a "file attributes" command from Tcl
1734 * to return the attributes for a file in our filesystem.
1735 *
1736 * objPtrRef will point to a 0 refCount Tcl_Obj on success.
1737 *
1738 * Results:
1739 * Standard Tcl result
1740 *
1741 *----------------------------------------------------------------------
1742 */
1743
1744static int
1745FileAttrsGet( Tcl_Interp *interp, int index,
1746 Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef )
1747{
1748 char *zFilename;
1749 ZvfsFile *pFile;
1750 zFilename = Tcl_GetString(pathPtr);
1751
1752 if( !(pFile = GetZvfsFile(pathPtr)) ) {
1753 return TCL_ERROR;
1754 }
1755
1756 switch(index) {
1757 case ZVFS_ATTR_ARCHIVE:
1758 *objPtrRef= Tcl_DuplicateObj(pFile->pArchive->zName);
1759 return TCL_OK;
1760 case ZVFS_ATTR_COMPSIZE:
1761 *objPtrRef=Tcl_NewIntObj(pFile->nByteCompr);
1762 return TCL_OK;
1763 case ZVFS_ATTR_CRC:
1764 *objPtrRef=Tcl_NewIntObj(pFile->iCRC);
1765 return TCL_OK;
1766 case ZVFS_ATTR_MOUNT:
1767 *objPtrRef= Tcl_DuplicateObj(pFile->pArchive->zMountPoint);
1768 return TCL_OK;
1769 case ZVFS_ATTR_OFFSET:
1770 *objPtrRef= Tcl_NewIntObj(pFile->nByte);
1771 return TCL_OK;
1772 case ZVFS_ATTR_UNCOMPSIZE:
1773 *objPtrRef= Tcl_NewIntObj(pFile->nByte);
1774 return TCL_OK;
1775 default:
1776 return TCL_ERROR;
1777 }
1778
1779 return TCL_OK;
1780}
1781
1782
1783/*
1784 *----------------------------------------------------------------------
1785 *
1786 * FileAttrsSet --
1787 *
1788 * Part of the "zvfs" Tcl_Filesystem.
1789 * Called to set the value of an attribute for the
1790 * given file. Since we're a read-only filesystem, this
1791 * always returns an error.
1792 *
1793 * Results:
1794 * Returns TCL_ERROR
1795 *
1796 *----------------------------------------------------------------------
1797 */
1798
1799static int
1800FileAttrsSet( Tcl_Interp *interp, int index,
1801 Tcl_Obj *pathPtr, Tcl_Obj *objPtr )
1802{
1803 return TCL_ERROR;
1804}
1805
1806
1807/*
1808 *----------------------------------------------------------------------
1809 *
1810 * Chdir --
1811 *
1812 * Part of the "zvfs" Tcl_Filesystem.
1813 * Handles a chdir() call for the filesystem. Tcl has
1814 * already determined that the directory belongs to us,
1815 * so we just need to check and make sure that the path
1816 * is actually a directory in our filesystem and not a
1817 * regular file.
1818 *
1819 * Results:
1820 * 0 on success, -1 on failure.
1821 *
1822 *----------------------------------------------------------------------
1823 */
1824
1825static int
1826Chdir( Tcl_Obj *pathPtr )
1827{
1828 ZvfsFile *zFile = GetZvfsFile(pathPtr);
1829 if( !zFile || !zFile->isdir ) return -1;
1830 return 0;
1831}
1832
1833
1834/*
1835 *----------------------------------------------------------------------
1836 *
1837 * MountObjCmd --
1838 *
1839 * This function implements the [zvfs::mount] command.
1840 *
1841 * zvfs::mount ?zipFile? ?mountPoint?
1842 *
1843 * Creates a new mount point to the given zip archive.
1844 * All files in the zip archive will be added to the
1845 * virtual filesystem and be available to Tcl as regular
1846 * files and directories.
1847 *
1848 * Results:
1849 * Standard Tcl result
1850 *
1851 *----------------------------------------------------------------------
1852 */
1853
1854static int
1855MountObjCmd(
1856 ClientData clientData,
1857 Tcl_Interp *interp,
1858 int objc,
1859 Tcl_Obj *CONST objv[]
1860) {
1861 char *zipFile = NULL, *mountPoint = NULL;
1862
1863 if( objc > 3 ) {
1864 Tcl_WrongNumArgs( interp, 1, objv, "?zipFile? ?mountPoint?" );
1865 return TCL_ERROR;
1866 }
1867
1868 if( objc > 1 ) {
1869 zipFile = Tcl_GetString( objv[1] );
1870 }
1871
1872 if( objc > 2 ) {
1873 mountPoint = Tcl_GetString( objv[2] );
1874 }
1875
1876 return Zvfs_Mount( interp, zipFile, mountPoint );
1877}
1878
1879
1880/*
1881 *----------------------------------------------------------------------
1882 *
1883 * UnmountObjCmd --
1884 *
1885 * This function implements the [zvfs::unmount] command.
1886 *
1887 * zvfs::unmount mountPoint
1888 *
1889 * Unmount the given mountPoint if it is mounted in our
1890 * filesystem.
1891 *
1892 * Results:
1893 * 0 on success, -1 on failure.
1894 *
1895 *----------------------------------------------------------------------
1896 */
1897
1898static int
1899UnmountObjCmd(
1900 ClientData clientData,
1901 Tcl_Interp *interp,
1902 int objc,
1903 Tcl_Obj *CONST objv[]
1904) {
1905 if( objc != 2 ) {
1906 Tcl_WrongNumArgs( interp, objc, objv, "mountPoint" );
1907 return TCL_ERROR;
1908 }
1909
1910 return Zvfs_Unmount( interp, Tcl_GetString(objv[1]) );
1911}
1912
1913
1914/*
1915 *----------------------------------------------------------------------
1916 *
1917 * Zvfs_Init, Zvfs_SafeInit --
1918 *
1919 * Initialize the zvfs package.
1920 *
1921 * Safe interpreters do not receive the ability to mount and
1922 * unmount zip files.
1923 *
1924 * Results:
1925 * Standard Tcl result
1926 *
1927 *----------------------------------------------------------------------
1928 */
1929
1930int
1931Zvfs_SafeInit( Tcl_Interp *interp )
1932{
1933#ifdef USE_TCL_STUBS
1934 if( Tcl_InitStubs( interp, "8.0", 0 ) == TCL_ERROR ) return TCL_ERROR;
1935#endif
1936
1937 if( !local.isInit ) {
1938 /* Register the filesystem and initialize the hash tables. */
1939 Tcl_FSRegister( 0, &zvfsFilesystem );
1940 Tcl_InitHashTable( &local.fileHash, TCL_STRING_KEYS );
1941 Tcl_InitHashTable( &local.archiveHash, TCL_STRING_KEYS );
1942
1943 local.isInit = 1;
1944 }
1945
1946 Tcl_PkgProvide( interp, "zvfs", "1.0" );
1947
1948 return TCL_OK;
1949}
1950
1951int
1952Zvfs_Init( Tcl_Interp *interp )
1953{
1954 if( Zvfs_SafeInit( interp ) == TCL_ERROR ) return TCL_ERROR;
1955
1956 if( !Tcl_IsSafe(interp) ) {
1957 Tcl_CreateObjCommand(interp, "zvfs::mount", MountObjCmd, 0, 0);
1958 Tcl_CreateObjCommand(interp, "zvfs::unmount", UnmountObjCmd, 0, 0);
1959 }
1960
1961 return TCL_OK;
1962}
Note: See TracBrowser for help on using the repository browser.