• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1;; Minimum stuff
2(class CLASS (PERM))
3(classorder (CLASS))
4(sid SID)
5(sidorder (SID))
6(user USER)
7(role ROLE)
8(type TYPE)
9(category CAT)
10(categoryorder (CAT))
11(sensitivity SENS)
12(sensitivityorder (SENS))
13(sensitivitycategory SENS (CAT))
14(allow TYPE self (CLASS (PERM)))
15(roletype ROLE TYPE)
16(userrole USER ROLE)
17(userlevel USER (SENS))
18(userrange USER ((SENS)(SENS (CAT))))
19(sidcontext SID (USER ROLE TYPE ((SENS)(SENS))))
20;; Extra stuff
21(common COMMON (PERM1 PERM2 PERM3 PERM4))
22(classcommon CLASS COMMON)
23
24
25;; Check global resolution
26(type t0)
27(allow t0 self (CLASS (PERM1)))
28(allow .t0 self (CLASS (PERM2)))
29
30
31;; Check block and sub-block resolution
32(block b1a
33  (type t1a)
34  (allow t1a self (CLASS (PERM)))
35  (allow b1b.t1b self (CLASS (PERM)))
36  (block b1b
37    (type t1b)
38    (allow t1a self (CLASS (PERM1)))
39    (allow t1b self (CLASS (PERM1)))
40    (allow .b1a.t1a self (CLASS (PERM2)))
41    (allow .b1a.b1b.t1b self (CLASS (PERM2)))
42  )
43)
44(allow b1a.t1a self (CLASS (PERM3)))
45(allow b1a.b1b.t1b self (CLASS (PERM3)))
46(allow .b1a.t1a self (CLASS (PERM4)))
47(allow .b1a.b1b.t1b self (CLASS (PERM4)))
48
49
50;; Check macro arg resolution
51(type t2)
52(macro m2 ((type t))
53  (allow t self (CLASS (PERM)))
54)
55(call m2 (t2))
56
57
58;; Check resolution for a macro with a parent decl
59(block b3
60  (type t3)
61  (macro m3 ()
62    (allow t3 self (CLASS (PERM)))
63  )
64)
65(call b3.m3)
66
67
68;; Check resolution for a macro with a caller decl
69(block b4
70  (block b4a
71    (macro m4 ()
72      (allow t4 self (CLASS (PERM)))
73    )
74  )
75  (block b4b
76    (type t4)
77    (call .b4.b4a.m4)
78  )
79)
80
81
82;; Check resolution for blockinherits with type in inheriting block
83(block b5a
84  (type t5a)
85  (block b5b
86    (allow t5a self (CLASS (PERM1)))
87  )
88)
89
90(block b5c
91  (type t5a)
92  (blockinherit b5a.b5b)
93  (allow t5a self (CLASS (PERM2)))
94)
95
96;; Check resolution for blockinherits with no type in inheriting block
97(block b6a
98  (type t6a)
99  (block b6b
100    (allow t6a self (CLASS (PERM1)))
101  )
102)
103
104(block b6c
105  (blockinherit b6a.b6b) ;; This does not cause an error.
106  ;;(allow t6a self (CLASS (PERM2))) ;; This causes an error
107)
108
109
110;; Check for proper resolution of t
111(block b7
112  (type t)
113  (macro m7 ((type t))
114    (allow t self (CLASS (PERM)))
115  )
116  (allow t self (CLASS (PERM1)))
117  (block b7a
118    (type t)
119    (allow t self (CLASS (PERM2)))
120    (block b7b
121      (type t)
122      (allow t self (CLASS (PERM3)))
123      (call m7 (t))
124    )
125  )
126)
127
128
129;; Check that improper name causes an error
130(block b8
131  (optional o8a
132    (type t8a)
133  )
134  (in o8a
135    (allow t8a self (CLASS (PERM1)))
136  )
137  ;;(allow o8a.t8a self (CLASS (PERM))) ;; Bad name
138  (macro m8 ((type t))
139    (allow t self (CLASS (PERM1)))
140  )
141  ;;(allow m8.t self (CLASS (PERM))) ;; Bad name
142)
143
144
145;;
146;; Expected:
147;;
148;; Types:
149;;   t0
150;;   b1a.t1a, b1a.b1b.t1b
151;;   t2
152;;   b3.t3
153;;   b4.b4b.t4
154;;   b5a.t5a, b5c.t5a
155;;   b6a.t6a
156;;   b7.t, b7.b7a.t, b7.b7a.b7b.t
157;;   b8.t8a
158;;
159;; Allow rules:
160;;   allow t0 t0 : CLASS { PERM1 PERM2 };
161;;   allow b1a.b1b.t1b b1a.b1b.t1b : CLASS { PERM PERM1 PERM2 PERM3 PERM4 };
162;;   allow b1a.t1a b1a.t1a : CLASS { PERM PERM1 PERM2 PERM3 PERM4 };
163;;   allow t2 t2 : CLASS { PERM };
164;;   allow b3.t3 b3.t3 : CLASS { PERM };
165;;   allow b4.b4b.t4 b4.b4b.t4 : CLASS { PERM };
166;;   allow b5a.t5a b5a.t5a : CLASS { PERM1 };
167;;   allow b5c.t5a b5c.t5a : CLASS { PERM1 PERM2 };
168;;   allow b6a.t6a b6a.t6a : CLASS { PERM1 };
169;;   allow b7.b7a.b7b.t b7.b7a.b7b.t : CLASS { PERM PERM3 };
170;;   allow b7.b7a.t b7.b7a.t : CLASS { PERM2 };
171;;   allow b7.t b7.t : CLASS { PERM1 };
172;;   allow b8.t8a b8.t8a : CLASS { PERM1 };
173