#we need to actually define these procs here, (not import then re-export) - or namespace origin will report the original source namespace - which isn't what we want.
#There is an assert command reachable - due to namespace path etc, it could be in another namespace entirely - (not necessarily in an ancestor namespace of the namespace's tree structure)
#There is an assert command reachable - due to namespace path etc, it could be in another namespace entirely - (not necessarily in an ancestor namespace of the namespace's tree structure)
if {$which_assert eq [punk::assertion::system::nsjoin ${nscaller} assert]} {
#assert is available, but isn't in the calling namespace - we should enable it in a way that is distinguishable from case where assert was explicitly imported to this namespace
#assert is available, but isn't in the calling namespace - we should enable it in a way that is distinguishable from case where assert was explicitly imported to this namespace
tcl::namespace::eval $nscaller {
set assertorigin [tcl::namespace::origin assert]
if {[tcl::string::match ::punk::assertion::* $assertorigin]} {
# A rudimentary hardcoded configuration for options/negotiation
# The way in which features are enabled/disabled and what goes together needs refinement & better understanding
# todo - review
#Note: further logic required, for example even something as supposedly simple as echo shouldn't be active on both ends at once or we get a loop.
#Note: further logic required, for example even something as supposedly simple as echo shouldn't be active on both ends at once or we get a loop.
# Can't necessarily rely on other end not to allow us to do something insane.
# Probably also.. some options should be under direct user ability to initiate/control - not just a configuration
# For that to work fully we may need a separate punk::telnet package that has a pseudoterminal in front of the real console (scrolling sub-area), allowing a custom repl, custom status display etc.
#Passively enabled server features - ie those we don't initiate but will accept
#default response to WILL is WON'T
#define our positive responses here for those that we will do
variable respond_will_do
set respond_will_do [list]
variable respond_will_do
set respond_will_do [list]
lappend respond_will_do 0 ;#binary
lappend respond_will_do 1 ;#echo
lappend respond_will_do 3 ;#suppress go-ahead
lappend respond_will_do 5 ;#status - by agreeing to this we should be able to read unsolicited "IAC SB STATUS IS ... IAC SE" reports and compare to our perception of state. (and do something if mismatches?)
lappend respond_will_do 24 ;#remote is letting us know they are willing to send terminal-type - but we would still have to request it
#passively enabled client features - requests for our own behaviours we will respond positively
variable respond_do_will
#passively enabled client features - requests for our own behaviours we will respond positively
set chunksize 4096 ;#No choice of chunksize can avoid the possibility of splitting a token such as a Telnet protocol command or an ANSI sequence.
#in theory, a split ANSI sequence won't cause a problem - except if we have debug on which could emit a request on stdout (e.g get_cursor_pos)
#as a byte oriented supposedly ascii-by-default protocol - we shouldn't expect to get utf-8 without having negotiated it - but it looks suspiciously like this is the sort of thing that happens (2024) review? Examples? mapscii.me 1984.ws? Test.
#as a byte oriented supposedly ascii-by-default protocol - we shouldn't expect to get utf-8 without having negotiated it - but it looks suspiciously like this is the sort of thing that happens (2024) review? Examples? mapscii.me 1984.ws? Test.
#randomly chosen chunk boundaries - whether due to size or a combination of network speed and event scheduling can mean we get some utf8 characters split too.
set last_unprocessed $fromserver_unprocessed
set data $fromserver_unprocessed
set data $fromserver_unprocessed
set fromserver_unprocessed ""
append data [read $sock $chunksize]
#repeatedly appending when not fblocked - will somewhat reduce the risk of splitting both ANSI and TELNET commands - but at the cost of starving the output processing
#somewhat conveniently? - the IAC \xFF byte is not valid in utf-8 or ascii
#this whole mechanism may need to be reviewed/modified if/when Telnet binary mode and/or charset changing is implemented/understood by the author.
#this whole mechanism may need to be reviewed/modified if/when Telnet binary mode and/or charset changing is implemented/understood by the author.
#The current basic system is tested on the few available public telnet servers. - todo - test on some old industrial equipment, read more RFCs.
#for now we'll use punk::lib::get_utf8_leading as a hack way to determine if we should throw some trailing data aside for next loop to process?
#for now we'll use punk::lib::get_utf8_leading as a hack way to determine if we should throw some trailing data aside for next loop to process?
#while {![fblocked $sock] && ![eof $sock]} {
# add_debug "[a+ red bold]RE-READ[a]\n" stdin $sock
set ansisplits [punk::ansi::ta::split_codes_single $prefix]
set last_pt [lindex $ansisplits end] ;#last part is supposed to be plaintext - if it looks like it contains a partial ansi - throw it to fromserver_unprocessed for next fromServer call
#look for incomplete ansi sequences
#REVIEW - encoding ?
set ansisplits [punk::ansi::ta::split_codes_single $prefix]
set last_pt [lindex $ansisplits end] ;#last part is supposed to be plaintext - if it looks like it contains a partial ansi - throw it to fromserver_unprocessed for next fromServer call
if {[string first "\x1b" $last_pt] >= 0} {
set complete [join [lrange $ansisplits 0 end-1] ""]
#we shouldn't get here if we are properly in sync with a well-behaved partner
#if we do however.. we need to either abort immediately.. or ignore the subnegotiation by skipping ahead to SE as it may not even be an SB structure we understand.
#[para]punk::cap provides management of named capabilities and the provider packages and handler packages that implement a pluggable capability.
#[para]see also [uri https://core.tcl-lang.org/tcllib/doc/trunk/embedded/md/tcllib/files/modules/pluginmgr/pluginmgr.md {tcllib pluginmgr}] for an alternative which uses safe interpreters
#[subsection Concepts]
#[para]A [term capability] may be something like providing a folder of files, or just a data dictionary, and/or an API
#[para]A [term capability] may be something like providing a folder of files, or just a data dictionary, and/or an API
#
#[para][term {capability handler}] - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# [enum] CLASS [class interface_cappprovider.registration]
# [para]Your provider package will need to instantiate this object under a sub-namespace called [namespace capsystem] within your package namespace.
# [para]Your provider package will need to instantiate this object under a sub-namespace called [namespace capsystem] within your package namespace.
# [para]If your package namespace is mypackages::providerpkg then the object command would be at mypackages::providerpkg::capsystem::capprovider.registration
# [para]Example code for your provider package to evaluate within its namespace:
# [para]Example code for your provider package to evaluate within its namespace:
# [example {
#namespace eval capsystem {
# if {[info commands capprovider.registration] eq ""} {
#[para] This method must be overridden by your provider using oo::objdefine cappprovider.registration as in the example above.
# There must be at least one 2-element list in the result for the provider to be registerable.
#[para]The first element of the list is the capabilityname - which can be custom to your provider/handler packages - or a well-known name that other authors may use/implement.
#[para]The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data.
#[para]The second element is a dictionary of keys specific to the capability being implemented. It may be empty if the any potential capability handlers for the named capability don't require registration data.
error "interface_capprovider.registration not implemented by provider"
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated handler.
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [capability_get_handler $capname]] ne ""} {
puts stderr "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
puts stderr "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
return
}
#assertion: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
#for template pathtype module & shellproject* we can resolve whether it's within a project at registration time and store the projectbase rather than rechecking it each time the templates handler api is called
#for template pathtype absolute - we can do the same.
#There is a small chance for a long-running shell that a project is later created which makes the absolute path within a project - but it seems an unlikely case, and probably won't surprise the user that they need to relaunch the shell or reload the capsystem to see the change.
#for template pathtype absolute - we can do the same.
#There is a small chance for a long-running shell that a project is later created which makes the absolute path within a project - but it seems an unlikely case, and probably won't surprise the user that they need to relaunch the shell or reload the capsystem to see the change.
#adhoc and currentproject* paths are relative to cwd - so no projectbase information can be stored at registration time.
#not all template item types will need projectbase information - as the item data may be self-contained within the template structure -
#not all template item types will need projectbase information - as the item data may be self-contained within the template structure -
#but project_layout will need it - or at least need to know if there is no project - because project_layout data is never stored in the template folder structure directly.
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
#concat and supply to existing handler in single text block - review
#Note will only
#Note will only
set waitingdata [join $input_chunks_waiting($input) ""]
set input_chunks_waiting($input) [list]
#after idle [list after 0 [list {*}$existing_handler $waitingdata]]
after idle [list {*}$existing_handler $waitingdata] ;#after 0 may be put ahead of events it shouldn't be - review
after idle [list {*}$existing_handler $waitingdata] ;#after 0 may be put ahead of events it shouldn't be - review
unset waitingdata
} else {
#! todo? for now, emit a clue as to what's happening.
@ -942,7 +942,7 @@ namespace eval punk::console {
#review - reading 1 byte at a time and repeatedly running the small capturing/completion regex seems a little inefficient... but we don't have a way to peek or put back chars (?)
#review (we do have the punk::console::input_chunks_waiting($chan) array to cooperatively put back data - but this won't work for user scripts not aware of this)
#review - timeout - what if terminal doesn't put data on stdin? error vs stderr report vs empty results
#review - Main loop may need to detect some terminal responses and store them for lookup instead-of or as-well-as this handler?
#review - Main loop may need to detect some terminal responses and store them for lookup instead-of or as-well-as this handler?
#e.g what happens to mouse-events while user code is executing?
#we may still need this handler if such a loop doesn't exist.
#faster than get_size when it is using ansi mechanism - but uses cursor_save - which we may want to avoid if calling during another operation which uses cursor save/restore
#[titledesc {file line-handling utilities}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk fileline}] [comment {-- Description at end of page heading --}]
#[moddesc {punk fileline}] [comment {-- Description at end of page heading --}]
#[require punk::fileline]
#[keywords module text parse file encoding BOM]
#[description]
@ -33,7 +33,7 @@
#[para]Utilities for in-memory analysis of text file data as both line data and byte/char-counted data whilst preserving the line-endings (even if mixed)
#[para]This is important for certain text files where examining the number of chars/bytes is important
#[para]For example - windows .cmd/.bat files need some byte counting to determine if labels lie on chunk boundaries and need to be moved.
#[para]This chunk-size counting will depend on the character encoding.
#[para]This chunk-size counting will depend on the character encoding.
#[para]Despite including the word 'file', the library doesn't necessarily deal with reading/writing to the filesystem -
#[para]The raw data can be supplied as a string, or loaded from a file using punk::fileline::get_textinfo -file <filename>
#[subsection Concepts]
@ -42,13 +42,13 @@
# package require punk::fileline
# package require fileutil
# set rawdata [lb]fileutil::cat data.txt -translation binary[rb]
#[para]Line records are referred to by a zero-based index instead of a one-based index as is commonly used when displaying files.
#[para]This is for programming consistency and convenience, and the module user should do their own conversion to one-based indexing for line display or messaging if desired.
#[para]No support for lone carriage-returns being interpreted as line-endings.
#[para]No support for lone carriage-returns being interpreted as line-endings.
#[para]CR line-endings that are intended to be interpreted as such should be mapped to something else before the data is supplied to this module.
#suport simple end+-int (+-)start(+-)int to set linebase to line corresponding to chunkstart or chunkend
#also simple int+int and int-int - nothing more complicated (similar to Tcl lrange etc in that regard)
#commonly this will be something like -start or -end
#commonly this will be something like -start or -end
if {![string is integer -strict $opt_linebase]} {
set sign ""
set errunrecognised "unrecognised -linebase value '$opt_linebase'. Expected positive or negative integer or -start -start-int -start+int -end -end-int -end+int or -eof (where leading - is optional but probably desirable) "
set errunrecognised "unrecognised -linebase value '$opt_linebase'. Expected positive or negative integer or -start -start-int -start+int -end -end-int -end+int or -eof (where leading - is optional but probably desirable) "
#[para]Reconstructs and returns the raw line using the payload and per-line stored line-ending metadata
#[para]Reconstructs and returns the raw line using the payload and per-line stored line-ending metadata
#[para]A 'line' may be returned without a line-ending if the unerlying chunk had trailing data without a line-ending (or the chunk was loaded under a non-standard -policy setting)
#[para]Whilst such data may not conform to definitions (e.g POSIX) of the terms 'textfile' and 'line' - it is useful here to represent it as a line with metadata le set to "none"
#[para]To return just the data which might more commonly be needed for dealing with lines, use the [method linepayload] method - which returns the line data minus line-ending
#[para]Line Metadata such as the line-ending for a particular line and the byte/character range it occupies within the chunk can be retrieved with the [method linemeta] method
#[para]To retrieve both the line text and metadata in a single call the [method lineinfo] method can be used
#[para]To retrieve an entire line including line-ending use the [method line] method.
#[para]truncation shows the shortened (missing bytes on left and/or right side) part of the entire line (potentially including line-ending or even partial line-ending)
#[para]Note that this truncation info is only in the return value of this method - and will not be reflected in [method lineinfo] queries to the main chunk.
set truncated [string range $payload_and_le 0 $split]
set truncated [string range $payload_and_le 0 $split]
set rhs [string range $payload_and_le $split+1 end]
dict set last truncated $truncated
dict set last truncatedright $rhs
#this has the effect that truncating the rhs by 1 can result in truncated being larger than original payload for crlf lines - as payload now sees the cr
#this is a bit unintuitive - but probably best reflects the reality. The truncated value is the truncated 'line' rather than the truncated 'payload'
#this is a bit unintuitive - but probably best reflects the reality. The truncated value is the truncated 'line' rather than the truncated 'payload'
#Also check if the truncation is directly between an crlf
#both an lhs split and an rhs split could land between cr and lf
#to be precise - we should presumably count the part within our chunk as either a none for cr or an lf
#This means a caller counting chunk by chunk using this method will sometimes get the wrong answer depending on where crlfs lie relative to their chosen chunk size
#This means a caller counting chunk by chunk using this method will sometimes get the wrong answer depending on where crlfs lie relative to their chosen chunk size
#This is presumably ok - as it should be a well known thing to watch out for.
#If we're only receiving chunk by chunk we can't reliably detect splits vs lone <cr>s in the data
#There are surely more efficient ways for a caller to count line-endings in the way that makes sense for them
#but we should makes things as easy as possible for users of this line/chunk structure anyway.
set first [lindex $infolines 0]
if {[dict get $first is_truncated]} {
#could be the only line - and truncated at one or both ends.
#[para]A utility to convert some of the of Tcl-style list-index expressions such as end, end-1 etc to valid indices in the range 0 to the supplied max
#[para]Basic addition and subtraction expressions such as 4-1 5+2 are accepted
#[para]A utility to convert some of the of Tcl-style list-index expressions such as end, end-1 etc to valid indices in the range 0 to the supplied max
#[para]Basic addition and subtraction expressions such as 4-1 5+2 are accepted
#[para]startidx higher than endidx is allowed
#[para]Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max
#[para]Unlike Tcl's index expressions - we raise an error if the calculated index is out of bounds 0 to max
set original_startidx $startidx
set original_endidx $endidx
set startidx [string map [list _ ""] $startidx] ;#don't barf on Tcl 8.7+ underscores in numbers - we can't just use expr because it will not handle end-x
set startidx [string map [list _ ""] $startidx] ;#don't barf on Tcl 8.7+ underscores in numbers - we can't just use expr because it will not handle end-x
set endidx [string map [list _ ""] $endidx]
if {![string is digit -strict "$startidx$endidx"]} {
#review - this will just result in out of bounds error in final test - as desired
#By calculating here - we will see the result in the error message - but it's probably not particularly useful - as we don't really need end+ support at all.
#[para]If -includebom 1 is specified - the bom will be retained in the stored chunk and the data for line 1, but will undergo the same encoding transformation as the rest of the data
#[para]The get_bomid method of the returned object will contain an identifier for any BOM encountered.
#[para]If the encoding specified in the BOM isn't recognised by Tcl - the resulting data is likely to remain as the raw bytes of whatever encoding that is.
#[para]If the encoding specified in the BOM isn't recognised by Tcl - the resulting data is likely to remain as the raw bytes of whatever encoding that is.
#[para]Currently only utf-8, utf-16* and utf-32* are properly supported even though the other BOMs are detected, reported via get_bomid, and stripped from the data.
#[para]GB18030 falls back to cp936/gbk (unless a gb18030 encoding has been installed). Use -encoding iso8859-1 if this isn't suitable and you need to do your own processing of the bytes.
fconfigure $fd -translation binary -encoding $opt_translation;#should use translation binary to get actual line-endings - but we allow caller to override
#Always read encoding in binary - check for bom below and/or apply chosen opt_encoding
set filename $opt_file
set fd [open $filename r]
chan configure $fd -translation binary -encoding $opt_translation;#should use translation binary to get actual line-endings - but we allow caller to override
#Always read encoding in binary - check for bom below and/or apply chosen opt_encoding
#Technically ambiguous - could be utf-16le bom followed by utf-16 null character (2 byte null)
#Technically ambiguous - could be utf-16le bom followed by utf-16 null character (2 byte null)
puts stderr "WARNING - ambiguous BOM fffe0000 found. Treating as utf-32le - but could be utf-16le - consider manually setting -encoding or converting data to another encoding."
#sha1 is performant - and this is not being used in a cryptographic or adversarial context - so performance and practical unlikelihood of accidental collisions should be the main consideration.
#adler32 is fastest for some larger files of a few MB but slower on small files (possibly due to Tcl-based file load?)
#Here we will raise an error if cksum exists and is not empty or a tag - whereas the multiple path version will honour valid-looking prefilled cksum values (ie will pass them through)
#base is the presumed location to store the checksum file. The caller should retain (normalize if relative)
#absolute base with no shared prefix doesn't make sense - we could ignore it - but better to error-out and require the caller specify an empty base
error "get_relativecksum_from_base error: base '$base' and specifiedpath '$specifiedpath' don't share a common root. Use empty-string for base if independent absolute path is required"
}
set targetpath $specifiedpath
set targetpath $specifiedpath
set storedpath [punk::path::relative $base $specifiedpath]
lappend decls [list punk.isbogus {provider punk::mix::templates something blah}] ;#some capability for which there is no handler to validate - therefore no warning will result.
#review - we should report unhandled caps somewhere, or provide a mechanism to detect/report.
#we don't want to warn at the time this provider is loaded - as handler may legitimately be loaded later.
#we don't want to warn at the time this provider is loaded - as handler may legitimately be loaded later.
puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
#This seems unfortunate - as a multithreaded set of test runs might otherwise have made some sense.. but perhaps for tests more serious isolation is a good idea.
#It also seems common to cd when loading certain packages e.g tls from starkit.
#While in most/normal cases the library will cd back to the remembered working directory after only a brief time - there seem to be many opportunities for issues
#if the repl is used to launch/run a number of things in the one process
#if the repl is used to launch/run a number of things in the one process
#dirfiles_dict would handle simple cases of globs within paths anyway - but we need to explicitly set tailglob here in all branches so that next level doesn't need to do file vs dir checks to determine user intent.
#(dir-listing vs file-info when no glob-chars present is inherently ambiguous so we test file vs dir to make an assumption - more explicit control via -tailglob can be done manually with dirfiles_dict)
if {$relativepath} {
set searchbase [pwd]
set searchbase [pwd]
if {!$has_tailglobs} {
if {[file isdirectory [file join $searchbase $searchspec]]} {
set location [file join $searchbase $searchspec]
set tailglob *
set tailglob *
} else {
set location [file dirname [file join $searchbase $searchspec]]
set tailglob [file tail $searchspec] ;#use exact match as a glob - will retrieve size,attributes etc.
#glob patterns in path prior to final segment should already be resolved before using dirfiles_dict - as the underlying filesystem mechanisms can't do nested globbing themselves.
#dirfiles_dict will assume the path up to the final segment is literal even if globchars are included therein.
#final segment globs will be recognised only if -tailglob is passed as empty string
#if -tailglob not supplied and last segment has globchars - presume searchspec parendir is the container and last segment is globbing within that.
#if -tailglob not supplied and last segment has no globchars - presume searchspec is a container(directory) and use glob *
#if -tailglob not supplied and last segment has no globchars - presume searchspec is a container(directory) and use glob *
#caller should use parentdir as location and set tailglob to search-pattern or exact match if location is intended to match a file rather than a directory
#examples:
# somewhere/files = search is effectively somewhere/files/* (location somewhere/files glob is *)
# somewhere/files/* = (as above)
# -tailglob * somewhere/files = (as above)
# -tailglob * somewhere/files = (as above)
#
# -tailglob "" somewhere/files = search somewhere folder for exactly 'files' (location somewhere glob is files)
# -tailglob files somewhere = (as above)
#
# somewhere/f* = search somewhere folder for f* (location somewhere glob is f*)
# -tailglob f* somewhere = (as above)
#
# -tailglob f* somewhere = (as above)
#
# This somewhat clumsy API is so that simple searches can be made in a default sensible manner without requiring extra -tailglob argument for the common cases - with lack of trailing glob segment indicating a directory listing
# - but we need to distinguish somewhere/files as a search of that folder vs somewhere/files as a search for exactly 'files' within somewhere, hence the -tailglob option to fine-tune.
# - this also in theory allows file/directory names to contain glob chars - although this is probably unlikely and/or unwise and not likely to be usable on all platforms.
# - this also in theory allows file/directory names to contain glob chars - although this is probably unlikely and/or unwise and not likely to be usable on all platforms.
#
#if caller supplies a tailglob as empty string - presume the caller hasn't set location to parentdir - and that last element is the search pattern.
# -searchbase is always passed through - and is only used to construct a location path if a relative searchspec was supplied
#NOTE: -types {hidden d} * may return . & .. on unix platforms - but will not show them on windows.
#A mounted vfs exe (e.g sometclkit.exe) may be returned by -types {hidden d} on windows - but at the same time has "-hidden 0" in the result of file attr.
#non-unix platforms may have attributes to indicate hidden status even if filename doesn't have leading dot.
#mac & windows have these
#windows doesn't consider dotfiles as hidden - mac does (?)
#glob -types {hidden} will not always return the combination of glob -types {hidden f} && -types {hidden d} (on windows anyway)
# -- ---
# -- ---
#can't lsort files without lsorting filesizes
#Note - the sort by index would convert an empty filesizes list to a list of empty strings - one for each entry in files
#We want to preserve the empty list if that's what the dirlisting mechanism returned (presumably because -with_sizes was 0 or explicitly excluded files)
#Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys.
#Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys.
}
# -- --- --- --- --- --- --- --- --- --- ---
#assign symlinks to the dirs or files collection (the punk::du system doesn't sort this out
#assign symlinks to the dirs or files collection (the punk::du system doesn't sort this out
#As at 2024-09 for windows symlinks - Tcl can't do file readlink on symlinks created with mklink /D name target (SYMLINKD) or mklink name target (SYMLINK)
#We can't read the target information - best we can do is classify it as a file or a dir
#we can't use 'file type' as that will report just 'link' - but file isfile and file isdirectory work and should work for links on all platforms - REVIEW
#we now have the issue that our symlinks aren't sorted within the dir/file categorisation - they currently will have to appear at beginning or end - TODO
# -- --- --- --- --- --- --- --- --- --- ---
#todo - sort whilst maintaining order for metadata?
#todo - sort whilst maintaining order for metadata?
#we need to co-sort files only with filesizes (other info such as times is keyed on fname so cosorting not required)
#expecting to be called from a thread::send in parent repl - ie in the toplevel interp so that the sub-interp "code" is available
#if a thread::send is done from the commandline in a codethread - Tcl will
#if a thread::send is done from the commandline in a codethread - Tcl will
if {![interp exists code] || ![info exists replthread_cond]} {
#in case someone tries calling from codethread directly - don't do anything or change any state
#(direct caller could create an interp named code at the level "" -> "code" -"code" and add a replthread_cond value to avoid this check - but it probably won't do anything useful)
#an experiment - this is essentially an identity transform unless flags are set. - result afer cmd.exe processes escapes is the same as running raw with no quoting
#an experiment - this is essentially an identity transform unless flags are set. - result afer cmd.exe processes escapes is the same as running raw with no quoting
#this follows the advice of 'don't let cmd see any double quotes unescaped' - but that's effectively a pretty useless strategy.
#The -useprequoted and -usepreescaped flags are the only difference
#these rely on the fact we can prepend a caret to each argument without affecting the resulting string - and use that as an indicator to treat specific input 'arguments' differently i.e by keeping existing escapes only.
@ -385,7 +385,7 @@ namespace eval punk::winrun {
set cmdline ""
set i 0
set meta_chars [list {"} "(" ")" ^ < > & |]
set meta_chars [list {"} "(" ")" ^ < > & |]
#note that %var% and !var! work the same whether within a double quote section or not
# - This approach with repeated double quotes gives inconsistent behaviour between twapi CommandLineToArgvW and tclsh -
# - This approach with repeated double quotes gives inconsistent behaviour between twapi CommandLineToArgvW and tclsh -
#prepare arguments that are given to cmd.exe such that they will be passed through to an executable that uses standard windows commandline parsing such as CommandLineToArgvW
#for each arg:
#double up any backslashes that precede double quotes, double up existing double quotes - then wrap in a single set of double quotes if argument had any quotes in it.
#This doesn't use \" or ^ style escaping - but the 2008+ argv processing on windows supposedly does what we want with doubled-up quotes and slashes, and cmd.exe passes them through
#todo - work out way to use same punkcheck file for multiple installers running concurrently. Thread?
#an installtrack objects represents an installation path from sourceroot to targetroot
#an installtrack objects represents an installation path from sourceroot to targetroot
#The source and target folders should be as specific as possible but it is valid to specify for example c:/ -> c:/ (or / -> /) if source and targets within the installation operation are spread around.
#
set objname [namespace current]::installtrack
@ -104,7 +104,7 @@ namespace eval punkcheck {
#FILEINFO record - target fileset with body records: INSTALL-RECORD,INSTALL-INPROGRESS,INSTALL-SKIPPED,DELETE-RECORD,DELETE-INPROGRESS,MODIFY-INPROGRESS,MODIFY-RECORD
#each FILEINFO body being a list of SOURCE records
oo::class create targetset {
variable o_targets
variable o_targets
variable o_keep_installrecords
variable o_keep_skipped
variable o_keep_inprogress
@ -132,7 +132,7 @@ namespace eval punkcheck {
-keep_inprogress $o_keep_inprogress\
body $o_records
}
#retrieve last completed record for the fileset ie exclude SKIPPED,INSTALL-INPROGRESS,DELETE-INPROGRESS,MODIFY-INPROGRESS
method get_last_record {fileset_record} {
set body [dict_getwithdefault $fileset_record body [list]]
@ -189,11 +189,11 @@ namespace eval punkcheck {
}
set o_ts_end [dict get $opts -tsend]
set o_types [dict get $opts -types]
set o_configdict [dict get $opts -config]
set o_configdict [dict get $opts -config]
set o_rel_sourceroot $rel_sourceroot
set o_rel_targetroot $rel_targetroot
}
}
destructor {
#puts "[self] destructor called"
}
@ -339,14 +339,14 @@ namespace eval punkcheck {
set installing_record [lindex $fileinfo_body end]
set ts_start [dict get $installing_record -ts]
set ts_now [clock microseconds]
set ts_now [clock microseconds]
set metadata_us [expr {$ts_now - $ts_start}]
dict set installing_record -metadata_us $metadata_us
dict set installing_record -ts_start_transfer $ts_now
lset fileinfo_body end $installing_record
return [dict set o_fileset_record body $fileinfo_body]
} else {
#legacy call
@ -368,7 +368,7 @@ namespace eval punkcheck {
}
set status [string toupper $status]
set statusdict [dict create OK RECORD SKIPPED SKIPPED FAILED FAILED]
set statusdict [dict create OK RECORD SKIPPED SKIPPED FAILED FAILED]
if {$o_operation_start_ts eq ""} {
error "[self] targetset_end $status - no current operation - call targetset_started first"
}
@ -383,7 +383,7 @@ namespace eval punkcheck {
error "targetset_end $status error. targetlist mismatch between file : $targetlist vs $o_targets"
}
set operation_end_ts [clock microseconds]
set elapsed_us [expr {$operation_end_ts - $o_operation_start_ts}]
set elapsed_us [expr {$operation_end_ts - $o_operation_start_ts}]
set file_record_body [dict get $o_fileset_record body]
set installing_record [lindex $file_record_body end]
set punkcheck_file [$o_installer get_checkfile]
@ -414,12 +414,12 @@ namespace eval punkcheck {
}
}
set cksum_us [expr {[clock microseconds] - $ts_begin_cksum}]
dict set installing_record -targets_cksums $new_targets_cksums
dict set installing_record -targets_cksums $new_targets_cksums
dict set installing_record -cksum_all_opts $cksum_all_opts
dict set installing_record -cksum_us $cksum_us
}
lset file_record_body end $installing_record
dict set o_fileset_record body $file_record_body
dict set o_fileset_record body $file_record_body
set o_fileset_record [punkcheck::recordlist::file_record_prune $o_fileset_record]
set oldrecordinfo [punkcheck::recordlist::get_file_record $targetlist $record_list]
@ -436,8 +436,8 @@ namespace eval punkcheck {
set o_operation ""
return $o_fileset_record
}
#can supply empty cksum value
# - that will influence the opts used if there is no existing install record
#can supply empty cksum value
# - that will influence the opts used if there is no existing install record
error "[self] set_source_target error: sourceroot must be absolute path. Received '$sourceroot'"
@ -605,7 +605,7 @@ namespace eval punkcheck {
}
method save_installer_record {} {
set file_records [punkcheck::load_records_from_file $o_checkfile]
set this_installer_record [my as_record]
set persistedinfo [punkcheck::recordlist::get_installer_record $o_name $file_records]
@ -658,13 +658,13 @@ namespace eval punkcheck {
set resultinfo [punkcheck::recordlist::get_installer_record $o_name $o_record_list]
}
method get_recordlist {} {
return $o_recordlist
return $o_recordlist
}
method end_event {} {
if {$o_active_event eq ""} {
error "[self] end_event error - no active event"
}
$o_active_event end
$o_active_event end
}
method get_event {} {
return $o_active_event
@ -720,7 +720,7 @@ namespace eval punkcheck {
append msg "Call in order:" \n
append msg " start_installer_event (get dict with eventid and recordset keys)"
append msg " installfile_begin (to return a new INSTALLING record) - must pass in a valid eventid" \n
append msg " installfile_add_source_and_fetch_metadata (1+ times to update SOURCE record with checksum/timestamp info from source)" \n
append msg " installfile_add_source_and_fetch_metadata (1+ times to update SOURCE record with checksum/timestamp info from source)" \n
append msg " ( - possibly with same algorithm as previous installrecord)" \n
append msg " ( - todo - search/load metadata for this source from other FILEINFO records for same installer)" \n
append msg "Finalize by calling:" \n
@ -749,7 +749,7 @@ namespace eval punkcheck {
set punkcheck_file [file join $punkcheck_folder/.punkcheck]
set record_list [load_records_from_file $punkcheck_file]
set resultinfo [punkcheck::recordlist::get_installer_record $installername $record_list]
set installer_record_position [dict get $resultinfo position]
if {$installer_record_position == -1} {
@ -805,7 +805,7 @@ namespace eval punkcheck {
#validate any passed cached_cksums
foreach cacheinfo $cached_cksums {
if {[llength $cacheinfo] % 2 != 0} {
error "installfile_add_source_and_fetch_metadata error.If cached_cksums is supplied, it must be a list of dicts containing keys cksum & opts"
error "installfile_add_source_and_fetch_metadata error.If cached_cksums is supplied, it must be a list of dicts containing keys cksum & opts"
}
dict for {k v} $cacheinfo {
switch -- $k {
@ -814,7 +814,7 @@ namespace eval punkcheck {
#todo - validate $v keys
}
default {
error "installfile_add_source_and_fetch_metadata error. Unrecognised key $k. Known keys {cksum opts}"
error "installfile_add_source_and_fetch_metadata error. Unrecognised key $k. Known keys {cksum opts}"
}
}
@ -837,7 +837,7 @@ namespace eval punkcheck {
}
}
}
#check that this relpath not already added as child of *-INPROGRESS
#check that this relpath not already added as child of *-INPROGRESS
set file_record_body [dict_getwithdefault $file_record body [list]] ;#new file_record may have no body
set installing_record [lindex $file_record_body end]
set already_present_record [lib::install_record_get_matching_source_record $installing_record $source_relpath]
@ -871,14 +871,14 @@ namespace eval punkcheck {
#use first entry in cached_cksums if we can
if {[llength $cached_cksums]} {
set use_cache 1
set use_cache_record [lindex $cached_cksums 0]
set use_cache_record [lindex $cached_cksums 0]
}
}
#todo - accept argument of cached source cksum info (for client calling multiple targets with same source in quick succession e.g when building .vfs kits with multiple runtimes)
#if same cksum_opts - then use cached data instead of checksumming here.
#allow nonexistant as a source
#allow nonexistant as a source
set fpath [file join $punkcheck_folder $source_relpath]
if {![file exists $fpath]} {
set ftype "missing"
@ -939,14 +939,14 @@ namespace eval punkcheck {
set installing_record [lindex $file_record_body end]
set ts_start [dict get $installing_record -ts]
set ts_now [clock microseconds]
set ts_now [clock microseconds]
set metadata_us [expr {$ts_now - $ts_start}]
dict set installing_record -metadata_us $metadata_us
dict set installing_record -ts_start_transfer $ts_now
lset file_record_body end $installing_record
dict set file_record body $file_record_body
@ -983,7 +983,7 @@ namespace eval punkcheck {
dict set installing_record tag "INSTALL-RECORD"
lset file_record_body end $installing_record
dict set file_record body $file_record_body
dict set file_record body $file_record_body
set file_record [punkcheck::recordlist::file_record_prune $file_record]
@ -1016,8 +1016,8 @@ namespace eval punkcheck {
set tsnow [clock microseconds]
set elapsed_us [expr {$tsnow - $ts_start}]
dict set installing_record -elapsed_us $elapsed_us
dict set installing_record tag "INSTALL-SKIPPED"
dict set installing_record tag "INSTALL-SKIPPED"
lset file_record_body end $installing_record
dict set file_record body $file_record_body
@ -1076,7 +1076,7 @@ namespace eval punkcheck {
#should work on *-INPROGRESS or INSTALL(etc) record - don't restrict tag to INSTALL
set body [dict_getwithdefault $install_record body [list]]
set body [dict_getwithdefault $install_record body [list]]
foreach src $body {
if {[dict get $src tag] eq "SOURCE"} {
if {[dict_getwithdefault $src -path ""] eq $source_relpath} {
@ -1124,7 +1124,7 @@ namespace eval punkcheck {
set do_normalize 1
}
} else {
#case differences in volumes is common on windows
#case differences in volumes is common on windows
set do_normalize 1
}
if {$do_normalize} {
@ -1207,7 +1207,7 @@ namespace eval punkcheck {
if {[dict exists $dictValue {*}$keys]} {
return [dict get $dictValue {*}$keys]
} else {
return [lindex $args end]
return [lindex $args end]
}
}
lappend PUNKARGS [list {
@ -1273,11 +1273,11 @@ namespace eval punkcheck {
# -overwrite newer-targets will copy files with older source timestamp over newer target timestamp and those missing at the target (a form of 'restore' operation)
# -overwrite older-targets will copy files with newer source timestamp over older target timestamp and those missing at the target
# -overwrite all-targets will copy regardless of timestamp at target
# -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed
# -overwrite installedsourcechanged-targets will copy if the target doesn't exist or the source changed
# -overwrite synced-targets will copy if the target doesn't exist or the source changed and the target cksum is the same as the last INSTALL-RECORD -targets_cksums entry
# review - timestamps unreliable
# - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first?
# if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?)
# - what about slightly mismatched system clocks and mounted filesystems? caller responsibility to verify first?
# if timestamp exactly equal - should we check content-hash? This is presumably only likely to occur deliberately(maliciously?)
# e.g some process that digitally signs or otherwise modifies a file and preserves update timestmp?
# if such a content-mismatch - what default behaviour and what options would make sense?
# probably it's reasonable that only all-targets would overwrite such files.
@ -1369,7 +1369,7 @@ namespace eval punkcheck {
if {[llength [file split $af]] > 1} {
error "punkcheck::install received invalid -antiglob_file entry '$af'. -antiglob_file entries are meant to match to a file name at any level so cannot contain path separators"
set opt_antiglob_dir_core [dict get $opts -antiglob_dir_core]
if {$opt_antiglob_dir_core eq "\uFFFF"} {
@ -1383,7 +1383,7 @@ namespace eval punkcheck {
if {[llength [file split $ad]] > 1} {
error "punkcheck::install received invalid -antiglob_dir entry '$ad'. -antiglob_dir entries are meant to match to a directory name at any level so cannot contain path separators"
#example - target dir has a file where there is a directory at the source
if {[file exists $current_target_dir] && ([file type $current_target_dir] ni [list directory])} {
error "punkcheck::install target subfolder $current_target_dir exists but is not of type 'directory'. Type current target folder: [file type $current_target_dir]"
set fetch_filerec_result [punkcheck::recordlist::get_file_record $punkcheck_target_relpath $punkcheck_records]
#change to use extract_or_create_fileset_record ?
set existing_filerec_posn [dict get $fetch_filerec_result position]
@ -1614,7 +1614,7 @@ namespace eval punkcheck {
set filerec [dict get $fetch_filerec_result record]
}
set filerec [punkcheck::recordlist::file_record_set_defaults $filerec]
#new INSTALLREC must be tagged as INSTALL-INPROGRESS to use recordlist::installfile_ method
set new_install_record [dict create tag INSTALL-INPROGRESS -tsiso $ts_start_iso -ts $ts_start -installer $opt_installer -eventid $punkcheck_eventid]
dict lappend filerec body $new_install_record ;#can't use recordlist::file_record_add_installrecord as '*-INPROGRESS' isn't a final tag - so pruning would be mucked up. No need to prune now anyway.
@ -1630,7 +1630,7 @@ namespace eval punkcheck {
#different volume or root
}
#Note this isn't a recordlist function - so it doesn't purely operate on the records
#this hits the filesystem for the sourcepath - gets checksums/timestamps depending on config.
#this hits the filesystem for the sourcepath - gets checksums/timestamps depending on config.
#It doesn't save to .punkcheck (the only punkcheck::installfile_ method which doesn't)
set filerec [punkcheck::installfile_add_source_and_fetch_metadata $punkcheck_folder $relative_source_path $filerec]
@ -1697,7 +1697,7 @@ namespace eval punkcheck {
} else {
#either cksum is different or we were unable to verify the record. Either way we can't know if the target is in sync so we must skip it
set is_skip 1
puts stderr "Skipping file copy $m target $current_target_dir/$m - require synced_target to overwrite - current target cksum compared to previous install: $target_cksum_compare"
puts stderr "Skipping file copy $m target $current_target_dir/$m - require synced_target to overwrite - current target cksum compared to previous install: $target_cksum_compare"
lappend files_skipped $current_source_dir/$m
}
} else {
@ -1728,7 +1728,7 @@ namespace eval punkcheck {
#if {$store_source_cksums} {
#}
set install_records [dict get $filerec body]
set install_records [dict get $filerec body]
set current_install_record [lindex $install_records end]
#change the tag from *-INPROGRESS to INSTALL-RECORD/SKIPPED
if {$is_skip} {
@ -1790,7 +1790,7 @@ namespace eval punkcheck {
set relative_source_path [file join $relative_source_dir $d]
set is_antipath 0
foreach antipath $opt_antiglob_paths {
#puts "testing folder - globmatchpath $antipath vs $relative_source_path"
#puts "testing folder - globmatchpath $antipath vs $relative_source_path"
if {[punk::path::globmatchpath $antipath $relative_source_path]} {
set logfile_stdout [dict get $conf logfile_stdout]
set logfile_stderr [dict get $conf logfile_stderr]
@ -43,18 +43,18 @@ namespace eval shellrun {
set err [dict get [shellfilter::stack::item punksherr] device localchan]
}
namespace import ::punk::ansi::a+
namespace import ::punk::ansi::a+
namespace import ::punk::ansi::a
#repltelemetry - additional/alternative display info used in a repl context i.e info directed towards the screen
#todo - package up in repltelemetry module and rewrite proc based on whether the module was found/loaded.
#somewhat strong coupling to punk - but let's try to behave decently if it's not loaded
#The last_run_display is actually intended for the repl - but is resident in the punk namespace with a view to the possibility of a different repl being in use.
proc set_last_run_display {chunklist} {
#chunklist as understood by the
#chunklist as understood by the
if {![info exists ::punk::repltelemetry_emmitters]} {
namespace eval ::punk {
variable repltelemetry_emmitters
@ -62,7 +62,7 @@ namespace eval shellrun {
}
} else {
if {"shellrun" ni $::punk::repltelemetry_emmitters} {
lappend punk::repltelemetry_emmitters "shellrun"
lappend punk::repltelemetry_emmitters "shellrun"
}
}
@ -70,7 +70,7 @@ namespace eval shellrun {
if {[catch {llength $chunklist} errMsg]} {
error "set_last_run_display expects a list. Value supplied doesn't appear to be a well formed tcl list. '$errMsg'"
#we leave stdout without imposed ansi colouring - because the source may be colourised and because ansi-wrapping a stream at whatever boundaries it comes in at isn't a really nice thing to do.
#stderr might have source colouring - but it usually doesn't seem to, and the visual distiction of red stderr can be very handy for the run command.
#A further enhancement could be to detect well-known options such as --color and/or use a configuration for specific commands that have useful colourised stderr,
#but having an option to configure stderr to red is a compromise.
#Note that the other run commands, runout,runerr, runx don't emit in real-time - so for those commands there may be options to detect and/or post-process stdout and stderr.
#TODO - fix. This has no effect if/when the repl adds an ansiwrap transform
#TODO - fix. This has no effect if/when the repl adds an ansiwrap transform
# what we probably want to do is 'aside' that transform for runxxx commands only.
#we can't detect stdout/stderr output from the exec
#for now emit an extra \n on stderr
#we can't detect stdout/stderr output from the exec
#for now emit an extra \n on stderr
#todo - there is probably no way around this but to somehow exec in the context of a completely separate console
#This is probably a tricky problem - especially to do cross-platform
#This is probably a tricky problem - especially to do cross-platform
#
# - use [dict get $::tcl::UnknownOptions -code] (0|1) exit
if {[dict get $::tcl::UnknownOptions -code] == 0} {
@ -230,9 +230,9 @@ namespace eval shellrun {
} else {
set nonewline 0
}
#puts stdout "RUNOUT cmdargs: $cmdargs"
#todo add -data boolean and -data lastwrite to -settings with default being -data all
# because sometimes we're only interested in last char (e.g to detect something was output)
@ -268,7 +268,7 @@ namespace eval shellrun {
if {"-tcl" in $runopts} {
} else {
#we must raise an error.
#we must raise an error.
#todo - check errorInfo makes sense.. return -code? tailcall?
#
set msg ""
@ -281,9 +281,10 @@ namespace eval shellrun {
set chunklist [list]
#exitcode not part of return value for runout - colourcode appropriately
set n $RST
set n $RST
set c ""
if [dict exists $exitinfo exitcode] {
if {[dict exists $exitinfo exitcode]} {
set code [dict get $exitinfo exitcode]
if {$code == 0} {
set c [a+ green]
@ -291,7 +292,7 @@ namespace eval shellrun {
set c [a+ white bold]
}
lappend chunklist [list "info" "$c$exitinfo$n"]
} elseif [dict exists $exitinfo error] {
} elseif {[dict exists $exitinfo error]} {
set c [a+ yellow bold]
lappend chunklist [list "info" "${c}error [dict get $exitinfo error]$n"]
lappend chunklist [list "info" "errorCode [dict get $exitinfo errorCode]"]
@ -330,7 +331,7 @@ namespace eval shellrun {
} else {
set o $::shellrun::runout
}
append chunk "$o"
append chunk "$o"
}
lappend chunklist [list result $chunk]
@ -347,7 +348,7 @@ namespace eval shellrun {
proc runerr {args} {
#set_last_run_display [list]
variable runout
variable runout
variable runerr
set runout ""
set runerr ""
@ -398,17 +399,15 @@ namespace eval shellrun {
set n [a]
set c ""
if [dict exists $exitinfo exitcode] {
if {[dict exists $exitinfo exitcode]} {
set code [dict get $exitinfo exitcode]
if {$code == 0} {
set c [a+ green]
} else {
set c [a+ white bold]
}
lappend chunklist [list "info" "$c$exitinfo$n"]
} elseif [dict exists $exitinfo error] {
} elseif {[dict exists $exitinfo error]} {
set c [a+ yellow bold]
lappend chunklist [list "info" "error [dict get $exitinfo error]"]
lappend chunklist [list "info" "errorCode [dict get $exitinfo errorCode]"]
@ -459,8 +458,8 @@ namespace eval shellrun {
proc runx {args} {
#set_last_run_display [list]
variable runout
#set_last_run_display [list]
variable runout
variable runerr
set runout ""
set runerr ""
@ -491,7 +490,7 @@ namespace eval shellrun {
set stderr_stackid [shellfilter::stack::add stderr var -action float-locked -junction 1 -settings {-varname ::shellrun::runerr}]
set stdout_stackid [shellfilter::stack::add stdout var -action float-locked -junction 1 -settings {-varname ::shellrun::runout}]
}
set callopts ""
if {"-tcl" in $runopts} {
append callopts " -tclscript 1"
@ -505,7 +504,7 @@ namespace eval shellrun {
flush stderr
flush stdout
if {[dict exists $exitinfo error]} {
if {"-tcl" in $runopts} {
@ -514,7 +513,7 @@ namespace eval shellrun {
error [dict get $exitinfo error]
}
}
#set x [shellfilter::stack::add stdout var -action sink-locked -settings {-varname ::repl::runxoutput}]
set chunk ""
@ -568,7 +567,7 @@ namespace eval shellrun {
set exitdict [list exitcode $code]
} elseif {[dict exists $exitinfo result]} {
# presumably from a -tcl call
set val [dict get $exitinfo result]
set val [dict get $exitinfo result]
lappend chunklist [list "info" " "]
lappend chunklist [list "result" result]
lappend chunklist [list "info" result]
@ -626,15 +625,15 @@ namespace eval shellrun {
#we can only call runraw with a single (presumably braced) string if we want to use it from both repl and tcl scripts (why? todo with unbalanced quotes/braces?)
proc runraw {commandline} {
#runraw fails as intended - because we can't bypass exec/open interference quoting :/
error "shellthread::worker::start_pipe_read - inpipe not configured. Use shellthread::manager::set_pipe_read_from_client to thread::transfer the pipe end"
error "shellthread::worker::start_pipe_read - inpipe not configured. Use shellthread::manager::set_pipe_read_from_client to thread::transfer the pipe end"
can configure $writechan -buffering $writebuffering
}
}
if {$writechan ni [chan names]} {
error "shellthread::worker::start_pipe_write - outpipe not configured. Use shellthread::manager::set_pipe_write_to_client to thread::transfer the pipe end"
error "shellthread::worker::start_pipe_write - outpipe not configured. Use shellthread::manager::set_pipe_write_to_client to thread::transfer the pipe end"
}
set outpipe $writechan
chan configure $readchan -blocking 0
chan configure $writechan -blocking 0
set waitvar ::shellthread::worker::wait($outpipe,[clock micros])
#for cooked - always remove the trailing newline before splitting..
#for cooked - always remove the trailing newline before splitting..
#
#note that if we got our data from reading a non-line-buffered binary channel - then this naive line splitting will not split neatly for mixed line-endings.
#
#Possibly not critical as cooked is for logging and we are still preserving all \r and \n chars - but review and consider implementing a better split
#but add it back exactly as it was afterwards
#but add it back exactly as it was afterwards
#we can always split on \n - and any adjacent \r will be preserved in the rejoin
set lastchar [string range $logchunk end end]
if {[string range $logchunk end-1 end] eq "\r\n"} {
#If the thread which started the thread calls leave_worker with that 'primary' sourcetag it means others won't be able to use that target - which seems reasonable.
#If another thread want's to maintain joinability beyond the span provided by the starting client,
#it can join with both the primary tag and a tag it will actually use for logging.
#A thread can join the logger with any existingtag - not just the 'primary'
#A thread can join the logger with any existingtag - not just the 'primary'
#(which is arbitrary anyway. It will usually be the first in the list - but may be unsubscribed by clients and disappear)
#it is up to caller to use a unique sourcetag (e.g by prefixing with own thread::id etc)
# This allows multiple threads to more easily write to the same named sourcetag if necessary
# todo - change sourcetag for a list of tags which will be handled by the same thread. e.g for multiple threads logging to same file
# todo - change sourcetag for a list of tags which will be handled by the same thread. e.g for multiple threads logging to same file
#
# todo - some protection mechanism for case where target is a file to stop creation of multiple worker threads writing to same file.
# Even if we use open fd,close fd wrapped around writes.. it is probably undesirable to have multiple threads with same target
# Even if we use open fd,close fd wrapped around writes.. it is probably undesirable to have multiple threads with same target
# On the other hand socket targets such as UDP can happily be written to by multiple threads.
# For now the mechanism is that a call to new_worker (rename to open_worker?) will join the same thread if a sourcetag matches..
# For now the mechanism is that a call to new_worker (rename to open_worker?) will join the same thread if a sourcetag matches.
# but, as sourcetags can get removed(unsubbed via leave_worker) this doesn't guarantee two threads with same -file settings won't fight.
# Also.. the settingsdict is ignored when joining with a tag that exists.. this is problematic.. e.g logrotation where previous file still being written by existing worker
# todo - rename 'sourcetag' concept to 'targettag' ?? the concept is a mixture of both.. it is somewhat analagous to a syslog 'facility'
# todo - rename 'sourcetag' concept to 'targettag' ?? the concept is a mixture of both.. it is somewhat analagous to a syslog 'facility'
# probably new_worker should disallow auto-joining and we allow different workers to handle same tags simultaneously to support overlap during logrotation etc.
set ts_end_list [dict get $workers $source ts_end_list] ;#ts_end_list is just a list of timestamps of closing calls for this source - only one is needed to close, but they may all come in a flurry.
if {[llength $ts_end_list]} {
set last_end_ts [lindex $ts_end_list end]
if {[expr {(($tsnow - $last_end_ts) / 1000) >= $timeout}]} {
if {(($tsnow - $last_end_ts) / 1000) >= $timeout} {
