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
|
(load "../common")
(load "../perm")
(defvarl tgt [*args* 0])
(remove-path tgt)
(with-stream (s (open-file tgt "w")))
(umask #o022)
(defvarl os (os-symbol))
(defvarl test-sticky (unless (meq os :bsd :openbsd)
(chmod tgt s-isvtx)
(let ((st (stat tgt)))
(plusp (logand s-isvtx st.mode)))))
(defmacro mode-bits (st-mode)
^(logand ,st-mode #xFFF))
(defun cht (init mode expected)
(when (or test-sticky
(not (find #\t `@init@mode@expected`)))
(let ((ini (dec-perm init))
(exp (dec-perm expected)))
(chmod tgt ini)
(let* ((st (stat tgt))
(m (mode-bits st.mode)))
(unless (eql m ini)
(error "failed to set initial mode: expected: ~s, actual: ~s "
init (enc-perm m))))
(chmod tgt mode)
(let* ((st (stat tgt))
(m (mode-bits st.mode)))
(unless (eql m exp)
(error "failed to set mode with ~s: expected ~s, actual ~s"
mode expected (enc-perm m)))))))
(cht "------------" "a+strwx" "sgtrwxrwxrwx")
(cht "------------" "+strwx" "sgtrwxr-xr-x")
(cht "------------" "u+s" "s-----------")
(cht "------------" "g+s" "-g----------")
(cht "------------" "+t" "--t---------")
(cht "sgtrwxrwxrwx" "=" "------------")
(unless (eq os :cygwin)
(cht "sgtrwxrwxrwx" "u=" "-gt---rwxrwx")
(cht "sgtrwxrwxrwx" "g=" "s-trwx---rwx")
(cht "sgtrwxrwxrwx" "o=" "sg-rwxrwx---"))
(cht "------------" "u+s,g+s" "sg----------")
(cht "------------" "u+r,g+r,o+r,+t,+s" "sgtr--r--r--")
(cht "------------" "+rwx,g-r+w,o-r+w" "---rwx-wx-wx")
(cht "---------rwx" "u=rwsx" "s--rwx---rwx")
(unless (eq os :cygwin)
(cht "---------rwx" "u=rwsx,g=rwx,go-x" "s--rwxrw-rw-")
(cht "---------rwx" "g=o,g-w+s,u=g,o-x" "-g-r-xr-xrw-"))
(cht "---------rwx" "o=o" "---------rwx")
(cht "-----x------" "a+X" "-----x--x--x")
(cht "-----x------" "=,a+X" "------------")
(cht "-----x------" "a-x+X" "------------")
(cht "------------" "u+x-X" "------------")
(cht "------------" "o+x=o" "-----------x")
|
