summaryrefslogtreecommitdiffstats
path: root/tests/018/chmod.tl
blob: d8663b5e3fada1aadcb246d584065aa4a2dcdb29 (plain)
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" "="                 "------------")
;; These tests don't work on Cygwin 3.1.7, Windows 10.
;; They worked on Cygwin 2.5 on Windows 7.
(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")