jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

punk::nav::fs filesizes and symlink indications

master
Julian Noble 2 months ago
parent
a66b63e6a6
commit
33585546b9
9 changed files with 1121 additions and 269 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 238
      src/bootsupport/modules/punk/du-0.1.0.tm
  2. 109
      src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  3. 238
      src/modules/punk/du-999999.0a1.0.tm
  4. 109
      src/modules/punk/nav/fs-999999.0a1.0.tm
  5. 2
      src/modules/punk/winlnk-999999.0a1.0.tm
  6. 238
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
  7. 109
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
  8. 238
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
  9. 109
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm

238
src/bootsupport/modules/punk/du-0.1.0.tm
Unescape View File

@ -19,6 +19,7 @@
##e.g package require frobz
package require punk::mix::base
package require struct::set
package require punk::args
namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end]
}
}
proc attributes_twapi {path {detail basic}} {
variable win_reparse_tags
#implied prefix for all names IO_REPARSE_TAG_
#list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4
set win_reparse_tags [dict create\
RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\
HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\
HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\
WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\
CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\
DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\
FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\
SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\
IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\
DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\
DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\
APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\
NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\
FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\
DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\
WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\
WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\
CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\
PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\
STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\
WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\
PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\
LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\
LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\
LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\
WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
]
variable win_reparse_tags_by_int
dict for {k v} $win_reparse_tags {
set intkey [expr {[dict get $v hex]}]
set info [dict merge [dict create tag $k] $v] ;#put tag at front
dict set win_reparse_tags_by_int $intkey $info
}
#https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point
#need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
#then twapi::device_ioctl (win32 DeviceIoControl)
#then parse buffer somehow (binary scan..)
#https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913
proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
*values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args]
set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
#-longname is placeholder - caller needs to set
set result [dict create -archive 0 -hidden 0 -longname [dict get $iteminfo name] -readonly 0 -shortname {} -system 0]
if {$opt_debug} {
set dbg "iteminfo returned by find_file_open\n"
append dbg [pdict -channel none iteminfo]
if {$opt_debugchannel eq "none"} {
dict set result -debug $dbg
} else {
puts -nonewline $opt_debugchannel $dbg
}
}
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -fileattributes $attrinfo
if {"reparse_point" in $attrinfo} {
#the twapi API splits this 32bit value for us
set low_word [dict get $iteminfo reserve0]
set high_word [dict get $iteminfo reserve1]
# 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
# 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
#+-+-+-+-+-----------------------+-------------------------------+
#|M|R|N|R| Reserved bits | Reparse tag value |
#+-+-+-+-+-----------------------+-------------------------------+
#todo - is_microsoft from first bit of high_word
set low_int [expr {$low_word}] ;#review - int vs string rep for dict key lookup? does it matter?
if {[dict exists $win_reparse_tags_by_int $low_int]} {
dict set result -reparseinfo [dict get $win_reparse_tags_by_int $low_int]
} else {
dict set result -reparseinfo [dict create tag "<UNKNOWN>" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"]
}
}
dict set result -raw $iteminfo
return $result
}
proc attributes_twapi {args} {
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
*values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes"
} $args]
set opts [dict get $argd opts]
set path [dict get $argd values path]
set opt_detail [dict get $opts -detail]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
try {
set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field
set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field
if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -rawflags $attrinfo
set extras [list]
#foreach prop {ctime atime mtime size} {
# lappend extras $prop [dict get $iteminfo $prop]
#}
#dict set result -extras $extras
dict set result -raw $iteminfo
set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
return $result
} else {
error "could not read attributes for $path"
@ -519,13 +647,14 @@ namespace eval punk::du {
}
#todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed?
namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided
namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs
# get listing without using unix-tools (may not be installed on the windows system)
# this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function)
# This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance
proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\
-glob *\
-filedebug 0\
-with_sizes 1\
-with_times 1\
]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create]
set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list]
set flaggedsystem [list]
set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue
}
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
#set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set ftype ""
#attributes applicable to any classification
set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} {
lappend flaggedhidden $fullname
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
set file_attributes [dict get $attrdict -fileattributes]
set linkdata [dict create]
# -----------------------------------------------------------
#main classification
if {"reparse_point" in $attrinfo} {
if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
@ -758,17 +885,27 @@ namespace eval punk::du {
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname
set ftype "l"
} elseif {"directory" in $attrinfo} {
dict set linkdata linktype reparse_point
dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
if {"directory" ni $file_attributes} {
dict set linkdata target_type file
}
}
if {"directory" in $file_attributes} {
if {$nm in {. ..}} {
continue
}
lappend dirs $fullname
set ftype "d"
} else {
if {"reparse_point" ni $file_attributes} {
lappend dirs $fullname
set ftype "d"
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
}
if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
lappend files $fullname
if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
}
set ftype "f"
}
# -----------------------------------------------------------
if {[dict get $attrdict -hidden]} {
lappend flaggedhidden $fullname
}
if {[dict get $attrdict -system]} {
lappend flaggedsystem $fullname
}
if {[dict get $attrdict -readonly]} {
lappend flaggedreadonly $fullname
}
if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]]
}
@ -789,6 +937,12 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
if {[dict size $linkdata]} {
dict set linkinfo $fullname $linkdata
}
if {[dict exists $attrdict -debug]} {
dict set debuginfo $fullname [dict get $attrdict -debug]
}
}
twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath]
@ -799,7 +953,7 @@ namespace eval punk::du {
#also determine whether vfs. file system x is *much* faster than file attributes
#whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder
return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors]
return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors]
}
proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list]

109
src/bootsupport/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs {
commandstack::basecall cd $VIRTUAL_CWD
}
}
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD]
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}]
} else {
if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $VIRTUAL_CWD
}
set matchinfo [dirfiles_dict -searchbase [pwd]]
set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}]
}
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
}
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location]
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}]
#puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
}
set normpath [file normalize $path]
cd $normpath
set matchinfo [dirfiles_dict -searchbase $normpath $normpath]
set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath]
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} {
set contents [dirfiles_dict $location]
set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location]
return [dirfiles_dict_as_lines -stripbase 1 $contents]
}
@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location"
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location]
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location]
return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents]
}
@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs {
lappend vfsmounts {*}[dict get $contents vfsmounts]
}
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} {
set filetails [list]
set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach f [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
}
set $fileset $stripped
}
#Note: we need to remember to use common_base to rebuild 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.
}
# -- --- --- --- --- --- --- --- --- --- ---
@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs {
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links {
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
set target_type [dict get $contents linkinfo $s target_type]
switch -- $target_type {
file {
lappend file_symlinks $s
}
directory {
lappend dir_symlinks $s
lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
}
}
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
#fallback if no target_type
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
}
}
}
#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
@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs {
if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each
}
#col2 with subcolumns
#col2 (file info) with subcolumns
#remove punk::pipedata dependency - allow use of punk::nav::fs without punk package
#set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
#widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max
set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]]
#set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]]
#c2c timestamp and short note - fixed width 19 for ts + <sp> + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck
# total 42
set c2c [string repeat " " 42]
set finfo [list]
foreach f $files s $filesizes {
if {[dict size $fkeys]} {
set key [dict get $fkeys $f]
} else {
#not stripped - they should match
set key $f
}
#note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces
#hence we need to keep the filename as well, properly protected as a list element
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"]
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
#set ts [string repeat { } 19]
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"]
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
set note "reparse_point"
if {[dict exists $contents linkinfo $key reparseinfo tag]} {
append note " " [dict get $contents linkinfo $key reparseinfo tag]
}
} else {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs {
if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} {
#file type could return 'link' - we will use ifile/isdirectory
#file type could return 'link' - we will use isfile/isdirectory
if {[file isfile $tgt]} {
set target_type file
} elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display $fshortcut_style$display ;#
set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display
lappend finfo_plus $fdict
}

238
src/modules/punk/du-999999.0a1.0.tm
Unescape View File

@ -19,6 +19,7 @@
##e.g package require frobz
package require punk::mix::base
package require struct::set
package require punk::args
namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end]
}
}
proc attributes_twapi {path {detail basic}} {
variable win_reparse_tags
#implied prefix for all names IO_REPARSE_TAG_
#list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4
set win_reparse_tags [dict create\
RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\
HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\
HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\
WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\
CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\
DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\
FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\
SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\
IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\
DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\
DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\
APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\
NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\
FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\
DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\
WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\
WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\
CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\
PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\
STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\
WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\
PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\
LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\
LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\
LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\
WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
]
variable win_reparse_tags_by_int
dict for {k v} $win_reparse_tags {
set intkey [expr {[dict get $v hex]}]
set info [dict merge [dict create tag $k] $v] ;#put tag at front
dict set win_reparse_tags_by_int $intkey $info
}
#https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point
#need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
#then twapi::device_ioctl (win32 DeviceIoControl)
#then parse buffer somehow (binary scan..)
#https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913
proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
*values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args]
set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
#-longname is placeholder - caller needs to set
set result [dict create -archive 0 -hidden 0 -longname [dict get $iteminfo name] -readonly 0 -shortname {} -system 0]
if {$opt_debug} {
set dbg "iteminfo returned by find_file_open\n"
append dbg [pdict -channel none iteminfo]
if {$opt_debugchannel eq "none"} {
dict set result -debug $dbg
} else {
puts -nonewline $opt_debugchannel $dbg
}
}
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -fileattributes $attrinfo
if {"reparse_point" in $attrinfo} {
#the twapi API splits this 32bit value for us
set low_word [dict get $iteminfo reserve0]
set high_word [dict get $iteminfo reserve1]
# 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
# 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
#+-+-+-+-+-----------------------+-------------------------------+
#|M|R|N|R| Reserved bits | Reparse tag value |
#+-+-+-+-+-----------------------+-------------------------------+
#todo - is_microsoft from first bit of high_word
set low_int [expr {$low_word}] ;#review - int vs string rep for dict key lookup? does it matter?
if {[dict exists $win_reparse_tags_by_int $low_int]} {
dict set result -reparseinfo [dict get $win_reparse_tags_by_int $low_int]
} else {
dict set result -reparseinfo [dict create tag "<UNKNOWN>" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"]
}
}
dict set result -raw $iteminfo
return $result
}
proc attributes_twapi {args} {
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
*values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes"
} $args]
set opts [dict get $argd opts]
set path [dict get $argd values path]
set opt_detail [dict get $opts -detail]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
try {
set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field
set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field
if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -rawflags $attrinfo
set extras [list]
#foreach prop {ctime atime mtime size} {
# lappend extras $prop [dict get $iteminfo $prop]
#}
#dict set result -extras $extras
dict set result -raw $iteminfo
set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
return $result
} else {
error "could not read attributes for $path"
@ -519,13 +647,14 @@ namespace eval punk::du {
}
#todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed?
namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided
namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs
# get listing without using unix-tools (may not be installed on the windows system)
# this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function)
# This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance
proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\
-glob *\
-filedebug 0\
-with_sizes 1\
-with_times 1\
]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create]
set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list]
set flaggedsystem [list]
set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue
}
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
#set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set ftype ""
#attributes applicable to any classification
set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} {
lappend flaggedhidden $fullname
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
set file_attributes [dict get $attrdict -fileattributes]
set linkdata [dict create]
# -----------------------------------------------------------
#main classification
if {"reparse_point" in $attrinfo} {
if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
@ -758,17 +885,27 @@ namespace eval punk::du {
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname
set ftype "l"
} elseif {"directory" in $attrinfo} {
dict set linkdata linktype reparse_point
dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
if {"directory" ni $file_attributes} {
dict set linkdata target_type file
}
}
if {"directory" in $file_attributes} {
if {$nm in {. ..}} {
continue
}
lappend dirs $fullname
set ftype "d"
} else {
if {"reparse_point" ni $file_attributes} {
lappend dirs $fullname
set ftype "d"
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
}
if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
lappend files $fullname
if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
}
set ftype "f"
}
# -----------------------------------------------------------
if {[dict get $attrdict -hidden]} {
lappend flaggedhidden $fullname
}
if {[dict get $attrdict -system]} {
lappend flaggedsystem $fullname
}
if {[dict get $attrdict -readonly]} {
lappend flaggedreadonly $fullname
}
if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]]
}
@ -789,6 +937,12 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
if {[dict size $linkdata]} {
dict set linkinfo $fullname $linkdata
}
if {[dict exists $attrdict -debug]} {
dict set debuginfo $fullname [dict get $attrdict -debug]
}
}
twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath]
@ -799,7 +953,7 @@ namespace eval punk::du {
#also determine whether vfs. file system x is *much* faster than file attributes
#whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder
return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors]
return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors]
}
proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list]

109
src/modules/punk/nav/fs-999999.0a1.0.tm
Unescape View File

@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs {
commandstack::basecall cd $VIRTUAL_CWD
}
}
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD]
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}]
} else {
if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $VIRTUAL_CWD
}
set matchinfo [dirfiles_dict -searchbase [pwd]]
set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}]
}
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
}
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location]
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}]
#puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
}
set normpath [file normalize $path]
cd $normpath
set matchinfo [dirfiles_dict -searchbase $normpath $normpath]
set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath]
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} {
set contents [dirfiles_dict $location]
set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location]
return [dirfiles_dict_as_lines -stripbase 1 $contents]
}
@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location"
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location]
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location]
return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents]
}
@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs {
lappend vfsmounts {*}[dict get $contents vfsmounts]
}
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} {
set filetails [list]
set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach f [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
}
set $fileset $stripped
}
#Note: we need to remember to use common_base to rebuild 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.
}
# -- --- --- --- --- --- --- --- --- --- ---
@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs {
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links {
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
set target_type [dict get $contents linkinfo $s target_type]
switch -- $target_type {
file {
lappend file_symlinks $s
}
directory {
lappend dir_symlinks $s
lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
}
}
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
#fallback if no target_type
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
}
}
}
#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
@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs {
if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each
}
#col2 with subcolumns
#col2 (file info) with subcolumns
#remove punk::pipedata dependency - allow use of punk::nav::fs without punk package
#set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
#widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max
set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]]
#set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]]
#c2c timestamp and short note - fixed width 19 for ts + <sp> + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck
# total 42
set c2c [string repeat " " 42]
set finfo [list]
foreach f $files s $filesizes {
if {[dict size $fkeys]} {
set key [dict get $fkeys $f]
} else {
#not stripped - they should match
set key $f
}
#note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces
#hence we need to keep the filename as well, properly protected as a list element
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"]
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
#set ts [string repeat { } 19]
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"]
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
set note "reparse_point"
if {[dict exists $contents linkinfo $key reparseinfo tag]} {
append note " " [dict get $contents linkinfo $key reparseinfo tag]
}
} else {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs {
if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} {
#file type could return 'link' - we will use ifile/isdirectory
#file type could return 'link' - we will use isfile/isdirectory
if {[file isfile $tgt]} {
set target_type file
} elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display $fshortcut_style$display ;#
set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display
lappend finfo_plus $fdict
}

2
src/modules/punk/winlnk-999999.0a1.0.tm
Unescape View File

@ -252,7 +252,7 @@ tcl::namespace::eval punk::winlnk {
#https://github.com/libyal/liblnk/blob/main/documentation/Windows%20Shortcut%20File%20(LNK)%20format.asciidoc
#offset 24 4 bytes
#File attribute flags

238
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
Unescape View File

@ -19,6 +19,7 @@
##e.g package require frobz
package require punk::mix::base
package require struct::set
package require punk::args
namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end]
}
}
proc attributes_twapi {path {detail basic}} {
variable win_reparse_tags
#implied prefix for all names IO_REPARSE_TAG_
#list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4
set win_reparse_tags [dict create\
RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\
HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\
HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\
WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\
CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\
DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\
FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\
SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\
IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\
DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\
DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\
APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\
NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\
FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\
DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\
WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\
WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\
CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\
PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\
STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\
WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\
PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\
LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\
LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\
LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\
WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
]
variable win_reparse_tags_by_int
dict for {k v} $win_reparse_tags {
set intkey [expr {[dict get $v hex]}]
set info [dict merge [dict create tag $k] $v] ;#put tag at front
dict set win_reparse_tags_by_int $intkey $info
}
#https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point
#need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
#then twapi::device_ioctl (win32 DeviceIoControl)
#then parse buffer somehow (binary scan..)
#https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913
proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
*values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args]
set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
#-longname is placeholder - caller needs to set
set result [dict create -archive 0 -hidden 0 -longname [dict get $iteminfo name] -readonly 0 -shortname {} -system 0]
if {$opt_debug} {
set dbg "iteminfo returned by find_file_open\n"
append dbg [pdict -channel none iteminfo]
if {$opt_debugchannel eq "none"} {
dict set result -debug $dbg
} else {
puts -nonewline $opt_debugchannel $dbg
}
}
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -fileattributes $attrinfo
if {"reparse_point" in $attrinfo} {
#the twapi API splits this 32bit value for us
set low_word [dict get $iteminfo reserve0]
set high_word [dict get $iteminfo reserve1]
# 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
# 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
#+-+-+-+-+-----------------------+-------------------------------+
#|M|R|N|R| Reserved bits | Reparse tag value |
#+-+-+-+-+-----------------------+-------------------------------+
#todo - is_microsoft from first bit of high_word
set low_int [expr {$low_word}] ;#review - int vs string rep for dict key lookup? does it matter?
if {[dict exists $win_reparse_tags_by_int $low_int]} {
dict set result -reparseinfo [dict get $win_reparse_tags_by_int $low_int]
} else {
dict set result -reparseinfo [dict create tag "<UNKNOWN>" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"]
}
}
dict set result -raw $iteminfo
return $result
}
proc attributes_twapi {args} {
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
*values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes"
} $args]
set opts [dict get $argd opts]
set path [dict get $argd values path]
set opt_detail [dict get $opts -detail]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
try {
set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field
set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field
if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -rawflags $attrinfo
set extras [list]
#foreach prop {ctime atime mtime size} {
# lappend extras $prop [dict get $iteminfo $prop]
#}
#dict set result -extras $extras
dict set result -raw $iteminfo
set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
return $result
} else {
error "could not read attributes for $path"
@ -519,13 +647,14 @@ namespace eval punk::du {
}
#todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed?
namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided
namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs
# get listing without using unix-tools (may not be installed on the windows system)
# this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function)
# This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance
proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\
-glob *\
-filedebug 0\
-with_sizes 1\
-with_times 1\
]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create]
set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list]
set flaggedsystem [list]
set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue
}
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
#set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set ftype ""
#attributes applicable to any classification
set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} {
lappend flaggedhidden $fullname
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
set file_attributes [dict get $attrdict -fileattributes]
set linkdata [dict create]
# -----------------------------------------------------------
#main classification
if {"reparse_point" in $attrinfo} {
if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
@ -758,17 +885,27 @@ namespace eval punk::du {
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname
set ftype "l"
} elseif {"directory" in $attrinfo} {
dict set linkdata linktype reparse_point
dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
if {"directory" ni $file_attributes} {
dict set linkdata target_type file
}
}
if {"directory" in $file_attributes} {
if {$nm in {. ..}} {
continue
}
lappend dirs $fullname
set ftype "d"
} else {
if {"reparse_point" ni $file_attributes} {
lappend dirs $fullname
set ftype "d"
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
}
if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
lappend files $fullname
if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
}
set ftype "f"
}
# -----------------------------------------------------------
if {[dict get $attrdict -hidden]} {
lappend flaggedhidden $fullname
}
if {[dict get $attrdict -system]} {
lappend flaggedsystem $fullname
}
if {[dict get $attrdict -readonly]} {
lappend flaggedreadonly $fullname
}
if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]]
}
@ -789,6 +937,12 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
if {[dict size $linkdata]} {
dict set linkinfo $fullname $linkdata
}
if {[dict exists $attrdict -debug]} {
dict set debuginfo $fullname [dict get $attrdict -debug]
}
}
twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath]
@ -799,7 +953,7 @@ namespace eval punk::du {
#also determine whether vfs. file system x is *much* faster than file attributes
#whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder
return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors]
return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors]
}
proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list]

109
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs {
commandstack::basecall cd $VIRTUAL_CWD
}
}
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD]
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}]
} else {
if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $VIRTUAL_CWD
}
set matchinfo [dirfiles_dict -searchbase [pwd]]
set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}]
}
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
}
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location]
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}]
#puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
}
set normpath [file normalize $path]
cd $normpath
set matchinfo [dirfiles_dict -searchbase $normpath $normpath]
set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath]
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} {
set contents [dirfiles_dict $location]
set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location]
return [dirfiles_dict_as_lines -stripbase 1 $contents]
}
@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location"
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location]
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location]
return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents]
}
@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs {
lappend vfsmounts {*}[dict get $contents vfsmounts]
}
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} {
set filetails [list]
set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach f [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
}
set $fileset $stripped
}
#Note: we need to remember to use common_base to rebuild 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.
}
# -- --- --- --- --- --- --- --- --- --- ---
@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs {
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links {
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
set target_type [dict get $contents linkinfo $s target_type]
switch -- $target_type {
file {
lappend file_symlinks $s
}
directory {
lappend dir_symlinks $s
lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
}
}
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
#fallback if no target_type
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
}
}
}
#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
@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs {
if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each
}
#col2 with subcolumns
#col2 (file info) with subcolumns
#remove punk::pipedata dependency - allow use of punk::nav::fs without punk package
#set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
#widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max
set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]]
#set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]]
#c2c timestamp and short note - fixed width 19 for ts + <sp> + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck
# total 42
set c2c [string repeat " " 42]
set finfo [list]
foreach f $files s $filesizes {
if {[dict size $fkeys]} {
set key [dict get $fkeys $f]
} else {
#not stripped - they should match
set key $f
}
#note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces
#hence we need to keep the filename as well, properly protected as a list element
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"]
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
#set ts [string repeat { } 19]
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"]
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
set note "reparse_point"
if {[dict exists $contents linkinfo $key reparseinfo tag]} {
append note " " [dict get $contents linkinfo $key reparseinfo tag]
}
} else {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs {
if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} {
#file type could return 'link' - we will use ifile/isdirectory
#file type could return 'link' - we will use isfile/isdirectory
if {[file isfile $tgt]} {
set target_type file
} elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display $fshortcut_style$display ;#
set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display
lappend finfo_plus $fdict
}

238
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm
Unescape View File

@ -19,6 +19,7 @@
##e.g package require frobz
package require punk::mix::base
package require struct::set
package require punk::args
namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end]
}
}
proc attributes_twapi {path {detail basic}} {
variable win_reparse_tags
#implied prefix for all names IO_REPARSE_TAG_
#list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4
set win_reparse_tags [dict create\
RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\
MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\
HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\
HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\
SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\
WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\
CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\
DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\
FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\
SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\
IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\
DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\
DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\
APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\
NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\
FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\
DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\
WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\
WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\
GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\
CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\
APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\
PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\
STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\
WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\
PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\
AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\
LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\
LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\
LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\
WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\
]
variable win_reparse_tags_by_int
dict for {k v} $win_reparse_tags {
set intkey [expr {[dict get $v hex]}]
set info [dict merge [dict create tag $k] $v] ;#put tag at front
dict set win_reparse_tags_by_int $intkey $info
}
#https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point
#need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000
#then twapi::device_ioctl (win32 DeviceIoControl)
#then parse buffer somehow (binary scan..)
#https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913
proc Get_attributes_from_iteminfo {args} {
variable win_reparse_tags_by_int
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
*values -min 1 -max 1
iteminfo -help "iteminfo dict as set by 'twapi::find_file_next <iterator> iteminfo'"
} $args]
set opts [dict get $argd opts]
set iteminfo [dict get $argd values iteminfo]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
#-longname is placeholder - caller needs to set
set result [dict create -archive 0 -hidden 0 -longname [dict get $iteminfo name] -readonly 0 -shortname {} -system 0]
if {$opt_debug} {
set dbg "iteminfo returned by find_file_open\n"
append dbg [pdict -channel none iteminfo]
if {$opt_debugchannel eq "none"} {
dict set result -debug $dbg
} else {
puts -nonewline $opt_debugchannel $dbg
}
}
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -fileattributes $attrinfo
if {"reparse_point" in $attrinfo} {
#the twapi API splits this 32bit value for us
set low_word [dict get $iteminfo reserve0]
set high_word [dict get $iteminfo reserve1]
# 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
# 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
#+-+-+-+-+-----------------------+-------------------------------+
#|M|R|N|R| Reserved bits | Reparse tag value |
#+-+-+-+-+-----------------------+-------------------------------+
#todo - is_microsoft from first bit of high_word
set low_int [expr {$low_word}] ;#review - int vs string rep for dict key lookup? does it matter?
if {[dict exists $win_reparse_tags_by_int $low_int]} {
dict set result -reparseinfo [dict get $win_reparse_tags_by_int $low_int]
} else {
dict set result -reparseinfo [dict create tag "<UNKNOWN>" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"]
}
}
dict set result -raw $iteminfo
return $result
}
proc attributes_twapi {args} {
set argd [punk::args::get_dict {
-debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)"
-debugchannel -default stderr -help "channel to write debug output, or none to append to output"
-detail -default basic -choices {basic full} -help "full returns also the altname/shortname field"
*values -min 1 -max 1
path -help "path to file or folder for which to retrieve attributes"
} $args]
set opts [dict get $argd opts]
set path [dict get $argd values path]
set opt_detail [dict get $opts -detail]
set opt_debug [dict get $opts -debug]
set opt_debugchannel [dict get $opts -debugchannel]
try {
set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field
set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field
if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0]
if {"hidden" in $attrinfo} {
dict set result -hidden 1
}
if {"system" in $attrinfo} {
dict set result -system 1
}
if {"readonly" in $attrinfo} {
dict set result -readonly 1
}
dict set result -shortname [dict get $iteminfo altname]
dict set result -rawflags $attrinfo
set extras [list]
#foreach prop {ctime atime mtime size} {
# lappend extras $prop [dict get $iteminfo $prop]
#}
#dict set result -extras $extras
dict set result -raw $iteminfo
set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
return $result
} else {
error "could not read attributes for $path"
@ -519,13 +647,14 @@ namespace eval punk::du {
}
#todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed?
namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided
namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs
# get listing without using unix-tools (may not be installed on the windows system)
# this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function)
# This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance
proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\
-glob *\
-filedebug 0\
-with_sizes 1\
-with_times 1\
]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create]
set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list]
set flaggedsystem [list]
set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue
}
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
#set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
set ftype ""
#attributes applicable to any classification
set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} {
lappend flaggedhidden $fullname
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
set file_attributes [dict get $attrdict -fileattributes]
set linkdata [dict create]
# -----------------------------------------------------------
#main classification
if {"reparse_point" in $attrinfo} {
if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points
#review - and see which if any actually belong in the links key of our return
@ -758,17 +885,27 @@ namespace eval punk::du {
#Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window.
#
#links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname
set ftype "l"
} elseif {"directory" in $attrinfo} {
dict set linkdata linktype reparse_point
dict set linkdata reparseinfo [dict get $attrdict -reparseinfo]
if {"directory" ni $file_attributes} {
dict set linkdata target_type file
}
}
if {"directory" in $file_attributes} {
if {$nm in {. ..}} {
continue
}
lappend dirs $fullname
set ftype "d"
} else {
if {"reparse_point" ni $file_attributes} {
lappend dirs $fullname
set ftype "d"
} else {
#other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections
dict set linkdata target_type directory
}
}
if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} {
#review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort?
lappend files $fullname
if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
}
set ftype "f"
}
# -----------------------------------------------------------
if {[dict get $attrdict -hidden]} {
lappend flaggedhidden $fullname
}
if {[dict get $attrdict -system]} {
lappend flaggedsystem $fullname
}
if {[dict get $attrdict -readonly]} {
lappend flaggedreadonly $fullname
}
if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]]
}
@ -789,6 +937,12 @@ namespace eval punk::du {
m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\
]
}
if {[dict size $linkdata]} {
dict set linkinfo $fullname $linkdata
}
if {[dict exists $attrdict -debug]} {
dict set debuginfo $fullname [dict get $attrdict -debug]
}
}
twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath]
@ -799,7 +953,7 @@ namespace eval punk::du {
#also determine whether vfs. file system x is *much* faster than file attributes
#whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder
return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors]
return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors]
}
proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list]

109
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm
Unescape View File

@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs {
commandstack::basecall cd $VIRTUAL_CWD
}
}
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD]
set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}]
} else {
if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $VIRTUAL_CWD
}
set matchinfo [dirfiles_dict -searchbase [pwd]]
set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}]
}
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
}
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location]
set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}]
#puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
}
set normpath [file normalize $path]
cd $normpath
set matchinfo [dirfiles_dict -searchbase $normpath $normpath]
set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath]
set dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} {
set contents [dirfiles_dict $location]
set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location]
return [dirfiles_dict_as_lines -stripbase 1 $contents]
}
@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs {
}
}
puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location"
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location]
set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location]
return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents]
}
@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs {
lappend vfsmounts {*}[dict get $contents vfsmounts]
}
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} {
set filetails [list]
set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list]
foreach f [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base]
foreach fullname [set $fileset] {
set shortname [strip_prefix_depth $fullname $common_base]
dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem
lappend stripped $shortname
}
set $fileset $stripped
}
#Note: we need to remember to use common_base to rebuild 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.
}
# -- --- --- --- --- --- --- --- --- --- ---
@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs {
set dir_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links {
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
if {[dict exists $contents linkinfo $s target_type]} {
#some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
set target_type [dict get $contents linkinfo $s target_type]
switch -- $target_type {
file {
lappend file_symlinks $s
}
directory {
lappend dir_symlinks $s
lappend dirs $s
}
default {
puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)"
}
}
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
#fallback if no target_type
if {[file isfile $s]} {
lappend file_symlinks $s
#will be appended in finfo_plus later
} elseif {[file isdirectory $s]} {
lappend dir_symlinks $s
lappend dirs $s
} else {
#dunno - warn for now
puts stderr "Warning - cannot determine link type for link $s"
}
}
}
#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
@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs {
if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each
}
#col2 with subcolumns
#col2 (file info) with subcolumns
#remove punk::pipedata dependency - allow use of punk::nav::fs without punk package
#set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
#widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max
set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]]
#set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}]
set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]]
#c2c timestamp and short note - fixed width 19 for ts + <sp> + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck
# total 42
set c2c [string repeat " " 42]
set finfo [list]
foreach f $files s $filesizes {
if {[dict size $fkeys]} {
set key [dict get $fkeys $f]
} else {
#not stripped - they should match
set key $f
}
#note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces
#hence we need to keep the filename as well, properly protected as a list element
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"]
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
#set ts [string repeat { } 19]
set ts "$key vs [dict keys [dict get $contents times]]"
}
set note ""
lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"]
}
set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline
set dlink_style [punk::ansi::a+ undercurly underline undt-green]
#We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden
foreach flink $file_symlinks {
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"]
if {[dict size $fkeys]} {
set key [dict get $fkeys $flink]
} else {
set key $flink
}
if {[dict exists $contents times $key m]} {
set mtime [dict get $contents times $key m]
set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"]
} else {
set ts "[string repeat { } 19]"
}
set note "link" ;#default only
if {[dict exists $contents linkinfo $key linktype]} {
if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} {
set note "reparse_point"
if {[dict exists $contents linkinfo $key reparseinfo tag]} {
append note " " [dict get $contents linkinfo $key reparseinfo tag]
}
} else {
append note "$key vs [dict keys [dict get $contents linkinfo]]"
}
}
lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"]
}
set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink]
@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs {
if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} {
#file type could return 'link' - we will use ifile/isdirectory
#file type could return 'link' - we will use isfile/isdirectory
if {[file isfile $tgt]} {
set target_type file
} elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type {
file {
set display [dict get $fdict display]
set display $fshortcut_style$display ;#
set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display
lappend finfo_plus $fdict
}

Write Preview
Loading…
Cancel
Save