summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorapnadkarni <apnmbx-wits@yahoo.com>2023-09-25 02:36:04 (GMT)
committerapnadkarni <apnmbx-wits@yahoo.com>2023-09-25 02:36:04 (GMT)
commitebdda7be1cef8138ad5814b3daef76361ae862cf (patch)
tree7bf4983b7b888c81d7bb2b4b4115cd9277da375d
parent814c7d5faa8f01750383a3ded4aec02c22b50dd2 (diff)
parentfa3868a2a6dfe5003e5c2c78f6f2d1a232d767a2 (diff)
downloadtcl-ebdda7be1cef8138ad5814b3daef76361ae862cf.zip
tcl-ebdda7be1cef8138ad5814b3daef76361ae862cf.tar.gz
tcl-ebdda7be1cef8138ad5814b3daef76361ae862cf.tar.bz2
Merge 8.7
-rw-r--r--generic/tclClock.c4
-rw-r--r--generic/tclZipfs.c65
-rw-r--r--library/tcltest/tcltest.tcl1
-rw-r--r--tests/clock.test6
-rw-r--r--tests/fileSystem.test2
-rw-r--r--tests/zipfs.test309
6 files changed, 307 insertions, 80 deletions
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 4f97cb9..15256e8 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1695,7 +1695,7 @@ ThreadSafeLocalTime(
struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm));
#ifdef HAVE_LOCALTIME_R
- localtime_r(timePtr, tmPtr);
+ tmPtr = localtime_r(timePtr, tmPtr);
#else
struct tm *sysTmPtr;
@@ -1705,7 +1705,7 @@ ThreadSafeLocalTime(
Tcl_MutexUnlock(&clockMutex);
return NULL;
}
- memcpy(tmPtr, localtime(timePtr), sizeof(struct tm));
+ memcpy(tmPtr, sysTmPtr, sizeof(struct tm));
Tcl_MutexUnlock(&clockMutex);
#endif
return tmPtr;
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 92a39e4..673c9e6 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -4698,18 +4698,16 @@ InitWritableChannel(
*/
info->numBytes = 0;
+ z->crc32 = 0; /* Truncated, CRC no longer applicable */
} else if (z->data) {
/*
* Already got uncompressed data.
*/
+ if (z->numBytes > (int) info->maxWrite)
+ goto tooBigError;
- unsigned int j = z->numBytes;
-
- if (j > info->maxWrite) {
- j = info->maxWrite;
- }
- memcpy(info->ubuf, z->data, j);
- info->numBytes = j;
+ memcpy(info->ubuf, z->data, z->numBytes);
+ info->numBytes = z->numBytes;
} else {
/*
* Need to uncompress the existing data.
@@ -4767,39 +4765,53 @@ InitWritableChannel(
}
err = inflate(&stream, Z_SYNC_FLUSH);
inflateEnd(&stream);
- if ((err == Z_STREAM_END)
- || ((err == Z_OK) && (stream.avail_in == 0))) {
- if (cbuf) {
- memset(info->keys, 0, sizeof(info->keys));
- ckfree(cbuf);
- }
- return TCL_OK;
+ if ((err != Z_STREAM_END) &&
+ ((err != Z_OK) || (stream.avail_in != 0))) {
+ goto corruptionError;
+ }
+ /* Even if decompression succeeded, counts should be as expected */
+ if ((int) stream.total_out != z->numBytes)
+ goto corruptionError;
+ info->numBytes = z->numBytes;
+ if (cbuf) {
+ ckfree(cbuf);
}
- goto corruptionError;
} else if (z->isEncrypted) {
/*
* Need to decrypt some otherwise-simple stored data.
*/
-
- for (i = 0; i < z->numBytes - 12; i++) {
+ if (z->numCompressedBytes <= 12 ||
+ (z->numCompressedBytes - 12) != z->numBytes)
+ goto corruptionError;
+ int len = z->numCompressedBytes - 12;
+ for (i = 0; i < len; i++) {
ch = zbuf[i];
info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
}
- } else {
+ info->numBytes = len;
+ }
+ else {
/*
* Simple stored data. Copy into our working buffer.
*/
-
memcpy(info->ubuf, zbuf, z->numBytes);
+ info->numBytes = z->numBytes;
}
memset(info->keys, 0, sizeof(info->keys));
}
+
+ assert(info->numBytes == 0 || (int) info->numBytes == z->numBytes);
return TCL_OK;
memoryError:
ZIPFS_MEM_ERROR(interp);
goto error_cleanup;
+ tooBigError:
+ ZIPFS_ERROR(interp, "file size exceeds max writable");
+ ZIPFS_ERROR_CODE(interp, "TOOBIG");
+ goto error_cleanup;
+
corruptionError:
if (cbuf) {
memset(info->keys, 0, sizeof(info->keys));
@@ -4927,6 +4939,9 @@ InitReadableChannel(
&& ((err != Z_OK) || (stream.avail_in != 0))) {
goto corruptionError;
}
+ /* Even if decompression succeeded, counts should be as expected */
+ if ((int) stream.total_out != z->numBytes)
+ goto corruptionError;
if (ubuf) {
info->isEncrypted = 0;
@@ -4941,7 +4956,8 @@ InitReadableChannel(
* Decode encrypted but uncompressed file, since we support Tcl_Seek()
* on it, and it can be randomly accessed later.
*/
-
+ if (z->numCompressedBytes <= 12 || (z->numCompressedBytes - 12) != z->numBytes)
+ goto corruptionError;
len = z->numCompressedBytes - 12;
ubuf = (unsigned char *) attemptckalloc(len);
if (ubuf == NULL) {
@@ -5092,14 +5108,14 @@ ZipFSOpenFileChannelProc(
int mode,
TCL_UNUSED(int) /* permissions */)
{
- int trunc = (mode & O_TRUNC) != 0;
- int wr = (mode & (O_WRONLY | O_RDWR)) != 0;
-
pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (!pathPtr) {
return NULL;
}
+ int trunc = (mode & O_TRUNC) != 0;
+ int wr = (mode & (O_WRONLY | O_RDWR)) != 0;
+
/*
* Check for unsupported modes.
*/
@@ -5108,7 +5124,8 @@ ZipFSOpenFileChannelProc(
Tcl_SetErrno(EACCES);
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "write access not supported: %s",
+ "%s not supported: %s",
+ mode & O_APPEND ? "append mode" : "write access",
Tcl_PosixError(interp)));
}
return NULL;
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index c7aee29..22a4dfd 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -2402,6 +2402,7 @@ proc tcltest::Skipped {name constraints} {
# make sure that the constraints are satisfied.
set doTest 0
+ set constraints [string trim $constraints]
if {[string match {*[$\[]*} $constraints] != 0} {
# full expression, e.g. {$foo > [info tclversion]}
catch {set doTest [uplevel #0 [list expr $constraints]]}
diff --git a/tests/clock.test b/tests/clock.test
index 3f20607..7bcc002 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -18601,10 +18601,10 @@ test clock-7.10 {Julian Day, negative amount} {
# add negative amounts to Julian day 0 instead
set s0 [clock scan 0 -format %J -gmt true]
set J0 [scan [clock format $s0 -format %J -gmt true] %lld]
- set s0m1d [clock add $s0 -1 days]
- set s0m24h [clock add $s0 -24 hours]
+ set s0m1d [clock add $s0 -1 days -timezone :UTC]
+ set s0m24h [clock add $s0 -24 hours -timezone :UTC]
set J0m24h [scan [clock format $s0m24h -format %J -gmt true] %lld]
- set s0m1s [clock add $s0 -1 seconds]
+ set s0m1s [clock add $s0 -1 seconds -timezone :UTC]
set J0m1s [scan [clock format $s0m1s -format %J -gmt true] %lld]
list $s0m1d $s0m24h $J0m24h $s0m1s $J0m1s $s0 $J0 \
[::tcl::mathop::== $s0m1d $s0m24h] [::tcl::mathop::== $J0m24h $J0m1s]
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index d62a59a..5631445 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -69,7 +69,7 @@ apply {{} {
lappend drives $vol
}
}
- testConstraint moreThanOneDrive [llength $drives]
+ testConstraint moreThanOneDrive [expr {[llength $drives] > 1}]
} finally {
cd $dir
}
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 1a521dc..200a8a1 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -18,6 +18,7 @@ source [file join [file dirname [info script]] tcltests.tcl]
testConstraint zipfs [expr {[llength [info commands zipfs]]}]
testConstraint zipfslib 1
+
set ziproot [zipfs root]
set CWD [pwd]
@@ -409,6 +410,11 @@ namespace eval test_ns_zipfs {
}
}
+ # list of paths -> list of paths under [zipfs root]
+ proc zipfspaths {args} {
+ return [lmap path $args {file join [zipfs root] $path}]
+ }
+
proc cleanup {} {
dict for {mount -} [zipfs mount] {
if {[string match //zipfs:/test* $mount]} {
@@ -574,20 +580,6 @@ namespace eval test_ns_zipfs {
cleanup
} -result {1 {decryption failed} 1}
- test zipfs-mount-password-4 "mount - verify uncompressed cipher readable with password" -body {
- zipfs mount [zippath test-password.zip] $defaultMountPoint password
- readbin [file join $defaultMountPoint cipher.bin]
- } -cleanup {
- cleanup
- } -result ciphertext
-
- test zipfs-mount-password-5 "mount - verify compressed cipher readable with password" -body {
- zipfs mount [zippath test-password.zip] $defaultMountPoint password
- readbin [file join $defaultMountPoint cipher-deflate.bin]
- } -cleanup {
- cleanup
- } -result [lseq 100]
-
test zipfs-mount-nested-1 "mount - nested mount on non-existing path" -setup {
mount [zippath test.zip]
} -cleanup {
@@ -714,6 +706,7 @@ namespace eval test_ns_zipfs {
testzipfslist no-pattern-mount-on-empty "" {test.zip {}} {{} test testdir testdir/test2} -constraints !zipfslib
testzipfslist no-pattern-mount-on-root "" [list test.zip [zipfs root]] {{} test testdir testdir/test2} -constraints !zipfslib
testzipfslist no-pattern-mount-on-slash "" [list test.zip /] {{} test testdir testdir/test2} -constraints !zipfslib
+ testzipfslist no-pattern-mount-on-level3 "" [list test.zip testmt/a/b] {{} testmt testmt/a testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2} -constraints {bug-02acab5aea !zipfslib}
testzipfslist no-pattern-multiple "" {test.zip testmountA test.zip testmountB/subdir} {
testmountA testmountA/test testmountA/testdir testmountA/testdir/test2
testmountB/subdir testmountB/subdir/test testmountB/subdir/testdir testmountB/subdir/testdir/test2
@@ -736,21 +729,25 @@ namespace eval test_ns_zipfs {
testnumargs "zipfs exists" "filename" ""
# Generates tests for zipfs exists
- proc testzipfsexists {id path result args} {
+ proc testzipfsexists [list id path result [list mountpoint $defaultMountPoint] args] {
test zipfs-exists-$id "zipfs exists $id" -body {
zipfs exists $path
} -setup {
- mount [zippath test.zip]
+ mount [zippath test.zip] $mountpoint
} -cleanup {
+ zipfs unmount $mountpoint
cleanup
} -result $result {*}$args
}
- testzipfsexists native-file [info nameofexecutable] 0
+ testzipfsexists native-file [info nameofexecutable] 0
testzipfsexists nonexistent-file [file join $defaultMountPoint nosuchfile] 0
- testzipfsexists file [file join $defaultMountPoint test] 1
- testzipfsexists dir [file join $defaultMountPoint testdir] 1
- testzipfsexists mountpoint $defaultMountPoint 1
- testzipfsexists root [zipfs root] 1 -constraints bug-02acab5aea
+ testzipfsexists file [file join $defaultMountPoint test] 1
+ testzipfsexists dir [file join $defaultMountPoint testdir] 1
+ testzipfsexists mountpoint $defaultMountPoint 1
+ testzipfsexists root [zipfs root] 1 \
+ $defaultMountPoint -constraints bug-02acab5aea
+ testzipfsexists level3 [file join $defaultMountPoint a b] 1 \
+ [file join $defaultMountPoint a b c] -constraints bug-02acab5aea
#
# zipfs find
@@ -792,12 +789,9 @@ namespace eval test_ns_zipfs {
test.zip testmountA test.zip testmountB/subdir
} {}
- variable path
testzipfsfind absolute-path [file join [zipfs root] testmountA] {
test.zip testmountA test.zip testmountB/subdir
- } [lmap path {
- testmountA/test testmountA/testdir testmountA/testdir/test2
- } {file join [zipfs root] $path}]
+ } [zipfspaths testmountA/test testmountA/testdir testmountA/testdir/test2]
testzipfsfind relative-path testdir {
test.zip testmountA test.zip testmountB/subdir
@@ -811,9 +805,17 @@ namespace eval test_ns_zipfs {
# bug-6183f535c8
testzipfsfind root-path [zipfs root] {
test.zip {} test.zip testmountB/subdir
- } [lmap path {
- test testdir testdir/test2
- } {file join [zipfs root] $path}] -constraints !zipfslib
+ } [zipfspaths test testdir testdir/test2] -constraints !zipfslib
+
+ testzipfsfind level3 [file join [zipfs root] testmt a] {
+ test.zip testmt/a/b
+ } [zipfspaths testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2] \
+ -constraints bug-02acab5aea
+
+ testzipfsfind level3-root [zipfs root] {
+ test.zip testmt/a/b
+ } [zipfspaths testmt testmt/a testmt/a/b testmt/a/b/test testmt/a/b/testdir testmt/a/b/testdir/test2] \
+ -constraints bug-02acab5aea
test zipfs-find-native-absolute "zipfs find on native file system" -setup {
set dir [makeDirectory zipfs-native-absolute]
@@ -843,7 +845,6 @@ namespace eval test_ns_zipfs {
zipfs find [file tail $dir]
} -result {zipfs-native-relative/subdir zipfs-native-relative/subdir/native}
-
#
# zipfs info
testnumargs "zipfs info" "filename" ""
@@ -889,6 +890,15 @@ namespace eval test_ns_zipfs {
zipfs info $defaultMountPoint
} -result [list [zippath junk-at-start.zip] 0 0 4]
+ test zipfs-info-level3 "zipfs info on mount point - verify correct offset of zip content" -setup {
+ # zip starts at offset 4
+ mount [zippath junk-at-start.zip] /testmt/a/b
+ } -cleanup {
+ cleanup
+ } -body {
+ zipfs info [file join [zipfs root] testmt a]
+ } -result {{} 0 0 0} -constraints bug-02acab5aea
+
#
# zipfs canonical -
# TODO - semantics are very unclear. Can produce nonsensical paths like
@@ -920,38 +930,225 @@ namespace eval test_ns_zipfs {
testzipfscanonical backslashes X:\\\\foo\\\\bar [file join [zipfs root] foo bar] -constraints win
testzipfscanonical backslashes-1 X:/foo\\\\bar [file join [zipfs root] foo bar] -constraints win
-
-
- #
- # TODO - read of zipfs file Bad CRC
-
#
# Read/uncompress
- proc testuncompress {id zippath result {filename abac-repeat.txt} args} {
+ proc testzipfsread {id zippath result {filename abac-repeat.txt} {openopts {}} args} {
variable defaultMountPoint
set zippath [zippath $zippath]
- test zipfs-uncompress-$id "zipfs uncompress $id" -setup {
+ test zipfs-read-$id "zipfs read $id" -setup {
unset -nocomplain fd
zipfs mount $zippath $defaultMountPoint
} -cleanup {
- # In case mount succeeded when it should not
+ # In case open succeeded when it should not
if {[info exists fd]} {
close $fd
}
cleanup
} -body {
- set fd [open [file join $defaultMountPoint $filename]]
+ set fd [open [file join $defaultMountPoint $filename] {*}$openopts]
+ gets $fd
+ } -result $result {*}$args
+
+ set data [readbin $zippath]
+ test zipfs-read-memory-$id "zipfs read in-memory $id" -setup {
+ unset -nocomplain fd
+ zipfs mount_data $data $defaultMountPoint
+ } -cleanup {
+ # In case open succeeded when it should not
+ if {[info exists fd]} {
+ close $fd
+ }
+ cleanup
+ } -body {
+ set fd [open [file join $defaultMountPoint $filename] {*}$openopts]
gets $fd
} -result $result {*}$args
+
+ }
+ testzipfsread stored test.zip test test
+ testzipfsread stored teststored.zip aaaaaaaaaaaaaa
+ testzipfsread deflate testdeflated2.zip aaaaaaaaaaaaaa
+ # Test open modes - see bug [4645658689]
+ testzipfsread stored-rw teststored.zip aaaaaaaaaaaaaa abac-repeat.txt r+
+ testzipfsread deflate-rw testdeflated2.zip aaaaaaaaaaaaaa abac-repeat.txt r+
+ testzipfsread stored-wr teststored.zip {} abac-repeat.txt w+ -constraints bug-00018ec7a0
+ testzipfsread deflate-wr testdeflated2.zip {} abac-repeat.txt w+ -constraints bug-00018ec7a0
+ testzipfsread stored-ar teststored.zip {} abac-repeat.txt a+
+ testzipfsread deflate-ar testdeflated2.zip {} abac-repeat.txt a+
+
+ testzipfsread nosuch test.zip "file not found \"//zipfs:/testmount/nosuchfile\": no such file or directory" nosuchfile {} -returnCodes error
+ testzipfsread deflate-error broken.zip {decompression error} deflatezliberror {} -returnCodes error
+ testzipfsread bzip2 testbzip2.zip {unsupported compression method} abac-repeat.txt {} -returnCodes error
+ testzipfsread lzma testfile-lzma.zip {unsupported compression method} abac-repeat.txt {} -returnCodes error
+ testzipfsread xz testfile-xz.zip {unsupported compression method} abac-repeat.txt {} -returnCodes error
+ testzipfsread zstd testfile-zstd.zip {unsupported compression method} abac-repeat.txt {} -returnCodes error
+
+ test zipfs-read-unwritable "Writes not allowed on file opened for read" -setup {
+ mount [zippath test.zip]
+ } -cleanup {
+ close $fd
+ cleanup
+ } -body {
+ set fd [open [file join $defaultMountPoint test]]
+ puts $fd blah
+ } -result {channel "*" wasn't opened for writing} -match glob -returnCodes error
+
+ #
+ # Write
+ proc testzipfswrite {id zippath result filename mode args} {
+ variable defaultMountPoint
+ set zippath [zippath $zippath]
+ set path [file join $defaultMountPoint $filename]
+ set body {
+ set fd [open $path $mode]
+ fconfigure $fd -translation binary
+ puts -nonewline $fd "xyz"
+ close $fd
+ set fd [open $path]
+ fconfigure $fd -translation binary
+ read $fd
+ }
+ test zipfs-write-$id "zipfs write $id" -setup {
+ unset -nocomplain fd
+ zipfs mount $zippath $defaultMountPoint
+ } -cleanup {
+ # In case open succeeded when it should not
+ if {[info exists fd]} {
+ close $fd
+ }
+ cleanup
+ } -body $body -result $result {*}$args
+
+ set data [readbin $zippath]
+ test zipfs-write-memory-$id "zipfs write in-memory $id" -setup {
+ unset -nocomplain fd
+ zipfs mount_data $data $defaultMountPoint
+ } -cleanup {
+ # In case open succeeded when it should not
+ if {[info exists fd]} {
+ close $fd
+ }
+ cleanup
+ } -body $body -result $result {*}$args
+
+ }
+ testzipfswrite create-w test.zip "file not found \"//zipfs:/testmount/newfile\": no such file or directory" newfile w -returnCodes error
+ testzipfswrite create-wr test.zip "file not found \"//zipfs:/testmount/newfile\": no such file or directory" newfile w+ -returnCodes error
+ testzipfswrite create-a test.zip "append mode not supported: permission denied" newfile a -returnCodes error
+ testzipfswrite create-ar test.zip "file not found \"//zipfs:/testmount/newfile\": no such file or directory" newfile a+ -returnCodes error
+ testzipfswrite store-w teststored.zip "xyz" abac-repeat.txt w
+ testzipfswrite deflate-w testdeflated2.zip "xyz" abac-repeat.txt w
+ testzipfswrite store-wr teststored.zip "xyz" abac-repeat.txt w+
+ testzipfswrite deflate-wr testdeflated2.zip "xyz" abac-repeat.txt w+
+ testzipfswrite stored-a teststored.zip "append mode not supported: permission denied" abac-repeat.txt a -returnCodes error
+ testzipfswrite deflate-a testdeflated2.zip "append mode not supported: permission denied" abac-repeat.txt a -returnCodes error
+ testzipfswrite store-ar teststored.zip "aaaaaaaaaaaaaa\nbbbbbbbbbbbbbb\naaaaaaaaaaaaaa\ncccccccccccccc\nxyz" abac-repeat.txt a+
+ testzipfswrite deflate-ar testdeflated2.zip "aaaaaaaaaaaaaa\nbbbbbbbbbbbbbb\naaaaaaaaaaaaaa\ncccccccccccccc\nxyz" abac-repeat.txt a+
+
+ test zipfs-write-unreadable "Reads not allowed on file opened for write" -setup {
+ mount [zippath test.zip]
+ } -cleanup {
+ close $fd
+ cleanup
+ } -body {
+ set fd [open [file join $defaultMountPoint test] w]
+ read $fd
+ } -result {channel "*" wasn't opened for reading} -match glob -returnCodes error
+
+ test zipfs-write-persist "Writes persist ONLY while mounted" -setup {
+ mount [zippath test.zip]
+ } -cleanup {
+ cleanup
+ } -body {
+ set path [file join $defaultMountPoint test]
+ set fd [open $path w]
+ puts -nonewline $fd newtext
+ close $fd
+ set fd [open $path]
+ set result [list [read $fd]]
+ close $fd
+ zipfs unmount $defaultMountPoint
+ mount [zippath test.zip]
+ set fd [open $path]
+ lappend result [read $fd]
+ close $fd
+ set result
+ } -result [list newtext test\n]
+
+ test zipfs-write-size-limit-0 "Writes have a size limit" -setup {
+ set origlimit $::tcl::zipfs::wrmax
+ mount [zippath test.zip]
+ } -cleanup {
+ close $fd
+ set ::tcl::zipfs::wrmax $origlimit
+ cleanup
+ } -body {
+ set ::tcl::zipfs::wrmax 10
+ set fd [open [file join $defaultMountPoint test] w]
+ puts -nonewline $fd [string repeat x 11]
+ } -result {} -returnCodes error -constraints bug-d5d03207ca
+
+ test zipfs-write-size-limit-1 "Writes disallowed" -setup {
+ set origlimit $::tcl::zipfs::wrmax
+ mount [zippath test.zip]
+ } -cleanup {
+ set ::tcl::zipfs::wrmax $origlimit
+ cleanup
+ } -body {
+ set ::tcl::zipfs::wrmax -1
+ open [file join $defaultMountPoint test] w
+ } -result {write access not supported: permission denied} -returnCodes error
+
+ #
+ # read/seek/write
+ proc testzipfsrw {id zippath expected filename mode args} {
+ variable defaultMountPoint
+ set zippath [zippath $zippath]
+ set path [file join $defaultMountPoint $filename]
+ set body {
+ set result ""
+ set fd [open $path $mode]
+ fconfigure $fd -translation binary
+ append result [gets $fd],
+ set pos [tell $fd]
+ append result $pos,
+ puts -nonewline $fd "xyz"
+ append result [gets $fd],
+ seek $fd $pos
+ append result [gets $fd],
+ seek $fd -6 end
+ append result [read $fd]
+ }
+ test zipfs-readwrite-$id "zipfs read/seek/write $id" -setup {
+ unset -nocomplain fd
+ zipfs mount $zippath $defaultMountPoint
+ } -cleanup {
+ # In case open succeeded when it should not
+ if {[info exists fd]} {
+ close $fd
+ }
+ cleanup
+ } -body $body -result $expected {*}$args
+
+ set data [readbin $zippath]
+ test zipfs-readwrite-memory-$id "zipfs read/seek/write in-memory $id" -setup {
+ unset -nocomplain fd
+ zipfs mount_data $data $defaultMountPoint
+ } -cleanup {
+ # In case open succeeded when it should not
+ if {[info exists fd]} {
+ close $fd
+ }
+ cleanup
+ } -body $body -result $expected {*}$args
+
}
- testuncompress stored teststored.zip aaaaaaaaaaaaaa
- testuncompress deflate testdeflated2.zip aaaaaaaaaaaaaa
- testuncompress deflate-error broken.zip {decompression error} deflatezliberror -returnCodes error
- testuncompress bzip2 testbzip2.zip {unsupported compression method} abac-repeat.txt -returnCodes error
- testuncompress lzma testfile-lzma.zip {unsupported compression method} abac-repeat.txt -returnCodes error
- testuncompress xz testfile-xz.zip {unsupported compression method} abac-repeat.txt -returnCodes error
- testuncompress zstd testfile-zstd.zip {unsupported compression method} abac-repeat.txt -returnCodes error
+ testzipfsrw store-r+ teststored.zip "aaaaaaaaaaaaaa,15,bbbbbbbbbbb,xyzbbbbbbbbbbb,ccccc\n" abac-repeat.txt r+
+ testzipfsrw store-w+ teststored.zip ",0,,xyz,yz" abac-repeat.txt w+ -constraints bug-00018ec7a0
+ testzipfsrw store-a+ teststored.zip ",60,,xyz,cc\nxyz" abac-repeat.txt a+
+ #
+ # Password protected
proc testpassword {id filename password result args} {
variable defaultMountPoint
set zippath [zippath test-password.zip]
@@ -963,7 +1160,7 @@ namespace eval test_ns_zipfs {
zipfs mount $zippath $defaultMountPoint
}
} -cleanup {
- # In case mount succeeded when it should not
+ # In case open succeeded when it should not
if {[info exists fd]} {
close $fd
}
@@ -973,13 +1170,15 @@ namespace eval test_ns_zipfs {
gets $fd
} -result $result {*}$args
}
+ # The bug bug-bbe7c6ff9e only manifests on macos
+ testConstraint bug-bbe7c6ff9e [expr {$::tcl_platform(os) ne "Darwin"}]
testpassword plain plain.txt password plaintext
testpassword plain-nopassword plain.txt "" plaintext
testpassword plain-badpassword plain.txt xxx plaintext
- testpassword cipher cipher.bin password ciphertext
+ testpassword cipher cipher.bin password ciphertext -constraints bug-bbe7c6ff9e
testpassword cipher-nopassword cipher.bin {} "decryption failed" -returnCodes error
testpassword cipher-badpassword cipher.bin xxx "invalid CRC" -returnCodes error
- testpassword cipher-deflate cipher-deflate.bin password [lseq 100]
+ testpassword cipher-deflate cipher-deflate.bin password [lseq 100] -constraints bug-bbe7c6ff9e
testpassword cipher-deflate-nopassword cipher-deflate.bin {} "decryption failed" -returnCodes error
testpassword cipher-deflate-badpassword cipher-deflate.bin xxx "decompression error" -returnCodes error
@@ -1077,12 +1276,22 @@ namespace eval test_ns_zipfs {
lsort -stride 2 [file stat [zipfs root]]
} -result [fixupstat {atime 0 ctime 0 dev 0 gid 0 ino 0 mode 16749 mtime 0 nlink 0 size 0 type directory uid 0}]
- test zipfs-file-stat-root-subdir-mount "Read stat of root when mount is subdir" -setup {
+ test zipfs-file-stat-root-subdir-mount "Read stat of root when mount is subdir" -constraints {
+ bug-02acab5aea
+ } -setup {
mount [zippath test.zip]
- } -cleanup cleanup -constraints bug-02acab5aea -body {
+ } -cleanup cleanup -body {
lsort -stride 2 [file stat [zipfs root]]
} -result [fixupstat {atime 0 ctime 0 dev 0 gid 0 ino 0 mode 16749 mtime 0 nlink 0 size 0 type directory uid 0}]
+ test zipfs-file-stat-level3 "Stat on a directory that is intermediary in a mount point" -constraints {
+ bug-02acab5aea
+ } -setup {
+ mount [zippath test.zip] [file join $defaultMountPoint mt2]
+ } -cleanup cleanup -body {
+ lsort -stride 2 [file stat $defaultMountPoint]
+ }
+
#
# glob of zipfs file
proc testzipfsglob {id mountpoint pat result {globopt {}} args} {