uawdijnntqw1x1x1
IP : 18.118.255.23
Hostname : ns1.eurodns.top
Kernel : Linux ns1.eurodns.top 4.18.0-553.5.1.lve.1.el7h.x86_64 #1 SMP Fri Jun 14 14:24:52 UTC 2024 x86_64
Disable Function : mail,sendmail,exec,passthru,shell_exec,system,popen,curl_multi_exec,show_source,eval,open_base
OS : Linux
PATH:
/
home
/
sudancam
/
.
/
..
/
..
/
usr
/
share
/
.
/
tcl8.5
/
tm.tcl
/
/
# -*- tcl -*- # # Searching for Tcl Modules. Defines a procedure, declares it as the # primary command for finding packages, however also uses the former # 'package unknown' command as a fallback. # # Locates all possible packages in a directory via a less restricted # glob. The targeted directory is derived from the name of the # requested package. I.e. the TM scan will look only at directories # which can contain the requested package. It will register all # packages it found in the directory so that future requests have a # higher chance of being fulfilled by the ifneeded database without # having to come to us again. # # We do not remember where we have been and simply rescan targeted # directories when invoked again. The reasoning is this: # # - The only way we get back to the same directory is if someone is # trying to [package require] something that wasn't there on the # first scan. # # Either # 1) It is there now: If we rescan, you get it; if not you don't. # # This covers the possibility that the application asked for a # package late, and the package was actually added to the # installation after the application was started. It shoukld # still be able to find it. # # 2) It still is not there: Either way, you don't get it, but the # rescan takes time. This is however an error case and we dont't # care that much about it # # 3) It was there the first time; but for some reason a "package # forget" has been run, and "package" doesn't know about it # anymore. # # This can be an indication that the application wishes to reload # some functionality. And should work as well. # # Note that this also strikes a balance between doing a glob targeting # a single package, and thus most likely requiring multiple globs of # the same directory when the application is asking for many packages, # and trying to glob for _everything_ in all subdirectories when # looking for a package, which comes with a heavy startup cost. # # We scan for regular packages only if no satisfying module was found. namespace eval ::tcl::tm { # Default paths. None yet. variable paths {} # The regex pattern a file name has to match to make it a Tcl Module. set pkgpattern {^([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)[.]tm$} # Export the public API namespace export path namespace ensemble create -command path -subcommand {add remove list} } # ::tcl::tm::path implementations -- # # Public API to the module path. See specification. # # Arguments # cmd - The subcommand to execute # args - The paths to add/remove. Must not appear querying the # path with 'list'. # # Results # No result for subcommands 'add' and 'remove'. A list of paths # for 'list'. # # Sideeffects # The subcommands 'add' and 'remove' manipulate the list of # paths to search for Tcl Modules. The subcommand 'list' has no # sideeffects. proc ::tcl::tm::add {path args} { # PART OF THE ::tcl::tm::path ENSEMBLE # # The path is added at the head to the list of module paths. # # The command enforces the restriction that no path may be an # ancestor directory of any other path on the list. If the new # path violates this restriction an error wil be raised. # # If the path is already present as is no error will be raised and # no action will be taken. variable paths # We use a copy of the path as source during validation, and # extend it as well. Because we not only have to detect if the new # paths are bogus with respect to the existing paths, but also # between themselves. Otherwise we can still add bogus paths, by # specifying them in a single call. This makes the use of the new # paths simpler as well, a trivial assignment of the collected # paths to the official state var. set newpaths $paths foreach p [linsert $args 0 $path] { if {$p in $newpaths} { # Ignore a path already on the list. continue } # Search for paths which are subdirectories of the new one. If # there are any then the new path violates the restriction # about ancestors. set pos [lsearch -glob $newpaths ${p}/*] # Cannot use "in", we need the position for the message. if {$pos >= 0} { return -code error \ "$p is ancestor of existing module path [lindex $newpaths $pos]." } # Now look for existing paths which are ancestors of the new # one. This reverse question forces us to loop over the # existing paths, as each element is the pattern, not the new # path :( foreach ep $newpaths { if {[string match ${ep}/* $p]} { return -code error \ "$p is subdirectory of existing module path $ep." } } set newpaths [linsert $newpaths 0 $p] } # The validation of the input is complete and successful, and # everything in newpaths is either an old path, or added. We can # now extend the official list of paths, a simple assignment is # sufficient. set paths $newpaths return } proc ::tcl::tm::remove {path args} { # PART OF THE ::tcl::tm::path ENSEMBLE # # Removes the path from the list of module paths. The command is # silently ignored if the path is not on the list. variable paths foreach p [linsert $args 0 $path] { set pos [lsearch -exact $paths $p] if {$pos >= 0} { set paths [lreplace $paths $pos $pos] } } } proc ::tcl::tm::list {} { # PART OF THE ::tcl::tm::path ENSEMBLE variable paths return $paths } # ::tcl::tm::UnknownHandler -- # # Unknown handler for Tcl Modules, i.e. packages in module form. # # Arguments # original - Original [package unknown] procedure. # name - Name of desired package. # version - Version of desired package. Can be the # empty string. # exact - Either -exact or ommitted. # # Name, version, and exact are used to determine # satisfaction. The original is called iff no satisfaction was # achieved. The name is also used to compute the directory to # target in the search. # # Results # None. # # Sideeffects # May populate the package ifneeded database with additional # provide scripts. proc ::tcl::tm::UnknownHandler {original name args} { # Import the list of paths to search for packages in module form. # Import the pattern used to check package names in detail. variable paths variable pkgpattern # Without paths to search we can do nothing. (Except falling back # to the regular search). if {[llength $paths]} { set pkgpath [string map {:: /} $name] set pkgroot [file dirname $pkgpath] if {$pkgroot eq "."} { set pkgroot "" } # We don't remember a copy of the paths while looping. Tcl # Modules are unable to change the list while we are searching # for them. This also simplifies the loop, as we cannot get # additional directories while iterating over the list. A # simple foreach is sufficient. set satisfied 0 foreach path $paths { if {![interp issafe] && ![file exists $path]} { continue } set currentsearchpath [file join $path $pkgroot] if {![interp issafe] && ![file exists $currentsearchpath]} { continue } set strip [llength [file split $path]] # We can't use glob in safe interps, so enclose the following # in a catch statement, where we get the module files out # of the subdirectories. In other words, Tcl Modules are # not-functional in such an interpreter. This is the same # as for the command "tclPkgUnknown", i.e. the search for # regular packages. catch { # We always look for _all_ possible modules in the current # path, to get the max result out of the glob. foreach file [glob -nocomplain -directory $currentsearchpath *.tm] { set pkgfilename [join [lrange [file split $file] $strip end] ::] if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} { # Ignore everything not matching our pattern # for package names. continue } if {[catch {package vcompare $pkgversion 0}]} { # Ignore everything where the version part is # not acceptable to "package vcompare". continue } # We have found a candidate, generate a "provide # script" for it, and remember it. Note that we # are using ::list to do this; locally [list] # means something else without the namespace # specifier. # NOTE. When making changes to the format of the # provide command generated below CHECK that the # 'LOCATE' procedure in core file # 'platform/shell.tcl' still understands it, or, # if not, update its implementation appropriately. # # Right now LOCATE's implementation assumes that # the path of the package file is the last element # in the list. package ifneeded $pkgname $pkgversion \ "[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]" # We abort in this unknown handler only if we got # a satisfying candidate for the requested # package. Otherwise we still have to fallback to # the regular package search to complete the # processing. if { ($pkgname eq $name) && [package vsatisfies $pkgversion {*}$args] } then { set satisfied 1 # We do not abort the loop, and keep adding # provide scripts for every candidate in the # directory, just remember to not fall back to # the regular search anymore. } } } } if {$satisfied} { return } } # Fallback to previous command, if existing. See comment above # about ::list... if {[llength $original]} { uplevel 1 $original [::linsert $args 0 $name] } } # ::tcl::tm::Defaults -- # # Determines the default search paths. # # Arguments # None # # Results # None. # # Sideeffects # May add paths to the list of defaults. proc ::tcl::tm::Defaults {} { global env tcl_platform lassign [split [info tclversion] .] major minor set exe [file normalize [info nameofexecutable]] # Note that we're using [::list], not [list] because [list] means # something other than [::list] in this namespace. roots [::list \ [file dirname [info library]] \ [file join [file dirname [file dirname $exe]] lib] \ ] if {$tcl_platform(platform) eq "windows"} { set sep ";" } else { set sep ":" } for {set n $minor} {$n >= 0} {incr n -1} { foreach ev [::list \ TCL${major}.${n}_TM_PATH \ TCL${major}_${n}_TM_PATH \ ] { if {![info exists env($ev)]} continue foreach p [split $env($ev) $sep] { path add $p } } } return } # ::tcl::tm::roots -- # # Public API to the module path. See specification. # # Arguments # paths - List of 'root' paths to derive search paths from. # # Results # No result. # # Sideeffects # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { foreach {major minor} [split [info tclversion] .] break foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { set px [file join $p ${major}.${n}] if {![interp issafe]} { set px [file normalize $px] } path add $px } set px [file join $p site-tcl] if {![interp issafe]} { set px [file normalize $px] } path add $px } return } # Initialization. Set up the default paths, then insert the new # handler into the chain. if {![interp issafe]} { ::tcl::tm::Defaults }
/home/sudancam/./../../usr/share/./tcl8.5/tm.tcl