Browse Source
zipfs_wrap.tcl (renamed from zipfs_mkimg.tcl, same CLI contract): payload zip written by the driving shell's builtin tcl::zipfs::mkzip - convention-stable across mkimg vintages (probed 8.7a6 vs 9.0.3: identical member tables/CRCs) - with the prefix executable concatenated OUTSIDE the writer, plus an EOCD archive-relative self-check per wrap (exit 9 on file-relative output). build905.zig wrap lane updated (3 call sites, identifiers zipwrap_*); suite README states the wrap contract; G-165 follow-on disposition => landed. Verified: standalone wraps under both vintages mount/boot identically (840 members, base=prefix); suite make-zipfs/smoke/kit-family green - all 5 products probe archive-relative and boot (family_check plain/punk/punk-bi, tclsh90szip smoke, tclsh90sprzip manual boot). Assisted-by: harness=opencode; primary-model=openrouter/moonshotai/kimi-k3; api-location=openrouter.aimaster
5 changed files with 212 additions and 106 deletions
@ -1,58 +0,0 @@
|
||||
#JMN 2024 |
||||
#A simple wrapper to call the 'zipfs mkimg' (tcl::zipfs::mkimg) command via commandline arguments. |
||||
#(avoiding piping commands to tclsh via stdin to make calling simpler, and to provide more specific error messages) |
||||
# |
||||
set script_title "[file tail [info nameofexecutable]] [file tail [info script]]" |
||||
set usage "$script_title -outfile <target_zipfile_path> -indir <folder_to_zip> ?-strip <path_prefix_to_strip>? ?-password <plaintext>? ?-infile <explicit_prepend_file>?" |
||||
set arglist $::argv |
||||
#informational arglist echo goes to stdout if wanted - stderr output makes zig build |
||||
#report the (successful) step with a misleading "failed command:" block (0.16 |
||||
#build_runner prints that whenever result_stderr is nonempty, success or not) |
||||
puts stdout "====> '$arglist'" |
||||
#error 42 |
||||
if {![llength $arglist]} { |
||||
puts stderr $usage |
||||
exit 1 |
||||
} |
||||
if {[llength $arglist] %2 != 0} { |
||||
puts stderr "$script_title error: expected an even number of option value pairs. Got [llength $arglist] commandline arguments. '$arglist'" |
||||
puts stderr $usage |
||||
exit 2 |
||||
} |
||||
set known_opts [list -outfile -indir -strip -password -infile] |
||||
dict for {k v} $arglist { |
||||
switch -exact -- $k { |
||||
-outfile - -indir - -strip - -password - -infile {} |
||||
default { |
||||
puts stderr "$script_title error: unrecognised option $k. Known_options $known_opts" |
||||
exit 3 |
||||
} |
||||
} |
||||
} |
||||
set defaults [dict create\ |
||||
-strip ""\ |
||||
-password ""\ |
||||
] |
||||
|
||||
set opts [dict merge $defaults $arglist] |
||||
if {![dict exists $opts -outfile]} { |
||||
puts stderr "$script_title error: Missing -outfile <zipfilename>" |
||||
exit 4 |
||||
} |
||||
if {![dict exists $opts -indir]} { |
||||
puts stderr "$script_title error: Missing -indir <folder>" |
||||
exit 5 |
||||
} |
||||
set callargs [list [file normalize [dict get $opts -outfile]] [file normalize [dict get $opts -indir]] [file normalize [dict get $opts -strip]] [dict get $opts -password]] |
||||
if {[dict exists $opts -infile]} { |
||||
lappend callargs [file normalize [dict get $opts -infile]] |
||||
} |
||||
puts stdout "$script_title call 'tcl::zipfs::mkimg $callargs'" ;#stdout: stderr makes zig report the successful step as 'failed command' |
||||
|
||||
if {[catch { |
||||
tcl::zipfs::mkimg {*}$callargs |
||||
} errM]} { |
||||
puts stderr "$script_title error: Failure during call 'tcl::zipfs::mkimg $callargs'\n $errM" |
||||
exit 6 |
||||
} |
||||
exit 0 |
||||
@ -0,0 +1,158 @@
|
||||
#JMN 2024 / rewritten 2026-08-05 (G-165 follow-on) |
||||
#Wrap a payload tree into a self-contained zipfs executable: write the tree as |
||||
#a bare zip with the DRIVING interp's own tcl::zipfs::mkzip, then concatenate |
||||
#the prefix executable OUTSIDE the writer. Descends from zipfs_mkimg.tcl - |
||||
#same commandline contract (and the same reason for existing: avoiding piping |
||||
#commands to tclsh via stdin, with more specific error messages). |
||||
# |
||||
#Why not tcl::zipfs::mkimg: mkimg's offset convention depends on the vintage |
||||
#of the tclsh that runs it (legacy file-relative in 8.7 alphas / 9.0.0, |
||||
#archive-relative after the 2024-12-05 upstream fix), so the produced |
||||
#runtime's convention became a property of which shell drove the build - the |
||||
#same sensitivity G-165 removed from the make.tcl kit-bake pipeline. mkzip |
||||
#writes a standard bare zip whose offsets count from position 0 on EVERY |
||||
#vintage (probed 2026-08-05, tclsh 8.7a6 vs tclsh90 9.0.3: identical member |
||||
#tables/CRCs/local offsets, and prefix-concatenated images of both mount and |
||||
#read under 9.0.3 zipfs). prefix + zip concatenated afterwards therefore |
||||
#yields an ARCHIVE-relative attached image on every driver - the |
||||
#self-locating-EOCD shape zipfs mounts by deriving the archive base, and the |
||||
#same compose shape make.tcl's zipcat kits ship. |
||||
# |
||||
#The wrap self-verifies before exiting: the finished image is re-read from |
||||
#disk and its EOCD-derived archive base must be > 0 (base == 0 would mean the |
||||
#zip's offsets count from file position 0 - the legacy file-relative mkimg |
||||
#convention) and must point at a central-directory signature. |
||||
# |
||||
#usage: zipfs_wrap.tcl -outfile <target_exe> -indir <folder_to_wrap> |
||||
# ?-strip <path_prefix_to_strip>? ?-password <plaintext>? |
||||
# ?-infile <explicit_prepend_file>? (default: the calling interp's exe) |
||||
# |
||||
#exit codes: 1 usage, 2 odd arg count, 3 unknown option, 4 missing -outfile, |
||||
#5 missing -indir, 6 prefix unreadable, 7 mkzip failure, 8 compose failure, |
||||
#9 archive-relative self-check failure. |
||||
|
||||
set script_title "[file tail [info nameofexecutable]] [file tail [info script]]" |
||||
set usage "$script_title -outfile <target_zipfile_path> -indir <folder_to_zip> ?-strip <path_prefix_to_strip>? ?-password <plaintext>? ?-infile <explicit_prepend_file>?" |
||||
set arglist $::argv |
||||
#informational arglist echo goes to stdout if wanted - stderr output makes zig build |
||||
#report the (successful) step with a misleading "failed command:" block (0.16 |
||||
#build_runner prints that whenever result_stderr is nonempty, success or not) |
||||
puts stdout "====> '$arglist'" |
||||
if {![llength $arglist]} { |
||||
puts stderr $usage |
||||
exit 1 |
||||
} |
||||
if {[llength $arglist] %2 != 0} { |
||||
puts stderr "$script_title error: expected an even number of option value pairs. Got [llength $arglist] commandline arguments. '$arglist'" |
||||
puts stderr $usage |
||||
exit 2 |
||||
} |
||||
set known_opts [list -outfile -indir -strip -password -infile] |
||||
dict for {k v} $arglist { |
||||
switch -exact -- $k { |
||||
-outfile - -indir - -strip - -password - -infile {} |
||||
default { |
||||
puts stderr "$script_title error: unrecognised option $k. Known_options $known_opts" |
||||
exit 3 |
||||
} |
||||
} |
||||
} |
||||
set defaults [dict create\ |
||||
-strip ""\ |
||||
-password ""\ |
||||
] |
||||
|
||||
set opts [dict merge $defaults $arglist] |
||||
if {![dict exists $opts -outfile]} { |
||||
puts stderr "$script_title error: Missing -outfile <zipfilename>" |
||||
exit 4 |
||||
} |
||||
if {![dict exists $opts -indir]} { |
||||
puts stderr "$script_title error: Missing -indir <folder>" |
||||
exit 5 |
||||
} |
||||
set outfile [file normalize [dict get $opts -outfile]] |
||||
set indir [file normalize [dict get $opts -indir]] |
||||
if {[dict exists $opts -infile]} { |
||||
set prefixfile [file normalize [dict get $opts -infile]] |
||||
} else { |
||||
#mkimg parity: with no explicit -infile the calling interp's own executable |
||||
#is the prepended file (the stock tclsh90szip wrap relies on this) |
||||
set prefixfile [file normalize [info nameofexecutable]] |
||||
} |
||||
if {![file readable $prefixfile]} { |
||||
puts stderr "$script_title error: prefix executable not readable: '$prefixfile'" |
||||
exit 6 |
||||
} |
||||
|
||||
#-- payload zip: the driving interp's builtin mkzip (a bare zip - standard |
||||
#offsets on every driver vintage) ------------------------------------------- |
||||
set callargs [list $indir] |
||||
if {[dict get $opts -strip] ne ""} { |
||||
lappend callargs [file normalize [dict get $opts -strip]] |
||||
} elseif {[dict get $opts -password] ne ""} { |
||||
lappend callargs "" |
||||
} |
||||
if {[dict get $opts -password] ne ""} { |
||||
lappend callargs [dict get $opts -password] |
||||
} |
||||
set tmpch [file tempfile tmpzip] |
||||
close $tmpch |
||||
puts stdout "$script_title call 'tcl::zipfs::mkzip $tmpzip $callargs'" ;#stdout: stderr makes zig report the successful step as 'failed command' |
||||
if {[catch { |
||||
tcl::zipfs::mkzip $tmpzip {*}$callargs |
||||
} errM]} { |
||||
file delete $tmpzip |
||||
puts stderr "$script_title error: Failure during call 'tcl::zipfs::mkzip $tmpzip $callargs'\n $errM" |
||||
exit 7 |
||||
} |
||||
|
||||
#-- compose: prefix executable + payload zip, concatenated OUTSIDE the writer - |
||||
puts stdout "$script_title compose '[file tail $prefixfile]' + payload -> '[file tail $outfile]'" |
||||
if {[catch { |
||||
set fin [open $prefixfile rb] |
||||
set prefixbytes [read $fin] |
||||
close $fin |
||||
set fzip [open $tmpzip rb] |
||||
set zipbytes [read $fzip] |
||||
close $fzip |
||||
set fout [open $outfile wb] |
||||
puts -nonewline $fout $prefixbytes |
||||
puts -nonewline $fout $zipbytes |
||||
close $fout |
||||
} errM]} { |
||||
file delete $tmpzip |
||||
puts stderr "$script_title error: Failure composing '$outfile' from prefix '$prefixfile' + payload zip\n $errM" |
||||
exit 8 |
||||
} |
||||
file delete $tmpzip |
||||
|
||||
#-- self-verify: the finished image must be ARCHIVE-relative ------------------- |
||||
#EOCD-derived archive base = eocd_filepos - (cd_offset + cd_size). base == 0 |
||||
#would mean the zip's offsets count from file position 0 (the legacy |
||||
#file-relative mkimg convention); base > 0 is the prefix size (archive-relative, |
||||
#what zipfs mounts). Then require the central-directory signature at |
||||
#base + cd_offset. |
||||
if {[catch { |
||||
set sz [file size $outfile] |
||||
set fv [open $outfile rb] |
||||
set tailn [expr {min($sz, 66000)}] |
||||
seek $fv [expr {$sz - $tailn}] start |
||||
set tail [read $fv $tailn] |
||||
set eidx [string last "PK\x05\x06" $tail] |
||||
if {$eidx < 0} {error "no end-of-central-directory record found"} |
||||
binary scan [string range $tail [expr {$eidx+4}] [expr {$eidx+21}]] "ssssiis" d1 d2 dn dnrec cdsize cdoff comlen |
||||
set eocdpos [expr {$sz - $tailn + $eidx}] |
||||
set base [expr {$eocdpos - ($cdoff + $cdsize)}] |
||||
if {$base <= 0} {error "archive base $base - file-relative offset convention"} |
||||
seek $fv [expr {$base + $cdoff}] start |
||||
set cdsig [read $fv 4] |
||||
close $fv |
||||
if {$cdsig ne "PK\x01\x02"} {error "no central-directory signature at base+cd_offset"} |
||||
} errM]} { |
||||
catch {close $fv} |
||||
puts stderr "$script_title error: wrapped image '$outfile' failed the archive-relative self-check\n $errM" |
||||
exit 9 |
||||
} |
||||
puts stdout "$script_title OK: '[file tail $outfile]' archive-relative (prefix [file size $prefixfile] bytes + zip [expr {$sz - [file size $prefixfile]}] bytes = $sz bytes)" |
||||
exit 0 |
||||
Loading…
Reference in new issue