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