1 /****^  **************************************************************
   2         *                                                            *
   3         * Copyright, (C) Massachusetts Institute of Technology, 1983 *
   4         *                                                            *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982    *
   6         *                                                            *
   7         * Copyright (c) 1972 by Massachusetts Institute of           *
   8         * Technology and Honeywell Information Systems, Inc.         *
   9         *                                                            *
  10         ************************************************************** */
  11 
  12 
  13 
  14 /* format: style2 */
  15 
  16 status_:
  17      proc (a_dir_name, a_entryname, a_chase, a_return_struc_ptr, a_return_area_ptr, a_code);
  18 
  19 /* STATUS returns the contents of a specified entry
  20    in a directory.
  21    dir_name = path name of directory (input)
  22    entry = name of the entry to be listed (input)
  23    chase = a switch when =1 means list the branch pointed to by "entry" (input)
  24    type = indicates whether "entry" (output) is a non-dir branch (=1),
  25    dir branch (=2), or a link (=0)
  26    return_struc_ptr = the pointer to the structure in which items from "entry" will be returned
  27    status_area_ptr = pointer to an area in which the names will be returned
  28    if it is null, no names will be returned. */
  29 
  30 
  31 /* ************************************************************************** */
  32 /* ************************************************************************** */
  33 /* ************************************************************************** */
  34 /*
  35    *
  36    *    NN    NN   OOOOOO   TTTTTTTT  EEEEEEEE
  37    *    NNN   NN  OO    OO     TT     EE
  38    *    NN N  NN  OO    OO     TT     EE
  39    *    NN NN NN  OO    OO     TT     EEEEEEE
  40    *    NN  N NN  OO    OO     TT     EE
  41    *    NN  NNNN  OO    OO     TT     EE
  42    *    NN   NNN  OO    OO     TT     EE
  43    *    NN    NN   OOOOOO      TT     EEEEEEEE
  44    *
  45    *    The variable status_call MUST be set in any entry to this program
  46    *    before any calls to fatal_error, or the establishment of any
  47    *    cleanup handler. It should be set to zero for attributes, and
  48    *    other values for status info. Only status_ and status_long_
  49    *    should set values other than 0 and 3.
  50    *
  51    /**************************************************************************** */
  52 /* *************************************************************************** */
  53 /* *************************************************************************** */
  54 
  55 
  56 /****^  HISTORY COMMENTS:
  57   1) change(85-10-31,Lippard), approve(86-06-02,MCR7427),
  58      audit(86-06-17,Farley), install(86-06-17,MR12.0-1077):
  59       Modified to zero out status_branch structures before calling dc_find
  60       so that status_link.pathname_length is zeroed when user doesn't have
  61       status permission on the containing directory.
  62   2) change(86-05-20,Lippard), approve(86-06-02,MCR7427),
  63      audit(86-06-17,Farley), install(86-06-17,MR12.0-1077):
  64       Modified to not set status_branch.nnames if user doesn't have status
  65       permission, change status_for_backup to not return bogus information.
  66   3) change(86-07-03,Farley), approve(86-07-03,MCR7427),
  67      audit(86-07-03,Fawcett), install(86-07-07,MR12.0-1086):
  68      This change is a PBF to installation 1077. The effective mode was being
  69      returned one bit position off.
  70                                                    END HISTORY COMMENTS */
  71 
  72 /* Modified 1985-05-08, EJ Sharpe: added get_mdir_status_priv, made get_mdir_status non-privileged,
  73           changed get_mdir_status_uid to get_mdir_status_uid_priv */
  74 /* Modified 1985-04-19, BIM: include parent access class in entry_access_info */
  75 /* Modified 04/08/85 by Keith Loepere to use fs_modes when possible (gets priv init right). */
  76 /* Modified 03/25/85 by M. Pandolf to add get_access_(info info_seg) entries */
  77 /* Modified 02/21/85 by E. Swenson to add get_user_access_modes_seg entry */
  78 /* Modified 10/19/84 by Keith Loepere to properly copy status_for_backup. */
  79 /* Modified 9/25/84 by EJ Sharpe for new entry get_user_raw_mode */
  80 /* Modified 6/14/84 Keith Loepere to use the new dc_find */
  81 /* Modified 1/84 BIM for 18 bit quota values */
  82 /* Modified 6/9/83 Jay Pattin to not require status permission in get_author, get_bc_author, and status_for_backup */
  83 /* Modified 830427 BIM to set dp in the root case. */
  84 /* Modified 2/26/83 Jay Pattin to add get_uid_file */
  85 /* Modified 1/3/83 Jay Pattin to add get_user_access_modes */
  86 /* Modified 2/83, BIM, to stop zeroing the version in status_for_backup  and fix Harcore 519. */
  87 /* Modified September 1982, J. Bongiovanni, for synchronized switch, init bug */
  88 /* Modified 3/82, BIM: (1) stop using sfs, (2) get_user_exmode,
  89    (3) overall cleanup, (4) general branch entrypoint.
  90    /* Modified 06/08/81, WOS: (1) Accept default of -1 for ring number in get_user_effmode,
  91    (2): Return documented directory mode values in get_user_effmode (turn off "e" bit)
  92    (3): Return access without regard to dir_name access if requested username
  93    is that of calling process, in get_user_effmode. */
  94 /* Modified 11/26/80 W. Olin Sibert to fail when returning names in wrong component of extensible area */
  95 /* Modified 10/79 by Mike Grady to set ptrs and counts before getting space in system
  96    free seg for names and such. Bug found by GDixon. */
  97 /* Modified 9 Feb 79 by D. Spector to allow call to access_mode$user return an
  98    error code (status_$get_user_effmode) */
  99 /* Modified 11/15/78 by C. D. Tavares to use status_structures.incl.pl1 */
 100 /* Modified July 1977 by THVV for Bratt's MCR 2364 to return all but names in no_s_permission case */
 101 /* Modified 07/77 by THVV for bad_dir_ check */
 102 /* Modified July 1976 by R. Bratt to return uid in partial info case */
 103 /* Modified June 1976 by R. Bratt to call find_$finished */
 104 /* Modified April 1976 by R. Bratt to check mountedness and return partial info */
 105 /* Modified March 1976 by Larry Johnson for master_dir status entries */
 106 /* Modified March 1976 by R. Bratt for tpd */
 107 /* 11/17/75 RE Mullen: status_for_backup to ret UID's and master_dir */
 108 /* 9/25/75 RE Mullen: remove obsolete seg_activity and backup_branch_info entrypoints */
 109 /* 9/25/75 RE Mullen: status_for_backup to not go to vtoc for maxlength */
 110 /* Modified for NSS 4/75 by THVV */
 111 
 112           dcl     a_access_class         bit (72) aligned parameter;
 113           dcl     a_auth                 char (*) parameter;
 114           dcl     a_bkptr                ptr parameter;
 115           dcl     a_bitcnt               fixed bin (24) parameter;
 116           dcl     a_chase                fixed bin (1) parameter;
 117           dcl     a_code                 fixed bin (35) parameter;
 118           dcl     a_dates                (*) bit (36) parameter;
 119           dcl     a_dir_name             char (*) parameter;
 120           dcl     a_entryname            char (*) parameter;
 121           dcl     a_ex_modes             bit (36) aligned parameter;
 122           dcl     a_max_length           fixed bin (19) parameter;
 123           dcl     a_mode                 fixed bin (5) parameter;
 124           dcl     a_modes                bit (36) aligned parameter;
 125                                                             /* note difference in dcl */
 126           dcl     a_ncd                  fixed bin parameter;
 127           dcl     a_nid                  fixed bin parameter;
 128           dcl     a_quota                fixed bin (18) parameter;
 129           dcl     a_return_area_ptr      ptr parameter;
 130           dcl     a_return_struc_ptr     ptr parameter;
 131           dcl     a_ring                 fixed bin parameter;
 132           dcl     a_safety_sw            bit (1) parameter;
 133           dcl     a_seg_usage            fixed bin (35) parameter;
 134           dcl     a_segptr               ptr parameter;
 135           dcl     a_type                 fixed bin (2) parameter;
 136           dcl     a_uidpath              (0:15) bit (36) aligned parameter;
 137           dcl     a_user                 char (*) parameter;
 138           dcl     a_voluid               bit (36) aligned parameter;
 139 
 140 /* VARIABLES */
 141 
 142           dcl     access_class           bit (72) aligned;
 143           dcl     auth                   char (32) aligned;
 144           dcl     bitcnt                 fixed bin (24);
 145           dcl     bkptr                  ptr;
 146           dcl     1 bks                  aligned like status_for_backup;
 147           dcl     called_find            bit (1) aligned init ("0"b);
 148           dcl     chase                  fixed bin (1);
 149           dcl     code                   fixed bin (35);
 150           dcl     cur_length             fixed bin (35);
 151           dcl     dates                  (5) bit (36);
 152           dcl     dir_name               char (168);
 153           dcl     dummy                  fixed bin (35);
 154           dcl     entryname              char (32);
 155           dcl     1 local_entry_access_info
 156                                          like entry_access_info;
 157           dcl     ex_mode_entry          bit (1) aligned;
 158           dcl     exmode                 bit (36) aligned;
 159           dcl     have_s_permission      bit (1) aligned init ("1"b);
 160           dcl     i                      fixed bin;
 161           dcl     locked                 bit (1) aligned init ("0"b);
 162           dcl     max_length             fixed bin (19);
 163           dcl     mode                   bit (36) aligned;
 164           dcl     n_names_to_allocate    fixed bin;
 165           dcl     name_rp                bit (18) aligned;
 166           dcl     names_seen             fixed bin;
 167           dcl     ncd                    fixed bin;
 168           dcl     nid                    fixed bin;
 169           dcl     nnp                    ptr;
 170           dcl     pathname_length_to_allocate
 171                                          fixed bin;
 172           dcl     pathname_supplied      bit (1) aligned;
 173           dcl     pathname_varying       char (168) varying;
 174           dcl     pvid                   bit (36) aligned;
 175           dcl     1 qcell                like quota_cell aligned automatic;
 176           dcl     r                      (3) fixed bin (3);
 177           dcl     raw_mode_entry         bit (1) aligned;
 178           dcl     rec_used               fixed bin (9);
 179           dcl     return_area_ptr        pointer;
 180           dcl     return_names_or_pathname
 181                                          bit (1) aligned;
 182           dcl     return_names_ptr       pointer init (null ());
 183           dcl     return_pathname_ptr    pointer init (null ());
 184           dcl     return_pathname_sw     bit (1);
 185           dcl     return_struc_ptr       ptr;
 186           dcl     rexmode                bit (36) aligned;
 187           dcl     ring                   fixed bin;
 188           dcl     rmode                  bit (36) aligned;
 189           dcl     root_lvid              bit (36) aligned;  /* logical volume ID of the root */
 190           dcl     safety_sw              bit (1) aligned;
 191           dcl     saved_dir_change_pclock
 192                                          fixed bin (35);
 193           dcl     seg_usage              fixed bin (35);
 194           dcl     segptr                 pointer;
 195           dcl     status_call            fixed bin (3);
 196           dcl     tcode                  fixed bin (35);
 197           dcl     type                   fixed bin;
 198           dcl     uid                    bit (36) aligned;
 199           dcl     uidpath                (0:15) bit (36) aligned;
 200           dcl     user                   char (32) aligned;
 201           dcl     vol_dtd                bit (36);
 202           dcl     volid                  (3) bit (36);
 203           dcl     vtocx                  fixed bin;
 204 
 205 /* * * * * TEXT SECTION REFERENCES * * * * * * * */
 206 
 207           dcl     ENTRY_status_          initial (1) fixed binary (3) internal static options (constant);
 208                                                             /* note that there is code in this program which */
 209           dcl     ENTRY_status_long      initial (2) fixed binary (3) internal static options (constant);
 210                                                             /* assumes this ordering of these indicators */
 211           dcl     ENTRY_status_min       initial (3) fixed binary (3) internal static options (constant);
 212                                                             /* section of the procedure */
 213 
 214 /* BASED */
 215 
 216           dcl     return_area            area based (return_area_ptr);
 217           dcl     return_names           (n_names_to_allocate) character (32) unaligned based (return_names_ptr);
 218           dcl     return_pathname        aligned based (return_pathname_ptr) char (pathname_length_to_allocate);
 219           dcl     1 status_branch_short  aligned based (status_ptr) like status_branch.short;
 220 
 221 /* EXTERNAL */
 222 
 223           dcl     error_table_$bad_arg   fixed bin (35) external;
 224           dcl     error_table_$dirseg    fixed bin (35) external;
 225           dcl     error_table_$link      fixed bin (35) external;
 226           dcl     error_table_$mdc_not_mdir
 227                                          fixed bin (35) external;
 228           dcl     error_table_$no_s_permission
 229                                          fixed bin (35) external;
 230           dcl     error_table_$noalloc   fixed bin (35) external;
 231           dcl     error_table_$notalloc  fixed bin (35) external;
 232           dcl     error_table_$null_info_ptr
 233                                          fixed bin (35) external;
 234           dcl     error_table_$root      fixed bin (35) external;
 235           dcl     error_table_$unimplemented_version
 236                                          fixed bin (35) static external;
 237           dcl     pds$process_group_id   char (32) aligned external static;
 238           dcl     pvt$root_lvid          bit (36) aligned external;
 239           dcl     pvt$root_pvid          bit (36) aligned external;
 240           dcl     pvt$root_vtocx         fixed bin external;
 241 
 242 /* ENTRIES */
 243 
 244           dcl     acc_name_$get          entry (ptr, ptr);
 245           dcl     access_mode$effective  entry (ptr, bit (36) aligned, bit (36) aligned, fixed bin (35));
 246           dcl     access_mode$raw        entry (ptr, bit (36) aligned, bit (36) aligned, fixed bin (35));
 247           dcl     access_mode$user       entry (ptr, char (32) aligned, bit (36) aligned, bit (36) aligned,
 248                                          fixed bin (35));
 249           dcl     fs_modes$locked        entry (ptr, bit (36) aligned, bit (36) aligned, (3) fixed bin (3),
 250                                          fixed bin (35));
 251           dcl     get_pathname_          entry (fixed bin (17), char (*) varying, fixed bin (35));
 252           dcl     level$get              entry () returns (fixed bin (3));
 253           dcl     lock$dir_lock_read     entry (ptr, fixed bin (35));
 254           dcl     lock$dir_unlock        entry (ptr);
 255           dcl     mountedp               entry (bit (36) aligned) returns (fixed bin (35));
 256           dcl     uid_path_util$get      entry (ptr, dim (0:15) bit (36) aligned, fixed bin (35));
 257           dcl     vtoc_attributes$get_dump_info
 258                                          entry (bit (36) aligned, bit (36) aligned, fixed bin, bit (36), (3) bit (36),
 259                                          fixed bin (35));
 260           dcl     vtoc_attributes$get_dump_switches
 261                                          entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin, fixed bin,
 262                                          fixed bin (35));
 263           dcl     vtoc_attributes$get_info
 264                                          entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin (35));
 265           dcl     vtoc_attributes$get_quota
 266                                          entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin,
 267                                          fixed bin (35));
 268 
 269 /* MISC */
 270 
 271           dcl     (addr, baseno, bin, divide, fixed, hbound, ptr, null, rel, segno, substr, unspec)
 272                                          builtin;
 273 
 274           dcl     area                   condition;
 275           dcl     bad_dir_               condition;
 276           dcl     cleanup                condition;
 277           dcl     seg_fault_error        condition;
 278           dcl     stringsize             condition;
 279 %page;
 280 /* status:          proc (a_dir_name, a_entryname, a_chase, a_return_struc_ptr, a_return_area_ptr, a_code); */
 281 
 282           status_call = ENTRY_status_;
 283           go to status_join;                                /* Join common code. */
 284 
 285 
 286 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 287 
 288 long:
 289      entry (a_dir_name, a_entryname, a_chase, a_return_struc_ptr, a_return_area_ptr, a_code);
 290 
 291           status_call = ENTRY_status_long;
 292 
 293 /* status_ and status_long join here. status_min* does not come in here */
 294 
 295 status_join:
 296           return_struc_ptr = a_return_struc_ptr;
 297           return_area_ptr = a_return_area_ptr;
 298           call copy_and_check_pathname_arg;
 299           chase = a_chase;
 300           code = 0;
 301           tcode = 0;
 302           status_ptr = return_struc_ptr;
 303           n_names_to_allocate = 0;
 304           pathname_length_to_allocate = 0;
 305 
 306           if status_call = ENTRY_status_
 307           then unspec (status_branch_short) = ""b;          /* clear it out */
 308           else unspec (status_branch) = ""b;
 309 
 310           on cleanup call clean_up_status_;
 311 
 312 /* Now set some bit flags to determine what work will be needed */
 313 
 314           return_names_or_pathname = (return_area_ptr ^= null);
 315 
 316 RETRY_STATUS:
 317           call dc_find$obj_status_attributes_read (dir_name, entryname, chase, ep, code);
 318           if code = error_table_$no_s_permission
 319           then have_s_permission = "0"b;
 320           else if code ^= 0
 321           then call fatal_error (code);
 322           locked, called_find = "1"b;
 323 
 324           dp = ptr (ep, 0);
 325 
 326           call get_type;                                    /* Get segment type, bit count, and ring brackets. */
 327 
 328 /* See how much stuff to allocate */
 329 /* the qualifier of entry is set already */
 330 /* assume we need entry.nnames, and only discover bad_dir_ later */
 331 
 332           if ^return_names_or_pathname
 333           then do;
 334                     n_names_to_allocate = 0;
 335                     pathname_length_to_allocate = 0;
 336                end;
 337           else do;
 338                     n_names_to_allocate = entry.nnames;
 339                     if type = Link
 340                     then pathname_length_to_allocate = link.pathname_size;
 341 
 342 /* Now unlock, allocate, and relock */
 343 
 344                     saved_dir_change_pclock = dir.change_pclock;
 345 
 346                     call lock$dir_unlock (dp);              /* unlock, i say */
 347                     locked = "0"b;                          /* for cleanup benefit */
 348 
 349                     on area call fatal_error (error_table_$noalloc);
 350 
 351                     if n_names_to_allocate > 0
 352                     then do;
 353                               if have_s_permission
 354                               then allocate return_names in (return_area) set (return_names_ptr);
 355                               else n_names_to_allocate = 0; /* if no status, we have no name structure to copy */
 356                          end;
 357                     if pathname_length_to_allocate > 0
 358                     then allocate return_pathname in (return_area) set (return_pathname_ptr);
 359 
 360                     if return_names_ptr ^= null | return_pathname_ptr ^= null
 361                     then do;
 362                               if (return_names_ptr ^= null & baseno (return_names_ptr) ^= baseno (return_area_ptr))
 363                                    | (return_pathname_ptr ^= null
 364                                    & baseno (return_pathname_ptr) ^= baseno (return_area_ptr))
 365                               then call fatal_error (error_table_$notalloc);
 366 
 367 
 368 /* note that we could retry the allocation to try to get it into the */
 369 /* segment, but there is a better entrypoint on the way anyway */
 370 
 371 /* now relock and check for races */
 372 /* if the dir has been deleted, we could seg-fault here */
 373 
 374                               on seg_fault_error signal bad_dir_;
 375 
 376                               call lock$dir_lock_read (dp, code);
 377                               if code ^= 0
 378                               then call fatal_error (code);
 379                               locked = "1"b;
 380                               revert seg_fault_error;
 381 
 382                               if dir.change_pclock ^= saved_dir_change_pclock
 383                               then do;
 384                                         call unlock_dir;
 385                                         call clean_up_status_;
 386                                                             /* free storage */
 387                                         go to RETRY_STATUS;
 388                                    end;
 389                          end;
 390                end;
 391 
 392 /* Okay, now the dir is locked, and any allocated storage needed */
 393 /* to return the data has been allocated */
 394 /* go ahead and fill things in */
 395 
 396           if type ^= Link
 397           then do;                                          /* if a branch */
 398                     if type = Directory
 399                     then tcode = 0;                         /* RLV always mounted */
 400                     else tcode = mountedp (dir.sons_lvid);  /* check mountedness */
 401                     if tcode = 0
 402                     then call get_vtoc;                     /* okay its mounted */
 403                     else unspec (sc_info) = "0"b;           /* DAMN, give him partial info, N.B. tcode must get out */
 404 
 405                     rec_used = sc_info.records;
 406                     cur_length = sc_info.csl;
 407                end;
 408           else tcode = 0;
 409 
 410           uid = entry.uid;                                  /* can always know uid */
 411 
 412           status_branch.type = type;                        /* set fixed information */
 413 
 414 /* status_branch.nnames is set to 0 when no names are allocated, regardless of
 415    whether or not the caller has status permission. As per specs in documentation. */
 416           status_branch.nnames = 0;
 417           if n_names_to_allocate > 0                        /* we have allocated them */
 418           then do;
 419                     status_branch.names_relp = rel (return_names_ptr);
 420                     status_branch.nnames = entry.nnames;
 421 
 422                     names_seen = 0;
 423                     do name_rp = entry.name_frp repeat ptr (dp, name_rp) -> names.fp while (name_rp ^= ""b);
 424 
 425                          nnp = ptr (dp, name_rp);
 426                          if nnp -> names.type ^= NAME_TYPE | nnp -> names.owner ^= entry.uid
 427                               | nnp -> names.entry_rp ^= rel (ep)
 428                          then signal bad_dir_;
 429                          names_seen = names_seen + 1;
 430                          if names_seen > n_names_to_allocate
 431                          then signal bad_dir_;
 432                          return_names (names_seen) = nnp -> names.name;
 433                     end;
 434                     if names_seen < n_names_to_allocate
 435                     then signal bad_dir_;
 436                end;
 437 
 438           if type = Link
 439           then do;
 440                     if return_pathname_ptr ^= null
 441                     then do;
 442                               status_link.pathname_relp = rel (return_pathname_ptr);
 443                               on stringsize signal bad_dir_;
 444 (stringsize):
 445                               return_pathname = link.pathname;
 446                               revert stringsize;
 447                          end;
 448 
 449                     status_link.dtem = entry.dtem;
 450                     status_link.dtd = entry.dtd;
 451                     status_link.pathname_length = link.pathname_size;
 452                end;
 453           else do;                                          /* branch only items */
 454                     status_branch.dtu = sc_info.dtu;
 455                     status_branch.dtcm = sc_info.dtm;
 456                     call access_mode$effective (ep, mode, exmode, dummy);
 457                     if type = Segment
 458                     then status_branch.mode = "0"b || substr (mode, 1, 3);
 459                     else status_branch.mode = "0"b || substr (exmode, 1, 1) || "1"b || substr (exmode, 2, 2);
 460                     status_branch.records_used = rec_used;
 461 
 462                     call access_mode$raw (ep, rmode, rexmode, dummy);
 463                                                             /* get raw bits for pad field */
 464                     if type = Segment
 465                     then mode = "0"b || substr (rmode, 1, 3);
 466                     else mode = "0"b || substr (rexmode, 1, 1) || "1"b || substr (rexmode, 2, 2);
 467                     status_branch.raw_mode = substr (mode, 1, 5);
 468 
 469                     if status_call ^= ENTRY_status_long
 470                     then goto GOOD_RETURN;
 471 
 472                     status_branch.long.dtd = entry.dtd;
 473                     status_branch.long.dtem = entry.dtem;
 474                     if type = Directory
 475                     then status_branch.long.lvid = entry.sons_lvid;
 476                     else status_branch.long.lvid = ptr (ep, 0) -> dir.sons_lvid;
 477                     status_branch.long.current_length = divide (cur_length, 1024, 11, 0);
 478                     status_branch.long.bit_count = bitcnt;
 479                     status_branch.long.copy_switch = entry.copysw;
 480                     status_branch.long.tpd_switch = entry.tpd;
 481                     status_branch.long.mdir_switch = entry.master_dir;
 482                     status_branch.long.damaged_switch = sc_info.damaged;
 483                     status_branch.long.synchronized_switch = sc_info.synchronized;
 484                     status_branch.long.ring_brackets (*) = r (*);
 485                     status_branch.long.uid = entry.uid;
 486                end;
 487 
 488 GOOD_RETURN:
 489           if tcode = 0 & ^have_s_permission
 490           then tcode = error_table_$no_s_permission;
 491 
 492           call unlock_dir;
 493 
 494           a_code = tcode;                                   /* remember LV problems */
 495                                                             /* or no_s_permission */
 496           return;
 497 %page;
 498 mins:
 499      entry (a_segptr, a_type, a_bitcnt, a_code);
 500 
 501           status_call = ENTRY_status_min;
 502           call copy_and_check_segptr_arg;
 503 
 504           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 505           if code ^= 0
 506           then call fatal_error (code);
 507           locked = "1"b;
 508 
 509           go to min_join;
 510 
 511 
 512 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 513 
 514 minf:
 515      entry (a_dir_name, a_entryname, a_chase, a_type, a_bitcnt, a_code);
 516 
 517 
 518           status_call = ENTRY_status_min;
 519           call copy_and_check_pathname_arg;
 520           chase = a_chase;
 521 
 522           call dc_find$obj_attributes_read (dir_name, entryname, chase, ep, code);
 523           if code ^= 0
 524           then call fatal_error (code);
 525           locked, called_find = "1"b;
 526 
 527 min_join:
 528           dp = ptr (ep, 0);
 529 
 530           call get_type;                                    /* Get type and bit count. */
 531 
 532           call unlock_dir;                                  /* Unlock_dir the directory now. */
 533 
 534           a_type = type;                                    /* Return the segment type. */
 535           a_bitcnt = bitcnt;                                /* Return the bit count. */
 536 
 537           go to RETURN;
 538 %page;
 539 get_author:
 540      entry (a_dir_name, a_entryname, a_chase, a_auth, a_code);
 541 
 542           status_call = ENTRY_status_min;
 543           call copy_and_check_pathname_arg;
 544           chase = a_chase;
 545 
 546           call dc_find$obj_attributes_read (dir_name, entryname, chase, ep, code);
 547           if code ^= 0
 548           then call fatal_error (code);
 549           locked, called_find = "1"b;
 550 
 551           dp = ptr (ep, 0);
 552 
 553           call acc_name_$get (addr (entry.author), addr (auth));
 554                                                             /* decode the name */
 555 
 556           call unlock_dir;                                  /* Unlock directory before returning info. */
 557 
 558           a_auth = auth;
 559 
 560           go to RETURN;
 561 
 562 
 563 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 564 
 565 get_bc_author:
 566      entry (a_dir_name, a_entryname, a_auth, a_code);
 567 
 568 
 569           status_call = ENTRY_status_min;
 570           call copy_and_check_pathname_arg;
 571 
 572           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 573           if code ^= 0
 574           then call fatal_error (code);
 575           locked, called_find = "1"b;
 576 
 577           dp = ptr (ep, 0);
 578 
 579           call acc_name_$get (addr (entry.bc_author), addr (auth));
 580 
 581           call unlock_dir;
 582 
 583           a_auth = auth;
 584 
 585           go to RETURN;
 586 %page;
 587 get_uid_file:
 588      entry (a_dir_name, a_entryname, a_uid, a_code);
 589 
 590           declare a_uid                  bit (36) aligned parameter;
 591 
 592           status_call = ENTRY_status_min;
 593           call copy_and_check_pathname_arg ();
 594 
 595           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 596           if code ^= 0
 597           then call fatal_error (code);
 598           locked, called_find = "1"b;
 599 
 600           dp = ptr (ep, 0);
 601 
 602           uid = entry.uid;
 603 
 604           call unlock_dir ();
 605 
 606           a_uid = uid;
 607           go to RETURN;
 608 %page;
 609 get_user_access_modes:
 610      entry (a_dir_name, a_entryname, a_user, a_ring, a_modes, a_ex_modes, a_code);
 611                                                             /* modes returned as bit strings (36) */
 612           ex_mode_entry = "1"b;
 613           raw_mode_entry = "0"b;
 614           pathname_supplied = "1"b;
 615           ring = a_ring;
 616           goto GET_MODE_JOIN;
 617 
 618 get_user_access_modes_seg:
 619      entry (a_segptr, a_user, a_ring, a_modes, a_ex_modes, a_code);
 620 
 621           ex_mode_entry = "1"b;
 622           raw_mode_entry = "0"b;
 623           pathname_supplied = "0"b;
 624           ring = a_ring;
 625           goto GET_MODE_JOIN;
 626 
 627 get_user_effmode:
 628      entry (a_dir_name, a_entryname, a_user, a_ring, a_mode, a_code);
 629                                                             /* mode returned as fixed bin (5) */
 630           ex_mode_entry = "0"b;
 631           raw_mode_entry = "0"b;
 632           pathname_supplied = "1"b;
 633           ring = a_ring;
 634           goto GET_MODE_JOIN;
 635 
 636 get_user_raw_mode:
 637      entry (a_dir_name, a_entryname, a_user, a_modes, a_code);
 638                                                             /* mode returned as bit string (36) */
 639           ex_mode_entry = "0"b;
 640           raw_mode_entry = "1"b;
 641           pathname_supplied = "1"b;
 642 
 643 GET_MODE_JOIN:
 644           user = a_user;                                    /* copy arg */
 645 
 646           if user = pds$process_group_id
 647           then user = "";                                   /* Make the default work (and not require s) */
 648 
 649           if (user = "")
 650           then /* Don't require dir_name access for this */
 651                status_call = ENTRY_status_min;
 652           else status_call = 0;                             /* Otherwise, not a status entry */
 653 
 654           if pathname_supplied
 655           then call copy_and_check_pathname_arg ();
 656           else call copy_and_check_segptr_arg ();           /* must be segptr entry */
 657 
 658           if ring < 0
 659           then ring = level$get ();                         /* Default to validation level */
 660           else if ring > 7
 661           then ring = 7;                                    /* And make it "valid" */
 662 
 663           if pathname_supplied
 664           then do;
 665                     if status_call = ENTRY_status_min
 666                     then call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 667                                                             /* allow no s but non-null on object */
 668                     else call dc_find$obj_status_read (dir_name, entryname, 1, ep, code);
 669                end;
 670           else do;
 671                     if status_call = ENTRY_status_min
 672                     then call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 673                     else call dc_find$obj_status_read_ptr (segptr, ep, code);
 674                end;
 675 
 676           if code ^= 0
 677           then call fatal_error (code);
 678 
 679           locked = "1"b;
 680           if pathname_supplied
 681           then called_find = "1"b;
 682 
 683           dp = ptr (ep, 0);
 684 
 685           if (user ^= "")
 686           then /* Someone other than ourselves */
 687                call access_mode$user (ep, user, mode, exmode, code);
 688           else call access_mode$raw (ep, mode, exmode, code);
 689                                                             /* Otherwise, determine our own mode */
 690           if code ^= 0
 691           then call fatal_error (code);
 692 
 693           call get_type;                                    /* Get segment type, ring brackets and bitcount. */
 694 
 695           call unlock_dir;                                  /* Unlock the directory now. */
 696 
 697           if raw_mode_entry
 698           then do;                                          /* don't need to factor in ring brackets */
 699                     if type = Directory
 700                     then a_modes = exmode;                  /* "111"b = sma */
 701                     else a_modes = mode;                    /* "111"b = rew */
 702                     goto RETURN;
 703                end;
 704 
 705           if type = Directory
 706           then do;                                          /* for directories */
 707                     mode = exmode;
 708                     exmode = ""b;
 709                     if ring <= r (1)
 710                     then ;                                  /* all access allowed */
 711                     else if ring <= r (2)
 712                     then mode = (mode & "100"b);            /* status only */
 713                     else mode = "0"b;
 714                     if ^ex_mode_entry
 715                     then mode = substr (mode, 1, 1) || "0"b || substr (mode, 2, 2);
 716                                                             /* map "sma" into "rwa" */
 717                end;
 718           else do;                                          /* a real segment */
 719                     if ring < r (1)
 720                     then mode = (mode & "101"b);
 721                     else if ring = r (1)
 722                     then ;
 723                     else if ring <= r (2)
 724                     then mode = (mode & "110"b);
 725                     else if ring <= r (3)
 726                     then mode = (mode & "010"b);
 727                     else mode = "0"b;
 728                end;
 729 
 730           if ex_mode_entry
 731           then do;
 732                     a_modes = mode;
 733                     a_ex_modes = exmode;
 734                end;
 735           else a_mode = fixed (substr (mode, 1, 4), 5);     /* Return the effective mode. */
 736                                                             /* the forth bit of the bit string */
 737                                                             /* mode alignes with the lsb of the fixed bin number a_mode */
 738           go to RETURN;
 739 %page;
 740 status_for_backup:
 741      entry (a_dir_name, a_entryname, a_bkptr, a_code);
 742 
 743           status_call = ENTRY_status_min;
 744           call copy_and_check_pathname_arg;
 745 
 746           bkptr = a_bkptr;
 747 
 748           if bkptr = null
 749           then call fatal_error (error_table_$bad_arg);
 750 
 751           if bkptr -> status_for_backup.version ^= status_for_backup_version_2
 752           then call fatal_error (error_table_$unimplemented_version);
 753 
 754           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 755           if code ^= 0
 756           then call fatal_error (code);
 757           locked, called_find = "1"b;
 758 
 759           dp = ptr (ep, 0);
 760 
 761           unspec (bks) = "0"b;
 762           bks.version = status_for_backup_version_2;
 763           bks.switches.safety = entry.safety_sw;
 764           bks.switches.tpd = entry.tpd;
 765           bks.switches.security_oosw = entry.security_oosw;
 766           bks.switches.audit_flag = entry.audit_flag;
 767           bks.switches.multiple_class = entry.multiple_class;
 768           bks.switches.entrypt = entry.entrypt_sw;
 769           bks.entrypt_bound = entry.entrypt_bound;
 770           bks.access_class = entry.access_class;
 771 
 772           if entry.dirsw
 773           then do;
 774                     bks.lvid = entry.sons_lvid;
 775                     bks.switches.master_dir = entry.master_dir;
 776                end;
 777           else bks.lvid = dp -> dir.sons_lvid;
 778 
 779           bks.pvid = entry.pvid;
 780 
 781           call acc_name_$get (addr (entry.author), addr (bks.author));
 782 
 783           call acc_name_$get (addr (entry.bc_author), addr (bks.bc_author));
 784 
 785           call unlock_dir;
 786 
 787           bkptr -> status_for_backup = bks;                 /* return data to user */
 788 
 789           go to RETURN;
 790 %page;
 791 
 792 get_safety_sw_ptr:
 793      entry (a_segptr, a_safety_sw, a_code);
 794 
 795           status_call = ENTRY_status_min;
 796           call copy_and_check_segptr_arg;
 797 
 798           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 799           if code ^= 0
 800           then call fatal_error (code);
 801           locked = "1"b;
 802 
 803           go to safety_sw_join;
 804 
 805 
 806 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 807 
 808 
 809 get_safety_sw:
 810      entry (a_dir_name, a_entryname, a_safety_sw, a_code);
 811 
 812 
 813           status_call = ENTRY_status_min;
 814           call copy_and_check_pathname_arg;
 815 
 816           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 817           if code ^= 0
 818           then call fatal_error (code);
 819           locked, called_find = "1"b;
 820 
 821 safety_sw_join:
 822           dp = ptr (ep, 0);
 823 
 824           safety_sw = entry.safety_sw;
 825 
 826           call unlock_dir;
 827 
 828           a_safety_sw = safety_sw;
 829 
 830           go to RETURN;
 831 %page;
 832 get_seg_usage_ptr:
 833      entry (a_segptr, a_seg_usage, a_code);
 834 
 835           status_call = ENTRY_status_min;
 836           call copy_and_check_segptr_arg;
 837 
 838           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 839           if code ^= 0
 840           then call fatal_error (code);
 841           locked = "1"b;
 842 
 843           go to seg_usage_join;
 844 
 845 
 846 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 847 
 848 
 849 get_seg_usage:
 850      entry (a_dir_name, a_entryname, a_seg_usage, a_code);
 851 
 852 
 853           status_call = ENTRY_status_min;
 854           call copy_and_check_pathname_arg;
 855 
 856           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 857           if code ^= 0
 858           then call fatal_error (code);
 859           locked, called_find = "1"b;
 860 
 861 seg_usage_join:
 862           dp = ptr (ep, 0);
 863 
 864           if type = Directory
 865           then tcode = error_table_$dirseg;                 /* Dirs have quota instead */
 866           else tcode = mountedp (dir.sons_lvid);            /* Make sure seg is mounted by user */
 867           if tcode ^= 0
 868           then call fatal_error (tcode);
 869 
 870           call get_vtoc;                                    /* Read AST or VTOCE */
 871           seg_usage = sc_info.pf_count;
 872           call unlock_dir;
 873 
 874           a_seg_usage = seg_usage;
 875           go to RETURN;
 876 %page;
 877 
 878 get_dates_ptr:
 879      entry (a_segptr, a_dates, a_code);
 880 
 881           status_call = ENTRY_status_min;
 882           call copy_and_check_segptr_arg;
 883 
 884           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 885           if code ^= 0
 886           then call fatal_error (code);
 887           locked = "1"b;
 888 
 889           go to dates_join;
 890 
 891 
 892 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 893 
 894 
 895 get_dates:
 896      entry (a_dir_name, a_entryname, a_dates, a_code);
 897 
 898 
 899           status_call = ENTRY_status_min;
 900           call copy_and_check_pathname_arg;
 901 
 902           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 903           if code ^= 0
 904           then call fatal_error (code);
 905           locked, called_find = "1"b;
 906 
 907 dates_join:
 908           dp = ptr (ep, 0);
 909 
 910           call get_vtoc_dates;
 911 
 912           dates (1) = sc_info.dtu;
 913           dates (2) = sc_info.dtm;
 914           dates (3) = entry.dtem;
 915           dates (4) = entry.dtd;
 916           dates (5) = vol_dtd;
 917 
 918           call unlock_dir;
 919 
 920           do i = 1 to hbound (a_dates, 1);
 921                a_dates (i) = dates (i);
 922           end;
 923 
 924           go to RETURN;
 925 %page;
 926 
 927 get_volume_dump_switches_ptr:
 928      entry (a_segptr, a_nid, a_ncd, a_code);
 929 
 930           status_call = ENTRY_status_min;
 931           call copy_and_check_segptr_arg;
 932 
 933           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 934           if code ^= 0
 935           then call fatal_error (code);
 936           locked = "1"b;
 937 
 938           go to volume_dump_switches_join;
 939 
 940 
 941 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 942 
 943 
 944 get_volume_dump_switches:
 945      entry (a_dir_name, a_entryname, a_nid, a_ncd, a_code);
 946 
 947 
 948           status_call = ENTRY_status_min;
 949           call copy_and_check_pathname_arg;
 950 
 951           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 952           if code ^= 0
 953           then call fatal_error (code);
 954           locked, called_find = "1"b;
 955 
 956 volume_dump_switches_join:
 957           dp = ptr (ep, 0);
 958 
 959           call get_vtoc_volume_dump_switches;
 960 
 961           call unlock_dir;
 962 
 963           a_nid = nid;
 964           a_ncd = ncd;
 965 
 966           go to RETURN;
 967 %page;
 968 
 969 get_max_length_ptr:
 970      entry (a_segptr, a_max_length, a_code);
 971 
 972           status_call = ENTRY_status_min;
 973           call copy_and_check_segptr_arg;
 974 
 975           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
 976           if code ^= 0
 977           then call fatal_error (code);
 978           locked = "1"b;
 979 
 980           go to max_length_join;
 981 
 982 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
 983 
 984 get_max_length:
 985      entry (a_dir_name, a_entryname, a_max_length, a_code);
 986 
 987 
 988 
 989           status_call = ENTRY_status_min;
 990           call copy_and_check_pathname_arg;
 991 
 992           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
 993           if code ^= 0
 994           then call fatal_error (code);
 995           locked, called_find = "1"b;
 996 
 997 max_length_join:
 998           dp = ptr (ep, 0);
 999 
1000           if type = Directory                               /* check mountedness for non-dirs */
1001           then tcode = 0;
1002           else tcode = mountedp (dir.sons_lvid);
1003           if tcode ^= 0
1004           then call fatal_error (tcode);
1005 
1006           call get_vtoc;
1007           max_length = sc_info.msl;
1008 
1009           call unlock_dir;
1010 
1011           a_max_length = max_length;
1012 
1013           go to RETURN;
1014 %page;
1015 get_access_class_ptr:
1016      entry (a_segptr, a_access_class, a_code);
1017 
1018           status_call = ENTRY_status_min;
1019           call copy_and_check_segptr_arg;
1020 
1021           call dc_find$obj_attributes_read_ptr (segptr, ep, code);
1022           if code ^= 0
1023           then call fatal_error (code);
1024           locked = "1"b;
1025 
1026           go to access_class_join;
1027 
1028 get_access_class:
1029      entry (a_dir_name, a_entryname, a_access_class, a_code);
1030 
1031           status_call = ENTRY_status_min;
1032           call copy_and_check_pathname_arg;
1033 
1034           call dc_find$obj_attributes_read (dir_name, entryname, 1, ep, code);
1035           if code ^= 0
1036           then call fatal_error (code);
1037           locked, called_find = "1"b;
1038 
1039 access_class_join:
1040           dp = ptr (ep, 0);
1041 
1042           access_class = entry.access_class;
1043 
1044           call unlock_dir;
1045 
1046           a_access_class = access_class;
1047 
1048           go to RETURN;
1049 %page;
1050 
1051 get_access_info:
1052      entry (a_dir_name, a_entryname, a_chase, a_return_struc_ptr, a_code);
1053 
1054           chase = a_chase;
1055           pathname_supplied = "1"b;
1056 
1057           go to get_access_info_join;
1058 
1059 get_access_info_seg:
1060      entry (a_segptr, a_return_struc_ptr, a_code);
1061 
1062           pathname_supplied = "0"b;
1063 
1064 get_access_info_join:
1065           status_call = ENTRY_status_min;
1066 
1067           entry_access_info_ptr = a_return_struc_ptr;
1068           if entry_access_info_ptr = null ()
1069           then call fatal_error (error_table_$null_info_ptr);
1070           else if entry_access_info.version ^= ENTRY_ACCESS_INFO_VERSION_1
1071           then call fatal_error (error_table_$unimplemented_version);
1072 
1073           if pathname_supplied
1074           then do;
1075                     call copy_and_check_pathname_arg ();
1076 
1077                     call dc_find$obj_attributes_read (dir_name, entryname, chase, ep, code);
1078                     if code ^= 0
1079                     then call fatal_error (code);
1080 
1081                     dp = ptr (ep, 0);
1082 
1083                     locked, called_find = "1"b;
1084                end;
1085           else do;
1086                     call copy_and_check_segptr_arg ();
1087 
1088                     call dc_find$obj_attributes_read_ptr (segptr, ep, code);
1089                     if code ^= 0
1090                     then call fatal_error (code);
1091 
1092                     dp = ptr (ep, 0);
1093 
1094                     locked = "1"b;
1095                end;
1096 
1097           if ^entry.bs                                      /* if entry is a link */
1098           then call fatal_error (error_table_$link);        /* we can't continue */
1099           else do;
1100                     if called_find                          /* use expensive access lookup */
1101                     then call access_mode$effective (ep, mode, exmode, code);
1102                     else call fs_modes$locked (segptr, mode, exmode, r, code);
1103                                                             /* r gets overwritten at get_type */
1104                     if code ^= 0
1105                     then call fatal_error (code);
1106 
1107                     call get_pathname_ (bin (segno (dp), 17, 0), pathname_varying, code);
1108                     if code ^= 0
1109                     then call fatal_error (code);
1110 
1111                     local_entry_access_info.version = ENTRY_ACCESS_INFO_VERSION_1;
1112 
1113                     call get_type;
1114                     local_entry_access_info.type = type;
1115 
1116                     local_entry_access_info.dir_name = pathname_varying;
1117                     local_entry_access_info.entryname = addr (entry.primary_name) -> names.name;
1118 
1119                     local_entry_access_info.uid = entry.uid;
1120 
1121                     local_entry_access_info.ring_brackets (*) = r (*);
1122                     if type = Directory
1123                     then local_entry_access_info.extended_ring_brackets (*) = 0;
1124                     else do i = 1 to 3;
1125                               local_entry_access_info.extended_ring_brackets (i) = fixed (entry.ex_ring_brackets (i), 3);
1126                          end;
1127 
1128 
1129                     if type = Segment
1130                     then do;
1131                               local_entry_access_info.effective_access_modes = mode;
1132                               local_entry_access_info.extended_access_modes = exmode;
1133                          end;
1134                     else do;
1135                               local_entry_access_info.effective_access_modes = exmode;
1136                               local_entry_access_info.extended_access_modes = ""b;
1137                          end;
1138 
1139                     local_entry_access_info.access_class = entry.access_class;
1140                     local_entry_access_info.multiclass = entry.multiple_class;
1141                     local_entry_access_info.parent_access_class = dir.access_class;
1142 
1143                end;
1144 
1145           call unlock_dir ();
1146 
1147           entry_access_info = local_entry_access_info;
1148 
1149           go to RETURN;
1150 
1151 %page;
1152 
1153 /* Status entries used by master directory control */
1154 
1155 get_mdir_status:
1156      entry (a_dir_name, a_entryname, a_uidpath, a_voluid, a_quota, a_code);
1157 
1158           status_call = 0;
1159           call copy_and_check_pathname_arg;
1160           return_pathname_sw = "0"b;
1161 
1162           call dc_find$obj_status_read (dir_name, entryname, 0, ep, code);
1163                                                             /* find it without chasing link */
1164           goto mdir_common;
1165 
1166 get_mdir_status_priv:
1167      entry (a_dir_name, a_entryname, a_uidpath, a_voluid, a_quota, a_code);
1168 
1169           status_call = 0;
1170           call copy_and_check_pathname_arg;
1171           return_pathname_sw = "0"b;
1172 
1173           call dc_find$obj_status_read_priv (dir_name, entryname, 0, ep, code);
1174                                                             /* find it without chasing link */
1175 
1176 mdir_common:
1177           if code ^= 0
1178           then if code = error_table_$root
1179                then go to mdir_root;                        /* the root is NOT locked. we are making up this info */
1180                else call fatal_error (code);
1181 
1182           dp = ptr (ep, 0);
1183           locked, called_find = "1"b;
1184 
1185           call check_master_dir;                            /* must be master dir, which is on RLV */
1186           call get_vtoc_quota;                              /* get vtoce atrrbiutes */
1187 
1188           a_quota = qcell.received;                         /* and quota received */
1189           a_voluid = entry.sons_lvid;
1190           if ^return_pathname_sw
1191           then do;                                          /* need uid pathname */
1192                     call uid_path_util$get (dp, uidpath, code);
1193                     if code ^= 0
1194                     then call fatal_error (code);
1195                     uidpath (dir.tree_depth + 1) = entry.uid;
1196                                                             /* finish name */
1197                     a_uidpath = uidpath;
1198                end;
1199           else do;
1200                     a_dir_name = dir_name;
1201                     a_entryname = entryname;
1202                end;
1203 
1204           call unlock_dir;
1205           go to RETURN;
1206 
1207 mdir_root:
1208           code = 0;                                         /* clear residual error_table_$root */
1209           dp = null;
1210 
1211           call get_vtoc_root;                               /* read roots vtoc entry */
1212           a_quota = qcell.received;
1213           a_voluid = root_lvid;
1214           if ^return_pathname_sw
1215           then do;                                          /* make up pathname of root */
1216                     uidpath = "0"b;
1217                     uidpath (0) = (36)"1"b;
1218                     a_uidpath = uidpath;
1219                end;
1220           else do;
1221                     a_dir_name = ">";
1222                     a_entryname = "";
1223                end;
1224           go to RETURN;
1225 
1226 /* this entry is similiar to above, but is given a uid pathname to start with */
1227 
1228 get_mdir_status_uid_priv:
1229      entry (a_uidpath, a_dir_name, a_entryname, a_voluid, a_quota, a_code);
1230 
1231           status_call = 0;
1232           call copy_and_check_pathname_arg;
1233           return_pathname_sw = "1"b;                        /* remember to return pathname */
1234           uidpath = a_uidpath;
1235           call dc_find$obj_status_read_priv_uid (uidpath, dir_name, entryname, ep, code);
1236                                                             /* find entry and lock dir_name */
1237           go to mdir_common;
1238 
1239 
1240 
1241 /* procedure to check for a master directory */
1242 
1243 check_master_dir:
1244      proc;
1245 
1246           if entry.bs
1247           then if entry.dirsw
1248                then if entry.master_dir
1249                     then do;
1250                               code = 0;
1251                               return;
1252                          end;
1253           call fatal_error (error_table_$mdc_not_mdir);
1254 
1255 
1256      end check_master_dir;
1257 %page;
1258 get_vtoc:
1259      proc;
1260 
1261           uid = entry.uid;
1262           pvid = entry.pvid;
1263           vtocx = entry.vtocx;
1264           call vtoc_attributes$get_info (uid, pvid, vtocx, addr (sc_info), dummy);
1265           if dummy ^= 0
1266           then call fatal_error (dummy);
1267 
1268      end get_vtoc;
1269 
1270 get_vtoc_dates:
1271      proc;
1272 
1273           call get_vtoc;
1274           call vtoc_attributes$get_dump_info (uid, pvid, vtocx, vol_dtd, volid, dummy);
1275           if dummy ^= 0
1276           then call fatal_error (dummy);
1277 
1278      end get_vtoc_dates;
1279 
1280 get_vtoc_volume_dump_switches:
1281      proc;
1282 
1283           uid = entry.uid;
1284           pvid = entry.pvid;
1285           vtocx = entry.vtocx;
1286           call vtoc_attributes$get_dump_switches (uid, pvid, vtocx, nid, ncd, dummy);
1287           if dummy ^= 0
1288           then call fatal_error (dummy);
1289 
1290      end get_vtoc_volume_dump_switches;
1291 
1292 
1293 get_vtoc_quota:
1294      proc;                                                  /* special get_vtoc for master dirs */
1295 
1296           uid = entry.uid;
1297           pvid = entry.pvid;
1298           vtocx = entry.vtocx;
1299           call vtoc_attributes$get_quota (uid, pvid, vtocx, addr (qcell), 0, code);
1300           if code ^= 0
1301           then call fatal_error (code);
1302 
1303      end get_vtoc_quota;
1304 
1305 get_vtoc_root:
1306      proc;                                                  /* get vtoce for the root master dir */
1307 
1308           uid = (36)"1"b;
1309           pvid = pvt$root_pvid;
1310           vtocx = pvt$root_vtocx;
1311           root_lvid = pvt$root_lvid;
1312           call vtoc_attributes$get_quota (uid, pvid, vtocx, addr (qcell), 0, code);
1313           if code ^= 0
1314           then call fatal_error (code);
1315           unspec (uidpath) = "0"b;                          /* make up uidpathname */
1316           uidpath (0) = (36)"1"b;
1317           return;
1318 
1319      end get_vtoc_root;
1320 
1321 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
1322 
1323 unlock_dir:
1324      proc;
1325 
1326           if called_find
1327           then call dc_find$finished (dp, locked);          /* unlock and unuse */
1328           else if locked
1329           then call lock$dir_unlock (dp);
1330           locked, called_find = "0"b;
1331      end unlock_dir;
1332 %page;
1333 
1334 get_type:
1335      proc;
1336 
1337 
1338           if entry.bs
1339           then do;                                          /* entry is a branch */
1340                     if entry.dirsw
1341                     then do;                                /* entry is a directory branch */
1342                               type = Directory;
1343                               r (1) = fixed (entry.ex_ring_brackets (1), 3);
1344                                                             /* return extended ring brackets */
1345                               r (2) = fixed (entry.ex_ring_brackets (2), 3);
1346                               r (3) = r (2);
1347                          end;
1348                     else do;                                /* entry is a non_directory branch */
1349                               type = Segment;
1350                               r (1) = fixed (entry.ring_brackets (1), 3);
1351                                                             /* return ring brackets */
1352                               r (2) = fixed (entry.ring_brackets (2), 3);
1353                               r (3) = fixed (entry.ring_brackets (3), 3);
1354                          end;
1355                     bitcnt = entry.bc;
1356                end;
1357 
1358           else do;                                          /* entry is a link */
1359                     type = Link;
1360                     bitcnt = 0;
1361                end;
1362 
1363 
1364      end get_type;
1365 %page;
1366 
1367 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
1368 
1369 fatal_error:
1370      procedure (e_code);
1371           declare e_code                 fixed bin (35);
1372 
1373           call unlock_dir;                                  /* cleanup */
1374           call clean_up_status_;                            /* free storage if already dereferenced */
1375 
1376           a_code = e_code;
1377           go to ERR_RETURN;
1378      end fatal_error;
1379 
1380 RETURN:
1381           a_code = 0;
1382 ERR_RETURN:
1383           return;
1384 
1385 copy_and_check_segptr_arg:
1386      procedure;
1387 
1388           segptr = a_segptr;
1389           if segptr = null
1390           then call fatal_error (error_table_$null_info_ptr);
1391      end copy_and_check_segptr_arg;
1392 
1393 copy_and_check_pathname_arg:
1394      procedure;
1395 
1396           dir_name = a_dir_name;
1397           entryname = a_entryname;
1398           if dir_name = ""
1399           then call fatal_error (error_table_$bad_arg);
1400      end copy_and_check_pathname_arg;
1401 
1402 clean_up_status_:
1403      procedure;
1404 
1405 /* ASSUME that if we are called as a cleanup handler that */
1406 /* a crawlout is in progress, and we should leave the dir locked */
1407 /* so that verify_lock will find it. */
1408 
1409 
1410           if status_call = ENTRY_status_ | status_call = ENTRY_status_long
1411           then do;
1412                     if return_names_ptr ^= null
1413                     then free return_names;
1414                     if return_pathname_ptr ^= null
1415                     then free return_pathname;
1416                end;
1417           if called_find                                    /* will be false on error exits */
1418           then do;
1419                     call dc_find$finished (dp, "0"b);       /* dereference, but leave locked so verify_lock will salvage */
1420                     called_find = "0"b;
1421                end;
1422      end clean_up_status_;
1423 %page;
1424 %include dc_find_dcls;
1425 %page;
1426 %include dir_entry;
1427 %page;
1428 %include dir_header;
1429 %page;
1430 %include dir_link;
1431 %page;
1432 %include dir_name;
1433 %page;
1434 %include entry_access_info;
1435 %page;
1436 %include fs_types;
1437 %page;
1438 %include quota_cell;
1439 %page;
1440 %include sc_info;
1441 %page;
1442 %include status_for_backup;
1443 %page;
1444 %include status_structures;
1445      end status_;