diff --git a/src/bootsupport/modules/punk/du-0.1.0.tm b/src/bootsupport/modules/punk/du-0.1.0.tm index f2ee38b5..1e1986e6 100644 --- a/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/src/bootsupport/modules/punk/du-0.1.0.tm @@ -19,6 +19,7 @@ ##e.g package require frobz package require punk::mix::base package require struct::set +package require punk::args namespace eval punk::du { @@ -486,29 +487,156 @@ namespace eval punk::du { return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] } } - proc attributes_twapi {path {detail basic}} { + variable win_reparse_tags + #implied prefix for all names IO_REPARSE_TAG_ + #list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4 + set win_reparse_tags [dict create\ + RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\ + HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\ + HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\ + WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\ + CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\ + DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\ + FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\ + SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\ + IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\ + DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\ + DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\ + APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\ + NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\ + FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\ + DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\ + WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\ + WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\ + CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\ + PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\ + STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\ + WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\ + PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\ + LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\ + LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\ + LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\ + WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ] + variable win_reparse_tags_by_int + dict for {k v} $win_reparse_tags { + set intkey [expr {[dict get $v hex]}] + set info [dict merge [dict create tag $k] $v] ;#put tag at front + dict set win_reparse_tags_by_int $intkey $info + } + + #https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point + #need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 + #then twapi::device_ioctl (win32 DeviceIoControl) + #then parse buffer somehow (binary scan..) + #https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913 + + proc Get_attributes_from_iteminfo {args} { + variable win_reparse_tags_by_int + + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + *values -min 1 -max 1 + iteminfo -help "iteminfo dict as set by 'twapi::find_file_next 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 "" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"] + } + } + dict set result -raw $iteminfo + return $result + } + + + proc attributes_twapi {args} { + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" + *values -min 1 -max 1 + path -help "path to file or folder for which to retrieve attributes" + } $args] + set opts [dict get $argd opts] + set path [dict get $argd values path] + set opt_detail [dict get $opts -detail] + set opt_debug [dict get $opts -debug] + set opt_debugchannel [dict get $opts -debugchannel] + try { - set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field + set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field if {[twapi::find_file_next $iterator iteminfo]} { - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0] - if {"hidden" in $attrinfo} { - dict set result -hidden 1 - } - if {"system" in $attrinfo} { - dict set result -system 1 - } - if {"readonly" in $attrinfo} { - dict set result -readonly 1 - } - dict set result -shortname [dict get $iteminfo altname] - dict set result -rawflags $attrinfo - set extras [list] - #foreach prop {ctime atime mtime size} { - # lappend extras $prop [dict get $iteminfo $prop] - #} - #dict set result -extras $extras - dict set result -raw $iteminfo + set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo] return $result } else { error "could not read attributes for $path" @@ -519,13 +647,14 @@ namespace eval punk::du { } #todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed? - namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided + namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs # get listing without using unix-tools (may not be installed on the windows system) # this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function) # This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance proc du_dirlisting_twapi {folderpath args} { set defaults [dict create\ -glob *\ + -filedebug 0\ -with_sizes 1\ -with_times 1\ ] @@ -534,6 +663,9 @@ namespace eval punk::du { set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_with_sizes [dict get $opts -with_sizes] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + set opt_filedebug [dict get $opts -filedebug] ;#per file + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set ftypes [list f d l] if {"$opt_with_sizes" in {0 1}} { #don't use string is boolean - (f false vs f file!) @@ -705,6 +837,8 @@ namespace eval punk::du { set alltimes [dict create] set links [list] + set linkinfo [dict create] + set debuginfo [dict create] set flaggedhidden [list] set flaggedsystem [list] set flaggedreadonly [list] @@ -717,25 +851,18 @@ namespace eval punk::du { continue } set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - #puts stderr "$iteminfo" - #puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo" + #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set ftype "" #attributes applicable to any classification set fullname [file_join_one $folderpath $nm] - if {"hidden" in $attrinfo} { - lappend flaggedhidden $fullname - } - if {"system" in $attrinfo} { - lappend flaggedsystem $fullname - } - if {"readonly" in $attrinfo} { - lappend flaggedreadonly $fullname - } + set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict + set file_attributes [dict get $attrdict -fileattributes] + set linkdata [dict create] + # ----------------------------------------------------------- #main classification - if {"reparse_point" in $attrinfo} { + if {"reparse_point" in $file_attributes} { #this concept doesn't correspond 1-to-1 with unix links #https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #review - and see which if any actually belong in the links key of our return @@ -758,17 +885,27 @@ namespace eval punk::du { #Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window. # #links are techically files too, whether they point to a file/dir or nothing. - lappend links $fullname set ftype "l" - } elseif {"directory" in $attrinfo} { + dict set linkdata linktype reparse_point + dict set linkdata reparseinfo [dict get $attrdict -reparseinfo] + if {"directory" ni $file_attributes} { + dict set linkdata target_type file + } + } + if {"directory" in $file_attributes} { if {$nm in {. ..}} { continue } - lappend dirs $fullname - set ftype "d" - } else { - + if {"reparse_point" ni $file_attributes} { + lappend dirs $fullname + set ftype "d" + } else { + #other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections + dict set linkdata target_type directory + } + } + if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} { #review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort? lappend files $fullname if {"f" in $sized_types} { @@ -776,6 +913,17 @@ namespace eval punk::du { } set ftype "f" } + # ----------------------------------------------------------- + + if {[dict get $attrdict -hidden]} { + lappend flaggedhidden $fullname + } + if {[dict get $attrdict -system]} { + lappend flaggedsystem $fullname + } + if {[dict get $attrdict -readonly]} { + lappend flaggedreadonly $fullname + } if {$ftype in $sized_types} { dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] } @@ -789,6 +937,12 @@ namespace eval punk::du { m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\ ] } + if {[dict size $linkdata]} { + dict set linkinfo $fullname $linkdata + } + if {[dict exists $attrdict -debug]} { + dict set debuginfo $fullname [dict get $attrdict -debug] + } } twapi::find_file_close $iterator set vfsmounts [get_vfsmounts_in_folder $folderpath] @@ -799,7 +953,7 @@ namespace eval punk::du { #also determine whether vfs. file system x is *much* faster than file attributes #whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder - return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors] + return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors] } proc get_vfsmounts_in_folder {folderpath} { set vfsmounts [list] diff --git a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index fdffa091..9c7fd73c 100644 --- a/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs { commandstack::basecall cd $VIRTUAL_CWD } } - set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD] + set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}] } else { if {[pwd] ne $VIRTUAL_CWD} { commandstack::basecall cd $VIRTUAL_CWD } - set matchinfo [dirfiles_dict -searchbase [pwd]] + set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}] } set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] #puts stderr "=--->$matchinfo" @@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs { } set normpath [file normalize $path] cd $normpath - set matchinfo [dirfiles_dict -searchbase $normpath $normpath] + set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath] set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] set location [file normalize [dict get $matchinfo location]] @@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs { proc dirlist {{location ""}} { - set contents [dirfiles_dict $location] + set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase 1 $contents] } @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs { lappend vfsmounts {*}[dict get $contents vfsmounts] } + set fkeys [dict create] ;#avoid some file normalize calls.. if {$opt_stripbase && $common_base ne ""} { set filetails [list] set dirtails [list] foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { set stripped [list] - foreach f [set $fileset] { - lappend stripped [strip_prefix_depth $f $common_base] + foreach fullname [set $fileset] { + set shortname [strip_prefix_depth $fullname $common_base] + dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem + lappend stripped $shortname } set $fileset $stripped } - #Note: we need to remember to use common_base to rebuild the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. + #Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. } # -- --- --- --- --- --- --- --- --- --- --- @@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs { set dir_symlinks [list] set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory foreach s $links { - if {[file isfile $s]} { - lappend file_symlinks $s - #will be appended in finfo_plus later - } elseif {[file isdirectory $s]} { - lappend dir_symlinks $s - lappend dirs $s + if {[dict exists $contents linkinfo $s target_type]} { + #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem. + set target_type [dict get $contents linkinfo $s target_type] + switch -- $target_type { + file { + lappend file_symlinks $s + } + directory { + lappend dir_symlinks $s + lappend dirs $s + } + default { + puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)" + } + } } else { - #dunno - warn for now - puts stderr "Warning - cannot determine link type for link $s" + #fallback if no target_type + if {[file isfile $s]} { + lappend file_symlinks $s + #will be appended in finfo_plus later + } elseif {[file isdirectory $s]} { + lappend dir_symlinks $s + lappend dirs $s + } else { + #dunno - warn for now + puts stderr "Warning - cannot determine link type for link $s" + } } } #we now have the issue that our symlinks aren't sorted within the dir/file categorisation - they currently will have to appear at beginning or end - TODO @@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs { if {$opt_formatsizes} { set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each } - #col2 with subcolumns + + #col2 (file info) with subcolumns - #remove punk::pipedata dependency - allow use of punk::nav::fs without punk package - #set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] - #widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]] set c2a [string repeat " " [expr {$widest2a + 1}]] #set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]] set c2b [string repeat " " [expr {$widest2b + 1}]] + + #c2c timestamp and short note - fixed width 19 for ts + + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck + # total 42 + set c2c [string repeat " " 42] set finfo [list] foreach f $files s $filesizes { + if {[dict size $fkeys]} { + set key [dict get $fkeys $f] + } else { + #not stripped - they should match + set key $f + } #note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces #hence we need to keep the filename as well, properly protected as a list element - lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"] + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + #set ts [string repeat { } 19] + set ts "$key vs [dict keys [dict get $contents times]]" + } + set note "" + lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"] } set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline set dlink_style [punk::ansi::a+ undercurly underline undt-green] #We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden foreach flink $file_symlinks { - lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"] + if {[dict size $fkeys]} { + set key [dict get $fkeys $flink] + } else { + set key $flink + } + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + set ts "[string repeat { } 19]" + } + set note "link" ;#default only + if {[dict exists $contents linkinfo $key linktype]} { + if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} { + set note "reparse_point" + if {[dict exists $contents linkinfo $key reparseinfo tag]} { + append note " " [dict get $contents linkinfo $key reparseinfo tag] + } + } else { + append note "$key vs [dict keys [dict get $contents linkinfo]]" + } + } + lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"] } set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink] @@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs { if {[dict exists $shortcutinfo link_target]} { set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { - #file type could return 'link' - we will use ifile/isdirectory + #file type could return 'link' - we will use isfile/isdirectory if {[file isfile $tgt]} { set target_type file } elseif {[file isdirectory $tgt]} { @@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs { switch -- $target_type { file { set display [dict get $fdict display] - set display $fshortcut_style$display ;# + set display "$fshortcut_style$display (shortcut to $tgt)" ;# dict set fdict display $display lappend finfo_plus $fdict } diff --git a/src/modules/punk/du-999999.0a1.0.tm b/src/modules/punk/du-999999.0a1.0.tm index 3a9332de..80bd9ed8 100644 --- a/src/modules/punk/du-999999.0a1.0.tm +++ b/src/modules/punk/du-999999.0a1.0.tm @@ -19,6 +19,7 @@ ##e.g package require frobz package require punk::mix::base package require struct::set +package require punk::args namespace eval punk::du { @@ -486,29 +487,156 @@ namespace eval punk::du { return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] } } - proc attributes_twapi {path {detail basic}} { + variable win_reparse_tags + #implied prefix for all names IO_REPARSE_TAG_ + #list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4 + set win_reparse_tags [dict create\ + RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\ + HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\ + HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\ + WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\ + CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\ + DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\ + FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\ + SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\ + IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\ + DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\ + DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\ + APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\ + NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\ + FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\ + DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\ + WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\ + WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\ + CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\ + PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\ + STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\ + WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\ + PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\ + LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\ + LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\ + LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\ + WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ] + variable win_reparse_tags_by_int + dict for {k v} $win_reparse_tags { + set intkey [expr {[dict get $v hex]}] + set info [dict merge [dict create tag $k] $v] ;#put tag at front + dict set win_reparse_tags_by_int $intkey $info + } + + #https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point + #need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 + #then twapi::device_ioctl (win32 DeviceIoControl) + #then parse buffer somehow (binary scan..) + #https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913 + + proc Get_attributes_from_iteminfo {args} { + variable win_reparse_tags_by_int + + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + *values -min 1 -max 1 + iteminfo -help "iteminfo dict as set by 'twapi::find_file_next 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 "" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"] + } + } + dict set result -raw $iteminfo + return $result + } + + + proc attributes_twapi {args} { + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" + *values -min 1 -max 1 + path -help "path to file or folder for which to retrieve attributes" + } $args] + set opts [dict get $argd opts] + set path [dict get $argd values path] + set opt_detail [dict get $opts -detail] + set opt_debug [dict get $opts -debug] + set opt_debugchannel [dict get $opts -debugchannel] + try { - set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field + set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field if {[twapi::find_file_next $iterator iteminfo]} { - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0] - if {"hidden" in $attrinfo} { - dict set result -hidden 1 - } - if {"system" in $attrinfo} { - dict set result -system 1 - } - if {"readonly" in $attrinfo} { - dict set result -readonly 1 - } - dict set result -shortname [dict get $iteminfo altname] - dict set result -rawflags $attrinfo - set extras [list] - #foreach prop {ctime atime mtime size} { - # lappend extras $prop [dict get $iteminfo $prop] - #} - #dict set result -extras $extras - dict set result -raw $iteminfo + set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo] return $result } else { error "could not read attributes for $path" @@ -519,13 +647,14 @@ namespace eval punk::du { } #todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed? - namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided + namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs # get listing without using unix-tools (may not be installed on the windows system) # this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function) # This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance proc du_dirlisting_twapi {folderpath args} { set defaults [dict create\ -glob *\ + -filedebug 0\ -with_sizes 1\ -with_times 1\ ] @@ -534,6 +663,9 @@ namespace eval punk::du { set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_with_sizes [dict get $opts -with_sizes] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + set opt_filedebug [dict get $opts -filedebug] ;#per file + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set ftypes [list f d l] if {"$opt_with_sizes" in {0 1}} { #don't use string is boolean - (f false vs f file!) @@ -705,6 +837,8 @@ namespace eval punk::du { set alltimes [dict create] set links [list] + set linkinfo [dict create] + set debuginfo [dict create] set flaggedhidden [list] set flaggedsystem [list] set flaggedreadonly [list] @@ -717,25 +851,18 @@ namespace eval punk::du { continue } set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - #puts stderr "$iteminfo" - #puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo" + #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set ftype "" #attributes applicable to any classification set fullname [file_join_one $folderpath $nm] - if {"hidden" in $attrinfo} { - lappend flaggedhidden $fullname - } - if {"system" in $attrinfo} { - lappend flaggedsystem $fullname - } - if {"readonly" in $attrinfo} { - lappend flaggedreadonly $fullname - } + set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict + set file_attributes [dict get $attrdict -fileattributes] + set linkdata [dict create] + # ----------------------------------------------------------- #main classification - if {"reparse_point" in $attrinfo} { + if {"reparse_point" in $file_attributes} { #this concept doesn't correspond 1-to-1 with unix links #https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #review - and see which if any actually belong in the links key of our return @@ -758,17 +885,27 @@ namespace eval punk::du { #Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window. # #links are techically files too, whether they point to a file/dir or nothing. - lappend links $fullname set ftype "l" - } elseif {"directory" in $attrinfo} { + dict set linkdata linktype reparse_point + dict set linkdata reparseinfo [dict get $attrdict -reparseinfo] + if {"directory" ni $file_attributes} { + dict set linkdata target_type file + } + } + if {"directory" in $file_attributes} { if {$nm in {. ..}} { continue } - lappend dirs $fullname - set ftype "d" - } else { - + if {"reparse_point" ni $file_attributes} { + lappend dirs $fullname + set ftype "d" + } else { + #other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections + dict set linkdata target_type directory + } + } + if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} { #review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort? lappend files $fullname if {"f" in $sized_types} { @@ -776,6 +913,17 @@ namespace eval punk::du { } set ftype "f" } + # ----------------------------------------------------------- + + if {[dict get $attrdict -hidden]} { + lappend flaggedhidden $fullname + } + if {[dict get $attrdict -system]} { + lappend flaggedsystem $fullname + } + if {[dict get $attrdict -readonly]} { + lappend flaggedreadonly $fullname + } if {$ftype in $sized_types} { dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] } @@ -789,6 +937,12 @@ namespace eval punk::du { m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\ ] } + if {[dict size $linkdata]} { + dict set linkinfo $fullname $linkdata + } + if {[dict exists $attrdict -debug]} { + dict set debuginfo $fullname [dict get $attrdict -debug] + } } twapi::find_file_close $iterator set vfsmounts [get_vfsmounts_in_folder $folderpath] @@ -799,7 +953,7 @@ namespace eval punk::du { #also determine whether vfs. file system x is *much* faster than file attributes #whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder - return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors] + return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors] } proc get_vfsmounts_in_folder {folderpath} { set vfsmounts [list] diff --git a/src/modules/punk/nav/fs-999999.0a1.0.tm b/src/modules/punk/nav/fs-999999.0a1.0.tm index 3c609beb..043181af 100644 --- a/src/modules/punk/nav/fs-999999.0a1.0.tm +++ b/src/modules/punk/nav/fs-999999.0a1.0.tm @@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs { commandstack::basecall cd $VIRTUAL_CWD } } - set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD] + set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}] } else { if {[pwd] ne $VIRTUAL_CWD} { commandstack::basecall cd $VIRTUAL_CWD } - set matchinfo [dirfiles_dict -searchbase [pwd]] + set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}] } set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] #puts stderr "=--->$matchinfo" @@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs { } set normpath [file normalize $path] cd $normpath - set matchinfo [dirfiles_dict -searchbase $normpath $normpath] + set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath] set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] set location [file normalize [dict get $matchinfo location]] @@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs { proc dirlist {{location ""}} { - set contents [dirfiles_dict $location] + set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase 1 $contents] } @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs { lappend vfsmounts {*}[dict get $contents vfsmounts] } + set fkeys [dict create] ;#avoid some file normalize calls.. if {$opt_stripbase && $common_base ne ""} { set filetails [list] set dirtails [list] foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { set stripped [list] - foreach f [set $fileset] { - lappend stripped [strip_prefix_depth $f $common_base] + foreach fullname [set $fileset] { + set shortname [strip_prefix_depth $fullname $common_base] + dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem + lappend stripped $shortname } set $fileset $stripped } - #Note: we need to remember to use common_base to rebuild the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. + #Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. } # -- --- --- --- --- --- --- --- --- --- --- @@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs { set dir_symlinks [list] set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory foreach s $links { - if {[file isfile $s]} { - lappend file_symlinks $s - #will be appended in finfo_plus later - } elseif {[file isdirectory $s]} { - lappend dir_symlinks $s - lappend dirs $s + if {[dict exists $contents linkinfo $s target_type]} { + #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem. + set target_type [dict get $contents linkinfo $s target_type] + switch -- $target_type { + file { + lappend file_symlinks $s + } + directory { + lappend dir_symlinks $s + lappend dirs $s + } + default { + puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)" + } + } } else { - #dunno - warn for now - puts stderr "Warning - cannot determine link type for link $s" + #fallback if no target_type + if {[file isfile $s]} { + lappend file_symlinks $s + #will be appended in finfo_plus later + } elseif {[file isdirectory $s]} { + lappend dir_symlinks $s + lappend dirs $s + } else { + #dunno - warn for now + puts stderr "Warning - cannot determine link type for link $s" + } } } #we now have the issue that our symlinks aren't sorted within the dir/file categorisation - they currently will have to appear at beginning or end - TODO @@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs { if {$opt_formatsizes} { set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each } - #col2 with subcolumns + + #col2 (file info) with subcolumns - #remove punk::pipedata dependency - allow use of punk::nav::fs without punk package - #set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] - #widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]] set c2a [string repeat " " [expr {$widest2a + 1}]] #set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]] set c2b [string repeat " " [expr {$widest2b + 1}]] + + #c2c timestamp and short note - fixed width 19 for ts + + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck + # total 42 + set c2c [string repeat " " 42] set finfo [list] foreach f $files s $filesizes { + if {[dict size $fkeys]} { + set key [dict get $fkeys $f] + } else { + #not stripped - they should match + set key $f + } #note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces #hence we need to keep the filename as well, properly protected as a list element - lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"] + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + #set ts [string repeat { } 19] + set ts "$key vs [dict keys [dict get $contents times]]" + } + set note "" + lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"] } set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline set dlink_style [punk::ansi::a+ undercurly underline undt-green] #We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden foreach flink $file_symlinks { - lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"] + if {[dict size $fkeys]} { + set key [dict get $fkeys $flink] + } else { + set key $flink + } + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + set ts "[string repeat { } 19]" + } + set note "link" ;#default only + if {[dict exists $contents linkinfo $key linktype]} { + if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} { + set note "reparse_point" + if {[dict exists $contents linkinfo $key reparseinfo tag]} { + append note " " [dict get $contents linkinfo $key reparseinfo tag] + } + } else { + append note "$key vs [dict keys [dict get $contents linkinfo]]" + } + } + lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"] } set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink] @@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs { if {[dict exists $shortcutinfo link_target]} { set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { - #file type could return 'link' - we will use ifile/isdirectory + #file type could return 'link' - we will use isfile/isdirectory if {[file isfile $tgt]} { set target_type file } elseif {[file isdirectory $tgt]} { @@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs { switch -- $target_type { file { set display [dict get $fdict display] - set display $fshortcut_style$display ;# + set display "$fshortcut_style$display (shortcut to $tgt)" ;# dict set fdict display $display lappend finfo_plus $fdict } diff --git a/src/modules/punk/winlnk-999999.0a1.0.tm b/src/modules/punk/winlnk-999999.0a1.0.tm index 2925f40e..5bcd7172 100644 --- a/src/modules/punk/winlnk-999999.0a1.0.tm +++ b/src/modules/punk/winlnk-999999.0a1.0.tm @@ -252,7 +252,7 @@ tcl::namespace::eval punk::winlnk { - #https://github.com/libyal/liblnk/blob/main/documentation/Windows%20Shortcut%20File%20(LNK)%20format.asciidoc + #offset 24 4 bytes #File attribute flags diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm index f2ee38b5..1e1986e6 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/du-0.1.0.tm @@ -19,6 +19,7 @@ ##e.g package require frobz package require punk::mix::base package require struct::set +package require punk::args namespace eval punk::du { @@ -486,29 +487,156 @@ namespace eval punk::du { return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] } } - proc attributes_twapi {path {detail basic}} { + variable win_reparse_tags + #implied prefix for all names IO_REPARSE_TAG_ + #list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4 + set win_reparse_tags [dict create\ + RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\ + HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\ + HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\ + WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\ + CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\ + DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\ + FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\ + SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\ + IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\ + DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\ + DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\ + APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\ + NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\ + FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\ + DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\ + WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\ + WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\ + CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\ + PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\ + STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\ + WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\ + PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\ + LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\ + LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\ + LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\ + WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ] + variable win_reparse_tags_by_int + dict for {k v} $win_reparse_tags { + set intkey [expr {[dict get $v hex]}] + set info [dict merge [dict create tag $k] $v] ;#put tag at front + dict set win_reparse_tags_by_int $intkey $info + } + + #https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point + #need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 + #then twapi::device_ioctl (win32 DeviceIoControl) + #then parse buffer somehow (binary scan..) + #https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913 + + proc Get_attributes_from_iteminfo {args} { + variable win_reparse_tags_by_int + + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + *values -min 1 -max 1 + iteminfo -help "iteminfo dict as set by 'twapi::find_file_next 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 "" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"] + } + } + dict set result -raw $iteminfo + return $result + } + + + proc attributes_twapi {args} { + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" + *values -min 1 -max 1 + path -help "path to file or folder for which to retrieve attributes" + } $args] + set opts [dict get $argd opts] + set path [dict get $argd values path] + set opt_detail [dict get $opts -detail] + set opt_debug [dict get $opts -debug] + set opt_debugchannel [dict get $opts -debugchannel] + try { - set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field + set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field if {[twapi::find_file_next $iterator iteminfo]} { - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0] - if {"hidden" in $attrinfo} { - dict set result -hidden 1 - } - if {"system" in $attrinfo} { - dict set result -system 1 - } - if {"readonly" in $attrinfo} { - dict set result -readonly 1 - } - dict set result -shortname [dict get $iteminfo altname] - dict set result -rawflags $attrinfo - set extras [list] - #foreach prop {ctime atime mtime size} { - # lappend extras $prop [dict get $iteminfo $prop] - #} - #dict set result -extras $extras - dict set result -raw $iteminfo + set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo] return $result } else { error "could not read attributes for $path" @@ -519,13 +647,14 @@ namespace eval punk::du { } #todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed? - namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided + namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs # get listing without using unix-tools (may not be installed on the windows system) # this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function) # This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance proc du_dirlisting_twapi {folderpath args} { set defaults [dict create\ -glob *\ + -filedebug 0\ -with_sizes 1\ -with_times 1\ ] @@ -534,6 +663,9 @@ namespace eval punk::du { set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_with_sizes [dict get $opts -with_sizes] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + set opt_filedebug [dict get $opts -filedebug] ;#per file + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set ftypes [list f d l] if {"$opt_with_sizes" in {0 1}} { #don't use string is boolean - (f false vs f file!) @@ -705,6 +837,8 @@ namespace eval punk::du { set alltimes [dict create] set links [list] + set linkinfo [dict create] + set debuginfo [dict create] set flaggedhidden [list] set flaggedsystem [list] set flaggedreadonly [list] @@ -717,25 +851,18 @@ namespace eval punk::du { continue } set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - #puts stderr "$iteminfo" - #puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo" + #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set ftype "" #attributes applicable to any classification set fullname [file_join_one $folderpath $nm] - if {"hidden" in $attrinfo} { - lappend flaggedhidden $fullname - } - if {"system" in $attrinfo} { - lappend flaggedsystem $fullname - } - if {"readonly" in $attrinfo} { - lappend flaggedreadonly $fullname - } + set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict + set file_attributes [dict get $attrdict -fileattributes] + set linkdata [dict create] + # ----------------------------------------------------------- #main classification - if {"reparse_point" in $attrinfo} { + if {"reparse_point" in $file_attributes} { #this concept doesn't correspond 1-to-1 with unix links #https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #review - and see which if any actually belong in the links key of our return @@ -758,17 +885,27 @@ namespace eval punk::du { #Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window. # #links are techically files too, whether they point to a file/dir or nothing. - lappend links $fullname set ftype "l" - } elseif {"directory" in $attrinfo} { + dict set linkdata linktype reparse_point + dict set linkdata reparseinfo [dict get $attrdict -reparseinfo] + if {"directory" ni $file_attributes} { + dict set linkdata target_type file + } + } + if {"directory" in $file_attributes} { if {$nm in {. ..}} { continue } - lappend dirs $fullname - set ftype "d" - } else { - + if {"reparse_point" ni $file_attributes} { + lappend dirs $fullname + set ftype "d" + } else { + #other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections + dict set linkdata target_type directory + } + } + if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} { #review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort? lappend files $fullname if {"f" in $sized_types} { @@ -776,6 +913,17 @@ namespace eval punk::du { } set ftype "f" } + # ----------------------------------------------------------- + + if {[dict get $attrdict -hidden]} { + lappend flaggedhidden $fullname + } + if {[dict get $attrdict -system]} { + lappend flaggedsystem $fullname + } + if {[dict get $attrdict -readonly]} { + lappend flaggedreadonly $fullname + } if {$ftype in $sized_types} { dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] } @@ -789,6 +937,12 @@ namespace eval punk::du { m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\ ] } + if {[dict size $linkdata]} { + dict set linkinfo $fullname $linkdata + } + if {[dict exists $attrdict -debug]} { + dict set debuginfo $fullname [dict get $attrdict -debug] + } } twapi::find_file_close $iterator set vfsmounts [get_vfsmounts_in_folder $folderpath] @@ -799,7 +953,7 @@ namespace eval punk::du { #also determine whether vfs. file system x is *much* faster than file attributes #whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder - return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors] + return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors] } proc get_vfsmounts_in_folder {folderpath} { set vfsmounts [list] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index fdffa091..9c7fd73c 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs { commandstack::basecall cd $VIRTUAL_CWD } } - set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD] + set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}] } else { if {[pwd] ne $VIRTUAL_CWD} { commandstack::basecall cd $VIRTUAL_CWD } - set matchinfo [dirfiles_dict -searchbase [pwd]] + set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}] } set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] #puts stderr "=--->$matchinfo" @@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs { } set normpath [file normalize $path] cd $normpath - set matchinfo [dirfiles_dict -searchbase $normpath $normpath] + set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath] set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] set location [file normalize [dict get $matchinfo location]] @@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs { proc dirlist {{location ""}} { - set contents [dirfiles_dict $location] + set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase 1 $contents] } @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs { lappend vfsmounts {*}[dict get $contents vfsmounts] } + set fkeys [dict create] ;#avoid some file normalize calls.. if {$opt_stripbase && $common_base ne ""} { set filetails [list] set dirtails [list] foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { set stripped [list] - foreach f [set $fileset] { - lappend stripped [strip_prefix_depth $f $common_base] + foreach fullname [set $fileset] { + set shortname [strip_prefix_depth $fullname $common_base] + dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem + lappend stripped $shortname } set $fileset $stripped } - #Note: we need to remember to use common_base to rebuild the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. + #Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. } # -- --- --- --- --- --- --- --- --- --- --- @@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs { set dir_symlinks [list] set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory foreach s $links { - if {[file isfile $s]} { - lappend file_symlinks $s - #will be appended in finfo_plus later - } elseif {[file isdirectory $s]} { - lappend dir_symlinks $s - lappend dirs $s + if {[dict exists $contents linkinfo $s target_type]} { + #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem. + set target_type [dict get $contents linkinfo $s target_type] + switch -- $target_type { + file { + lappend file_symlinks $s + } + directory { + lappend dir_symlinks $s + lappend dirs $s + } + default { + puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)" + } + } } else { - #dunno - warn for now - puts stderr "Warning - cannot determine link type for link $s" + #fallback if no target_type + if {[file isfile $s]} { + lappend file_symlinks $s + #will be appended in finfo_plus later + } elseif {[file isdirectory $s]} { + lappend dir_symlinks $s + lappend dirs $s + } else { + #dunno - warn for now + puts stderr "Warning - cannot determine link type for link $s" + } } } #we now have the issue that our symlinks aren't sorted within the dir/file categorisation - they currently will have to appear at beginning or end - TODO @@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs { if {$opt_formatsizes} { set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each } - #col2 with subcolumns + + #col2 (file info) with subcolumns - #remove punk::pipedata dependency - allow use of punk::nav::fs without punk package - #set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] - #widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]] set c2a [string repeat " " [expr {$widest2a + 1}]] #set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]] set c2b [string repeat " " [expr {$widest2b + 1}]] + + #c2c timestamp and short note - fixed width 19 for ts + + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck + # total 42 + set c2c [string repeat " " 42] set finfo [list] foreach f $files s $filesizes { + if {[dict size $fkeys]} { + set key [dict get $fkeys $f] + } else { + #not stripped - they should match + set key $f + } #note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces #hence we need to keep the filename as well, properly protected as a list element - lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"] + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + #set ts [string repeat { } 19] + set ts "$key vs [dict keys [dict get $contents times]]" + } + set note "" + lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"] } set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline set dlink_style [punk::ansi::a+ undercurly underline undt-green] #We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden foreach flink $file_symlinks { - lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"] + if {[dict size $fkeys]} { + set key [dict get $fkeys $flink] + } else { + set key $flink + } + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + set ts "[string repeat { } 19]" + } + set note "link" ;#default only + if {[dict exists $contents linkinfo $key linktype]} { + if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} { + set note "reparse_point" + if {[dict exists $contents linkinfo $key reparseinfo tag]} { + append note " " [dict get $contents linkinfo $key reparseinfo tag] + } + } else { + append note "$key vs [dict keys [dict get $contents linkinfo]]" + } + } + lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"] } set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink] @@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs { if {[dict exists $shortcutinfo link_target]} { set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { - #file type could return 'link' - we will use ifile/isdirectory + #file type could return 'link' - we will use isfile/isdirectory if {[file isfile $tgt]} { set target_type file } elseif {[file isdirectory $tgt]} { @@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs { switch -- $target_type { file { set display [dict get $fdict display] - set display $fshortcut_style$display ;# + set display "$fshortcut_style$display (shortcut to $tgt)" ;# dict set fdict display $display lappend finfo_plus $fdict } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm index f2ee38b5..1e1986e6 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/du-0.1.0.tm @@ -19,6 +19,7 @@ ##e.g package require frobz package require punk::mix::base package require struct::set +package require punk::args namespace eval punk::du { @@ -486,29 +487,156 @@ namespace eval punk::du { return [lindex [lappend winfile_attributes $bitmask [twapi::decode_file_attributes $bitmask]] end] } } - proc attributes_twapi {path {detail basic}} { + variable win_reparse_tags + #implied prefix for all names IO_REPARSE_TAG_ + #list of reparse tags: https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/c8e77b37-3909-4fe6-a4ea-2b9d423b1ee4 + set win_reparse_tags [dict create\ + RESERVED_ZERO [list hex 0x00000000 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_ONE [list hex 0x00000001 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + RESERVED_TWO [list hex 0x00000002 obsolete 0 serverside 0 meaning "Reserved reparse tag value"]\ + MOUNT_POINT [list hex 0xA0000003 obsolete 0 serverside 0 meaning "Used for mount point support"]\ + HSM [list hex 0xC0000004 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + DRIVE_EXTENDER [list hex 0x80000005 obsolete 0 serverside 0 meaning "Home server drive extender"]\ + HSM2 [list hex 0xC0000006 obsolete 1 serverside 0 meaning "Obsolete. Used by legacy Hierarchical Storage Manager Product"]\ + SIS [list hex 0x80000007 obsolete 0 serverside 1 meaning "Used by single-instance storage (SIS) filter driver."]\ + WIM [list hex 0x80000008 obsolete 0 serverside 1 meaning "Used by the WIM Mount filter."]\ + CSV [list hex 0x80000008 obsolete 1 serverside 1 meaning "Obsolete. Used by Clustered Shared Volumes (CSV) version 1 in Windows Server 2008 R2 operating system. "]\ + DFS [list hex 0x8000000A obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in the Distributed File System (DFS): Referral Protocol Specification \[MS-DFSC\]."]\ + FILTER_MANAGER [list hex 0x8000000B obsolete 0 serverside 0 meaning "Used by filter manager test harness"]\ + SYMLINK [list hex 0xA000000C obsolete 0 serverside 0 meaning "Used for symbolic link support."]\ + IIS_CACHE [list hex 0xA0000010 obsolete 0 serverside 1 meaning "Used by Microsoft Internet Information Services (IIS) caching. "]\ + DFSR [list hex 0x80000012 obsolete 0 serverside 1 meaning "Used by the DFS filter. The DFS is described in \[MS-DFSC\]. "]\ + DEDUP [list hex 0x80000013 obsolete 0 serverside 1 meaning "Used by the Data Deduplication (Dedup) filter. "]\ + APPXSTRM [list hex 0xC0000014 obsolete 0 serverside 0 meaning "Not used."]\ + NFS [list hex 0x80000014 obsolete 0 serverside 1 meaning "Used by the Network File System (NFS) component. "]\ + FILE_PLACEHOLDER [list hex 0x80000015 obsolete 1 serverside 1 meaning "Obsolete. Used by Windows Shell for legacy placeholder files in Windows 8.1. "]\ + DFM [list hex 0x80000016 obsolete 0 serverside 1 meaning "Used by the Dynamic File filter. "]\ + WOF [list hex 0x80000017 obsolete 0 serverside 1 meaning "Used by the Windows Overlay filter, for either WIMBoot or single-file compression."]\ + WCI [list hex 0x80000018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + WCI_2 [list hex 0x90001018 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter. "]\ + GLOBAL_REPARSE [list hex 0xA0000019 obsolete 0 serverside 1 meaning "Used by NPFS to indicate a named pipe symbolic link from a server silo into the host silo."]\ + CLOUD [list hex 0x9000001A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_1 [list hex 0x9000101A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_2 [list hex 0x9000201A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_3 [list hex 0x9000301A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_4 [list hex 0x9000401A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_5 [list hex 0x9000501A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_6 [list hex 0x9000601A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_7 [list hex 0x9000701A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_8 [list hex 0x9000801A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_9 [list hex 0x9000901A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_A [list hex 0x9000A01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_B [list hex 0x9000B01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_C [list hex 0x9000C01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_D [list hex 0x9000D01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_E [list hex 0x9000E01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + CLOUD_F [list hex 0x9000F01A obsolete 0 serverside 1 meaning "Used by the Cloud Files filter, for files managed by a sync engine such as Microsoft OneDrive."]\ + APPEXECLINK [list hex 0x8000001B obsolete 0 serverside 1 meaning "Used by Universal Windows Platform (UWP) packages to encode information that allows the application to be launched by CreateProcess."]\ + PROJFS [list hex 0x9000001C obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + LX_SYMLINK [list hex 0xA000001D obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX symbolic link."]\ + STORAGE_SYNC [list hex 0x8000001E obsolete 0 serverside 1 meaning "Used by the Azure File Sync (AFS) filter."]\ + WCI_TOMBSTONE [list hex 0xA000001F obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + UNHANDLED [list hex 0x80000020 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ONEDRIVE [list hex 0x80000021 obsolete 0 serverside 0 meaning "Not used"]\ + PROJFS_TOMBSTONE [list hex 0xA0000022 obsolete 0 serverside 1 meaning "Used by the Windows Projected File System filter, for files managed by a user mode provider such as VFS for Git."]\ + AF_UNIX [list hex 0x80000023 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX domain socket."]\ + LX_FIFO [list hex 0x80000024 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX FIFO (named pipe)."]\ + LX_CHR [list hex 0x80000025 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX character special file."]\ + LX_BLK [list hex 0x80000026 obsolete 0 serverside 1 meaning "Used by the Windows Subsystem for Linux (WSL) to represent a UNIX block special file."]\ + WCI_LINK [list hex 0xA0000027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + WCI_LINK_1 [list hex 0xA0001027 obsolete 0 serverside 1 meaning "Used by the Windows Container Isolation filter."]\ + ] + variable win_reparse_tags_by_int + dict for {k v} $win_reparse_tags { + set intkey [expr {[dict get $v hex]}] + set info [dict merge [dict create tag $k] $v] ;#put tag at front + dict set win_reparse_tags_by_int $intkey $info + } + + #https://stackoverflow.com/questions/46383428/get-the-immediate-target-path-from-symlink-reparse-point + #need to call twapi::create_file with FILE_FLAG_OPEN_REPARSE_POINT 0x00200000 + #then twapi::device_ioctl (win32 DeviceIoControl) + #then parse buffer somehow (binary scan..) + #https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-fscc/b41f1cbf-10df-4a47-98d4-1c52a833d913 + + proc Get_attributes_from_iteminfo {args} { + variable win_reparse_tags_by_int + + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + *values -min 1 -max 1 + iteminfo -help "iteminfo dict as set by 'twapi::find_file_next 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 "" hex 0x[format %X $low_int] meaning "unknown reparse tag int:$low_int"] + } + } + dict set result -raw $iteminfo + return $result + } + + + proc attributes_twapi {args} { + set argd [punk::args::get_dict { + -debug -default 0 -help "set 1 for raw data on -debugchannel (default stderr)" + -debugchannel -default stderr -help "channel to write debug output, or none to append to output" + -detail -default basic -choices {basic full} -help "full returns also the altname/shortname field" + *values -min 1 -max 1 + path -help "path to file or folder for which to retrieve attributes" + } $args] + set opts [dict get $argd opts] + set path [dict get $argd values path] + set opt_detail [dict get $opts -detail] + set opt_debug [dict get $opts -debug] + set opt_debugchannel [dict get $opts -debugchannel] + try { - set iterator [twapi::find_file_open $path -detail $detail] ;# -detail full only adds data to the altname field + set iterator [twapi::find_file_open $path -detail $opt_detail] ;# -detail full only adds data to the altname field if {[twapi::find_file_next $iterator iteminfo]} { - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - set result [dict create -archive 0 -hidden 0 -longname $path -readonly 0 -shortname {} -system 0] - if {"hidden" in $attrinfo} { - dict set result -hidden 1 - } - if {"system" in $attrinfo} { - dict set result -system 1 - } - if {"readonly" in $attrinfo} { - dict set result -readonly 1 - } - dict set result -shortname [dict get $iteminfo altname] - dict set result -rawflags $attrinfo - set extras [list] - #foreach prop {ctime atime mtime size} { - # lappend extras $prop [dict get $iteminfo $prop] - #} - #dict set result -extras $extras - dict set result -raw $iteminfo + set result [Get_attributes_from_iteminfo -debug $opt_debug -debugchannel $opt_debugchannel $iteminfo] return $result } else { error "could not read attributes for $path" @@ -519,13 +647,14 @@ namespace eval punk::du { } #todo - review 'errors' key. We have errors relating to containing folder and args vs per child-item errors - additional key needed? - namespace export du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided + namespace export attributes_twapi du_dirlisting_twapi du_dirlisting_generic du_dirlisting_unix du_dirlisting_undecided du_dirlisting_tclvfs # get listing without using unix-tools (may not be installed on the windows system) # this dirlisting is customised for du - so only retrieves dirs,files,filesizes (minimum work needed to perform du function) # This also preserves path rep for elements in the dirs/folders keys etc - which can make a big difference in performance proc du_dirlisting_twapi {folderpath args} { set defaults [dict create\ -glob *\ + -filedebug 0\ -with_sizes 1\ -with_times 1\ ] @@ -534,6 +663,9 @@ namespace eval punk::du { set opt_glob [dict get $opts -glob] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_with_sizes [dict get $opts -with_sizes] + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- + set opt_filedebug [dict get $opts -filedebug] ;#per file + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- set ftypes [list f d l] if {"$opt_with_sizes" in {0 1}} { #don't use string is boolean - (f false vs f file!) @@ -705,6 +837,8 @@ namespace eval punk::du { set alltimes [dict create] set links [list] + set linkinfo [dict create] + set debuginfo [dict create] set flaggedhidden [list] set flaggedsystem [list] set flaggedreadonly [list] @@ -717,25 +851,18 @@ namespace eval punk::du { continue } set tail_altname [dict get $iteminfo altname] ;#altname of tail - not whole path - set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] - #puts stderr "$iteminfo" - #puts stderr "$nm -> [dict get $iteminfo attrs] -> $attrinfo" + #set attrinfo [decode_win_attributes [dict get $iteminfo attrs]] set ftype "" #attributes applicable to any classification set fullname [file_join_one $folderpath $nm] - if {"hidden" in $attrinfo} { - lappend flaggedhidden $fullname - } - if {"system" in $attrinfo} { - lappend flaggedsystem $fullname - } - if {"readonly" in $attrinfo} { - lappend flaggedreadonly $fullname - } + set attrdict [Get_attributes_from_iteminfo -debug $opt_filedebug -debugchannel none $iteminfo] ;#-debugchannel none puts -debug key in the resulting dict + set file_attributes [dict get $attrdict -fileattributes] + set linkdata [dict create] + # ----------------------------------------------------------- #main classification - if {"reparse_point" in $attrinfo} { + if {"reparse_point" in $file_attributes} { #this concept doesn't correspond 1-to-1 with unix links #https://learn.microsoft.com/en-us/windows/win32/fileio/reparse-points #review - and see which if any actually belong in the links key of our return @@ -758,17 +885,27 @@ namespace eval punk::du { #Note also - a shortcut created in explorer with drag and drop to an existant folder is a different animal to a symlink (file with .lnk extension) even though it looks the same in explorer window. # #links are techically files too, whether they point to a file/dir or nothing. - lappend links $fullname set ftype "l" - } elseif {"directory" in $attrinfo} { + dict set linkdata linktype reparse_point + dict set linkdata reparseinfo [dict get $attrdict -reparseinfo] + if {"directory" ni $file_attributes} { + dict set linkdata target_type file + } + } + if {"directory" in $file_attributes} { if {$nm in {. ..}} { continue } - lappend dirs $fullname - set ftype "d" - } else { - + if {"reparse_point" ni $file_attributes} { + lappend dirs $fullname + set ftype "d" + } else { + #other mechanisms can't immediately classify a link as file vs directory - so we don't return this info in the main dirs/files collections + dict set linkdata target_type directory + } + } + if {"reparse_point" ni $file_attributes && "directory" ni $file_attributes} { #review - is anything that isn't a reparse_point or a directory, some sort of 'file' in this context? What about the 'device' attribute? Can that occur in a directory listing of some sort? lappend files $fullname if {"f" in $sized_types} { @@ -776,6 +913,17 @@ namespace eval punk::du { } set ftype "f" } + # ----------------------------------------------------------- + + if {[dict get $attrdict -hidden]} { + lappend flaggedhidden $fullname + } + if {[dict get $attrdict -system]} { + lappend flaggedsystem $fullname + } + if {[dict get $attrdict -readonly]} { + lappend flaggedreadonly $fullname + } if {$ftype in $sized_types} { dict set allsizes $fullname [dict create bytes [dict get $iteminfo size]] } @@ -789,6 +937,12 @@ namespace eval punk::du { m [twapi::large_system_time_to_secs_since_1970 [dict get $iteminfo mtime]]\ ] } + if {[dict size $linkdata]} { + dict set linkinfo $fullname $linkdata + } + if {[dict exists $attrdict -debug]} { + dict set debuginfo $fullname [dict get $attrdict -debug] + } } twapi::find_file_close $iterator set vfsmounts [get_vfsmounts_in_folder $folderpath] @@ -799,7 +953,7 @@ namespace eval punk::du { #also determine whether vfs. file system x is *much* faster than file attributes #whether or not there is a corresponding file/dir add any applicable mountpoints for the containing folder - return [list dirs $dirs vfsmounts $vfsmounts links $links files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts errors $errors] + return [list dirs $dirs vfsmounts $vfsmounts links $links linkinfo $linkinfo files $files filesizes $filesizes sizes $allsizes times $alltimes flaggedhidden $flaggedhidden flaggedsystem $flaggedsystem flaggedreadonly $flaggedreadonly altname $altname opts $effective_opts debuginfo $debuginfo errors $errors] } proc get_vfsmounts_in_folder {folderpath} { set vfsmounts [list] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm index fdffa091..9c7fd73c 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/nav/fs-0.1.0.tm @@ -196,12 +196,12 @@ tcl::namespace::eval punk::nav::fs { commandstack::basecall cd $VIRTUAL_CWD } } - set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD] + set matchinfo [dirfiles_dict -searchbase $VIRTUAL_CWD -with_times {f d l} -with_sizes {f d l}] } else { if {[pwd] ne $VIRTUAL_CWD} { commandstack::basecall cd $VIRTUAL_CWD } - set matchinfo [dirfiles_dict -searchbase [pwd]] + set matchinfo [dirfiles_dict -searchbase [pwd] -with_times {f d l} -with_sizes {f d l}] } set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] @@ -378,7 +378,7 @@ tcl::namespace::eval punk::nav::fs { } } } - set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location] + set matchinfo [dirfiles_dict -searchbase $searchbase -tailglob $glob $location -with_sizes {f d l} -with_times {f d l}] #puts stderr "=--->$matchinfo" @@ -467,7 +467,7 @@ tcl::namespace::eval punk::nav::fs { } set normpath [file normalize $path] cd $normpath - set matchinfo [dirfiles_dict -searchbase $normpath $normpath] + set matchinfo [dirfiles_dict -searchbase $normpath -with_sizes {f d l} -with_times {f d l} $normpath] set dircount [llength [dict get $matchinfo dirs]] set filecount [llength [dict get $matchinfo files]] set location [file normalize [dict get $matchinfo location]] @@ -626,7 +626,7 @@ tcl::namespace::eval punk::nav::fs { proc dirlist {{location ""}} { - set contents [dirfiles_dict $location] + set contents [dirfiles_dict -with_times {f d l} -with_sizes {f d l} $location] return [dirfiles_dict_as_lines -stripbase 1 $contents] } @@ -694,7 +694,7 @@ tcl::namespace::eval punk::nav::fs { } } puts "--> -searchbase:$searchbase searchspec:$searchspec -tailglob:$tailglob location:$location" - set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob $location] + set contents [dirfiles_dict -searchbase $searchbase -tailglob $tailglob -with_times {f d l} $location] return [dirfiles_dict_as_lines -stripbase $opt_stripbase -formatsizes $opt_formatsizes $contents] } @@ -1038,17 +1038,20 @@ tcl::namespace::eval punk::nav::fs { lappend vfsmounts {*}[dict get $contents vfsmounts] } + set fkeys [dict create] ;#avoid some file normalize calls.. if {$opt_stripbase && $common_base ne ""} { set filetails [list] set dirtails [list] foreach fileset [list dirs files links underlayfiles flaggedhidden flaggedreadonly flaggedsystem nonportable vfsmounts] { set stripped [list] - foreach f [set $fileset] { - lappend stripped [strip_prefix_depth $f $common_base] + foreach fullname [set $fileset] { + set shortname [strip_prefix_depth $fullname $common_base] + dict set fkeys $shortname $fullname ;#cache so we can retrieve already normalised name without re-hitting filesystem + lappend stripped $shortname } set $fileset $stripped } - #Note: we need to remember to use common_base to rebuild the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. + #Note: without fkeys we would need to remember to use common_base to rebuild (and file normalize!) the key when we need to query the dict-based elements: sizes & times - because we didn't strip those keys. } # -- --- --- --- --- --- --- --- --- --- --- @@ -1060,15 +1063,33 @@ tcl::namespace::eval punk::nav::fs { set dir_symlinks [list] set dir_shortcuts [list] ;#windows shell links (.lnk) that have a target that is a directory foreach s $links { - if {[file isfile $s]} { - lappend file_symlinks $s - #will be appended in finfo_plus later - } elseif {[file isdirectory $s]} { - lappend dir_symlinks $s - lappend dirs $s + if {[dict exists $contents linkinfo $s target_type]} { + #some mechanisms such as twapi can provide the target_type info so we don't have to re-hit the filesystem. + set target_type [dict get $contents linkinfo $s target_type] + switch -- $target_type { + file { + lappend file_symlinks $s + } + directory { + lappend dir_symlinks $s + lappend dirs $s + } + default { + puts stderr "Warning - cannot determine link type for link $s (target_type value is:$target_type)" + } + } } else { - #dunno - warn for now - puts stderr "Warning - cannot determine link type for link $s" + #fallback if no target_type + if {[file isfile $s]} { + lappend file_symlinks $s + #will be appended in finfo_plus later + } elseif {[file isdirectory $s]} { + lappend dir_symlinks $s + lappend dirs $s + } else { + #dunno - warn for now + puts stderr "Warning - cannot determine link type for link $s" + } } } #we now have the issue that our symlinks aren't sorted within the dir/file categorisation - they currently will have to appear at beginning or end - TODO @@ -1083,28 +1104,66 @@ tcl::namespace::eval punk::nav::fs { if {$opt_formatsizes} { set filesizes [punk::lib::format_number $filesizes] ;#accepts a list and will process each } - #col2 with subcolumns + + #col2 (file info) with subcolumns - #remove punk::pipedata dependency - allow use of punk::nav::fs without punk package - #set widest2a [punk::pipedata [list {*}$files ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] - #widest2a.= concat $files [list ""] |> .=>2 lmap v {string length $v} |> .=>* tcl::mathfunc::max set widest2a [tcl::mathfunc::max {*}[lmap v [list {*}$files {*}$file_symlinks ""] {string length $v}]] set c2a [string repeat " " [expr {$widest2a + 1}]] #set widest2b [punk::pipedata [list {*}$filesizes ""] {lmap v $data {string length $v}} {tcl::mathfunc::max {*}$data}] set widest2b [tcl::mathfunc::max {*}[lmap v [list {*}$filesizes ""] {string length $v}]] set c2b [string repeat " " [expr {$widest2b + 1}]] + + #c2c timestamp and short note - fixed width 19 for ts + + filetype note e.g "symlink" "shortcut" "binary" ?? combinations? allow 2 words 10 each for 21 + 1 for luck + # total 42 + set c2c [string repeat " " 42] set finfo [list] foreach f $files s $filesizes { + if {[dict size $fkeys]} { + set key [dict get $fkeys $f] + } else { + #not stripped - they should match + set key $f + } #note - the display entry isn't necessarily a valid tcl list e.g filename with unbalanced curly braces #hence we need to keep the filename as well, properly protected as a list element - lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s]"] + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + #set ts [string repeat { } 19] + set ts "$key vs [dict keys [dict get $contents times]]" + } + set note "" + lappend finfo [list file $f display "[overtype::left $c2a $f] [overtype::right $c2b $s] [overtype::left $c2c "$ts $note"]"] } set flink_style [punk::ansi::a+ undercurly underline undt-green] ;#curly green underline with fallback to normal underline set dlink_style [punk::ansi::a+ undercurly underline undt-green] #We use an underline so the visual styling of a link can coexist with fg/bg colors applied for other attributes such as hidden foreach flink $file_symlinks { - lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0]"] + if {[dict size $fkeys]} { + set key [dict get $fkeys $flink] + } else { + set key $flink + } + if {[dict exists $contents times $key m]} { + set mtime [dict get $contents times $key m] + set ts [tcl::clock::format $mtime -format "%Y-%m-%d %H:%M:%S"] + } else { + set ts "[string repeat { } 19]" + } + set note "link" ;#default only + if {[dict exists $contents linkinfo $key linktype]} { + if {[dict get $contents linkinfo $key linktype] eq "reparse_point"} { + set note "reparse_point" + if {[dict exists $contents linkinfo $key reparseinfo tag]} { + append note " " [dict get $contents linkinfo $key reparseinfo tag] + } + } else { + append note "$key vs [dict keys [dict get $contents linkinfo]]" + } + } + lappend finfo [list file $flink display "$flink_style[overtype::left $c2a $flink] [overtype::right $c2b 0] [overtype::left $c2c "$ts $note"]"] } set fshortcut_style [punk::ansi::a+ underdotted underline undt-hotpink] @@ -1122,7 +1181,7 @@ tcl::namespace::eval punk::nav::fs { if {[dict exists $shortcutinfo link_target]} { set tgt [dict get $shortcutinfo link_target] if {[file exists $tgt]} { - #file type could return 'link' - we will use ifile/isdirectory + #file type could return 'link' - we will use isfile/isdirectory if {[file isfile $tgt]} { set target_type file } elseif {[file isdirectory $tgt]} { @@ -1138,7 +1197,7 @@ tcl::namespace::eval punk::nav::fs { switch -- $target_type { file { set display [dict get $fdict display] - set display $fshortcut_style$display ;# + set display "$fshortcut_style$display (shortcut to $tgt)" ;# dict set fdict display $display lappend finfo_plus $fdict }