1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* Initial coding by Kobziar July 74 */
 14 /* Modified 750523 by LJS to add protection auditing */
 15 /* Modified June 1, 1976 by R. Bratt to call find_$finished */
 16 /* Modified Nov 30 76 by B. Greenberg for setting dtem */
 17 /* Modified September 1981 by J. Bongiovanni for better error codes */
 18 /* Modified March 1983 by E. N. Kittlitz to not set dtem back */
 19 /* Modified August 1983 by E. N. Kittlitz for setfaults$if_active pvid, vtocx args */
 20 /* Modified 83-10-10 by E. N. Kittlitz to fix locking problems */
 21 /* Modified 83-12-07 by E. N. Kittlitz to audit setting node oos */
 22 /* Modified July 1984 by Keith Loepere to use the new dc_find.  Also to flush
 23    PAM on dir reclassify. */
 24 /* Modified November 1984 by Keith Loepere for access_audit_ and for PAM using
 25    uid's. */
 26 /* Modified 84-12-05 by EJ Sharpe to actually use access_audit_ (also new sys_seg_priv entry) */
 27 /* Modified 85-04-01 by Keith Loepere for access_audit_check_ep_. */
 28 
 29 /* format: style4 */
 30 reclassify: proc;
 31 
 32 /* Parameters */
 33 
 34 dcl  a_access_class bit (72) aligned;
 35 dcl  a_code fixed bin (35);
 36 dcl  a_dirname char (*);
 37 dcl  a_ename char (*);
 38 
 39 /* Variables */
 40 
 41 dcl  access_class bit (72) aligned;
 42 dcl  branch_name char (32);
 43 dcl  branchp ptr;
 44 dcl  code fixed bin (35);
 45 dcl  dep ptr;
 46 dcl  dep_locked bit (1) aligned;
 47 dcl  dirname char (168);
 48 dcl  dirpath char (168);
 49 dcl  ename char (32);
 50 dcl  ep_locked bit (1) aligned;
 51 dcl  1 event_flags aligned like audit_event_flags;
 52 dcl  has_zero_quota bit (1);
 53 dcl  1 local_vtoce like vtoce aligned;
 54 dcl  oosw_err bit (1) aligned;
 55 dcl  parent_access_class bit (72) aligned;
 56 dcl  pvtx fixed bin (17);
 57 dcl  1 qcell like quota_cell aligned;
 58 dcl  quota_err bit (1) aligned;
 59 dcl  relp bit (18);
 60 dcl  set_soos bit (1) aligned;
 61 dcl  targp ptr;
 62 dcl  targp_locked bit (1) aligned;
 63 dcl  whoami char (24) aligned;
 64 
 65 /* Entries */
 66 
 67 dcl  access_audit_check_ep_$self entry (bit (36) aligned, bit (36) aligned, ptr) returns (bit (1));
 68 dcl  access_audit_$log_entry_ptr entry options (variable);
 69 dcl  access_audit_$log_obj_class entry options (variable);
 70 dcl  aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
 71 dcl  aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
 72 dcl  aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
 73 dcl  change_dtem entry (ptr);
 74 dcl  display_access_class_ entry (bit (72) aligned) returns (char (32) aligned);
 75 dcl  get_pvtx entry (bit (36) unaligned, fixed bin (35)) returns (fixed bin (17));
 76 dcl  level$get entry () returns (fixed bin);
 77 dcl  lock$dir_unlock entry (ptr);
 78 dcl  lock$lock_ast entry;
 79 dcl  lock$unlock_ast entry;
 80 dcl  logical_volume_manager$lvtep entry (bit (36) aligned, ptr, fixed bin (35));
 81 dcl  pathname_am$flush entry (bit (36) aligned);
 82 dcl  setfaults$if_active entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (1) aligned);
 83 dcl  sum$dirmod entry (ptr);
 84 dcl  sum$getbranch entry (ptr, bit (36) aligned, ptr, fixed bin (35));
 85 dcl  syserr$error_code entry options (variable);
 86 dcl  vtoc_attributes$get_quota entry (bit (36) aligned, bit (36) aligned, fixed bin (17), ptr, fixed bin, fixed bin (35));
 87 dcl  vtoc_man$get_vtoce entry (bit (36) aligned, fixed bin (17), fixed bin (17), bit (3) aligned, ptr, fixed bin (35));
 88 dcl  vtoc_man$put_vtoce entry (bit (36) aligned, fixed bin (17), fixed bin (17), bit (3) aligned, ptr, fixed bin (35));
 89 
 90 /* External */
 91 
 92 dcl  access_operations_$fs_obj_reclassify bit (36) aligned ext static;
 93 dcl  access_operations_$fs_obj_set_soos bit (36) aligned ext static;
 94 dcl  error_table_$action_not_performed fixed bin (35) ext static;
 95 dcl  error_table_$ai_out_range fixed bin (35) ext static;
 96 dcl  error_table_$ai_parent_greater fixed bin (35) ext static;
 97 dcl  error_table_$ai_son_less fixed bin (35) ext static;
 98 dcl  error_table_$argerr fixed bin (35) ext static;
 99 dcl  error_table_$bad_ring_brackets fixed bin (35) ext static;
100 dcl  error_table_$dirseg fixed bin (35) ext static;
101 dcl  error_table_$no_terminal_quota fixed bin (35) ext static;
102 dcl  error_table_$nondirseg fixed bin (35) ext static;
103 dcl  error_table_$not_a_branch fixed bin (35) ext static;
104 dcl  error_table_$rqover fixed bin (35) ext static;
105 dcl  error_table_$soos_set fixed bin (35) ext static;
106 dcl  error_table_$vtoce_connection_fail fixed bin (35) ext static;
107 dcl  pds$processid bit (36) aligned ext;
108 dcl  sys_info$access_class_ceiling bit (72) aligned ext static;
109 
110 /* Misc */
111 
112 dcl  (addr, fixed, null, ptr, rtrim, string) builtin;
113 %page;
114 /* change branch's access_class to value of parent, called through system_privilege_ gate */
115 
116 branch: entry (a_dirname, a_ename, a_access_class, a_code);
117 
118           whoami = "reclassify$branch";
119           call setup;                                       /* process args and get ptrs */
120           if ep -> entry.dirsw then do;
121                code = error_table_$dirseg;
122                go to unlock_all;
123           end;
124           dir.modify = pds$processid;
125           call set_access_class (ep, parent_access_class, dirname, ename); /* Set the access class */
126           if code = 0 then                                  /* Force ring 1 multiclass bit off */
127                call set_r1mc (ep -> entry.multiple_class, "0"b, dirname, ename);
128           go to finish_seg;
129 %page;
130 /* change seg to be multi class, called through system_privilege_ gate */
131 
132 sys_seg_priv: entry (a_dirname, a_ename, a_access_class, a_code);
133 
134           whoami = "reclassify$sys_seg_priv";
135           goto sys_seg_join;
136 
137 
138 /* change seg to be multi class, called through admin_gate_ from ring 1 */
139 
140 sys_seg: entry (a_dirname, a_ename, a_access_class, a_code);
141 
142           whoami = "reclassify$sys_seg";
143 sys_seg_join:
144           call setup;
145           if ^aim_check_$greater (access_class, parent_access_class) then do; /* must be higher */
146                code = error_table_$action_not_performed;
147                go to unlock_all;
148           end;
149           if ep -> entry.dirsw then do;
150                code = error_table_$dirseg;
151                go to unlock_all;
152           end;
153           if ep -> entry.ring_brackets (3) ^= "001"b then do; /* must be ring 1 */
154                code = error_table_$bad_ring_brackets;
155                go to unlock_all;
156           end;
157           dir.modify = pds$processid;
158           call set_access_class (ep, access_class, dirname, ename); /* Set the access class */
159           if code = 0 then                                  /* Force ring 1 multiclass bit on */
160                call set_r1mc (ep -> entry.multiple_class, "1"b, dirname, ename);
161 finish_seg:
162           call setfaults$if_active ((ep -> entry.uid),      /* be conservative, call even if code ^= 0 */
163                (ep -> entry.pvid), (ep -> entry.vtocx), "1"b);
164           dir.modify = "0"b;
165           if code = 0 then
166                call sum$dirmod (dp);                        /* reflect modification up for backup to find */
167                                                             /* note: we don't soos parent if this failed */
168           call dc_find$finished (dp, "1"b);                 /* unlock and unuse */
169           go to ret;
170 %page;
171 /* change access class of directory and contents */
172 
173 node: entry (a_dirname, a_ename, a_access_class, a_code);
174 
175           whoami = "reclassify$node";
176           call setup;
177           if ^ep -> entry.dirsw then do;
178                code = error_table_$nondirseg;
179                go to unlock_all;
180           end;
181 
182           call vtoc_attributes$get_quota (ep -> entry.uid, (ep -> entry.pvid), (ep -> entry.vtocx),
183                addr (qcell), 0, code);
184           if code ^= 0 then go to unlock_all;
185           has_zero_quota = ^qcell.terminal_quota_sw;
186 
187           call lock$dir_unlock (dp);                        /* all done with dp for now (will re-get via sum when done with node) */
188                                                             /* see if dir will be upgraded */
189           ep_locked = "0"b;
190 
191           if aim_check_$greater (access_class, parent_access_class) then
192                if has_zero_quota then do;                   /* refuse to do operation */
193                     code = error_table_$no_terminal_quota;
194                     go to unlock_all;
195                end;
196                else ;                                       /* ok upgraded dir */
197           else if ^aim_check_$equal (access_class, parent_access_class) then do; /* don't accept lower than parent */
198                code = error_table_$action_not_performed;
199                go to unlock_all;
200           end;
201 %page;
202 /* now reset access class and check multi class bit */
203 /* must go to completion in the following loop for a consistent directory */
204 
205           targp -> dir.modify = pds$processid;
206           relp = targp -> dir.entryfrp;
207           do while (relp ^= "0"b);                          /* reset access_class if necessary */
208                branchp = ptr (targp, relp);
209                branch_name = ptr (targp, branchp -> entry.name_frp) -> names.name;
210                if ^branchp -> entry.dirsw then if branchp -> entry.bs then do; /* a segment */
211                          if aim_check_$greater (branchp -> entry.access_class, access_class) then
212                               if branchp -> entry.multiple_class then go to fine;
213                                                             /* all other segments get access class reset (or corrected) */
214                          call set_access_class (branchp, access_class, dirpath, branch_name);
215                          call set_r1mc (branchp -> entry.multiple_class, "0"b, dirpath, branch_name);
216                          call setfaults$if_active ((branchp -> entry.uid), (branchp -> entry.pvid),
217                               (branchp -> entry.vtocx), "1"b);
218                     end;
219                                                             /* now for directories */
220                if branchp -> entry.dirsw then if aim_check_$equal (branchp -> entry.access_class, access_class)
221                     then call set_r1mc (branchp -> entry.multiple_class, "0"b, dirpath, branch_name);
222                     else if aim_check_$greater (branchp -> entry.access_class, access_class)
223                     then call set_r1mc (branchp -> entry.multiple_class, "1"b, dirpath, branch_name);
224                     else do;                                /* this directory doesn't fit */
225                          if ^branchp -> entry.security_oosw then do;
226                               if access_audit_check_ep_$self (string (event_flags), access_operations_$fs_obj_set_soos, branchp) then
227                                    call access_audit_$log_entry_ptr (whoami, level$get (), string (event_flags),
228                                    access_operations_$fs_obj_set_soos, branchp, error_table_$ai_parent_greater, null (), 0,
229                                    "Parent class: ^a", display_access_class_ (access_class));
230                          end;
231                          branchp -> entry.security_oosw = "1"b;
232                          oosw_err = "1"b;
233                     end;
234 fine:
235                relp = branchp -> entry.efrp;
236           end;
237 
238           if set_soos then go to finish_node;
239           targp -> dir.access_class = access_class;
240 %page;
241 /* now check all upgraded directories for quota */
242 /* this loop seperate from above since locking failure not critical */
243 
244           relp = targp -> dir.entryfrp;
245           do while (relp ^= "0"b);
246                branchp = ptr (targp, relp);
247                if branchp -> entry.dirsw then
248                     if aim_check_$greater (branchp -> entry.access_class, access_class) then do;
249                          call vtoc_attributes$get_quota (branchp -> entry.uid, (branchp -> entry.pvid),
250                               (branchp -> entry.vtocx), addr (qcell), 0, code);
251                          if code ^= 0 then go to q_err;
252                          if ^qcell.terminal_quota_sw then do;
253 q_err:                        if ^branchp -> entry.security_oosw then
254                                    if access_audit_check_ep_$self (string (event_flags), access_operations_$fs_obj_set_soos, branchp) then
255                                         call access_audit_$log_entry_ptr (whoami, level$get (), string (event_flags),
256                                         access_operations_$fs_obj_set_soos, branchp, error_table_$no_terminal_quota,
257                                         null (), 0);
258                               branchp -> entry.security_oosw = "1"b;
259                               quota_err = "1"b;
260                          end;
261                     end;
262                relp = branchp -> entry.efrp;
263           end;
264 %page;
265 /* fix branch in parent */
266 
267 finish_node:
268           call sum$getbranch (targp, "1"b, ep, code);       /* get ep again (could change via on-line salvage) */
269           if code ^= 0 then do;                             /* stop the world, I want to get off */
270                call syserr$error_code (CRASH, code, "reclassify: err locking parent");
271                go to unlock_all;                            /* just in case we come back... */
272           end;
273           ep_locked = "1"b;
274           dp = ptr (ep, 0);                                 /* reaffirm dp */
275           dir.modify = pds$processid;
276           if set_soos then do;
277                if access_audit_check_ep_$self (string (event_flags), access_operations_$fs_obj_set_soos, ep) then
278                     call access_audit_$log_entry_ptr (whoami, level$get (), string (event_flags),
279                     access_operations_$fs_obj_set_soos, ep, error_table_$ai_son_less, null (), 0);
280                entry.security_oosw = "1"b;                  /* zap main dir */
281           end;
282           call set_access_class (ep, access_class, dirname, ename);
283           if code = 0 then
284                call set_r1mc (ep -> entry.multiple_class, aim_check_$greater (access_class, parent_access_class), dirname, ename); /* Set multi-class bit */
285           if code = 0 then if quota_err then code = error_table_$rqover;
286                else if oosw_err | set_soos then code = error_table_$soos_set; /* signal oosw problem */
287           targp -> dir.modify = "0"b;
288           call sum$dirmod (targp);
289           call pathname_am$flush (ep -> entry.uid);
290           dir.modify = "0"b;
291           call sum$dirmod (dp);
292           call lock$dir_unlock (dp);
293           call dc_find$finished (targp, "1"b);              /* unlock and unuse */
294 
295 ret:
296           a_code = code;
297           return;
298 
299 unlock_all:
300                                                             /* we come here only if the operation is denied due
301                                                                to some aim restriction or improper operation */
302           event_flags.grant = "0"b;
303           call access_audit_$log_obj_class (whoami, level$get (), string (event_flags),
304                access_operations_$fs_obj_reclassify, access_class, target (dirname, ename), code, null (), 0);
305 
306           if targp_locked then do;                          /* dirs held by targp */
307                if dep_locked then
308                     call lock$dir_unlock (ptr (dep, 0));
309                if ep_locked then do;
310                     dp -> dir.modify = "0"b;
311                     call lock$dir_unlock (ptr (ep, 0));
312                end;
313                targp -> dir.modify = "0"b;
314                call dc_find$finished (targp, "1"b);
315           end;
316           else do;
317                if dep_locked then call lock$dir_unlock (ptr (dep, 0));
318                dir.modify = "0"b;
319                call dc_find$finished (dp, "1"b);            /* unlock and unuse */
320           end;
321           go to ret;
322 %page;
323 /* get entry and check access */
324 
325 setup: proc;
326 
327 dcl  lvid bit (36) aligned;
328 
329           string (event_flags) = ""b;
330           event_flags.special_op = "1"b;
331           event_flags.grant = "1"b;                         /* for now */
332 
333           if whoami ^= "reclassify$sys_seg"                 /* this one's refed through admin_gate_ */
334           then event_flags.priv_op = "1"b;
335 
336           pvt_arrayp = addr (pvt$array);
337           dep_locked, ep_locked, oosw_err, quota_err, set_soos, targp_locked = "0"b;
338           access_class = a_access_class;                    /* copy args */
339           if aim_check_$greater_or_equal (sys_info$access_class_ceiling, access_class) then code = 0;
340           else do;                                          /* check arg */
341                code = error_table_$argerr;
342                go to ret;
343           end;
344           dirname = a_dirname;
345           ename = a_ename;
346 
347 /* the calls to dc_find below may generate an audit message
348    thus, it's OK to simply return without additional auditing
349    if either fails. */
350           if whoami = "reclassify$node" then do;
351                if dirname = ">" then dirpath = ">" || ename;/* now check out the directory */
352                else dirpath = rtrim (dirname) || ">" || ename;
353                call dc_find$dir_reclassify (dirpath, dep, ep, targp, code);
354                if code ^= 0 then go to ret;
355                targp_locked = "1"b;
356           end;
357           else do;
358                call dc_find$obj_reclassify (dirname, ename, dep, ep, code);
359                if code ^= 0 then go to ret;
360           end;
361           ep_locked = "1"b;
362           dp = ptr (ep, 0);
363           if dep ^= null then dep_locked = "1"b;
364 
365           if ^ep -> entry.bs then do;                       /* this is a link */
366                code = error_table_$not_a_branch;
367                go to unlock_all;
368           end;
369           if whoami = "reclassify$node" then lvid = entry.sons_lvid; /* check AIM for volume */
370           else do;
371                pvtx = get_pvtx (entry.pvid, code);
372                if code ^= 0 then go to unlock_all;
373                lvid = pvt_array (pvtx).lvid;
374           end;
375           call logical_volume_manager$lvtep (lvid, lvtep, code); /* check lv mounted, AIM range */
376           if code ^= 0 then go to unlock_all;               /* oh well */
377           if ^aim_check_$greater_or_equal (access_class, lvte.access_class.min) |
378                ^aim_check_$greater_or_equal (lvte.access_class.max, access_class) then do;
379                code = error_table_$ai_out_range;
380                go to unlock_all;
381           end;
382           if dep_locked then do;
383                parent_access_class = dep -> entry.access_class;
384                call lock$dir_unlock (ptr (dep, 0));
385                dep_locked = "0"b;                           /* remember not to do this again when finishing */
386           end;
387           else parent_access_class = "0"b;
388 
389      end setup;
390 
391 
392 %page;
393 set_access_class: proc (set_ep, to_this, dirname, ename);
394 
395 dcl  dirname char (168) parameter;
396 dcl  ename char (32) parameter;
397 dcl  set_ep ptr parameter;
398 dcl  to_this bit (72) aligned parameter;
399 
400 dcl  pvid bit (36);
401 dcl  uid bit (36) aligned;
402 dcl  vtocx fixed bin (17);
403 
404 
405 
406 /* reclassify$(branch sys_seg sys_seg_priv) call this to
407    set the new access class of the segment in its entry and
408    vtoce.  reclassify$node calls this once for each segment
409    in the dir being reclassified, and finally once for the
410    directory itself.  "set_soos" is set if the operation
411    failed so reclassify$node will set security-out-of-service
412    on the containing dir that is being reclassified. */
413 
414           if access_audit_check_ep_$self (string (event_flags), access_operations_$fs_obj_reclassify, set_ep) then
415                call access_audit_$log_entry_ptr (whoami, level$get (), string (event_flags),
416                access_operations_$fs_obj_reclassify, set_ep, 0, null (), 0, "New class: ^a",
417                display_access_class_ (to_this));
418 
419           pvid = set_ep -> entry.pvid;                      /* do vtoce first */
420           uid = set_ep -> entry.uid;
421           vtocx = set_ep -> entry.vtocx;                    /* copy args before ASTlocking */
422           call lock$lock_ast;
423           pvtx = get_pvtx (pvid, code);
424           if code ^= 0 then go to bust;
425           call vtoc_man$get_vtoce ((pvid), pvtx, vtocx, "101"b, addr (local_vtoce), code);
426                                                             /* read activation + part 3 */
427           if code ^= 0 then go to bust;
428           if local_vtoce.uid ^= uid then do;
429                code = error_table_$vtoce_connection_fail;
430                go to bust;
431           end;
432           addr (local_vtoce) -> vtoce.access_class = to_this;
433           call vtoc_man$put_vtoce ((pvid), pvtx, vtocx, "001"b, addr (local_vtoce), code);
434                                                             /* but only write part 3 */
435 
436 bust:     call lock$unlock_ast;
437           if code = 0 then do;
438                set_ep -> entry.access_class = to_this;
439                call change_dtem (set_ep);                   /* Cause access recomputation */
440           end;
441           else set_soos = "1"b;
442           return;
443      end set_access_class;
444 %page;
445 
446 set_r1mc: proc (set_this, to_this, dirname, ename);
447 
448 dcl  dirname char (168) parameter;
449 dcl  ename char (32) parameter;
450 dcl  set_this bit (1) parameter;
451 dcl  to_this bit (1) parameter;
452 
453 dcl  type (0:1) char (12) aligned static options (constant) init ("single-class", "upgraded");
454 
455           if set_this ^= to_this
456           then do;
457                                                             /* we'll already have logged with entry data by reclassifying,
458                                                                so here we'll just log a text message, no binary */
459                call access_audit_$log_obj_class (whoami, level$get (), string (event_flags),
460                     access_operations_$fs_obj_reclassify, access_class, target (dirname, ename),
461                     0, null (), 0, "Changed to ^a", type (fixed (to_this, 1)));
462           end;
463 
464           set_this = to_this;
465 
466           return;
467      end set_r1mc;
468 %page;
469 target: proc (dir, ent) returns (char (*));
470 
471 dcl  dir char (*) parameter;
472 dcl  ent char (*) parameter;
473 
474           if dir = ">"
475           then return (">" || ent);
476           else return (rtrim (dir) || ">" || ent);
477 
478      end target;
479 
480 /* format: off */
481 %page; %include access_audit_eventflags;
482 %page; %include dc_find_dcls;
483 %page; %include dir_entry;
484 %page; %include dir_header;
485 %page; %include dir_name;
486 %page; %include lvt;
487 %page; %include pvte;
488 %page; %include quota_cell;
489 %page; %include vtoce;
490 %page; %include syserr_constants;
491 %page;
492 /* format: on */
493 
494 /* BEGIN MESSAGE DOCUMENTATION
495 
496    Message:
497    reclassify: err locking parent. ERROR_CODE
498 
499    S:     $crash
500 
501    T:     $run
502 
503    M:     $err
504    $crashes
505 
506    A:     $recover
507 
508 
509    Message:
510    AUDIT (reclassify$ENTRY): GRANTED modification of security out-of-service ADDED_INFO
511 
512    S:     $access_audit
513 
514    T:     $run
515 
516    M:     An AIM error was found in respect to the specified directory.
517    There was a disagreement in access class between the directory
518    and one of it's sons, or there was an upgraded directory with
519    non-terminal quota.
520 
521    A:     $ignore
522 
523 
524    Message:
525    AUDIT (reclassify$ENTRY): GRANTED|DENIED modification of fs_obj access class ADDED_INFO
526 
527    S:     $access_audit
528 
529    T:     $run
530 
531    M:     Indicates whether an attempt to reclassify the specified file
532    system object was granted or denied.  In the case of
533    reclassify$node, a message will be generated for each
534    entry in the directory being reclassified.
535 
536    A:     $ignore
537 
538 
539    END MESSAGE DOCUMENTATION */
540 
541      end reclassify;