1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) BULL HN Information Systems Inc., 1990   *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Bull Inc., 1987                *
   6         *                                                         *
   7         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   8         *                                                         *
   9         *********************************************************** */
  10 
  11 
  12 
  13 /****^  HISTORY COMMENTS:
  14   1) change(85-05-31,EJSharpe), approve(86-02-20,MCR7301),
  15      audit(86-04-07,Swenson), install(86-04-23,MR12.0-1044):
  16      fix bug where get_link_target would not update dir argument
  17   2) change(90-09-28,Schroth), approve(90-09-28,MCR8205),
  18      audit(90-10-04,WAAnderson), install(90-10-14,MR12.4-1042):
  19      Corrected dir_salvage entry to lock parent of dir to salvage after locking
  20      the dir itself.  This is in keeping with the documented protocol and
  21      corrects a potential dir locking deadly embrace.
  22                                                    END HISTORY COMMENTS */
  23 
  24 
  25 /* The master module within directory control that finds directories or
  26 directory entries, checks access, audits successful accesses and attempted
  27 access violations and produces correct user visible error codes.
  28 
  29 Produced out of what once was find_, find_entry, find_dirsegno,
  30 dir_control_error and parts of uid_path_util by Keith Loepere, June 1984.
  31 
  32 Modified throughout 1984 by Keith Loepere for successful access auditing,
  33 centralization of access decisions, etc.
  34 Modified 84-11-27 by EJ Sharpe to change access_audit_ arg list
  35 Modified 85-01-07 by Keith Loepere for obj_for_audit.
  36 Modified 85-02-19 by Keith Loepere so that append through links returns the
  37    target path.
  38 Modified 85-02-25 by Keith Loepere to bring back existence entrypoint.
  39 Modified 85-04-01 by Keith Loepere for new access_audit_check_ep_ and fix
  40      to truncating MSFs.
  41 Modified 85-04-08 by Keith Loepere to use fs_modes whenever possible,
  42      which has the advantage of understanding priv init objects.
  43 Modified 85-05-08 by EJ Sharpe to add obj_delete_uid (non-privileged) and to
  44      make uid path searches obey AIM rules for making dir names known
  45 Modified 85-05-15 by EJ Sharpe to change dir_write_raw_uid to mdir_set_quota_uid
  46 */
  47 
  48 /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */
  49 
  50 dc_find: proc;
  51           return;
  52 
  53 /* External */
  54 
  55 dcl  active_all_rings_data$maxlinks     fixed bin ext;
  56 dcl  dseg$                              (0:4095) fixed bin (71) ext static;
  57 dcl  error_table_$bad_uidpath           fixed bin (35) ext;
  58 dcl  error_table_$badpath               fixed bin (35) ext;
  59 dcl  error_table_$dirseg                fixed bin (35) ext;
  60 dcl  error_table_$entlong               fixed bin (35) ext;
  61 dcl  error_table_$incorrect_access      fixed bin (35) ext;
  62 dcl  error_table_$link                  fixed bin (35) ext;
  63 dcl  error_table_$moderr                fixed bin (35) ext;
  64 dcl  error_table_$mylock                fixed bin (35) ext;
  65 dcl  error_table_$no_dir                fixed bin (35) ext;
  66 dcl  error_table_$no_info               fixed bin (35) ext;
  67 dcl  error_table_$no_s_permission       fixed bin (35) ext;
  68 dcl  error_table_$namedup               fixed bin (35) ext;
  69 dcl  error_table_$noentry               fixed bin (35) ext;
  70 dcl  error_table_$not_link              fixed bin (35) ext;
  71 dcl  error_table_$notadir               fixed bin (35) ext;
  72 dcl  error_table_$oosw                  fixed bin (35) ext;
  73 dcl  error_table_$root                  fixed bin (35) ext;
  74 dcl  error_table_$seg_deleted           fixed bin (35) ext;
  75 dcl  error_table_$segknown              fixed bin (35) ext;
  76 dcl  error_table_$toomanylinks          fixed bin (35) ext;
  77 dcl  pds$access_authorization           bit (72) aligned ext;
  78 
  79 /* Entries */
  80 
  81 dcl  access_audit_check_ep_$self        entry (bit (36) aligned, bit (36) aligned, ptr) returns (bit (1));
  82 dcl  access_audit_check_ep_$user        entry (bit (36) aligned, bit (36) aligned, ptr, bit (72) aligned, bit (36) aligned) returns (bit (1));
  83 dcl  access_audit_$log_entry_ptr        entry (char (*), fixed bin, bit (36) aligned, bit (36) aligned, ptr, fixed bin (35), ptr, fixed bin (18), char (*));
  84 dcl  access_audit_$log_entry_ptr_user   entry (char (*), fixed bin, bit (36) aligned, bit (36) aligned, ptr, fixed bin (35), ptr, fixed bin (18), ptr, char (*));
  85 dcl  access_mode$effective              entry (ptr, bit (36) aligned, bit (36) aligned, fixed bin (35));
  86 dcl  access_mode$raw                    entry (ptr, bit (36) aligned, bit (36) aligned, fixed bin (35));
  87 dcl  access_mode$user_effmode           entry (ptr, char (32) aligned, bit (72) aligned, fixed bin (3), bit (36) aligned, bit (36) aligned, fixed bin (35));
  88 dcl  aim_check_$greater_or_equal        entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
  89 dcl  fs_modes$locked                    entry (ptr, bit (36) aligned, bit (36) aligned, (3) fixed bin (3), fixed bin (35));
  90 dcl  get_kstep                          entry (fixed bin, ptr, fixed bin (35));
  91 dcl  hash$search                        entry (ptr, ptr, ptr, fixed bin (35));
  92 dcl  level$get                          entry () returns (fixed bin);
  93 dcl  lock$dir_lock_read                 entry (ptr, fixed bin (35));
  94 dcl  lock$dir_lock_salvage              entry (ptr, bit (36) aligned, fixed bin (35));
  95 dcl  lock$dir_lock_write                entry (ptr, fixed bin (35));
  96 dcl  lock$dir_unlock                    entry (ptr);
  97 dcl  makeknown_                         entry (ptr, fixed bin (17), fixed bin (17), fixed bin (35));
  98 dcl  mlr_                               entry (ptr, fixed bin (21), ptr, fixed bin (21));
  99 dcl  mrl_                               entry (ptr, fixed bin (21), ptr, fixed bin (21));
 100 dcl  pathname_am$get_segno              entry (char (*) varying, fixed bin (17));
 101 dcl  pathname_am$set                    entry (char (*) varying, fixed bin (17));
 102 dcl  read_allowed_                      entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
 103 dcl  sdw_util_$construct                entry (ptr, ptr);
 104 dcl  sdw_util_$dissect                  entry (ptr, ptr);
 105 dcl  segno_usage$decrement              entry (fixed bin (17), fixed bin (35));
 106 dcl  sum$getbranch                      entry (ptr, bit (36) aligned, ptr, fixed bin (35));
 107 dcl  sum$getbranch_root_my              entry (ptr, bit (36) aligned, ptr, fixed bin (35));
 108 dcl  update_kste_access                 entry (ptr, ptr, bit (36) aligned);
 109 dcl  wired_utility_$grow_stack_frame    entry (fixed bin) returns (ptr);
 110 
 111 /* Misc */
 112 
 113 dcl  addcharno                          builtin;
 114 dcl  addr                               builtin;
 115 dcl  baseptr                            builtin;
 116 dcl  binary                             builtin;
 117 dcl  index                              builtin;
 118 dcl  length                             builtin;
 119 dcl  max                                builtin;
 120 dcl  min                                builtin;
 121 dcl  null                               builtin;
 122 dcl  ptr                                builtin;
 123 dcl  rel                                builtin;
 124 dcl  reverse                            builtin;
 125 dcl  rtrim                              builtin;
 126 dcl  segno                              builtin;
 127 dcl  size                               builtin;
 128 dcl  string                             builtin;
 129 dcl  substr                             builtin;
 130 dcl  unspec                             builtin;
 131 
 132 dcl  bad_dir_                           condition;
 133 
 134 /* Parameters */
 135 
 136 dcl  a_audit_user_info_ptr              ptr parameter;
 137 dcl  a_bc                               fixed bin (24) parameter;
 138 dcl  a_bc_delta                         fixed bin (24) parameter;
 139 dcl  a_chase_sw                         fixed bin (1) parameter;
 140 dcl  a_code                             fixed bin (35) parameter;
 141 dcl  a_detailed_operation               fixed bin (18) uns parameter;
 142 dcl  a_dir_uid                          bit (36) aligned parameter;
 143 dcl  a_dirname                          char (168) unal parameter;
 144 dcl  a_dp                               ptr parameter;
 145 dcl  a_entryname                        char (32) unal parameter;
 146 dcl  a_ep                               ptr parameter;
 147 dcl  a_exmode                           bit (36) aligned parameter;
 148 dcl  a_kstep                            ptr parameter;
 149 dcl  a_mode                             bit (36) aligned parameter;
 150 dcl  a_pep                              ptr parameter;
 151 dcl  a_ppep                             ptr parameter;
 152 dcl  a_ringbr                           (3) fixed bin (3) parameter;
 153 dcl  a_segptr                           ptr parameter;
 154 dcl  a_unlocksw                         bit (1) aligned parameter;
 155 dcl  a_uidpath                          (0:15) bit (36) aligned parameter;
 156 
 157 /* Constants */
 158 
 159 dcl  FIND_ALL                           bit (4) aligned init ("1111"b) static options (constant);
 160 dcl  FIND_DIR                           bit (4) aligned init ("1000"b) static options (constant);
 161 dcl  FIND_DIR_OR_LINK                   bit (4) aligned init ("1100"b) static options (constant);
 162 dcl  FIND_LINK                          bit (4) aligned init ("0100"b) static options (constant);
 163 dcl  FIND_LINK_OR_NOTHING               bit (4) aligned init ("0110"b) static options (constant);
 164 dcl  FIND_NOTHING                       bit (4) aligned init ("0010"b) static options (constant);
 165 dcl  FIND_OBJECT_OR_LINK                bit (4) aligned init ("1101"b) static options (constant);
 166 dcl  FIND_SEG                           bit (4) aligned init ("0001"b) static options (constant);
 167 dcl  ME                                 char (7) init ("dc_find") static options (constant);
 168 dcl  READ_LOCK                          bit (36) aligned init ("0"b) static options (constant);
 169 dcl  WRITE_LOCK                         bit (36) aligned init ("1"b) static options (constant);
 170 
 171 /* Variables */
 172 
 173 dcl  access_checker                     variable entry (ptr, bit (36) aligned, bit (36) aligned, fixed bin (35)); /* one of the access_mode$foo gets put here */
 174 dcl  change_bc                          bit (1) aligned;
 175 dcl  chase_sw                           fixed bin (1);
 176 dcl  code                               fixed bin (35);
 177 dcl  dir_uid                            bit (36) aligned;
 178 dcl  dirmode                            bit (36) aligned;
 179 dcl  dirmode_raw                        bit (1) aligned;
 180 dcl  dirname                            char (168) var;
 181 dcl  entryname                          char (32) aligned;
 182 dcl  exmode                             bit (36) aligned;
 183 dcl  linkage_ring                       fixed bin (3);
 184 dcl  lock_for_writing                   bit (36) aligned;
 185 dcl  mode                               bit (36) aligned;
 186 dcl  1 my_makeknown_info                aligned like makeknown_info;
 187 dcl  objmode                            bit (36) aligned;
 188 dcl  pdp                                ptr;
 189 dcl  pep                                ptr;
 190 dcl  ppdp                               ptr;
 191 dcl  ppep                               ptr;
 192 dcl  ringbr                             (3) fixed bin (3);
 193 dcl  1 sdwi                             aligned like sdw_info;
 194 dcl  segptr                             ptr;
 195 dcl  1 state                            aligned,
 196        2 allow_searching_aim_isolated_dirs bit (1) aligned,
 197        2 allow_aim_isolated_final_dir   bit (1) aligned,
 198        2 dir_held                       bit (1) aligned,
 199        2 dir_locked                     bit (1) aligned,
 200        2 for_user                       bit (1) aligned,    /* this is being done for someone else */
 201        2 parent_locked                  bit (1) aligned,
 202        2 parent_parent_locked           bit (1) aligned,
 203        2 find_dir_has_work_area         bit (1) aligned,
 204        2 work_pathname_ptr              ptr,
 205        2 operation                      bit (36) aligned,
 206        2 event_flags                    bit (36) aligned,
 207        2 user                           aligned like audit_user_info; /* user this is done for */
 208 dcl  uidpath                            (0:15) bit (36) aligned;
 209 %page;
 210 dir_for_append: entry (a_dirname, a_entryname, a_chase_sw, a_pep, a_dp, a_code);
 211 
 212 /* Used by append to find a pointer into a directory into which to append.
 213 The dirname and entryname variables are updated to the target of the link if
 214 chase is specified.  The directory is returned locked. */
 215 
 216           dirmode_raw = "0"b;
 217           go to dir_for_append_join;
 218 
 219 dir_for_append_raw: entry (a_dirname, a_entryname, a_chase_sw, a_pep, a_dp, a_code);
 220 
 221           dirmode_raw = "1"b;                               /* admin_gate_ */
 222 
 223 dir_for_append_join:
 224           call dir_name_setup;
 225           dirmode = A_ACCESS;
 226           state.operation = access_operations_$fs_obj_contents_mod; /* obj creation is audited by append */
 227           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_CREATE_BRANCH;
 228 
 229           entryname = a_entryname;
 230           lock_for_writing = "1"b;
 231           chase_sw = a_chase_sw;
 232           a_pep, pep = null;
 233 
 234           call find_$append;
 235           if code ^= 0 then go to RETURN;
 236 
 237           call sum$getbranch_root_my (dp, READ_LOCK, pep, code);
 238           if code = 0 then state.parent_locked = "1"b;
 239           else if code = error_table_$root then code = 0;
 240           else call fatal_error;
 241           pdp = ptr (pep, 0);
 242 
 243           if dirmode_raw then call access_mode$raw (pep, mode, exmode, code);
 244           else call get_dir_mode$locked (dp, exmode, code);
 245           if code ^= 0 then call fatal_error;
 246           if (exmode & dirmode) ^= dirmode then do;
 247                call dir_control_error$append (pep, code);
 248                call fatal_error;
 249           end;
 250 
 251           call audit_success$msg (pep, entryname);
 252 
 253           a_dirname = dirname;
 254           a_entryname = entryname;
 255           a_pep = pep;
 256           a_dp = dp;
 257           a_code = code;
 258           return;
 259 %page;
 260 dir_for_retrieve_append: entry (a_dirname, a_entryname, a_chase_sw, a_audit_user_info_ptr, a_pep, a_dp, a_code);
 261 
 262 /* Used by append to find a pointer into a directory into which to append.
 263 The dirname and entryname variables are updated to the target of the link if
 264 chase is specified.  The directory is returned locked. */
 265 
 266           call dir_name_setup;
 267           state.operation = access_operations_$fs_obj_contents_mod; /* obj creation audited by append */
 268           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_CREATE_BRANCH;
 269 
 270           state.for_user = "1"b;
 271           state.user = a_audit_user_info_ptr -> audit_user_info;
 272 
 273           a_pep, pep = null;
 274           entryname = a_entryname;
 275           lock_for_writing = "1"b;
 276           chase_sw = a_chase_sw;
 277 
 278           call find_$append;
 279           if code ^= 0 then go to RETURN;
 280 
 281           call sum$getbranch_root_my (dp, READ_LOCK, pep, code);
 282           if code = 0 then state.parent_locked = "1"b;
 283           else if code = error_table_$root then code = 0;
 284           else call fatal_error;
 285           pdp = ptr (pep, 0);
 286 
 287           call access_mode$user_effmode (pep, state.user_id, state.authorization, (state.ring), mode, exmode, code);
 288           if code ^= 0 then call fatal_error;
 289           if (exmode & A_ACCESS) ^= A_ACCESS then do;
 290                call dir_control_error$append (pep, code);
 291                call fatal_error;
 292           end;
 293 
 294           call audit_success$msg (pep, entryname);
 295 
 296           a_dirname = dirname;
 297           a_entryname = entryname;
 298           a_pep = pep;
 299           a_dp = dp;
 300           a_code = code;
 301           return;
 302 %page;
 303 dir_initiate: entry (a_dirname, a_dp, a_code);
 304 
 305 /* Make the dir known (set_wdir, etc.). */
 306 
 307           call dir_name_setup;
 308           state.operation = access_operations_$fs_obj_initiate;
 309           lock_for_writing = "0"b;
 310 
 311           call find_locked_dir;
 312           if code ^= 0 then go to RETURN;
 313 
 314           call sum$getbranch_root_my (dp, READ_LOCK, pep, code); /* needed for auditing */
 315           if code = 0 then state.parent_locked = "1"b;
 316           else if code = error_table_$root then code = 0;
 317           else call fatal_error;
 318           pdp = ptr (pep, 0);
 319 
 320           call get_dir_mode$locked (dp, exmode, code);      /* must have access to dir or parent */
 321           if code ^= 0 then call fatal_error;
 322           if exmode = "0"b then do;                         /* check parent */
 323                if pdp ^= null then do;
 324                     call get_dir_mode (pdp, exmode, code);
 325                     if code ^= 0 then call fatal_error;
 326                end;
 327                if exmode = "0"b then do;
 328                     call dir_control_error$attributes (pep, code);
 329                     call fatal_error;
 330                end;
 331           end;
 332 
 333           call audit_success (pep);
 334 
 335           if state.parent_locked then call lock$dir_unlock (pdp); /* done with parent */
 336 
 337           a_dp = dp;
 338           a_code = code;
 339           return;
 340 %page;
 341 dir_move_quota: entry (a_dirname, a_pep, a_dp, a_code);
 342 
 343 /* Used by quota moving.  Access checks are M on the target dir and M on the
 344 parent.  NOTE also that the final target is allowed to be upgraded. */
 345 
 346           call dir_name_setup;
 347           state.operation = access_operations_$fs_obj_contents_mod;
 348           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_MOVE_QUOTA;
 349 
 350           a_pep, pep = null;
 351           state.allow_aim_isolated_final_dir = "1"b;        /* This is the only known case where this is true. */
 352           lock_for_writing = "1"b;
 353 
 354           if dirname = ">" then do;
 355                code = error_table_$root;
 356                go to RETURN;
 357           end;
 358 
 359           call find_locked_dir;
 360           if code ^= 0 then go to RETURN;
 361 
 362           call sum$getbranch (dp, WRITE_LOCK, pep, code);
 363           if code ^= 0 then call fatal_error;
 364           pdp = ptr (pep, 0);
 365           state.parent_locked = "1"b;
 366 
 367           call get_dir_mode (pdp, exmode, code);
 368           if code ^= 0 then call fatal_error;
 369           if (exmode & M_ACCESS) ^= M_ACCESS | ^aim_check_$greater_or_equal (pep -> entry.access_class, dp -> dir.access_class) then do;
 370                                                             /* user not allowed to see dir for access or aim isolated */
 371                call dir_control_error$contents (pep, code);
 372                call fatal_error;
 373           end;
 374 
 375           call access_mode$raw (pep, mode, exmode, code);
 376           if code ^= 0 then call fatal_error;
 377           if (exmode & M_ACCESS) ^= M_ACCESS then do;
 378                call dir_control_error$contents (pep, code);
 379                call fatal_error;
 380           end;
 381 
 382           call audit_success (pep);
 383 
 384           a_pep = pep;
 385           a_dp = dp;
 386           a_code = code;
 387           return;
 388 %page;
 389 dir_read: entry (a_dirname, a_dp, a_code);
 390 
 391 /* These return a pointer to a locked directory.  The use of these are for
 392 cases in which the contents (name space, iacls) of a directory are desired.
 393 The access requirements are effective s access on the dir for read, m for
 394 write. */
 395 
 396           lock_for_writing = "0"b;
 397           dirmode = S_ACCESS;
 398           call dir_name_setup;
 399           state.operation = access_operations_$fs_obj_contents_read;
 400           go to dir_join;
 401 
 402 dir_write: entry (a_dirname, a_detailed_operation, a_dp, a_code);
 403 
 404           lock_for_writing = "1"b;
 405           dirmode = M_ACCESS;
 406           call dir_name_setup;
 407           state.operation = access_operations_$fs_obj_contents_mod;
 408           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
 409           go to dir_join;
 410 
 411 dir_read_priv: entry (a_dirname, a_dp, a_code);
 412 
 413           lock_for_writing = "0"b;
 414           dirmode = "0"b;
 415           call dir_name_setup;
 416           state.operation = access_operations_$fs_obj_contents_read;
 417           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
 418           go to dir_join;
 419 
 420 dir_write_priv: entry (a_dirname, a_detailed_operation, a_dp, a_code);
 421 
 422           lock_for_writing = "1"b;
 423           dirmode = "0"b;
 424           call dir_name_setup;
 425           state.operation = access_operations_$fs_obj_contents_mod;
 426           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
 427           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
 428 
 429 dir_join:
 430           call find_locked_dir;
 431           if code ^= 0 then go to RETURN;
 432 
 433           call sum$getbranch_root_my (dp, READ_LOCK, pep, code); /* needed for auditing */
 434           if code = 0 then state.parent_locked = "1"b;
 435           else if code = error_table_$root then code = 0;
 436           else call fatal_error;
 437           pdp = ptr (pep, 0);
 438 
 439           if dirmode ^= "0"b then do;
 440                call get_dir_mode$locked (dp, exmode, code);
 441                if code ^= 0 then call fatal_error;
 442                if (exmode & dirmode) ^= dirmode then do;
 443                     call dir_control_error$contents (pep, code);
 444                     call fatal_error;
 445                end;
 446           end;
 447 
 448           call audit_success (pep);
 449 
 450           if state.parent_locked then call lock$dir_unlock (pdp);
 451 
 452           a_dp = dp;                                        /* Success! */
 453           a_code = code;
 454           return;
 455 %page;
 456 dir_reclassify: entry (a_dirname, a_ppep, a_pep, a_dp, a_code);
 457 
 458 /* Return a pointer to a dir, its entry and its parent's parent's entry for the
 459 reclassify_node operation. */
 460 
 461           call dir_name_setup;
 462           state.operation = access_operations_$fs_obj_access_mod;
 463           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_RECLASSIFY_NODE;
 464           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
 465           a_pep, a_ppep, pep, ppep = null;
 466           lock_for_writing = "1"b;
 467 
 468           if dirname = ">" then do;
 469                code = error_table_$root;
 470                go to RETURN;
 471           end;
 472 
 473           call find_locked_dir;
 474           if code ^= 0 then go to RETURN;
 475 
 476           call sum$getbranch (dp, WRITE_LOCK, pep, code);
 477           if code ^= 0 then call fatal_error;
 478           pdp = ptr (pep, 0);
 479           state.parent_locked = "1"b;
 480 
 481           call access_mode$raw (pep, mode, exmode, code);   /* check raw mode on parent for reclassify */
 482           if code ^= 0 then call fatal_error;
 483           if (exmode & SM_ACCESS) ^= SM_ACCESS then do;
 484                call dir_control_error$contents (pep, code);
 485                call fatal_error;
 486           end;
 487 
 488           call sum$getbranch_root_my (pdp, READ_LOCK, ppep, code);
 489           if code = 0 then state.parent_parent_locked = "1"b;
 490           else if code = error_table_$root then code = 0;
 491           else call fatal_error;
 492           ppdp = ptr (ppep, 0);
 493 
 494           call access_mode$raw (ppep, mode, exmode, code);
 495           if code ^= 0 then call fatal_error;
 496           if (exmode & M_ACCESS) ^= M_ACCESS then do;
 497                call dir_control_error$contents (pep, code);
 498                call fatal_error;
 499           end;
 500 
 501           call audit_success (pep);
 502 
 503           a_ppep = ppep;
 504           a_pep = pep;
 505           a_dp = dp;
 506           a_code = code;
 507           return;
 508 %page;
 509 dir_salvage: entry (a_dirname, a_dir_uid, a_dp, a_code);
 510 
 511 /* Entry used by the directory salvager.  It is like dir_write_priv except that
 512 it uses a special locking primitive. */
 513 
 514           call dir_name_setup;
 515           state.operation = access_operations_$fs_obj_contents_mod;
 516           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_DIR_SALVAGE;
 517           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
 518           a_dir_uid = "0"b;
 519 
 520           call find_dir;
 521           if code ^= 0 then go to RETURN;
 522 
 523           dir.modify = "0"b;
 524 
 525           call lock$dir_lock_salvage (dp, dir_uid, code);
 526           if code ^= 0 then call fatal_error;
 527 
 528           call sum$getbranch_root_my (dp, READ_LOCK, pep, code); /* needed for auditing */
 529           if code = 0 then state.parent_locked = "1"b;
 530           else if code = error_table_$root then code = 0;
 531           else call fatal_error;
 532           pdp = ptr (pep, 0);
 533 
 534           call audit_success (pep);
 535 
 536           if state.parent_locked then call lock$dir_unlock (pdp);
 537 
 538           a_dir_uid = dir_uid;
 539           a_dp = dp;                                        /* Success! */
 540           a_code = code;
 541           return;
 542 %page;
 543 mdir_set_quota_uid: entry (a_uidpath, a_dirname, a_detailed_operation, a_pep, a_dp, a_code);
 544 
 545 /* Returns a pointer to a directory when given a uid path.  Access requirements
 546 are M on the dir. It is used by quota$mdir_set. */
 547 
 548           unspec (state) = "0"b;
 549           state.operation = access_operations_$fs_obj_contents_mod;
 550           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
 551           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
 552           state.allow_aim_isolated_final_dir = "1"b;
 553 
 554           dirmode = M_ACCESS;
 555           a_pep, pdp, pep, ep, a_dp, dp = null;
 556           code = 0;
 557           uidpath = a_uidpath;
 558           lock_for_writing = "0"b;                          /* parent dir is not beign modified */
 559 
 560           call uid_path_util$find_dir;
 561           if code = error_table_$root then a_dirname = dirname; /* Return name so far */
 562           if code ^= 0 then go to RETURN;
 563 
 564           call lock$dir_lock_write (dp, code);
 565           if code ^= 0 then call fatal_error;
 566           state.dir_locked = "1"b;
 567 
 568           call sum$getbranch (dp, lock_for_writing, pep, code);
 569           if code ^= 0 then call fatal_error;
 570           pdp = ptr (pep, 0);
 571           state.parent_locked = "1"b;
 572 
 573           call access_mode$raw (pep, mode, exmode, code);
 574           if code ^= 0 then call fatal_error;
 575           if (exmode & dirmode) ^= dirmode then do;
 576                call dir_control_error$contents (pep, code);
 577                call fatal_error;
 578           end;
 579 
 580           call audit_success (pep);
 581 
 582           a_dirname = dirname;
 583           a_pep = pep;
 584           a_dp = dp;
 585           a_code = 0;
 586           return;
 587 %page;
 588 finished: entry (a_ep, a_unlocksw);
 589 
 590 /* Undoes the result of a previous dc_find (non-ptr) call.  It unlocks the dir
 591 specified (if unlocksw is set) and dereferences the dir.  The proper
 592 termination for a directory found through a _ptr entry is to call
 593 lock$dir_unlock on it. */
 594 
 595           ep = a_ep;
 596           if ep ^= null then do;
 597                if a_unlocksw then call lock$dir_unlock (ptr (ep, 0));
 598                call segno_usage$decrement (segno (ep), (0));
 599           end;
 600           return;
 601 %page;
 602 link_target: entry (a_dirname, a_entryname, a_code);
 603 
 604 /* Returns the path of the target of the (possible) link.  The user must have
 605 non-null access to the target dir or non-null access to the target (if it
 606 exists). */
 607 
 608           unspec (state) = "0"b;
 609           state.operation = access_operations_$fs_obj_prop_read;
 610 
 611           code = 0;
 612           dirname = rtrim (a_dirname);
 613           entryname = a_entryname;
 614           lock_for_writing = "0"b;
 615 
 616           call find_$link_target;
 617           if code ^= 0 then go to RETURN;
 618 
 619           if ep ^= null then do;                            /* a target exists */
 620                call get_dir_mode (dp, exmode, code);
 621                if code ^= 0 then call fatal_error;
 622                if exmode = N_ACCESS then do;                /* no dir access, check entry */
 623                     call access_mode$effective (ep, mode, exmode, code);
 624                     if code ^= 0 then call fatal_error;
 625                     if ep -> entry.dirsw then mode = exmode;
 626                     if mode = N_ACCESS then do;             /* null on both target dir and target */
 627                          call dir_control_error$attributes (ep, code);
 628                          call fatal_error;
 629                     end;
 630                end;
 631 
 632                call audit_success (ep);
 633           end;
 634           else do;
 635                state.operation = access_operations_$fs_obj_contents_read; /* reading names in dir */
 636 
 637                call sum$getbranch_root_my (dp, READ_LOCK, pep, code); /* needed for auditing */
 638                if code = 0 then state.parent_locked = "1"b;
 639                else if code = error_table_$root then code = 0;
 640                else call fatal_error;
 641                pdp = ptr (pep, 0);
 642 
 643                call get_dir_mode$locked (dp, exmode, code);
 644                if code ^= 0 then call fatal_error;
 645                if exmode = N_ACCESS then do;
 646                     code = error_table_$no_info;
 647                     call dir_control_error$name_non_existant (dp, code);
 648                     call fatal_error;
 649                end;
 650 
 651                call audit_success (pep);
 652 
 653                if state.parent_locked then call lock$dir_unlock (pdp);
 654 
 655                code = error_table_$noentry;                 /* tell of non-existance */
 656           end;
 657 
 658           call lock$dir_unlock (dp);
 659           call segno_usage$decrement (segno (dp), (0));     /* done with dir */
 660 
 661           a_dirname = dirname;
 662           a_entryname = entryname;
 663           a_code = code;
 664           return;
 665 %page;
 666 obj_attributes_read: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
 667 
 668 /* Return a pointer to an entry in a locked directory.  These entries are used
 669 when the attributes of an object (such as ring brackets) are desired that are
 670 accessible for either effective s access on the parent dir or non-null access
 671 on the object (for read) or for m access on the parent dir or w/m access on
 672 the object (for write). */
 673 
 674           lock_for_writing = "0"b;
 675           dirmode = S_ACCESS;
 676           call obj_name_setup;
 677           state.operation = access_operations_$fs_obj_prop_read;
 678           go to obj_attributes_name_join;
 679 
 680 obj_attributes_write: entry (a_dirname, a_entryname, a_chase_sw, a_detailed_operation, a_ep, a_code);
 681 
 682           lock_for_writing = "1"b;
 683           dirmode = M_ACCESS;
 684           call obj_name_setup;
 685           state.operation = access_operations_$fs_obj_attr_mod;
 686           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
 687           go to obj_attributes_name_join;
 688 
 689 obj_terminate: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
 690 
 691           lock_for_writing = "0"b;
 692           dirmode = N_ACCESS;
 693           call obj_name_setup;
 694           state.operation = access_operations_$fs_obj_terminate;
 695 
 696 obj_attributes_name_join:
 697           chase_sw = a_chase_sw;
 698 
 699           call find_;
 700           if code ^= 0 then go to RETURN;
 701           go to obj_attributes_join;
 702 
 703 obj_existence_ptr: entry (a_segptr, a_ep, a_code);
 704 
 705           lock_for_writing = "0"b;
 706           dirmode = N_ACCESS;
 707           call obj_ptr_setup;
 708           state.operation = access_operations_$fs_obj_prop_read;
 709           go to obj_attributes_ptr_join;
 710 
 711 obj_terminate_ptr: entry (a_segptr, a_ep, a_code);
 712 
 713           lock_for_writing = "0"b;
 714           dirmode = N_ACCESS;
 715           call obj_ptr_setup;
 716           state.operation = access_operations_$fs_obj_terminate;
 717           go to obj_attributes_ptr_join;
 718 
 719 obj_attributes_read_ptr: entry (a_segptr, a_ep, a_code);
 720 
 721           lock_for_writing = "0"b;
 722           dirmode = S_ACCESS;
 723           call obj_ptr_setup;
 724           state.operation = access_operations_$fs_obj_prop_read;
 725           go to obj_attributes_ptr_join;
 726 
 727 obj_attributes_write_ptr: entry (a_segptr, a_detailed_operation, a_ep, a_code);
 728 
 729           lock_for_writing = "1"b;
 730           dirmode = M_ACCESS;
 731           call obj_ptr_setup;
 732           state.operation = access_operations_$fs_obj_attr_mod;
 733           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
 734 
 735 obj_attributes_ptr_join:
 736           call find_segptr_branch;
 737           if code ^= 0 then
 738                if code = error_table_$root & state.operation = access_operations_$fs_obj_terminate then go to obj_attribute_success;
 739                else go to SEGPTR_FAILURE;
 740 
 741 obj_attributes_join:
 742           call get_dir_mode (dp, exmode, code);
 743           if code ^= 0 then call fatal_error;
 744           if (exmode & dirmode) = dirmode then
 745                if exmode = N_ACCESS then go to obj_attributes_check_target; /* dirmode of N_ACCESS can also bring us here */
 746                else ;
 747           else do;                                          /* wrong parent access, check for access on target */
 748 obj_attributes_check_target:
 749                if ^ep -> entry.bs then go to obj_attributes_error; /* link */
 750                if state.dir_held then                       /* path entry */
 751                     call access_mode$effective (ep, mode, exmode, code);
 752                else call fs_modes$locked (segptr, mode, exmode, ringbr, code);
 753                if code ^= 0 then call fatal_error;
 754                if dirmode = M_ACCESS then do;               /* we need m/w if we do not have m on parent */
 755                     if ep -> entry.dirsw then
 756                          if (exmode & M_ACCESS) ^= M_ACCESS then go to obj_attributes_error;
 757                          else ;
 758                     else if (mode & W_ACCESS) ^= W_ACCESS then go to obj_attributes_error;
 759                     else ;
 760                end;
 761                else do;                                     /* we'll allow since user has non-null on object */
 762                     if ep -> entry.dirsw then mode = exmode;
 763                     if mode = N_ACCESS then do;
 764 obj_attributes_error:    call dir_control_error$attributes (ep, code);
 765                          call fatal_error;
 766                     end;
 767                     else ;
 768                end;
 769           end;
 770 
 771 obj_attribute_success:
 772           call audit_success (ep);
 773 
 774           a_ep = ep;                                        /* Success! */
 775           a_code = code;
 776           return;
 777 %page;
 778 obj_bc_delta_write: entry (a_dirname, a_entryname, a_bc_delta, a_ep, a_code);
 779 
 780 /* Return a pointer to a directory entry.  These entries are called when the
 781 caller wishes to change the bit_coount for an object.  The delta entries are
 782 called when the bit_count is to added to/subtracted from; the non-delta when
 783 bc is to be set.  These entries have strange access requirements; w if a
 784 segment; for a directory, m if lowering the bc, a if increasing. */
 785 
 786           change_bc = "1"b;
 787           go to obj_bc_name_join;
 788 
 789 obj_bc_write: entry (a_dirname, a_entryname, a_bc, a_ep, a_code);
 790 
 791           change_bc = "0"b;
 792 
 793 obj_bc_name_join:
 794           call obj_name_setup;
 795           state.operation = access_operations_$fs_obj_contents_mod;
 796           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_BC_MOD;
 797           lock_for_writing = "1"b;
 798           chase_sw = DC_FIND_CHASE;
 799 
 800           call find_;
 801           if code ^= 0 then go to RETURN;
 802 
 803           call access_mode$effective (ep, mode, exmode, code);
 804           if code ^= 0 then call fatal_error;
 805           go to obj_bc_join;
 806 
 807 obj_bc_delta_write_ptr: entry (a_segptr, a_bc_delta, a_ep, a_code);
 808 
 809           change_bc = "1"b;
 810           go to obj_bc_ptr_join;
 811 
 812 obj_bc_write_ptr: entry (a_segptr, a_bc, a_ep, a_code);
 813 
 814           change_bc = "0"b;
 815 
 816 obj_bc_ptr_join:
 817           lock_for_writing = "1"b;
 818 
 819           call obj_ptr_setup;
 820           state.operation = access_operations_$fs_obj_contents_mod;
 821           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_BC_MOD;
 822 
 823           call find_segptr_branch;
 824           if code ^= 0 then go to SEGPTR_FAILURE;
 825 
 826           call fs_modes$locked (segptr, mode, exmode, ringbr, code);
 827           if code ^= 0 then call fatal_error;
 828 
 829 obj_bc_join:
 830           if ep -> entry.dirsw then do;
 831                mode = exmode;
 832                if change_bc then
 833                     if a_bc_delta <= 0 then objmode = M_ACCESS; /* viewed as deleting components of msf */
 834                     else objmode = A_ACCESS;                /* adding components */
 835                else if ep -> entry.bc >= a_bc then objmode = M_ACCESS;
 836                else objmode = A_ACCESS;
 837           end;
 838           else objmode = W_ACCESS;
 839           if (mode & objmode) ^= objmode then do;
 840                call dir_control_error$contents (ep, code);
 841                call fatal_error;
 842           end;
 843 
 844           call audit_success (ep);
 845 
 846           a_ep = ep;
 847           a_code = code;
 848           return;
 849 %page;
 850 obj_for_audit: entry (a_dirname, a_entryname, a_ep, a_code);
 851 
 852 /* Returns a pointer to an entry in a locked directory.  No access check or
 853 auditing are done, in as much as access_audit_ is calling us so that it can
 854 audit somthing about the path supplied. */
 855 
 856           lock_for_writing = "0"b;
 857           call obj_name_setup;
 858           state.operation = access_operations_$fs_obj_prop_read; /* in case something goes wrong */
 859           chase_sw = DC_FIND_NO_CHASE;
 860 
 861           call find_;
 862           if code ^= 0 then go to RETURN;
 863 
 864           a_ep = ep;
 865           a_code = code;
 866           return;
 867 %page;
 868 obj_initiate: entry (a_dirname, a_entryname, a_ep, a_code);
 869 
 870 /* Returns the entry pointer for the initiate function.  The access check is
 871 non-null on the object.  The _dp versions take a directory pointer instead
 872 of a directory name.  For these (used by fs_search), a simple dir look-up is
 873 done.  If the object found is a link, though, we must perform a normal
 874 branch lookup.  In this case, a_dp is set to null, warning the user that
 875 his dp is no longer good and that finished must be called.  The raw version
 876 only checks raw access on the target;  it also simulates dir priv by ignoring
 877 the upgradedness of directories when searching them.  The auth version uses
 878 authorization access. */
 879 
 880           call obj_name_setup;
 881           state.operation = access_operations_$fs_obj_initiate;
 882 
 883           access_checker = access_mode$effective;
 884           go to initiate_name_join;
 885 
 886 obj_initiate_raw: entry (a_dirname, a_entryname, a_ep, a_code);
 887 
 888           call obj_name_setup;
 889           state.operation = access_operations_$fs_obj_initiate;
 890           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
 891 
 892           state.allow_searching_aim_isolated_dirs = "1"b;
 893           access_checker = access_mode$raw;
 894 
 895 initiate_name_join:
 896           lock_for_writing = "0"b;
 897           chase_sw = DC_FIND_CHASE;
 898 
 899           call find_;
 900           if code = 0 then ;
 901           else if code = error_table_$root then do;
 902                dp, ep = null;
 903                code = 0;
 904           end;
 905           else go to RETURN;
 906           go to initiate_join;
 907 
 908 obj_initiate_for_linker_dp: entry (a_dp, a_entryname, a_ep, a_code);
 909 
 910 /* NOTE: we have a contract that the only caller of this is initiate_seg_count,
 911 which in turn is only called by fs_search.  Since this is the case, we perform
 912 an optimization that throws away information (providing no security
 913 violation).  For this entry, we merge the non-existance of the target with
 914 no_info access to the target and call the result no_info in both cases. */
 915 
 916           unspec (state) = "0"b;
 917           state.operation = access_operations_$fs_obj_initiate;
 918 
 919           access_checker = access_mode$effective;
 920 
 921           lock_for_writing = "0"b;
 922           a_ep, ep = null;
 923           dp = a_dp;
 924           entryname = a_entryname;
 925           code = 0;
 926 
 927           call lock$dir_lock_read (dp, code);
 928           if code ^= 0 then go to RETURN;
 929           state.dir_locked = "1"b;
 930 
 931           call find_entry (dp, entryname, FIND_ALL, ep, code);
 932           if code ^= 0 then call fatal_error;
 933           if ep = null then do;                             /* no such name */
 934                code = error_table_$no_info;                 /* don't bother distinguishing this from no_entry, fs_search doesn't care */
 935                call fatal_error;
 936           end;
 937 
 938           if ^ep -> entry.bs then do;                       /* link */
 939                dirname = rtrim (substr (ep -> link.pathname, 1, ep -> link.pathname_size));
 940                entryname = "";
 941                call lock$dir_unlock (dp);
 942                state.dir_locked = "0"b;
 943                a_dp = null;                                 /* tell user his dp isn't good anymore; finished must be called */
 944                call find_$link_target;
 945                if code = 0 then do;
 946                     if ep = null then do;                   /* no such target */
 947                          code = error_table_$no_info;       /* don't bother distinguishing this from no_entry, fs_search doesn't care */
 948                          call fatal_error;
 949                     end;
 950                end;
 951                else if code = error_table_$root then do;
 952                     dp, ep = null;
 953                     code = 0;
 954                end;
 955                else go to RETURN;
 956           end;
 957 
 958 initiate_join:
 959           call access_checker (ep, mode, exmode, code);
 960           if code ^= 0 then call fatal_error;
 961 
 962 /* We allow initiating dirs only if the mode and exmode are non_null. */
 963 
 964           if ep = null then                                 /* root */
 965                if exmode = "0"b then go to obj_initiate_error;
 966                else ;
 967           else if ep -> entry.dirsw then
 968                if exmode = "0"b then go to obj_initiate_error;
 969 
 970           if mode = "0"b then do;
 971 obj_initiate_error:
 972                if ep = null then code = error_table_$dirseg;/* not nice to ask for root */
 973                else if ep -> entry.dirsw then do;
 974                     call dir_control_error$contents_info (ep, code); /* asking for dir is not considered a real violation */
 975                     if code = error_table_$moderr then code = error_table_$dirseg;
 976                end;
 977                else call dir_control_error$contents (ep, code);
 978                call fatal_error;
 979           end;
 980 
 981           call audit_success (ep);
 982 
 983           a_ep = ep;
 984           a_code = code;
 985           return;
 986 %page;
 987 obj_linkage_ring_ptr: entry (a_segptr, a_code);
 988 
 989 /* Allows a user process to read the definitions for a lower ring gate by
 990 lowering the ring number in the supplied pointer from within the call bracket
 991 into the read bracket. */
 992 
 993           unspec (state) = "0"b;
 994           state.operation = access_operations_$fs_obj_contents_read;
 995 
 996           ep = null;
 997           code = 0;
 998           segptr = a_segptr;
 999 
1000           lock_for_writing = "0"b;
1001 
1002           call find_segptr_branch;
1003           if code ^= 0 then go to SEGPTR_FAILURE;
1004 
1005           call fs_modes$locked (segptr, mode, exmode, ringbr, code);
1006           if code ^= 0 then call fatal_error;
1007 
1008           if (mode & E_ACCESS) ^= E_ACCESS then do;
1009                call dir_control_error$attributes (ep, code);
1010                call fatal_error;
1011           end;
1012 
1013           call audit_success (ep);
1014 
1015           call lock$dir_unlock (dp);
1016 
1017           linkage_ring = min (level$get (), ringbr (2));    /* let read through call bracket */
1018 
1019           addr (a_segptr) -> its_unsigned.ringno = linkage_ring;
1020           a_code = code;
1021           return;
1022 %page;
1023 obj_modes_ptr: entry (a_segptr, a_mode, a_exmode, a_ringbr, a_code);
1024 
1025 /* Return the access modes the process has to the object, assuming it has some
1026 access. */
1027 
1028           unspec (state) = "0"b;
1029           state.operation = access_operations_$fs_obj_prop_read;
1030           ep = null;
1031           code = 0;
1032           segptr = a_segptr;
1033 
1034           lock_for_writing = "0"b;
1035 
1036           call sum$getbranch_root_my (segptr, lock_for_writing, ep, code);
1037           if code ^= 0 then
1038                if code = error_table_$root then do;
1039                     code = 0;
1040                     ep = null;
1041                end;
1042                else go to SEGPTR_FAILURE;
1043           else do;
1044                dp = ptr (ep, 0);
1045                state.dir_locked = "1"b;
1046           end;
1047 
1048           call fs_modes$locked (segptr, mode, exmode, ringbr, code);
1049           if code ^= 0 then call fatal_error;
1050 
1051           if ep = null then do;
1052                mode = exmode;                               /* root */
1053                exmode = "0"b;
1054           end;
1055           else if ep -> entry.dirsw then do;
1056                mode = exmode;                               /* dir */
1057                exmode = "0"b;
1058           end;
1059 
1060           if mode = "0"b then do;                           /* make sure user is allowed to see no access */
1061                if ep = null then dirmode = "0"b;            /* root */
1062                else do;
1063                     call get_dir_mode (dp, dirmode, code);
1064                     if code ^= 0 then call fatal_error;
1065                end;
1066                if (dirmode & S_ACCESS) ^= S_ACCESS then do;
1067                     call dir_control_error$attributes (ep, code);
1068                     call fatal_error;
1069                end;
1070           end;
1071 
1072           call audit_success (ep);
1073 
1074           if ep -> entry.dirsw then code = error_table_$dirseg;
1075           if state.dir_locked then call lock$dir_unlock (dp);
1076 
1077           a_mode = mode;
1078           a_exmode = exmode;
1079           a_ringbr = ringbr;
1080           a_code = code;
1081           return;
1082 %page;
1083 obj_reclassify: entry (a_dirname, a_entryname, a_pep, a_ep, a_code);
1084 
1085 /* Return a pointer to a directory entry and its parent entry for the
1086 reclassify operation. */
1087 
1088           call obj_name_setup;
1089           state.operation = access_operations_$fs_obj_access_mod;
1090           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_RECLASSIFY;
1091           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1092 
1093           lock_for_writing = "1"b;
1094           a_pep, pep = null;
1095           chase_sw = DC_FIND_NO_CHASE;
1096 
1097           call find_;
1098           if code ^= 0 then go to RETURN;
1099 
1100           call sum$getbranch_root_my (dp, READ_LOCK, pep, code);
1101           if code = 0 then state.parent_locked = "1"b;
1102           else if code = error_table_$root then code = 0;   /* dep is null but access_mode understands this */
1103           else call fatal_error;
1104           pdp = ptr (pep, 0);
1105 
1106           call access_mode$raw (pep, mode, exmode, code);   /* check raw mode on parent for reclassify */
1107           if code ^= 0 then call fatal_error;
1108           if (exmode & M_ACCESS) ^= M_ACCESS then do;
1109                call dir_control_error$attributes (pep, code);
1110                call fatal_error;
1111           end;
1112 
1113           call audit_success (ep);
1114 
1115           a_pep = pep;
1116           a_ep = ep;
1117           a_code = code;
1118           return;
1119 %page;
1120 obj_status_attributes_read: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
1121 
1122 /* Same as obj_attributes_read except that it returns the code no_s_permission
1123 if this is the case.  It is used by the status_ and status_long functions. */
1124 
1125           call obj_name_setup;
1126           state.operation = access_operations_$fs_obj_prop_read;
1127 
1128           lock_for_writing = "0"b;
1129           dirmode = S_ACCESS;
1130           chase_sw = a_chase_sw;
1131 
1132           call find_;
1133           if code ^= 0 then go to RETURN;
1134 
1135           call get_dir_mode (dp, exmode, code);
1136           if code ^= 0 then call fatal_error;
1137           if (exmode & dirmode) ^= dirmode then do;
1138                if ep -> entry.bs then do;
1139                     call access_mode$effective (ep, mode, exmode, code); /* look for non-null on object */
1140                     if code ^= 0 then call fatal_error;
1141                     if ep -> entry.dirsw then mode = exmode;
1142                     if mode = N_ACCESS then do;
1143                          call dir_control_error$attributes (ep, code); /* We have no access on object; check access on parent dir for error code. */
1144                          call fatal_error;
1145                     end;
1146                     else call dir_control_error$status (ep, code); /* audit partial lack of access, return ep anyway */
1147                end;
1148                else do;
1149                     call dir_control_error$attributes (ep, code); /* link */
1150                     call fatal_error;
1151                end;
1152           end;
1153 
1154           call audit_success (ep);
1155 
1156           a_ep = ep;                                        /* Success! */
1157           a_code = code;
1158           return;
1159 %page;
1160 obj_status_read: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
1161 
1162 /* Returns a pointer to an entry in a locked directory.  These entries are used
1163 when the attributes of an object that are considered as belonging to the
1164 parent dir (acls, names) are desired.  The access requirements are effective s
1165 access on the dir for read, m for write. */
1166 
1167           lock_for_writing = "0"b;
1168           dirmode = S_ACCESS;
1169           call obj_name_setup;
1170           state.operation = access_operations_$fs_obj_prop_read;
1171           go to obj_status_name_join;
1172 
1173 obj_status_read_priv: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
1174 
1175           lock_for_writing = "0"b;
1176           dirmode = "0"b;
1177           call obj_name_setup;
1178           state.operation = access_operations_$fs_obj_prop_read;
1179           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1180           go to obj_status_name_join;
1181 
1182 obj_access_write: entry (a_dirname, a_entryname, a_chase_sw, a_detailed_operation, a_ep, a_code);
1183 
1184           lock_for_writing = "1"b;
1185           dirmode = M_ACCESS;
1186           call obj_name_setup;
1187           state.operation = access_operations_$fs_obj_access_mod;
1188           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
1189           go to obj_status_name_join;
1190 
1191 obj_access_write_priv: entry (a_dirname, a_entryname, a_chase_sw, a_detailed_operation, a_ep, a_code);
1192 
1193           lock_for_writing = "1"b;
1194           dirmode = "0"b;
1195           call obj_name_setup;
1196           state.operation = access_operations_$fs_obj_access_mod;
1197           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
1198           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1199           go to obj_status_name_join;
1200 
1201 obj_delete: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
1202 
1203           lock_for_writing = "1"b;
1204           dirmode = M_ACCESS;
1205           call obj_name_setup;
1206           state.operation = access_operations_$fs_obj_delete;
1207           go to obj_status_name_join;
1208 
1209 obj_status_write: entry (a_dirname, a_entryname, a_chase_sw, a_detailed_operation, a_ep, a_code);
1210 
1211           lock_for_writing = "1"b;
1212           dirmode = M_ACCESS;
1213           call obj_name_setup;
1214           state.operation = access_operations_$fs_obj_status_mod;
1215           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
1216           go to obj_status_name_join;
1217 
1218 obj_delete_priv: entry (a_dirname, a_entryname, a_chase_sw, a_ep, a_code);
1219 
1220           lock_for_writing = "1"b;
1221           dirmode = "0"b;
1222           call obj_name_setup;
1223           state.operation = access_operations_$fs_obj_delete;
1224           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1225           go to obj_status_name_join;
1226 
1227 obj_status_write_priv: entry (a_dirname, a_entryname, a_chase_sw, a_detailed_operation, a_ep, a_code);
1228 
1229           lock_for_writing = "1"b;
1230           dirmode = "0"b;
1231           call obj_name_setup;
1232           state.operation = access_operations_$fs_obj_status_mod;
1233           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
1234           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1235 
1236 obj_status_name_join:
1237           chase_sw = a_chase_sw;
1238 
1239           call find_;
1240           if code ^= 0 then go to RETURN;
1241           go to obj_status_join;
1242 
1243 obj_status_read_ptr: entry (a_segptr, a_ep, a_code);
1244 
1245           lock_for_writing = "0"b;
1246           dirmode = S_ACCESS;
1247           call obj_ptr_setup;
1248           state.operation = access_operations_$fs_obj_prop_read;
1249           go to obj_status_ptr_join;
1250 
1251 obj_status_read_priv_ptr: entry (a_segptr, a_ep, a_code);
1252 
1253           lock_for_writing = "0"b;
1254           dirmode = "0"b;
1255           call obj_ptr_setup;
1256           state.operation = access_operations_$fs_obj_prop_read;
1257           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1258           go to obj_status_ptr_join;
1259 
1260 obj_delete_ptr: entry (a_segptr, a_ep, a_code);
1261 
1262           lock_for_writing = "1"b;
1263           dirmode = M_ACCESS;
1264           call obj_ptr_setup;
1265           state.operation = access_operations_$fs_obj_delete;
1266           go to obj_status_ptr_join;
1267 
1268 obj_status_write_ptr: entry (a_segptr, a_detailed_operation, a_ep, a_code);
1269 
1270           lock_for_writing = "1"b;
1271           dirmode = M_ACCESS;
1272           call obj_ptr_setup;
1273           state.operation = access_operations_$fs_obj_status_mod;
1274           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
1275           go to obj_status_ptr_join;
1276 
1277 obj_status_write_priv_ptr: entry (a_segptr, a_detailed_operation, a_ep, a_code);
1278 
1279           lock_for_writing = "1"b;
1280           dirmode = "0"b;
1281           call obj_ptr_setup;
1282           state.operation = access_operations_$fs_obj_status_mod;
1283           addr (state.operation) -> encoded_access_op.detailed_operation = a_detailed_operation;
1284           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1285 
1286 obj_status_ptr_join:
1287           call find_segptr_branch;
1288           if code ^= 0 then go to SEGPTR_FAILURE;
1289 
1290 obj_status_join:
1291           if dirmode ^= "0"b then do;
1292                call get_dir_mode (dp, exmode, code);
1293                if code ^= 0 then call fatal_error;
1294                if (exmode & dirmode) ^= dirmode then do;
1295                     call dir_control_error$attributes (ep, code);
1296                     call fatal_error;
1297                end;
1298           end;
1299 
1300           call audit_success (ep);
1301 
1302           a_ep = ep;                                        /* Success! */
1303           a_code = code;
1304           return;
1305 %page;
1306 obj_status_read_uid: entry (a_uidpath, a_dirname, a_entryname, a_ep, a_code);
1307 
1308 /* Like obj_status_read/write but are given a uid path. */
1309 
1310 
1311           lock_for_writing = "0"b;
1312           dirmode = S_ACCESS;
1313           unspec (state) = "0"b;
1314           state.operation = access_operations_$fs_obj_prop_read;
1315           go to obj_status_uid_join;
1316 
1317 obj_status_read_priv_uid: entry (a_uidpath, a_dirname, a_entryname, a_ep, a_code);
1318 
1319           lock_for_writing = "0"b;
1320           dirmode = "0"b;
1321           unspec (state) = "0"b;
1322           state.operation = access_operations_$fs_obj_prop_read;
1323           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1324           go to obj_status_uid_join;
1325 
1326 obj_status_read_raw_uid: entry (a_uidpath, a_dirname, a_entryname, a_ep, a_code);
1327 
1328           lock_for_writing = "0"b;
1329           dirmode = "0"b;
1330           unspec (state) = "0"b;
1331           state.operation = access_operations_$fs_obj_prop_read;
1332           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1333           state.allow_searching_aim_isolated_dirs = "1"b;
1334 
1335 
1336 obj_status_uid_join:
1337           a_ep, ep = null;
1338           code = 0;
1339           uidpath = a_uidpath;
1340 
1341           call uid_path_util$find_entry;
1342           if code = error_table_$root then do;
1343                a_dirname = dirname;                         /* Return name so far */
1344                go to RETURN;
1345           end;
1346           if code = error_table_$bad_uidpath then do;
1347                if addr (state.event_flags) -> audit_event_flags.priv_op then
1348                     a_dirname = dirname;                    /* Return name so far if allowed */
1349                go to RETURN;
1350           end;
1351           if code ^= 0 then go to RETURN;
1352 
1353           if dirmode ^= "0"b then do;                       /* access required? */
1354                /*** need to check access to object's parent */
1355                call get_dir_mode (dp, exmode, code);
1356                if code ^= 0 then call fatal_error;
1357                if (exmode & dirmode) ^= dirmode then do;
1358                     /*** not enough on parent, check entry (a dir itself) */
1359                     call access_mode$effective (ep, mode, exmode, code);
1360                     if code ^= 0 then call fatal_error;
1361                     if exmode = "0"b then do;               /* any access would've been OK */
1362                          call dir_control_error$attributes (ep, code);
1363                          call fatal_error;
1364                     end;
1365                end;
1366           end;
1367 
1368           call audit_success (ep);
1369 
1370           a_dirname = dirname;
1371           a_entryname = entryname;
1372           a_ep = ep;
1373           a_code = code;
1374           return;
1375 %page;
1376 obj_delete_uid: entry (a_uidpath, a_dirname, a_entryname, a_ep, a_code);
1377 
1378           lock_for_writing = "1"b;
1379           dirmode = M_ACCESS;
1380           unspec (state) = "0"b;
1381           state.operation = access_operations_$fs_obj_delete;
1382           goto obj_delete_uid_join;
1383 
1384 obj_delete_priv_uid: entry (a_uidpath, a_dirname, a_entryname, a_ep, a_code);
1385 
1386           lock_for_writing = "1"b;
1387           dirmode = "0"b;
1388           unspec (state) = "0"b;
1389           state.operation = access_operations_$fs_obj_delete;
1390           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1391 
1392 
1393 obj_delete_uid_join:
1394           a_ep, ep = null;
1395           code = 0;
1396           uidpath = a_uidpath;
1397 
1398           call uid_path_util$find_entry;
1399           if code = error_table_$root then do;
1400                a_dirname = dirname;                         /* Return name so far */
1401                go to RETURN;
1402           end;
1403           if code = error_table_$bad_uidpath then do;
1404                if addr (state.event_flags) -> audit_event_flags.priv_op then
1405                     a_dirname = dirname;                    /* Return name so far if allowed */
1406                go to RETURN;
1407           end;
1408           if code ^= 0 then go to RETURN;
1409 
1410           if dirmode ^= "0"b then do;
1411                /*** need to check access to object's parent */
1412                call get_dir_mode (dp, exmode, code);
1413                if code ^= 0 then call fatal_error;
1414                if (exmode & dirmode) ^= dirmode then do;
1415                     call dir_control_error$attributes (ep, code);
1416                     call fatal_error;
1417                end;
1418           end;
1419 
1420           call audit_success (ep);
1421 
1422           a_dirname = dirname;
1423           a_entryname = entryname;
1424           a_ep = ep;
1425           a_code = code;
1426           return;
1427 %page;
1428 obj_truncate: entry (a_dirname, a_entryname, a_ep, a_code);
1429 
1430 /* Returns a ptr to a directory entry when we want to truncate the object at
1431 hand.  Truncate has its own peculiarities in auditing.  The main access check
1432 is "w" on the target.  The raw entries ask for raw "w" on the target, as
1433 opposed to no requirement at all. */
1434 
1435           call obj_name_setup;
1436           state.operation = access_operations_$fs_obj_contents_mod;
1437           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_TRUNCATE;
1438 
1439           lock_for_writing = "1"b;
1440           chase_sw = DC_FIND_CHASE;
1441 
1442           call find_;
1443           if code ^= 0 then go to RETURN;
1444 
1445           call access_mode$effective (ep, mode, exmode, code);
1446           if code ^= 0 then call fatal_error;
1447           go to obj_truncate_join;
1448 
1449 obj_truncate_ptr: entry (a_segptr, a_ep, a_code);
1450 
1451           call obj_ptr_setup;
1452           state.operation = access_operations_$fs_obj_contents_mod;
1453           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_TRUNCATE;
1454 
1455           lock_for_writing = "1"b;
1456           call find_segptr_branch;
1457           if code ^= 0 then go to SEGPTR_FAILURE;
1458 
1459           call fs_modes$locked (segptr, mode, exmode, ringbr, code);
1460           if code ^= 0 then call fatal_error;
1461           go to obj_truncate_join;
1462 
1463 obj_truncate_raw_ptr: entry (a_segptr, a_ep, a_code);
1464 
1465           call obj_ptr_setup;
1466           state.operation = access_operations_$fs_obj_contents_mod;
1467           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_TRUNCATE;
1468           addr (state.event_flags) -> audit_event_flags.priv_op = "1"b;
1469 
1470           lock_for_writing = "1"b;
1471           call find_segptr_branch;
1472           if code ^= 0 then go to SEGPTR_FAILURE;
1473 
1474           call access_mode$raw (ep, mode, exmode, code);
1475           if code ^= 0 then call fatal_error;
1476 
1477 obj_truncate_join:
1478           objmode = W_ACCESS;
1479           if (mode & objmode) ^= objmode then do;
1480                if ep -> entry.copysw then call dir_control_error$contents_info (ep, code); /* don't audit; user can make a copy to truncate */
1481                else call dir_control_error$contents (ep, code);
1482                if ep -> entry.dirsw then                    /* MSF? */
1483                     if code = error_table_$moderr then code = error_table_$dirseg;
1484                call fatal_error;
1485           end;
1486 
1487           call audit_success (ep);
1488 
1489           a_ep = ep;
1490           a_code = code;
1491           return;
1492 %page;
1493 obj_volume_retrieve: entry (a_dirname, a_entryname, a_audit_user_info_ptr, a_ep, a_code);
1494 
1495 /* Follows the unique access checks pertenant to the volume retriever. */
1496 
1497           call obj_name_setup;
1498           state.operation = access_operations_$fs_obj_contents_mod;
1499           addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_VOLUME_RETRIEVE;
1500 
1501           state.for_user = "1"b;
1502           state.user = a_audit_user_info_ptr -> audit_user_info;
1503 
1504           lock_for_writing = "0"b;
1505           chase_sw = DC_FIND_NO_CHASE;
1506 
1507           call find_;                                       /* modifying object contents, not entry */
1508           if code ^= 0 then go to RETURN;
1509 
1510           call access_mode$user_effmode (ep, state.user_id, state.authorization, (state.ring), mode, exmode, code);
1511           if code ^= 0 then call fatal_error;
1512           if ep -> entry.dirsw then do;
1513                mode = exmode;
1514                objmode = SM_ACCESS;
1515           end;
1516           else objmode = RW_ACCESS;
1517           if (mode & objmode) ^= objmode then do;           /* look at parent's mode */
1518                call sum$getbranch (dp, READ_LOCK, pep, code);
1519                if code ^= 0 then call fatal_error;
1520                pdp = ptr (pep, 0);
1521                state.parent_locked = "1"b;
1522 
1523                call access_mode$user_effmode (pep, state.user_id, state.authorization, (state.ring), mode, exmode, code);
1524                call lock$dir_unlock (pdp);                  /* done with parent */
1525                state.parent_locked = "0"b;
1526                if code ^= 0 then call fatal_error;
1527                if (exmode & SM_ACCESS) ^= SM_ACCESS then do;
1528                     call dir_control_error$contents (ep, code);
1529                     call fatal_error;
1530                end;
1531           end;
1532 
1533           call audit_success (ep);
1534 
1535           a_ep = ep;
1536           a_code = code;
1537           return;
1538 %page;
1539 seg_fault: entry (a_kstep, a_ep, a_code);
1540 
1541 /* Compute the sdw access fields and generate an error if the process has
1542 null authorization access to the segment.  This is used by seg_fault.
1543 The finding of the directory entry pointer is done in seg_fault so as to
1544 minimize the number of stack frames pushed when recursive seg faults are
1545 taken referencing the parent dir. */
1546 
1547           unspec (state) = "0"b;
1548           state.operation = access_operations_$fs_obj_contents_read;
1549 
1550           code = 0;
1551           kstep = a_kstep;
1552           ep = a_ep;
1553 
1554           if ep = null then do;
1555                code = error_table_$seg_deleted;
1556                call dir_control_error$name_non_existant (ptr (kstep -> kste.entryp, 0), code);
1557                go to RETURN;
1558           end;
1559 
1560           if ep -> entry.dirsw then go to RETURN;           /* dir access is special cased in seg_fault */
1561 
1562           if kstep -> kste.dtbm ^= ep -> entry.dtem then    /* entry change, recompute access */
1563                call update_kste_access (kstep, ep, mode);
1564           else mode = kstep -> kste.access;                 /* else kste mode is good (possibly from a previous fs_modes call) */
1565 
1566           if mode = "0"b then do;
1567                call dir_control_error$contents (ep, code);
1568                go to RETURN;
1569           end;
1570 
1571           call sdw_util_$dissect (addr (dseg$ (kstep -> kste.segno)), addr (sdwi)); /* Take it apart to set access */
1572 
1573           if (mode & W_ACCESS) then do;
1574                state.operation = access_operations_$fs_obj_contents_mod;
1575                addr (state.operation) -> encoded_access_op.detailed_operation = FS_OBJ_CONNECT;
1576           end;
1577 
1578           if mode ^= string (sdwi.access) |
1579                sdwi.r1 ^= ep -> entry.ring_brackets (1) |
1580                sdwi.r2 ^= ep -> entry.ring_brackets (2) |
1581                sdwi.r3 ^= ep -> entry.ring_brackets (3) then call audit_success (ep);
1582 
1583           sdwi.r1 = ep -> entry.ring_brackets (1);          /* Rings and access mode from the branch */
1584           sdwi.r2 = ep -> entry.ring_brackets (2);
1585           sdwi.r3 = ep -> entry.ring_brackets (3);
1586 
1587           string (sdwi.access) = substr (mode, 1, 4);
1588           if ^kstep -> kste.allow_write then sdwi.write = "0"b; /* Don't allow write access, no way */
1589 
1590           call sdw_util_$construct (addr (dseg$ (kstep -> kste.segno)), addr (sdwi)); /* Put it back together */
1591 
1592           a_code = code;
1593           return;
1594 %page;
1595 dir_name_setup: proc;
1596 
1597           unspec (state) = "0"b;
1598           a_dp, dp = null;
1599           code = 0;
1600           dirname = rtrim (a_dirname);
1601           return;
1602      end;
1603 
1604 fatal_error: proc;
1605 
1606           if state.parent_parent_locked then call lock$dir_unlock (ppdp);
1607           if state.parent_locked then call lock$dir_unlock (pdp);
1608           if state.dir_locked then call lock$dir_unlock (dp);
1609           if state.dir_held then call segno_usage$decrement (segno (dp), (0));
1610           go to RETURN;
1611      end fatal_error;
1612 
1613 obj_name_setup: proc;
1614 
1615           unspec (state) = "0"b;
1616           a_ep, ep = null;
1617           code = 0;
1618           dirname = rtrim (a_dirname);
1619           entryname = a_entryname;
1620           return;
1621      end;
1622 
1623 obj_ptr_setup: proc;
1624 
1625           unspec (state) = "0"b;
1626           a_ep, ep = null;
1627           code = 0;
1628           segptr = a_segptr;
1629           return;
1630      end;
1631 %page;
1632 SEGPTR_FAILURE:
1633           if code = error_table_$seg_deleted then do;
1634                call get_kstep (segno (segptr), kstep, code);
1635                if code = 0 then do;
1636                     state.operation = access_operations_$fs_obj_contents_read; /* audit failure as attempt to read names */
1637                     code = error_table_$seg_deleted;
1638                     call dir_control_error$name_non_existant (ptr (kstep -> kste.entryp, 0), code);
1639                end;
1640           end;
1641 
1642 RETURN:   a_code = code;
1643           return;
1644 %page;
1645 audit_success$msg: proc (a_ep, a_message);
1646 
1647 dcl  a_ep                               ptr parameter;
1648 dcl  a_message                          char (32) aligned parameter;
1649 
1650 dcl  audit                              bit (1) aligned;
1651 dcl  ep                                 ptr;
1652 dcl  message                            char (32);
1653 
1654           addr (state.event_flags) -> audit_event_flags.grant = "1"b;
1655           message = a_message;
1656           go to check_audit;
1657 
1658 audit_success: entry (a_ep);
1659 
1660           addr (state.event_flags) -> audit_event_flags.grant = "1"b;
1661 
1662 audit_failure: entry (a_ep);
1663 
1664           message = "";
1665 check_audit:
1666           ep = a_ep;
1667           if state.for_user then audit =
1668                     access_audit_check_ep_$user (state.event_flags, state.operation, ep, state.user.authorization, state.user.audit_flags);
1669           else audit =
1670                     access_audit_check_ep_$self (state.event_flags, state.operation, ep);
1671           if audit then
1672                if state.for_user then
1673                     call access_audit_$log_entry_ptr_user (ME, (state.ring), state.event_flags, state.operation, ep, code, null, 0, addr (state.user), message);
1674                else call access_audit_$log_entry_ptr (ME, level$get (), state.event_flags, state.operation, ep, code, null, 0, message);
1675           return;
1676      end;
1677 %page;
1678 dir_control_error: proc;
1679 
1680 /* Original version written by Kobziar (July 74) */
1681 
1682 dcl  a_dp                               ptr parameter;
1683 dcl  a_ep                               ptr parameter;
1684 dcl  a_code                             fixed bin (35) parameter;
1685 
1686 dcl  code                               fixed bin (35);
1687 dcl  dp                                 ptr;
1688 dcl  ep                                 ptr;
1689 dcl  exmode                             bit (36) aligned;
1690 dcl  info_only                          bit (1) aligned;    /* TRUE iff info entry called */
1691 dcl  locked                             bit (1) aligned;
1692 dcl  mode                               bit (36) aligned;
1693 dcl  original_code                      fixed bin (35);
1694 dcl  pep                                ptr;
1695 %page;
1696 dir_control_error$append: entry (a_ep, a_code);
1697 
1698 /* Used for appending into a dir.  The only access consideration is on the dir
1699 itself, since asking to append inside a dir is like asking for the names of
1700 objects in the dir; we can not let the user know of the existance of objects
1701 in a dir to which he has no access. */
1702 
1703           info_only = "0"b;
1704 
1705           ep = a_ep;                                        /* entry for dir being appended into */
1706           if ep = null then code = error_table_$incorrect_access; /* something wrong here */
1707           else do;
1708                call get_mode_on_entry (ep);
1709                if (exmode ^= N_ACCESS) then code = error_table_$incorrect_access; /* user has some access on dir,
1710                                                             hence can know of no access (=> not namedup) */
1711                else code = error_table_$no_info;            /* no access on dir */
1712           end;
1713           go to return_error_code;
1714 %page;
1715 dir_control_error$attributes_info: entry (a_ep, a_code);
1716           info_only = "1"b;
1717           go to attributes_entry;
1718 
1719 dir_control_error$attributes: entry (a_ep, a_code);
1720           info_only = "0"b;
1721 
1722 /* These entries are called when we had insufficient access to examine/change
1723 the attributes of an object. */
1724 
1725 attributes_entry:
1726           ep = a_ep;                                        /* copy entry pointer */
1727           if ep = null then code = error_table_$incorrect_access; /* if entry is the root */
1728           else do;
1729 
1730 /* Check access on parent */
1731 
1732                dp = ptr (ep, 0);                            /* get ptr to directory */
1733                call get_mode_on_dir (dp);
1734                if (exmode ^= N_ACCESS) then code = error_table_$incorrect_access; /* user has some access on parent but apparently not enough */
1735                else do;
1736                     if ep -> entry.bs = "1"b then do;
1737                          call get_mode_on_entry (ep);       /* access on entry allows user to see entry */
1738                          if code ^= 0 then go to return_error_code_no_audit;
1739 
1740                          if ep -> entry.dirsw then mode = exmode; /* if a directory, look at the extended access */
1741 
1742                          if mode ^= N_ACCESS then code = error_table_$incorrect_access; /* user has some access on object but not enough */
1743                          else code = error_table_$no_info;
1744                     end;
1745                     else code = error_table_$no_info;       /* link */
1746                end;
1747           end;
1748           go to return_error_code;
1749 %page;
1750 dir_control_error$contents_info: entry (a_ep, a_code);      /* Entry does not result in an auditing message */
1751           info_only = "1"b;
1752           go to contents_entry;
1753 
1754 dir_control_error$contents: entry (a_ep, a_code);
1755           info_only = "0"b;
1756 
1757 /* Entries called with an ep for an object whose contents in which we were
1758 interested. */
1759 
1760 contents_entry:
1761           ep = a_ep;                                        /* copy entry pointer */
1762           if rel (ep) = "0"b then code = error_table_$no_info; /* argument should always point to a directory entry */
1763           else if ep = null then code = error_table_$moderr;/* if entry represents the root */
1764           else if ep -> entry.bs = "0"b then code = error_table_$no_info; /* if passed a pointer to a link entry */
1765           else do;
1766 
1767 /* check access of entry */
1768 
1769                call get_mode_on_entry (ep);
1770                if code ^= 0 then go to return_error_code_no_audit;
1771 
1772                if ep -> entry.dirsw then mode = exmode;     /* if a directory, look at the extended access */
1773 
1774                if mode ^= N_ACCESS then code = error_table_$moderr; /* user has some access but not apparently what was needed */
1775                else do;
1776 
1777 /* otherwise look at access on parent */
1778 
1779                     dp = ptr (ep, 0);                       /* get ptr to directory */
1780                     call get_mode_on_dir (dp);
1781                     if (exmode ^= N_ACCESS) then code = error_table_$moderr; /* return moderr if user has non-null access on parent */
1782                     else code = error_table_$no_info;       /* return no_info if user has null access on parent */
1783                end;
1784           end;
1785           go to return_error_code;
1786 %page;
1787 dir_control_error$name_existant: entry (a_ep, a_code);
1788 
1789 /* This entry is called when a user tries to look up a name which isn't what's
1790 desired.  We have to see if the user is allowed to know this.  The argument is
1791 an entry ptr to the entry of the wrong type.  If the user is allowed to see
1792 the name non-existance, we return the input code.  Otherwise, we return
1793 no_info.
1794 
1795 Audit when user couldn't see object.  One reason for this is because we
1796 can't keep dirs from entering the address space and we want to audit attempts
1797 to try directory names.  */
1798 
1799           original_code = a_code;
1800           code = 0;                                         /* clear error code */
1801           ep = a_ep;
1802           dp = ptr (ep, 0);
1803           if ep = null then code = original_code;           /* root? */
1804           else do;
1805                call get_mode_on_dir (dp);
1806                if (exmode ^= N_ACCESS) then code = original_code; /* user has some access on dir */
1807                else do;
1808                     if ep -> entry.bs then do;              /* see if user has access (can see) object */
1809                          call get_mode_on_entry (ep);
1810                          if code ^= 0 then go to return_error_code_no_audit;
1811 
1812                          if ep -> entry.dirsw then mode = exmode;
1813                          if (mode ^= N_ACCESS) then code = original_code;
1814                          else code = error_table_$no_info;
1815                     end;
1816                     else code = error_table_$no_info;
1817                end;
1818           end;
1819           if code = error_table_$no_info then call audit_failure (ep);
1820           go to return_error_code_no_audit;
1821 %page;
1822 dir_control_error$name_non_existant: entry (a_dp, a_code);
1823 
1824 /* This entry is called when a user tries to look up a name which isn't found.
1825 We have to see if the user is allowed to know this.  The argument is a ptr
1826 to a directory in which the name wasn't found.  If the user is allowed to see
1827 the name non-existance, we return the input code.  Otherwise, we return
1828 no_info.
1829 
1830 Audit when user couldn't see object.  One reason for this is because we
1831 can't keep dirs from entering the address space and we want to audit attempts
1832 to try directory names.  */
1833 
1834           original_code = a_code;
1835           code = 0;                                         /* clear error code */
1836           dp = a_dp;
1837 
1838           locked = "0"b;
1839           pep = null;
1840           call sum$getbranch_root_my (dp, READ_LOCK, pep, code); /* needed for auditing */
1841           if code = 0 then locked = "1"b;
1842           else if code = error_table_$root | code = error_table_$mylock then ;
1843           else go to return_error_code_no_audit;
1844 
1845           call get_mode_on_entry (pep);
1846           if (exmode ^= N_ACCESS) then code = original_code;/* user has some access on dir */
1847           else code = error_table_$no_info;
1848 
1849           if code = error_table_$no_info then call audit_failure (pep);
1850 
1851           if locked then call lock$dir_unlock (ptr (pep, 0));
1852           go to return_error_code_no_audit;
1853 %page;
1854 dir_control_error$status: entry (a_ep, a_code);
1855 
1856 /* This entry is called when the user had non-null access on an object but did
1857 not have s permission on the parent.  It is only called when this circumstance
1858 causes us to return some, but not all, information the user requested.  In this
1859 case, we know what error to flag.  We simply audit and return
1860 no_s_permission. */
1861 
1862           info_only = "0"b;                                 /* For real */
1863           ep = a_ep;                                        /* copy argument */
1864           if ep = null then code = error_table_$incorrect_access; /* if entry is the root */
1865           else code = error_table_$no_s_permission;         /* branch - caller knows we have some access but not access on dir */
1866           go to return_error_code;
1867 %page;
1868 return_error_code:
1869           if ^info_only then                                /* If a real violation */
1870                call audit_failure (ep);
1871 
1872 return_error_code_no_audit:
1873           a_code = code;
1874           return;
1875 %page;
1876 get_mode_on_dir: proc (a_dp);
1877 
1878 dcl  a_dp                               ptr parameter;
1879 
1880 dcl  dp                                 ptr;
1881 dcl  locked                             bit (1) aligned;
1882 dcl  pdp                                ptr;
1883 dcl  pep                                ptr;
1884 
1885                dp = a_dp;
1886                if state.for_user then do;                   /* need to get pep to figure out access */
1887                     locked = "1"b;                          /* set lock indicator on */
1888                     call sum$getbranch_root_my (dp, READ_LOCK, pep, code); /* get pointer to parent directory */
1889                     if code ^= 0 then                       /* turn off lock indicator */
1890                          if code = error_table_$root | code = error_table_$mylock then do;
1891                               locked = "0"b;                /* if already locked by us */
1892                               code = 0;
1893                          end;
1894                          else go to return_error_code_no_audit;
1895 
1896                     pdp = ptr (pep, 0);                     /* get pointer to parent of parent */
1897                     call get_mode_on_entry (pep);           /* look at the access on parent directory */
1898                     if locked then call lock$dir_unlock (pdp);
1899                     if code ^= 0 then go to return_error_code_no_audit;
1900                end;
1901                else call get_dir_mode (dp, exmode, code);   /* easier to get mode for caller than someone else */
1902                return;
1903           end get_mode_on_dir;
1904 
1905 get_mode_on_entry: proc (a_ep);
1906 
1907 dcl  a_ep                               ptr parameter;
1908 
1909 dcl  ep                                 ptr;
1910 
1911                ep = a_ep;
1912                if state.for_user then call access_mode$user_effmode (ep, state.user_id, state.authorization, (state.ring), mode, exmode, code);
1913                else call access_mode$effective (ep, mode, exmode, code); /* get mode and extended mode of entry */
1914                return;
1915           end get_mode_on_entry;
1916      end dir_control_error;
1917 %page;
1918 find_: proc;
1919 
1920 /* Original version written by R. Bratt (October 1974). */
1921 
1922 /* This program returns a pointer to a directory entry in a specified
1923 directory.  It returns with the directory locked.  a_ep is non-null only for
1924 success; the code will be zero in this case.
1925 
1926 The append entries return a pointer to a locked directory in which and entry
1927 is to be appended.  These entries basically just ensure that the named object
1928 doesn't exist.
1929 */
1930 
1931 dcl  find_type                          bit (4) aligned;    /* type of object (or nothing) acceptable to find */
1932 dcl  links                              fixed bin;
1933 
1934           code = 0;
1935           ep, dp = null ();
1936           call setup ();
1937 
1938           if chase_sw = DC_FIND_NO_CHASE then do;
1939                call find_locked_dir;
1940                if code ^= 0 then call abort;
1941 
1942                call find_entry (dp, entryname, FIND_OBJECT_OR_LINK, ep, code);
1943                if code ^= 0 then call abort;
1944                return;
1945           end;
1946           else do;
1947                find_type = FIND_OBJECT_OR_LINK;
1948                call find_chasing_link;
1949                do links = 1 to active_all_rings_data$maxlinks while (code = error_table_$link);
1950                     call split_pathname ();
1951                     call find_chasing_link;
1952                end;
1953 
1954                if code = error_table_$link then code = error_table_$toomanylinks;
1955                if code ^= 0 then call abort;
1956                return;
1957           end;
1958 %page;
1959 find_$append: entry;
1960 
1961 /* This entry checks that the pathname supplied does not exist. */
1962 
1963           code = 0;
1964           dp = null ();
1965           call setup ();
1966 
1967           if chase_sw = DC_FIND_NO_CHASE then do;
1968                call find_locked_dir;
1969                if code ^= 0 then call abort;
1970 
1971                call find_entry (dp, entryname, FIND_NOTHING, ep, code);
1972                if code ^= 0 then call abort;
1973                return;
1974           end;
1975           else do;
1976 
1977 /* This entry makes sure that the final target doesn't exist.  It returns
1978 a pointer to the final target dir and the updated pathname of the link
1979 target. */
1980 
1981                find_type = FIND_LINK_OR_NOTHING;
1982                call find_chasing_link;
1983                do links = 1 to active_all_rings_data$maxlinks while (code = error_table_$link);
1984                     call split_pathname ();
1985                     call find_chasing_link;
1986                end;
1987 
1988                if code = error_table_$link then code = error_table_$toomanylinks;
1989                if code ^= 0 then call abort;
1990                return;
1991           end;
1992 %page;
1993 find_$link_target: entry;
1994 
1995 /* This entry finds the target of the specified link, whether existant or not.
1996 It returns this final path. */
1997 
1998           code = 0;
1999           ep, dp = null ();
2000           call setup ();
2001 
2002           find_type = FIND_ALL;
2003           call find_chasing_link;
2004           do links = 1 to active_all_rings_data$maxlinks while (code = error_table_$link);
2005                call split_pathname ();
2006                call find_chasing_link;
2007           end;
2008 
2009           if code = error_table_$link then code = error_table_$toomanylinks;
2010           if code ^= 0 then call abort;
2011           return;
2012 %page;
2013 find_chasing_link: proc;
2014 
2015                call find_locked_dir;
2016                if code ^= 0 then call abort;
2017 
2018                call find_entry (dp, entryname, find_type, ep, code);
2019                if code ^= 0 then call abort;
2020 
2021                if ep ^= null then
2022                     if ^ep -> entry.bs then do;             /* link */
2023                          dirname = substr (ep -> link.pathname, 1, ep -> link.pathname_size);
2024                          code = error_table_$link;
2025                          call lock$dir_unlock (dp);
2026                          state.dir_locked = "0"b;
2027                          call segno_usage$decrement (segno (dp), (0));
2028                          state.dir_held = "0"b;
2029                     end;
2030                return;
2031           end find_chasing_link;
2032 %page;
2033 setup:    proc;
2034                if entryname = "" then call split_pathname ();
2035                return;
2036           end setup;
2037 
2038 split_pathname: proc;
2039 
2040 dcl  ename_len                          fixed bin (17);
2041 dcl  path_len                           fixed bin (17);
2042 
2043                if dirname = ">" then do;
2044                     code = error_table_$root;
2045                     call abort;
2046                end;
2047                ename_len = index (reverse (dirname), ">") - 1;
2048                if ename_len < 1 then do;
2049                     code = error_table_$badpath;
2050                     call abort;
2051                end;
2052                if ename_len > 32 then do;
2053                     code = error_table_$entlong;
2054                     call abort;
2055                end;
2056                path_len = length (dirname) - ename_len - 1;
2057                entryname = substr (dirname, path_len + 2, ename_len);
2058                dirname = substr (dirname, 1, max (path_len, 1));
2059                return;
2060           end split_pathname;
2061 
2062 abort:    proc;
2063 
2064                if state.dir_locked then do;
2065                     call lock$dir_unlock (dp);
2066                     state.dir_locked = "0"b;
2067                end;
2068                if state.dir_held then do;
2069                     call segno_usage$decrement (segno (dp), (0));
2070                     state.dir_held = "0"b;
2071                end;
2072                go to non_local_return;
2073           end abort;
2074 
2075 non_local_return:
2076           return;
2077      end find_;
2078 %page;
2079 find_dir: proc;
2080 
2081 /* Original version (find_dirsegno) written by R. Bratt (September 1974) */
2082 
2083 /* find_dir resolves a directory pathname into a directory pointer.
2084    It initiates any directories which are in the path but unknown to the
2085    process.  On exit only the target directory is marked as in use.
2086 
2087 The operation of this program is as follows:
2088 
2089 We maintain the pathname of the directory we want to find (and initiate) in
2090 substr (work_pathname.string, 1, work_pathname.parent_len + work_pathname.son_len).
2091 
2092 We start by walking up the hierarchy from the last directory in the path
2093 looking for one whose segno is known.  This will either be because we find it
2094 in the PAM, or because we hit the root (which can be implicitly made known).
2095 The amount of the original pathname that we examing in this walk up is
2096 substr (work_pathname.string, 1, work_pathname.parent_len).
2097 
2098 When we find this segno, we can walk back down the hierarchy, making each
2099 subordinate directory known.  As we make a subordinate directory known, we free
2100 up its parent.  Eventually we find what we want.
2101 
2102 If we encounter a link, we substitute the portion of the pathname that this
2103 link is with the target path of the link.  We then restart the search given
2104 this new "expanded" pathname. */
2105 
2106 /* Based */
2107 
2108 dcl  parent_path                        char (work_pathname.parent_len) aligned based (addr (work_pathname.string)); /* based form of working path */
2109 dcl  parent_path_var                    char (work_pathname.parent_len) aligned var based (addr (work_pathname.parent_len));
2110 dcl  son_path                           char (work_pathname.son_len) based (addcharno (addr (work_pathname.string), work_pathname.parent_len));
2111                                                             /* This describes the characters after the parent path
2112                                                   (path that has been found).  This describes ">" || entryname of the next
2113                                                   dir (and any chars that follows). */
2114 dcl  1 work_pathname                    aligned based (state.work_pathname_ptr), /* work area for path expansion and name stripping (concealing) */
2115        2 parent_len                     fixed bin (21),     /* this field makes the characters that follow look like a var string
2116 - this is how many chars we are currently examining */
2117        2 string                         char (2048),        /* more than enough for... */
2118        2 son_len                        fixed bin (21);     /* number of chars in string following parent chars */
2119 
2120 /* Variables */
2121 
2122 dcl  authorization                      bit (72) aligned;
2123 dcl  entry                              char (32) aligned;
2124 dcl  entry_len                          fixed bin (21);
2125 dcl  ep                                 ptr;
2126 dcl  new_son_ptr                        ptr;                /* after relocation after link */
2127 dcl  numlinks                           fixed bin;
2128 dcl  old_son_ptr                        ptr;                /* to str of son */
2129 dcl  segnum                             fixed bin (17);     /* segno of directory currently held */
2130 dcl  son_segnum                         fixed bin (17);     /* new dir being made active */
2131 dcl  sub_path_len                       fixed bin (21);     /* after stripping an entryname */
2132 %page;
2133           code = 0;
2134 
2135 /* work_pathname is not kept as an automatic area to minimize stack frame
2136 size during certain ptr based calls.  We grow the stack frame big
2137 enough for work_pathname only when we need to. */
2138 
2139           if ^state.find_dir_has_work_area then do;
2140                state.work_pathname_ptr = wired_utility_$grow_stack_frame (size (work_pathname));
2141                state.find_dir_has_work_area = "1"b;
2142           end;
2143 
2144           if state.for_user then authorization = state.user.authorization;
2145           else authorization = pds$access_authorization;
2146 
2147           work_pathname.son_len = 0;
2148           work_pathname.parent_len = length (dirname);
2149           substr (work_pathname.string, 1, work_pathname.parent_len) = dirname;
2150 
2151           unspec (my_makeknown_info) = "0"b;
2152           my_makeknown_info.activate, my_makeknown_info.dirsw, my_makeknown_info.allow_write = "1"b;
2153           numlinks = 0;
2154 
2155 Find_dir: call pathname_am$get_segno (parent_path_var, segnum);
2156           if segnum > -1 then do;                           /* found in PAM */
2157 
2158 /* See if this dir (=> any dir in path) aim isolated.  Normally, we would say
2159 that it couldn't be to have made it into the PAM on a previous pass.  But,
2160 real or simulated dir priv in the past could have brought it into our space.
2161 We don't want to allow accessing it any more unless privs are still on. */
2162 
2163                dp = baseptr (segnum);
2164                state.dir_held = "1"b;
2165                if /* tree */ ^read_allowed_ (authorization, dp -> dir.access_class) then
2166                     if ^addr (authorization) -> aim_template.privileges.dir then /* user lacks dir priv */
2167                          if ^(state.allow_searching_aim_isolated_dirs | state.allow_aim_isolated_final_dir) then do;
2168                               state.operation = access_operations_$fs_obj_contents_read;
2169                               call sum$getbranch (dp, READ_LOCK, pep, code);
2170                               if code ^= 0 then go to abort;
2171                               pdp = ptr (pep, 0);
2172                               call dir_control_error$attributes (pep, code);
2173                               call lock$dir_unlock (pdp);
2174                               go to abort;
2175                          end;
2176 
2177                go to find_dir_return;
2178           end;
2179 
2180           if parent_path_var = ">" then do;
2181                call activate_root;
2182                dp = baseptr (segnum);
2183                state.dir_held = "1"b;
2184                go to find_dir_return;                       /* Everyone can see root */
2185           end;
2186 
2187 /* We must split the pathname and start walking up the hierarchy, until we
2188 find a PAM match or hit the root. */
2189 
2190           do while (segnum < 0);                            /* walk down until we find the segno for some dir in path */
2191 
2192 /* Adjust working_length to split off entryname */
2193 
2194                sub_path_len = work_pathname.parent_len - index (reverse (parent_path), ">");
2195                if sub_path_len = 0 then ;                   /* directory right off root */
2196                else if sub_path_len >= work_pathname.parent_len - 1 then do;
2197                     code = error_table_$badpath;            /* no ">" or last char is ">" */
2198                     go to abort;
2199                end;
2200                work_pathname.son_len = work_pathname.son_len + (work_pathname.parent_len - sub_path_len); /* add last entryname found to son half of string */
2201                work_pathname.parent_len = sub_path_len;
2202 
2203 /* Try to find dir */
2204 
2205                if work_pathname.parent_len = 0 then call activate_root; /* root */
2206                else call pathname_am$get_segno (parent_path_var, segnum); /* marks segno as held if segno returned */
2207           end;
2208           dp = baseptr (segnum);
2209           state.dir_held = "1"b;
2210 
2211 /* Now we walk back down the hierarchy, finding the sub-ordinate dirs to the
2212 one found above. */
2213 
2214           do while (work_pathname.son_len > 0);
2215                entry_len = index (substr (son_path, 2), ">"); /* add the next entry back to the parent half of string */
2216                if entry_len = 0 then entry_len = work_pathname.son_len - 1; /* last entryname in path */
2217                else entry_len = entry_len - 1;              /* remove ">" */
2218                if entry_len > 32 then do;
2219                     code = error_table_$entlong;
2220                     go to abort;
2221                end;
2222                entry = substr (son_path, 2, entry_len);
2223                work_pathname.son_len = work_pathname.son_len - (entry_len + 1);
2224                work_pathname.parent_len = work_pathname.parent_len + (entry_len + 1); /* add in entryname we're about to find */
2225 
2226                call lock$dir_lock_read (dp, code);
2227                if code ^= 0 then go to abort;
2228                state.dir_locked = "1"b;
2229 
2230                call find_entry (dp, entry, FIND_DIR_OR_LINK, ep, code);
2231                if code ^= 0 then go to abort;
2232 
2233                if ^ep -> entry.bs then do;                  /* link */
2234 
2235 /* We substitute the pathname resolved so far with the link pathname and start
2236 all over. */
2237 
2238                     numlinks = numlinks + 1;
2239                     if ep -> link.pathname_size + work_pathname.son_len > length (work_pathname.string) |
2240                          numlinks > active_all_rings_data$maxlinks then do;
2241                          code = error_table_$toomanylinks;
2242                          go to abort;
2243                     end;
2244                     old_son_ptr = addcharno (addr (work_pathname.string), work_pathname.parent_len); /* move son portion down */
2245                     new_son_ptr = addr (work_pathname.string); /* avoid compiler bug */
2246                     new_son_ptr = addcharno (new_son_ptr, ep -> link.pathname_size);
2247                     if work_pathname.parent_len < ep -> link.pathname_size then
2248                          call mrl_ (old_son_ptr, work_pathname.son_len, new_son_ptr, work_pathname.son_len); /* moving to the right */
2249                     else call mlr_ (old_son_ptr, work_pathname.son_len, new_son_ptr, work_pathname.son_len); /* moving to the left */
2250                     substr (work_pathname.string, 1, ep -> link.pathname_size) = substr (ep -> link.pathname, 1, ep -> link.pathname_size); /* insert link as new parent */
2251                     work_pathname.parent_len = work_pathname.son_len + ep -> link.pathname_size; /* make whole string parent, start over */
2252                     work_pathname.son_len = 0;
2253                     dirname = parent_path;                  /* update dirname, disregard truncation */
2254                     call lock$dir_unlock (dp);              /* release dir holding link */
2255                     state.dir_locked = "0"b;
2256                     call segno_usage$decrement (segnum, (0));
2257                     state.dir_held = "0"b;
2258                     go to Find_dir;                         /* must start from scratch */
2259                end;
2260 
2261                if /* tree */ ^read_allowed_ (authorization, ep -> entry.access_class) then /* dir aim protected */
2262                     if ^addr (authorization) -> aim_template.privileges.dir then /* user lacks dir priv */
2263                          if ^state.allow_searching_aim_isolated_dirs then
2264                               if ^(work_pathname.son_len = 0 & state.allow_aim_isolated_final_dir) then do;
2265                                    state.operation = access_operations_$fs_obj_contents_read;
2266                                    call dir_control_error$attributes (ep, code);
2267                                    go to abort;
2268                               end;
2269 
2270                my_makeknown_info.entryp = ep;
2271                my_makeknown_info.uid = ep -> entry.uid;
2272                call makeknown_ (addr (my_makeknown_info), son_segnum, (0), code);
2273                if code ^= 0 then
2274                     if code ^= error_table_$segknown then go to abort;
2275                call lock$dir_unlock (dp);                   /* dir is locked during makeknown_ activate call */
2276                state.dir_locked = "0"b;
2277                call segno_usage$decrement (segnum, (0));    /* parent will be held by son */
2278                segnum = son_segnum;                         /* makeknown made dir held */
2279                dp = baseptr (segnum);
2280                call pathname_am$set (parent_path_var, segnum); /* remember this after all we had to do to find it */
2281           end;
2282 
2283 find_dir_return:
2284           code = 0;
2285           return;
2286 
2287 abort:    if state.dir_locked then do;
2288                call lock$dir_unlock (dp);
2289                state.dir_locked = "0"b;
2290           end;
2291           if state.dir_held then do;
2292                call segno_usage$decrement (segnum, (0));
2293                state.dir_held = "0"b;
2294           end;
2295           return;
2296 
2297 activate_root: proc;
2298 
2299                my_makeknown_info.uid = "777777777777"b3;
2300                my_makeknown_info.entryp = null;
2301                call makeknown_ (addr (my_makeknown_info), segnum, (0), code); /* marks segno as held */
2302                if code ^= 0 then
2303                     if code ^= error_table_$segknown then go to abort;
2304                return;
2305           end activate_root;
2306      end find_dir;
2307 %page;
2308 find_entry: proc (a_dp, a_ename, a_type, a_ep, a_code);
2309 
2310 /* Original version written by R. Bratt (September 1974) */
2311 
2312 /* find_entry provides entries for finding a directory entry of
2313    a certain type given the segment number of the parent directory and
2314    the name of the desired entry (and its desired type).  Code will be zero
2315    only if an object of the desired type was found.  ep will be non-null
2316    only if the found object is existant. */
2317 
2318 dcl  a_code                             fixed bin (35) parameter;
2319 dcl  a_dp                               ptr parameter;
2320 dcl  a_ename                            char (32) aligned parameter;
2321 dcl  a_ep                               ptr parameter;
2322 dcl  a_type                             bit (4) aligned parameter;
2323 
2324 dcl  authorization                      bit (72) aligned;
2325 dcl  code                               fixed bin (35);
2326 dcl  dp                                 ptr;
2327 dcl  ep                                 ptr;
2328 dcl  type                               bit (4) aligned;
2329 %page;
2330           a_code = 0;
2331           a_ep = null;
2332           dp = a_dp;
2333           type = a_type;
2334 
2335           if state.for_user then authorization = state.user.authorization;
2336           else authorization = pds$access_authorization;
2337 
2338           call hash$search (dp, addr (a_ename), ep, code);
2339           if code ^= 0 then do;
2340                if code ^= error_table_$noentry then go to abort;
2341                if (type & FIND_NOTHING) then do;
2342                     code = 0;                               /* user got what he wanted */
2343                     return;
2344                end;
2345                if (type & FIND_SEG) then code = error_table_$noentry; /* if we'd accept a seg, we'd accept anything */
2346                else if (type & FIND_DIR) then code = error_table_$no_dir; /* only a dir or link will do */
2347                else code = error_table_$not_link;           /* only link would do */
2348                state.operation = access_operations_$fs_obj_contents_read; /* audit failure as attempt to read names */
2349                call dir_control_error$name_non_existant (dp, code);
2350                go to abort;
2351           end;
2352 
2353 /* Found name; make some checks on what's found */
2354 
2355           if ep -> entry.bs then do;
2356                if (ep -> entry.dirsw & (ep -> entry.type ^= DIR_TYPE))
2357                     | (^ep -> entry.dirsw & (ep -> entry.type ^= SEG_TYPE))
2358                     | ep -> entry.owner ^= dp -> dir.uid then signal bad_dir_;
2359                if ep -> entry.security_oosw & ^addr (authorization) -> privileges.soos then do;
2360                     state.operation = access_operations_$fs_obj_prop_read;
2361                     call dir_control_error$attributes_info (ep, code);
2362                     if code = error_table_$incorrect_access then code = error_table_$oosw;
2363                     go to abort;
2364                end;
2365                if /* tree */ ep -> entry.dirsw then
2366                     if (type & FIND_DIR) = "0"b then
2367                          if (type & FIND_NOTHING) then code = error_table_$namedup;
2368                          else if (type & FIND_SEG) then code = error_table_$dirseg;
2369                               else code = error_table_$not_link; /* only choice left */
2370                     else ;
2371                else if (type & FIND_SEG) = "0"b then
2372                          if (type & FIND_NOTHING) then code = error_table_$namedup;
2373                          else if (type & FIND_DIR) then code = error_table_$notadir;
2374                               else code = error_table_$not_link; /* only choice left */
2375                     else ;
2376           end;
2377           else do;                                          /* link */
2378                if ep -> link.type ^= LINK_TYPE | ep -> link.owner ^= dp -> dir.uid then signal bad_dir_;
2379                if (type & FIND_LINK) = "0"b then
2380                     if (type & FIND_NOTHING) then code = error_table_$namedup;
2381                     else code = error_table_$link;
2382           end;
2383           if code ^= 0 then do;
2384                state.operation = access_operations_$fs_obj_prop_read; /* audit failure as attempt to read names */
2385                call dir_control_error$name_existant (ep, code);
2386                go to abort;
2387           end;
2388 
2389           a_ep = ep;
2390           return;
2391 
2392 abort:    a_code = code;
2393           return;
2394      end find_entry;
2395 %page;
2396 find_locked_dir: proc;
2397 
2398           call find_dir;                                    /* this makes dir_held */
2399           if code ^= 0 then return;
2400 
2401           if lock_for_writing then call lock$dir_lock_write (dp, code);
2402           else call lock$dir_lock_read (dp, code);
2403           if code ^= 0 then do;
2404                call segno_usage$decrement (segno (dp), (0));
2405                state.dir_held = "0"b;
2406                return;
2407           end;
2408           state.dir_locked = "1"b;
2409           return;
2410      end;
2411 %page;
2412 find_segptr_branch: proc;
2413 
2414           call sum$getbranch (segptr, lock_for_writing, ep, code);
2415           if code ^= 0 then return;
2416           dp = ptr (ep, 0);
2417           state.dir_locked = "1"b;
2418           return;
2419      end;
2420 %page;
2421 get_dir_mode: proc (a_segptr, a_mode, a_code);
2422 
2423 /* Find the effective access to the dir, ignoring everything else. */
2424 
2425 dcl  a_code                             fixed bin (35) parameter;
2426 dcl  a_mode                             bit (36) aligned parameter;
2427 dcl  a_segptr                           ptr parameter;
2428 
2429 dcl  code                               fixed bin (35);
2430 dcl  dp                                 ptr;
2431 dcl  ep                                 ptr;
2432 dcl  kstep                              ptr;
2433 dcl  lock_sw                            bit (1) aligned;
2434 dcl  mode                               bit (36) aligned;
2435 dcl  need_to_lock                       bit (1) aligned;
2436 dcl  rb                                 (3) fixed bin (3);
2437 dcl  ring                               fixed bin (3);
2438 dcl  segptr                             ptr;
2439 
2440           need_to_lock = "1"b;
2441           go to join;
2442 
2443 get_dir_mode$locked: entry (a_segptr, a_mode, a_code);
2444 
2445 /* Entry to use when parent directory of object that segptr indicates is
2446 locked. */
2447 
2448           need_to_lock = "0"b;
2449 
2450 join:     a_mode = "0"b;
2451           segptr = a_segptr;
2452 
2453           mode = N_ACCESS;
2454           call get_kstep (segno (segptr), kstep, code);     /* get kst entry ptr for this seg */
2455           if code ^= 0 then go to abort;
2456 
2457           if kstep -> kste.uid = (36)"1"b then do;          /* special case the root */
2458                lock_sw = "0"b;
2459                dp, ep = null;                               /* get access to root */
2460                if kstep -> kste.dtbm = (36)"1"b then call update_kste_access (kstep, ep, mode);
2461                mode = kstep -> kste.extended_access;        /* pick up directory access */
2462                rb (1), rb (2), rb (3) = 7;
2463           end;
2464           else do;
2465                lock_sw = "0"b;
2466 
2467 /* lock parent and  get pointer to entry */
2468                if need_to_lock then do;
2469                     call sum$getbranch_root_my (segptr, READ_LOCK, ep, code);
2470                     if code = 0 then lock_sw = "1"b;
2471                     else if code = error_table_$mylock then code = 0;
2472                     else go to abort;
2473                end;
2474                else ep = kstep -> kste.entryp;              /* kste entryp good if dir locked */
2475 
2476                dp = ptr (ep, 0);                            /* get pointer to parent directory */
2477                if kstep -> kste.dtbm ^= ep -> entry.dtem then call update_kste_access (kstep, ep, mode);
2478                mode = kstep -> kste.extended_access;
2479                rb (*) = binary (kstep -> kste.ex_rb (*), 3);/* factor in extended ring brackets */
2480                ring = level$get ();
2481                if ring <= rb (1) then ;
2482                else if ring <= rb (2) then mode = mode & S_ACCESS;
2483                else mode = N_ACCESS;
2484           end;
2485 
2486           if lock_sw then call lock$dir_unlock (dp);
2487           a_mode = mode;
2488 
2489 abort:    a_code = code;
2490           return;
2491      end get_dir_mode;
2492 %page;
2493 uid_path_util: proc;
2494 
2495 /* Original version written March 1975 by Larry Johnson */
2496 
2497 /* Variables */
2498 
2499 dcl  authorization                      bit (72) aligned;
2500 dcl  current_depth                      fixed bin;
2501 dcl  entrysw                            bit (1) aligned;
2502 dcl  max_depth                          fixed bin;
2503 dcl  segnum                             fixed bin;
2504 dcl  son_segnum                         fixed bin;
2505 
2506 uid_path_util$find_entry: entry;
2507           entrysw = "1"b;
2508           go to join;
2509 
2510 uid_path_util$find_dir: entry;
2511           entrysw = "0"b;
2512 
2513 join:     ep, dp = null;
2514           dirname = "";
2515           entryname = "";
2516           code = 0;
2517 
2518           if state.for_user then authorization = state.user.authorization;
2519           else authorization = pds$access_authorization;
2520 
2521           if uidpath (0) ^= "777777777777"b3 then do;       /* All paths must start with root */
2522                code = error_table_$bad_uidpath;
2523                go to RETURN;
2524           end;
2525           do max_depth = 1 to 15 while (uidpath (max_depth));
2526           end;
2527           max_depth = max_depth - 1;
2528           if max_depth = 0 then do;
2529                code = error_table_$root;
2530                dirname = ">";
2531                go to RETURN;
2532           end;
2533 
2534           unspec (my_makeknown_info) = "0"b;
2535           my_makeknown_info.dirsw, my_makeknown_info.allow_write,
2536                my_makeknown_info.priv_init, my_makeknown_info.activate = "1"b;
2537 
2538           my_makeknown_info.entryp = null;                  /* Start with root */
2539           my_makeknown_info.uid = "777777777777"b3;
2540           call makeknown_ (addr (my_makeknown_info), segnum, (0), code);
2541           if code ^= 0 then
2542                if code ^= error_table_$segknown then go to abort;
2543           state.dir_held = "1"b;
2544           dp = baseptr (segnum);
2545 
2546           if entrysw then max_depth = max_depth - 1;
2547           if max_depth = 0 then dirname = ">";
2548           else dirname = "";
2549           do current_depth = 1 to max_depth;                /* Step down path */
2550                call find_uid (uidpath (current_depth), READ_LOCK);
2551 
2552                dirname = dirname || ">";
2553                dirname = dirname || rtrim (entryname);
2554 
2555                if /* tree */ ^read_allowed_ (authorization, ep -> entry.access_class) then /* dir aim protected */
2556                     if ^addr (authorization) -> aim_template.privileges.dir then /* user lacks dir priv */
2557                          if ^state.allow_searching_aim_isolated_dirs then
2558                               if ^(current_depth = max_depth & state.allow_aim_isolated_final_dir) then do;
2559                                    state.operation = access_operations_$fs_obj_contents_read;
2560                                    call dir_control_error$attributes (ep, code);
2561                                    go to abort;
2562                               end;
2563 
2564                my_makeknown_info.uid = uidpath (current_depth);
2565                my_makeknown_info.entryp = ep;
2566                call makeknown_ (addr (my_makeknown_info), son_segnum, (0), code);
2567                if code ^= 0 then
2568                     if code ^= error_table_$segknown then go to abort;
2569                call lock$dir_unlock (dp);                   /* dir is kept locked during makeknown_ activate call */
2570                state.dir_locked = "0"b;
2571                call segno_usage$decrement (segnum, (0));    /* son will hold parent */
2572                segnum = son_segnum;
2573                dp = baseptr (segnum);
2574           end;
2575 
2576           if entrysw then call find_uid (uidpath (max_depth + 1), lock_for_writing);
2577 
2578           code = 0;
2579           return;
2580 
2581 abort:    if state.dir_locked then do;
2582                call lock$dir_unlock (dp);
2583                state.dir_locked = "0"b;
2584           end;
2585           if state.dir_held then do;
2586                call segno_usage$decrement (segno (dp), (0));
2587                state.dir_held = "0"b;
2588           end;
2589 RETURN:   return;
2590 %page;
2591 find_uid: proc (a_uid, a_typelock);
2592 
2593 dcl  a_typelock                         bit (36) aligned parameter;
2594 dcl  a_uid                              bit (36) aligned parameter;
2595 
2596 dcl  ecount                             fixed bin;
2597 dcl  nnp                                ptr;
2598 dcl  num_entries_in_dir                 fixed bin;
2599 dcl  uid                                bit (36) aligned;
2600 
2601                uid = a_uid;
2602 
2603                if a_typelock then call lock$dir_lock_write (dp, code);
2604                else call lock$dir_lock_read (dp, code);
2605                if code ^= 0 then go to abort;
2606                state.dir_locked = "1"b;
2607 
2608                num_entries_in_dir = dp -> dir.seg_count + dp -> dir.dir_count + dp -> dir.lcount;
2609                ecount = 0;
2610                do ep = ptr (dp, dp -> dir.entryfrp) repeat (ptr (dp, ep -> entry.efrp)) while (rel (ep));
2611                     ecount = ecount + 1;
2612                     if ecount > num_entries_in_dir then signal bad_dir_;
2613                     if ep -> entry.bs then
2614                          if ep -> entry.owner ^= dp -> dir.uid then signal bad_dir_;
2615                          else if ep -> entry.type ^= SEG_TYPE & ep -> entry.type ^= DIR_TYPE then signal bad_dir_;
2616                          else ;
2617                     else if ep -> link.owner ^= dp -> dir.uid then signal bad_dir_;
2618                     else if ep -> link.type ^= LINK_TYPE then signal bad_dir_;
2619                     if ep -> entry.uid = uid then
2620                          if ep -> entry.bs & ep -> entry.dirsw then do; /* Must be dir branch */
2621                               nnp = addr (ep -> entry.primary_name);
2622                               if nnp -> names.owner ^= ep -> entry.uid
2623                                    | nnp -> names.type ^= NAME_TYPE
2624                                    | nnp -> names.entry_rp ^= rel (ep) then signal bad_dir_;
2625                               entryname = nnp -> names.name;
2626                               return;
2627                          end;
2628                          else go to not_found;
2629                end;
2630 
2631 not_found:     code = error_table_$bad_uidpath;
2632                go to abort;
2633           end find_uid;
2634      end uid_path_util;
2635 %page; %include access_audit_encoded_op;
2636 %page; %include access_audit_eventflags;
2637 %page; %include access_audit_user_info;
2638 %page; %include access_mode_values;
2639 %page; %include aim_template;
2640 %page; %include dc_find_dcls;
2641 %page; %include dir_entry;
2642 %page; %include dir_header;
2643 %page; %include dir_link;
2644 %page; %include dir_name;
2645 %page; %include fs_obj_access_codes;
2646 %page; %include fs_types;
2647 %page; %include its;
2648 %page; %include kst;
2649 %page; %include makeknown_info;
2650 %page; %include sdw_info;
2651      end dc_find;