This file is indexed.

/usr/share/tcltk/vfs1.3/starkit.tcl is in tcl-vfs 1.3-20080503-4.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
# Starkit support, see http://www.equi4.com/starkit/
# by Jean-Claude Wippler, July 2002

package provide starkit 1.3.2

package require vfs

# Starkit scripts can launched in a number of ways:
#   - wrapped or unwrapped
#   - using tclkit, or from tclsh/wish with a couple of pkgs installed
#   - with real MetaKit support, or with a read-only fake (ReadKit)
#   - as 2-file starkit deployment, or as 1-file starpack
#
# Furthermore, there are three variations:
#   current:  starkits
#   older:    VFS-based "scripted documents"
#   oldest:   pre-VFS "scripted documents"
#
# The code in here is only called directly from the current starkits.

# lassign is used so widely by now, make sure it is always available
if {![info exists auto_index(lassign)] && [info commands lassign] eq ""} {
    set auto_index(lassign) {
	proc lassign {l args} {
	    foreach v $l a $args { uplevel 1 [list set $a $v] }
	}
    }
}

namespace eval starkit {
    # these variables are defined after the call to starkit::startup
    # they are special in that a second call will not alter them
    # (as needed when a starkit sources others for more packages)
    variable topdir	;# root directory (while the starkit is mounted)
    variable mode 	;# startup mode (starkit, sourced, etc)

    # called from the header of a starkit
    proc header {driver args} {
	if {[catch {
	    set self [fullnormalize [info script]]

	    package require ${driver}vfs
	    eval [list ::vfs::${driver}::Mount $self $self] $args

	    uplevel [list source [file join $self main.tcl]]
	}]} {
	    panic $::errorInfo
	}
    }

    proc fullnormalize {path} {
	# SNARFED from tcllib, fileutil.
	# 8.5
	# return [file join {expand}[lrange [file split
	#    [file normalize [file join $path __dummy__]]] 0 end-1]]

	return [file dirname [file normalize [file join $path __dummy__]]]
    }

    # called from the startup script of a starkit to init topdir and auto_path
    # 2003/10/21, added in 1.3: remember startup mode in starkit::mode
    proc startup {} {
	if {![info exists starkit::mode]} { variable mode }
	set mode [_startup]
    }

    # returns how the script was launched: starkit, starpack, unwrapped, or
    # sourced (2003: also tclhttpd, plugin, or service)
    proc _startup {} {
	global argv0

	# 2003/02/11: new behavior, if starkit::topdir exists, don't disturb it
	if {![info exists starkit::topdir]} { variable topdir }

	set script [vfs::filesystem fullynormalize [info script]]
	set topdir [file dirname $script]

	if {$topdir eq [vfs::filesystem fullynormalize [info nameofexe]]} { return starpack }

	# pkgs live in the $topdir/lib/ directory
	set lib [file join $topdir lib]
	if {[file isdir $lib]} { autoextend $lib }

	set a0 [vfs::filesystem fullynormalize $argv0]
	if {$topdir eq $a0} { return starkit }
	if {$script eq $a0} { return unwrapped }

	# detect when sourced from tclhttpd
	if {[info procs ::Httpd_Server] ne ""} { return tclhttpd }

	# detect when sourced from the plugin (tentative)
	if {[info exists ::embed_args]} { return plugin }

	# detect when run as an NT service
	if {[info exists ::tcl_service]} { return service }

	return sourced
    }

    # append an entry to auto_path if it's not yet listed
    proc autoextend {dir} {
	global auto_path
	set dir [vfs::filesystem fullynormalize $dir]
	if {[lsearch $auto_path $dir] < 0} {
	    lappend auto_path $dir
	}
    }

    # remount a starkit with different options
    proc remount {args} {
	variable topdir
	lassign [vfs::filesystem info $topdir] drv arg
	vfs::unmount $topdir
	
	eval [list [regsub handler $drv Mount] $topdir $topdir] $args
    }

    # terminate with an error message, using most appropriate mechanism
    proc panic {msg} {
	if {[info commands wm] ne ""} {
	    catch { wm withdraw . }
	    tk_messageBox -icon error -message $msg -title "Fatal error"
	} elseif {[info commands ::eventlog] ne ""} {
	    eventlog error $msg
	} else {
	    puts stderr $msg
	}
	exit
    }

    # the following proc was copied from the critcl package:

    # return a platform designator, including both OS and machine
    #
    # only use first element of $tcl_platform(os) - we don't care
    # whether we are on "Windows NT" or "Windows XP" or whatever
    #
    # transforms $tcl_platform(machine) for some special cases
    #  - on SunOS, matches for sun4* are transformed to sparc
    #  - on all OS's matches for intel and i*86* are transformed to x86
    #  - on MacOS X "Power Macintosh" is transformed to ppc
    #
    proc platform {} {
        global tcl_platform
        set plat [lindex $tcl_platform(os) 0]
        set mach $tcl_platform(machine)
        switch -glob -- $mach {
            sun4* { set mach sparc }
            intel -
            i*86* { set mach x86 }
            "Power Macintosh" { set mach ppc }
        }
	switch -- $plat {
	  AIX   { set mach ppc }
	  HP-UX { set mach hppa }
	}
        return "$plat-$mach"
    }

    # load extension from a platform-specific subdirectory
    proc pload {dir name args} {
      set f [file join $dir [platform] $name[info sharedlibext]]
      uplevel 1 [linsert $args 0 load $f]
    }
}