1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style4 */
 14 acl: proc;
 15 
 16 /* This is the acl write around for the directory change of 1972. */
 17 
 18 
 19 /****^  HISTORY COMMENTS:
 20   1) change(73-01-21,Kobziar), approve(), audit(), install():
 21       Remove append from segments and obsolete CACLs.
 22   2) change(73-02-01,EStone), approve(), audit(), install():
 23       Rewritten in v2pl1 for performance improvements.
 24   3) change(74-10-01,EStone), approve(), audit(), install():
 25       Place uid and dtem in double word.
 26   4) change(75-04-25,Greenberg), approve(), audit(), install():
 27       Modified by BSG for NSS and no perm acls.
 28   5) change(76-06-01,RBratt), approve(), audit(), install():
 29       Modified to call find_$finished.
 30   6) change(76-06-01,VanVleck), approve(), audit(), install():
 31       Modified by THVV for no perm acls.
 32   7) change(77-07-01,VanVleck), approve(), audit(), install():
 33       Modified for bad_dir_ check.
 34   8) change(83-08-01,Kittlitz), approve(), audit(), install():
 35       Modified by E. N. Kittlitz for setfault$if_active pvid, vtocx args.
 36   9) change(84-06-01,Loepere), approve(), audit(), install():
 37       Modified by Keith Loepere for the new dc_find.
 38  10) change(84-10-01,Loepere), approve(), audit(), install():
 39       Modified for auditing operation as access change.
 40  11) change(86-06-03,Lippard), approve(86-09-04,MCR7534),
 41      audit(86-09-11,Dickson), install(86-09-16,MR12.0-1159):
 42       Modified by Jim Lippard to make dir modes RW rather than null.
 43                                                    END HISTORY COMMENTS */
 44 
 45 
 46 /* Strategy used is to move input structure into an automatic structure acl(100) and call the new single acl
 47    primitives , thus avoiding seg faults while dir locked */
 48 
 49 /* The entries to this routine are
 50    name        entry switch
 51    $aadd            1
 52    $a1add           1
 53    $areplace        2
 54    $adelete         3
 55    $alist           4
 56 
 57    Up to 100 entries are handeled and the arguments for all but alist and a1add are
 58    1)   a_dirname character(*)          a directory path name. (Input)
 59    2)   a_ename character(*)  an entry name for this acl; was null for now obselete cacl. (Input)
 60    3)   a_aclp pointer        a pointer to an array of data to be entered or returned. (Input)
 61    4)   a_aclct fixed bin (17)          a count of the number of entries in the array. (Output/alist Input/others)
 62    5)   a_code fixed bin (17) an error code. (Output)
 63 
 64    For $alist the argument a_uap is a pointer to a user area where the output will beallocated.
 65 
 66    For $a1add the first two arguments are as above and the rest are
 67    1)   a_name character(*)   name to be added to the ACL. (Input)
 68    2)   a_mode fixed bin (5)  the mode. (Input)
 69    3)   a_rb fixed bin (6)     the ring brackets. (Input)
 70 
 71    This routine will do as much as it can, processing good entries in the data array
 72    and returning an error code in acla(i).reterr for the bad entries
 73    as well as an error code in a_code.
 74 
 75 
 76    If a_aclct = -1 for $adelete or if a_uap is non-null for $alist then the whole
 77    ACL list (up to 100 entries) will be listed or deleted as requested.
 78    The target ACL for replace is deleted before the new entries are made. */
 79 %page;
 80 
 81 /* Parameters */
 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 /* Constants */
 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 /* Variables */
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 /* External */
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 /* Based */
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 /* Entries */
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 /* Misc */
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;                                   /* indicate which type of acl manipulation */
193 
194           call setup;                                       /* copy input arguments and initialize flags */
195 
196           if cnt = 0 then go to ret;                        /* if number of acl entries to be added is zero, return */
197           call check_count;                                 /* validate count and aclp */
198 
199           call clear_code;                                  /* clear return 13 bit error code */
200 
201           call fill_in_temp;                                /* convert input structure to intermediate structure */
202 
203 add_common:
204           call get_entry_ptr;                               /* get pointer to entry */
205 
206           if dirsw then call check_modes;                   /* check validity of directory modes for dir acl  */
207 
208           else do;                                          /* for segment acl */
209 
210                call get_rb;                                 /* get ring brackets of segment */
211                call check_rb;                               /* perform check on input ring bracket array */
212 
213                if gate then do;                             /* if adding ACL to a gate, cannot add new project */
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;         /* cannot perform ACL addition */
217 
218                end;
219 
220           end;
221 
222           call change_acl;                                  /* set modify switch and update dtm */
223 
224           call add_to_acl;                                  /* add acl list */
225 
226 /* indicate to segment control that dir modified */
227           call update_and_unlock;                           /* and unlock the directory */
228 
229           go to finale;
230 %page;
231 a1add: entry (a_dirname, a_ename, a_name, a_mode, a_rb, a_code); /* add one only */
232 
233           function = add_one;                               /* indicate which type of acl manipulation */
234 
235           call setup;
236 
237           p = addr (acl (1));                               /* convert input to intermediate strucutre */
238           cnt = 1;                                          /* adding one acl */
239 
240           name = a_name;                                    /* copy userid */
241 
242           if name = "" then do;                             /* set userid to current user with tag = "*" */
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;                                          /* break up userid into 3 part access name */
251 
252                call acc_name_$elements (addr (name), p, p -> temp_acl.status);
253                if p -> temp_acl.status ^= 0 then go to finale; /* if illegal name, stop right now */
254 
255           end;
256 
257           p -> temp_acl.mode = bit (fixed (a_mode, 4), 4);  /* copy mode, strip off trap bit */
258           p -> temp_acl.ex_mode = "0"b;                     /* clear extended mode */
259 
260           p -> temp_acl.status = 0;                         /* clear error code */
261 
262           p -> x.rb = a_rb;                                 /* copy ring brackets */
263 
264           go to add_common;                                 /* transfer to acl adding code */
265 %page;
266 areplace: entry (a_dirname, a_ename, a_aclp, a_aclct, a_code);
267 
268           function = replace;                               /* indicate what type of acl manipulation */
269 
270           call setup;                                       /* copy input arguments and initialize flags */
271 
272           if cnt = 0 then go to remove_acl;                 /* if no ACLs to replace current ACL, delete present ACL */
273           call check_count;                                 /* validate count and aclp */
274 
275           call clear_code;                                  /* clear return 13 bit error code */
276 
277           call fill_in_temp;                                /* convert input structure to intermediate structure */
278 
279           call get_entry_ptr;                               /* get pointer to entry and lock parent directory */
280 
281           if dirsw then call check_modes;                   /* if replacing a dir acl check validity of dir modes */
282 
283           else do;                                          /* for segment acl */
284                p = addr (acl (cnt));
285                ring (1) = bit (fixed (p -> temp_acl.rb1, 3), 3); /* get ring brackets from intermediate structure */
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;                               /* perform check on input ring bracket array */
289 
290           end;
291 
292           call change_acl;                                  /* set modify switch and update dtm */
293 
294           call delete_acl;                                  /* delete entire acl */
295 
296           call add_to_acl;                                  /* add ACL list */
297 
298           if ^dirsw then ep -> entry.ring_brackets = ring;  /* change ring brackets of segment ACL */
299 
300 /* indicate to segment control that dir modified */
301           call update_and_unlock;                           /* and unlock the directory */
302 
303           go to finale;
304 %page;
305 adelete: entry (a_dirname, a_ename, a_aclp, a_aclct, a_code);
306 
307           function = delete;                                /* indicate what type of acl manipulation we are doing */
308 
309           call setup;                                       /* copy input arguments and initialize flags */
310 
311           if cnt ^= -1 then do;                             /* given a list of acl entries to delete */
312 
313                if cnt = 0 then go to ret;                   /* done if none to delete */
314                call check_count;                            /* validate count and aclp */
315                call clear_code;                             /* clear return 13 bit error code */
316                call get_names;                              /* parse input userids */
317 
318           end;
319 
320           else do;                                          /* delete entire acl */
321 
322 remove_acl:
323                all = "1"b;                                  /* set flag */
324                aclp = null;
325 
326           end;
327 
328           call get_entry_ptr;                               /* get ptr to entry and lock directory */
329 
330           call change_acl;                                  /* set modify switch and update dtm */
331 
332           if all then call delete_acl;                      /* delete whole acl */
333 
334           else call delete_from_acl;                        /* or delete selected acl entries */
335 
336 /* indicate to segment control that dir modified */
337           call update_and_unlock;                           /* and unlock the directory */
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;                                  /* indicate what type of acl manipulation */
344 
345           call setup;                                       /* copy input arguments and initialize flags */
346 
347           uap = a_uap;                                      /* copy pointer to user's area */
348 
349           if uap = null then do;                            /* if user provided no area, then list selected acl entries */
350 
351                cnt = a_aclct;                               /* copy number of acl entries to be listed */
352                if cnt = 0 then go to ret;                   /* if number of acl entries is zero, return */
353 
354                aclp = a_aclp;                               /* copy pointer to input structure */
355 
356                call check_count;                            /* validate count and aclp */
357                call clear_code;                             /* clear return 13 bit error code */
358                call get_names;                              /* parse input userids */
359 
360           end;
361 
362           else do;                                          /* list entire acl */
363 
364                all = "1"b;                                  /* set flag */
365                aclp = null;
366                cnt = -1;
367 
368           end;
369 
370           call get_entry_ptr;                               /* get entry ptr and lock directory */
371 
372           if all then call list_acl;                        /* list entire acl */
373 
374           else call list_acl_entries;                       /* list certain acl entries */
375 
376           call get_rb;                                      /* get ring brackets of segment */
377 
378           call dc_find$finished (dp, "1"b);                 /* unlock and unuse */
379 
380           if all then on area go to alloc_err;              /* enable area condition outside internal procedure */
381                                                             /* so that it will share external procedure's stack frame */
382           call copy_acl;                                    /* copy from intermediate structure to user area */
383 
384           go to finale;
385 %page;
386 /* error and other miscellanous returns */
387 
388 alloc_err:                                                  /* user did not provide enough room when listing entire ACL */
389           if aclp ^= null then call freen_ (aclp);          /* free what was allocated */
390           a_aclp = null;                                    /* return null pointer to allocation, acl count = 0 and status code */
391           a_aclct = 0;
392           code = error_table_$noalloc;
393           go to ret;                                        /* copy main status code - already unlocked directory */
394 
395 arg_err:                                                    /* global problem with input arguments */
396           code = error_table_$argerr;
397           go to ret;                                        /* copy main status code - not yet locked directory */
398 
399 bracket_error:                                              /* rb of segment/directory not within write bracket */
400           code = error_table_$bad_ring_brackets;
401           go to unlock;                                     /* unlock directory - reflect individual errors */
402 
403 unlock:                                                     /* unlock the directory on error */
404           dir.modify = "0"b;
405           call dc_find$finished (dp, "1"b);                 /* unlock and unuse */
406 
407 finale:
408           if function = add_one then do;                    /* if entered via a1add, skip processing individual codes */
409                if code = 0 then code = p -> temp_acl.status;
410           end;
411 
412           else if cnt > 0 then do i = 1 to cnt;             /* reflect individual code to user's structure */
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 /* if main status code is non-zero, reflect it up */
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:                                                      /* copy arguments - set initial values for flags */
429      proc;
430 
431           code = 0;                                         /* clear status code */
432 
433           dirname = a_dirname;                              /* copy directory name */
434 
435           entryname = a_ename;                              /* copy entry name */
436                                                             /* perform requested function */
437 
438           if function ^= list & function ^= add_one then do;/* if input args */
439 
440                aclp = a_aclp;                               /* copy pointer to input structure */
441                cnt = a_aclct;                               /* copy count of entries in input structure */
442 
443           end;
444 
445           all,                                              /* clear various flags */
446                fail_sw,
447                gate = "0"b;
448 
449           call level$get (ringno);                          /* get validation level */
450 
451      end setup;
452 %page;
453 check_count:                                                /* check input arguments - count of acl entries */
454      proc;                                                  /* and pointer to input structure */
455 
456           if cnt < 0 then go to arg_err;                    /* count must be non-negative */
457           if cnt > 100 then go to arg_err;                  /* limit of 100 in this primitive */
458           if aclp = null then go to arg_err;                /* trouble if pointer is null */
459 
460      end check_count;
461 %page;
462 clear_code:                                                 /* clear error codes in user structure before doing anything */
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:                                              /* procedure called when manipulating acls - get pointer to entry */
475      proc;                                                  /* lock dir - copy items from entry - define items for lower level primitives */
476 
477           if entryname = "" then do;                        /* trying to get obsolete cacl */
478                code = error_table_$obsolete_function;
479                go to finale;
480           end;
481 
482 /* get pointer to entry and lock parent */
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);                                 /* get directory pointer before checking status code */
488 
489           if code ^= 0 then go to ret;                      /* non-zero codes do not lock the directory */
490 
491           dirsw = ep -> entry.dirsw;                        /* copy directory flag */
492 
493           acl_start_ptr = addr (ep -> entry.acl_frp);       /* lower level acl primitives want to know where acl starts */
494 
495 /* check that validation level is <= write bracket of segment */
496 
497           if function ^= list then
498                if dirsw then do;
499                                                             /* if a directory look at extended ring brackets */
500                     if ringno > bin (ep -> entry.ex_ring_brackets (1), 3) then go to bracket_error;
501                end;
502 
503                else do;
504                                                             /* if a segment look at actual ring bracket */
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:                                                  /* break input userids into 3 part access names */
511      proc;                                                  /* and store in intermediate storage */
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:                                          /* reflect change to ACL */
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);                             /* turn on file modified switch of the directory */
531 
532           call dc_find$finished (dp, "1"b);                 /* unlock and unuse */
533 
534      end update_and_unlock;
535 %page;
536 change_acl:                                                 /* set dtem if user not transparent */
537                                                             /* set dtbm in kste */
538      proc;                                                  /* turn on modify switch in directory */
539 
540           dir.modify = pds$processid;
541 
542           call change_dtem (ep);
543 
544      end change_acl;
545 %page;
546 fill_in_temp:                                               /* fill in intermediate structure before locking directory */
547      proc;                                                  /* essentially copying arguments */
548 
549           do i = 1 to cnt;
550 
551                p = addr (acl (i));
552                in_aclp = addr (aclp -> acla (i));
553                                                             /* store userid as 3 part access name */
554                call acc_name_$elements (in_aclp, p, p -> temp_acl.status);
555 
556 /* copy input mode as is + strip off old trap bit */
557                p -> temp_acl.mode = substr (in_aclp -> input_acl.mode, 2);
558                p -> temp_acl.ex_mode = "0"b;                /* clear extended mode */
559 
560 /* copy input ring brackets */
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:                                                 /* procedure to delete entire ACL */
570      proc;
571                                                             /* call lower level procedure to do work */
572           call acl_$del_acl ((entry.acle_count), entry.uid, acl_start_ptr);
573 
574 /* update counts */
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;                                             /* list entire ACL */
580 
581           do i = 1 to 100;
582 
583                p = addr (acl (i));
584                                                             /* get the i th ACL */
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                                                             /* have reached the end of the ACL list */
590 
591                          cnt = i - 1;                       /* store the number of entries in the list */
592                          count = ep -> entry.acle_count;
593 
594 /* check the validity of the entry ACL count count */
595                          if count ^= cnt then signal bad_dir_;
596                          return;
597 
598                     end;
599 
600           end;
601 
602           cnt = 100;                                        /* there are more than 100 entries in list */
603           code = error_table_$argerr;                       /* return first 100 entries + status code */
604 
605      end list_acl;
606 %page;
607 add_to_acl:                                                 /* add entries to ACL */
608      proc;
609 
610           count = 0;                                        /* zero count of new ACL entries */
611 
612           do i = 1 to cnt;
613 
614                p = addr (acl (i));
615                if p -> temp_acl.status = 0 then do;         /* skip over items which previously produced errors */
616 
617 /* add one entry to ACL */
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;                      /* if atually added, update counts */
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:                                            /* remove selected ACL entries */
633      proc;
634 
635           count = 0;                                        /* zero count of entries deleted */
636 
637           do i = 1 to cnt;
638 
639                p = addr (acl (i));
640                if p -> temp_acl.status = 0 then do;         /* ignore requests with previous errors */
641 
642 /* delete the ACL entry */
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                                                             /* increment count of deletions if successful */
647                end;
648 
649           end;
650 
651           if count > 0 then do;                             /* if any deletions took place, update counts */
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:                                           /* list selected 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;         /* if no previous error, */
667 
668 /* find ACL entry in list */
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;    /* if input access name on list */
673 
674 /* copy mode + extended mode into intermediate store */
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;                                               /* obtain ring brackets from branch */
687 
688           if dirsw then do;                                 /* directory ACL */
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;                                          /* segment ACL */
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:                                                /* perform check on input directory modes for ACLs */
707      proc;                                                  /* map old REWA modes to new SMA modes - setup intermediate structure modes */
708 
709           do i = 1 to cnt;
710 
711                p = addr (acl (i));
712 
713 /* convert REWA mode to new SMA directory modes */
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;              /* rw mode for directory ACLs */
717 
718 /* do not allow specification of M without S */
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;/* stop for add1 entry */
723 
724                end;
725 
726           end;
727 
728      end check_modes;
729 %page;
730 check_rb:                                                   /* check input ring brackets of segments for legality + consistency */
731      proc;                                                  /* check projects of gate segments */
732 
733           if ringno > 1 then                                /* perform special checks if creating a gate segment by ACL replacement */
734                if ring (2) ^= ring (3) then                 /* or if adding ACL entries to a gate segment */
735                     gate = "1"b;                            /* from rings greater than the administrative ring */
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; /* strip off old append bit for segment ACLs */
742 
743 /* ring must be less than 8 and non-negative */
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 /* ring brackets must be internally consistent */
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;                         /* abort after checking remainder of input ACLs */
757                     go to skip_rb_check;                    /* and skip remainder of checking */
758                end;
759 
760                if gate then                                 /* if manipulating a gate segment */
761                                                             /* check that user is adding/replacing his project or service project */
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;               /* stop after checking rest of input */
766                               go to skip_rb_check;
767                          end;
768 
769                do j = 1 to 3;                               /* if no errors thus far */
770 
771 /* check input rb against rb of existing segment (adding) */
772 /* or check all input rb against rb of last input rb (replacing) */
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;                     /* if serious error, abort */
780 
781      end check_rb;
782 %page;
783 copy_acl:                                                   /* format ACL for entry points which list */
784      proc;                                                  /* and copy from temporary storage into user's area */
785 
786           if all then do;                                   /* if listing entire ACL */
787 
788 /* allocate in area provided by user */
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));                          /* get ptr to intermediate entry */
799 
800 /* omit requests which generated errors */
801                if p -> temp_acl.status = 0 then do;
802 
803                     in_aclp = addr (aclp -> acla (i));      /* get ptr to output entry */
804 
805 /* construct userid - use varying character string for efficiency */
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 /* format directory mode - convert from SMA to REWA */
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 /* return segment ACL modes - add old trap and append bits */
818                     else in_aclp -> input_acl.mode = "0"b || substr (p -> temp_acl.mode, 1, 4);
819 
820 /* return ring brackets */
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;     /* clear code */
826 
827                end;
828 
829           end;
830 
831      end copy_acl;
832 
833 /* format: off */
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;