From Newsgroup: comp.lang.tcl

I have porting issues (moving from Tcl 8 to 9) with creating and reading
tar archives.

Creating, -progress option has been removed in the last tar version.

I used to do this:

set fd [open $zipfile wb]
fconfigure $fd -translation binary
::zlib push gzip $fd -level 9
# tar::create $fd $paths -chan -progress [list ::UIProgressBar {}]
tar::create $fd $paths -chan
close $fd

Reading:

set f [open $zipfile rb]
::zlib push gunzip $f
set result [tar::stat $f "" -chan]
close $f

1: {::bgerrorhandler {error during seek on "filea58d4ac0": invalid
argument} {-code 1 -level 0 -errorstack {INNER {invokeStk1 seek
filea58d4ac0 0} CALL {IsGzFile filea58d4ac0} CALL {SetupReading 1 0 filea58d4ac0} CALL {tar::stat filea58d4ac0 {} -chan} CALL {::meshparts::AssemblyArchiveGetData C:/arbeit/MESHPARTS-Offline/Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz}
CALL {::meshparts::DirectorySyncAnalyse C:/arbeit/MESHPARTS-Offline/Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz
{} 0 0} CALL ::meshparts::ExplorerSyncAnalyse CALL ::meshparts::ExplorerArchiveUnpack} -errorcode {POSIX EINVAL {invalid argument}} -errorinfo {error during seek on "filea58d4ac0": invalid argument
while executing
"seek $fh 0"
(procedure "IsGzFile" line 3)
invoked from within
"IsGzFile $fh"
(procedure "SetupReading" line 16)
invoked from within
"SetupReading $chan $gzip $tar"
(procedure "tar::stat" line 5)
invoked from within
"tar::stat $f "" -chan"

Any ideas on this?
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 03.09.2025 um 15:13 schrieb meshparts:

I have porting issues (moving from Tcl 8 to 9) with creating and reading
tar archives.

Creating, -progress option has been removed in the last tar version.

I used to do this:

  set fd [open $zipfile wb]
  fconfigure $fd -translation binary
  ::zlib push gzip $fd -level 9
  # tar::create $fd $paths -chan -progress [list ::UIProgressBar {}]
  tar::create $fd $paths -chan
  close $fd

Reading:

  set f [open $zipfile rb]
  ::zlib push gunzip $f
  set result [tar::stat $f "" -chan]
  close $f

1: {::bgerrorhandler {error during seek on "filea58d4ac0": invalid
argument} {-code 1 -level 0 -errorstack {INNER {invokeStk1 seek
filea58d4ac0 0} CALL {IsGzFile filea58d4ac0} CALL {SetupReading 1 0 filea58d4ac0} CALL {tar::stat filea58d4ac0 {} -chan} CALL {::meshparts::AssemblyArchiveGetData C:/arbeit/MESHPARTS-Offline/ Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz} CALL {::meshparts::DirectorySyncAnalyse C:/arbeit/MESHPARTS-Offline/ Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz {} 0 0}
CALL ::meshparts::ExplorerSyncAnalyse
CALL ::meshparts::ExplorerArchiveUnpack} -errorcode {POSIX EINVAL
{invalid argument}} -errorinfo {error during seek on "filea58d4ac0":
invalid argument
    while executing
"seek $fh 0"
    (procedure "IsGzFile" line 3)
    invoked from within
"IsGzFile $fh"
    (procedure "SetupReading" line 16)
    invoked from within
"SetupReading $chan $gzip $tar"
    (procedure "tar::stat" line 5)
    invoked from within
"tar::stat $f "" -chan"

Any ideas on this?

I did some further testing with this simple code, which works with Tcl 8
and tar 0.11 but fails with Tcl 9.0.2 and tar 0.13:

package require tar

set f [open $zipfile rb]
::zlib push gunzip $f
set result [tar::stat $f "" -chan]
close $f

The error is:

error during seek on "file4ed5dd0": invalid argument
while executing
"seek $fh 0"
(procedure "IsGzFile" line 3)
invoked from within
"IsGzFile $fh"
(procedure "SetupReading" line 16)
invoked from within
"SetupReading $chan $gzip $tar"
(procedure "tar::stat" line 5)
invoked from within
"tar::stat $f "" -chan"

Any ideas?
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 05.09.2025 um 21:41 schrieb meshparts:

Am 03.09.2025 um 15:13 schrieb meshparts:

I have porting issues (moving from Tcl 8 to 9) with creating and reading tar archives.

Creating, -progress option has been removed in the last tar version.

I used to do this:

   set fd [open $zipfile wb]
   fconfigure $fd -translation binary
   ::zlib push gzip $fd -level 9
   # tar::create $fd $paths -chan -progress [list ::UIProgressBar {}]
   tar::create $fd $paths -chan
   close $fd

Reading:

   set f [open $zipfile rb]
   ::zlib push gunzip $f
   set result [tar::stat $f "" -chan]
   close $f

1: {::bgerrorhandler {error during seek on "filea58d4ac0": invalid argument} {-code 1 -level 0 -errorstack {INNER {invokeStk1 seek filea58d4ac0 0} CALL {IsGzFile filea58d4ac0} CALL {SetupReading 1 0 filea58d4ac0} CALL {tar::stat filea58d4ac0 {} -chan} CALL {::meshparts::AssemblyArchiveGetData C:/arbeit/MESHPARTS-Offline/ Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz} CALL {::meshparts::DirectorySyncAnalyse C:/arbeit/MESHPARTS-Offline/ Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz {} 0 0} CALL ::meshparts::ExplorerSyncAnalyse CALL ::meshparts::ExplorerArchiveUnpack} -errorcode {POSIX EINVAL {invalid argument}} -errorinfo {error during seek on "filea58d4ac0": invalid argument
     while executing
"seek $fh 0"
     (procedure "IsGzFile" line 3)
     invoked from within
"IsGzFile $fh"
     (procedure "SetupReading" line 16)
     invoked from within
"SetupReading $chan $gzip $tar"
     (procedure "tar::stat" line 5)
     invoked from within
"tar::stat $f "" -chan"

Any ideas on this?

I did some further testing with this simple code, which works with Tcl 8 and tar 0.11 but fails with Tcl 9.0.2 and tar 0.13:

package require tar

set f [open $zipfile rb]
::zlib push gunzip $f
set result [tar::stat $f "" -chan]
close $f

The error is:

error during seek on "file4ed5dd0": invalid argument
    while executing
"seek $fh 0"
    (procedure "IsGzFile" line 3)
    invoked from within
"IsGzFile $fh"
    (procedure "SetupReading" line 16)
    invoked from within
"SetupReading $chan $gzip $tar"
    (procedure "tar::stat" line 5)
    invoked from within
"tar::stat $f "" -chan"

Any ideas?

This is not a problem with Tcl 8 or 9, but due to changes from tar 0.11 to 0.13.
If removing the line "::zlib push gunzip $f", everything works fine for me.

Paul
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

On 9/5/25 21:41, meshparts wrote:

…

I did some further testing with this simple code, which works with Tcl 8
and tar 0.11 but fails with Tcl 9.0.2 and tar 0.13:

package require tar

set f [open $zipfile rb]
::zlib push gunzip $f
set result [tar::stat $f "" -chan]
close $f

The error is:

error during seek on "file4ed5dd0": invalid argument
    while executing
"seek $fh 0"
    (procedure "IsGzFile" line 3)
    invoked from within
"IsGzFile $fh"
    (procedure "SetupReading" line 16)
    invoked from within
"SetupReading $chan $gzip $tar"
    (procedure "tar::stat" line 5)
    invoked from within
"tar::stat $f "" -chan"

Any ideas?

Either omit the "zlib push…" and use the new "-gzip" option after
"-chan", or use the patch in the tcllib ticket

https://core.tcl-lang.org/tcllib/tktview/cc1e1bc658955776b14b604ec9e11a863375ef6a

which might overcome this issue.

This is the patch
https://core.tcl-lang.org/tcllib/artifact/60c43fe93d939832

Best regards,
Christian
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 06.09.2025 um 00:11 schrieb Paul Obermeier:

Am 05.09.2025 um 21:41 schrieb meshparts:

Am 03.09.2025 um 15:13 schrieb meshparts:

I have porting issues (moving from Tcl 8 to 9) with creating and
reading tar archives.

Creating, -progress option has been removed in the last tar version.

I used to do this:

   set fd [open $zipfile wb]
   fconfigure $fd -translation binary
   ::zlib push gzip $fd -level 9
   # tar::create $fd $paths -chan -progress [list ::UIProgressBar {}]
   tar::create $fd $paths -chan
   close $fd

Reading:

   set f [open $zipfile rb]
   ::zlib push gunzip $f
   set result [tar::stat $f "" -chan]
   close $f

1: {::bgerrorhandler {error during seek on "filea58d4ac0": invalid
argument} {-code 1 -level 0 -errorstack {INNER {invokeStk1 seek
filea58d4ac0 0} CALL {IsGzFile filea58d4ac0} CALL {SetupReading 1 0
filea58d4ac0} CALL {tar::stat filea58d4ac0 {} -chan} CALL
{::meshparts::AssemblyArchiveGetData C:/arbeit/MESHPARTS-Offline/
Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz} CALL
{::meshparts::DirectorySyncAnalyse C:/arbeit/MESHPARTS-Offline/
Assemblies/Schulung/ProfileScrews2/ProfileScrews.mpasmz {} 0 0}
CALL ::meshparts::ExplorerSyncAnalyse
CALL ::meshparts::ExplorerArchiveUnpack} -errorcode {POSIX EINVAL
{invalid argument}} -errorinfo {error during seek on "filea58d4ac0":
invalid argument
     while executing
"seek $fh 0"
     (procedure "IsGzFile" line 3)
     invoked from within
"IsGzFile $fh"
     (procedure "SetupReading" line 16)
     invoked from within
"SetupReading $chan $gzip $tar"
     (procedure "tar::stat" line 5)
     invoked from within
"tar::stat $f "" -chan"

Any ideas on this?

I did some further testing with this simple code, which works with Tcl
8 and tar 0.11 but fails with Tcl 9.0.2 and tar 0.13:

package require tar

set f [open $zipfile rb]
::zlib push gunzip $f
set result [tar::stat $f "" -chan]
close $f

The error is:

error during seek on "file4ed5dd0": invalid argument
     while executing
"seek $fh 0"
     (procedure "IsGzFile" line 3)
     invoked from within
"IsGzFile $fh"
     (procedure "SetupReading" line 16)
     invoked from within
"SetupReading $chan $gzip $tar"
     (procedure "tar::stat" line 5)
     invoked from within
"tar::stat $f "" -chan"

Any ideas?

This is not a problem with Tcl 8 or 9, but due to changes from tar 0.11
to 0.13.
If removing the line "::zlib push gunzip $f", everything works fine for me.

Paul

Weird, removing that line leads to another error in my case:

expected integer but got a list
while executing
"format %d 0[string trim [set $x] " \x00"]"
(procedure "readHeader" line 8)
invoked from within
"readHeader [read $fh 512]"
(procedure "tar::stat" line 8)
invoked from within
"tar::stat $f "" -chan"
(file "C:/arbeit/MESHPARTS-Software/test3.tcl" line 9)
invoked from within
"source -encoding utf-8 C:/arbeit/MESHPARTS-Software/test3.tcl"

Could it be that we have different versions of tar?
I got 0.13 from BAWT.
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 06.09.2025 um 02:10 schrieb undroidwish:

On 9/5/25 21:41, meshparts wrote:

…

I did some further testing with this simple code, which works with Tcl
8 and tar 0.11 but fails with Tcl 9.0.2 and tar 0.13:

package require tar

set f [open $zipfile rb]
::zlib push gunzip $f
set result [tar::stat $f "" -chan]
close $f

The error is:

error during seek on "file4ed5dd0": invalid argument
     while executing
"seek $fh 0"
     (procedure "IsGzFile" line 3)
     invoked from within
"IsGzFile $fh"
     (procedure "SetupReading" line 16)
     invoked from within
"SetupReading $chan $gzip $tar"
     (procedure "tar::stat" line 5)
     invoked from within
"tar::stat $f "" -chan"

Any ideas?

Either omit the "zlib push…" and use the new "-gzip" option after
"-chan", or use the patch in the tcllib ticket

https://core.tcl-lang.org/tcllib/tktview/ cc1e1bc658955776b14b604ec9e11a863375ef6a

which might overcome this issue.

This is the patch
https://core.tcl-lang.org/tcllib/artifact/60c43fe93d939832

Best regards,
Christian

Same here, adding the -gzip option still produced the error

set f [open $zipfile rb]
set result [tar::stat $f "" -chan -gzip]

expected integer but got a list
while executing
"format %d 0[string trim [set $x] " \x00"]"
(procedure "readHeader" line 8)
invoked from within
"readHeader [read $fh 512]"
(procedure "tar::stat" line 8)
invoked from within
"tar::stat $f "" -chan -gzip"
(file "C:/arbeit/MESHPARTS-Software/test3.tcl" line 9)
invoked from within
"source -encoding utf-8 C:/arbeit/MESHPARTS-Software/test3.tcl"


I'll take a look at the patch.

Thnks!
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

On 9/6/25 08:39, meshparts wrote:

…
I'll take a look at the patch.

Octal is the hidden octopus in the room (in format).
Use at least version 0.14 from the tcllib repo.
But please try my patch with your original zlib logic
around tar::stat anyway.

Best regards,
Christian
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 06.09.2025 um 10:50 schrieb undroidwish:

On 9/6/25 08:39, meshparts wrote:

…
I'll take a look at the patch.

Octal is the hidden octopus in the room (in format).
Use at least version 0.14 from the tcllib repo.
But please try my patch with your original zlib logic
around tar::stat anyway.

Best regards,
Christian

The last version I could find is 0.13: https://github.com/tcltk/tcllib/blob/master/modules/tar/tar.tcl

Where do I get 0.14?
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

On 9/6/25 22:25, meshparts wrote:

…
The last version I could find is 0.13: https://github.com/tcltk/tcllib/blob/master/modules/tar/tar.tcl

Where do I get 0.14?

The canonical source of tcllib is not on github but in a fossil
repository below https://core.tcl-lang.org, see

https://core.tcl-lang.org/tcllib/doc/trunk/embedded/index.md

So on github you find a more or (in your case) less synchronized
copy of it.

Better for you, Luke, if you search the real, true force,
Christian

--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 07.09.2025 um 01:06 schrieb undroidwish:

On 9/6/25 22:25, meshparts wrote:

… The last version I could find is 0.13: https://github.com/tcltk/
tcllib/blob/master/modules/tar/tar.tcl

Where do I get 0.14?

The canonical source of tcllib is not on github but in a fossil
repository below https://core.tcl-lang.org, see

https://core.tcl-lang.org/tcllib/doc/trunk/embedded/index.md

So on github you find a more or (in your case) less synchronized
copy of it.

Better for you, Luke, if you search the real, true force,
Christian

The force got me there already.
I downloaded the tcllib release 2.0 but that contains only tar 0.13.
Now I tried to download the latest snapshot (https://core.tcl-lang.org/tcllib/wiki?name=Downloads) and the webpage
seems to have a technical issue: It loops endlessly around that
"checking you are not a robot..." thing.
Is there another way?

--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 07.09.2025 um 08:56 schrieb meshparts:

Am 07.09.2025 um 01:06 schrieb undroidwish:

On 9/6/25 22:25, meshparts wrote:

… The last version I could find is 0.13: https://github.com/tcltk/
tcllib/blob/master/modules/tar/tar.tcl

Where do I get 0.14?

The canonical source of tcllib is not on github but in a fossil
repository below https://core.tcl-lang.org, see

https://core.tcl-lang.org/tcllib/doc/trunk/embedded/index.md

So on github you find a more or (in your case) less synchronized
copy of it.

Better for you, Luke, if you search the real, true force,
Christian

The force got me there already.
I downloaded the tcllib release 2.0 but that contains only tar 0.13.
Now I tried to download the latest snapshot (https://core.tcl-lang.org/ tcllib/wiki?name=Downloads) and the webpage seems to have a technical
issue: It loops endlessly around that "checking you are not a robot..." thing.
Is there another way?

Oh, I got it, I must be logged in, on order to avoid that robot thing.
Now it have the latest snapshot.
BUT! The tar version is still 0.13...


--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

On 9/7/25 09:03, meshparts wrote:

…
BUT! The tar version is still 0.13...

Right are you, Luke. The 0.14 version is in an unreleased branch.

So take pkgIndex.tcl from

https://androwish.org/home/raw/91ff376148d2eb8e791936fe6c925d03a5d6bc79?at=91ff376148d2eb8e

and tar.tcl from

https://androwish.org/home/raw/c4c5e925e09b3cae3f54ed18da4cc510ea9f36f8?at=c4c5e925e09b3cae

with my proposed seek fix applied. This would hopefully be 0.15 someday.

Best regards,
Christian
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 07.09.2025 um 10:25 schrieb undroidwish:

On 9/7/25 09:03, meshparts wrote:

…
BUT! The tar version is still 0.13...

Right are you, Luke. The 0.14 version is in an unreleased branch.

So take pkgIndex.tcl from

https://androwish.org/home/raw/91ff376148d2eb8e791936fe6c925d03a5d6bc79? at=91ff376148d2eb8e

and tar.tcl from

https://androwish.org/home/raw/c4c5e925e09b3cae3f54ed18da4cc510ea9f36f8? at=c4c5e925e09b3cae

with my proposed seek fix applied. This would hopefully be 0.15 someday.

Best regards,
Christian

Thank you for the direct link.
Reading the archive works now.

--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

Am 07.09.2025 um 10:25 schrieb undroidwish:

On 9/7/25 09:03, meshparts wrote:

…
BUT! The tar version is still 0.13...

Right are you, Luke. The 0.14 version is in an unreleased branch.

So take pkgIndex.tcl from

https://androwish.org/home/raw/91ff376148d2eb8e791936fe6c925d03a5d6bc79? at=91ff376148d2eb8e

and tar.tcl from

https://androwish.org/home/raw/c4c5e925e09b3cae3f54ed18da4cc510ea9f36f8? at=c4c5e925e09b3cae

with my proposed seek fix applied. This would hopefully be 0.15 someday.

Best regards,
Christian

Hi Christian,

could you look at those changes to tar.tcl?
I'm using this customized untar function to be able to pass multiple
files to the function when unpacking. Sorry for not making an official
pull requst, but since I cannot find the current version online, It's
probably the best:

# tar.tcl --
#
# Creating, extracting, and listing posix tar archives
#
# Copyright (c) 2004 Aaron Faupell <[email protected]>
# Copyright (c) 2013 Andreas Kupries <[email protected]>
# (GNU tar @LongLink support).
# Copyright (c) 2024-25 Christian Werner <[email protected]>
# (zlib support).
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl
package provide tar 0.15

# # ## ### ##### ######## ############# #####################
##
# Gzip support
#
# |Id |Question |Check |Notes|
# |---:|:--- |:--- |:---|
# |1 |system supports gzip|`info command ::zlib`|check on package load|
# |2 |user requests gzip |`-gzip` |check per command |
# |3 |file is gzipped |file inspection |check per command |
#
# All questions are boolean, resulting in 8 different combinations:
#
# Tar reading
#
# |Id |Sys |Usr |File|Good?|Notes|
# |---:|---:|---:|---:|:---|:---|
# |R1 |0 |0 |0 |OK | read regular |
# |R2 |0 |0 |1 |FAIL| unsupported input |
# |R3 |0 |1 |0 |FAIL| unsupported user request, sys |
# |R4 |0 |1 |1 |FAIL| unsupported user request, sys |
# | | | | | ||
# |R5 |1 |0 |0 |OK | read regular |
# |R6 |1 |0 |1 |OK | auto-adapt, read gzip |
# |R7 |1 |1 |0 |FAIL| unsupported user request, file |
# |R8 |1 |1 |1 |OK | read gzip |
#
# Tar creation
#
# |Id |Sys |Usr |Good?|Notes|
# |---:|---:|---:|:---|:---|
# |C1 |0 |0 |OK | write regular |
# |C2 |0 |1 |FAIL| unsupported user request, sys |
# | | | | ||
# |C3 |1 |0 |OK | write regular |
# |C4 |1 |1 |OK | write gzip |

# # ## ### ##### ######## ############# #####################

namespace eval ::tar {
# (1)
variable hasgzip [llength [info command ::zlib]]
# (2) IsGzFile, see internal helpers at the end
}

# # ## ### ##### ######## ############# #####################

proc ::tar::parseOpts {acc opts} {
array set flags $acc
foreach {x y} $acc {upvar $x $x}

set len [llength $opts]
set i 0
while {$i < $len} {
set name [string trimleft [lindex $opts $i] -]
if {![info exists flags($name)]} {
Err "unknown option \"$name\"" INVALID OPTION
}
if {$flags($name) == 1} {
set $name [lindex $opts [expr {$i + 1}]]
incr i $flags($name)
} elseif {$flags($name) > 1} {
set $name [lrange $opts [expr {$i + 1}] [expr {$i + $flags($name)}]]
incr i $flags($name)
} else {
set $name 1
}
incr i
}
}

proc ::tar::pad {size} {
set pad [expr {512 - ($size % 512)}]
if {$pad == 512} {return 0}
return $pad
}

proc ::tar::seekorskip {ch off wh} {
if {[tell $ch] < 0} {
if {$wh ne "current"} {
Err "WHENCE=$wh not supported on non-seekable channel $ch" INVALID WHENCE $wh
}
skip $ch $off
return
}
seek $ch $off $wh
return
}

proc ::tar::skip {ch skipover} {
while {$skipover > 0} {
set requested $skipover

# Limit individual skips to 64K, as a compromise between speed
# of skipping (Number of read requests), and memory usage
# (Note how skipped block is read into memory!). While the
# read data is immediately discarded it still generates memory
# allocation traffic, gets copied, etc. Trying to skip the
# block in one go without the limit may cause us to run out of
# (virtual) memory, or just induce swapping, for nothing.

if {$requested > 65536} {
set requested 65536
}

set skipped [string length [read $ch $requested]]

# Stop in short read into the end of the file.
if {!$skipped && [eof $ch]} break

# Keep track of how much is (not) skipped yet.
incr skipover -$skipped
}
return
}

proc ::tar::readHeader {data} {
binary scan $data a100a8a8a8a12a12a8a1a100a6a2a32a32a8a8a155 \
name mode uid gid size mtime cksum type \
linkname magic version uname gname devmajor devminor prefix

foreach x {name type linkname} {
set $x [string trim [set $x] "\x00"]
}
foreach x {uid gid size mtime cksum} {
set $x [format %d 0o0[string trim [set $x] " \x00"]]
}
set mode [string trim $mode " \x00"]

if {$magic eq "ustar "} {
# gnu tar
# not fully supported
foreach x {uname gname prefix} {
set $x [string trim [set $x] "\x00"]
}
foreach x {devmajor devminor} {
set $x [format %d 0o0[string trim [set $x] " \x00"]]
}
} elseif {$magic eq "ustar\x00"} {
# posix tar
foreach x {uname gname prefix} {
set $x [string trim [set $x] "\x00"]
}
foreach x {devmajor devminor} {
set $x [format %d 0o0[string trim [set $x] " \x00"]]
}
} else {
# old style tar
foreach x {uname gname devmajor devminor prefix} { set $x {} }
if {$type eq ""} {
if {[string match */ $name]} {
set type 5
} else {
set type 0
}
}
}

return [list name $name mode $mode uid $uid gid $gid size $size \
mtime $mtime cksum $cksum type $type linkname $linkname \
magic $magic version $version uname $uname gname $gname \
devmajor $devmajor devminor $devminor prefix $prefix]
}

proc ::tar::contents {file args} {
set chan 0
set gzip 0
parseOpts {chan 0 gzip 0} $args
lassign [SetupReading $chan $gzip $file] fh pos gzip
set ret {}
while {![eof $fh]} {
array set header [readHeader [read $fh 512]]
HandleLongLink $fh header
if {$header(name) eq ""} break
if {$header(prefix) ne ""} {append header(prefix) /}
lappend ret $header(prefix)$header(name)
seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current
}
Close $fh $pos $chan $gzip
return $ret
}

proc ::tar::stat {tar {file {}} args} {
set chan 0
set gzip 0
parseOpts {chan 0 gzip 0} $args
lassign [SetupReading $chan $gzip $tar] fh pos gzip
set ret {}
while {![eof $fh]} {
array set header [readHeader [read $fh 512]]
HandleLongLink $fh header
if {$header(name) eq ""} break
if {$header(prefix) ne ""} {append header(prefix) /}
seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current
if {$file ne "" && "$header(prefix)$header(name)" ne $file} {continue}
set header(type) [string map {
0 file 5 directory 3 characterSpecial 4 blockSpecial
6 fifo 2 link
} $header(type)]
set header(mode) [string range $header(mode) 2 end]
lappend ret $header(prefix)$header(name) \
[list mode $header(mode) uid $header(uid) gid $header(gid) \
size $header(size) mtime $header(mtime) type
$header(type) \
linkname $header(linkname) uname $header(uname) \
gname $header(gname) devmajor $header(devmajor) \
devminor $header(devminor)]
}
Close $fh $pos $chan $gzip
return $ret
}

proc ::tar::get {tar file args} {
set chan 0
set gzip 0
parseOpts {chan 0 gzip 0} $args
lassign [SetupReading $chan $gzip $tar] fh pos gzip
while {![eof $fh]} {
set data [read $fh 512]
array set header [readHeader $data]
HandleLongLink $fh header
if {$header(name) eq ""} break
if {$header(prefix) ne ""} {append header(prefix) /}
set name [string trimleft $header(prefix)$header(name) /]
if {$name eq $file} {
set file [read $fh $header(size)]
Close $fh $pos $chan $gzip
return $file
}
seekorskip $fh [expr {$header(size) + [pad $header(size)]}] current
}
Close $fh $pos $chan $gzip
Err "Tar \"$tar\": File \"$file\" not found" MISSING FILE
}

proc ::tar::isabsolute {path} {
return [expr {[string match -nocase [file pathtype $path] "absolute"]}]
}

## Compose an absolute path from a given file name (that could also be
an absolute path) and a target directory
proc ::tar::path2absolute {name dir} {
if {$dir!=""} {
if {[::tar::isabsolute $name]} {
return [file join $dir [file tail $name]]
} else {
return [file join $dir $name]
}
} else {
return $name
}
}

proc ::tar::untar {tar args} {
set nooverwrite 0
set data 0
set nomtime 0
set noperms 0
set chan 0
set gzip 0
parseOpts {
dir 1 file 1 glob 1 nooverwrite 0 nomtime 0 noperms 0 chan 0
gzip 0 files 1 dirs 1
} $args
if {![info exists dir]} {set dir [pwd]}
set pattern *
# If the "files" option is used, then "file", "glob" and "dir" are ignored
# Also current implementation of "files" assumes that "prefix" is
also not used in combination
if {[info exists files]} {
unset -nocomplain file
if {![info exists dirs]} {
set dirs [lrepeat [llength $files] $dir]
}
set dir ""
} else {
if {[info exists file]} {
set pattern [string map {* \\* ? \\? \\ \\\\ \[ \\\[ \] \\\]} $file]
} elseif {[info exists glob]} {
set pattern $glob
}
}

set ret {}
lassign [SetupReading $chan $gzip $tar] fh pos gzip
while {![eof $fh]} {
array set header [readHeader [read $fh 512]]
HandleLongLink $fh header
if {$header(name) eq ""} break
if {$header(prefix) ne ""} {append header(prefix) /}
set name [string trimleft $header(prefix)$header(name) /]
# Get target directory "dir2"
# This is also first stage of checking if "name" should be
skipped from unpacking
if {[info exists files]} {
set skip 1
foreach file2 $files dir2 $dirs {
if {[string match $file2 $name]} {
set skip 0
break
}
}
} else {
set skip 0
set dir2 $dir
}
# This is also second stage of checking if "name" should be
skipped from unpacking
if {$skip==0} {
# Compose the target full file path, if target directory is specified
set name2 [::tar::path2absolute $name $dir2]
# Check if this file should be skipped
if {$nooverwrite && [file exists $name2]} {
set skip 1
} else {
set skip [expr {![string match $pattern $name]}]
}
set name $name2
}
if {$skip} {
seekorskip $fh [expr {$header(size) + [pad $header(size)]}]
current
continue
}

if {![file isdirectory [file dirname $name]]} {
file mkdir [file dirname $name]
lappend ret [file dirname $name] {}
}
if {[string match {[0346]} $header(type)]} {
if {[catch {::open $name wb+} new]} {
# sometimes if we dont have write permission we can
still delete
catch {file delete -force $name}
set new [::open $name wb+]
}
fcopy $fh $new -size $header(size)
close $new
lappend ret $name $header(size)
} elseif {$header(type) == 5} {
file mkdir $name
lappend ret $name {}
} elseif {[string match {[12]} $header(type)] &&
$::tcl_platform(platform) eq "unix"} {
catch {file delete $name}
if {![catch {
file link [string map {1 -hard 2 -symbolic}
$header(type)] \
$name $header(linkname)
}]} {
lappend ret $name {}
}
}
seekorskip $fh [pad $header(size)] current
if {![file exists $name]} continue

if {$::tcl_platform(platform) eq "unix"} {
if {!$noperms} {
catch {
file attributes $name -permissions 0o[string range $header(mode) 2 end]
}
}
catch {
file attributes $name -owner $header(uid) -group
$header(gid)
}
catch {
file attributes $name -owner $header(uname) -group $header(gname)
}
}
if {!$nomtime} {
file mtime $name $header(mtime)
}
}
Close $fh $pos $chan $gzip
return $ret
}

##
# ::tar::statFile
#
# Returns stat info about a filesystem object, in the form of an info
# dictionary like that returned by ::tar::readHeader.
#
# The mode, uid, gid, mtime, and type entries are always present.
# The size and linkname entries are present if relevant for this type
# of object. The uname and gname entries are present if the OS supports
# them. No devmajor or devminor entry is present.
##

proc ::tar::statFile {name followlinks} {
if {$followlinks} {
file stat $name stat
} else {
file lstat $name stat
}

set ret {}

if {$::tcl_platform(platform) eq "unix"} {
# Tcl 9 returns the permission as 0o octal number. Since this
# is written to the tar file and the file format expects "00"
# we have to rewrite.
lappend ret mode 1[string map {o 0} [file attributes $name -permissions]]
lappend ret uname [file attributes $name -owner]
lappend ret gname [file attributes $name -group]
if {$stat(type) eq "link"} {
lappend ret linkname [file link $name]
}
} else {
lappend ret mode [lindex {100644 100755} [expr {$stat(type) eq "directory"}]]
}

lappend ret uid $stat(uid) gid $stat(gid) mtime $stat(mtime) \
type $stat(type)

if {$stat(type) eq "file"} {lappend ret size $stat(size)}

return $ret
}

##
# ::tar::formatHeader
#
# Opposite operation to ::tar::readHeader; takes a file name and info
# dictionary as arguments, returns a corresponding (POSIX-tar) header.
#
# The following dictionary entries must be present:
# mode
# type
#
# The following dictionary entries are used if present, otherwise
# the indicated default is used:
# uid 0
# gid 0
# size 0
# mtime [clock seconds]
# linkname {}
# uname {}
# gname {}
#
# All other dictionary entries, including devmajor and devminor, are
# presently ignored.
##

proc ::tar::formatHeader {name info} {
array set A {
linkname ""
uname ""
gname ""
size 0
gid 0
uid 0
}
set A(mtime) [clock seconds]
array set A $info
array set A {devmajor "" devminor ""}

set type [string map {
file 0 directory 5 characterSpecial 3
blockSpecial 4 fifo 6 link 2 socket A
} $A(type)]

set osize [format %o $A(size)]
set ogid [format %o $A(gid)]
set ouid [format %o $A(uid)]
set omtime [format %o $A(mtime)]

set name [string trimleft $name /]
if {[string length $name] > 255} {
Err "path name over 255 chars" BAD PATH LENGTH
} elseif {[string length $name] > 100} {
set common [string range $name end-99 154]
if {[set splitpoint [string first / $common]] == -1} {
Err "path name cannot be split into prefix and name" BAD
PATH UNSPLITTABLE
}
set prefix [string range $name 0 end-100][string range $common
0 $splitpoint-1]
set name [string range $common $splitpoint+1 end][string
range $name 155 end]
} else {
set prefix ""
}

set header [binary format
a100A8A8A8A12A12A8a1a100A6a2a32a32a8a8a155a12 \
$name $A(mode)\x00 $ouid\x00 $ogid\x00\
$osize\x00 $omtime\x00 {} $type \
$A(linkname) ustar\x00 00 $A(uname) $A(gname)\
$A(devmajor) $A(devminor) $prefix {}]

binary scan $header c* tmp
set cksum 0
foreach x $tmp {incr cksum $x}

return [string replace $header 148 155 [binary format A8 [format %o $cksum]\x00]]
}

proc ::tar::recurseDirs {files followlinks} {
foreach x $files {
if {[file isdirectory $x] && ([file type $x] ne "link" || $followlinks)} {
if {[set more [glob -dir $x -nocomplain *]] ne ""} {
eval lappend files [recurseDirs $more $followlinks]
} else {
lappend files $x
}
}
}
return $files
}

proc ::tar::writefile {in out followlinks name} {
puts -nonewline $out [formatHeader $name [statFile $in $followlinks]]
set size 0
if {[file type $in] eq "file" || ($followlinks && [file type $in]
eq "link")} {
set in [::open $in rb]
set size [fcopy $in $out]
close $in
}
puts -nonewline $out [string repeat \x00 [pad $size]]
}

proc ::tar::create {tar files args} {
set dereference 0
set chan 0
set gzip 0
parseOpts {dereference 0 chan 0 gzip 0} $args

lassign [SetupCreation $chan $gzip $tar] fh pos

foreach x [recurseDirs $files $dereference] {
writefile $x $fh $dereference $x
if {$gzip} {
chan configure $fh -flush sync
}
}
puts -nonewline $fh [string repeat \x00 1024]

Close $fh $pos $chan $gzip
return $tar
}

proc ::tar::add {tar files args} {
set dereference 0
set prefix ""
set quick 0
parseOpts {dereference 0 prefix 1 quick 0} $args
set fh [SetupWriting $tar {add to}]
if {$quick} then {
seek $fh -1024 end
} else {
set data [read $fh 512]
while {[regexp {[^\0]} $data]} {
array set header [readHeader $data]
seek $fh [expr {$header(size) + [pad $header(size)]}] current
set data [read $fh 512]
}
seek $fh -512 current
}

foreach x [recurseDirs $files $dereference] {
writefile $x $fh $dereference $prefix$x
}
puts -nonewline $fh [string repeat \x00 1024]

close $fh
return $tar
}

proc ::tar::remove {tar files} {
set fh [SetupWriting $tar {remove from} rb]
# mode is `rb` because removal is done as a read/copy/filter/write and
# `fh` is the read side.
set n 0
while {[file exists $tar$n.tmp]} {incr n}
set tfh [::open $tar$n.tmp wb]
while {![eof $fh]} {
array set header [readHeader [read $fh 512]]
if {$header(name) eq ""} {
puts -nonewline $tfh [string repeat \x00 1024]
break
}
if {$header(prefix) ne ""} {append header(prefix) /}
set name $header(prefix)$header(name)
set len [expr {$header(size) + [pad $header(size)]}]
if {[lsearch $files $name] > -1} {
seek $fh $len current
} else {
seek $fh -512 current
fcopy $fh $tfh -size [expr {$len + 512}]
}
}

close $fh
close $tfh

file rename -force $tar$n.tmp $tar
}

# # ## ### ##### ######## ############# #####################
## internal helpers

proc ::tar::HandleLongLink {fh hv} {
upvar 1 $hv header thelongname thelongname

# @LongName Part I.
if {$header(type) eq "L"} {
# Size == Length of name. Read it, and pad to full 512
# size. After that is a regular header for the actual
# file, where we have to insert the name. This is handled
# by the next iteration and the part II below.
set thelongname [string trimright [read $fh $header(size)] \000]
seekorskip $fh [pad $header(size)] current
return -code continue
}
# Not supported yet: type 'K' for LongLink (long symbolic links).

# @LongName, part II, get data from previous entry, if defined.
if {[info exists thelongname]} {
set header(name) $thelongname
# Prevent leakage to further entries.
unset thelongname
}

return
}

proc ::tar::SetupWriting {file do {mode rb+}} {
set fh [::open $file $mode]
if {[IsGzFile $fh]} {
close $fh
Err "cannot $do gzip compressed tar" ZLIB UNSUPPORTED WRITE
}
return $fh
}

proc ::tar::SetupCreation {chan gzip file} {
variable hasgzip
if {!$hasgzip && $gzip} {
# C2
Err "unsupported user request, no zlib support available" \
ZLIB UNSUPPORTED USER
}

# C1, C3, C4
if {$chan} {
set fh $file
set pos [tell $fh]
} else {
set fh [::open $file wb+]
set pos ""
}

if {$gzip} {
# C4
zlib push gzip $fh
fconfigure $fh -translation binary
}

list $fh $pos
}

proc ::tar::SetupReading {chan gzip file} {
variable hasgzip
if {!$hasgzip && $gzip} {
# R3, R4
Err "unsupported user request, no zlib support available" \
ZLIB UNSUPPORTED USER
}

# inspect file or channel
if {$chan} {
set fh $file
set pos [tell $fh]
} else {
set fh [::open $file rb]
set pos ""
}
set gz [IsGzFile $fh]

if {!$hasgzip && $gz > 0} {
# R2
close $fh
Err "unsupported input, no zlib support available" \
ZLIB UNSUPPORTED FILE
}

if {$hasgzip && $gzip && $gz <= 0} {
# R7
Err "input mismatch, zlib requested, not present" \
ZLIB MISMATCH
}

if {$gz > 0} {
# R6, R8
zlib push gunzip $fh
fconfigure $fh -translation binary
} ;# else R1, R5

list $fh $pos $gz
}

proc ::tar::Close {fh pos chan gz} {
if {!$chan} {
close $fh
} elseif {$gz > 0} {
chan pop $fh
catch {seek $fh $pos}
}
return
}

proc ::tar::IsGzFile {fh} {
if {[catch {seek $fh 0 current}]} {
# not seekable
return -1
}
set hdr [read $fh 2]
seek $fh 0
return [expr {$hdr eq "\x1f\x8b"}]
}

proc ::tar::Err {msg args} {
return -code error -errorcode [list TAR {*}$args] $msg
}

# # ## ### ##### ######## ############# #####################
return

--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

On 9/7/25 21:05, meshparts wrote:

could you look at those changes to tar.tcl?
I'm using this customized untar function to be able to pass multiple
files to the function when unpacking. Sorry for not making an official
pull requst, but since I cannot find the current version online, It's probably the best:

If you want your changes to be considered for addition into tcllib,
you should provide a patch attached to a ticket in the official repo
on core.tcl-lang.org. That's the way I've got the zlib support in after
my initial proposal got reviewed.

HTH,
Christian
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.tcl

On 07/09/2025 07:56, meshparts wrote:

Am 07.09.2025 um 01:06 schrieb undroidwish:

On 9/6/25 22:25, meshparts wrote:

… The last version I could find is 0.13: https://github.com/tcltk/
tcllib/blob/master/modules/tar/tar.tcl

Where do I get 0.14?

The canonical source of tcllib is not on github but in a fossil
repository below https://core.tcl-lang.org, see

https://core.tcl-lang.org/tcllib/doc/trunk/embedded/index.md

So on github you find a more or (in your case) less synchronized
copy of it.

Better for you, Luke, if you search the real, true force,
Christian

The force got me there already.
I downloaded the tcllib release 2.0 but that contains only tar 0.13.
Now I tried to download the latest snapshot (https://core.tcl-lang.org/ tcllib/wiki?name=Downloads) and the webpage seems to have a technical
issue: It loops endlessly around that "checking you are not a robot..." thing.
Is there another way?

Me too.

The website puts up a page saying "Checking you are not a robot...",
then a few seconds later it decides I'm not a robot and adds an "OK"
button. I click that and... it's back to "Checking you are not a robot...".

I had a poke around, and it seemed that every time I got somewhere that
might allow a download, the site took me back to the "Checking you are
not a robot..." death spiral.

It looks to me like a "feature" of fossil 2.27, but maybe not. It looks (https://fossil-scm.org/forum/forumpost/ff999a6931) as though there are
some problems with the robot-checking code. That thread concerns a
different problem, but it might be worth reporting this by posting on it.

Alan
--- Synchronet 3.21a-Linux NewsLink 1.2