1
2
3
4
5
6
7
8
9
10
11
12
13
14 acl: 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
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 %page;
80
81
82
83 dcl a_aclct fixed bin parameter;
84 dcl a_aclp ptr parameter;
85 dcl a_code fixed bin (35) parameter;
86 dcl a_dirname char (*) parameter;
87 dcl a_ename char (*) parameter;
88 dcl a_mode fixed bin (5) parameter;
89 dcl a_name char (*) parameter;
90 dcl a_rb (3) fixed bin (6) parameter;
91 dcl a_uap ptr parameter;
92
93
94
95 dcl add fixed bin static options (constant) init (0);
96 dcl add_one fixed bin static options (constant) init (1);
97 dcl delete fixed bin static options (constant) init (3);
98 dcl list fixed bin static options (constant) init (4);
99 dcl replace fixed bin static options (constant) init (2);
100
101
102
103 dcl 1 acl (100) aligned like temp_acl;
104 dcl access_id char (32) varying;
105 dcl acl_start_ptr ptr;
106 dcl aclp ptr;
107 dcl add_sw bit (1);
108 dcl all bit (1) aligned;
109 dcl count fixed bin;
110 dcl cnt fixed bin;
111 dcl code fixed bin (35);
112 dcl dirname char (168);
113 dcl dirsw bit (1) aligned;
114 dcl dummy char (32) aligned;
115 dcl entryname char (32);
116 dcl fail_sw bit (1) aligned;
117 dcl function fixed bin;
118 dcl gate bit (1) aligned;
119 dcl i fixed bin;
120 dcl in_aclp ptr;
121 dcl j fixed bin;
122 dcl name char (32) aligned;
123 dcl offset fixed bin;
124 dcl p ptr;
125 dcl ring (3) bit (3) aligned;
126 dcl ringno fixed bin;
127 dcl uap ptr;
128
129
130
131 dcl error_table_$argerr fixed bin (35) ext;
132 dcl error_table_$bad_ring_brackets fixed bin (35) ext;
133 dcl error_table_$invalid_mode fixed bin (35) ext;
134 dcl error_table_$invalid_project_for_gate fixed bin (35) ext;
135 dcl error_table_$noalloc fixed bin (35) ext;
136 dcl error_table_$obsolete_function fixed bin (35) ext;
137 dcl 1 pds$access_name aligned ext,
138 2 person char (32),
139 2 project char (32),
140 2 tag (1);
141 dcl pds$processid bit (36) aligned ext;
142
143
144
145 dcl 1 acla (100) aligned based (aclp) like input_acl;
146 dcl 1 input_acl aligned based,
147 2 userid char (32) aligned,
148 2 mode bit (5) unaligned,
149 2 reterr bit (13) unaligned,
150 2 (rb1, rb2, rb3) bit (6) unaligned;
151 dcl 1 temp_acl aligned based,
152 2 person char (32) aligned,
153 2 project char (32) aligned,
154 2 tag char (1) aligned,
155 2 mode bit (36) aligned,
156 2 ex_mode bit (36) aligned,
157 2 status fixed bin (35),
158 2 (rb1, rb2, rb3) fixed bin;
159 dcl 1 x aligned based,
160 2 person char (32) aligned,
161 2 project char (32) aligned,
162 2 tag char (1) aligned,
163 2 mode bit (36) aligned,
164 2 ex_mode bit (36) aligned,
165 2 status fixed bin (35),
166 2 rb (3) fixed bin;
167
168
169
170 dcl acc_list_$match entry (fixed bin, bit (36) aligned, ptr, ptr, ptr, fixed bin, fixed bin (35));
171 dcl acc_name_$elements entry (ptr, ptr, fixed bin (35));
172 dcl acl_$add_entry entry (fixed bin, bit (36) aligned, ptr, ptr, bit (1), fixed bin (35));
173 dcl acl_$del_acl entry (fixed bin, bit (36) aligned, ptr);
174 dcl acl_$del_entry entry (fixed bin, bit (36) aligned, ptr, ptr, fixed bin (35));
175 dcl acl_$list_entry entry (fixed bin, bit (36) aligned, ptr, ptr, fixed bin, fixed bin (35));
176 dcl alloc_ entry (fixed bin, ptr, ptr);
177 dcl change_dtem entry (ptr);
178 dcl check_gate_acl_ entry (ptr, bit (1) aligned, fixed bin, char (32) aligned, fixed bin (35));
179 dcl freen_ entry (ptr);
180 dcl level$get entry (fixed bin);
181 dcl setfaults$if_active entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (1) aligned);
182 dcl sum$dirmod entry (ptr);
183
184
185
186 dcl (area, bad_dir_) condition;
187
188 dcl (addr, bin, bit, fixed, null, ptr, rtrim, size, substr) builtin;
189 %page;
190 aadd: entry (a_dirname, a_ename, a_aclp, a_aclct, a_code);
191
192 function = add;
193
194 call setup;
195
196 if cnt = 0 then go to ret;
197 call check_count;
198
199 call clear_code;
200
201 call fill_in_temp;
202
203 add_common:
204 call get_entry_ptr;
205
206 if dirsw then call check_modes;
207
208 else do;
209
210 call get_rb;
211 call check_rb;
212
213 if gate then do;
214
215 call check_gate_acl_ (acl_start_ptr, "1"b, (ep -> entry.acle_count), dummy, code);
216 if code ^= 0 then go to unlock;
217
218 end;
219
220 end;
221
222 call change_acl;
223
224 call add_to_acl;
225
226
227 call update_and_unlock;
228
229 go to finale;
230 %page;
231 a1add: entry (a_dirname, a_ename, a_name, a_mode, a_rb, a_code);
232
233 function = add_one;
234
235 call setup;
236
237 p = addr (acl (1));
238 cnt = 1;
239
240 name = a_name;
241
242 if name = "" then do;
243
244 p -> temp_acl.person = pds$access_name.person;
245 p -> temp_acl.project = pds$access_name.project;
246 p -> temp_acl.tag = "*";
247
248 end;
249
250 else do;
251
252 call acc_name_$elements (addr (name), p, p -> temp_acl.status);
253 if p -> temp_acl.status ^= 0 then go to finale;
254
255 end;
256
257 p -> temp_acl.mode = bit (fixed (a_mode, 4), 4);
258 p -> temp_acl.ex_mode = "0"b;
259
260 p -> temp_acl.status = 0;
261
262 p -> x.rb = a_rb;
263
264 go to add_common;
265 %page;
266 areplace: entry (a_dirname, a_ename, a_aclp, a_aclct, a_code);
267
268 function = replace;
269
270 call setup;
271
272 if cnt = 0 then go to remove_acl;
273 call check_count;
274
275 call clear_code;
276
277 call fill_in_temp;
278
279 call get_entry_ptr;
280
281 if dirsw then call check_modes;
282
283 else do;
284 p = addr (acl (cnt));
285 ring (1) = bit (fixed (p -> temp_acl.rb1, 3), 3);
286 ring (2) = bit (fixed (p -> temp_acl.rb2, 3), 3);
287 ring (3) = bit (fixed (p -> temp_acl.rb3, 3), 3);
288 call check_rb;
289
290 end;
291
292 call change_acl;
293
294 call delete_acl;
295
296 call add_to_acl;
297
298 if ^dirsw then ep -> entry.ring_brackets = ring;
299
300
301 call update_and_unlock;
302
303 go to finale;
304 %page;
305 adelete: entry (a_dirname, a_ename, a_aclp, a_aclct, a_code);
306
307 function = delete;
308
309 call setup;
310
311 if cnt ^= -1 then do;
312
313 if cnt = 0 then go to ret;
314 call check_count;
315 call clear_code;
316 call get_names;
317
318 end;
319
320 else do;
321
322 remove_acl:
323 all = "1"b;
324 aclp = null;
325
326 end;
327
328 call get_entry_ptr;
329
330 call change_acl;
331
332 if all then call delete_acl;
333
334 else call delete_from_acl;
335
336
337 call update_and_unlock;
338
339 go to finale;
340 %page;
341 alist: entry (a_dirname, a_ename, a_aclp, a_aclct, a_uap, a_code);
342
343 function = list;
344
345 call setup;
346
347 uap = a_uap;
348
349 if uap = null then do;
350
351 cnt = a_aclct;
352 if cnt = 0 then go to ret;
353
354 aclp = a_aclp;
355
356 call check_count;
357 call clear_code;
358 call get_names;
359
360 end;
361
362 else do;
363
364 all = "1"b;
365 aclp = null;
366 cnt = -1;
367
368 end;
369
370 call get_entry_ptr;
371
372 if all then call list_acl;
373
374 else call list_acl_entries;
375
376 call get_rb;
377
378 call dc_find$finished (dp, "1"b);
379
380 if all then on area go to alloc_err;
381
382 call copy_acl;
383
384 go to finale;
385 %page;
386
387
388 alloc_err:
389 if aclp ^= null then call freen_ (aclp);
390 a_aclp = null;
391 a_aclct = 0;
392 code = error_table_$noalloc;
393 go to ret;
394
395 arg_err:
396 code = error_table_$argerr;
397 go to ret;
398
399 bracket_error:
400 code = error_table_$bad_ring_brackets;
401 go to unlock;
402
403 unlock:
404 dir.modify = "0"b;
405 call dc_find$finished (dp, "1"b);
406
407 finale:
408 if function = add_one then do;
409 if code = 0 then code = p -> temp_acl.status;
410 end;
411
412 else if cnt > 0 then do i = 1 to cnt;
413
414 p = addr (acl (i));
415 if p -> temp_acl.status ^= 0 then do;
416 aclp -> acla (i).reterr = bit (fixed (p -> temp_acl.status, 13), 13);
417
418
419 if code = 0 then code = p -> temp_acl.status;
420
421 end;
422
423 end;
424 ret:
425 a_code = code;
426 return;
427 %page;
428 setup:
429 proc;
430
431 code = 0;
432
433 dirname = a_dirname;
434
435 entryname = a_ename;
436
437
438 if function ^= list & function ^= add_one then do;
439
440 aclp = a_aclp;
441 cnt = a_aclct;
442
443 end;
444
445 all,
446 fail_sw,
447 gate = "0"b;
448
449 call level$get (ringno);
450
451 end setup;
452 %page;
453 check_count:
454 proc;
455
456 if cnt < 0 then go to arg_err;
457 if cnt > 100 then go to arg_err;
458 if aclp = null then go to arg_err;
459
460 end check_count;
461 %page;
462 clear_code:
463 proc;
464
465 do i = 1 to cnt;
466
467 in_aclp = addr (aclp -> acla (i));
468 in_aclp -> input_acl.reterr = "0"b;
469
470 end;
471
472 end clear_code;
473 %page;
474 get_entry_ptr:
475 proc;
476
477 if entryname = "" then do;
478 code = error_table_$obsolete_function;
479 go to finale;
480 end;
481
482
483
484 if function = list then call dc_find$obj_status_read (dirname, entryname, 1, ep, code);
485 else call dc_find$obj_access_write (dirname, entryname, 1, FS_OBJ_ACL_RING_MOD, ep, code);
486
487 dp = ptr (ep, 0);
488
489 if code ^= 0 then go to ret;
490
491 dirsw = ep -> entry.dirsw;
492
493 acl_start_ptr = addr (ep -> entry.acl_frp);
494
495
496
497 if function ^= list then
498 if dirsw then do;
499
500 if ringno > bin (ep -> entry.ex_ring_brackets (1), 3) then go to bracket_error;
501 end;
502
503 else do;
504
505 if ringno > bin (ep -> entry.ring_brackets (1), 3) then go to bracket_error;
506 end;
507
508 end get_entry_ptr;
509 %page;
510 get_names:
511 proc;
512
513 do i = 1 to cnt;
514
515 p = addr (acl (i));
516 in_aclp = addr (aclp -> acla (i));
517
518 call acc_name_$elements (in_aclp, p, p -> temp_acl.status);
519
520 end;
521
522 end get_names;
523 %page;
524 update_and_unlock:
525 proc;
526
527 call setfaults$if_active ((ep -> entry.uid), (ep -> entry.pvid), (ep -> entry.vtocx), "1"b);
528
529 dir.modify = "0"b;
530 call sum$dirmod (dp);
531
532 call dc_find$finished (dp, "1"b);
533
534 end update_and_unlock;
535 %page;
536 change_acl:
537
538 proc;
539
540 dir.modify = pds$processid;
541
542 call change_dtem (ep);
543
544 end change_acl;
545 %page;
546 fill_in_temp:
547 proc;
548
549 do i = 1 to cnt;
550
551 p = addr (acl (i));
552 in_aclp = addr (aclp -> acla (i));
553
554 call acc_name_$elements (in_aclp, p, p -> temp_acl.status);
555
556
557 p -> temp_acl.mode = substr (in_aclp -> input_acl.mode, 2);
558 p -> temp_acl.ex_mode = "0"b;
559
560
561 p -> temp_acl.rb1 = fixed (in_aclp -> input_acl.rb1, 6);
562 p -> temp_acl.rb2 = fixed (in_aclp -> input_acl.rb2, 6);
563 p -> temp_acl.rb3 = fixed (in_aclp -> input_acl.rb3, 6);
564
565 end;
566
567 end fill_in_temp;
568 %page;
569 delete_acl:
570 proc;
571
572 call acl_$del_acl ((entry.acle_count), entry.uid, acl_start_ptr);
573
574
575 dp -> dir.acle_total = dp -> dir.acle_total - ep -> entry.acle_count;
576 ep -> entry.acle_count = 0;
577 end delete_acl;
578 %page;
579 list_acl: proc;
580
581 do i = 1 to 100;
582
583 p = addr (acl (i));
584
585 call acl_$list_entry ((entry.acle_count), entry.uid, acl_start_ptr, p, i, p -> temp_acl.status);
586
587 if p -> temp_acl.status ^= 0 then
588 if p -> temp_acl.status = error_table_$argerr then do;
589
590
591 cnt = i - 1;
592 count = ep -> entry.acle_count;
593
594
595 if count ^= cnt then signal bad_dir_;
596 return;
597
598 end;
599
600 end;
601
602 cnt = 100;
603 code = error_table_$argerr;
604
605 end list_acl;
606 %page;
607 add_to_acl:
608 proc;
609
610 count = 0;
611
612 do i = 1 to cnt;
613
614 p = addr (acl (i));
615 if p -> temp_acl.status = 0 then do;
616
617
618 call acl_$add_entry ((entry.acle_count), entry.uid, acl_start_ptr,
619 p, add_sw, p -> temp_acl.status);
620
621 if add_sw then do;
622 ep -> entry.acle_count = ep -> entry.acle_count + 1;
623 dp -> dir.acle_total = dp -> dir.acle_total + 1;
624 end;
625
626 end;
627
628 end;
629
630 end add_to_acl;
631 %page;
632 delete_from_acl:
633 proc;
634
635 count = 0;
636
637 do i = 1 to cnt;
638
639 p = addr (acl (i));
640 if p -> temp_acl.status = 0 then do;
641
642
643 call acl_$del_entry ((entry.acle_count), entry.uid, acl_start_ptr, p, p -> temp_acl.status);
644
645 if p -> temp_acl.status = 0 then count = count + 1;
646
647 end;
648
649 end;
650
651 if count > 0 then do;
652
653 ep -> entry.acle_count = ep -> entry.acle_count - count;
654 dp -> dir.acle_total = dp -> dir.acle_total - count;
655
656 end;
657
658 end delete_from_acl;
659 %page;
660 list_acl_entries:
661 proc;
662
663 do i = 1 to cnt;
664
665 p = addr (acl (i));
666 if p -> temp_acl.status = 0 then do;
667
668
669 call acc_list_$match ((entry.acle_count), entry.uid, acl_start_ptr,
670 p, aclep, offset, p -> temp_acl.status);
671
672 if p -> temp_acl.status = 0 then do;
673
674
675 p -> temp_acl.mode = aclep -> acl_entry.mode;
676 p -> temp_acl.ex_mode = aclep -> acl_entry.mode;
677
678 end;
679
680 end;
681
682 end;
683
684 end list_acl_entries;
685 %page;
686 get_rb: proc;
687
688 if dirsw then do;
689
690 ring (1) = ep -> entry.ex_ring_brackets (1);
691 ring (2),
692 ring (3) = ep -> entry.ex_ring_brackets (2);
693
694 end;
695
696 else do;
697
698 ring (1) = ep -> entry.ring_brackets (1);
699 ring (2) = ep -> entry.ring_brackets (2);
700 ring (3) = ep -> entry.ring_brackets (3);
701
702 end;
703
704 end get_rb;
705 %page;
706 check_modes:
707 proc;
708
709 do i = 1 to cnt;
710
711 p = addr (acl (i));
712
713
714 p -> temp_acl.ex_mode = substr (p -> temp_acl.mode, 1, 1) || substr (p -> temp_acl.mode, 3, 2);
715
716 p -> temp_acl.mode = RW_ACCESS;
717
718
719 if (p -> temp_acl.ex_mode & "11"b) = "01"b then do;
720
721 p -> temp_acl.status = error_table_$invalid_mode;
722 if function = add_one then go to unlock;
723
724 end;
725
726 end;
727
728 end check_modes;
729 %page;
730 check_rb:
731 proc;
732
733 if ringno > 1 then
734 if ring (2) ^= ring (3) then
735 gate = "1"b;
736
737 do i = 1 to cnt;
738
739 p = addr (acl (i));
740
741 p -> temp_acl.mode = p -> temp_acl.mode & "1110"b;
742
743
744 if p -> temp_acl.rb1 > 7 then go to input_rb_error;
745 if p -> temp_acl.rb1 < 0 then go to input_rb_error;
746 if p -> temp_acl.rb2 > 7 then go to input_rb_error;
747 if p -> temp_acl.rb2 < 0 then go to input_rb_error;
748 if p -> temp_acl.rb3 > 7 then go to input_rb_error;
749 if p -> temp_acl.rb3 < 0 then go to input_rb_error;
750
751
752 if ringno > p -> temp_acl.rb1 then go to input_rb_error;
753 if p -> temp_acl.rb1 > p -> temp_acl.rb2 then go to input_rb_error;
754 if p -> temp_acl.rb2 > p -> temp_acl.rb3 then do;
755 input_rb_error: p -> temp_acl.status = error_table_$bad_ring_brackets;
756 fail_sw = "1"b;
757 go to skip_rb_check;
758 end;
759
760 if gate then
761
762 if p -> temp_acl.project ^= pds$access_name.project then
763 if p -> temp_acl.project ^= "SysDaemon" then do;
764 p -> temp_acl.status = error_table_$invalid_project_for_gate;
765 fail_sw = "1"b;
766 go to skip_rb_check;
767 end;
768
769 do j = 1 to 3;
770
771
772
773 if p -> x.rb (j) ^= fixed (ring (j), 3) then go to input_rb_error;
774
775 end;
776 skip_rb_check:
777 end;
778
779 if fail_sw then go to unlock;
780
781 end check_rb;
782 %page;
783 copy_acl:
784 proc;
785
786 if all then do;
787
788
789 call alloc_ (size (input_acl) * cnt, uap, aclp);
790 if aclp = null then go to alloc_err;
791 a_aclp = aclp;
792 a_aclct = cnt;
793
794 end;
795
796 do i = 1 to cnt;
797
798 p = addr (acl (i));
799
800
801 if p -> temp_acl.status = 0 then do;
802
803 in_aclp = addr (aclp -> acla (i));
804
805
806 access_id = rtrim (p -> temp_acl.person);
807 access_id = access_id || ".";
808 access_id = access_id || rtrim (p -> temp_acl.project);
809 access_id = access_id || ".";
810 access_id = access_id || p -> temp_acl.tag;
811 in_aclp -> input_acl.userid = access_id;
812
813
814 if dirsw then in_aclp -> input_acl.mode =
815 "0"b || substr (p -> temp_acl.ex_mode, 1, 1) || "1"b || substr (p -> temp_acl.ex_mode, 2, 2);
816
817
818 else in_aclp -> input_acl.mode = "0"b || substr (p -> temp_acl.mode, 1, 4);
819
820
821 in_aclp -> input_acl.rb1 = (3)"0"b || ring (1);
822 in_aclp -> input_acl.rb2 = (3)"0"b || ring (2);
823 in_aclp -> input_acl.rb3 = (3)"0"b || ring (3);
824
825 in_aclp -> input_acl.reterr = "0"b;
826
827 end;
828
829 end;
830
831 end copy_acl;
832
833
834 %page; %include access_mode_values;
835 %page; %include dc_find_dcls;
836 %page; %include dir_acl;
837 %page; %include dir_entry;
838 %page; %include dir_header;
839 %page; %include fs_obj_access_codes;
840 end acl;