diff --git a/CHANGELOG.md b/CHANGELOG.md index 57e6b59b..35caab7b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,11 @@ The latest `## [X.Y.Z]` header must match the `version` field in `punkproject.to Entries are newest-first; one bullet per notable change. See the root `AGENTS.md` "Project Versioning" section for the bump policy. +## [0.4.8] - 2026-07-08 + +- G-037 completed (flipped to achieved): new `make.tcl vfslibs` step (also run inside `make.tcl project`) propagates declared vendored platform-library packages into kit vfs lib_tcl trees — declarations in `src/runtime/vendorlib_vfs.toml` (tomlish-parsed, per-package per-kit with explicit `supersedes` removal so no silent mixed-version provision; punkcheck provenance at src/vfs/.punkcheck, outside kit payloads; malformed entries fail the build naming the entry). G-024's mapvfs toml conversion was not required; the file is recorded as a candidate for absorption into it. Authority is the declaration — undeclared drift (e.g. the vendorlib/kit twapi divergence) is deliberately untouched. +- 8.6 kits upgraded to tcludp 1.0.13 via the new step (the G-036 loose-end decision): the 1.0.13 folder is dual-generation (pkgIndex selects tcl9udp1013.dll or udp1013t.dll), so the single vendorlib_tcl9 source serves punk8win.vfs/lib_tcl8, replacing udp 1.0.12. Verified on rebuilt kits: punksys/punkbi (8.6.13) and punk902z (9.0.2) all load udp 1.0.13 from their vfs; no udp1.0.12 remains under src/vfs. + ## [0.4.7] - 2026-07-08 - G-036 completed (flipped to achieved): `punk::lib` 0.3.0 adds `punk::lib::check::has_libbug_udp_threadexit` — version-based detection of the tcludp < 1.0.13 thread-exit bug on Tcl 9 Windows (the per-thread exit handler closes process-global event handles, silently freezing every other udp-using thread's event loop after any udp-loaded thread exits; root-caused and fixed-by-upgrade earlier in 0.4.3). `has_libbug_*` is the new check family for bundled/vendored library bugs; `help tcl` (punk 0.2.1) now scans it alongside `has_tclbug_*`, supports a full `url` reference key for non tcl-core trackers, and no longer errors on a triggered check carrying a reference without a description. Detection is loaded-version based, falling back to the best available registered version without loading the binary. New checkbugs.test covers the classifier matrix, the live check's dict shape/consistency, and a contract test over all existing check procs. Open decisions recorded in the G-036 detail: punk8win (8.6) kit's udp 1.0.12 swap; optional upstream tickets for residual tcludp trunk weaknesses. diff --git a/GOALS.md b/GOALS.md index d1dffec0..c9d0ec4b 100644 --- a/GOALS.md +++ b/GOALS.md @@ -267,7 +267,7 @@ Detail: goals/G-036-tcl9-udp-console-worker-wedge.md Goal: the Tcl 9-only wedge - a worker thread that has used a tcludp syslog socket stops servicing its event queue (timers, thread::send) when the punkshell process is console-attached, the proximate trigger of the piped-stdin exit/quit hang - is root-caused to a named component (Tcl 9 Windows console driver, tcludp, Thread extension, or a specific interaction) with the smallest demonstrating repro, so the user can decide on and manually file an upstream report. Acceptance: (reworked 2026-07-08 after the root cause was found) the wedge mechanism is identified and written up in the detail file - DONE: bundled tcludp 1.0.12's Windows per-thread UDP_ExitProc closes the process-global synchronization events, proven by dump handle-table analysis plus a live CloseHandle breakpoint and confirmed by the upstream 1.0.12->1.0.13 diff, which already fixes it (so no upstream report is required; the standalone minimal repro originally required here is waived as moot by the user); the tcl9 kits bundle tcludp >= 1.0.13 with the in-context batch harness baseline resolved - DONE 2026-07-08 (run-2 syslog workers alive vs the 4/4-wedged 1.0.12 baseline); DONE 2026-07-08 (punk::lib 0.3.0 has_libbug_udp_threadexit, surfaced via 'help tcl' in punk 0.2.1): a has_bug-style detection in the punkshell check machinery (in the vein of punk::lib::check::has_tclbug_* / punk::console::check::has_bug_*, surfaced through the same reporting as 'help tcl'/'help console') reports the vulnerable combination - simple version-based detection (loaded/bundled tcludp < 1.0.13 on Tcl 9 Windows) is sufficient, no behavioural probe needed; loose-end decisions (punk8win 8.6 kit's udp 1.0.12 swap; optional upstream tickets for residual tcludp trunk weaknesses) recorded in the detail file when made (open as of 2026-07-08 - non-gating). -### G-037 [proposed] Propagate platform vendor libraries into kit vfs lib_tcl trees via make.tcl +### G-037 [achieved 2026-07-08] Propagate platform vendor libraries into kit vfs lib_tcl trees via make.tcl Scope: src/make.tcl (new or extended step), src/vendorlib_tcl8 + src/vendorlib_tcl9 (sources), src/vfs/.vfs/lib_tcl8 + lib_tcl9 (targets), punkcheck tracking Detail: goals/G-037-vendorlib-vfs-propagation.md Goal: platform-specific vendored binary packages under src/vendorlib_tcl/ reach the kit vfs lib_tcl trees through a make.tcl step instead of hand-copying - updating a vendored package becomes a vendorlib drop plus standard build invocations (motivating case 2026-07-08: tcludp 1.0.12 -> 1.0.13 for the G-036 wedge fix - `libs`, `vfscommonupdate` and `project` all completed while every kit vfs still bundled udp 1.0.12, requiring a manual copy into each vfs lib_tcl9 folder). diff --git a/goals/G-036-tcl9-udp-console-worker-wedge.md b/goals/G-036-tcl9-udp-console-worker-wedge.md index 896a6a79..16d73248 100644 --- a/goals/G-036-tcl9-udp-console-worker-wedge.md +++ b/goals/G-036-tcl9-udp-console-worker-wedge.md @@ -301,9 +301,15 @@ shorthand). Verified: current punk902z kit (udp 1.0.13) reports bug=0 with no wa a simulated triggered has_libbug_* check renders the warning block with description and url; checkbugs.test also pins the buginfo dict contract across all existing check procs. -Loose ends / optional follow-ups (open as of 2026-07-08 - non-gating, record decisions here when made): -- Check which tcludp the punksys (8.6) kit bundles and why 8.6 appeared immune (different udp - version, different exit-handler ordering, or fast-fail luck). +Loose ends / optional follow-ups (record decisions here when made): +- DECIDED + DONE 2026-07-08: punk8win.vfs (8.6 kits punksys/punkbi) swapped from udp 1.0.12 + to tcludp 1.0.13 - the 1.0.13 folder is dual-generation (udp1013t.dll for 8.x selected by + its pkgIndex) so the same vendorlib_tcl9 source serves lib_tcl8. Applied via the new + G-037 vfslibs propagation step (declaration in src/runtime/vendorlib_vfs.toml removes the + superseded udp1.0.12). The 8.6 apparent immunity remains unexplained but is now moot for + punkshell kits (same fixed code everywhere). +- Check why 8.6 appeared immune (different exit-handler ordering, or fast-fail luck) - + academic now that all kits carry 1.0.13. - Residual weaknesses still present in tcludp trunk, candidates for polite upstream tickets: auto-reset-event-used-as-lock (lost-SetEvent risk, no ownership); packetNum not decremented on the recvfrom error path (ICMP port-unreachable leaves packetNum>0 -> permanent diff --git a/goals/G-037-vendorlib-vfs-propagation.md b/goals/G-037-vendorlib-vfs-propagation.md index 72ad6cb3..c5baf621 100644 --- a/goals/G-037-vendorlib-vfs-propagation.md +++ b/goals/G-037-vendorlib-vfs-propagation.md @@ -1,6 +1,6 @@ # G-037 Propagate platform vendor libraries into kit vfs lib_tcl trees via make.tcl -Status: proposed +Status: achieved 2026-07-08 Scope: src/make.tcl (new or extended step), src/vendorlib_tcl8 + src/vendorlib_tcl9 (sources), src/vfs/.vfs/lib_tcl8 + lib_tcl9 (targets), punkcheck tracking Acceptance: with a newer package version placed under src/vendorlib_tcl9/, one documented make.tcl invocation updates the participating src/vfs/*/lib_tcl9 trees - installing the new package and removing or explicitly retiring the superseded version (no silent mixed-version provision, per the G-035 concerns) - with punkcheck-tracked provenance; which vfs folders participate is explicitly declared per kit rather than blanket-copied (kit vfs package sets may intentionally differ), with the declaration mechanism recorded (candidate home: the G-024 mapvfs toml); a subsequent `make.tcl project` yields kits loading the new version (provable via the tcludp case: built punk902z reports `package require udp` == 1.0.13 with no udp1.0.12 folder remaining in its vfs); the lib_tcl8 tree gets the same treatment or an explicit exclusion rationale in the goal record. @@ -47,6 +47,51 @@ What the existing targets actually cover (verified in make.tcl at the time of wr - **lib_tcl8**: same mechanism should serve the tcl8 kits (punk8win.vfs still bundles udp 1.0.12 as of 0.4.3 - see G-036 loose ends), or the exclusion is recorded here. +## Implementation (2026-07-08) + +Mechanism as landed (design points above settled as follows): + +- **Declaration**: `src/runtime/vendorlib_vfs.toml`, parsed with the bootsupport tomlish + package (1.1.10) - no ad-hoc parsing. Named tables `[install.]` with keys: + `source` (package folder relative to src/), `targets` (list of kit vfs lib folders + relative to src/vfs/), optional `supersedes` (folder names removed from each target + before install). G-024's mapvfs toml conversion was NOT required first - this file is + recorded as a candidate for absorption into it. (make.tcl's own help already carried a + matching intent: "update the src/vendorlib based on src/vendorlib/config.toml (todo)".) +- **Step**: `make.tcl vfslibs` (new subcommand), also run automatically inside + `make.tcl project` before kit vfs assembly. Malformed/unresolvable entries fail loudly + naming the entry (exit 3). +- **Supersession**: explicit `supersedes` folder-name list per entry (the simpler option; + pkgIndex-declared package identity detection remains a possible refinement). The step + never removes the folder it is about to install, and removal happens before install. +- **Direction/authority**: declaration-driven only - nothing syncs unless declared, so the + observed twapi drift (vendorlib 5.0b1 older than kit copies) is untouched until someone + declares a twapi entry. This resolves the "explicit direction/authority semantics" + question: authority is the declaration, not file timestamps/versions. +- **Cross-generation sources**: allowed when the package supports it - the motivating + tcludp 1.0.13 folder is dual-generation (tcl9udp1013.dll + udp1013t.dll, pkgIndex + selects by [package vsatisfies]), so the single vendorlib_tcl9 source serves the + punk8win.vfs/lib_tcl8 target (no duplicate binary committed under vendorlib_tcl8). +- **punkcheck provenance**: records at `src/vfs/.punkcheck` via -punkcheck-folder (kept + outside the .vfs payload folders so no records are baked into kits); skip-if-unchanged + verified (second run: 0 copied, 9 skipped per target). +- **lib_tcl8**: same mechanism, exercised immediately - punk8win.vfs/lib_tcl8 had + udp1.0.12 removed and tcludp1.0.13 installed via the declaration (the G-036 loose-end + decision, made 2026-07-08). + +Verification (2026-07-08, acceptance met - goal flipped to achieved): + +- `make.tcl vfslibs`: installed tcludp1.0.13 into punk8win.vfs/lib_tcl8 (9 files), + removed superseded udp1.0.12; re-recorded the two tcl9 kit targets (previously + hand-copied). Second run: 0 copied / 9 skipped per target (punkcheck skip-unchanged). +- `make.tcl project` (with the vfslibs step now inside it): INSTALLED KITS punkbi.exe, + punksys.exe, punk902z.exe. punk9win_for_tkruntime.vfs correctly detected as unchanged + (its 1.0.13 payload predated the step) - cached kit redeployed. +- Built kits: punksys 8.6.13 `package require udp` = 1.0.13 loading + lib_tcl8/tcludp1.0.13/udp1013t.dll; punkbi likewise; punk902z 9.0.2 = 1.0.13 loading + zipfs lib_tcl9/tcludp1.0.13/tcl9udp1013.dll. No udp1.0.12 folder remains anywhere + under src/vfs. Piped-shell exit smoke on punksys clean (PUNK_PIPE_EOF=exit). + ## Alternatives considered - Extending `vfscommonupdate` to also sync platform libs into `_vfscommon.vfs` - rejected diff --git a/punkproject.toml b/punkproject.toml index ae1578fd..8b646556 100644 --- a/punkproject.toml +++ b/punkproject.toml @@ -1,3 +1,3 @@ [project] name = "punkshell" -version = "0.4.7" +version = "0.4.8" diff --git a/src/bootsupport/modules/punk-0.2.0.tm b/src/bootsupport/modules/punk-0.2.1.tm similarity index 99% rename from src/bootsupport/modules/punk-0.2.0.tm rename to src/bootsupport/modules/punk-0.2.1.tm index a8086722..a167b7f4 100644 --- a/src/bootsupport/modules/punk-0.2.0.tm +++ b/src/bootsupport/modules/punk-0.2.1.tm @@ -8570,7 +8570,7 @@ namespace eval punk { punk::args::define { @id -id ::punk::helptopic::tcl - @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter (as detected by the punk::lib::check::has_tclbug_* checks)." + @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter and known bugs in bundled library packages (as detected by the punk::lib::check::has_tclbug_* and has_libbug_* checks)." @values -min 0 -max 0 } proc tcl {context args} { @@ -8580,8 +8580,12 @@ namespace eval punk { catch { append text \n "Tcl build-info: [::tcl::build-info]" } - #generate warningblocks for each triggered Tcl bug in namespace ::punk::lib::check - set bugcheck_procs [info procs ::punk::lib::check::has_tclbug*] + #generate warningblocks for each triggered bug check in namespace ::punk::lib::check + #has_tclbug_* = Tcl core bugs; has_libbug_* = bundled/vendored library bugs (e.g. tcludp - G-036) + set bugcheck_procs [concat\ + [info procs ::punk::lib::check::has_tclbug*]\ + [info procs ::punk::lib::check::has_libbug*]\ + ] foreach bp $bugcheck_procs { set buginfo [$bp] if {[dict get $buginfo bug]} { @@ -8595,12 +8599,15 @@ namespace eval punk { major {set highlight [punk::ansi::a+ red bold]} default {set highlight ""} } + set indent " " append warningblock \n $highlight "warning level: $level $bp triggered." if {[dict exists $buginfo description]} { - set indent " " append warningblock \n "[punk::lib::indent [dict get $buginfo description] $indent]" } - if {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { + if {[dict exists $buginfo url] && [dict get $buginfo url] ne ""} { + #full reference url (e.g. non tcl-core trackers such as tcludp) + append warningblock \n "${indent}see [punk::ansi::hyperlink [dict get $buginfo url]]" + } elseif {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { set bugref [dict get $buginfo bugref] append warningblock \n "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/$bugref]" } @@ -9350,7 +9357,7 @@ punkcheck::cli set_alias punkcheck package provide punk [namespace eval punk { #FUNCTL variable version - set version 0.2.0 + set version 0.2.1 }] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.2.1.tm b/src/bootsupport/modules/punk/lib-0.3.0.tm similarity index 99% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.2.1.tm rename to src/bootsupport/modules/punk/lib-0.3.0.tm index 27aa0795..09da6c9a 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.2.1.tm +++ b/src/bootsupport/modules/punk/lib-0.3.0.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::lib 0.2.1 +# Application punk::lib 0.3.0 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::lib 0 0.2.1] +#[manpage_begin punkshell_module_punk::lib 0 0.3.0] #[copyright "2024"] #[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}] #[moddesc {punk library}] [comment {-- Description at end of page heading --}] @@ -250,6 +250,56 @@ tcl::namespace::eval punk::lib::check { return [dict create bug $bug bugref e38dc74e2 description $description level medium] } + #has_libbug_* procs report bugs in bundled/vendored library packages rather than the Tcl core. + #They are surfaced through the same 'help tcl' warning report as the has_tclbug_* checks. + + #pure classifier, separated for testability - facts in, verdict out + proc libbug_udp_threadexit_applies {udpversion platform tclversion} { + if {$udpversion eq ""} { + return 0 ;#no udp package known - nothing vulnerable to load + } + if {$platform ne "windows"} { + return 0 + } + if {![package vsatisfies $tclversion 9]} { + #tcl 8.6 exhibited apparent immunity in the G-036 investigation (unexplained - see goal detail) + #detection deliberately scoped to Tcl 9 per G-036 acceptance + return 0 + } + return [expr {[package vcompare $udpversion 1.0.13] < 0}] + } + proc has_libbug_udp_threadexit {} { + #tcludp <= 1.0.12 on Windows: the per-thread exit handler UDP_ExitProc closes the + #PROCESS-GLOBAL sockListLock/waitForSock event handles. The first udp-loaded thread to + #exit corrupts the lock for every other udp-loaded thread - their event loops block + #forever in WaitForSingleObject on a dead or recycled handle (timers and thread::send + #unserviced). In punkshell the visible casualty is syslog log workers silently freezing + #(the original exit/quit hang this caused is separately mitigated). Root-caused + #2026-07-08 - see goal G-036 detail. Fixed upstream in tcludp 1.0.13 (per-thread + #UdpThreadExitProc deletes only the event source; ExitSockets closes the events at + #process exit). + #Version-based detection only (per G-036 acceptance) - no behavioural probe. + set udpversion [package provide udp] + if {$udpversion eq ""} { + #not loaded - determine what version would be provided, without loading the binary: + #an unsatisfiable require triggers the package unknown scan (registering ifneeded + #scripts) then fails before any dll load. + catch {package require udp 999999} + set available [package versions udp] + if {[llength $available]} { + set udpversion [lindex [lsort -command {package vcompare} $available] end] + } + } + set bug [libbug_udp_threadexit_applies $udpversion $::tcl_platform(platform) [package provide Tcl]] + if {$udpversion eq ""} { + set verinfo "no udp package found" + } else { + set verinfo "udp $udpversion" + } + set description "tcludp < 1.0.13 on Tcl 9 Windows ($verinfo): the udp package's per-thread exit\nhandler closes process-global event handles - after any udp-using thread exits, every\nother udp-using thread's event loop can freeze silently (e.g. syslog log workers stop).\nUpgrade the bundled/available udp package to 1.0.13+ (see goal G-036)." + return [dict create bug $bug bugref "" url https://core.tcl-lang.org/tcludp description $description level medium libversion $udpversion] + } + proc has_tclbug_safeinterp_compile {{show 0}} { #ensemble calls within safe interp not compiled #https://core.tcl-lang.org/tcl/tktview/1095bf7f756f9aed6bde @@ -9069,7 +9119,7 @@ namespace eval ::punk::args::register { package provide punk::lib [tcl::namespace::eval punk::lib { variable pkg punk::lib variable version - set version 0.2.1 + set version 0.3.0 }] return diff --git a/src/make.tcl b/src/make.tcl index 8600aae7..eead4196 100644 --- a/src/make.tcl +++ b/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] + variable known_commands [list project modules libs packages vfs vfslibs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -1348,6 +1348,10 @@ proc ::punkboot::punkboot_gethelp {args} { append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n + append h " $scriptname vfslibs" \n + append h " - propagate declared vendored platform-library packages into kit vfs lib_tcl trees" \n + append h " - declarations (per-package per-kit, with superseded-version removal) live in src/runtime/vendorlib_vfs.toml" \n + append h " - also runs automatically as part of '$scriptname project'" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -2353,7 +2357,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules libs packages vfs bin}} { +if {$::punkboot::command ni {project modules libs packages vfs vfslibs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -2475,6 +2479,97 @@ if {$::punkboot::command in {project packages libs}} { } } +if {$::punkboot::command in {project vfslibs}} { + #G-037: propagate declared vendored platform-library packages into kit vfs lib_tcl trees. + #Participation is per-package per-kit (kit vfs package sets intentionally differ - e.g. twapi + #versions vary per kit) - declared in src/runtime/vendorlib_vfs.toml, never blanket-copied. + #punkcheck records live at src/vfs/.punkcheck so they are not baked into kit payloads. + set vfslibs_config $sourcefolder/runtime/vendorlib_vfs.toml + if {![file exists $vfslibs_config]} { + puts stdout "VFSLIBS: no config at $vfslibs_config - skipping vendorlib -> kit vfs propagation" + } else { + if {[catch {package require tomlish} tomlish_err]} { + puts stderr "$A(BAD)VFSLIBS: cannot process $vfslibs_config - tomlish package unavailable ($tomlish_err)$A(RST)" + exit 3 + } + set fd [open $vfslibs_config r] + fconfigure $fd -encoding utf-8 + set vfslibs_tomldata [read $fd] + close $fd + if {[catch {tomlish::to_dict [tomlish::from_toml $vfslibs_tomldata]} vfslibs_dict]} { + puts stderr "$A(BAD)VFSLIBS: failed to parse $vfslibs_config\n$vfslibs_dict$A(RST)" + exit 3 + } + #tomlish::to_dict values are type-tagged (e.g {type STRING value x}, {type ARRAY value {...}}) + proc ::punkboot::lib::toml_untag {tagged} { + if {[dict get $tagged type] eq "ARRAY"} { + set plain [list] + foreach el [dict get $tagged value] { + lappend plain [::punkboot::lib::toml_untag $el] + } + return $plain + } + return [dict get $tagged value] + } + set vfslibs_installs [dict create] + if {[dict exists $vfslibs_dict install]} { + set vfslibs_installs [dict get $vfslibs_dict install] + } + if {![dict size $vfslibs_installs]} { + puts stdout "VFSLIBS: no \[install.\] entries found in $vfslibs_config" + } + dict for {iname ientry} $vfslibs_installs { + foreach reqkey {source targets} { + if {![dict exists $ientry $reqkey]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname in $vfslibs_config is missing required key '$reqkey'$A(RST)" + exit 3 + } + } + set isource [punkboot::lib::toml_untag [dict get $ientry source]] + set itargets [punkboot::lib::toml_untag [dict get $ientry targets]] + set isupersedes [list] + if {[dict exists $ientry supersedes]} { + set isupersedes [punkboot::lib::toml_untag [dict get $ientry supersedes]] + } + set source_pkg_folder $sourcefolder/$isource + if {![file isdirectory $source_pkg_folder]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname source '$isource' not found at $source_pkg_folder$A(RST)" + exit 3 + } + set pkgtail [file tail $source_pkg_folder] + foreach t $itargets { + set target_vfs_dir [lindex [file split $t] 0] + if {![file isdirectory $sourcefolder/vfs/$target_vfs_dir]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname target '$t' - no vfs folder at $sourcefolder/vfs/$target_vfs_dir$A(RST)" + exit 3 + } + set target_lib_folder $sourcefolder/vfs/$t + file mkdir $target_lib_folder + #supersession first - no silent mixed-version provision (G-035 concerns) + foreach sup $isupersedes { + if {$sup eq $pkgtail} { + continue ;#never remove what we are about to install + } + set suppath $target_lib_folder/$sup + if {[file exists $suppath]} { + puts stdout "VFSLIBS install.$iname: removing superseded '$sup' from vfs/$t" + file delete -force $suppath + } + } + puts stdout "VFSLIBS install.$iname: $isource -> vfs/$t/$pkgtail (if source file changed)" + set resultdict [punkcheck::install $source_pkg_folder $target_lib_folder/$pkgtail\ + -installer make.tcl\ + -createdir 1\ + -overwrite installedsourcechanged-targets\ + -punkcheck-folder $sourcefolder/vfs\ + -progresschannel stdout\ + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } + } + } +} + if {$::punkboot::command in {project packages libs}} { ######################################################## lappend projectlibfolders lib diff --git a/src/project_layouts/custom/_project/punk.basic/src/make.tcl b/src/project_layouts/custom/_project/punk.basic/src/make.tcl index 8600aae7..eead4196 100644 --- a/src/project_layouts/custom/_project/punk.basic/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.basic/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] + variable known_commands [list project modules libs packages vfs vfslibs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -1348,6 +1348,10 @@ proc ::punkboot::punkboot_gethelp {args} { append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n + append h " $scriptname vfslibs" \n + append h " - propagate declared vendored platform-library packages into kit vfs lib_tcl trees" \n + append h " - declarations (per-package per-kit, with superseded-version removal) live in src/runtime/vendorlib_vfs.toml" \n + append h " - also runs automatically as part of '$scriptname project'" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -2353,7 +2357,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules libs packages vfs bin}} { +if {$::punkboot::command ni {project modules libs packages vfs vfslibs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -2475,6 +2479,97 @@ if {$::punkboot::command in {project packages libs}} { } } +if {$::punkboot::command in {project vfslibs}} { + #G-037: propagate declared vendored platform-library packages into kit vfs lib_tcl trees. + #Participation is per-package per-kit (kit vfs package sets intentionally differ - e.g. twapi + #versions vary per kit) - declared in src/runtime/vendorlib_vfs.toml, never blanket-copied. + #punkcheck records live at src/vfs/.punkcheck so they are not baked into kit payloads. + set vfslibs_config $sourcefolder/runtime/vendorlib_vfs.toml + if {![file exists $vfslibs_config]} { + puts stdout "VFSLIBS: no config at $vfslibs_config - skipping vendorlib -> kit vfs propagation" + } else { + if {[catch {package require tomlish} tomlish_err]} { + puts stderr "$A(BAD)VFSLIBS: cannot process $vfslibs_config - tomlish package unavailable ($tomlish_err)$A(RST)" + exit 3 + } + set fd [open $vfslibs_config r] + fconfigure $fd -encoding utf-8 + set vfslibs_tomldata [read $fd] + close $fd + if {[catch {tomlish::to_dict [tomlish::from_toml $vfslibs_tomldata]} vfslibs_dict]} { + puts stderr "$A(BAD)VFSLIBS: failed to parse $vfslibs_config\n$vfslibs_dict$A(RST)" + exit 3 + } + #tomlish::to_dict values are type-tagged (e.g {type STRING value x}, {type ARRAY value {...}}) + proc ::punkboot::lib::toml_untag {tagged} { + if {[dict get $tagged type] eq "ARRAY"} { + set plain [list] + foreach el [dict get $tagged value] { + lappend plain [::punkboot::lib::toml_untag $el] + } + return $plain + } + return [dict get $tagged value] + } + set vfslibs_installs [dict create] + if {[dict exists $vfslibs_dict install]} { + set vfslibs_installs [dict get $vfslibs_dict install] + } + if {![dict size $vfslibs_installs]} { + puts stdout "VFSLIBS: no \[install.\] entries found in $vfslibs_config" + } + dict for {iname ientry} $vfslibs_installs { + foreach reqkey {source targets} { + if {![dict exists $ientry $reqkey]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname in $vfslibs_config is missing required key '$reqkey'$A(RST)" + exit 3 + } + } + set isource [punkboot::lib::toml_untag [dict get $ientry source]] + set itargets [punkboot::lib::toml_untag [dict get $ientry targets]] + set isupersedes [list] + if {[dict exists $ientry supersedes]} { + set isupersedes [punkboot::lib::toml_untag [dict get $ientry supersedes]] + } + set source_pkg_folder $sourcefolder/$isource + if {![file isdirectory $source_pkg_folder]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname source '$isource' not found at $source_pkg_folder$A(RST)" + exit 3 + } + set pkgtail [file tail $source_pkg_folder] + foreach t $itargets { + set target_vfs_dir [lindex [file split $t] 0] + if {![file isdirectory $sourcefolder/vfs/$target_vfs_dir]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname target '$t' - no vfs folder at $sourcefolder/vfs/$target_vfs_dir$A(RST)" + exit 3 + } + set target_lib_folder $sourcefolder/vfs/$t + file mkdir $target_lib_folder + #supersession first - no silent mixed-version provision (G-035 concerns) + foreach sup $isupersedes { + if {$sup eq $pkgtail} { + continue ;#never remove what we are about to install + } + set suppath $target_lib_folder/$sup + if {[file exists $suppath]} { + puts stdout "VFSLIBS install.$iname: removing superseded '$sup' from vfs/$t" + file delete -force $suppath + } + } + puts stdout "VFSLIBS install.$iname: $isource -> vfs/$t/$pkgtail (if source file changed)" + set resultdict [punkcheck::install $source_pkg_folder $target_lib_folder/$pkgtail\ + -installer make.tcl\ + -createdir 1\ + -overwrite installedsourcechanged-targets\ + -punkcheck-folder $sourcefolder/vfs\ + -progresschannel stdout\ + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } + } + } +} + if {$::punkboot::command in {project packages libs}} { ######################################################## lappend projectlibfolders lib diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.2.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.2.1.tm similarity index 99% rename from src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.2.0.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.2.1.tm index a8086722..a167b7f4 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.2.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.2.1.tm @@ -8570,7 +8570,7 @@ namespace eval punk { punk::args::define { @id -id ::punk::helptopic::tcl - @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter (as detected by the punk::lib::check::has_tclbug_* checks)." + @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter and known bugs in bundled library packages (as detected by the punk::lib::check::has_tclbug_* and has_libbug_* checks)." @values -min 0 -max 0 } proc tcl {context args} { @@ -8580,8 +8580,12 @@ namespace eval punk { catch { append text \n "Tcl build-info: [::tcl::build-info]" } - #generate warningblocks for each triggered Tcl bug in namespace ::punk::lib::check - set bugcheck_procs [info procs ::punk::lib::check::has_tclbug*] + #generate warningblocks for each triggered bug check in namespace ::punk::lib::check + #has_tclbug_* = Tcl core bugs; has_libbug_* = bundled/vendored library bugs (e.g. tcludp - G-036) + set bugcheck_procs [concat\ + [info procs ::punk::lib::check::has_tclbug*]\ + [info procs ::punk::lib::check::has_libbug*]\ + ] foreach bp $bugcheck_procs { set buginfo [$bp] if {[dict get $buginfo bug]} { @@ -8595,12 +8599,15 @@ namespace eval punk { major {set highlight [punk::ansi::a+ red bold]} default {set highlight ""} } + set indent " " append warningblock \n $highlight "warning level: $level $bp triggered." if {[dict exists $buginfo description]} { - set indent " " append warningblock \n "[punk::lib::indent [dict get $buginfo description] $indent]" } - if {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { + if {[dict exists $buginfo url] && [dict get $buginfo url] ne ""} { + #full reference url (e.g. non tcl-core trackers such as tcludp) + append warningblock \n "${indent}see [punk::ansi::hyperlink [dict get $buginfo url]]" + } elseif {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { set bugref [dict get $buginfo bugref] append warningblock \n "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/$bugref]" } @@ -9350,7 +9357,7 @@ punkcheck::cli set_alias punkcheck package provide punk [namespace eval punk { #FUNCTL variable version - set version 0.2.0 + set version 0.2.1 }] diff --git a/src/bootsupport/modules/punk/lib-0.2.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.3.0.tm similarity index 99% rename from src/bootsupport/modules/punk/lib-0.2.1.tm rename to src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.3.0.tm index 27aa0795..09da6c9a 100644 --- a/src/bootsupport/modules/punk/lib-0.2.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.3.0.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::lib 0.2.1 +# Application punk::lib 0.3.0 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::lib 0 0.2.1] +#[manpage_begin punkshell_module_punk::lib 0 0.3.0] #[copyright "2024"] #[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}] #[moddesc {punk library}] [comment {-- Description at end of page heading --}] @@ -250,6 +250,56 @@ tcl::namespace::eval punk::lib::check { return [dict create bug $bug bugref e38dc74e2 description $description level medium] } + #has_libbug_* procs report bugs in bundled/vendored library packages rather than the Tcl core. + #They are surfaced through the same 'help tcl' warning report as the has_tclbug_* checks. + + #pure classifier, separated for testability - facts in, verdict out + proc libbug_udp_threadexit_applies {udpversion platform tclversion} { + if {$udpversion eq ""} { + return 0 ;#no udp package known - nothing vulnerable to load + } + if {$platform ne "windows"} { + return 0 + } + if {![package vsatisfies $tclversion 9]} { + #tcl 8.6 exhibited apparent immunity in the G-036 investigation (unexplained - see goal detail) + #detection deliberately scoped to Tcl 9 per G-036 acceptance + return 0 + } + return [expr {[package vcompare $udpversion 1.0.13] < 0}] + } + proc has_libbug_udp_threadexit {} { + #tcludp <= 1.0.12 on Windows: the per-thread exit handler UDP_ExitProc closes the + #PROCESS-GLOBAL sockListLock/waitForSock event handles. The first udp-loaded thread to + #exit corrupts the lock for every other udp-loaded thread - their event loops block + #forever in WaitForSingleObject on a dead or recycled handle (timers and thread::send + #unserviced). In punkshell the visible casualty is syslog log workers silently freezing + #(the original exit/quit hang this caused is separately mitigated). Root-caused + #2026-07-08 - see goal G-036 detail. Fixed upstream in tcludp 1.0.13 (per-thread + #UdpThreadExitProc deletes only the event source; ExitSockets closes the events at + #process exit). + #Version-based detection only (per G-036 acceptance) - no behavioural probe. + set udpversion [package provide udp] + if {$udpversion eq ""} { + #not loaded - determine what version would be provided, without loading the binary: + #an unsatisfiable require triggers the package unknown scan (registering ifneeded + #scripts) then fails before any dll load. + catch {package require udp 999999} + set available [package versions udp] + if {[llength $available]} { + set udpversion [lindex [lsort -command {package vcompare} $available] end] + } + } + set bug [libbug_udp_threadexit_applies $udpversion $::tcl_platform(platform) [package provide Tcl]] + if {$udpversion eq ""} { + set verinfo "no udp package found" + } else { + set verinfo "udp $udpversion" + } + set description "tcludp < 1.0.13 on Tcl 9 Windows ($verinfo): the udp package's per-thread exit\nhandler closes process-global event handles - after any udp-using thread exits, every\nother udp-using thread's event loop can freeze silently (e.g. syslog log workers stop).\nUpgrade the bundled/available udp package to 1.0.13+ (see goal G-036)." + return [dict create bug $bug bugref "" url https://core.tcl-lang.org/tcludp description $description level medium libversion $udpversion] + } + proc has_tclbug_safeinterp_compile {{show 0}} { #ensemble calls within safe interp not compiled #https://core.tcl-lang.org/tcl/tktview/1095bf7f756f9aed6bde @@ -9069,7 +9119,7 @@ namespace eval ::punk::args::register { package provide punk::lib [tcl::namespace::eval punk::lib { variable pkg punk::lib variable version - set version 0.2.1 + set version 0.3.0 }] return diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl index 8600aae7..eead4196 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] + variable known_commands [list project modules libs packages vfs vfslibs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -1348,6 +1348,10 @@ proc ::punkboot::punkboot_gethelp {args} { append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n + append h " $scriptname vfslibs" \n + append h " - propagate declared vendored platform-library packages into kit vfs lib_tcl trees" \n + append h " - declarations (per-package per-kit, with superseded-version removal) live in src/runtime/vendorlib_vfs.toml" \n + append h " - also runs automatically as part of '$scriptname project'" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -2353,7 +2357,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules libs packages vfs bin}} { +if {$::punkboot::command ni {project modules libs packages vfs vfslibs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -2475,6 +2479,97 @@ if {$::punkboot::command in {project packages libs}} { } } +if {$::punkboot::command in {project vfslibs}} { + #G-037: propagate declared vendored platform-library packages into kit vfs lib_tcl trees. + #Participation is per-package per-kit (kit vfs package sets intentionally differ - e.g. twapi + #versions vary per kit) - declared in src/runtime/vendorlib_vfs.toml, never blanket-copied. + #punkcheck records live at src/vfs/.punkcheck so they are not baked into kit payloads. + set vfslibs_config $sourcefolder/runtime/vendorlib_vfs.toml + if {![file exists $vfslibs_config]} { + puts stdout "VFSLIBS: no config at $vfslibs_config - skipping vendorlib -> kit vfs propagation" + } else { + if {[catch {package require tomlish} tomlish_err]} { + puts stderr "$A(BAD)VFSLIBS: cannot process $vfslibs_config - tomlish package unavailable ($tomlish_err)$A(RST)" + exit 3 + } + set fd [open $vfslibs_config r] + fconfigure $fd -encoding utf-8 + set vfslibs_tomldata [read $fd] + close $fd + if {[catch {tomlish::to_dict [tomlish::from_toml $vfslibs_tomldata]} vfslibs_dict]} { + puts stderr "$A(BAD)VFSLIBS: failed to parse $vfslibs_config\n$vfslibs_dict$A(RST)" + exit 3 + } + #tomlish::to_dict values are type-tagged (e.g {type STRING value x}, {type ARRAY value {...}}) + proc ::punkboot::lib::toml_untag {tagged} { + if {[dict get $tagged type] eq "ARRAY"} { + set plain [list] + foreach el [dict get $tagged value] { + lappend plain [::punkboot::lib::toml_untag $el] + } + return $plain + } + return [dict get $tagged value] + } + set vfslibs_installs [dict create] + if {[dict exists $vfslibs_dict install]} { + set vfslibs_installs [dict get $vfslibs_dict install] + } + if {![dict size $vfslibs_installs]} { + puts stdout "VFSLIBS: no \[install.\] entries found in $vfslibs_config" + } + dict for {iname ientry} $vfslibs_installs { + foreach reqkey {source targets} { + if {![dict exists $ientry $reqkey]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname in $vfslibs_config is missing required key '$reqkey'$A(RST)" + exit 3 + } + } + set isource [punkboot::lib::toml_untag [dict get $ientry source]] + set itargets [punkboot::lib::toml_untag [dict get $ientry targets]] + set isupersedes [list] + if {[dict exists $ientry supersedes]} { + set isupersedes [punkboot::lib::toml_untag [dict get $ientry supersedes]] + } + set source_pkg_folder $sourcefolder/$isource + if {![file isdirectory $source_pkg_folder]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname source '$isource' not found at $source_pkg_folder$A(RST)" + exit 3 + } + set pkgtail [file tail $source_pkg_folder] + foreach t $itargets { + set target_vfs_dir [lindex [file split $t] 0] + if {![file isdirectory $sourcefolder/vfs/$target_vfs_dir]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname target '$t' - no vfs folder at $sourcefolder/vfs/$target_vfs_dir$A(RST)" + exit 3 + } + set target_lib_folder $sourcefolder/vfs/$t + file mkdir $target_lib_folder + #supersession first - no silent mixed-version provision (G-035 concerns) + foreach sup $isupersedes { + if {$sup eq $pkgtail} { + continue ;#never remove what we are about to install + } + set suppath $target_lib_folder/$sup + if {[file exists $suppath]} { + puts stdout "VFSLIBS install.$iname: removing superseded '$sup' from vfs/$t" + file delete -force $suppath + } + } + puts stdout "VFSLIBS install.$iname: $isource -> vfs/$t/$pkgtail (if source file changed)" + set resultdict [punkcheck::install $source_pkg_folder $target_lib_folder/$pkgtail\ + -installer make.tcl\ + -createdir 1\ + -overwrite installedsourcechanged-targets\ + -punkcheck-folder $sourcefolder/vfs\ + -progresschannel stdout\ + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } + } + } +} + if {$::punkboot::command in {project packages libs}} { ######################################################## lappend projectlibfolders lib diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.2.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.2.1.tm similarity index 99% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.2.0.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.2.1.tm index a8086722..a167b7f4 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk-0.2.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk-0.2.1.tm @@ -8570,7 +8570,7 @@ namespace eval punk { punk::args::define { @id -id ::punk::helptopic::tcl - @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter (as detected by the punk::lib::check::has_tclbug_* checks)." + @cmd -name "help tcl" -summary "Tcl version warnings." -help "Show the running Tcl patchlevel and build-info, with warnings for known Tcl bugs affecting this interpreter and known bugs in bundled library packages (as detected by the punk::lib::check::has_tclbug_* and has_libbug_* checks)." @values -min 0 -max 0 } proc tcl {context args} { @@ -8580,8 +8580,12 @@ namespace eval punk { catch { append text \n "Tcl build-info: [::tcl::build-info]" } - #generate warningblocks for each triggered Tcl bug in namespace ::punk::lib::check - set bugcheck_procs [info procs ::punk::lib::check::has_tclbug*] + #generate warningblocks for each triggered bug check in namespace ::punk::lib::check + #has_tclbug_* = Tcl core bugs; has_libbug_* = bundled/vendored library bugs (e.g. tcludp - G-036) + set bugcheck_procs [concat\ + [info procs ::punk::lib::check::has_tclbug*]\ + [info procs ::punk::lib::check::has_libbug*]\ + ] foreach bp $bugcheck_procs { set buginfo [$bp] if {[dict get $buginfo bug]} { @@ -8595,12 +8599,15 @@ namespace eval punk { major {set highlight [punk::ansi::a+ red bold]} default {set highlight ""} } + set indent " " append warningblock \n $highlight "warning level: $level $bp triggered." if {[dict exists $buginfo description]} { - set indent " " append warningblock \n "[punk::lib::indent [dict get $buginfo description] $indent]" } - if {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { + if {[dict exists $buginfo url] && [dict get $buginfo url] ne ""} { + #full reference url (e.g. non tcl-core trackers such as tcludp) + append warningblock \n "${indent}see [punk::ansi::hyperlink [dict get $buginfo url]]" + } elseif {[dict exists $buginfo bugref] && [dict get $buginfo bugref] ne ""} { set bugref [dict get $buginfo bugref] append warningblock \n "${indent}see [punk::ansi::hyperlink https://core.tcl-lang.org/tcl/tktview/$bugref]" } @@ -9350,7 +9357,7 @@ punkcheck::cli set_alias punkcheck package provide punk [namespace eval punk { #FUNCTL variable version - set version 0.2.0 + set version 0.2.1 }] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.2.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.3.0.tm similarity index 99% rename from src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.2.1.tm rename to src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.3.0.tm index 27aa0795..09da6c9a 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.2.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.3.0.tm @@ -8,7 +8,7 @@ # (C) 2024 # # @@ Meta Begin -# Application punk::lib 0.2.1 +# Application punk::lib 0.3.0 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::lib 0 0.2.1] +#[manpage_begin punkshell_module_punk::lib 0 0.3.0] #[copyright "2024"] #[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}] #[moddesc {punk library}] [comment {-- Description at end of page heading --}] @@ -250,6 +250,56 @@ tcl::namespace::eval punk::lib::check { return [dict create bug $bug bugref e38dc74e2 description $description level medium] } + #has_libbug_* procs report bugs in bundled/vendored library packages rather than the Tcl core. + #They are surfaced through the same 'help tcl' warning report as the has_tclbug_* checks. + + #pure classifier, separated for testability - facts in, verdict out + proc libbug_udp_threadexit_applies {udpversion platform tclversion} { + if {$udpversion eq ""} { + return 0 ;#no udp package known - nothing vulnerable to load + } + if {$platform ne "windows"} { + return 0 + } + if {![package vsatisfies $tclversion 9]} { + #tcl 8.6 exhibited apparent immunity in the G-036 investigation (unexplained - see goal detail) + #detection deliberately scoped to Tcl 9 per G-036 acceptance + return 0 + } + return [expr {[package vcompare $udpversion 1.0.13] < 0}] + } + proc has_libbug_udp_threadexit {} { + #tcludp <= 1.0.12 on Windows: the per-thread exit handler UDP_ExitProc closes the + #PROCESS-GLOBAL sockListLock/waitForSock event handles. The first udp-loaded thread to + #exit corrupts the lock for every other udp-loaded thread - their event loops block + #forever in WaitForSingleObject on a dead or recycled handle (timers and thread::send + #unserviced). In punkshell the visible casualty is syslog log workers silently freezing + #(the original exit/quit hang this caused is separately mitigated). Root-caused + #2026-07-08 - see goal G-036 detail. Fixed upstream in tcludp 1.0.13 (per-thread + #UdpThreadExitProc deletes only the event source; ExitSockets closes the events at + #process exit). + #Version-based detection only (per G-036 acceptance) - no behavioural probe. + set udpversion [package provide udp] + if {$udpversion eq ""} { + #not loaded - determine what version would be provided, without loading the binary: + #an unsatisfiable require triggers the package unknown scan (registering ifneeded + #scripts) then fails before any dll load. + catch {package require udp 999999} + set available [package versions udp] + if {[llength $available]} { + set udpversion [lindex [lsort -command {package vcompare} $available] end] + } + } + set bug [libbug_udp_threadexit_applies $udpversion $::tcl_platform(platform) [package provide Tcl]] + if {$udpversion eq ""} { + set verinfo "no udp package found" + } else { + set verinfo "udp $udpversion" + } + set description "tcludp < 1.0.13 on Tcl 9 Windows ($verinfo): the udp package's per-thread exit\nhandler closes process-global event handles - after any udp-using thread exits, every\nother udp-using thread's event loop can freeze silently (e.g. syslog log workers stop).\nUpgrade the bundled/available udp package to 1.0.13+ (see goal G-036)." + return [dict create bug $bug bugref "" url https://core.tcl-lang.org/tcludp description $description level medium libversion $udpversion] + } + proc has_tclbug_safeinterp_compile {{show 0}} { #ensemble calls within safe interp not compiled #https://core.tcl-lang.org/tcl/tktview/1095bf7f756f9aed6bde @@ -9069,7 +9119,7 @@ namespace eval ::punk::args::register { package provide punk::lib [tcl::namespace::eval punk::lib { variable pkg punk::lib variable version - set version 0.2.1 + set version 0.3.0 }] return diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl index 8600aae7..eead4196 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] + variable known_commands [list project modules libs packages vfs vfslibs bin info check shell vendorupdate bootsupport vfscommonupdate projectversion] } @@ -1348,6 +1348,10 @@ proc ::punkboot::punkboot_gethelp {args} { append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n + append h " $scriptname vfslibs" \n + append h " - propagate declared vendored platform-library packages into kit vfs lib_tcl trees" \n + append h " - declarations (per-package per-kit, with superseded-version removal) live in src/runtime/vendorlib_vfs.toml" \n + append h " - also runs automatically as part of '$scriptname project'" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -2353,7 +2357,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules libs packages vfs bin}} { +if {$::punkboot::command ni {project modules libs packages vfs vfslibs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -2475,6 +2479,97 @@ if {$::punkboot::command in {project packages libs}} { } } +if {$::punkboot::command in {project vfslibs}} { + #G-037: propagate declared vendored platform-library packages into kit vfs lib_tcl trees. + #Participation is per-package per-kit (kit vfs package sets intentionally differ - e.g. twapi + #versions vary per kit) - declared in src/runtime/vendorlib_vfs.toml, never blanket-copied. + #punkcheck records live at src/vfs/.punkcheck so they are not baked into kit payloads. + set vfslibs_config $sourcefolder/runtime/vendorlib_vfs.toml + if {![file exists $vfslibs_config]} { + puts stdout "VFSLIBS: no config at $vfslibs_config - skipping vendorlib -> kit vfs propagation" + } else { + if {[catch {package require tomlish} tomlish_err]} { + puts stderr "$A(BAD)VFSLIBS: cannot process $vfslibs_config - tomlish package unavailable ($tomlish_err)$A(RST)" + exit 3 + } + set fd [open $vfslibs_config r] + fconfigure $fd -encoding utf-8 + set vfslibs_tomldata [read $fd] + close $fd + if {[catch {tomlish::to_dict [tomlish::from_toml $vfslibs_tomldata]} vfslibs_dict]} { + puts stderr "$A(BAD)VFSLIBS: failed to parse $vfslibs_config\n$vfslibs_dict$A(RST)" + exit 3 + } + #tomlish::to_dict values are type-tagged (e.g {type STRING value x}, {type ARRAY value {...}}) + proc ::punkboot::lib::toml_untag {tagged} { + if {[dict get $tagged type] eq "ARRAY"} { + set plain [list] + foreach el [dict get $tagged value] { + lappend plain [::punkboot::lib::toml_untag $el] + } + return $plain + } + return [dict get $tagged value] + } + set vfslibs_installs [dict create] + if {[dict exists $vfslibs_dict install]} { + set vfslibs_installs [dict get $vfslibs_dict install] + } + if {![dict size $vfslibs_installs]} { + puts stdout "VFSLIBS: no \[install.\] entries found in $vfslibs_config" + } + dict for {iname ientry} $vfslibs_installs { + foreach reqkey {source targets} { + if {![dict exists $ientry $reqkey]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname in $vfslibs_config is missing required key '$reqkey'$A(RST)" + exit 3 + } + } + set isource [punkboot::lib::toml_untag [dict get $ientry source]] + set itargets [punkboot::lib::toml_untag [dict get $ientry targets]] + set isupersedes [list] + if {[dict exists $ientry supersedes]} { + set isupersedes [punkboot::lib::toml_untag [dict get $ientry supersedes]] + } + set source_pkg_folder $sourcefolder/$isource + if {![file isdirectory $source_pkg_folder]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname source '$isource' not found at $source_pkg_folder$A(RST)" + exit 3 + } + set pkgtail [file tail $source_pkg_folder] + foreach t $itargets { + set target_vfs_dir [lindex [file split $t] 0] + if {![file isdirectory $sourcefolder/vfs/$target_vfs_dir]} { + puts stderr "$A(BAD)VFSLIBS: entry install.$iname target '$t' - no vfs folder at $sourcefolder/vfs/$target_vfs_dir$A(RST)" + exit 3 + } + set target_lib_folder $sourcefolder/vfs/$t + file mkdir $target_lib_folder + #supersession first - no silent mixed-version provision (G-035 concerns) + foreach sup $isupersedes { + if {$sup eq $pkgtail} { + continue ;#never remove what we are about to install + } + set suppath $target_lib_folder/$sup + if {[file exists $suppath]} { + puts stdout "VFSLIBS install.$iname: removing superseded '$sup' from vfs/$t" + file delete -force $suppath + } + } + puts stdout "VFSLIBS install.$iname: $isource -> vfs/$t/$pkgtail (if source file changed)" + set resultdict [punkcheck::install $source_pkg_folder $target_lib_folder/$pkgtail\ + -installer make.tcl\ + -createdir 1\ + -overwrite installedsourcechanged-targets\ + -punkcheck-folder $sourcefolder/vfs\ + -progresschannel stdout\ + ] + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + } + } + } +} + if {$::punkboot::command in {project packages libs}} { ######################################################## lappend projectlibfolders lib diff --git a/src/runtime/vendorlib_vfs.toml b/src/runtime/vendorlib_vfs.toml new file mode 100644 index 00000000..a079ff3d --- /dev/null +++ b/src/runtime/vendorlib_vfs.toml @@ -0,0 +1,32 @@ +# vendorlib -> kit vfs platform-library propagation (goal G-037) +# +# Declares which vendored platform-library package folders (paths relative to src/) are +# installed into which kit vfs lib trees (paths relative to src/vfs/). Processed by +# 'tclsh src/make.tcl vfslibs' - and automatically as part of 'tclsh src/make.tcl project' - +# with punkcheck-tracked provenance (records in src/vfs/.punkcheck, outside kit payloads). +# +# Participation is per-package per-kit by design: kit vfs package sets intentionally differ +# (e.g. twapi versions vary per kit), so nothing is blanket-copied and a vendorlib drop does +# not force a package into every kit. +# +# Cross-generation installs are allowed when the package supports both Tcl major versions +# (e.g. tcludp 1.0.13 ships tcl9udp1013.dll + udp1013t.dll with a pkgIndex.tcl that selects +# by generation - so the same source folder serves lib_tcl9 and lib_tcl8 targets). +# +# Keys per [install.] entry: +# source - package folder path relative to src/ +# targets - list of kit vfs lib folders relative to src/vfs/ +# supersedes - optional list of legacy/older package folder names to remove from each +# target before install (explicit - no silent mixed-version provision, per +# the G-035 concerns) +# +# This file is a candidate for absorption into the mapvfs toml conversion (goal G-024). + +[install.tcludp] +source = "vendorlib_tcl9/win32-x86_64/tcludp1.0.13" +targets = [ + "punk9win.vfs/lib_tcl9", + "punk9win_for_tkruntime.vfs/lib_tcl9", + "punk8win.vfs/lib_tcl8", +] +supersedes = ["udp1.0.12", "tcludp1.0.12"] diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/broadcast.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/broadcast.tcl new file mode 100644 index 00000000..e4c1bfbc --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/broadcast.tcl @@ -0,0 +1,39 @@ +#!/usr/bin/env tclsh +# multicast.tcl - Copyright (C) 2004 Pat Thoyts +# +# Demonstrate the use of broadcast UDP sockets. +# +# You can send to ths using netcat: +# echo HELLO | nc -u 192.168.255.255 7772 +# +# $Id: broadcast.tcl,v 1.1 2004/11/22 23:48:47 patthoyts Exp $ + +package require udp 1.0.6 + +proc udpEvent {chan} { + set data [read $chan] + set peer [fconfigure $chan -peer] + puts "$peer [string length $data] '$data'" + if {[string match "QUIT*" $data]} { + close $chan + set ::forever 1 + } + return +} + +# Select a subnet and the port number. +set subnet 192.168.255.255 +set port 7772 + +# Create a listening socket and configure for sending too. +set s [udp_open $port] +fconfigure $s -buffering none -blocking 0 +fconfigure $s -broadcast 1 -remote [list $subnet $port] +fileevent $s readable [list udpEvent $s] + +# Announce our presence and run +puts -nonewline $s "hello, world" +set forever 0 +vwait ::forever + +exit diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/bug1158628.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/bug1158628.tcl new file mode 100644 index 00000000..be3c2c5f --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/bug1158628.tcl @@ -0,0 +1,56 @@ +#!/usr/bin/env tclsh +# bug1158628.tcl - Copyright (C) 2005 Pat Thoyts +# +# "On windows XP, I have a GUI that has an exit buttons which when +# pressed does: {set done 1; destroy .;exit} If there is an open UDP +# channel with a fileevent on it, the program will not exit -- +# i.e. task manager still shows it. Also if I have the console up, the +# console goes away when the exit button is invoked, but the program +# does not exit. NOTE -- all windows are correctly destroyed (or at +# least withdrawn)" +# +# The fault is calling Tcl_UnregisterChannel in the udpClose function. +# We must let tcl handle this itself. Solved by Reinhard Max. +# +# This script demonstrates the problem. Using udp 1.0.6 the program hangs +# after printing "Exiting...". With the fix applied it properly exits. +# +# $Id: bug1158628.tcl,v 1.2 2005/05/19 20:46:23 patthoyts Exp $ + +#load [file join [file dirname [info script]] .. win Release udp107.dll] +#load [file join [file dirname [info script]] .. i386-unknown-openbsd3.6 libudp107.so] +package require udp + +variable forever 0 + +proc Event {sock} { + variable forever + set pkt [read $sock] + set peer [fconfigure $sock -peer] + puts "Recieved [string length $pkt] from $peer\n$pkt" + #set forever 1 + return +} + +proc Listen {port} { + set s [udp_open $port] + fconfigure $s -blocking 0 -buffering none -translation binary + fileevent $s readable [list Event $s] + return $s +} + +proc Exit {sock} { + puts "Exiting" + exit 0 +} + +if {!$tcl_interactive} { + puts "Bug #1158628 - hangs in exit if open udp channels" + puts " Using a buggy version, this will hang after printing Exiting..." + puts "" + set sock [Listen 10245] + puts "Wait 1 sec..." + after 1000 [list Exit $sock] + vwait forever + close $sock +} diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/chat.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/chat.tcl new file mode 100644 index 00000000..3cd65509 --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/chat.tcl @@ -0,0 +1,81 @@ +#!/usr/bin/env tclsh +# chat.tcl - Copyright (C) 2004 Pat Thoyts +# +# This is a sample application from TclUDP. +# +# This illustrates the use of multicast UDP messages to implement a +# primitive chat application. +# +# $Id: chat.tcl,v 1.2 2007/04/10 23:36:14 patthoyts Exp $ + +package require Tk 8.4- +package require udp 1.0.6 + +variable Address 224.5.1.21 +variable Port 7771 + +proc Receive {sock} { + set pkt [read $sock] + set peer [fconfigure $sock -peer] + AddMessage $peer $pkt + return +} + +proc Start {addr port} { + set s [udp_open $port] + fconfigure $s -blocking 0 -buffering none -translation binary \ + -mcastadd $addr -remote [list $addr $port] + fileevent $s readable [list ::Receive $s] + return $s +} + +proc CreateGui {socket} { + text .t -yscrollcommand {.s set} + scrollbar .s -command {.t yview} + frame .f -border 0 + entry .f.e -textvariable ::_msg + button .f.ok -text Send -underline 0 \ + -command "SendMessage $socket \$::_msg" + button .f.ex -text Exit -underline 1 -command {destroy .} + pack .f.ex .f.ok -side right + pack .f.e -side left -expand 1 -fill x + grid .t .s -sticky news + grid .f - -sticky ew + grid columnconfigure . 0 -weight 1 + grid rowconfigure . 0 -weight 1 + bind .f.e {.f.ok invoke} + .t tag configure CLNT -foreground red + .t configure -tabs {90} +} + +proc SendMessage {sock msg} { + puts -nonewline $sock $msg +} + +proc AddMessage {client msg} { + set msg [string map [list "\r\n" "" "\r" "" "\n" ""] $msg] + set client [lindex $client 0] + if {[string length $msg] > 0} { + .t insert end "$client\t" CLNT "$msg\n" MSG + .t see end + } +} + +proc Main {} { + variable Address + variable Port + variable sock + set sock [Start $Address $Port] + CreateGui $sock + after idle [list SendMessage $sock \ + "$::tcl_platform(user)@[info hostname] connected"] + tkwait window . + close $sock +} + +if {!$tcl_interactive} { + set r [catch [linsert $argv 0 Main] err] + if {$r} {puts $::errorInfo} else {puts $err} + exit 0 +} + diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/multicast.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/multicast.tcl new file mode 100644 index 00000000..b0de2ebc --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/multicast.tcl @@ -0,0 +1,45 @@ +#!/usr/bin/env tclsh +# multicast.tcl - Copyright (C) 2004 Pat Thoyts +# +# Demonstrate the use of IPv4 multicast UDP sockets. +# +# You can send to ths using netcat: +# echo HELLO | nc -u 224.5.1.21 7771 +# +# $Id: multicast.tcl,v 1.3 2007/04/10 23:49:38 patthoyts Exp $ + +package require udp 1.0.6 + +proc udpEvent {chan} { + set data [read $chan] + set peer [fconfigure $chan -peer] + set group [lindex [fconfigure $chan -remote] 0] + puts "$peer ($group) [string length $data] '$data' {[fconfigure $chan]}" + if {[string match "QUIT*" $data]} { + close $chan + set ::forever 1 + } + return +} + +# Select a multicast group and the port number. +# +# We have two groups here to show that it's possible. +# +set group1 224.5.1.21 +set group2 224.5.2.21 +set port 7771 + +# Create a listening socket and configure for sending too. +set s [udp_open $port] +fconfigure $s -buffering none -blocking 0 +fconfigure $s -mcastadd $group2 -remote [list $group2 $port] +fconfigure $s -mcastadd $group1 -remote [list $group1 $port] +fileevent $s readable [list udpEvent $s] + +# Announce our presence and run +puts -nonewline $s "hello, world" +set forever 0 +vwait ::forever + +exit diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/udpcat.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/udpcat.tcl new file mode 100644 index 00000000..284aec67 --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/demos/udpcat.tcl @@ -0,0 +1,65 @@ +#!/usr/bin/env tclsh +# udpsend.tcl - Copyright (C) 2004 Pat Thoyts +# +# Demo application - cat data from stdin via a UDP socket. +# +# $Id: udpcat.tcl,v 1.1 2004/11/22 23:48:47 patthoyts Exp $ + +package require udp 1.0.6 + +proc Event {sock} { + global forever + set pkt [read $sock] + set peer [fconfigure $sock -peer] + puts "Received [string length $pkt] from $peer\n$pkt" + set forever 1 + return +} + +proc Send {host port {msg {}}} { + set s [udp_open] + fconfigure $s -blocking 0 -buffering none -translation binary \ + -remote [list $host $port] + fileevent $s readable [list Event $s] + if {$msg eq {}} { + fcopy stdin $s + } else { + puts -nonewline $s $msg + } + + after 2000 + close $s +} + +proc Listen {port} { + set s [udp_open $port] + fconfigure $s -blocking 0 -buffering none -translation binary + fileevent $s readable [list Event $s] + return $s +} + +# ------------------------------------------------------------------------- +# Runtime +# udpsend listen -port N -blocking 0 +# udpsend send host port message +# ------------------------------------------------------------------------- +set forever 0 + +if {! $tcl_interactive} { + switch -exact -- [set cmd [lindex $argv 0]] { + send { + eval [list Send] [lrange $argv 1 end] + } + listen { + set s [Listen [lindex $argv 1]] + vwait ::forever + close $s + } + default { + puts "usage: udpcat send host port ?message?\ + \n udpcat listen port" + } + } +} + + diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/pkgIndex.tcl b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/pkgIndex.tcl new file mode 100644 index 00000000..ba2ae7e1 --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/pkgIndex.tcl @@ -0,0 +1,33 @@ +# -*- tcl -*- +# Tcl package index file, version 1.1 +# +if {[package vsatisfies [package provide Tcl] 9.0-]} { + package ifneeded udp 1.0.13 [list apply {{dir} { + # Load library + load [file join $dir tcl9udp1013.dll] [string totitle udp] + + # Source init file + set initScript [file join $dir udp.tcl] + if {[file exists $initScript]} { + source -encoding utf-8 $initScript + } + }} $dir] +} else { + if {![package vsatisfies [package provide Tcl] 8.5]} {return} + package ifneeded udp 1.0.13 [list apply {{dir} { + # Load library + if {[string tolower [file extension udp1013t.dll]] in [list .dll .dylib .so]} { + # Load dynamic library + load [file join $dir udp1013t.dll] [string totitle udp] + } else { + # Static library + load {} [string totitle udp] + } + + # Source init file + set initScript [file join $dir udp.tcl] + if {[file exists $initScript]} { + source -encoding utf-8 $initScript + } + }} $dir] +} diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/tcl9udp1013.dll b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/tcl9udp1013.dll new file mode 100644 index 00000000..097011cc Binary files /dev/null and b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/tcl9udp1013.dll differ diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/udp.html b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/udp.html new file mode 100644 index 00000000..0366618f --- /dev/null +++ b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/udp.html @@ -0,0 +1,326 @@ + + + +udp - Tcl UDP extension + + + + + +
+

udp(n) 1.0.13 udp "Tcl UDP extension"

+

Name

+

udp - Create UDP sockets in Tcl

+
+ + +

Description

+

This package provides support for using UDP through Tcl. The package provides +a new channel type and attempts to permit the use of packet oriented UDP +over stream oriented Tcl channels. The package defined three commands but +udp_conf should be considered depreciated in favor of the standard +Tcl command fconfigure.

+
+

COMMANDS

+
+
udp_open ?localport? ?reuse? ?ipv6?
+

udp_open will open a UDP socket. If a localport is specified the UDP +socket will be opened on that port. Otherwise the system will choose a port +and the user can use the udp_conf command to obtain the port number +if required.

+

The following keywords can be used to specify options on the opened socket.

+
+
reuse
+

Using this keyword sets the SO_REUSEADDR socket option which permits multiple +sockets to be bound to the same address/port combination.

+
ipv6
+

By default a IPv4 socket is created. When keyword ipv6 is specified, an IPv6 +socket is opened.

+
+
udp_conf channel host port
+

Deprecated in favor of the standard Tcl fconfigure or +chan configure commands.

+

udp_conf in this configuration is used to specify the remote destination +for packets written to this channel. You must call this command before +writing data to the UDP socket.

+
udp_conf channel ?optionName? ?value? ?optionName value ...?
+

Deprecated in favor of the standard Tcl fconfigure or +chan configure commands.

+

In addition to being used to configure the remote host, the udp_conf +command is used to obtain information about the UDP socket. NOTE all these +options are now available using the standard Tcl fconfigure or +chan configure command.

+
+
-myport
+

Returns the local port number of the socket. Read-only option.

+
-remote ?address port?
+

Specifies or returns the remote hostname and port number. Can also be set using +udp_conf channel host port.

+
-peer
+

Returns the remote hostname and port number for the packet most recently +received by this socket. Read-only option.

+
-family
+

Returns whether socket is configured for IPv4 or IPv6. Read-only option.

+
-broadcast ?boolean?
+

Specifies or returns whether can listen and send on the broadcast address. For some systems +a flag must be set on the socket to use broadcast. This option is not permitted when +using IPv6, instead use multicast.

+
-ttl ?count?
+

The time-to-live is given as the number of router hops the packet may do. For +multicast packets this is important in specifying the distribution of the +packet. The system default for multicast is 1 which restricts the packet +to the local subnet. To permit packets to pass routers, you must increase the +ttl. A value of 31 should keep it within a site, while 255 is global.

+
-mcastadd groupaddr
+
+
-mcastadd "groupaddr netwif"
+
+
-mcastdrop groupaddr
+
+
-mcastdrop "groupaddr netwif"
+
+
-mcastgroups
+

tcludp sockets can support IPv4 and IPv6 multicast operations. To receive +multicast packets the application has to notify the operating system that +it should join a particular multicast group. For IPv4 these are specified as addresses +in the range 224.0.0.0 to 239.255.255.255.

+

When specifying only the groupaddr the system will determine the network interface to use. +Specifying the netwif will join a multicast group on a specific network interface. +This is useful on a multihomed system with multiple network interfaces. +On windows you must specify the network interface index. For other platforms the network +interface (e.g. 'eth0') name can be specified.

+

To view the current set of multicast groups for a channel use -mcastgroups

+
-mcastif
+

Returns which interface is used for outgoing multicast packets. UNIX only.

+
-mcastloop ?boolean?
+

With multicast udp the system can choose to receive packets that it has sent +or it can drop them. This is known as multicast loopback and can be controlled +using this option. By default the value is true and your application will receive +its own transmissions.

+
+
udp_peek channel ?buffersize?
+

Examine a packet without removing it from the buffer. Option buffersize specifies the +maximum buffer size. Value must be between 0 and 16.

+

This function is not available on windows.

+
::udp::build-info
+

Return information on the build environment.

+
::udp::getaddrinfo -hostname name ?optionName value ...?
+

Returns a list with info on the IP address matching the specified parameters. +Valid options are:

+
+
-hostname name
+

Specifies which IP address to use for lookup. Can use IP address or name. Required option.

+
-port number
+

Specifies which port number to use for lookup.

+
-service name
+

Specifies which well-known service (i.e. http, https, etc.) to use for port in lookup.

+
-ipv4
+

Only return IP v4 addresses.

+
-ipv6
+

Only return IP v6 addresses.

+
-server
+

Only return services for which hostname is a server.

+
-tcp
+

Only return TCP services.

+
-udp
+

Only return UDP services.

+
+
::udp::getnameinfo address ?ipv6?
+

::udp::getnameinfo will return the name(s) corresponding to IP +address address. With ipv6, address is an IPv6 address.

+
+
+

EXAMPLES

+
+# Send data to a remote UDP socket
+proc udp_puts {host port} {
+    set s [udp_open]
+    fconfigure $s -remote [list $host $port]
+    puts $s "Hello, World"
+    close $f
+}
+
+
+# A simple UDP server
+package require udp
+proc udpEventHandler {sock} {
+    set pkt [read $sock]
+    set peer [fconfigure $sock -peer]
+    puts "$peer: [string length $pkt] {$pkt}"
+    return
+}
+proc udp_listen {port} {
+    set srv [udp_open $port]
+    fconfigure $srv -buffering none -translation binary
+    fileevent $srv readable [list ::udpEventHandler $srv]
+    puts "Listening on udp port: [fconfigure $srv -myport]"
+    return $srv
+}
+set sock [udp_listen 53530]
+vwait forever
+close $sock
+
+
+# A multicast demo.
+proc udpEvent {chan} {
+    set data [read $chan]
+    set peer [fconfigure $chan -peer]
+    puts "$peer [string length $data] '$data'"
+    if {[string match "QUIT*" $data]} {
+        close $chan
+        set ::forever 1
+    }
+    return
+}
+set group 224.5.1.21
+set port  7771
+set s [udp_open $port]
+fconfigure $s -buffering none -blocking 0
+fconfigure $s -mcastadd $group -remote [list $group $port]
+fileevent $s readable [list udpEvent $s]
+puts -nonewline $s "hello, world"
+set ::forever 0
+vwait ::forever
+exit
+
+
+

HISTORY

+

Some of the code in this extension is copied from Michael Miller's tcludp +package. (http://www.neosoft.com/tcl/ftparchive/sorted/comm/tcludp-1.0/) +Compared with Michael's UDP extension, this extension provides Windows +support and provides the ability of using 'gets/puts' to read/write +the socket. In addition, it provides more configuration ability.

+

Enhancements to support binary data and to setup the package for the Tcl +Extension Architecture by Pat Thoyts.

+

Support for IPv6 and allowing a multicast join on a specific network interface is added by Huub Eikens.

+
+

See Also

+

socket

+
+

Keywords

+

I/O, IP Address, TclUDP, UDP, asynchronous I/O, bind, channel, connection, domain, host, name, network, network address, networking, socket, udp

+
+ +
diff --git a/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/udp1013t.dll b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/udp1013t.dll new file mode 100644 index 00000000..11a3784f Binary files /dev/null and b/src/vfs/punk8win.vfs/lib_tcl8/tcludp1.0.13/udp1013t.dll differ diff --git a/src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/pkgIndex.tcl b/src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/pkgIndex.tcl deleted file mode 100644 index bf20b7c0..00000000 --- a/src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/pkgIndex.tcl +++ /dev/null @@ -1,2 +0,0 @@ -package ifneeded udp 1.0.12 \ - [list load [file join $dir udp1012.dll]] diff --git a/src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/udp1012.dll b/src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/udp1012.dll deleted file mode 100644 index afc4fd42..00000000 Binary files a/src/vfs/punk8win.vfs/lib_tcl8/udp1.0.12/udp1012.dll and /dev/null differ