Browse Source
make.tcl vfscommonupdate -confirm 0 after the 0.12.4 modules build. Besides punk::args 0.12.3 -> 0.12.4 (collision-aware resolve miss path), the REPLACE pass brought _vfscommon.vfs up to date with built modules that had not been propagated since the 0.12.37 refresh: cap handlers templates 0.2.0, mix base 0.1.1, mix commandsets layout/module/scriptwrap 0.1.1 + project 0.2.2, mix templates 0.1.5, fauxlink 0.1.2/0.2.0, tomlish 1.1.12 + test module catch-up (test/tomlish-1.1.5 content matches built copy). make.tcl project -confirm 0 rebuilt the kits: punkbi.exe and punksys.exe deployed to bin/; punk91.exe and punk902z.exe builds succeeded but deployment to bin/ was blocked by running shell instances holding the binaries (fresh kits left in src/_build - redeploy after closing shells). Kit executables are not tracked; this checkin is the vfs source tree only. argparsingtest work (module 0.2.0, tests) deliberately left uncommitted; its derived vfs artifacts (argparsingtest-0.1.0.tm removal / 0.2.0.tm addition) are likewise excluded from this checkin. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
12 changed files with 11325 additions and 50 deletions
@ -0,0 +1,726 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2024 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application fauxlink 0.1.2 |
||||
# Meta platform tcl |
||||
# Meta license MIT |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin fauxlink_module_fauxlink 0 0.1.2] |
||||
#[copyright "2024"] |
||||
#[titledesc {faux link application shortcuts}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {.fauxlink .fxlnk}] [comment {-- Description at end of page heading --}] |
||||
#[require fauxlink] |
||||
#[keywords symlink faux fake shortcut toml] |
||||
#[description] |
||||
#[para] A cross platform shortcut/symlink alternative. |
||||
#[para] Unapologetically ugly - but practical in certain circumstances. |
||||
#[para] A solution is required for application-driven filesystem links that survives cross platform moves as well as |
||||
#[para] archiving and packaging systems. |
||||
#[para] The target is specified in a minimally-encoded form in the filename itself - but still human readable. |
||||
#[para] format of name <nominalname>#<encodedtarget>.fauxlink |
||||
#[para] where <nominalname> can be empty - then the effective nominal name is the tail of the <encodedtarget> |
||||
#[para] The file extension must be .fauxlink or .fxlnk |
||||
#[para] The + symbol substitutes for forward-slashes. |
||||
#[para] Other chars can be encoded using url-like encoding - (but only up to %7E !) |
||||
#[para] We deliberately treat higher % sequences literally. |
||||
#[para] This means actual uri::urn encoded unicode sequences (e.g %E2%99%A5 [lb]heart[rb]) can remain literal for linking to urls. |
||||
#[para] e.g if an actual + or # is required in a filename or path segment they can be encoded as %2B & %23 |
||||
#[para] e.g a link to a file file#A.txt in parent dir could be: |
||||
#[para] file%23A.txt#..+file%23A.txt.fauxlink |
||||
#[para] or equivalently (but obviously affecting sorting) #..+file%23A.txt.fauxlink |
||||
#[para] The <nominalname> can be unrelated to the actual target |
||||
#[para] e.g datafile.dat#..+file%23A.txt.fauxlink |
||||
#[para] This system has no filesystem support - and must be completely application driven. |
||||
#[para] This can be useful for example in application test packages which may be tarred or zipped and moved cross platform. |
||||
#[para] The target being fully specified in the name means the file doesn't have to be read for the target to be determined |
||||
#[para] Extensions to behaviour should be added in the file as text data in Toml format, |
||||
#[para] with custom data being under a single application-chosen table name |
||||
#[para] The toplevel Toml table [lb]fauxlink[rb] is reserved for core extensions to this system. |
||||
#[para] Aside from the 2 used for delimiting (+ #) |
||||
#[para] certain characters which might normally be allowed in filesystems are required to be encoded |
||||
#[para] e.g space and tab are required to be %20 %09 |
||||
#[para] Others that require encoding are: * ? \ / | : ; " < > |
||||
#[para] The nul character in raw form, when detected, is always mapped away to the empty string - as very few filesystems support it. |
||||
#[para] Control characters and other punctuation is optional to encode. |
||||
#[para] Generally utf-8 should be used where possible and unicode characters can often be left unencoded on modern systems. |
||||
#[para] Where encoding of unicode is desired in the nominalname,encodedtarget,tag or comment portions it can be specified as %UXXXXXXXX |
||||
#[para] There must be between 1 and 8 X digits following the %U. Interpretation of chars following %U stops at the first non-hex character. |
||||
#[para] This means %Utest would not get any translation as there were no hex digits so it would come out as %Utest |
||||
# |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#https://learn.microsoft.com/en-us/troubleshoot/windows-client/networking/url-encoding-unc-paths-not-url-decoded |
||||
# ie "//server/c/Program files" works but "//server/c/Program%20Files" is now treated by windows as a literal path with %20 in it. |
||||
#Using fauxlink - a link would be: |
||||
# "my-program-files#++server+c+Program%20Files.fauxlink" |
||||
#If we needed the old-style literal %20 it would become |
||||
# "my-program-files#++server+c+Program%2520Files.fauxlink" |
||||
# |
||||
# The file:// scheme on windows supposedly *does* decode %xx (for use in a browser) |
||||
# e.g |
||||
# pfiles#file%3a++++localhost+c+Program%2520files |
||||
# The browser will work with literal spaces too though - so it could just as well be: |
||||
# pfiles#file%3a++++localhost+c+Program%20files |
||||
#windows may default to using explorer.exe instead of a browser for file:// urls though |
||||
#and explorer doesn't want the literal %20. It probably depends what API the file:// url is to be passed to? |
||||
#in a .url shortcut either literal space or %20 will work ie %xx values are decoded |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of fauxlink |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by fauxlink |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6-}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# oo::class namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval fauxlink::class { |
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink::class}] |
||||
#[para] class definitions |
||||
if {[info commands [namespace current]::interface_sample1] eq ""} { |
||||
#*** !doctools |
||||
#[list_begin enumerated] |
||||
|
||||
# oo::class create interface_sample1 { |
||||
# #*** !doctools |
||||
# #[enum] CLASS [class interface_sample1] |
||||
# #[list_begin definitions] |
||||
|
||||
# method test {arg1} { |
||||
# #*** !doctools |
||||
# #[call class::interface_sample1 [method test] [arg arg1]] |
||||
# #[para] test method |
||||
# puts "test: $arg1" |
||||
# } |
||||
|
||||
# #*** !doctools |
||||
# #[list_end] [comment {-- end definitions interface_sample1}] |
||||
# } |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end class enumeration ---}] |
||||
} |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval fauxlink { |
||||
namespace export {[a-z]*}; # Convention: export all lowercase |
||||
|
||||
#punk::args documentation blocks (PUNKARGS) are the maintained documentation source for this module. |
||||
#They are inert data unless/until punk::args is loaded (registration mechanism at bottom of file). |
||||
#The doctools comment header above is retained for the legacy doc pipeline but the PUNKARGS text governs on divergence. |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id "(package)fauxlink" |
||||
@package -name "fauxlink" -help\ |
||||
"A cross-platform application-driven shortcut/symlink alternative. |
||||
Unapologetically ugly - but practical in certain circumstances. |
||||
|
||||
A fauxlink is an ordinary file whose target is minimally encoded in the |
||||
filename itself - so the file never needs to be read for the target to |
||||
be determined, and the link survives cross-platform moves, archiving |
||||
and packaging systems. There is no filesystem support: resolution is |
||||
entirely application driven. |
||||
|
||||
Filename format: |
||||
<nominalname>#<encodedtarget>.fauxlink |
||||
<nominalname>#<encodedtarget>#<comment>.fauxlink |
||||
<nominalname>#<encodedtarget>#<tagset>#<comment>...#<comment>.fauxlink |
||||
The file extension must be .fauxlink or .fxlnk |
||||
<nominalname> may be empty - the effective name is then the tail of the |
||||
decoded target. A tagset is either empty or begins with @, with tags |
||||
separated by further @ characters (e.g @tag1@tag2). When exactly three |
||||
#-delimited sections are present the third is a comment, even if it |
||||
looks like a tagset - an explicit (possibly empty) tagset section is |
||||
required for tags. Empty comments are dropped. |
||||
|
||||
Encoding within any section: |
||||
+ substitutes for forward slash in the target path |
||||
(leading ++ therefore produces a //server style UNC path) |
||||
%XX url-style encoding is supported up to %7E only - higher %XX |
||||
sequences are deliberately left literal so uri/urn encoded |
||||
unicode in url targets can remain literal |
||||
%UXXXXXXXX (1 to 8 hex digits) encodes a unicode codepoint |
||||
Characters that MUST be %XX encoded when meant literally: |
||||
+ # * ? \\ / | : ; \" < > space tab and control characters 01-1F |
||||
(e.g %2B %23 %20 %09). A raw NUL character maps to empty string. |
||||
The forward slash has no %XX decoding (use +) and %UXXXXXXXX escapes |
||||
resolving to the default exclusions (/ LF CR NUL) are left unresolved. |
||||
|
||||
File content is reserved for future extension as TOML data: the |
||||
toplevel TOML table name 'fauxlink' is reserved for core extensions; |
||||
applications may use a single application-chosen table name. |
||||
|
||||
The primary API is fauxlink::resolve - which parses a fauxlink |
||||
filename and returns a dict with keys: |
||||
name targetpath tags comments fauxlinkextension" |
||||
}] |
||||
|
||||
#todo - enforce utf-8 |
||||
|
||||
#literal unicode chars supported by modern filesystems - leave as is - REVIEW |
||||
|
||||
|
||||
variable encode_map |
||||
variable decode_map |
||||
#most filesystems don't allow NULL - map to empty string |
||||
|
||||
#Make sure % is not in encode_map |
||||
set encode_map [dict create\ |
||||
\x00 ""\ |
||||
{ } %20\ |
||||
\t %09\ |
||||
+ %2B\ |
||||
# %23\ |
||||
* %2A\ |
||||
? %3F\ |
||||
\\ %5C\ |
||||
/ %2F\ |
||||
| %7C\ |
||||
: %3A\ |
||||
{;} %3B\ |
||||
{"} %22\ |
||||
< %3C\ |
||||
> %3E\ |
||||
] |
||||
#above have some overlap with ctrl codes below. |
||||
#no big deal as it's a dict |
||||
|
||||
#must_encode |
||||
# + # * ? \ / | : ; " < > <sp> \t |
||||
# also NUL to empty string |
||||
|
||||
# also ctrl chars 01 to 1F (1..31) |
||||
for {set i 1} {$i < 32} {incr i} { |
||||
set ch [format %c $i] |
||||
set enc "%[format %02X $i]" |
||||
set enc_lower [string tolower $enc] |
||||
dict set encode_map $ch $enc |
||||
dict set decode_map $enc $ch |
||||
dict set decode_map $enc_lower $ch |
||||
} |
||||
|
||||
variable must_encode |
||||
set must_encode [dict keys $encode_map] |
||||
|
||||
|
||||
|
||||
#decode map doesn't include |
||||
# %00 (nul) |
||||
# %2F "/" |
||||
# %2f "/" |
||||
# %7f (del) |
||||
#we exlude the forward slash because we already have + for that - and multiple ways to specify it obscure intention. |
||||
# |
||||
set decode_map [dict merge $decode_map [dict create\ |
||||
%09 \t\ |
||||
%20 { }\ |
||||
%21 "!"\ |
||||
%22 {"}\ |
||||
%23 "#"\ |
||||
%24 "$"\ |
||||
%25 "%"\ |
||||
%26 "&"\ |
||||
%27 "'"\ |
||||
%28 "("\ |
||||
%29 ")"\ |
||||
%2A "*"\ |
||||
%2a "*"\ |
||||
%2B "+"\ |
||||
%2b "+"\ |
||||
%2C ","\ |
||||
%2c ","\ |
||||
%2D "-"\ |
||||
%2d "-"\ |
||||
%2E "."\ |
||||
%2e "."\ |
||||
%3A ":"\ |
||||
%3a ":"\ |
||||
%3B {;}\ |
||||
%3b {;}\ |
||||
%3D "="\ |
||||
%3C "<"\ |
||||
%3c "<"\ |
||||
%3d "="\ |
||||
%3E ">"\ |
||||
%3e ">"\ |
||||
%3F "?"\ |
||||
%3f "?"\ |
||||
%40 "@"\ |
||||
%5B "\["\ |
||||
%5b "\["\ |
||||
%5C "\\"\ |
||||
%5c "\\"\ |
||||
%5D "\]"\ |
||||
%5d "\]"\ |
||||
%5E "^"\ |
||||
%5e "^"\ |
||||
%60 "`"\ |
||||
%7B "{"\ |
||||
%7b "{"\ |
||||
%7C "|"\ |
||||
%7c "|"\ |
||||
%7D "}"\ |
||||
%7d "}"\ |
||||
%7E "~"\ |
||||
%7e "~"\ |
||||
]] |
||||
#Don't go above 7f |
||||
#if we want to specify p |
||||
|
||||
|
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink}] |
||||
#[para] Core API functions for fauxlink |
||||
#[list_begin definitions] |
||||
proc Segment_mustencode_check {str} { |
||||
variable decode_map |
||||
variable encode_map ;#must_encode |
||||
set idx 0 |
||||
set err "" |
||||
foreach ch [split $str ""] { |
||||
if {[dict exists $encode_map $ch]} { |
||||
set enc [dict get $encode_map $ch] |
||||
if {[dict exists $decode_map $enc]} { |
||||
append err " char $idx should be encoded as $enc" \n |
||||
} else { |
||||
append err " no %xx encoding available. Use %UXX if really required" \n |
||||
} |
||||
} |
||||
incr idx |
||||
} |
||||
return $err ;#empty string if ok |
||||
} |
||||
|
||||
namespace eval argdoc { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::fauxlink::resolve |
||||
@cmd -name fauxlink::resolve\ |
||||
-summary\ |
||||
"Parse a fauxlink filename and return its target info as a dict."\ |
||||
-help\ |
||||
"Parse the fauxlink encoding in the filename of link and return a dict |
||||
with the keys: |
||||
name - the nominal name (section before the first #), |
||||
decoded. If empty in the link, the tail segment |
||||
of the decoded target is used. |
||||
targetpath - the decoded target path. + separated segments |
||||
are joined with forward slashes (a leading ++ |
||||
yields a //server style path). |
||||
tags - list of decoded tags from the tagset section |
||||
(4 or more #-delimited sections; tagset begins |
||||
with @). Empty when no tagset present. |
||||
comments - list of decoded non-empty comments. |
||||
fauxlinkextension - the link's extension without the dot |
||||
(normally fauxlink or fxlnk). |
||||
Only the file tail of link is parsed - any directory part is ignored. |
||||
The file itself is never read (it need not exist). |
||||
|
||||
Characters that must be %XX encoded (see the package help) appearing |
||||
raw in a name/target/tag/comment section raise an error, as does a |
||||
missing # separator or a malformed tagset. %UXXXXXXXX escapes are |
||||
decoded via fauxlink::decode_unicode_escapes with its default |
||||
exclusions. |
||||
|
||||
If the extension is not .fauxlink or .fxlnk the parse still proceeds, |
||||
but the result is wrapped so blind calls on the wrong file type can't |
||||
be mistaken for a standard resolve: the returned dict then has the |
||||
keys: linktype (the nonstandard extension), note, and data (the dict |
||||
described above)." |
||||
@values -min 1 -max 1 |
||||
link -type string -help\ |
||||
"Path or bare filename of the fauxlink (e.g name.txt#..+dir+name.txt.fauxlink)" |
||||
}] |
||||
} |
||||
proc resolve {link} { |
||||
variable decode_map |
||||
variable encode_map |
||||
variable must_encode |
||||
set ftail [file tail $link] |
||||
set extension_name [string range [file extension $ftail] 1 end] |
||||
if {$extension_name ni [list fxlnk fauxlink]} { |
||||
set is_fauxlink 0 |
||||
#we'll process anyway - but return the result wrapped |
||||
#This should allow deliberate erroring for the calling dict user if the extension difference is inadvertent |
||||
#(e.g blindly processing all files in a folder that is normally only .fauxlink files - but then something added that happens |
||||
# to have # characters in it) |
||||
#It also means if someone really wants to use the fauxlink semantics on a different file type |
||||
# - they can - but just have to access the results differently and take that (minor) risk. |
||||
#error "fauxlink::resolve refusing to process link $link - file extension must be .fxlnk or .fauxlink" |
||||
set err_extra "\nnonstandard extension '$extension_name' for fauxlink. (expected .fxlnk or .fauxlink) Check that the call to fauxlink::resolve was deliberate" |
||||
} else { |
||||
set is_fauxlink 1 |
||||
set err_extra "" |
||||
} |
||||
set linkspec [file rootname $ftail] |
||||
# - any # or + within the target path or name should have been uri encoded as %23 and %2b |
||||
if {[tcl::string::first # $linkspec] < 0} { |
||||
set err "fauxlink::resolve '$link'. Link must contain a # (usually at start if name matches target)" |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
#The 1st 2 parts of split on # are name and target file/dir |
||||
#If there are only 3 parts the 3rd part is a comment and there are no 'tags' |
||||
#if there are 4 parts - the 3rd part is a tagset where each tag begins with @ |
||||
#and each subsequent part is a comment. Empty comments are stripped from the comments list |
||||
#A tagset can be empty - but if it's not empty it must contain at least one @ and must start with @ |
||||
#e.g name.txt#path#@tag1@tag2#test###.fauxlink |
||||
#has a name, a target, 2 tags and one comment |
||||
|
||||
#check namespec already has required chars encoded |
||||
set segments [split $linkspec #] |
||||
lassign $segments namespec targetspec |
||||
#puts stderr "-->namespec $namespec" |
||||
set nametest [tcl::string::map $encode_map $namespec] |
||||
#puts stderr "-->nametest $nametest" |
||||
#nothing should be changed - if there are unencoded chars that must be encoded it is an error |
||||
if {[tcl::string::length $nametest] ne [tcl::string::length $namespec]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in name part (section prior to first #)" |
||||
append err [Segment_mustencode_check $namespec] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
#see comments below regarding 2 rounds and ordering. |
||||
set name [decode_unicode_escapes $namespec] |
||||
set name [tcl::string::map $decode_map $name] |
||||
#puts stderr "-->name: $name" |
||||
|
||||
set targetsegment [split $targetspec +] |
||||
#check each + delimited part of targetspec already has required chars encoded |
||||
set pp 0 ;#pathpart index |
||||
set targetpath_parts [list] |
||||
foreach pathpart $targetsegment { |
||||
set targettest [tcl::string::map $encode_map $pathpart] |
||||
if {[tcl::string::length $targettest] ne [tcl::string::length $pathpart]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in targetpath (section following first #)" |
||||
append err [Segment_mustencode_check $pathpart] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
#2 rounds of substitution is possibly asking for trouble.. |
||||
#We allow anything in the resultant segments anyway (as %UXXXX... allows all) |
||||
#so it's not so much about what can be encoded, |
||||
# - but it makes it harder to reason about for users |
||||
# In particular - if we map %XX first it makes %25 -> % substitution tricky |
||||
# if the user requires a literal %UXXX - they can't do %25UXXX |
||||
# the double sub would make it %UXXX -> somechar anyway. |
||||
#we do unicode first - as a 2nd round of %XX substitutions is unlikely to interfere. |
||||
#There is still the opportunity to use things like %U00000025 followed by hex-chars |
||||
# and get some minor surprises, but using %U on ascii is unlikely to be done accidentally - REVIEW |
||||
set pathpart [decode_unicode_escapes $pathpart] |
||||
set pathpart [tcl::string::map $decode_map $pathpart] |
||||
lappend targetpath_parts $pathpart |
||||
|
||||
incr pp |
||||
} |
||||
set targetpath [join $targetpath_parts /] |
||||
if {$name eq ""} { |
||||
set name [lindex $targetpath_parts end] |
||||
} |
||||
#we do the same encoding checks on tags and comments to increase chances of portability |
||||
set tags [list] |
||||
set comments [list] |
||||
switch -- [llength $segments] { |
||||
2 { |
||||
#no tags or comments |
||||
} |
||||
3 { |
||||
#only 3 sections - last is comment - even if looks like tags |
||||
#to make the 3rd part a tagset, an extra # would be needed |
||||
set c [lindex $segments 2] |
||||
if {$c ne ""} { |
||||
#same validation/decoding as the multi-comment case below |
||||
set commenttest [tcl::string::map $encode_map $c] |
||||
if {[tcl::string::length $commenttest] ne [tcl::string::length $c]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in comment 0" |
||||
append err [Segment_mustencode_check $c] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
set comments [list [tcl::string::map $decode_map [decode_unicode_escapes $c]]] |
||||
} |
||||
} |
||||
default { |
||||
set tagset [lindex $segments 2] |
||||
if {$tagset eq ""} { |
||||
#ok - no tags |
||||
} else { |
||||
if {[string first @ $tagset] != 0} { |
||||
set err "fauxlink::resolve '$link' invalid tagset in 3rd #-delimited segment" |
||||
append err \n " - must begin with @" |
||||
append err $err_extra |
||||
error $err |
||||
} else { |
||||
set tagset [string range $tagset 1 end] |
||||
set rawtags [split $tagset @] |
||||
set tags [list] |
||||
foreach t $rawtags { |
||||
if {$t eq ""} { |
||||
lappend tags "" |
||||
} else { |
||||
set tagtest [tcl::string::map $encode_map $t] |
||||
if {[tcl::string::length $tagtest] ne [tcl::string::length $t]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in tag [llength $tags]" |
||||
append err [Segment_mustencode_check $t] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
lappend tags [tcl::string::map $decode_map [decode_unicode_escapes $t]] |
||||
} |
||||
} |
||||
} |
||||
} |
||||
set rawcomments [lrange $segments 3 end] |
||||
#set comments [lsearch -all -inline -not $comments ""] |
||||
set comments [list] |
||||
foreach c $rawcomments { |
||||
if {$c eq ""} {continue} |
||||
set commenttest [tcl::string::map $encode_map $c] |
||||
if {[tcl::string::length $commenttest] ne [tcl::string::length $c]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in comment [llength $comments]" |
||||
append err [Segment_mustencode_check $c] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
lappend comments [tcl::string::map $decode_map [decode_unicode_escapes $c]] |
||||
} |
||||
} |
||||
} |
||||
|
||||
set data [dict create name $name targetpath $targetpath tags $tags comments $comments fauxlinkextension $extension_name] |
||||
if {$is_fauxlink} { |
||||
#standard .fxlnk or .fauxlink |
||||
return $data |
||||
} else { |
||||
#custom extension - or called in error on wrong type of file but happened to parse. |
||||
#see comments at top regarding is_fauxlink |
||||
#make sure no keys in common at top level. |
||||
return [dict create\ |
||||
linktype $extension_name\ |
||||
note "nonstandard extension returning nonstandard dict with result in data key"\ |
||||
data $data\ |
||||
] |
||||
} |
||||
} |
||||
variable map |
||||
|
||||
namespace eval argdoc { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::fauxlink::decode_unicode_escapes |
||||
@cmd -name fauxlink::decode_unicode_escapes\ |
||||
-summary\ |
||||
"Substitute %UXXXXXXXX unicode escapes in a string."\ |
||||
-help\ |
||||
"Return str with each %U escape followed by 1 to 8 hex digits replaced |
||||
by the unicode character for that codepoint. Interpretation of digits |
||||
stops at the first non-hex character or at 8 digits, whichever comes |
||||
first. A %U followed by no hex digits is left untouched (so %Utest |
||||
comes out as %Utest). |
||||
|
||||
An escape whose resolved character is in the exclusions list is left |
||||
in its escaped form. The default exclusions are forward slash, LF, CR |
||||
and NUL - the forward slash exclusion exists because + is the fauxlink |
||||
path separator and alternate spellings would obscure intention." |
||||
@values -min 1 -max 2 |
||||
str -type string -help\ |
||||
"String possibly containing %UXXXXXXXX escapes" |
||||
exclusions -type list -optional 1 -default {/ \n \r \x00} -help\ |
||||
"List of decoded characters that must NOT be substituted - matching |
||||
escapes are left in %U form. (Tcl list backslash forms: the default |
||||
excludes / LF CR NUL)" |
||||
}] |
||||
} |
||||
#default exclusion of / (%U2f and equivs) |
||||
#this would allow obfuscation of intention - when we have + for that anyway |
||||
proc decode_unicode_escapes {str {exclusions {/ \n \r \x00}}} { |
||||
variable map |
||||
set ucstart [string first %U $str 0] |
||||
if {$ucstart < 0} { |
||||
return $str |
||||
} |
||||
set max 8 |
||||
set map [list] |
||||
set strend [expr {[string length $str]-1}] |
||||
while {$ucstart >= 0} { |
||||
set s $ucstart |
||||
set i [expr {$s +2}] ;#skip the %U |
||||
set hex "" |
||||
while {[tcl::string::length $hex] < 8 && $i <= $strend} { |
||||
set in [string index $str $i] |
||||
if {[tcl::string::is xdigit -strict $in]} { |
||||
append hex $in |
||||
} else { |
||||
break |
||||
} |
||||
incr i |
||||
} |
||||
if {$hex ne ""} { |
||||
incr i -1 |
||||
lappend map $s $i $hex |
||||
} |
||||
set ucstart [tcl::string::first %U $str $i] |
||||
} |
||||
if {![llength $map]} { |
||||
#%U present but no valid escapes (no hex digits) - nothing to substitute |
||||
return $str |
||||
} |
||||
set out "" |
||||
set lastidx -1 |
||||
set e 0 |
||||
foreach {s e hex} $map { |
||||
append out [string range $str $lastidx+1 $s-1] |
||||
set sub [format %c 0x$hex] |
||||
if {$sub in $exclusions} { |
||||
append out %U$hex ;#put it back |
||||
} else { |
||||
append out $sub |
||||
} |
||||
set lastidx $e |
||||
} |
||||
if {$e < [tcl::string::length $str]-1} { |
||||
append out [string range $str $e+1 end] |
||||
} |
||||
return $out |
||||
} |
||||
namespace eval argdoc { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::fauxlink::link_as |
||||
@cmd -name fauxlink::link_as\ |
||||
-summary\ |
||||
"NOT YET IMPLEMENTED - encode a name and target as a fauxlink filename."\ |
||||
-help\ |
||||
"Reserved API - not yet implemented; currently raises an error. |
||||
Intended to perform the encoding counterpart of fauxlink::resolve: |
||||
produce the fauxlink filename for a given nominal name and target |
||||
path, applying the required %XX encodings and + path separators." |
||||
@values -min 2 -max 2 |
||||
name -type string -help\ |
||||
"Nominal name for the link (may be empty to default to the target tail)" |
||||
target -type string -help\ |
||||
"Target path the link should resolve to" |
||||
}] |
||||
} |
||||
proc link_as {name target} { |
||||
#todo - implement the encoder counterpart of resolve |
||||
error "fauxlink::link_as not yet implemented" |
||||
} |
||||
|
||||
#proc sample1 {p1 args} { |
||||
# #*** !doctools |
||||
# #[call [fun sample1] [arg p1] [opt {?option value...?}]] |
||||
# #[para]Description of sample1 |
||||
# return "ok" |
||||
#} |
||||
|
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace fauxlink ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval fauxlink::lib { |
||||
namespace export {[a-z]*}; # Convention: export all lowercase |
||||
namespace path [namespace parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink::lib}] |
||||
#[para] Secondary functions that are part of the API |
||||
#[list_begin definitions] |
||||
|
||||
#proc utility1 {p1 args} { |
||||
# #*** !doctools |
||||
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] |
||||
# #[para]Description of utility1 |
||||
# return 1 |
||||
#} |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace fauxlink::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
namespace eval fauxlink::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
#This is inert documentation registration - it does not load or require punk::args. |
||||
lappend ::punk::args::register::NAMESPACES ::fauxlink |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide fauxlink [namespace eval fauxlink { |
||||
variable pkg fauxlink |
||||
variable version |
||||
set version 0.1.2 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
@ -0,0 +1,824 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2024 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application fauxlink 0.2.0 |
||||
# Meta platform tcl |
||||
# Meta license MIT |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin fauxlink_module_fauxlink 0 0.2.0] |
||||
#[copyright "2024"] |
||||
#[titledesc {faux link application shortcuts}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {.fauxlink .fxlnk}] [comment {-- Description at end of page heading --}] |
||||
#[require fauxlink] |
||||
#[keywords symlink faux fake shortcut toml] |
||||
#[description] |
||||
#[para] A cross platform shortcut/symlink alternative. |
||||
#[para] Unapologetically ugly - but practical in certain circumstances. |
||||
#[para] A solution is required for application-driven filesystem links that survives cross platform moves as well as |
||||
#[para] archiving and packaging systems. |
||||
#[para] The target is specified in a minimally-encoded form in the filename itself - but still human readable. |
||||
#[para] format of name <nominalname>#<encodedtarget>.fauxlink |
||||
#[para] where <nominalname> can be empty - then the effective nominal name is the tail of the <encodedtarget> |
||||
#[para] The file extension must be .fauxlink or .fxlnk |
||||
#[para] The + symbol substitutes for forward-slashes. |
||||
#[para] Other chars can be encoded using url-like encoding - (but only up to %7E !) |
||||
#[para] We deliberately treat higher % sequences literally. |
||||
#[para] This means actual uri::urn encoded unicode sequences (e.g %E2%99%A5 [lb]heart[rb]) can remain literal for linking to urls. |
||||
#[para] e.g if an actual + or # is required in a filename or path segment they can be encoded as %2B & %23 |
||||
#[para] e.g a link to a file file#A.txt in parent dir could be: |
||||
#[para] file%23A.txt#..+file%23A.txt.fauxlink |
||||
#[para] or equivalently (but obviously affecting sorting) #..+file%23A.txt.fauxlink |
||||
#[para] The <nominalname> can be unrelated to the actual target |
||||
#[para] e.g datafile.dat#..+file%23A.txt.fauxlink |
||||
#[para] This system has no filesystem support - and must be completely application driven. |
||||
#[para] This can be useful for example in application test packages which may be tarred or zipped and moved cross platform. |
||||
#[para] The target being fully specified in the name means the file doesn't have to be read for the target to be determined |
||||
#[para] Extensions to behaviour should be added in the file as text data in Toml format, |
||||
#[para] with custom data being under a single application-chosen table name |
||||
#[para] The toplevel Toml table [lb]fauxlink[rb] is reserved for core extensions to this system. |
||||
#[para] Aside from the 2 used for delimiting (+ #) |
||||
#[para] certain characters which might normally be allowed in filesystems are required to be encoded |
||||
#[para] e.g space and tab are required to be %20 %09 |
||||
#[para] Others that require encoding are: * ? \ / | : ; " < > |
||||
#[para] The nul character in raw form, when detected, is always mapped away to the empty string - as very few filesystems support it. |
||||
#[para] Control characters and other punctuation is optional to encode. |
||||
#[para] Generally utf-8 should be used where possible and unicode characters can often be left unencoded on modern systems. |
||||
#[para] Where encoding of unicode is desired in the nominalname,encodedtarget,tag or comment portions it can be specified as %UXXXXXXXX |
||||
#[para] There must be between 1 and 8 X digits following the %U. Interpretation of chars following %U stops at the first non-hex character. |
||||
#[para] This means %Utest would not get any translation as there were no hex digits so it would come out as %Utest |
||||
# |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#https://learn.microsoft.com/en-us/troubleshoot/windows-client/networking/url-encoding-unc-paths-not-url-decoded |
||||
# ie "//server/c/Program files" works but "//server/c/Program%20Files" is now treated by windows as a literal path with %20 in it. |
||||
#Using fauxlink - a link would be: |
||||
# "my-program-files#++server+c+Program%20Files.fauxlink" |
||||
#If we needed the old-style literal %20 it would become |
||||
# "my-program-files#++server+c+Program%2520Files.fauxlink" |
||||
# |
||||
# The file:// scheme on windows supposedly *does* decode %xx (for use in a browser) |
||||
# e.g |
||||
# pfiles#file%3a++++localhost+c+Program%2520files |
||||
# The browser will work with literal spaces too though - so it could just as well be: |
||||
# pfiles#file%3a++++localhost+c+Program%20files |
||||
#windows may default to using explorer.exe instead of a browser for file:// urls though |
||||
#and explorer doesn't want the literal %20. It probably depends what API the file:// url is to be passed to? |
||||
#in a .url shortcut either literal space or %20 will work ie %xx values are decoded |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of fauxlink |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by fauxlink |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6-}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# oo::class namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval fauxlink::class { |
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink::class}] |
||||
#[para] class definitions |
||||
if {[info commands [namespace current]::interface_sample1] eq ""} { |
||||
#*** !doctools |
||||
#[list_begin enumerated] |
||||
|
||||
# oo::class create interface_sample1 { |
||||
# #*** !doctools |
||||
# #[enum] CLASS [class interface_sample1] |
||||
# #[list_begin definitions] |
||||
|
||||
# method test {arg1} { |
||||
# #*** !doctools |
||||
# #[call class::interface_sample1 [method test] [arg arg1]] |
||||
# #[para] test method |
||||
# puts "test: $arg1" |
||||
# } |
||||
|
||||
# #*** !doctools |
||||
# #[list_end] [comment {-- end definitions interface_sample1}] |
||||
# } |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end class enumeration ---}] |
||||
} |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval fauxlink { |
||||
namespace export {[a-z]*}; # Convention: export all lowercase |
||||
|
||||
#punk::args documentation blocks (PUNKARGS) are the maintained documentation source for this module. |
||||
#They are inert data unless/until punk::args is loaded (registration mechanism at bottom of file). |
||||
#The doctools comment header above is retained for the legacy doc pipeline but the PUNKARGS text governs on divergence. |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id "(package)fauxlink" |
||||
@package -name "fauxlink" -help\ |
||||
"A cross-platform application-driven shortcut/symlink alternative. |
||||
Unapologetically ugly - but practical in certain circumstances. |
||||
|
||||
A fauxlink is an ordinary file whose target is minimally encoded in the |
||||
filename itself - so the file never needs to be read for the target to |
||||
be determined, and the link survives cross-platform moves, archiving |
||||
and packaging systems. There is no filesystem support: resolution is |
||||
entirely application driven. |
||||
|
||||
Filename format: |
||||
<nominalname>#<encodedtarget>.fauxlink |
||||
<nominalname>#<encodedtarget>#<comment>.fauxlink |
||||
<nominalname>#<encodedtarget>#<tagset>#<comment>...#<comment>.fauxlink |
||||
The file extension must be .fauxlink or .fxlnk |
||||
<nominalname> may be empty - the effective name is then the tail of the |
||||
decoded target. A tagset is either empty or begins with @, with tags |
||||
separated by further @ characters (e.g @tag1@tag2). When exactly three |
||||
#-delimited sections are present the third is a comment, even if it |
||||
looks like a tagset - an explicit (possibly empty) tagset section is |
||||
required for tags. Empty comments are dropped. |
||||
|
||||
Encoding within any section: |
||||
+ substitutes for forward slash in the target path |
||||
(leading ++ therefore produces a //server style UNC path) |
||||
%XX url-style encoding is supported up to %7E only - higher %XX |
||||
sequences are deliberately left literal so uri/urn encoded |
||||
unicode in url targets can remain literal |
||||
%UXXXXXXXX (1 to 8 hex digits) encodes a unicode codepoint |
||||
Characters that MUST be %XX encoded when meant literally: |
||||
+ # * ? \\ / | : ; \" < > space tab and control characters 01-1F |
||||
(e.g %2B %23 %20 %09). A raw NUL character maps to empty string. |
||||
The forward slash has no %XX decoding (use +) and %UXXXXXXXX escapes |
||||
resolving to the default exclusions (/ LF CR NUL) are left unresolved. |
||||
|
||||
File content is reserved for future extension as TOML data: the |
||||
toplevel TOML table name 'fauxlink' is reserved for core extensions; |
||||
applications may use a single application-chosen table name. |
||||
|
||||
The primary API is fauxlink::resolve - which parses a fauxlink |
||||
filename and returns a dict with keys: |
||||
name targetpath tags comments fauxlinkextension" |
||||
}] |
||||
|
||||
#todo - enforce utf-8 |
||||
|
||||
#literal unicode chars supported by modern filesystems - leave as is - REVIEW |
||||
|
||||
|
||||
variable encode_map |
||||
variable decode_map |
||||
#most filesystems don't allow NULL - map to empty string |
||||
|
||||
#Make sure % is not in encode_map |
||||
set encode_map [dict create\ |
||||
\x00 ""\ |
||||
{ } %20\ |
||||
\t %09\ |
||||
+ %2B\ |
||||
# %23\ |
||||
* %2A\ |
||||
? %3F\ |
||||
\\ %5C\ |
||||
/ %2F\ |
||||
| %7C\ |
||||
: %3A\ |
||||
{;} %3B\ |
||||
{"} %22\ |
||||
< %3C\ |
||||
> %3E\ |
||||
] |
||||
#above have some overlap with ctrl codes below. |
||||
#no big deal as it's a dict |
||||
|
||||
#must_encode |
||||
# + # * ? \ / | : ; " < > <sp> \t |
||||
# also NUL to empty string |
||||
|
||||
# also ctrl chars 01 to 1F (1..31) |
||||
for {set i 1} {$i < 32} {incr i} { |
||||
set ch [format %c $i] |
||||
set enc "%[format %02X $i]" |
||||
set enc_lower [string tolower $enc] |
||||
dict set encode_map $ch $enc |
||||
dict set decode_map $enc $ch |
||||
dict set decode_map $enc_lower $ch |
||||
} |
||||
|
||||
variable must_encode |
||||
set must_encode [dict keys $encode_map] |
||||
|
||||
|
||||
|
||||
#decode map doesn't include |
||||
# %00 (nul) |
||||
# %2F "/" |
||||
# %2f "/" |
||||
# %7f (del) |
||||
#we exlude the forward slash because we already have + for that - and multiple ways to specify it obscure intention. |
||||
# |
||||
set decode_map [dict merge $decode_map [dict create\ |
||||
%09 \t\ |
||||
%20 { }\ |
||||
%21 "!"\ |
||||
%22 {"}\ |
||||
%23 "#"\ |
||||
%24 "$"\ |
||||
%25 "%"\ |
||||
%26 "&"\ |
||||
%27 "'"\ |
||||
%28 "("\ |
||||
%29 ")"\ |
||||
%2A "*"\ |
||||
%2a "*"\ |
||||
%2B "+"\ |
||||
%2b "+"\ |
||||
%2C ","\ |
||||
%2c ","\ |
||||
%2D "-"\ |
||||
%2d "-"\ |
||||
%2E "."\ |
||||
%2e "."\ |
||||
%3A ":"\ |
||||
%3a ":"\ |
||||
%3B {;}\ |
||||
%3b {;}\ |
||||
%3D "="\ |
||||
%3C "<"\ |
||||
%3c "<"\ |
||||
%3d "="\ |
||||
%3E ">"\ |
||||
%3e ">"\ |
||||
%3F "?"\ |
||||
%3f "?"\ |
||||
%40 "@"\ |
||||
%5B "\["\ |
||||
%5b "\["\ |
||||
%5C "\\"\ |
||||
%5c "\\"\ |
||||
%5D "\]"\ |
||||
%5d "\]"\ |
||||
%5E "^"\ |
||||
%5e "^"\ |
||||
%60 "`"\ |
||||
%7B "{"\ |
||||
%7b "{"\ |
||||
%7C "|"\ |
||||
%7c "|"\ |
||||
%7D "}"\ |
||||
%7d "}"\ |
||||
%7E "~"\ |
||||
%7e "~"\ |
||||
]] |
||||
#Don't go above 7f |
||||
#if we want to specify p |
||||
|
||||
|
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink}] |
||||
#[para] Core API functions for fauxlink |
||||
#[list_begin definitions] |
||||
proc Segment_mustencode_check {str} { |
||||
variable decode_map |
||||
variable encode_map ;#must_encode |
||||
set idx 0 |
||||
set err "" |
||||
foreach ch [split $str ""] { |
||||
if {[dict exists $encode_map $ch]} { |
||||
set enc [dict get $encode_map $ch] |
||||
if {[dict exists $decode_map $enc]} { |
||||
append err " char $idx should be encoded as $enc" \n |
||||
} else { |
||||
append err " no %xx encoding available. Use %UXX if really required" \n |
||||
} |
||||
} |
||||
incr idx |
||||
} |
||||
return $err ;#empty string if ok |
||||
} |
||||
|
||||
namespace eval argdoc { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::fauxlink::resolve |
||||
@cmd -name fauxlink::resolve\ |
||||
-summary\ |
||||
"Parse a fauxlink filename and return its target info as a dict."\ |
||||
-help\ |
||||
"Parse the fauxlink encoding in the filename of link and return a dict |
||||
with the keys: |
||||
name - the nominal name (section before the first #), |
||||
decoded. If empty in the link, the tail segment |
||||
of the decoded target is used. |
||||
targetpath - the decoded target path. + separated segments |
||||
are joined with forward slashes (a leading ++ |
||||
yields a //server style path). |
||||
tags - list of decoded tags from the tagset section |
||||
(4 or more #-delimited sections; tagset begins |
||||
with @). Empty when no tagset present. |
||||
comments - list of decoded non-empty comments. |
||||
fauxlinkextension - the link's extension without the dot |
||||
(normally fauxlink or fxlnk). |
||||
Only the file tail of link is parsed - any directory part is ignored. |
||||
The file itself is never read (it need not exist). |
||||
|
||||
Characters that must be %XX encoded (see the package help) appearing |
||||
raw in a name/target/tag/comment section raise an error, as does a |
||||
missing # separator or a malformed tagset. %UXXXXXXXX escapes are |
||||
decoded via fauxlink::decode_unicode_escapes with its default |
||||
exclusions. |
||||
|
||||
If the extension is not .fauxlink or .fxlnk the parse still proceeds, |
||||
but the result is wrapped so blind calls on the wrong file type can't |
||||
be mistaken for a standard resolve: the returned dict then has the |
||||
keys: linktype (the nonstandard extension), note, and data (the dict |
||||
described above)." |
||||
@values -min 1 -max 1 |
||||
link -type string -help\ |
||||
"Path or bare filename of the fauxlink (e.g name.txt#..+dir+name.txt.fauxlink)" |
||||
}] |
||||
} |
||||
proc resolve {link} { |
||||
variable decode_map |
||||
variable encode_map |
||||
variable must_encode |
||||
set ftail [file tail $link] |
||||
set extension_name [string range [file extension $ftail] 1 end] |
||||
if {$extension_name ni [list fxlnk fauxlink]} { |
||||
set is_fauxlink 0 |
||||
#we'll process anyway - but return the result wrapped |
||||
#This should allow deliberate erroring for the calling dict user if the extension difference is inadvertent |
||||
#(e.g blindly processing all files in a folder that is normally only .fauxlink files - but then something added that happens |
||||
# to have # characters in it) |
||||
#It also means if someone really wants to use the fauxlink semantics on a different file type |
||||
# - they can - but just have to access the results differently and take that (minor) risk. |
||||
#error "fauxlink::resolve refusing to process link $link - file extension must be .fxlnk or .fauxlink" |
||||
set err_extra "\nnonstandard extension '$extension_name' for fauxlink. (expected .fxlnk or .fauxlink) Check that the call to fauxlink::resolve was deliberate" |
||||
} else { |
||||
set is_fauxlink 1 |
||||
set err_extra "" |
||||
} |
||||
set linkspec [file rootname $ftail] |
||||
# - any # or + within the target path or name should have been uri encoded as %23 and %2b |
||||
if {[tcl::string::first # $linkspec] < 0} { |
||||
set err "fauxlink::resolve '$link'. Link must contain a # (usually at start if name matches target)" |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
#The 1st 2 parts of split on # are name and target file/dir |
||||
#If there are only 3 parts the 3rd part is a comment and there are no 'tags' |
||||
#if there are 4 parts - the 3rd part is a tagset where each tag begins with @ |
||||
#and each subsequent part is a comment. Empty comments are stripped from the comments list |
||||
#A tagset can be empty - but if it's not empty it must contain at least one @ and must start with @ |
||||
#e.g name.txt#path#@tag1@tag2#test###.fauxlink |
||||
#has a name, a target, 2 tags and one comment |
||||
|
||||
#check namespec already has required chars encoded |
||||
set segments [split $linkspec #] |
||||
lassign $segments namespec targetspec |
||||
#puts stderr "-->namespec $namespec" |
||||
set nametest [tcl::string::map $encode_map $namespec] |
||||
#puts stderr "-->nametest $nametest" |
||||
#nothing should be changed - if there are unencoded chars that must be encoded it is an error |
||||
if {[tcl::string::length $nametest] ne [tcl::string::length $namespec]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in name part (section prior to first #)" |
||||
append err [Segment_mustencode_check $namespec] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
#see comments below regarding 2 rounds and ordering. |
||||
set name [decode_unicode_escapes $namespec] |
||||
set name [tcl::string::map $decode_map $name] |
||||
#puts stderr "-->name: $name" |
||||
|
||||
set targetsegment [split $targetspec +] |
||||
#check each + delimited part of targetspec already has required chars encoded |
||||
set pp 0 ;#pathpart index |
||||
set targetpath_parts [list] |
||||
foreach pathpart $targetsegment { |
||||
set targettest [tcl::string::map $encode_map $pathpart] |
||||
if {[tcl::string::length $targettest] ne [tcl::string::length $pathpart]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in targetpath (section following first #)" |
||||
append err [Segment_mustencode_check $pathpart] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
#2 rounds of substitution is possibly asking for trouble.. |
||||
#We allow anything in the resultant segments anyway (as %UXXXX... allows all) |
||||
#so it's not so much about what can be encoded, |
||||
# - but it makes it harder to reason about for users |
||||
# In particular - if we map %XX first it makes %25 -> % substitution tricky |
||||
# if the user requires a literal %UXXX - they can't do %25UXXX |
||||
# the double sub would make it %UXXX -> somechar anyway. |
||||
#we do unicode first - as a 2nd round of %XX substitutions is unlikely to interfere. |
||||
#There is still the opportunity to use things like %U00000025 followed by hex-chars |
||||
# and get some minor surprises, but using %U on ascii is unlikely to be done accidentally - REVIEW |
||||
set pathpart [decode_unicode_escapes $pathpart] |
||||
set pathpart [tcl::string::map $decode_map $pathpart] |
||||
lappend targetpath_parts $pathpart |
||||
|
||||
incr pp |
||||
} |
||||
set targetpath [join $targetpath_parts /] |
||||
if {$name eq ""} { |
||||
set name [lindex $targetpath_parts end] |
||||
} |
||||
#we do the same encoding checks on tags and comments to increase chances of portability |
||||
set tags [list] |
||||
set comments [list] |
||||
switch -- [llength $segments] { |
||||
2 { |
||||
#no tags or comments |
||||
} |
||||
3 { |
||||
#only 3 sections - last is comment - even if looks like tags |
||||
#to make the 3rd part a tagset, an extra # would be needed |
||||
set c [lindex $segments 2] |
||||
if {$c ne ""} { |
||||
#same validation/decoding as the multi-comment case below |
||||
set commenttest [tcl::string::map $encode_map $c] |
||||
if {[tcl::string::length $commenttest] ne [tcl::string::length $c]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in comment 0" |
||||
append err [Segment_mustencode_check $c] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
set comments [list [tcl::string::map $decode_map [decode_unicode_escapes $c]]] |
||||
} |
||||
} |
||||
default { |
||||
set tagset [lindex $segments 2] |
||||
if {$tagset eq ""} { |
||||
#ok - no tags |
||||
} else { |
||||
if {[string first @ $tagset] != 0} { |
||||
set err "fauxlink::resolve '$link' invalid tagset in 3rd #-delimited segment" |
||||
append err \n " - must begin with @" |
||||
append err $err_extra |
||||
error $err |
||||
} else { |
||||
set tagset [string range $tagset 1 end] |
||||
set rawtags [split $tagset @] |
||||
set tags [list] |
||||
foreach t $rawtags { |
||||
if {$t eq ""} { |
||||
lappend tags "" |
||||
} else { |
||||
set tagtest [tcl::string::map $encode_map $t] |
||||
if {[tcl::string::length $tagtest] ne [tcl::string::length $t]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in tag [llength $tags]" |
||||
append err [Segment_mustencode_check $t] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
lappend tags [tcl::string::map $decode_map [decode_unicode_escapes $t]] |
||||
} |
||||
} |
||||
} |
||||
} |
||||
set rawcomments [lrange $segments 3 end] |
||||
#set comments [lsearch -all -inline -not $comments ""] |
||||
set comments [list] |
||||
foreach c $rawcomments { |
||||
if {$c eq ""} {continue} |
||||
set commenttest [tcl::string::map $encode_map $c] |
||||
if {[tcl::string::length $commenttest] ne [tcl::string::length $c]} { |
||||
set err "fauxlink::resolve '$link' invalid chars in comment [llength $comments]" |
||||
append err [Segment_mustencode_check $c] |
||||
append err $err_extra |
||||
error $err |
||||
} |
||||
lappend comments [tcl::string::map $decode_map [decode_unicode_escapes $c]] |
||||
} |
||||
} |
||||
} |
||||
|
||||
set data [dict create name $name targetpath $targetpath tags $tags comments $comments fauxlinkextension $extension_name] |
||||
if {$is_fauxlink} { |
||||
#standard .fxlnk or .fauxlink |
||||
return $data |
||||
} else { |
||||
#custom extension - or called in error on wrong type of file but happened to parse. |
||||
#see comments at top regarding is_fauxlink |
||||
#make sure no keys in common at top level. |
||||
return [dict create\ |
||||
linktype $extension_name\ |
||||
note "nonstandard extension returning nonstandard dict with result in data key"\ |
||||
data $data\ |
||||
] |
||||
} |
||||
} |
||||
variable map |
||||
|
||||
namespace eval argdoc { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::fauxlink::decode_unicode_escapes |
||||
@cmd -name fauxlink::decode_unicode_escapes\ |
||||
-summary\ |
||||
"Substitute %UXXXXXXXX unicode escapes in a string."\ |
||||
-help\ |
||||
"Return str with each %U escape followed by 1 to 8 hex digits replaced |
||||
by the unicode character for that codepoint. Interpretation of digits |
||||
stops at the first non-hex character or at 8 digits, whichever comes |
||||
first. A %U followed by no hex digits is left untouched (so %Utest |
||||
comes out as %Utest). |
||||
|
||||
An escape whose resolved character is in the exclusions list is left |
||||
in its escaped form. The default exclusions are forward slash, LF, CR |
||||
and NUL - the forward slash exclusion exists because + is the fauxlink |
||||
path separator and alternate spellings would obscure intention." |
||||
@values -min 1 -max 2 |
||||
str -type string -help\ |
||||
"String possibly containing %UXXXXXXXX escapes" |
||||
exclusions -type list -optional 1 -default {/ \n \r \x00} -help\ |
||||
"List of decoded characters that must NOT be substituted - matching |
||||
escapes are left in %U form. (Tcl list backslash forms: the default |
||||
excludes / LF CR NUL)" |
||||
}] |
||||
} |
||||
#default exclusion of / (%U2f and equivs) |
||||
#this would allow obfuscation of intention - when we have + for that anyway |
||||
proc decode_unicode_escapes {str {exclusions {/ \n \r \x00}}} { |
||||
variable map |
||||
set ucstart [string first %U $str 0] |
||||
if {$ucstart < 0} { |
||||
return $str |
||||
} |
||||
set max 8 |
||||
set map [list] |
||||
set strend [expr {[string length $str]-1}] |
||||
while {$ucstart >= 0} { |
||||
set s $ucstart |
||||
set i [expr {$s +2}] ;#skip the %U |
||||
set hex "" |
||||
while {[tcl::string::length $hex] < 8 && $i <= $strend} { |
||||
set in [string index $str $i] |
||||
if {[tcl::string::is xdigit -strict $in]} { |
||||
append hex $in |
||||
} else { |
||||
break |
||||
} |
||||
incr i |
||||
} |
||||
if {$hex ne ""} { |
||||
incr i -1 |
||||
lappend map $s $i $hex |
||||
} |
||||
set ucstart [tcl::string::first %U $str $i] |
||||
} |
||||
if {![llength $map]} { |
||||
#%U present but no valid escapes (no hex digits) - nothing to substitute |
||||
return $str |
||||
} |
||||
set out "" |
||||
set lastidx -1 |
||||
set e 0 |
||||
foreach {s e hex} $map { |
||||
append out [string range $str $lastidx+1 $s-1] |
||||
set sub [format %c 0x$hex] |
||||
if {$sub in $exclusions} { |
||||
append out %U$hex ;#put it back |
||||
} else { |
||||
append out $sub |
||||
} |
||||
set lastidx $e |
||||
} |
||||
if {$e < [tcl::string::length $str]-1} { |
||||
append out [string range $str $e+1 end] |
||||
} |
||||
return $out |
||||
} |
||||
#encode one #-delimited section (or one + delimited target segment) |
||||
#round-trip property: literal % is encoded as %25 so that pre-existing %XX / %UXXXX |
||||
#lookalike sequences in the input survive resolve's decoding untouched. |
||||
proc Segment_encode {str} { |
||||
variable encode_map |
||||
if {[tcl::string::first \x00 $str] >= 0} { |
||||
error "fauxlink::link_as NUL character cannot be represented in a fauxlink name" |
||||
} |
||||
set out [tcl::string::map {% %25} $str] |
||||
return [tcl::string::map $encode_map $out] |
||||
} |
||||
namespace eval argdoc { |
||||
variable PUNKARGS |
||||
lappend PUNKARGS [list { |
||||
@id -id ::fauxlink::link_as |
||||
@cmd -name fauxlink::link_as\ |
||||
-summary\ |
||||
"Encode a name and target as a fauxlink filename (counterpart of resolve)."\ |
||||
-help\ |
||||
"Return the fauxlink filename encoding the given nominal name and target |
||||
path, applying the required %XX encodings and + path separators, such |
||||
that fauxlink::resolve on the result returns the inputs unchanged |
||||
(resolve reports the decoded target tail as name when name is empty). |
||||
|
||||
target is a forward-slash separated path; each segment is encoded |
||||
separately (a literal + # % etc within a segment is escaped). A leading |
||||
// (e.g //server/share) is preserved via leading ++. |
||||
Literal % characters anywhere in the inputs are encoded as %25 so that |
||||
%XX or %UXXXX lookalike sequences in names/targets round-trip literally. |
||||
Unicode characters are left unencoded (modern filesystems accept utf-8). |
||||
|
||||
Only the filename is returned - no file is created; creating the |
||||
(normally zero-byte) link file is the caller's responsibility. |
||||
|
||||
Not representable (raises an error): NUL characters anywhere; a literal |
||||
forward slash within the name, a tag, a comment or a target segment |
||||
(fauxlink deliberately provides no %XX decoding for the slash - path |
||||
structure must be expressed via the + separators); an empty comment |
||||
(resolve drops empty comments, so it cannot round-trip)." |
||||
@leaders -min 2 -max 2 |
||||
name -type string -help\ |
||||
"Nominal name for the link. May be empty: the encoded form then starts |
||||
with # and resolve reports the target tail as the effective name. |
||||
NOTE: some punkcheck-based punkshell tooling treats leading-# filenames |
||||
as hidden/aside - prefer a non-empty name in punkshell project trees." |
||||
target -type string -help\ |
||||
"Target path the link should resolve to (forward-slash separated)" |
||||
@opts |
||||
-tags -type list -default {} -help\ |
||||
"List of tags for the tagset section. A literal @ within a tag is |
||||
encoded as %40 (the tagset uses @ as its separator)." |
||||
-comments -type list -default {} -help\ |
||||
"List of non-empty comments (each becomes one #-delimited section)" |
||||
-extension -type string -default "fauxlink" -choices {fauxlink fxlnk} -help\ |
||||
"File extension for the link filename" |
||||
}] |
||||
} |
||||
proc link_as {name target args} { |
||||
#manual args parsing - punk::args PUNKARGS definition above is documentation-only |
||||
#(keep behaviour synchronized with the definition) |
||||
set opts [dict create -tags {} -comments {} -extension fauxlink] |
||||
foreach {k v} $args { |
||||
switch -- $k { |
||||
-tags - -comments - -extension { |
||||
dict set opts $k $v |
||||
} |
||||
default { |
||||
error "fauxlink::link_as unknown option '$k'. Known options: -tags -comments -extension" |
||||
} |
||||
} |
||||
} |
||||
set extension [dict get $opts -extension] |
||||
if {$extension ni [list fauxlink fxlnk]} { |
||||
error "fauxlink::link_as -extension must be fauxlink or fxlnk" |
||||
} |
||||
|
||||
if {[tcl::string::first / $name] >= 0} { |
||||
error "fauxlink::link_as name cannot contain a forward slash (no %XX decoding exists for it - see fauxlink::resolve)" |
||||
} |
||||
set encname [Segment_encode $name] |
||||
|
||||
set enctarget_parts [list] |
||||
foreach segment [split $target /] { |
||||
lappend enctarget_parts [Segment_encode $segment] |
||||
} |
||||
set enctarget [join $enctarget_parts +] |
||||
|
||||
set enctags [list] |
||||
foreach tag [dict get $opts -tags] { |
||||
if {[tcl::string::first / $tag] >= 0} { |
||||
error "fauxlink::link_as tag cannot contain a forward slash" |
||||
} |
||||
#encode literal @ within a tag - @ is the tagset separator |
||||
lappend enctags [tcl::string::map {@ %40} [Segment_encode $tag]] |
||||
} |
||||
set enccomments [list] |
||||
foreach comment [dict get $opts -comments] { |
||||
if {$comment eq ""} { |
||||
error "fauxlink::link_as empty comment is not representable (resolve drops empty comments)" |
||||
} |
||||
if {[tcl::string::first / $comment] >= 0} { |
||||
error "fauxlink::link_as comment cannot contain a forward slash" |
||||
} |
||||
lappend enccomments [Segment_encode $comment] |
||||
} |
||||
|
||||
set parts [list $encname $enctarget] |
||||
if {[llength $enctags]} { |
||||
lappend parts "@[join $enctags @]" |
||||
if {![llength $enccomments]} { |
||||
#force a 4th (empty comment) section so the tagset is not read as a comment |
||||
lappend parts "" |
||||
} else { |
||||
lappend parts {*}$enccomments |
||||
} |
||||
} elseif {[llength $enccomments]} { |
||||
#explicit empty tagset section keeps comments unambiguous |
||||
lappend parts "" {*}$enccomments |
||||
} |
||||
return "[join $parts #].$extension" |
||||
} |
||||
|
||||
#proc sample1 {p1 args} { |
||||
# #*** !doctools |
||||
# #[call [fun sample1] [arg p1] [opt {?option value...?}]] |
||||
# #[para]Description of sample1 |
||||
# return "ok" |
||||
#} |
||||
|
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace fauxlink ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval fauxlink::lib { |
||||
namespace export {[a-z]*}; # Convention: export all lowercase |
||||
namespace path [namespace parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink::lib}] |
||||
#[para] Secondary functions that are part of the API |
||||
#[list_begin definitions] |
||||
|
||||
#proc utility1 {p1 args} { |
||||
# #*** !doctools |
||||
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] |
||||
# #[para]Description of utility1 |
||||
# return 1 |
||||
#} |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace fauxlink::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
namespace eval fauxlink::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace fauxlink::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
#This is inert documentation registration - it does not load or require punk::args. |
||||
lappend ::punk::args::register::NAMESPACES ::fauxlink |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide fauxlink [namespace eval fauxlink { |
||||
variable pkg fauxlink |
||||
variable version |
||||
set version 0.2.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
Binary file not shown.
Binary file not shown.
Loading…
Reference in new issue