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
|
#
# chroot.test
#
# Tests for the chroot command.
#---------------------------------------------------------------------------
# Copyright 1993-1999 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose. It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id:
#------------------------------------------------------------------------------
#
if {[cequal [info procs Test] {}]} {
source [file join [file dirname [info script]] testlib.tcl]
}
#
# Fork without exec will not work under Tk, skip this test
#
if {[info exists tk_version]} {
puts "*************************************************************"
puts "Chroot tests are constructed in a way that does not work"
puts "under Tk. Test skipped."
puts "*************************************************************"
return
}
test chroot-1.1 {chroot tests} {unixOnly} {
list [catch {chroot} msg] $msg
} {1 {wrong # args: chroot path}}
test chroot-1.2 {chroot tests} {unixOnly} {
list [catch {chroot a b} msg] $msg
} {1 {wrong # args: chroot path}}
test chroot-1.3 {chroot tests} {pcOnly} {
list [catch {chroot a} msg] $msg
} {1 {chroot is not available on MS Windows}}
#
# Actually doing something real with chroot only makes sense on unix.
#
if ![cequal $tcl_platform(platform) "unix"] {
# cleanup
::tcltest::cleanupTests
return
}
if {[id user] != "root"} {
puts "*******************************************************************"
puts "You are not running as `root', certain chroot tests will be skipped"
puts "*******************************************************************"
# cleanup
::tcltest::cleanupTests
return
}
#
# clean up and create an empty test directory
#
set CHROOTDIR __CHROOTDIR.TEST
catch {file delete -force $CHROOTDIR}
file mkdir $CHROOTDIR
#
# since you can't chroot back up, we spawn a child process to do the
# actual chroot
#
set pid [fork]
#
# parent waits for child to complete
#
if {$pid > 0} {
wait $pid
file delete -force $CHROOTDIR
# cleanup
::tcltest::cleanupTests
return
}
#
# child tests chroot then exits
#
test chroot-2.1 {chroot tests} {isRoot} {
chroot $CHROOTDIR
glob -nocomplain /*
} {}
# cleanup
::tcltest::cleanupTests
exit
|
