1#/usr/bin/env tclsh
2
3if 0 {
4########################
5
6chrootvfs.tcl --
7
8Written by Stephen Huntley (stephen.huntley@alum.mit.edu)
9License: Tcl license
10Version 1.5
11
12A chroot virtual filesystem.
13
14This virual filesystem has an effect similar to a "chroot" command; it makes the named existing directory appear
15to be the top of the filesystem and makes the rest of the real filesystem invisible.
16
17This vfs does not block access by the "exec" command to the real filesystem outside the chroot directory,
18or that of the "open" command when its command pipeline syntax is used.
19
20At the end of this file is example code showing one way to set up a safe slave interpreter suitable for
21running a process safely with limited filesystem access: its file access commands are re-enabled, the exec
22command remains disabled, the open command is aliased so that it can only open files and can't spawn new
23processes, and mounted volumes besides the volume on which the chroot directory resides are aliased so
24that they act as mirrors of the chroot directory.
25
26Such an interpreter should be advantageous for applications such as a web server: which requires some
27filesystem access but presents security threats that make access limitations desirable.
28
29 Install: This code requires the vfs::template package included in the Tclvfs distribution.
30
31 Usage: mount ?-volume? <existing "chroot" directory>  <virtual directory>
32
33 examples:
34
35	mount $::env(HOME) /
36
37	mount {C:\My Music} C:/
38
39	mount -volume /var/www/htdocs chroot://
40
41########################
42}
43
44namespace eval ::vfs::template::chroot {
45
46package require vfs::template 1.5
47package provide vfs::template::chroot 1.5.2
48
49# read template procedures into current namespace. Do not edit:
50foreach templateProc [namespace eval ::vfs::template {info procs}] {
51	set infoArgs [info args ::vfs::template::$templateProc]
52	set infoBody [info body ::vfs::template::$templateProc]
53	proc $templateProc $infoArgs $infoBody
54}
55
56proc file_attributes {file {attribute {}} args} {eval file attributes \$file $attribute $args}
57
58catch {rename redirect_handler {}}
59catch {rename handler redirect_handler}
60
61proc handler args {
62	set path [lindex $args 0]
63	set to [lindex $args 2]
64	set volume [lindex $::vfs::template::mount($to) 1]
65	if {$volume != "-volume"} {set volume {}}
66	set startDir [pwd]
67
68	::vfs::filesystem unmount $to
69
70	set err [catch {set rv [uplevel ::vfs::template::chroot::redirect_handler $args]} result] ; set errorCode $::errorCode
71
72	eval ::vfs::filesystem mount $volume [list $to] \[list [namespace current]::handler \[file normalize \$path\]\]
73	if {[pwd] != $startDir} {catch {cd $startDir}}
74	if {$err && ([lindex $errorCode 0] == "POSIX")} {vfs::filesystem posixerror $::vfs::posix([lindex $errorCode 1])}
75	if $err {return -code $err $result}
76	return $rv
77}
78
79
80# Example code to set up a safe interpreter with limited filesystem access:
81proc chroot_slave {} {
82	file mkdir /tmp
83	package require vfs::template
84	::vfs::template::chroot::mount -volume /tmp C:/
85	set vols [lsort -unique [file volumes]]
86	foreach vol $vols {
87		if {$vol == "C:/"} {continue}
88		::vfs::template::mount C:/ $vol
89	}
90	set slave [interp create -safe]
91	$slave expose cd
92	$slave expose encoding
93	$slave expose fconfigure
94	$slave expose file
95	$slave expose glob
96	$slave expose load
97	$slave expose pwd
98	$slave expose socket
99	$slave expose source
100
101	$slave alias exit exit_safe $slave
102	$slave alias open open_safe $slave
103
104	interp share {} stdin $slave
105	interp share {} stdout $slave
106	interp share {} stderr $slave
107}
108
109proc exit_safe {slave} {
110	interp delete $slave
111}
112
113proc open_safe {args} {
114	set slave [lindex $args 0]
115	set handle [lindex $args 1]
116	set args [lrange $args 1 end]
117	if {[string index $handle 0] != "|"} {
118		eval [eval list interp invokehidden $slave open $args]
119	} else {
120		error "permission denied"
121	}
122}
123
124
125}
126# end namespace ::vfs::template::chroot
127
128