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 asd_:
27 procedure;
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116 dcl a_acl_count fixed bin (17) parameter;
117 dcl a_acl_ptr ptr parameter;
118 dcl a_area_ptr ptr parameter;
119 dcl a_code fixed bin (35) parameter;
120 dcl a_daemon_sw bit (1) parameter;
121 dcl a_dir_name char (*) parameter;
122 dcl a_entryname char (*) parameter;
123 dcl a_return_struc_ptr ptr parameter;
124 dcl a_ring fixed bin (3) parameter;
125
126 dcl 1 acl1 based (acl_entry_ptr) aligned,
127
128 2 ac_name,
129 3 person char (32),
130 3 project char (32),
131 3 tag char (1),
132 2 mode bit (36),
133 2 ex_mode bit (36);
134 dcl arg_area area based (area_ptr);
135
136 dcl 1 a_n aligned like acl1;
137 dcl acl_entry_ptr ptr;
138 dcl acl_start_ptr ptr;
139 dcl add_sw bit (1);
140 dcl ael fixed bin;
141 dcl area_ptr ptr;
142 dcl called_find bit (1) aligned;
143 dcl caller_level fixed bin (3) unsigned;
144 dcl code fixed bin (35);
145 dcl d_s bit (1) aligned;
146 dcl daemon_sw bit (1) aligned;
147 dcl dirname char (168);
148 dcl entryname char (32);
149 dcl esw fixed bin (17);
150 dcl fail_sw bit (1) aligned;
151 dcl fatal_error_sets_faults
152 bit (1) aligned;
153 dcl i fixed bin;
154 dcl initial_acl bit (1) aligned;
155 dcl locked bit (1) aligned;
156 dcl locked_for_write bit (1) aligned;
157 dcl n_acls fixed bin;
158 dcl offset fixed bin;
159 dcl owning_structure bit (36) aligned;
160 dcl refer_allocation bit (1) aligned;
161 dcl return_acl_ptr pointer;
162 dcl ring fixed bin (17);
163 dcl structure_supplied bit (1) aligned;
164 dcl t_char1 char (32) aligned;
165 dcl t_char2 char (32) aligned;
166 dcl tag char (1) aligned;
167 dcl temp_access_name char (32) aligned;
168 dcl temp_extended_mode bit (36) aligned;
169 dcl temp_mode bit (36);
170 dcl work_p ptr;
171
172 dcl acc_name_$elements ext entry (ptr, ptr, fixed bin (35));
173 dcl acl_$add_entry entry (fixed bin, bit (36) aligned, ptr, ptr, bit (1), fixed bin (35));
174 dcl acl_$del_acl entry (fixed bin, bit (36) aligned, ptr);
175 dcl acl_$del_entry entry (fixed bin, bit (36) aligned, ptr, ptr, fixed bin (35));
176 dcl acl_$list_entry entry (fixed bin, bit (36) aligned, ptr, ptr, fixed bin, fixed bin (35));
177 dcl change_dtem entry (ptr);
178 dcl check_gate_acl_ entry (ptr, bit (1) aligned, fixed bin (17), char (32) aligned, fixed bin (35));
179 dcl level$get entry returns (fixed bin (3));
180 dcl lock$dir_lock_read entry (ptr, fixed bin (35));
181 dcl lock$dir_unlock entry (ptr);
182 dcl setfaults$if_active entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (1) aligned);
183 dcl sum$dirmod entry (ptr);
184
185 dcl error_table_$argerr ext fixed bin (35);
186 dcl error_table_$bad_acl_mode
187 ext fixed bin (35);
188 dcl error_table_$bad_ring_brackets
189 ext fixed bin (35);
190 dcl error_table_$dirseg ext fixed bin (35);
191 dcl error_table_$empty_acl ext fixed bin (35);
192 dcl error_table_$invalid_ascii
193 ext fixed bin (35);
194 dcl error_table_$invalid_mode
195 ext fixed bin (35);
196 dcl error_table_$noalloc ext fixed bin (35);
197 dcl error_table_$nondirseg ext fixed bin (35);
198 dcl error_table_$null_info_ptr
199 ext fixed bin (35);
200 dcl error_table_$user_not_found
201 ext fixed bin (35);
202 dcl pds$processid bit (36) aligned ext;
203
204 dcl ADD_DIR fixed bin static options (constant) init (4);
205 dcl ADD_SEG fixed bin static options (constant) init (8);
206 dcl DEL_DIR fixed bin static options (constant) init (2);
207 dcl DEL_SEG fixed bin static options (constant) init (6);
208 dcl LIST_DIR fixed bin static options (constant) init (1);
209 dcl LIST_SEG fixed bin static options (constant) init (5);
210 dcl REP_SEG fixed bin static options (constant) init (7);
211 dcl REP_DIR fixed bin static options (constant) init (3);
212
213 dcl (addr, bin, fixed, null, ptr, rtrim, substr)
214 builtin;
215
216 dcl (area, any_other, bad_dir_, cleanup, seg_fault_error)
217 condition;
218 %page;
219
220
221
222 list_idall:
223 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_acl_ptr, a_acl_count, a_ring, a_code);
224 initial_acl = "1"b;
225 go to LIST_DALL_COMMON;
226 list_dall:
227 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_acl_ptr, a_acl_count, a_code);
228 initial_acl = "0"b;
229
230 LIST_DALL_COMMON:
231 refer_allocation = "0"b;
232
233 go to R_LIST_DALL_COMMON;
234
235 r_list_idall:
236 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_ring, a_code);
237 initial_acl = "1"b;
238 go to R_LIST_DALL_COMMON_0;
239
240 r_list_dall:
241 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_code);
242 initial_acl = "0"b;
243 R_LIST_DALL_COMMON_0:
244 refer_allocation = "1"b;
245
246 R_LIST_DALL_COMMON:
247 if initial_acl
248 then ring = a_ring;
249
250
251 esw = LIST_DIR;
252 go to LIST_COMMON;
253
254 list_isall:
255 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_acl_ptr, a_acl_count, a_ring, a_code);
256
257 initial_acl = "1"b;
258 go to LIST_SALL_COMMON;
259
260 list_sall:
261 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_acl_ptr, a_acl_count, a_code);
262
263 initial_acl = "0"b;
264
265 LIST_SALL_COMMON:
266 refer_allocation = "0"b;
267
268 go to R_LIST_SALL_COMMON;
269
270 r_list_isall:
271 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_ring, a_code);
272 initial_acl = "1"b;
273 go to R_LIST_DALL_COMMON_0;
274
275 r_list_sall:
276 entry (a_dir_name, a_entryname, a_area_ptr, a_return_struc_ptr, a_code);
277 initial_acl = "0"b;
278 R_LIST_SALL_COMMON_0:
279 refer_allocation = "1"b;
280
281 R_LIST_SALL_COMMON:
282 if initial_acl
283 then ring = a_ring;
284
285 esw = LIST_SEG;
286
287
288
289
290
291
292
293
294 LIST_COMMON:
295 caller_level = level$get ();
296
297 locked, locked_for_write, called_find, fatal_error_sets_faults = "0"b;
298
299 area_ptr = a_area_ptr;
300 if initial_acl
301 then if ring < 0 | ring > 7
302 then call fatal_error (error_table_$argerr);
303 d_s = esw < LIST_SEG;
304 structure_supplied = (area_ptr = null);
305
306 if structure_supplied
307 then do;
308 if refer_allocation
309 then acl_ptr = a_return_struc_ptr;
310 else acl_ptr = a_acl_ptr;
311
312 if acl_ptr = null
313 then call fatal_error (error_table_$null_info_ptr);
314
315 if refer_allocation
316 then if d_s
317 then do;
318 acl_count = directory_acl.count;
319 acl_ptr = addr (directory_acl.entries);
320 end;
321 else do;
322 acl_count = segment_acl.count;
323 acl_ptr = addr (segment_acl.entries);
324 end;
325 else acl_count = a_acl_count;
326 end;
327 else do;
328 return_acl_ptr = null;
329 acl_ptr = null;
330 acl_count = 0;
331 end;
332
333
334 on cleanup call cleanup_;
335 %page;
336 Retry_process_list_all:
337 call check_pathname_find_read_lock_and_check_access;
338
339 acl_entry_ptr = addr (a_n);
340 if initial_acl
341 then do;
342 if d_s
343 then acl_start_ptr = addr (dir.iacl (ring).dir_frp);
344 else acl_start_ptr = addr (dir.iacl (ring).seg_frp);
345 if d_s
346 then n_acls = dir.iacl_count (ring).dir;
347 else n_acls = dir.iacl_count (ring).seg;
348 owning_structure = dir.uid;
349 end;
350 else do;
351 acl_start_ptr = addr (entry.acl_frp);
352 n_acls = entry.acle_count;
353 owning_structure = entry.uid;
354 end;
355
356
357
358
359
360 if structure_supplied
361 then call process_specific_list;
362 else if n_acls > 0
363 then call process_list_all;
364
365
366
367
368
369 call dc_find$finished (dp, "1"b);
370
371 if refer_allocation
372 then if structure_supplied
373 then ;
374 else do;
375 if acl_count = 0
376 then do;
377 acl_count = 1;
378 if d_s
379 then do;
380 allocate directory_acl in (arg_area);
381 directory_acl.count = 0;
382
383 end;
384 else do;
385 allocate segment_acl in (arg_area);
386 segment_acl.count = 0;
387 end;
388 return_acl_ptr = acl_ptr;
389 end;
390 a_return_struc_ptr = return_acl_ptr;
391 end;
392
393 else
394 if structure_supplied
395 then ;
396 else do;
397 if acl_count = 0
398 then do;
399 acl_count = 1;
400 if d_s
401 then allocate directory_acl_array in (arg_area);
402 else allocate segment_acl_array in (arg_area);
403 acl_count = 0;
404 end;
405 a_return_struc_ptr = acl_ptr;
406 a_acl_count = acl_count;
407 end;
408
409 a_code = code;
410 return;
411
412 %page;
413 del_identries:
414 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_ring, a_code);
415 initial_acl = "1"b;
416 go to DEL_DENTRIES_COMMON;
417 del_dentries:
418 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_code);
419
420 initial_acl = "0"b;
421 DEL_DENTRIES_COMMON:
422 esw = DEL_DIR;
423 goto start_proc;
424
425 del_isentries:
426 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_ring, a_code);
427 initial_acl = "1"b;
428 go to DEL_SENTRIES_COMMON;
429
430 del_sentries:
431 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_code);
432
433 initial_acl = "0"b;
434 DEL_SENTRIES_COMMON:
435 esw = DEL_SEG;
436 goto start_proc;
437
438 replace_idall:
439 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_daemon_sw, a_ring, a_code);
440 initial_acl = "1"b;
441 go to REPLACE_DALL_COMMON;
442
443 replace_dall:
444 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_daemon_sw, a_code);
445
446 initial_acl = "0"b;
447 REPLACE_DALL_COMMON:
448 esw = REP_DIR;
449 daemon_sw = a_daemon_sw;
450 goto start_proc;
451
452 replace_isall:
453 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_daemon_sw, a_ring, a_code);
454 initial_acl = "1"b;
455 go to REPLACE_SALL_COMMON;
456
457 replace_sall:
458 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_daemon_sw, a_code);
459
460 initial_acl = "0"b;
461 REPLACE_SALL_COMMON:
462 esw = REP_SEG;
463 daemon_sw = a_daemon_sw;
464 goto start_proc;
465
466 add_identries:
467 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_ring, a_code);
468 initial_acl = "1"b;
469 go to ADD_DENTRIES_COMMON;
470
471 add_dentries:
472 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_code);
473
474 initial_acl = "0"b;
475 ADD_DENTRIES_COMMON:
476 esw = ADD_DIR;
477 goto start_proc;
478
479 add_isentries:
480 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_ring, a_code);
481 initial_acl = "1"b;
482 go to ADD_SENTRIES_COMMON;
483
484 add_sentries:
485 entry (a_dir_name, a_entryname, a_acl_ptr, a_acl_count, a_code);
486
487 initial_acl = "0"b;
488 ADD_SENTRIES_COMMON:
489 esw = ADD_SEG;
490
491 %page;
492 start_proc:
493 caller_level = level$get ();
494 locked, locked_for_write, called_find, fatal_error_sets_faults = "0"b;
495
496 acl_ptr = a_acl_ptr;
497 acl_count = a_acl_count;
498
499 if initial_acl
500 then do;
501 ring = a_ring;
502 if ring < 0 | ring > 7
503 then call fatal_error (error_table_$argerr);
504 end;
505
506 d_s = esw < LIST_SEG;
507
508 if esw ^= REP_SEG & esw ^= REP_DIR
509 then do;
510 if acl_ptr = null
511 then call fatal_error (error_table_$null_info_ptr);
512
513 if acl_count = 0
514 then call fatal_error (error_table_$argerr);
515 end;
516
517 if acl_ptr = null
518 then acl_count = 0;
519 else do;
520 on any_other call fatal_error (error_table_$argerr);
521 call check_in_structure;
522 revert any_other;
523 end;
524
525 call check_pathname_find_read_lock_and_check_access;
526 %page;
527 acl_entry_ptr = addr (a_n);
528 if initial_acl
529 then do;
530 if d_s
531 then acl_start_ptr = addr (dir.iacl (ring).dir_frp);
532 else acl_start_ptr = addr (dir.iacl (ring).seg_frp);
533 if d_s
534 then n_acls = dir.iacl_count (ring).dir;
535 else n_acls = dir.iacl_count (ring).seg;
536 owning_structure = dir.uid;
537 end;
538 else do;
539 acl_start_ptr = addr (entry.acl_frp);
540 n_acls = entry.acle_count;
541 owning_structure = entry.uid;
542 end;
543 %page;
544 dir.modify = pds$processid;
545 if ^initial_acl
546 then do;
547 call change_dtem (ep);
548 fatal_error_sets_faults = "1"b;
549 end;
550
551
552
553 if (esw = DEL_DIR) | (esw = DEL_SEG)
554 then do;
555
556 on any_other call fatal_error (error_table_$argerr);
557 delete_acl_array (*).status_code = 0;
558 revert any_other;
559
560 do i = 1 to acl_count;
561
562 on any_other call fatal_error (error_table_$argerr);
563 temp_access_name = delete_acl_array (i).access_name;
564 revert any_other;
565
566 call acc_name_$elements (addr (temp_access_name), acl_entry_ptr, code);
567 if code ^= 0
568 then do;
569 on any_other call fatal_error (error_table_$argerr);
570 delete_acl_array (i).status_code = code;
571 revert any_other;
572 call fatal_error (error_table_$argerr);
573 end;
574
575 call acl_$del_entry (n_acls, owning_structure, acl_start_ptr, acl_entry_ptr, code);
576 if code ^= 0
577 then do;
578 if code = error_table_$user_not_found
579 then do;
580 on any_other call fatal_error (error_table_$argerr);
581 delete_acl_array (i).status_code = code;
582 revert any_other;
583 code = 0;
584 goto del_loop;
585 end;
586 else call fatal_error (code);
587 end;
588 if ^initial_acl
589 then entry.acle_count = entry.acle_count - 1;
590 else if d_s
591 then dir.iacl_count.dir (ring) = dir.iacl_count.dir (ring) - 1;
592 else dir.iacl_count.seg (ring) = dir.iacl_count.seg (ring) - 1;
593 dir.acle_total = dir.acle_total - 1;
594 del_loop:
595 end;
596
597 go to CLEAN_RETURN;
598 end;
599 %page;
600
601
602
603
604
605
606 if ^initial_acl
607 then if ((esw = REP_SEG) | (esw = ADD_SEG)) & caller_level > 1
608 & fixed (entry.ring_brackets (2), 3) < fixed (entry.ring_brackets (3), 3)
609 then do;
610 call check_gate_acl_ (acl_ptr, "0"b, acl_count, (""), code);
611 if code ^= 0
612 then call fatal_error (code);
613 if esw = ADD_SEG
614 then if entry.acl_frp ^= ""b
615 then do;
616 call check_gate_acl_ (acl_start_ptr, "1"b, (entry.acle_count), (""), code);
617 if code ^= 0
618 then call fatal_error (code);
619 end;
620 end;
621
622 if (esw = REP_DIR) | (esw = REP_SEG)
623 then do;
624 if initial_acl
625 then if d_s
626 then ael = dir.iacl_count.dir (ring);
627 else ael = dir.iacl_count.seg (ring);
628 else ael = entry.acle_count;
629 call acl_$del_acl (n_acls, owning_structure, acl_start_ptr);
630 n_acls = 0;
631 if initial_acl
632 then if d_s
633 then dir.iacl_count.dir (ring) = 0;
634 else dir.iacl_count.seg (ring) = 0;
635 else entry.acle_count = 0;
636 dir.acle_total = dir.acle_total - ael;
637 if ^daemon_sw
638 then do;
639 t_char1 = "*.SysDaemon.* ";
640 call acc_name_$elements (addr (t_char1), acl_entry_ptr, (0));
641 acl_entry_ptr -> acl1.mode = RW_ACCESS;
642
643 if d_s
644 then acl_entry_ptr -> acl1.ex_mode = SMA_ACCESS;
645 else acl_entry_ptr -> acl1.ex_mode = ""b;
646 call acl_$add_entry (n_acls, owning_structure, acl_start_ptr, acl_entry_ptr, add_sw, code);
647 if code ^= 0
648 then call fatal_error (code);
649
650 n_acls = 1;
651
652 if ^initial_acl
653 then entry.acle_count = entry.acle_count + 1;
654 else if d_s
655 then dir.iacl_count.dir (ring) = dir.iacl_count.dir (ring) + 1;
656 else dir.iacl_count.seg (ring) = dir.iacl_count.seg (ring) + 1;
657 dir.acle_total = dir.acle_total + 1;
658 end;
659 end;
660
661 do i = 1 to acl_count;
662
663 on any_other call fatal_error (error_table_$argerr);
664 if d_s
665 then do;
666 temp_access_name = directory_acl_array (i).access_name;
667 temp_mode = directory_acl_array (i).mode;
668 if substr (temp_mode, 4) ^= ""b
669 then do;
670 directory_acl_array (i).status_code = error_table_$bad_acl_mode;
671 call fatal_error (error_table_$argerr);
672 end;
673 end;
674 else do;
675 temp_access_name = segment_acl_array (i).access_name;
676 temp_mode = segment_acl_array (i).mode;
677 if substr (temp_mode, 5) ^= ""b
678 then do;
679 segment_acl_array (i).status_code = error_table_$bad_acl_mode;
680 call fatal_error (error_table_$argerr);
681 end;
682 temp_mode = temp_mode & REW_ACCESS;
683 temp_extended_mode = segment_acl_array (i).extended_mode;
684 end;
685 revert any_other;
686
687 call acc_name_$elements (addr (temp_access_name), acl_entry_ptr, code);
688 if code ^= 0
689 then do;
690 on any_other call fatal_error (error_table_$argerr);
691 if d_s
692 then do;
693 directory_acl_array (i).status_code = code;
694 go to BAD_ACLE;
695 end;
696 else do;
697 segment_acl_array (i).status_code = code;
698 BAD_ACLE:
699 revert any_other;
700 call fatal_error (error_table_$argerr);
701 end;
702 end;
703 if d_s
704 then do;
705 acl_entry_ptr -> acl1.mode = RW_ACCESS;
706 acl_entry_ptr -> acl1.ex_mode = temp_mode;
707 end;
708 else do;
709 acl_entry_ptr -> acl1.mode = temp_mode;
710 acl_entry_ptr -> acl1.ex_mode = temp_extended_mode;
711 end;
712
713 call acl_$add_entry (n_acls, owning_structure, acl_start_ptr, acl_entry_ptr, add_sw, code);
714 if code ^= 0
715 then call fatal_error (code);
716 n_acls = n_acls + 1;
717
718 if add_sw
719 then do;
720 if ^initial_acl
721 then entry.acle_count = entry.acle_count + 1;
722 else if d_s
723 then dir.iacl_count.dir (ring) = dir.iacl_count.dir (ring) + 1;
724 else dir.iacl_count.seg (ring) = dir.iacl_count.seg (ring) + 1;
725 dir.acle_total = dir.acle_total + 1;
726 end;
727
728 end;
729
730 CLEAN_RETURN:
731 if ^initial_acl
732 then call setfaults$if_active ((entry.uid), (entry.pvid), (entry.vtocx), "1"b);
733 call unlock_dir;
734 a_code = 0;
735 return;
736 %page;
737 check_pathname_find_read_lock_and_check_access:
738 procedure;
739
740 if initial_acl
741 then do;
742 dirname = a_dir_name;
743 entryname = a_entryname;
744 if dirname = ">"
745 then dirname = ">" || entryname;
746 else if entryname ^= ""
747 then dirname = rtrim (dirname) || ">" || entryname;
748
749 if dirname = ""
750 then call fatal_error (error_table_$argerr);
751
752 if esw = LIST_DIR | esw = LIST_SEG
753 then do;
754 call dc_find$dir_read (dirname, dp, code);
755 if code ^= 0
756 then go to find_error;
757 called_find, locked = "1"b;
758 end;
759 else do;
760 call dc_find$dir_write (dirname, FS_OBJ_IACL_MOD, dp, code);
761 if code ^= 0
762 then go to find_error;
763 called_find, locked = "1"b;
764 locked_for_write = "1"b;
765
766 if ring < caller_level | ring > 7
767
768 then call fatal_error (error_table_$bad_ring_brackets);
769 end;
770 end;
771 else do;
772 dirname = a_dir_name;
773 entryname = a_entryname;
774
775 if dirname = ""
776 then call fatal_error (error_table_$argerr);
777
778 if esw = LIST_DIR | esw = LIST_SEG
779 then do;
780 call dc_find$obj_status_read (dirname, entryname, 1, ep, code);
781 if code ^= 0
782 then go to find_error;
783 locked, called_find = "1"b;
784 dp = ptr (ep, 0);
785 end;
786 else do;
787 call dc_find$obj_access_write (dirname, entryname, 1, FS_OBJ_ACL_MOD, ep, code);
788 if code ^= 0
789 then
790 find_error:
791 call fatal_error (code);
792 locked, called_find = "1"b;
793 dp = ptr (ep, 0);
794 locked_for_write = "1"b;
795
796 if entry.dirsw
797 then if caller_level > bin (entry.ex_ring_brackets (1), 3)
798
799 then call fatal_error (error_table_$bad_ring_brackets);
800 else ;
801 else if caller_level > bin (entry.ring_brackets (1))
802 then call fatal_error (error_table_$bad_ring_brackets);
803 end;
804
805 if entry.dirsw
806 then do;
807 if esw > ADD_DIR
808 then call fatal_error (error_table_$dirseg);
809
810 end;
811
812 else do;
813 if esw <= ADD_DIR
814 then call fatal_error (error_table_$nondirseg);
815 end;
816 end;
817
818
819
820 end check_pathname_find_read_lock_and_check_access;
821 %page;
822 check_in_structure:
823 procedure;
824
825
826
827
828
829 declare fail_sw bit (1) aligned;
830
831 if esw = DEL_DIR | esw = DEL_SEG
832 then delete_acl_array (*).status_code = 0;
833 else if d_s
834 then directory_acl_array (*).status_code = 0;
835 else segment_acl_array (*).status_code = 0;
836
837 fail_sw = "0"b;
838 work_p = addr (a_n.ac_name);
839 do i = 1 to acl_count;
840
841 if (esw = DEL_DIR) | (esw = DEL_SEG)
842 then do;
843 call acc_name_$elements (addr (delete_acl_array (i).access_name), work_p, code);
844 if code ^= 0
845 then do;
846 delete_acl_array (i).status_code = code;
847 if code ^= error_table_$invalid_ascii
848 then fail_sw = "1"b;
849 end;
850 end;
851
852 else if d_s
853 then do;
854 if substr (directory_acl_array (i).mode, 4) ^= ""b
855 then do;
856 bad_mode:
857 directory_acl_array (i).status_code = error_table_$bad_acl_mode;
858 fail_sw = "1"b;
859 end;
860 else if substr (directory_acl_array (i).mode, 1, 2) = "01"b
861 then do;
862 directory_acl_array (i).status_code = error_table_$invalid_mode;
863 fail_sw = "1"b;
864 end;
865
866 call acc_name_$elements (addr (directory_acl_array (i).access_name), work_p, code);
867 if code ^= 0
868 then do;
869 fail_sw = "1"b;
870 directory_acl_array (i).status_code = code;
871 end;
872 end;
873
874 else do;
875 if substr (segment_acl_array (i).mode, 5) ^= ""b
876 then do;
877 segment_acl_array (i).status_code = error_table_$bad_acl_mode;
878 fail_sw = "1"b;
879 end;
880 call acc_name_$elements (addr (segment_acl_array (i).access_name), work_p, code);
881 if code ^= 0
882 then do;
883 fail_sw = "1"b;
884 segment_acl_array (i).status_code = code;
885 end;
886 end;
887 end;
888 if fail_sw
889 then do;
890 a_code = error_table_$argerr;
891 go to ERROR_RETURN;
892 end;
893 end check_in_structure;
894 %page;
895 process_specific_list:
896 procedure;
897
898
899 ael = acl_count;
900
901
902
903 on any_other call fatal_error (error_table_$argerr);
904 if d_s
905 then directory_acl_array (*).status_code = 0;
906 else segment_acl_array (*).status_code = 0;
907 revert any_other;
908
909 fail_sw = "0"b;
910
911 do i = 1 to ael;
912 offset = 0;
913
914 on any_other call fatal_error (error_table_$argerr);
915 if d_s
916 then temp_access_name = directory_acl_array (i).access_name;
917 else temp_access_name = segment_acl_array (i).access_name;
918 revert any_other;
919
920 call acc_name_$elements (addr (temp_access_name), acl_entry_ptr, code);
921 if code ^= 0
922 then do;
923 on any_other call fatal_error (error_table_$argerr);
924 if d_s
925 then directory_acl_array (i).status_code = code;
926 else segment_acl_array (i).status_code = code;
927 revert any_other;
928 fail_sw = "1"b;
929 go to list_loop;
930 end;
931
932 call acl_$list_entry (n_acls, owning_structure, acl_start_ptr, acl_entry_ptr, offset, code);
933
934 if code ^= 0
935 then if code = error_table_$empty_acl
936 then do;
937 on any_other call fatal_error (error_table_$argerr);
938 if d_s
939 then do;
940 directory_acl_array (*).status_code = error_table_$user_not_found;
941 directory_acl_array (*).mode = ""b;
942 end;
943 else do;
944 segment_acl_array (*).status_code = error_table_$user_not_found;
945 segment_acl_array (*).mode = ""b;
946 segment_acl_array (*).extended_mode = ""b;
947 end;
948 revert any_other;
949 code = 0;
950 return;
951 end;
952 else if code = error_table_$user_not_found
953 then do;
954 on any_other call fatal_error (error_table_$argerr);
955 if d_s
956 then do;
957 directory_acl_array (i).status_code = code;
958 directory_acl_array (i).mode = ""b;
959 end;
960 else do;
961 segment_acl_array (i).status_code = code;
962 segment_acl_array (i).mode = ""b;
963 segment_acl_array (i).extended_mode = ""b;
964 end;
965 revert any_other;
966 code = 0;
967 goto list_loop;
968 end;
969 else call fatal_error (code);
970
971 on any_other call fatal_error (error_table_$argerr);
972 if d_s
973 then directory_acl_array (i).mode = acl_entry_ptr -> acl1.ex_mode;
974 else do;
975 segment_acl_array (i).mode = acl_entry_ptr -> acl1.mode;
976 segment_acl_array (i).extended_mode = acl_entry_ptr -> acl1.ex_mode;
977 end;
978 revert any_other;
979 list_loop:
980 end;
981 if fail_sw
982 then call fatal_error (error_table_$argerr);
983
984 end process_specific_list;
985 %page;
986 process_list_all:
987 procedure;
988 declare saved_dir_change_pclock
989 fixed bin (35);
990
991 acl_count = n_acls;
992
993
994
995 saved_dir_change_pclock = dir.change_pclock;
996
997 call lock$dir_unlock (dp);
998 locked = "0"b;
999
1000 on any_other call fatal_error (error_table_$argerr);
1001 on area call fatal_error (error_table_$noalloc);
1002
1003 if refer_allocation
1004 then do;
1005 if d_s
1006 then do;
1007 allocate directory_acl in (arg_area);
1008 directory_acl.count = acl_count;
1009 directory_acl.version = ACL_VERSION_1;
1010 return_acl_ptr = acl_ptr;
1011 acl_ptr = addr (directory_acl.entries);
1012 end;
1013 else do;
1014 allocate segment_acl in (arg_area);
1015 segment_acl.count = acl_count;
1016 segment_acl.version = ACL_VERSION_1;
1017 return_acl_ptr = acl_ptr;
1018 acl_ptr = addr (segment_acl.entries);
1019 end;
1020 end;
1021 else do;
1022 if d_s
1023 then allocate directory_acl_array in (arg_area);
1024 else allocate segment_acl_array in (arg_area);
1025 return_acl_ptr = acl_ptr;
1026 end;
1027
1028 revert any_other, area;
1029
1030
1031
1032
1033 on seg_fault_error signal bad_dir_;
1034 call lock$dir_lock_read (dp, code);
1035 if code ^= 0
1036 then call fatal_error (code);
1037 locked = "1"b;
1038 revert seg_fault_error;
1039
1040 if dir.change_pclock ^= saved_dir_change_pclock
1041 then do;
1042 call unlock_dir;
1043 go to Retry_process_list_all;
1044 end;
1045
1046 acl_entry_ptr = addr (a_n);
1047
1048 do i = 1 to acl_count;
1049 offset = i;
1050
1051 call acl_$list_entry (acl_count, owning_structure, acl_start_ptr, acl_entry_ptr, offset, code);
1052 if code = error_table_$argerr
1053 then
1054 signal bad_dir_;
1055
1056 else if code ^= 0
1057 then call fatal_error (code);
1058
1059 t_char1 = acl_entry_ptr -> acl1.ac_name.person;
1060 t_char2 = acl_entry_ptr -> acl1.ac_name.project;
1061 tag = acl_entry_ptr -> acl1.ac_name.tag;
1062
1063 on any_other call fatal_error (error_table_$argerr);
1064
1065 (nostringsize):
1066 begin;
1067 if d_s
1068 then do;
1069 directory_acl_array (i).status_code = 0;
1070 directory_acl_array (i).access_name =
1071 rtrim (t_char1) || "." || rtrim (t_char2) || "." || tag;
1072 directory_acl_array (i).mode = acl_entry_ptr -> acl1.ex_mode;
1073 directory_acl_array (i).status_code = 0;
1074 end;
1075 else do;
1076 segment_acl_array (i).status_code = 0;
1077 segment_acl_array (i).access_name = rtrim (t_char1) || "." || rtrim (t_char2) || "." || tag;
1078 segment_acl_array (i).mode = acl_entry_ptr -> acl1.mode;
1079 segment_acl_array (i).extended_mode = acl_entry_ptr -> acl1.ex_mode;
1080 end;
1081 end ;
1082 revert any_other;
1083 end;
1084
1085 end process_list_all;
1086 %page;
1087 cleanup_:
1088 procedure;
1089
1090
1091
1092
1093
1094 if esw = LIST_DIR | esw = LIST_SEG
1095 then do;
1096 if ^structure_supplied & acl_ptr ^= null
1097 then if refer_allocation
1098 then if d_s
1099 then free directory_acl;
1100 else free segment_acl;
1101 else if d_s
1102 then free directory_acl_array;
1103 else free segment_acl_array;
1104 end;
1105 if called_find
1106 then call dc_find$finished (dp, "0"b);
1107
1108 end cleanup_;
1109
1110 unlock_dir:
1111 procedure;
1112
1113 if locked_for_write
1114 then do;
1115 call sum$dirmod (dp);
1116 dir.modify = ""b;
1117 end;
1118 if called_find
1119 then call dc_find$finished (dp, locked);
1120 else if locked
1121 then call lock$dir_unlock (dp);
1122 locked, called_find = "0"b;
1123 end unlock_dir;
1124
1125
1126 fatal_error:
1127 procedure (cc);
1128 declare cc fixed bin (35);
1129
1130 a_code = cc;
1131 if fatal_error_sets_faults
1132 then do;
1133 call setfaults$if_active ((entry.uid), (entry.pvid), (entry.vtocx), "1"b);
1134 fatal_error_sets_faults = ""b;
1135 end;
1136 call unlock_dir;
1137 call cleanup_;
1138 go to ERROR_RETURN;
1139 end fatal_error;
1140 ERROR_RETURN:
1141 return;
1142 %page;
1143 %include access_mode_values;
1144 %page;
1145 %include acl_structures;
1146 %page;
1147 %include dc_find_dcls;
1148 %page;
1149 %include dir_entry;
1150 %page;
1151 %include dir_header;
1152 %page;
1153 %include fs_obj_access_codes;
1154 end asd_;