TclVFS

View Ticket
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Ticket Hash: 887778e1916c934f8a303a6337a10869d0ac2963
Title: tclvfs module vfs::zip discards the leading dot of files stored in an ZIP archive
Status: Open Type: Code_Defect
Severity: Severe Priority: Immediate
Subsystem: Resolution: Open
Last Modified: 2022-05-10 17:09:30
Version Found In: 1.0.4
User Comments:
anonymous added on 2022-05-09 17:04:57: (text/x-markdown)
tcl 8.6.12

tclvfs module vfs::zip discards the leading dot of files stored in an
ZIP archive:

    # create ZIP archive
    $ touch .foo bar
    $ zip test.zip .foo bar

open via vfs::zip

    $ tclsh
    % package require vfs::zip
    1.0.4
    % vfs::zip::Mount test.zip test.zip
    file3
    % glob test.zip/*
    test.zip/bar test.zip/foo

As you can see, '.foo' became 'foo' in vfs::zip

    % open test.zip/bar
    rc0
    % open test.zip/.foo
    couldn't open "test.zip/.foo": no such file or directory
    % open test.zip/foo
    rc1

But the ZIP really holds '.foo', not 'foo'

    % exec unzip -l test.zip
    Archive:  test.zip
      Length      Date    Time    Name
    ---------  ---------- -----   ----
            0  2022-05-09 18:15   .foo
            0  2022-05-09 18:15   bar
    ---------                     -------
            0                     2 files


This is due to the following code in

    proc zip::TOC {...} {
      ...
      set sb(name) [string trimleft $sb(name) "./"]

which looks suspiciously like someone was trying to strip off the "./"
prefix sequence from names like "./foo"

Cleary stripping off the dot from the beginning of a file name is plain wrong.

Proposed patch:

    --- zipvfs.tcl	2022/05/09 17:00:22	1.1
    +++ zipvfs.tcl	2022/05/09 17:00:28
    @@ -546,7 +546,9 @@
             set sb(name) [encoding convertfrom utf-8 $sb(name)]
             set sb(comment) [encoding convertfrom utf-8 $sb(comment)]
         }
    -    set sb(name) [string trimleft $sb(name) "./"]
    +    if {[string range $sb(name) 0 1] == "./"} {
    +	set sb(name) [string range $sb(name) 2 end]
    +    }
         set parent [file dirname $sb(name)]
         if {$parent == "."} {set parent ""}
         lappend cbdir([string tolower $parent]) [file tail [string trimright $sb(name) /]]

anonymous added on 2022-05-10 17:09:30: (text/x-markdown)
The line of code you highlighted is plain wrong as pointed out.  It gives the following results:

% string trimleft "/.hello" "./"
hello

% string trimleft "../../../../hello" "./"
hello

I would ask that the proposed fix handles these cases correctly.