You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
399 lines
19 KiB
399 lines
19 KiB
#library_artifacts.tcl (G-138, schema v2 lineage per G-123): emit punkbin |
|
#LIB-TIER artifact zips + per-artifact toml metadata + per-tier sha1sums for the |
|
#library packages a suite builds and verifies (tcllib pure-tcl, tcllibc critcl |
|
#accelerators - the mechanism is package-generic: any installed-shape package |
|
#folder can ride it). |
|
# |
|
#Layout emitted under -outdir (a punkbin repository mirror rooted at the lib tier): |
|
# lib/allplatforms/<pkgfolder>-<generation>-r<N>.zip platform-neutral packages |
|
# lib/<target>/<pkgfolder>-<generation>-r<N>.zip binary packages per platform |
|
# beside each zip: <artifact rootname>.toml sidecar; per-tier sha1sums.txt |
|
# (punkbin format '<sha1> *<filename>') |
|
# |
|
#Artifact naming: <installed folder name>-<generation>-r<N>.zip - the generation |
|
#tag (tcl8/tcl9) keeps the same package name distinct across Tcl generations |
|
#(folder names collide: both generations install tcllib2.0 and tcllibc), and the |
|
#-r<N> assembly revision gives punkbin-immutable names (revision from the |
|
#invocation; bump ONLY on deliberate publish - the dlls inside are NOT |
|
#bit-reproducible across zig rebuilds, so a rebuild-and-republish under the same |
|
#revision would violate punkbin immutability). |
|
# |
|
#Embedded record (embed-then-hash, the G-117 ordering rule): the record is |
|
#written INTO the staged package copy at <folder>/punkbin-artifact.toml (package |
|
#root, beside pkgIndex.tcl - inert to package loading) BEFORE the zip is |
|
#assembled and hashed; the finished-zip facts (sha1, size, built) live only in |
|
#the sidecar toml + sha1sums.txt, which remain the integrity authority. Single |
|
#emitting actor here (unlike the runtime family's zig-staging/tcl-emission |
|
#split), so embedded and sidecar copies are identical by construction; the |
|
#porcelain listing of the finished zip re-verifies the embedded member. |
|
# |
|
#Determinism contract: punkzip 'build' walks with SORTED member order, and zip |
|
#members carry file AND directory mtimes - so the staging copy syncs every |
|
#file/dir mtime from the installed source tree (Tcl 'file copy' preserves file |
|
#mtimes on windows but not unix; explicit sync makes it platform-independent), |
|
#and the embedded record's own mtime is pinned to the package's pkgIndex.tcl so |
|
#re-emission over an unchanged install tree reproduces byte-identical zips. |
|
#(zig install steps rewrite files only on content change, so an unchanged |
|
#package keeps its mtimes across no-op rebuilds.) |
|
# |
|
#Deliberately run UNDER A SUITE-BUILT SHELL (suite_tcl90: the plain family kit; |
|
#suite_tcl86: the installed static shell): the sha1 digests come from the |
|
#suite-built tcllib/tcllibc, so every emission run doubles as a proof that the |
|
#built shell executes real tooling from the very packages being published. |
|
# |
|
#args: -outdir <dir> -rev <N> -generation <tcl8|tcl9> -target <punkbin platform> |
|
# -tclpatch <patchlevel of the driving suite-built shell> |
|
# -suite <name> -zig <version> -optimize <mode> |
|
# -origin <url> -packager <identity> -project <name> -projecturl <url> |
|
# -provenance {<name> <uuid> ...} source checkout uuids. The 'critcl' pair |
|
# is included in a package's record only |
|
# when its teapot.txt declares a critcl |
|
# build (accelerator packages); other pairs |
|
# are recorded for every package. |
|
# -punkzip <exe> punkzip executable (deterministic zip) |
|
# -testreports <dir> G-107 evidence summaries; optional |
|
# -packages {<folder> <tier> <license> <testlibs> <path> ...} |
|
# 5-tuples: installed folder name, lib-tier subfolder |
|
# (allplatforms or a platform), license summary, comma-joined |
|
# summary library names for the sidecar [tests] section ('' for |
|
# none), absolute path of the installed package folder. |
|
|
|
proc fail {msg} {puts stderr "library_artifacts FAIL: $msg"; flush stderr; exit 1} |
|
proc note {msg} {puts stdout "library_artifacts: $msg"; flush stdout} |
|
|
|
array set opt { |
|
-outdir {} -rev 1 -generation {} -target {} -tclpatch {} |
|
-suite {} -zig {} -optimize {} |
|
-origin {} -packager {} -project {} -projecturl {} |
|
-provenance {} -punkzip {} -testreports {} -packages {} |
|
} |
|
foreach {k v} $argv { |
|
if {![info exists opt($k)]} {fail "unknown option '$k'"} |
|
set opt($k) $v |
|
} |
|
foreach req {-outdir -generation -target -tclpatch -suite -zig -optimize -origin -packager -project -projecturl -punkzip -packages} { |
|
if {$opt($req) eq ""} {fail "missing required option $req"} |
|
} |
|
if {![string is integer -strict $opt(-rev)] || $opt(-rev) < 1} {fail "-rev must be a positive integer"} |
|
if {[llength $opt(-packages)] % 5 != 0} {fail "-packages must be a list of 5-tuples: folder tier license testlibs path"} |
|
set punkzip [file normalize $opt(-punkzip)] |
|
if {![file exists $punkzip]} {fail "punkzip executable not found: $punkzip"} |
|
|
|
if {[catch {package require sha1} sha1ver]} { |
|
fail "package require sha1 failed under [info nameofexecutable] - the driving suite-built shell must resolve tcllib: $sha1ver" |
|
} |
|
|
|
proc toml_str {s} { |
|
#basic toml string: escape backslash and double-quote (values here are names, |
|
#versions, uuids, iso dates - no control chars expected) |
|
return "\"[string map {\\ \\\\ \" \\\"} $s]\"" |
|
} |
|
|
|
proc zip_split {name} { |
|
#{root ext} splitting only a .zip suffix - dotted package versions make |
|
#[file rootname] wrong (tcllib2.0-tcl9-r1 would truncate at the version dot) |
|
if {[string match -nocase "*.zip" $name]} { |
|
return [list [string range $name 0 end-4] .zip] |
|
} |
|
return [list $name ""] |
|
} |
|
|
|
proc runcap {args} { |
|
#run a helper tool capturing combined output; fail with that output on error |
|
if {[catch {exec {*}$args 2>@1} out]} { |
|
fail "command failed: $args\n$out" |
|
} |
|
return $out |
|
} |
|
|
|
proc copy_tree_synced {src dst} { |
|
#recursive copy with every file AND directory mtime synced from the source: |
|
#zip members carry both, so staged mtimes must be deterministic. Directories |
|
#are synced bottom-up (writing children updates a directory's own mtime). |
|
file mkdir $dst |
|
set names {} |
|
foreach pat {* .*} { |
|
foreach n [glob -nocomplain -directory $src -tails $pat] { |
|
if {$n in {. ..}} {continue} |
|
if {$n ni $names} {lappend names $n} |
|
} |
|
} |
|
foreach n [lsort $names] { |
|
set s [file join $src $n] |
|
set d [file join $dst $n] |
|
if {[file isdirectory $s]} { |
|
copy_tree_synced $s $d |
|
} else { |
|
file copy $s $d |
|
file mtime $d [file mtime $s] |
|
} |
|
} |
|
file mtime $dst [file mtime $src] |
|
} |
|
|
|
proc teapot_facts {pkgdir} { |
|
#best-effort facts from a critcl-generated teapot.txt at the package root: |
|
#dict keys 'version' (first 'Package <name> <ver>' line) and 'critcl' |
|
#(first 'Meta generated::by {critcl <ver>} ...' line). Empty dict when absent. |
|
set facts [dict create] |
|
set tp [file join $pkgdir teapot.txt] |
|
if {![file exists $tp]} {return $facts} |
|
set f [open $tp r] |
|
set data [read $f] |
|
close $f |
|
foreach line [split $data \n] { |
|
set line [string trim $line] |
|
if {![dict exists $facts version] && [regexp {^Package\s+\S+\s+(\S+)} $line -> v]} { |
|
dict set facts version $v |
|
} |
|
if {![dict exists $facts critcl] && [regexp {generated::by\s+\{critcl\s+([^\}]+)\}} $line -> cv]} { |
|
dict set facts critcl [string trim $cv] |
|
} |
|
} |
|
return $facts |
|
} |
|
|
|
proc summary_test_lines {reportsdir testlibs} { |
|
#G-107 evidence summaries -> '[tests]' toml lines, filtered to the summary |
|
#'library' names in testlibs (result lines only; the full line-record |
|
#summaries stay the canonical evidence artifacts) |
|
set tlines {} |
|
if {$reportsdir eq "" || ![file isdirectory $reportsdir] || ![llength $testlibs]} { |
|
return $tlines |
|
} |
|
foreach sf [lsort [glob -nocomplain -directory $reportsdir *.summary]] { |
|
set rec [dict create] |
|
set f [open $sf r] |
|
foreach line [split [read $f] \n] { |
|
set line [string trim $line] |
|
if {$line eq "" || [string index $line 0] eq "#"} continue |
|
if {[catch {llength $line} n] || $n < 2} continue |
|
dict set rec [lindex $line 0] [lrange $line 1 end] |
|
} |
|
close $f |
|
if {![dict exists $rec library] || ![dict exists $rec result]} continue |
|
set lib [dict get $rec library] |
|
if {$lib ni $testlibs} continue |
|
set parts [list "result=[dict get $rec result]"] |
|
foreach fkey {mode total passed skipped failed} { |
|
if {[dict exists $rec $fkey]} {lappend parts "$fkey=[dict get $rec $fkey]"} |
|
} |
|
lappend tlines "$lib = [toml_str [join $parts { }]]" |
|
} |
|
return $tlines |
|
} |
|
|
|
proc compose_record {ident finished tests} { |
|
#one composer for both copies (single emitting actor - identical by |
|
#construction): 'finished' empty -> the EMBEDDED record; 'finished' a dict |
|
#(sha1 size built) -> the sidecar, which adds those facts. 'tests' lines go |
|
#to the sidecar only. |
|
set emb [expr {[dict size $finished] == 0}] |
|
set m {} |
|
if {$emb} { |
|
lappend m "#punkshell library artifact metadata - EMBEDDED copy (schema v2, class \"library\")," |
|
lappend m "#written at library-artifacts emission into the staged package copy BEFORE the" |
|
lappend m "#zip is assembled and hashed (embed-then-hash). Finished-zip facts (sha1, size," |
|
lappend m "#built) live only in the sidecar toml + sha1sums.txt, which remain the" |
|
lappend m "#integrity authority; this copy makes a materialized package tree self-describing." |
|
} else { |
|
lappend m "#punkshell library artifact metadata (schema v2, class \"library\") - generated" |
|
lappend m "#by library_artifacts.tcl. Sidecar copy: the record embedded in the zip at" |
|
lappend m "#<folder>/punkbin-artifact.toml plus the finished-zip facts (sha1, size, built)." |
|
lappend m "#The sidecar + sha1sums.txt remain the integrity authority." |
|
} |
|
lappend m "schema = 2" |
|
lappend m "" |
|
lappend m "\[artifact\]" |
|
lappend m "name = [toml_str [dict get $ident name]]" |
|
lappend m "class = \"library\"" |
|
lappend m "package = [toml_str [dict get $ident package]]" |
|
lappend m "package_version = [toml_str [dict get $ident package_version]]" |
|
lappend m "#folder: the installed-shape package folder the zip carries at its root" |
|
lappend m "folder = [toml_str [dict get $ident folder]]" |
|
lappend m "revision = [dict get $ident revision]" |
|
lappend m "target = [toml_str [dict get $ident target]]" |
|
lappend m "#tcl_generation: the Tcl major-generation the package was built/installed under" |
|
lappend m "#(and, for binary packages, compiled against) - part of the artifact name." |
|
lappend m "tcl_generation = [toml_str [dict get $ident tcl_generation]]" |
|
if {!$emb} { |
|
lappend m "sha1 = [toml_str [dict get $finished sha1]]" |
|
lappend m "size = [dict get $finished size]" |
|
lappend m "built = [toml_str [dict get $finished built]]" |
|
} |
|
lappend m "#build_id: offline correlation key re-joining a renamed copy to its record;" |
|
lappend m "#identical in the embedded and sidecar copies (a deterministic identity digest," |
|
lappend m "#not an integrity key - the sidecar sha1 is the integrity fact)." |
|
lappend m "build_id = [toml_str [dict get $ident build_id]]" |
|
lappend m "#origin: canonical artifact repo this artifact was BUILT FOR - not necessarily" |
|
lappend m "#where it is hosted; mirrors preserve it." |
|
lappend m "origin = [toml_str [dict get $ident origin]]" |
|
lappend m "#packager: declared identity, not proof - signing (minisign sidecars) is the" |
|
lappend m "#verification layer." |
|
lappend m "packager = [toml_str [dict get $ident packager]]" |
|
lappend m "project = [toml_str [dict get $ident project]]" |
|
lappend m "project_url = [toml_str [dict get $ident project_url]]" |
|
lappend m "#license: summary for the distributed package; the package's own license text" |
|
lappend m "#rides inside the zip (license.terms etc)." |
|
lappend m "license = [toml_str [dict get $ident license]]" |
|
lappend m "build_host_platform = [toml_str [dict get $ident build_host_platform]]" |
|
lappend m "" |
|
lappend m "\[library\]" |
|
lappend m "#driving_tcl_patchlevel: patchlevel of the suite-built shell that ran the" |
|
lappend m "#installer/critcl - the generation witness, not a runtime version requirement." |
|
lappend m "driving_tcl_patchlevel = [toml_str [dict get $ident tclpatch]]" |
|
lappend m "" |
|
lappend m "\[provenance\]" |
|
lappend m "#class: build-origin class (schema v2): suite-built | third-party | local." |
|
lappend m "#NOTE for line-based consumers: '\[artifact\] class' above is the first 'class ='" |
|
lappend m "#line in the record by construction - whole-text single-key scans see that one." |
|
lappend m "class = \"suite-built\"" |
|
lappend m "suite = [toml_str [dict get $ident suite]]" |
|
lappend m "toolchain = [toml_str [dict get $ident toolchain]]" |
|
lappend m "optimize = [toml_str [dict get $ident optimize]]" |
|
if {[dict exists $ident critcl]} { |
|
lappend m "#critcl: version declared by the package's own critcl-generated teapot.txt" |
|
lappend m "critcl = [toml_str [dict get $ident critcl]]" |
|
} |
|
foreach {n uuid} [dict get $ident provpairs] { |
|
lappend m "${n}_checkout = [toml_str $uuid]" |
|
} |
|
if {!$emb && [llength $tests]} { |
|
lappend m "" |
|
lappend m "\[tests\]" |
|
lappend m {*}$tests |
|
} |
|
return [join $m \n] |
|
} |
|
|
|
set outdir [file normalize $opt(-outdir)] |
|
set stageroot [file join $outdir .stage] |
|
file delete -force $stageroot |
|
file mkdir $outdir |
|
set built [clock format [clock seconds] -format %Y-%m-%dT%H:%M:%SZ -timezone :UTC] |
|
set sha1lines [dict create] ;#tier -> list of sha1sums lines |
|
set emitted {} |
|
|
|
foreach {folder tier license testlibs pkgpath} $opt(-packages) { |
|
set pkgpath [file normalize $pkgpath] |
|
if {![file isdirectory $pkgpath]} {fail "package folder not found: $pkgpath"} |
|
if {![file exists [file join $pkgpath pkgIndex.tcl]]} { |
|
fail "$folder: no pkgIndex.tcl at $pkgpath - not an installed-shape package folder" |
|
} |
|
if {[file exists [file join $pkgpath punkbin-artifact.toml]]} { |
|
fail "$folder: source tree already carries punkbin-artifact.toml ($pkgpath) - stale staging or a pre-recorded source; refusing to overwrite provenance" |
|
} |
|
if {[file tail $pkgpath] ne $folder} { |
|
fail "$folder: installed folder name mismatch (path tail '[file tail $pkgpath]')" |
|
} |
|
|
|
set artifact "$folder-$opt(-generation)-r$opt(-rev).zip" |
|
lassign [zip_split $artifact] aroot _ |
|
|
|
#package name/version: trailing dotted version in the folder name (tcllib2.0), |
|
#else the folder name as-is with the version from a critcl teapot.txt when |
|
#present (tcllibc installs to an unversioned folder), else 'unrecorded'. |
|
set tfacts [teapot_facts $pkgpath] |
|
if {[regexp {^(.*[^0-9.])([0-9][0-9.]*)$} $folder -> pname pver]} { |
|
} else { |
|
set pname $folder |
|
if {[dict exists $tfacts version]} { |
|
set pver [dict get $tfacts version] |
|
} else { |
|
set pver "unrecorded" |
|
} |
|
} |
|
|
|
#provenance pairs for THIS package: the 'critcl' pair rides only with |
|
#critcl-built packages (teapot.txt witness); other pairs are general. |
|
set provpairs {} |
|
foreach {n uuid} $opt(-provenance) { |
|
if {$n eq "critcl" && ![dict exists $tfacts critcl]} {continue} |
|
lappend provpairs $n $uuid |
|
} |
|
|
|
#deterministic build_id (uuid-shaped sha1 digest of stable identity inputs - |
|
#same input family as the runtime records: name, toolchain/optimize, driving |
|
#patchlevel, per-member source checkout uuids) |
|
set idseed "punkbin-artifact|$artifact|zig $opt(-zig)|$opt(-optimize)|tcl$opt(-tclpatch)|$provpairs" |
|
set ihex [sha1::sha1 -hex $idseed] |
|
set build_id "[string range $ihex 0 7]-[string range $ihex 8 11]-[string range $ihex 12 15]-[string range $ihex 16 19]-[string range $ihex 20 31]" |
|
|
|
set ident [dict create \ |
|
name $artifact package $pname package_version $pver folder $folder \ |
|
revision $opt(-rev) target $tier tcl_generation $opt(-generation) \ |
|
build_id $build_id origin $opt(-origin) packager $opt(-packager) \ |
|
project $opt(-project) project_url $opt(-projecturl) license $license \ |
|
build_host_platform $opt(-target) tclpatch $opt(-tclpatch) \ |
|
suite $opt(-suite) toolchain "zig $opt(-zig)" optimize $opt(-optimize) \ |
|
provpairs $provpairs] |
|
if {[dict exists $tfacts critcl]} { |
|
dict set ident critcl [dict get $tfacts critcl] |
|
} |
|
|
|
#stage: mtime-synced copy + embedded record, record mtime pinned to the |
|
#package's pkgIndex.tcl (a stable per-install anchor), folder mtime re-synced |
|
#after the write (creating the record file bumps it) |
|
set astage [file join $stageroot $aroot] |
|
file delete -force $astage |
|
file mkdir $astage |
|
copy_tree_synced $pkgpath [file join $astage $folder] |
|
set recordtext [compose_record $ident [dict create] {}] |
|
set recfile [file join $astage $folder punkbin-artifact.toml] |
|
set f [open $recfile w] |
|
fconfigure $f -translation lf |
|
puts $f $recordtext |
|
close $f |
|
file mtime $recfile [file mtime [file join $pkgpath pkgIndex.tcl]] |
|
file mtime [file join $astage $folder] [file mtime $pkgpath] |
|
|
|
#assemble (punkzip: recursive walk, sorted members) and re-verify the |
|
#embedded member from the finished zip's porcelain listing |
|
set tierdir [file join $outdir lib $tier] |
|
file mkdir $tierdir |
|
set dest [file join $tierdir $artifact] |
|
file delete -force $dest |
|
set savedpwd [pwd] |
|
cd $astage |
|
runcap $punkzip build $dest $folder |
|
cd $savedpwd |
|
set porcelain [runcap $punkzip list -porcelain $dest] |
|
set expbytes [expr {[string length $recordtext] + 1}] ;#trailing newline (all-ASCII record) |
|
set members 0 |
|
set recline "" |
|
foreach line [split $porcelain \n] { |
|
if {[string match "m *" $line]} { |
|
incr members |
|
if {[string match "* $folder/punkbin-artifact.toml" $line]} {set recline $line} |
|
} |
|
} |
|
if {$recline eq ""} {fail "$artifact: embedded record member $folder/punkbin-artifact.toml missing from finished zip"} |
|
#porcelain v1 member line: m <isdir> <method> <uncompressed> <compressed> <crc> ... |
|
if {[lindex $recline 3] != $expbytes} { |
|
fail "$artifact: embedded record member size [lindex $recline 3] != composed record size $expbytes" |
|
} |
|
|
|
set sha1 [sha1::sha1 -hex -file $dest] |
|
set size [file size $dest] |
|
dict lappend sha1lines $tier "$sha1 *$artifact" |
|
|
|
set tests [summary_test_lines $opt(-testreports) [split $testlibs ,]] |
|
set mf [file join $tierdir "$aroot.toml"] |
|
set f [open $mf w] |
|
fconfigure $f -translation lf |
|
puts $f [compose_record $ident [dict create sha1 $sha1 size $size built $built] $tests] |
|
close $f |
|
lappend emitted "$folder -> lib/$tier/$artifact" |
|
note "emitted lib/$tier/$artifact (sha1 $sha1, [expr {$size/1024}] KB, $members members) + [file tail $mf]" |
|
} |
|
|
|
dict for {tier lines} $sha1lines { |
|
set f [open [file join $outdir lib $tier sha1sums.txt] w] |
|
fconfigure $f -translation lf |
|
puts $f [join $lines \n] |
|
close $f |
|
note "lib/$tier/sha1sums.txt written ([llength $lines] artifacts)" |
|
} |
|
file delete -force $stageroot |
|
puts "library_artifacts OK: [join $emitted {; }] -> $outdir" |
|
exit 0
|
|
|