File: chrootvfs.tcl

package info (click to toggle)
tclvfs 1.3-20080503-3
  • links: PTS
  • area: main
  • in suites: wheezy
  • size: 2,052 kB
  • sloc: tcl: 7,090; xml: 2,882; ansic: 1,729; sh: 193; makefile: 55; exp: 12
file content (126 lines) | stat: -rw-r--r-- 3,814 bytes parent folder | download | duplicates (3)
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
#/usr/bin/env tclsh

if 0 {
########################

chrootvfs.tcl --

Written by Stephen Huntley (stephen.huntley@alum.mit.edu)
License: Tcl license
Version 1.5

A chroot virtual filesystem.

This virual filesystem has an effect similar to a "chroot" command; it makes the named existing directory appear
to be the top of the filesystem and makes the rest of the real filesystem invisible.

This vfs does not block access by the "exec" command to the real filesystem outside the chroot directory,
or that of the "open" command when its command pipeline syntax is used.

At the end of this file is example code showing one way to set up a safe slave interpreter suitable for
running a process safely with limited filesystem access: its file access commands are re-enabled, the exec
command remains disabled, the open command is aliased so that it can only open files and can't spawn new 
processes, and mounted volumes besides the volume on which the chroot directory resides are aliased so 
that they act as mirrors of the chroot directory.

Such an interpreter should be advantageous for applications such as a web server: which requires some 
filesystem access but presents security threats that make access limitations desirable.

 Install: This code requires the vfs::template package included in the Tclvfs distribution.

 Usage: mount ?-volume? <existing "chroot" directory>  <virtual directory>

 examples:

	mount $::env(HOME) /

	mount {C:\My Music} C:/

	mount -volume /var/www/htdocs chroot://

########################
}

namespace eval ::vfs::template::chroot {

package require vfs::template 1.5

# read template procedures into current namespace. Do not edit:
foreach templateProc [namespace eval ::vfs::template {info procs}] {
	set infoArgs [info args ::vfs::template::$templateProc]
	set infoBody [info body ::vfs::template::$templateProc]
	proc $templateProc $infoArgs $infoBody
}

proc file_attributes {file {attribute {}} args} {eval file attributes \$file $attribute $args}

catch {rename redirect_handler {}}
catch {rename handler redirect_handler}

proc handler args {
	set path [lindex $args 0]
	set to [lindex $args 2]
	set volume [lindex $::vfs::template::mount($to) 1]
	if {$volume != "-volume"} {set volume {}}
	set startDir [pwd]

	::vfs::filesystem unmount $to

	set err [catch {set rv [uplevel ::vfs::template::chroot::redirect_handler $args]} result] ; set errorCode $::errorCode

	eval ::vfs::filesystem mount $volume [list $to] \[list [namespace current]::handler \[file normalize \$path\]\]
	if {[pwd] != $startDir} {catch {cd $startDir}}
	if {$err && ([lindex $errorCode 0] == "POSIX")} {vfs::filesystem posixerror $::vfs::posix([lindex $errorCode 1])}
	if $err {return -code $err $result}
	return $rv
}


# Example code to set up a safe interpreter with limited filesystem access:
proc chroot_slave {} {
	file mkdir /tmp
	package require vfs::template
	::vfs::template::chroot::mount -volume /tmp C:/
	set vols [lsort -unique [file volumes]]
	foreach vol $vols {
		if {$vol == "C:/"} {continue}
		::vfs::template::mount C:/ $vol
	}
	set slave [interp create -safe]
	$slave expose cd  
	$slave expose encoding
	$slave expose fconfigure
	$slave expose file
	$slave expose glob
	$slave expose load
	$slave expose pwd
	$slave expose socket
	$slave expose source

	$slave alias exit exit_safe $slave
	$slave alias open open_safe $slave

	interp share {} stdin $slave
	interp share {} stdout $slave
	interp share {} stderr $slave
}

proc exit_safe {slave} {
	interp delete $slave
}

proc open_safe {args} {
	set slave [lindex $args 0]
	set handle [lindex $args 1]
	set args [lrange $args 1 end]
	if {[string index $handle 0] != "|"} {
		eval [eval list interp invokehidden $slave open $args]
	} else {
		error "permission denied"
	}
}


}
# end namespace ::vfs::template::chroot