1
2
3
4
5
6
7
8
9
10
11
12
13
14 ringbr_: proc;
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 dcl a_code fixed bin (35) parameter;
44 dcl a_dirname char (*) parameter;
45 dcl a_drb (2) fixed bin (3) parameter;
46 dcl a_ename char (*) parameter;
47 dcl a_rb (3) fixed bin (3) parameter;
48 dcl a_segptr ptr parameter;
49
50 dcl directory fixed bin static options (constant) init (2);
51 dcl get fixed bin static options (constant) init (1);
52 dcl segment fixed bin static options (constant) init (1);
53 dcl set fixed bin static options (constant) init (2);
54
55 dcl code fixed bin (35);
56 dcl d_s bit (1) aligned;
57 dcl drbr (2) fixed bin (3);
58 dcl dirname char (168);
59 dcl entryname char (32);
60 dcl function fixed bin;
61 dcl i fixed bin;
62 dcl lev fixed bin;
63 dcl 1 local_sc_info aligned like sc_info;
64 dcl pathname_supplied bit (1) aligned;
65 dcl pvid bit (36) aligned;
66 dcl rbr (3) fixed bin (3);
67 dcl segptr ptr;
68 dcl type fixed bin;
69 dcl uid bit (36) aligned;
70 dcl username char (32) aligned;
71 dcl vtocx fixed bin;
72
73 dcl change_dtem ext entry (ptr);
74 dcl check_gate_acl_ ext entry (ptr, bit (1) aligned, fixed bin, char (32) aligned, fixed bin (35));
75 dcl level$get ext entry (fixed bin);
76 dcl lock$dir_unlock ext entry (ptr);
77 dcl setfaults$if_active ext entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (1) aligned);
78 dcl sum$dirmod ext entry (ptr);
79 dcl vtoc_attributes$get_info ext entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin (35));
80
81 dcl error_table_$ai_restricted ext fixed bin (35);
82 dcl error_table_$dirseg ext fixed bin (35);
83 dcl error_table_$invalid_ring_brackets ext fixed bin (35);
84 dcl error_table_$lower_ring ext fixed bin (35);
85 dcl error_table_$not_dm_ring ext fixed bin (35);
86 dcl error_table_$notadir ext fixed bin (35);
87 dcl error_table_$null_info_ptr ext fixed bin (35);
88 dcl pds$processid bit (36) aligned ext;
89 dcl sys_info$data_management_ringno fixed bin ext;
90
91 dcl (addr, bit, fixed, null, ptr) builtin;
92 %page;
93
94
95
96 get: entry (a_dirname, a_ename, a_rb, a_code);
97
98 function = get;
99 type = segment;
100 pathname_supplied = "1"b;
101 go to start_proc;
102
103 get_ring_brackets_seg:
104 entry (a_segptr, a_rb, a_code);
105
106 function = get;
107 type = segment;
108 pathname_supplied = "0"b;
109 go to start_proc;
110
111 get_dir: entry (a_dirname, a_ename, a_drb, a_code);
112
113 function = get;
114 type = directory;
115 pathname_supplied = "1"b;
116 go to start_proc;
117
118 set: entry (a_dirname, a_ename, a_rb, a_code);
119
120 function = set;
121 type = segment;
122 pathname_supplied = "1"b;
123 go to start_proc;
124
125 set_dir: entry (a_dirname, a_ename, a_drb, a_code);
126
127 function = set;
128 type = directory;
129 pathname_supplied = "1"b;
130 go to start_proc;
131
132
133
134 start_proc:
135
136 dp, ep = null ();
137
138 if pathname_supplied then
139 do;
140 dirname = a_dirname;
141 entryname = a_ename;
142 end;
143 else do;
144 segptr = a_segptr;
145 if segptr = null then
146 go to segptr_null_err;
147 end;
148
149 code = 0;
150 call level$get (lev);
151
152 if function = set then do;
153 if type = segment then do;
154 rbr = a_rb;
155 do i = 1 to 3;
156 if rbr (i) < lev then go to low_ring_err;
157 if rbr (i) > 7 then go to brack_err;
158 end;
159 if rbr (1) > rbr (2) then go to brack_err;
160 if rbr (2) > rbr (3) then go to brack_err;
161 end;
162
163 else do;
164 drbr = a_drb;
165 do i = 1 to 2;
166 if drbr (i) < lev then go to low_ring_err;
167 if drbr (i) > 7 then go to brack_err;
168 end;
169 if drbr (1) > drbr (2) then go to brack_err;
170 end;
171 end;
172
173 if pathname_supplied then
174 do;
175 if function = set then
176 call dc_find$obj_access_write (dirname, entryname, 1, FS_OBJ_RING_MOD, ep, code);
177 else call dc_find$obj_attributes_read (dirname, entryname, 1, ep, code);
178 end;
179
180 Note
181
182
183
184
185
186
187 else
188 call dc_find$obj_attributes_read_ptr (segptr, ep, code);
189
190 if code ^= 0 then go to error_return;
191
192 dp = ptr (ep, 0);
193
194 d_s = ep -> entry.dirsw;
195
196 if type = directory then
197 if ^d_s then do;
198 code = error_table_$notadir;
199 go to error_return;
200 end;
201
202 if type = segment then
203 if d_s then do;
204 code = error_table_$dirseg;
205 go to error_return;
206 end;
207
208 if function = get then do;
209 if type = segment then rbr = fixed (ep -> entry.ring_brackets, 3);
210 else do;
211 drbr (1) = fixed (ep -> entry.ex_ring_brackets (1), 3);
212 drbr (2) = fixed (ep -> entry.ex_ring_brackets (2), 3);
213 end;
214 end;
215
216 else do;
217 if type = segment then do;
218 if lev > fixed (ep -> entry.ring_brackets (1), 3) then go to low_ring_err;
219
220 if (rbr (2) ^= rbr (3))
221 & lev > 1
222 & ep -> entry.acl_frp ^= "0"b then do;
223 call check_gate_acl_ (addr (ep -> entry.acl_frp), "1"b, (ep -> entry.acle_count), username, code);
224 if code ^= 0 then go to error_return;
225 end;
226
227 if ep -> entry.multiple_class
228 & rbr (3) > 1 then go to aim_err;
229
230 if (fixed (ep -> entry.ring_brackets (1), 3) <= sys_info$data_management_ringno)
231 & (rbr (1) > sys_info$data_management_ringno)
232 then do;
233 uid = ep -> entry.uid;
234 pvid = ep -> entry.pvid;
235 vtocx = ep -> entry.vtocx;
236 call vtoc_attributes$get_info (uid, pvid, vtocx, addr (local_sc_info), code);
237 if code ^= 0 then goto error_return;
238 if local_sc_info.flags.synchronized
239 then goto dm_ring_error;
240 end;
241
242 end;
243
244
245 else if lev > fixed (ep -> entry.ex_ring_brackets (1), 3) then go to low_ring_err;
246
247 dir.modify = pds$processid;
248 call change_dtem (ep);
249
250 if type = segment then ep -> entry.ring_brackets = bit (rbr, 3);
251 else do;
252 ep -> entry.ex_ring_brackets (1) = bit (drbr (1), 3);
253 ep -> entry.ex_ring_brackets (2) = bit (drbr (2), 3);
254 end;
255
256 call setfaults$if_active ((ep -> entry.uid), (ep -> entry.pvid), (ep -> entry.vtocx), "1"b);
257
258 dir.modify = "0"b;
259 call sum$dirmod (dp);
260 end;
261
262 if pathname_supplied then
263 call dc_find$finished (dp, DC_FIND_UNLOCK_DIR);
264 else call lock$dir_unlock (dp);
265
266 if function = get then do;
267 if type = segment then a_rb = rbr;
268 else a_drb = drbr;
269 end;
270
271 a_code = code;
272 return;
273 %page;
274 brack_err:
275 code = error_table_$invalid_ring_brackets;
276 go to error_common;
277
278 low_ring_err:
279 code = error_table_$lower_ring;
280 go to error_common;
281
282 aim_err:
283 code = error_table_$ai_restricted;
284 goto error_common;
285
286 dm_ring_error:
287 code = error_table_$not_dm_ring;
288 goto error_common;
289
290 segptr_null_err:
291 code = error_table_$null_info_ptr;
292 goto error_common;
293
294 error_return:
295 error_common:
296 if dp ^= null then do;
297 if function = set then dir.modify = "0"b;
298 call lock$dir_unlock (dp);
299 if pathname_supplied then
300 call dc_find$finished (dp, "0"b);
301 end;
302
303 a_code = code;
304 return;
305 %page; %include dc_find_dcls;
306 %page; %include dir_entry;
307 %page; %include dir_header;
308 %page; %include fs_obj_access_codes;
309 %page; %include quota_cell;
310 %page; %include sc_info;
311 end;