tests/018/path-safe.tl


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

(load "../common")

;; only root can do this test
(unless (zerop (geteuid))
  (exit))

(defvarl testdir (mkdtemp `/tmp/txr-path-safe-test`))

(push-after-load (remove-path-rec testdir))

(chmod testdir "a+rX")

(defvarl atestdir (realpath testdir))
(defvarl tmpdir (path-cat testdir "tmp"))

(mkdir tmpdir)
(defvarl atmpdir (realpath tmpdir))
(ensure-dir tmpdir)
(chmod tmpdir "a+rwt")

(seteuid 10000)
(touch (path-cat tmpdir "10000"))
(symlink "/" (path-cat tmpdir "10000-link"))
(seteuid 0)

(seteuid 20000)
(touch (path-cat tmpdir "20000"))
(symlink "/" (path-cat tmpdir "20000-link"))
(seteuid 0)

(mtest
  (path-components-safe tmpdir) t
  (path-components-safe (path-cat tmpdir "10000")) nil
  (path-components-safe (path-cat tmpdir "10000-link")) nil
  (path-components-safe (path-cat tmpdir "20000")) nil)

(mtest
  (path-components-safe atmpdir) t
  (path-components-safe (path-cat atmpdir "10000")) nil
  (path-components-safe (path-cat atmpdir "10000-link")) nil
  (path-components-safe (path-cat atmpdir "20000")) nil)

(seteuid 10000)

(mtest
  (path-components-safe atmpdir) t
  (path-components-safe (path-cat tmpdir "10000")) t
  (path-components-safe (path-cat tmpdir "10000-link")) t
  (path-components-safe (path-cat tmpdir "20000")) nil
  (path-components-safe (path-cat tmpdir "20000-link")) nil)

(mtest
  (path-components-safe atmpdir) t
  (path-components-safe (path-cat atmpdir "10000")) t
  (path-components-safe (path-cat atmpdir "10000-link")) t
  (path-components-safe (path-cat atmpdir "20000")) nil
  (path-components-safe (path-cat atmpdir "20000-link")) nil)

(symlink "loop/x/y" (path-cat tmpdir "loop"))

(test
  (path-components-safe (path-cat tmpdir "loop/z")) :error)

(chdir tmpdir)
(symlink "b/c" "a")
(ensure-dir "b")
(symlink "x" "b/c")
(touch "b/x")

(test
  (path-components-safe "a") t)

(remove-path "b/c")

(test
  (path-components-safe "a") :error)

(seteuid 0)
(seteuid 20000)
(symlink "x" "z")

(seteuid 0)
(rename-path "z" "b/c")
(seteuid 10000)

(test
  (path-components-safe "a") nil)

(seteuid 0)