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
Unified 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 ##e.g package require frobz
package require punk::mix::base package require punk::mix::base
package require struct::set package require struct::set
package require punk::args
namespace eval punk::du { namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] 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 { 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]} { if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
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
return $result return $result
} else { } else {
error "could not read attributes for $path" 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? #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) # 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 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 # 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} { proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\ set defaults [dict create\
-glob *\ -glob *\
-filedebug 0\
-with_sizes 1\ -with_sizes 1\
-with_times 1\ -with_times 1\
] ]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob] set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes] set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l] set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} { if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!) #don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create] set alltimes [dict create]
set links [list] set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list] set flaggedhidden [list]
set flaggedsystem [list] set flaggedsystem [list]
set flaggedreadonly [list] set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue continue
} }
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
set ftype "" set ftype ""
#attributes applicable to any classification #attributes applicable to any classification
set fullname [file_join_one $folderpath $nm] set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} { set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
lappend flaggedhidden $fullname set file_attributes [dict get $attrdict -fileattributes]
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set linkdata [dict create]
# -----------------------------------------------------------
#main classification #main classification
if {"reparse_point" in $attrinfo} { if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links #this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #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 #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. #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. #links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname lappend links $fullname
set ftype "l" 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 {. ..}} { if {$nm in {. ..}} {
continue continue
} }
lappend dirs $fullname if {"reparse_point" ni $file_attributes} {
set ftype "d" lappend dirs $fullname
} else { 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? #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 lappend files $fullname
if {"f" in $sized_types} { if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
} }
set ftype "f" 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} { if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] 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]]\ 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 twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath] 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 #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 #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} { proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list] 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 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 { } else {
if {[pwd] ne $VIRTUAL_CWD} { if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] 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" #puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
} }
set normpath [file normalize $path] set normpath [file normalize $path]
cd $normpath 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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]] set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} { 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] 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" 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] 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] lappend vfsmounts {*}[dict get $contents vfsmounts]
} }
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} { if {$opt_stripbase && $common_base ne ""} {
set filetails [list] set filetails [list]
set dirtails [list] set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list] set stripped [list]
foreach f [set $fileset] { foreach fullname [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base] 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 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_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links { foreach s $links {
if {[file isfile $s]} { if {[dict exists $contents linkinfo $s target_type]} {
lappend file_symlinks $s #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
#will be appended in finfo_plus later set target_type [dict get $contents linkinfo $s target_type]
} elseif {[file isdirectory $s]} { switch -- $target_type {
lappend dir_symlinks $s file {
lappend dirs $s 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 { } else {
#dunno - warn for now #fallback if no target_type
puts stderr "Warning - cannot determine link type for link $s" 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 #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} { if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each 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 widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]] 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 [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 widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]] 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] set finfo [list]
foreach f $files s $filesizes { 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 #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 #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 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] 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 #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 { 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] 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]} { if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target] set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} { 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]} { if {[file isfile $tgt]} {
set target_type file set target_type file
} elseif {[file isdirectory $tgt]} { } elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type { switch -- $target_type {
file { file {
set display [dict get $fdict display] set display [dict get $fdict display]
set display $fshortcut_style$display ;# set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display dict set fdict display $display
lappend finfo_plus $fdict 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 ##e.g package require frobz
package require punk::mix::base package require punk::mix::base
package require struct::set package require struct::set
package require punk::args
namespace eval punk::du { namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] 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 { 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]} { if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
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
return $result return $result
} else { } else {
error "could not read attributes for $path" 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? #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) # 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 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 # 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} { proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\ set defaults [dict create\
-glob *\ -glob *\
-filedebug 0\
-with_sizes 1\ -with_sizes 1\
-with_times 1\ -with_times 1\
] ]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob] set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes] set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l] set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} { if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!) #don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create] set alltimes [dict create]
set links [list] set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list] set flaggedhidden [list]
set flaggedsystem [list] set flaggedsystem [list]
set flaggedreadonly [list] set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue continue
} }
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
set ftype "" set ftype ""
#attributes applicable to any classification #attributes applicable to any classification
set fullname [file_join_one $folderpath $nm] set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} { set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
lappend flaggedhidden $fullname set file_attributes [dict get $attrdict -fileattributes]
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set linkdata [dict create]
# -----------------------------------------------------------
#main classification #main classification
if {"reparse_point" in $attrinfo} { if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links #this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #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 #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. #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. #links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname lappend links $fullname
set ftype "l" 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 {. ..}} { if {$nm in {. ..}} {
continue continue
} }
lappend dirs $fullname if {"reparse_point" ni $file_attributes} {
set ftype "d" lappend dirs $fullname
} else { 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? #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 lappend files $fullname
if {"f" in $sized_types} { if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
} }
set ftype "f" 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} { if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] 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]]\ 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 twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath] 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 #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 #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} { proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list] 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 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 { } else {
if {[pwd] ne $VIRTUAL_CWD} { if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] 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" #puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
} }
set normpath [file normalize $path] set normpath [file normalize $path]
cd $normpath 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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]] set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} { 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] 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" 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] 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] lappend vfsmounts {*}[dict get $contents vfsmounts]
} }
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} { if {$opt_stripbase && $common_base ne ""} {
set filetails [list] set filetails [list]
set dirtails [list] set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list] set stripped [list]
foreach f [set $fileset] { foreach fullname [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base] 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 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_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links { foreach s $links {
if {[file isfile $s]} { if {[dict exists $contents linkinfo $s target_type]} {
lappend file_symlinks $s #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
#will be appended in finfo_plus later set target_type [dict get $contents linkinfo $s target_type]
} elseif {[file isdirectory $s]} { switch -- $target_type {
lappend dir_symlinks $s file {
lappend dirs $s 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 { } else {
#dunno - warn for now #fallback if no target_type
puts stderr "Warning - cannot determine link type for link $s" 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 #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} { if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each 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 widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]] 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 [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 widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]] 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] set finfo [list]
foreach f $files s $filesizes { 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 #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 #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 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] 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 #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 { 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] 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]} { if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target] set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} { 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]} { if {[file isfile $tgt]} {
set target_type file set target_type file
} elseif {[file isdirectory $tgt]} { } elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type { switch -- $target_type {
file { file {
set display [dict get $fdict display] set display [dict get $fdict display]
set display $fshortcut_style$display ;# set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display dict set fdict display $display
lappend finfo_plus $fdict 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 #offset 24 4 bytes
#File attribute flags #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 ##e.g package require frobz
package require punk::mix::base package require punk::mix::base
package require struct::set package require struct::set
package require punk::args
namespace eval punk::du { namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] 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 { 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]} { if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
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
return $result return $result
} else { } else {
error "could not read attributes for $path" 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? #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) # 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 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 # 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} { proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\ set defaults [dict create\
-glob *\ -glob *\
-filedebug 0\
-with_sizes 1\ -with_sizes 1\
-with_times 1\ -with_times 1\
] ]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob] set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes] set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l] set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} { if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!) #don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create] set alltimes [dict create]
set links [list] set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list] set flaggedhidden [list]
set flaggedsystem [list] set flaggedsystem [list]
set flaggedreadonly [list] set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue continue
} }
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
set ftype "" set ftype ""
#attributes applicable to any classification #attributes applicable to any classification
set fullname [file_join_one $folderpath $nm] set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} { set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
lappend flaggedhidden $fullname set file_attributes [dict get $attrdict -fileattributes]
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set linkdata [dict create]
# -----------------------------------------------------------
#main classification #main classification
if {"reparse_point" in $attrinfo} { if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links #this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #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 #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. #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. #links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname lappend links $fullname
set ftype "l" 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 {. ..}} { if {$nm in {. ..}} {
continue continue
} }
lappend dirs $fullname if {"reparse_point" ni $file_attributes} {
set ftype "d" lappend dirs $fullname
} else { 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? #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 lappend files $fullname
if {"f" in $sized_types} { if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
} }
set ftype "f" 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} { if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] 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]]\ 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 twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath] 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 #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 #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} { proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list] 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 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 { } else {
if {[pwd] ne $VIRTUAL_CWD} { if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] 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" #puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
} }
set normpath [file normalize $path] set normpath [file normalize $path]
cd $normpath 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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]] set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} { 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] 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" 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] 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] lappend vfsmounts {*}[dict get $contents vfsmounts]
} }
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} { if {$opt_stripbase && $common_base ne ""} {
set filetails [list] set filetails [list]
set dirtails [list] set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list] set stripped [list]
foreach f [set $fileset] { foreach fullname [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base] 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 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_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links { foreach s $links {
if {[file isfile $s]} { if {[dict exists $contents linkinfo $s target_type]} {
lappend file_symlinks $s #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
#will be appended in finfo_plus later set target_type [dict get $contents linkinfo $s target_type]
} elseif {[file isdirectory $s]} { switch -- $target_type {
lappend dir_symlinks $s file {
lappend dirs $s 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 { } else {
#dunno - warn for now #fallback if no target_type
puts stderr "Warning - cannot determine link type for link $s" 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 #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} { if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each 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 widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]] 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 [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 widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]] 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] set finfo [list]
foreach f $files s $filesizes { 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 #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 #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 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] 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 #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 { 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] 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]} { if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target] set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} { 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]} { if {[file isfile $tgt]} {
set target_type file set target_type file
} elseif {[file isdirectory $tgt]} { } elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type { switch -- $target_type {
file { file {
set display [dict get $fdict display] set display [dict get $fdict display]
set display $fshortcut_style$display ;# set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display dict set fdict display $display
lappend finfo_plus $fdict 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 ##e.g package require frobz
package require punk::mix::base package require punk::mix::base
package require struct::set package require struct::set
package require punk::args
namespace eval punk::du { namespace eval punk::du {
@ -486,29 +487,156 @@ namespace eval punk::du {
return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] 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 { 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]} { if {[twapi::find_file_next $iterator iteminfo]} {
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo]
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
return $result return $result
} else { } else {
error "could not read attributes for $path" 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? #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) # 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 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 # 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} { proc du_dirlisting_twapi {folderpath args} {
set defaults [dict create\ set defaults [dict create\
-glob *\ -glob *\
-filedebug 0\
-with_sizes 1\ -with_sizes 1\
-with_times 1\ -with_times 1\
] ]
@ -534,6 +663,9 @@ namespace eval punk::du {
set opt_glob [dict get $opts -glob] set opt_glob [dict get $opts -glob]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- # -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_with_sizes [dict get $opts -with_sizes] set opt_with_sizes [dict get $opts -with_sizes]
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_filedebug [dict get $opts -filedebug] ;#per file
# -- --- --- --- --- --- --- --- --- --- --- --- --- ---
set ftypes [list f d l] set ftypes [list f d l]
if {"$opt_with_sizes" in {0 1}} { if {"$opt_with_sizes" in {0 1}} {
#don't use string is boolean - (f false vs f file!) #don't use string is boolean - (f false vs f file!)
@ -705,6 +837,8 @@ namespace eval punk::du {
set alltimes [dict create] set alltimes [dict create]
set links [list] set links [list]
set linkinfo [dict create]
set debuginfo [dict create]
set flaggedhidden [list] set flaggedhidden [list]
set flaggedsystem [list] set flaggedsystem [list]
set flaggedreadonly [list] set flaggedreadonly [list]
@ -717,25 +851,18 @@ namespace eval punk::du {
continue continue
} }
set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path
set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]]
#puts stderr "$iteminfo"
#puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo"
set ftype "" set ftype ""
#attributes applicable to any classification #attributes applicable to any classification
set fullname [file_join_one $folderpath $nm] set fullname [file_join_one $folderpath $nm]
if {"hidden" in $attrinfo} { set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict
lappend flaggedhidden $fullname set file_attributes [dict get $attrdict -fileattributes]
}
if {"system" in $attrinfo} {
lappend flaggedsystem $fullname
}
if {"readonly" in $attrinfo} {
lappend flaggedreadonly $fullname
}
set linkdata [dict create]
# -----------------------------------------------------------
#main classification #main classification
if {"reparse_point" in $attrinfo} { if {"reparse_point" in $file_attributes} {
#this concept doesn't correspond 1-to-1 with unix links #this concept doesn't correspond 1-to-1 with unix links
#https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #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 #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. #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. #links are techically files too, whether they point to a file/dir or nothing.
lappend links $fullname lappend links $fullname
set ftype "l" 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 {. ..}} { if {$nm in {. ..}} {
continue continue
} }
lappend dirs $fullname if {"reparse_point" ni $file_attributes} {
set ftype "d" lappend dirs $fullname
} else { 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? #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 lappend files $fullname
if {"f" in $sized_types} { if {"f" in $sized_types} {
@ -776,6 +913,17 @@ namespace eval punk::du {
} }
set ftype "f" 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} { if {$ftype in $sized_types} {
dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] 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]]\ 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 twapi::find_file_close $iterator
set vfsmounts [get_vfsmounts_in_folder $folderpath] 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 #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 #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} { proc get_vfsmounts_in_folder {folderpath} {
set vfsmounts [list] 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 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 { } else {
if {[pwd] ne $VIRTUAL_CWD} { if {[pwd] ne $VIRTUAL_CWD} {
commandstack::basecall cd $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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] 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" #puts stderr "=--->$matchinfo"
@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs {
} }
set normpath [file normalize $path] set normpath [file normalize $path]
cd $normpath 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 dircount [llength [dict get $matchinfo dirs]]
set filecount [llength [dict get $matchinfo files]] set filecount [llength [dict get $matchinfo files]]
set location [file normalize [dict get $matchinfo location]] set location [file normalize [dict get $matchinfo location]]
@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs {
proc dirlist {{location ""}} { 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] 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" 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] 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] lappend vfsmounts {*}[dict get $contents vfsmounts]
} }
set fkeys [dict create] ;#avoid some file normalize calls..
if {$opt_stripbase && $common_base ne ""} { if {$opt_stripbase && $common_base ne ""} {
set filetails [list] set filetails [list]
set dirtails [list] set dirtails [list]
foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] {
set stripped [list] set stripped [list]
foreach f [set $fileset] { foreach fullname [set $fileset] {
lappend stripped [strip_prefix_depth $f $common_base] 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 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_symlinks [list]
set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory
foreach s $links { foreach s $links {
if {[file isfile $s]} { if {[dict exists $contents linkinfo $s target_type]} {
lappend file_symlinks $s #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem.
#will be appended in finfo_plus later set target_type [dict get $contents linkinfo $s target_type]
} elseif {[file isdirectory $s]} { switch -- $target_type {
lappend dir_symlinks $s file {
lappend dirs $s 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 { } else {
#dunno - warn for now #fallback if no target_type
puts stderr "Warning - cannot determine link type for link $s" 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 #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} { if {$opt_formatsizes} {
set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each 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 widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]]
set c2a [string repeat " " [expr {$widest2a + 1}]] 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 [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 widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]]
set c2b [string repeat " " [expr {$widest2b + 1}]] 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] set finfo [list]
foreach f $files s $filesizes { 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 #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 #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 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] 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 #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 { 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] 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]} { if {[dict exists $shortcutinfo link_target]} {
set tgt [dict get $shortcutinfo link_target] set tgt [dict get $shortcutinfo link_target]
if {[file exists $tgt]} { 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]} { if {[file isfile $tgt]} {
set target_type file set target_type file
} elseif {[file isdirectory $tgt]} { } elseif {[file isdirectory $tgt]} {
@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs {
switch -- $target_type { switch -- $target_type {
file { file {
set display [dict get $fdict display] set display [dict get $fdict display]
set display $fshortcut_style$display ;# set display "$fshortcut_style$display (shortcut to $tgt)" ;#
dict set fdict display $display dict set fdict display $display
lappend finfo_plus $fdict lappend finfo_plus $fdict
} }

Write Preview
Loading…
Cancel
Save