1 
   2 /****^  ***********************************************************
   3         *                                                         *
   4         * Copyright, (C) Honeywell Bull Inc., 1987                *
   5         *                                                         *
   6         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   7         *                                                         *
   8         * Copyright (c) 1972 by Massachusetts Institute of        *
   9         * Technology and Honeywell Information Systems, Inc.      *
  10         *                                                         *
  11         *********************************************************** */
  12 
  13 /* The hierarchy reloader/retriever */
  14 
  15 /* Created:  February 1969 by R. C. Daley. */
  16 /* Modified: 16 June 1970 by R. H. Campbell */
  17 /* Modified: 21 October 1970 by R. J. Feiertag */
  18 /* Modified: 10 May 1971 by R. A. Tilden */
  19 /* Modified: 11 Nov 1973 by E. Stone to allow selected users to use 256K segs */
  20 /* Modified: 22 July 1974 by R. E. Mullen for sec_seg + sec_dir types */
  21 /* Modified: 21 October 1974 by A. Kobziar to handle access_mode field */
  22 /* Modified: February 1975 by R. E. Mullen for tape, cpu, and paging speedups */
  23 /* Modified: July 1975 by R. Bratt for new KST cleanup scheme, to burn our bridges behind us, to cleanup, and to fix an
  24    IACL reloading bug */
  25 /* Modified: Autumn 1975 by R. E. Mullen to retune for NSS by not calling status_long for access_mode and to not set max
  26    length and entrybound when already set by create_branch_ */
  27 /* Modified: February 1976 by R. Bratt to improve KST cleanup */
  28 /* Modified: May 1976 by R. Bratt to handle deleted PVs */
  29 /* Modified: September 1976 by R. Bratt to not do KST cleanup ditty */
  30 /* Modified: 2 November 1977 by S. Herbst to add backup_load_ entry point */
  31 /* Modified: 3 August 1979 by S. Herbst to add -trim and fix bugs */
  32 /* Modified: 17 July 1980 by S. Herbst to test for phcs_ and hphcs_ access */
  33 /* Modified: 6 November 1980 by G. Palter for version 3 backup_control structure */
  34 /* Modified: 8 January 1981 by G.  Palter to fix a bug which prevented reloading all entries in a directory which already
  35    existed online if the reloading process didn't already have "sma" access on the directory */
  36 /* Modified: December 1981 by C. Hornig to remove calls to hphcs_$set_dir_size */
  37 /* Modified: 21 January 1982 by S. Herbst to test for access to system_privilege_ in addition to phcs_ and hphcs_ */
  38 /* Modified: 5 February 1982 by S. Herbst to retrieve an entire MSF without haing to specify ">**" */
  39 /* Modified: 23 March 1982 by S. Herbst to omit date comparision on second pass for directories */
  40 /* Modified: May 1982 by Benson I. Margulies to do ACLs straight forwardly */
  41 /* Modified: July 1982 by G. Palter to add features for IMFT support of AIM: enforce a minimum ring for all created
  42    branches, restore the access class of the branch even if in debug mode, and translate access classes between systems */
  43 /* BIM: 10/82: removed acl printing */
  44 /* BIM: 2/83: Consider status_for_backup version 0 equivalent to 2 to */
  45 /* clean up after hardcore bug in 10.0 */
  46 /* Modified February 1983, E. N. Kittlitz. 256K segments */
  47 /* Modified 1985-03-21, BIM: fixed prehistoric busted condition handler.
  48    -------- -- Fixed not to force access in no-reload mode.
  49    phx18650 -- does not reset transparency switches.
  50    phx17329 -- mishandling empty acls.
  51    phx17310 -- unitialized variables in cross-dumping.
  52    phx16651 -- rqovers on the map do not always get to level 2.
  53    phx13714 -- catching command_error conditions */
  54 
  55 /****^  HISTORY COMMENTS:
  56   1) change(87-07-15,GDixon), approve(87-07-15,MCR7617),
  57      audit(87-07-16,RBarstad), install(87-07-16,MR12.1-1041):
  58      Modified for change to backup_record_types.incl.pl1.
  59   2) change(88-05-11,Lippard), approve(88-05-02,MCR7881),
  60      audit(88-06-15,Fawcett), install(88-08-02,MR12.2-1074):
  61      Changed to add reloading of the audit_flag attribute. This changed the
  62      reload_set_version to 2.
  63                                                    END HISTORY COMMENTS */
  64 
  65 /* format: style4,delnl,insnl,ifthenstmt,ifthen */
  66 
  67 
  68 backup_load:
  69      procedure ();
  70 
  71 dcl  (i, n, hcnt, scnt, type, htype) fixed bin,             /* temporary storage */
  72      (old_trans_sw, sys_type, ts) fixed bin (2),            /* Save previous settings of transparent switches. */
  73      bc fixed bin,                                          /* Segment bit count. */
  74      dtd_test bit (36) aligned,                             /* time from  backup to test for later copy */
  75      (dtp, dtd, dtu, dtem, dtsm) fixed bin (52),            /* Storage for various times. */
  76      (np, ap, segptr, bp, aclp, ix) ptr,
  77      pp ptr,                                                /* Use in an incl file. */
  78      dump_date char (24),                                   /* Storage for conversion of time record written. */
  79      ring fixed bin (3),                                    /* ring number for reloading initial ACLs */
  80      old_dname char (168) varying init (""),                /* Previous directory name. */
  81      new_dir bit (1) aligned init ("1"b),                   /* set if name header needs printing */
  82      optionsw fixed bin (2),                                /* Copy of option switch. */
  83      save_ename char (32) aligned,                          /* real pri name of reloaded seg */
  84      save_elen fixed bin,
  85      MRS fixed bin init (0),                                /* if nonzero must read seg still */
  86      FRS fixed bin init (0),                                /* if nonzero reload directly to target seg, else pdir */
  87      INITIALIZER bit (1) aligned init ("0"b),               /* "1"b => user has total access */
  88      hs_dirname char (168) varying aligned init (""),       /* last dir for which HAVE_SMA was called */
  89      hs_bit bit (1) init ("0"b),                            /* result of HAVE_SMA call */
  90      USERID char (32),                                      /* used by HAVE_SMA intl proc */
  91      access_class bit (72) aligned,                         /* access class of branch */
  92      (a_code, dir_priv_code, code) fixed bin (35),
  93      control_ptr ptr,                                       /* ptr to control structure for backup_load_ */
  94      octal_string character (32) aligned,
  95      dirname_dirname character (168),
  96      dirname_ename character (32);
  97 dcl  old_256K_switch bit (2) aligned;
  98 
  99 dcl  (cleanup, record_quota_overflow) condition;
 100 
 101 dcl  label_index fixed bin;
 102 
 103 dcl  temp_dir char (168) aligned,                           /* TEMPORARY CODE */
 104      temp_entry char (32) aligned,                          /* TEMPORARY CODE */
 105      temp_length fixed bin;                                 /* TEMPORARY CODE */
 106 
 107 
 108 dcl  stptr ptr;                                             /* pointer to status_long return area */
 109 dcl  1 status aligned,                                      /* status long return area */
 110        (
 111        2 type bit (2),
 112        2 nnames bit (16),
 113        2 nrp bit (18),
 114        2 dtm bit (36),
 115        2 dtu bit (36),
 116        2 mode bit (5),
 117        2 padding bit (13),
 118        2 records bit (18),
 119        2 dtd bit (36),
 120        2 dtem bit (36),
 121        2 acct bit (36),
 122        2 curlen bit (12),
 123        2 bitcnt bit (24),
 124        2 did bit (4),
 125        2 mdid bit (4),
 126        2 copysw bit (1),
 127        2 pad2 bit (9),
 128        2 rbs (0:2) bit (6),
 129        2 uid bit (36)
 130        ) unaligned;
 131 
 132 dcl  1 inacl_info aligned,
 133        2 sia_relp (0:7) bit (18),
 134        2 sia_count (0:7) fixed bin,
 135        2 dia_relp (0:7) bit (18),
 136        2 dia_count (0:7) fixed bin;
 137 
 138 
 139 dcl  rings (3) fixed bin (3);                               /* Ring brackets for non directory segments */
 140 
 141 dcl  reload_init bit (1) static initial ("1"b);             /* Internal static. */
 142 
 143 dcl  line char (300) static,                                /* Output line(s) buffer. */
 144      line_pointer ptr static,                               /* Pointer to line buffer. */
 145      (hp, seg_buff) ptr static;
 146 
 147 dcl  (phcs_sw, hphcs_sw, system_priv_sw) bit (1) init ("0"b);
 148                                                             /* for testing access to gates */
 149 dcl  text char (32) varying;
 150 
 151 dcl  (
 152      error_table_$namedup,
 153      error_table_$noentry,
 154      error_table_$pvid_not_found,
 155      error_table_$vtoce_connection_fail,
 156      error_table_$moderr,
 157      error_table_$no_dir,
 158      error_table_$no_info,
 159      error_table_$no_e_permission,
 160      error_table_$incorrect_access,
 161      error_table_$rqover
 162      ) ext fixed bin (35);
 163 
 164 dcl  sys_info$access_class_ceiling ext bit (72) aligned;
 165 dcl  sys_info$default_max_length ext fixed bin (35);
 166 dcl  sys_info$seg_size_256K fixed bin (19) ext;
 167 
 168 dcl  linkage_error condition;
 169 
 170 dcl  (addr, bit, clock, divide, fixed, max, min, null, pointer, substr, unspec, verify) builtin;
 171 
 172 dcl  test_entry entry variable;
 173 
 174 dcl  backup_control_mgr_$initiate entry (pointer, fixed binary (35)),
 175      backup_control_mgr_$terminate entry (pointer),
 176      backup_load_dir_list$build_tree
 177           entry (char (168) aligned, char (*) aligned, fixed bin, fixed bin (24), fixed bin (2), char (*) aligned,
 178           bit (72) aligned, fixed bin (35)),
 179      backup_load_dir_list entry (ptr, fixed bin (35)),
 180      backup_map_$name_line entry (ptr, fixed bin (21)),
 181      backup_map_$beginning_line entry (fixed bin (52), ptr, fixed bin),
 182      backup_map_$detail_line2
 183           entry (char (32) aligned, fixed bin (9), char (10) aligned, fixed bin (52), fixed bin (52), fixed bin (52),
 184           fixed bin (52), fixed bin (52)),
 185      (
 186      backup_map_$directory_line,
 187      backup_map_$on_line
 188      ) entry (ptr, fixed bin),
 189      backup_map_$error_line entry () options (variable),
 190      backup_map_$fs_error_line entry (fixed bin (35), char (*) aligned, char (*) aligned, char (*) aligned),
 191      backup_map_$terminal_line entry (fixed bin (52), fixed bin (35)),
 192      backup_util$add_names entry (char (168) aligned, char (32) aligned, ptr, fixed bin, bit (1)),
 193      backup_util$delete_name entry (char (168) aligned, char (32) aligned, fixed bin (35)),
 194      backup_util$give_access entry (char (168) aligned, char (32) aligned, fixed bin (35)),
 195      backup_util$idline entry (char (*), char (*), ptr, fixed bin),
 196      bk_input$input_init entry (fixed bin (35)),
 197      bk_input$rd_tape entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)),
 198      bk_retrieve$check_retrieval ext entry (fixed bin),
 199      bk_retrieve$flag_msf entry (fixed bin),
 200      bk_retrieve$parse_retrieval_control ext entry (char (168), fixed bin, ptr, fixed bin),
 201      bk_retrieve$parse_structure entry (ptr, fixed bin),
 202      bk_retrieve$report_retrieval ext entry,
 203      convert_aim_attributes_ entry (bit (72) aligned, character (32) aligned),
 204      cu_$arg_count entry (fixed bin),
 205      cu_$arg_list_ptr entry (ptr),
 206      cu_$level_get entry returns (fixed bin (3)),
 207      hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35)),
 208      hcs_$proc_info entry (bit (36) aligned, char (32), char (32), bit (36) aligned),
 209      bk_arg_reader_$reload_arg_reader entry (fixed bin, ptr, fixed bin (35)),
 210      date_time_ entry (fixed bin (52), char (*)),
 211      unique_chars_ entry (bit (*) aligned) returns (char (15) aligned),
 212      expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
 213 
 214 dcl  hphcs_$set_for_reloader entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)),
 215      hphcs_$delentry_file entry (char (*) aligned, char (*) aligned, fixed bin (35)),
 216      hcs_$set_copysw entry (char (*) aligned, char (*) aligned, bit (1) aligned, fixed bin (35)),
 217      hcs_$set_entry_bound entry (char (*) aligned, char (*) aligned, fixed bin (14), fixed bin (35)),
 218      hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)),
 219      hcs_$chname_file entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)),
 220      hcs_$list_inacl_all entry (char (*) aligned, ptr, ptr, ptr, fixed bin (35)),
 221      hcs_$set_max_length entry (char (*), char (*), fixed bin (19), fixed bin (35)),
 222      phcs_$set_max_length entry (char (*) aligned, char (*) aligned, fixed bin (19), fixed bin (35)),
 223                                                             /* TEMPORARY CODE */
 224      hcs_$fs_get_path_name entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35)),
 225                                                             /* TEMPORARY CODE */
 226      hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)),
 227      hcs_$set_safety_sw entry (char (*) aligned, char (*) aligned, bit (1), fixed bin (35)),
 228      (
 229      hcs_$replace_acl,
 230      hcs_$replace_dir_acl
 231      ) entry (char (*) aligned, char (*) aligned, ptr, fixed bin, bit (1), fixed bin (35)),
 232      (
 233      hcs_$replace_inacl,
 234      hcs_$replace_dir_inacl
 235      ) entry (char (*) aligned, char (*) aligned, ptr, fixed bin, bit (1), fixed bin (3), fixed bin (35)),
 236      (
 237      hcs_$set_ring_brackets,
 238      hcs_$set_dir_ring_brackets
 239      ) entry (char (*) aligned, char (*) aligned, (3) fixed bin (3), fixed bin (35)),
 240      hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), fixed bin, fixed bin (35)),
 241      hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin (5), fixed bin (5), fixed bin (35)),
 242      hcs_$status_long entry (char (*) aligned, char (*) aligned, fixed bin (1), ptr, ptr, fixed bin (35)),
 243      hcs_$terminate_noname entry (ptr, fixed bin (35)),
 244      hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)),
 245      hcs_$initiate
 246           entry (char (*) aligned, char (*) aligned, char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)),
 247      pathname_ entry (character (*), character (*)) returns (character (168)),
 248      system_privilege_$dir_priv_off entry (fixed binary (35)),
 249      system_privilege_$dir_priv_on entry (fixed binary (35)),
 250      system_privilege_$initiate
 251           entry (char (*) aligned, char (*) aligned, char (*), fixed bin, fixed bin (2), ptr, fixed bin (35)),
 252      system_privilege_$set_entry_audit_switch
 253           entry (char (*), char (*), bit (1), fixed bin (35)),
 254      translate_aim_attributes_ entry (pointer, bit (72) aligned, pointer, bit (72) aligned, fixed binary (35));
 255 
 256 dcl  (
 257      bk_input$input_finish,
 258      com_err_,
 259      ioa_$rsnnl,
 260      ioa_$rs,
 261      hphcs_$suspend_quota,
 262      hphcs_$restore_quota
 263      ) external entry options (variable);
 264 
 265 dcl  hphcs_$fs_get_trans_sw entry (fixed bin (2), fixed bin (2));
 266 
 267 dcl  mover (scnt) based;                                    /* To move words into new segment */
 268 dcl  call_limiter fixed bin (14);
 269 
 270 /*^L*/
 271 
 272 %include backup_dir_list;
 273 %page;
 274 %include bk_ss_;
 275 %page;
 276 %include bk_nss_info;
 277 %page;
 278 %include reload_set_info;
 279 %page;
 280 %include backup_fs_times;
 281 %page;
 282 %include backup_control;
 283 %page;
 284 %include backup_preamble_header;
 285 %page;
 286 %include backup_record_types;
 287 
 288 /*^L*/
 289           bk_ss_$sub_entry = "0"b;
 290 
 291           if bk_ss_$myname = " " then bk_ss_$myname = "backup_load";
 292                                                             /* set up name if called directly */
 293 
 294 /*        read in arguments and set switches                */
 295 
 296           call cu_$arg_count (i);                           /* Get the number of input arguments */
 297           if i ^= 0 then do;                                /* Don't bother if no args */
 298                call cu_$arg_list_ptr (ap);                  /* Get pointer to argument list */
 299                call bk_arg_reader_$reload_arg_reader (1, ap, code);
 300                                                             /* Do the work */
 301                if code ^= 0 then do;                        /* Uh Oh, Trouble */
 302                     call com_err_ (code, "backup_load", "");
 303                     return;
 304                end;
 305           end;
 306           if ^bk_ss_$debugsw then do;                       /* check phcs_ and hphcs_ access */
 307                phcs_sw, hphcs_sw = "0"b;
 308                on linkage_error
 309                     begin;
 310                     phcs_sw = "1"b;
 311                     go to TRY2;
 312                end;
 313                test_entry = phcs_$set_max_length;           /* test access to phcs_ gate */
 314 TRY2:
 315                on linkage_error
 316                     begin;
 317                     hphcs_sw = "1"b;
 318                     go to TRY3;
 319                end;
 320                test_entry = hphcs_$delentry_file;           /* test access to hphcs_ gate */
 321 TRY3:
 322                on linkage_error
 323                     begin;
 324                     system_priv_sw = "1"b;
 325                     go to TRY4;
 326                end;
 327                test_entry = system_privilege_$initiate;     /* test access to system_privilege_ gate */
 328 TRY4:
 329                revert linkage_error;
 330                if phcs_sw | hphcs_sw | system_priv_sw then do;
 331                     text = "";
 332                     call com_err_ (error_table_$moderr, bk_ss_$myname, "^[phcs_ ^]^[hphcs_ ^]^[system_privilege_^]
 333 Use -debug control argument to avoid calling privileged gates.", phcs_sw, hphcs_sw, system_priv_sw);
 334                     go to RETURN;
 335                end;
 336           end;
 337           old_256K_switch = ""b;                            /* initialize for cleanup */
 338           on cleanup
 339                begin;
 340                call hcs_$set_256K_switch (old_256K_switch, (""b), (0));
 341           end;
 342           go to COMMON;
 343 
 344 
 345 backup_load_:
 346      entry (control_ptr, a_code);
 347 
 348           bk_ss_$sub_entry = "1"b;
 349           a_code = 0;
 350 
 351           call backup_control_mgr_$initiate (control_ptr, a_code);
 352           if a_code ^= 0 then return;
 353 
 354           dir_priv_code = -1;                               /* for cleanup handler */
 355           old_256K_switch = ""b;                            /* ditto */
 356           on condition (cleanup)
 357                begin;
 358                if dir_priv_code = 0 then call system_privilege_$dir_priv_off ((0));
 359                call hcs_$set_256K_switch (old_256K_switch, (""b), (0));
 360                call backup_control_mgr_$terminate (control_ptr);
 361           end;
 362 
 363           if bk_ss_$control_ptr -> backup_control.debug_sw then do;
 364                bk_ss_$debugsw = "1"b;
 365                bk_ss_$trimsw = "0"b;
 366           end;
 367           else bk_ss_$debugsw = "0"b;
 368 
 369           bk_ss_$mapsw = bk_ss_$control_ptr -> backup_control.map_sw;
 370           bk_ss_$no_reload = bk_ss_$control_ptr -> backup_control.no_reload_sw;
 371           bk_ss_$holdsw = bk_ss_$control_ptr -> backup_control.hold_sw;
 372           bk_ss_$allow_dir_overwrite = bk_ss_$control_ptr -> backup_control.allow_dir_overwrite;
 373           bk_ss_$preattached = bk_ss_$control_ptr -> backup_control.preattached;
 374           if bk_ss_$preattached then bk_ss_$data_iocb = bk_ss_$control_ptr -> backup_control.data_iocb;
 375           bk_ss_$sub_entry_errfile = bk_ss_$control_ptr -> backup_control.error_file;
 376           bk_ss_$onlysw = bk_ss_$control_ptr -> backup_control.first;
 377 
 378           bk_ss_$restore_access_class = bk_ss_$control_ptr -> backup_control.restore_access_class;
 379           if bk_ss_$restore_access_class then do;           /* turn on directory privilege */
 380                on condition (linkage_error)
 381                     begin;
 382                     a_code = error_table_$moderr;
 383                     go to RETURN;
 384                end;
 385                call system_privilege_$dir_priv_on (dir_priv_code);
 386                if (dir_priv_code ^= 0) & (dir_priv_code ^= 1) then do;
 387                     a_code = code;                          /* couldn't get it */
 388                     go to RETURN;
 389                end;
 390                revert condition (linkage_error);
 391           end;
 392 
 393           bk_ss_$enforce_minimum_ring = bk_ss_$control_ptr -> backup_control.enforce_minimum_ring;
 394           if bk_ss_$enforce_minimum_ring then bk_ss_$minimum_ring = bk_ss_$control_ptr -> backup_control.minimum_ring;
 395 
 396           bk_ss_$translate_access_class = bk_ss_$control_ptr -> backup_control.translate_access_class;
 397           if bk_ss_$translate_access_class then do;
 398                bk_ss_$source_attributes_ptr = bk_ss_$control_ptr -> backup_control.source_attributes_ptr;
 399                bk_ss_$target_attributes_ptr = bk_ss_$control_ptr -> backup_control.target_attributes_ptr;
 400           end;
 401 
 402           do i = 1 to bk_ss_$control_ptr -> backup_control.request_count;
 403                if verify (bk_ss_$control_ptr -> backup_control.new_path (i), "^@") = 0 then
 404                     bk_ss_$control_ptr -> backup_control.new_path (i) = "";
 405                                                             /* can't have new pathname all zeros */
 406                bk_ss_$control_ptr -> backup_control.found (i) = "0"b;
 407                bk_ss_$control_ptr -> backup_control.loaded (i) = "0"b;
 408                bk_ss_$control_ptr -> backup_control.status_code (i) = 0;
 409                bk_ss_$control_ptr -> backup_control.error_name = "";
 410           end;
 411 
 412           bk_ss_$qchecksw = "1"b;
 413 
 414           if bk_ss_$control_ptr -> backup_control.request_count = 0 then
 415                bk_ss_$retrievesw = "0"b;
 416           else bk_ss_$retrievesw = "1"b;
 417 
 418           bk_ss_$myname = "backup_load_";
 419 
 420 COMMON:
 421           call hcs_$set_256K_switch ("11"b, old_256K_switch, code);
 422                                                             /* enable 256K connnections, ignore code */
 423           if reload_init then do;
 424                call hcs_$make_seg ("", "reload_preamble", "", 01011b, hp, code);
 425                call hcs_$make_seg ("", "reload_temp", "", 01011b, seg_buff, code);
 426                                                             /* Make segment buffer. */
 427                                                             /* THE FOLLOWING TWELVE LINES SHOULD BE REMOVED WHEN 256K SEGMENTS ARE INSTALLED. */
 428                if ^bk_ss_$debugsw then do;                  /* TEMPORARY CODE */
 429                     call hcs_$fs_get_path_name (seg_buff, temp_dir, temp_length, temp_entry, code);
 430                                                             /* TEMPORARY CODE */
 431                     on linkage_error
 432                          begin;
 433                          if bk_ss_$sub_entry then
 434                               call backup_map_$fs_error_line (error_table_$no_e_permission, (bk_ss_$myname), ">sl1",
 435                                    "phcs_$set_max_length");
 436                          else call com_err_ (error_table_$no_e_permission, bk_ss_$myname,
 437                                    ">sl1>phcs_$set_max_length^/Use -debug control argument.");
 438                          go to RETURN;
 439                     end;
 440                     call phcs_$set_max_length (temp_dir, temp_entry, sys_info$seg_size_256K, code);
 441                                                             /* TEMPORARY CODE */
 442                     revert linkage_error;
 443                end;                                         /* TEMPORARY CODE */
 444 
 445                call hcs_$set_max_length_seg (seg_buff, sys_info$seg_size_256K, code);
 446                line_pointer = addr (line);                  /* Set up pointer to line buffer. */
 447                reload_init = ""b;
 448           end;
 449 
 450 start:
 451           if bk_ss_$retrievesw then do;                     /* Is this a retrieval */
 452                if bk_ss_$sub_entry then
 453                     call bk_retrieve$parse_structure (hp, label_index);
 454                else call bk_retrieve$parse_retrieval_control (bk_ss_$rname, bk_ss_$rsize, hp, label_index);
 455                                                             /* pass retrieve seg name */
 456                                                             /* and preamble seg pointer for init */
 457                go to loc_label (label_index);               /* go to appropriate place on return */
 458           end;
 459 
 460 loc_label (1):
 461 parsed:
 462           if ^bk_ss_$debugsw then do;                       /* Check if this can be done. */
 463                if ^bk_ss_$qchecksw then                     /* Now check if it should be done */
 464                     call hphcs_$suspend_quota;              /* Disable quota-checking. */
 465                call hphcs_$fs_get_trans_sw (11b, old_trans_sw);
 466                                                             /* Set transparent usage, modification switches. */
 467                if (bk_ss_$myname = "reload") | (bk_ss_$myname = "iload") then do;
 468                     if ^bk_ss_$qchecksw then
 469                          if ^bk_ss_$no_reload then FRS = 1; /* reload to target diectly */
 470                end;
 471           end;
 472           call hcs_$proc_info ((""b), USERID, (""), (""b)); /* pid, pdir, lockid not needed */
 473           if USERID = "Initializer.SysDaemon.z" then INITIALIZER = "1"b;
 474           call bk_input$input_init (code);                  /* initialize tape read package */
 475           if code ^= 0 then do;
 476                call backup_map_$fs_error_line (code, "backup_load", "bk_input$input_init", "");
 477                if bk_ss_$sub_entry then a_code = code;
 478                go to terminate;                             /* Give up. */
 479           end;
 480           n = 0;                                            /* set length of id line */
 481           if bk_ss_$mapsw then                              /* Are we preparing a map listing? */
 482                                                             /* Format id line */
 483                call backup_util$idline (substr (bk_ss_$rname, 1, bk_ss_$rsize), "5 May 1982.", line_pointer, n);
 484 
 485           stptr = addr (status);                            /* get pointer to status_long return structure */
 486 
 487           dtp = clock;                                      /* Get starting time. */
 488           call backup_map_$beginning_line (dtp, line_pointer, n);
 489                                                             /* Begin reload. */
 490 
 491 
 492 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Main Processing Loop */
 493 
 494 
 495 loc_label (2):
 496 next:                                                       /* get first of next logical record */
 497           if MRS ^= 0 then do;                              /* must complete read of last seg */
 498                call bk_input$rd_tape (null (), (0), seg_buff, scnt, code);
 499                if code = 2 then code = 0;                   /* ok if run onto new tape */
 500                if code ^= 0 then go to TAPE_DONE;
 501                call hcs_$truncate_seg (seg_buff, 0, (code));/* throw away data */
 502                MRS = 0;                                     /* done with flushing read */
 503           end;
 504 
 505           if FRS = 0 then do;
 506                call bk_input$rd_tape (hp, hcnt, seg_buff, scnt, code);
 507                                                             /* read hdr, read seg to pdir */
 508           end;
 509           else do;                                          /* read hdr only, seg to pdir later */
 510                call bk_input$rd_tape (hp, hcnt, null (), scnt, code);
 511                                                             /* just header */
 512                if scnt > 0 then MRS = 1;                    /* remember to read seg later */
 513           end;
 514 
 515 
 516 TAPE_DONE:
 517           if code ^= 0 then do;                             /* check for end of last reload tape */
 518                if code = 1 then code = 0;                   /* Is this the end of the last tape? */
 519                if bk_ss_$sub_entry then a_code = code;
 520 
 521 /*        finish up and quit */
 522 
 523 loc_label (3):
 524 stop:
 525                call bk_input$input_finish;                  /* if done, clean up i/o */
 526 loc_label (4):
 527 terminate:
 528                if bk_ss_$retrievesw then call bk_retrieve$report_retrieval;
 529                                                             /* Report if doing a retrieval. */
 530 loc_label (5):
 531 reported:
 532                if ^bk_ss_$debugsw then do;                  /* Is this a real run? */
 533                     if ^bk_ss_$qchecksw then                /* Should we restore quota checking? */
 534                          call hphcs_$restore_quota;         /* Enable quota-checking. */
 535                     call hphcs_$fs_get_trans_sw (old_trans_sw, ts);
 536                                                             /* Restore switch settings. */
 537                end;
 538                dtp = clock;                                 /* Get stopping time. */
 539                call backup_map_$terminal_line (dtp, code);  /* Type normal or abnormal termination comment. */
 540                call hcs_$truncate_seg (hp, 0, code);        /* Clean up the buffer segments. */
 541                call hcs_$truncate_seg (seg_buff, 0, code);  /* .. */
 542                if bk_ss_$myname = "backup_load" | bk_ss_$myname = "backup_load_" then bk_ss_$myname = " ";
 543                                                             /* reset name if we set it */
 544 RETURN:
 545                call hcs_$set_256K_switch (old_256K_switch, (""b), (0));
 546                if bk_ss_$sub_entry then do;
 547                     if dir_priv_code = 0 then call system_privilege_$dir_priv_off ((0));
 548                     call backup_control_mgr_$terminate (control_ptr);
 549                end;
 550                return;                                      /* end of job */
 551           end;                                              /* make check for physical volume recovery */
 552                                                             /* and skip if pvnames don't match */
 553 /**** CORRECT FOR BUG IN 10.0 WHERE status_version = 0 but SHOULD = 2. */
 554 
 555           if hp -> h.status_version = 0 then hp -> h.status_version = 2;
 556 
 557           if bk_ss_$pvsw & hp -> h.status_version >= 2 & hp -> h.nss_info_relp ^= "0"b then
 558                if pointer (hp, hp -> h.nss_info_relp) -> bk_nss_info.pvname ^= bk_ss_$pvname then go to next;
 559 
 560           htype = hp -> h.record_type;                      /* Pick up record type. */
 561           dtp = hp -> h.dtd;                                /* pickup date and time record dumped */
 562           dtd_test = substr (bit (dtp, 52), 1, 36);         /* convert it to bit 36 for testing */
 563 
 564           call CHECK_FOR_NEW_DIRECTORY ();
 565 
 566           if bk_ss_$retrievesw then do;                     /* If retrieval check for correct seg */
 567                if bk_ss_$datesw                             /* Has a comparison date been given? */
 568                     then
 569                     if dtp < bk_ss_$date then go to next;   /* Must be copy dumped on or after the given date */
 570                call bk_retrieve$check_retrieval (label_index);
 571                go to loc_label (label_index);               /* if match go to checked else to next */
 572           end;
 573 
 574 
 575           else if htype = ndc_directory_list then go to checked;
 576                                                             /* 2nd pass for directory */
 577 
 578 /*        On reload check dates to see if later version already present         */
 579 
 580           else do;                                          /* Reload not retrieve */
 581                if ^bk_ss_$no_reload then do;
 582 get_dates:
 583                     call hcs_$status_long (hp -> h.dname, hp -> h.ename, 0, stptr, null, code);
 584                                                             /* get branch data */
 585                     if code ^= 0 then
 586                          if code = error_table_$noentry then go to checked;
 587                                                             /* New Segment */
 588                          else if code = error_table_$no_dir then go to checked;
 589                                                             /* New segment in reload */
 590                          else if code = error_table_$moderr | code = error_table_$incorrect_access then do;
 591 give_acc:
 592                               call backup_util$give_access (hp -> h.dname, hp -> h.ename, code);
 593                                                             /* Try to give ourselves access */
 594                               if code ^= 0 then do;
 595                                    call backup_map_$fs_error_line (code, "add_acl_entries backup_util$give_access",
 596                                         hp -> h.dname, hp -> h.ename);
 597                                    go to next;
 598                               end;
 599                               else go to get_dates;         /* Go try again */
 600                          end;                               /* end of easily recognizable errors */
 601                          else if ^bk_ss_$debugsw
 602                               & (code = error_table_$pvid_not_found | code = error_table_$vtoce_connection_fail) then do;
 603                               call hphcs_$delentry_file (hp -> h.dname, hp -> h.ename, code);
 604                               if code = 0 then go to checked;
 605                               if code = error_table_$moderr | code = error_table_$incorrect_access
 606                                    | code = error_table_$no_info then
 607                                    goto give_acc;
 608                               call backup_map_$fs_error_line (code, "hphcs_$delentry_file", hp -> h.dname, hp -> h.ename);
 609                               go to next;
 610                          end;
 611 
 612                          else do;                           /* Strange error so give up */
 613                               call backup_map_$fs_error_line (code, "hcs_$status_long", hp -> h.dname, hp -> h.ename);
 614                               go to next;
 615                          end;
 616 
 617 /*        Now actually check the dates            */
 618 
 619                     if dtd_test < status.dtm then           /* if dump earlier than seg in system */
 620                          if dtd_test < status.dtem then     /* and earlier than branch in system */
 621                               if ^bk_ss_$ignore_dates then  /* and the system dates are not unmeaningless */
 622                                    go to next;              /* then go get next */
 623                end;                                         /* finished with date testing */
 624           end;
 625 
 626 /*        Now start checking segment type on tape */
 627 
 628 loc_label (6):
 629 checked:
 630           type = 0;                                         /* Set up type for build_tree. */
 631 
 632           if (htype = ndc_directory | htype = ndc_directory_list | htype = sec_dir) & hp -> h.bitcnt ^= 0 then
 633                                                             /* MSF */
 634                call bk_retrieve$flag_msf (bk_ss_$retrieval_index);
 635 
 636           if bk_ss_$translate_access_class then do;         /* translate access class read from tape */
 637                call translate_aim_attributes_ (bk_ss_$source_attributes_ptr, hp -> h.access_class,
 638                     bk_ss_$target_attributes_ptr, access_class, code);
 639                if code ^= 0 then do;
 640                     call convert_aim_attributes_ (hp -> h.access_class, octal_string);
 641                     call backup_map_$error_line (code, bk_ss_$myname, "Attempting to translate access class ^a for ^a.",
 642                          octal_string, pathname_ ((hp -> h.dname), (hp -> h.ename)));
 643                     go to next;
 644                end;
 645                hp -> h.access_class = access_class;
 646           end;
 647 
 648           if htype = ndc_directory_list then do;            /* Is it the results of list_dir? */
 649 
 650 /* Directory listing:  clean it out if "trim" was specified and reload the links */
 651 
 652 do_directory_list:
 653                type = 3;                                    /* Set up type code. */
 654                optionsw = 0;                                /* Set up option switch. */
 655                call PRINT_HEADER ();
 656 
 657                if (htype = ndc_directory_list) & ^bk_ss_$no_reload then
 658                     if ^HAVE_SMA () then do;                /* force access so reload will work properly */
 659                          call expand_pathname_ ((hp -> h.dname), dirname_dirname, dirname_ename, (0));
 660                                                             /* get it as two pieces */
 661                          call backup_util$give_access ((dirname_dirname), (dirname_ename), code);
 662                          if code ^= 0 then do;
 663                               call backup_map_$fs_error_line (code, "backup_util$give_access", hp -> h.dname, "");
 664                               go to next;                   /* forget trying the rest: don't have sma on the dir */
 665                          end;
 666                     end;
 667 
 668                if bk_ss_$qchecksw then
 669                     on record_quota_overflow
 670                          begin;
 671                          code = error_table_$rqover;
 672                          if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b;
 673                          call UNCREATE;
 674                          go to no_dir;
 675                     end;
 676                if bk_ss_$sub_entry then bk_ss_$trimsw = bk_ss_$control_ptr -> backup_control.trim_sw (bk_ss_$path_index);
 677                call backup_load_dir_list (hp, code);        /* Go process the record. */
 678                if bk_ss_$qchecksw then revert record_quota_overflow;
 679                if code ^= 0 then do;                        /* Comment if any errors. */
 680 no_dir:
 681                     call backup_map_$fs_error_line (code, "backup_load_dir_list", hp -> h.dname, "");
 682                     go to next;
 683                end;
 684 
 685 
 686 /* Replace Initial ACL in as many rings as possible */
 687 
 688                if (htype = ndc_directory_list) & ^bk_ss_$no_reload then do;
 689                     unspec (inacl_info) = "0"b;             /* see if have to delete any existing ones */
 690                     call hcs_$list_inacl_all (hp -> h.dname, null, null, addr (inacl_info), code);
 691                     if code ^= 0 then do;
 692                          call backup_map_$fs_error_line (code, "hcs_$list_inacl_all", hp -> h.dname, "");
 693                          do ring = 0 to 7;                  /* mark non zero to force setting */
 694                               inacl_info.sia_count (ring) = 1;
 695                               inacl_info.dia_count (ring) = 1;
 696                          end;
 697                     end;
 698 
 699                     do ring = cu_$level_get () to 7;        /* Replace all initial ACL's from this ring on up. */
 700                          if (hp -> h.inaclc (ring) > 0) | (inacl_info.sia_count (ring) > 0) then do;
 701                               if hp -> h.inaclc (ring) = 0 then
 702                                    aclp = null ();
 703                               else aclp = pointer (hp, hp -> h.inaclp (ring));
 704                                                             /* Get a pointer to initial ACL. */
 705                               call hcs_$replace_inacl (hp -> h.dname, "", aclp, hp -> h.inaclc (ring), "1"b, ring, code);
 706                               if code ^= 0 then             /* Replace the initial ACL. */
 707                                    call backup_map_$fs_error_line (code, "hcs_$replace_inacl", hp -> h.dname, "");
 708                          end;
 709 
 710                          if (hp -> h.dir_inaclc (ring) > 0) | (inacl_info.dia_count (ring) > 0) then do;
 711                               if hp -> h.inaclc (ring) = 0 then
 712                                    aclp = null ();
 713                               else aclp = pointer (hp, hp -> h.dir_inaclp (ring));
 714                                                             /* Get a pointer to directory initial ACL. */
 715                               call hcs_$replace_dir_inacl (hp -> h.dname, "", aclp, hp -> h.dir_inaclc (ring), "1"b, ring,
 716                                    code);
 717                               if code ^= 0 then             /* Replace the directory initial ACL. */
 718                                    call backup_map_$fs_error_line (code, "hcs_$replace_dir_inacl", hp -> h.dname, "");
 719                          end;
 720                     end;
 721                end;
 722 
 723                go to next;
 724           end;
 725           bp = pointer (hp, hp -> h.bp);                    /* Get pointer to branch info. */
 726           np = pointer (hp, bp -> br (1).namerp);           /* Get pointer to name array. */
 727           optionsw = fixed (bp -> br (1).optionsw, 2);      /* Get option switch for call. */
 728 
 729 
 730 /*        check for segment type record           */
 731 
 732           if (htype = ndc_segment) | (htype = sec_seg) then go to load_it;
 733                                                             /* Is the record of a complete segment? */
 734 
 735 
 736 /*        check for directory type information in this record */
 737 
 738           if (htype = ndc_directory) | (htype = sec_dir) then do;
 739                                                             /* Is it a directory's info? */
 740 do_directory:
 741                if bk_ss_$no_reload then go to load_it;
 742                type = 2;                                    /* Set up type for build_tree. */
 743 
 744                do i = 1 to fixed (bp -> br (1).nnames, 17); /* Examine each name. */
 745                     ix = addr (np -> name (i));             /* Get pointer to this name element. */
 746                     call hcs_$status_minf (hp -> h.dname, ix -> name (1).string, 0, sys_type, bc, code);
 747                     if code ^= 0 then do;                   /* Error detected? */
 748                          if code ^= error_table_$noentry then
 749                                                             /* Entry missing, OK. */
 750                               if code ^= error_table_$no_dir then
 751                                                             /* Directory missing, OK. */
 752                                    call backup_map_$fs_error_line (code, "status_minf in backup_load",
 753                                                             /* Give comment. */
 754                                         hp -> h.dname, ix -> name (1).string);
 755                     end;
 756                     else if sys_type = 2 then do;           /* Entry exists, is it a directory? */
 757 
 758 
 759 /*        See if a directory with a conflicting name exists.
 760    If so, then assume that it is the directory we are trying
 761    to reload so add all reload info (names acls etc.) to it. */
 762 
 763                          if i > 1 then do;                  /* Ignore swap on first name. */
 764                               np -> name (1).size = ix -> name (1).size;
 765                                                             /* Replace first name with current one. */
 766                               np -> name (1).string = ix -> name (1).string;
 767                                                             /* .. */
 768                               ix -> name (1).size = bit (hp -> h.elen, 17);
 769                                                             /* Replace name with (first) name in header. */
 770                               ix -> name (1).string = hp -> h.ename;
 771                                                             /* .. */
 772                               hp -> h.elen = fixed (np -> name (1).size, 17);
 773                                                             /* Replace name in header with this one. */
 774                               hp -> h.ename = np -> name (1).string;
 775                                                             /* .. */
 776                          end;
 777                          go to load_it;                     /* Go do normal processing. */
 778                     end;
 779                end;
 780                go to load_it;                               /* Go load the info. */
 781           end;
 782           call date_time_ (dtp, dump_date);                 /* Convert the dump date. */
 783           call ioa_$rs ("Unrecognized record type ^d written ^a by ^a:^/^a>^a^/", line, n, htype, dump_date,
 784                hp -> h.dumper_id, hp -> h.dname, hp -> h.ename);
 785           call backup_map_$on_line (line_pointer, n);
 786           go to next;                                       /* Go try the next record. */
 787 
 788 
 789 /* * * * * * * * * * * * * * * * * * * * * Make entry for this segment or link. */
 790 
 791 
 792 load_it:
 793           if MRS ^= 0 then do;                              /* seg reload direct to target */
 794                if ^(HAVE_SMA ()) then do;                   /* dont dare */
 795                     call bk_input$rd_tape (null (), (0), seg_buff, scnt, code);
 796                     MRS = 0;
 797                     if code ^= 0 then do;
 798                          if code = 2 then code = 0;
 799                          if code = 0 then
 800                               go to next;
 801                          else go to TAPE_DONE;
 802                     end;
 803                end;
 804                else do;
 805                     save_ename = hp -> h.ename;             /* save real pri name */
 806                     save_elen = hp -> h.elen;               /* and its length */
 807                     hp -> h.ename = unique_chars_ (""b) || substr (save_ename, 1, 17);
 808                                                             /* make funny name */
 809                     hp -> h.elen = min (32, 15 + save_elen);
 810                end;
 811           end;
 812 
 813           if (htype = sec_seg) | (htype = sec_dir) then do;
 814                access_class = hp -> h.access_class;
 815                if (access_class & (^sys_info$access_class_ceiling)) ^= "0"b then go to set_ac;
 816                                                             /* pre AIM */
 817                if htype = sec_seg then do;
 818                     if hp -> h.switches.multiple_class then type = 4;
 819                                                             /* a upgraded segment */
 820                end;
 821                else do;
 822                     if hp -> h.switches.multiple_class then type = 5;
 823                                                             /* a upgraded directory */
 824                end;
 825           end;
 826           else do;
 827 set_ac:
 828                access_class = "0"b;                         /* old branch */
 829           end;
 830           if bk_ss_$sub_entry then bk_ss_$trimsw = bk_ss_$control_ptr -> backup_control.trim_sw (bk_ss_$path_index);
 831           bk_ss_$hp = hp;
 832           call backup_load_dir_list$build_tree (hp -> h.dname, hp -> h.ename, type, hp -> h.bitcnt, optionsw, "",
 833                access_class, code);
 834           if code ^= 0 then do;
 835                call backup_map_$fs_error_line (code, "build_tree", hp -> h.dname, hp -> h.ename);
 836                if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b;
 837                go to next;                                  /* and go get next logical record */
 838           end;
 839 
 840           else if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "1"b;
 841 
 842           unspec (reload_set_info) = "0"b;
 843           reload_set_info.version = reload_set_version_2;
 844 
 845           if ((htype = ndc_segment) | (htype = sec_seg)) then do;
 846                if ^bk_ss_$debugsw then do;
 847                     if hp -> h.max_length ^= sys_info$default_max_length then do;
 848                                                             /* only set if create_branch_ didn't */
 849                                                             /* already set correct value */
 850                                                             /* thus possibly avoiding setfault */
 851                          reload_set_info.should_set.max_length = "1"b;
 852                          reload_set_info.max_length = hp -> h.max_length;
 853                     end;
 854                end;
 855                else if ^bk_ss_$no_reload then do;
 856                     call hcs_$set_max_length ((hp -> h.dname), (hp -> h.ename), (hp -> h.max_length), code);
 857                     if code ^= 0 then                       /* Attempt to set max length of segment. */
 858                          call backup_map_$fs_error_line (code, "hcs_$set_max_length", hp -> dname, hp -> ename);
 859                end;
 860           end;                                              /*
 861                                                                /*     SKIP SEGMENT INITIATION AND COPYING IF NOT RELOADING
 862                                                                /*                                                                                     */
 863           if ^bk_ss_$no_reload then
 864                if scnt > 0 then do;                         /* Any segment to reload? */
 865                     if MRS = 0 then do;                     /* has been read to pdir already */
 866                          if bk_ss_$debugsw & ^bk_ss_$restore_access_class then
 867                               call hcs_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code);
 868                          else call system_privilege_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code);
 869                          if code ^= 0 then do;
 870                               call backup_map_$fs_error_line (code, "initiate", hp -> h.dname, hp -> h.ename);
 871                               go to next;                   /* go get next logical record */
 872                          end;
 873 
 874                          if bk_ss_$qchecksw                 /* If checking quotas */
 875                          then do;
 876                               on record_quota_overflow call handle_rqo;
 877                               segptr -> mover = seg_buff -> mover;
 878                                                             /* move it from temp seg */
 879                               revert record_quota_overflow; /* revert the condition */
 880                          end;
 881 
 882                          else segptr -> mover = seg_buff -> mover;
 883                                                             /* reload segment from temp i/o segment */
 884 
 885                          call hcs_$terminate_noname (segptr, code);
 886                                                             /* terminate segment after reloading */
 887                          if code ^= 0 then                  /* Print comment for error in terminate. */
 888                               call backup_map_$fs_error_line (code, "terminate_noname", hp -> h.dname, hp -> h.ename);
 889                     end;
 890 
 891 
 892                     else do;                                /* must still read seg & rename */
 893 
 894                          if bk_ss_$debugsw & ^bk_ss_$restore_access_class then
 895                               call hcs_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code);
 896                          else call system_privilege_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code);
 897                          if code ^= 0 then do;
 898                               call backup_map_$fs_error_line (code, "initiate", hp -> h.dname, hp -> h.ename);
 899 
 900                               call UNCREATE;
 901                               go to next;
 902                          end;                               /* seg has been initiated, actually couldn't fail.. */
 903                          if bk_ss_$qchecksw then on record_quota_overflow call handle_rqo;
 904                          call bk_input$rd_tape (null (), (0), segptr, scnt, code);
 905                                                             /* read data into seg */
 906                          if bk_ss_$qchecksw then revert record_quota_overflow;
 907                          MRS = 0;                           /* remember this is done */
 908                          if code ^= 0 then do;              /* tape trouble or EOT */
 909                               call UNCREATE;
 910                               if code = 2 then code = 0;
 911                               if code ^= 0 then
 912                                    go to TAPE_DONE;         /* err or no more tapes */
 913                               else go to next;
 914                          end;                               /* code from tape nonzero */
 915 
 916                          call hcs_$terminate_noname (segptr, code);
 917                          if code ^= 0 then
 918                               call backup_map_$fs_error_line (code, "terminate", hp -> h.dname, hp -> h.ename);
 919                                                             /* now must put pri name on seg */
 920                          call hcs_$chname_file (hp -> h.dname, hp -> h.ename, hp -> h.ename, save_ename, code);
 921                          if code ^= 0 then do;
 922                               if code = error_table_$namedup then do;
 923                                                             /* only sensible err */
 924                                    call backup_util$delete_name (hp -> h.dname, save_ename, code);
 925                                    if code ^= 0 then do;    /* can't happen */
 926 uncreate:
 927                                         if bk_ss_$sub_entry then do;
 928                                              bk_ss_$control_ptr -> backup_control.status_code (bk_ss_$path_index) =
 929                                                   error_table_$namedup;
 930                                              bk_ss_$control_ptr -> backup_control.error_name (bk_ss_$path_index) =
 931                                                   "backup_util$delete_name";
 932                                              bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b;
 933                                         end;
 934                                         call UNCREATE;
 935                                         go to next;
 936                                    end;
 937                                    else do;                 /* name was deleted */
 938                                         call hcs_$chname_file (hp -> h.dname, hp -> h.ename, hp -> h.ename, save_ename,
 939                                              code);
 940                                         if code ^= 0 then go to uncreate;
 941                                    end;
 942                               end;
 943                               else go to uncreate;
 944                          end;
 945                          hp -> h.ename = save_ename;
 946                          hp -> h.elen = save_elen;
 947                     end;                                    /* end loading seg from tape */
 948                end;                                         /* end loading seg */
 949           dtd = fixed (bp -> br (1).dtd, 52);               /* Get times from branch structure. */
 950           dtu = fixed (bp -> br (1).dtu, 52);
 951           dtem = fixed (bp -> br (1).dtbm, 52);
 952           dtsm = fixed (bp -> br (1).dtm, 52);
 953           call PRINT_HEADER ();
 954           if bk_ss_$mapsw then
 955                call backup_map_$detail_line2 (hp -> h.ename, divide (scnt + 1023, 1024, 9, 0), RECORD_TYPE (htype), dtp,
 956                     dtem, dtd, dtu, dtsm);
 957 
 958 /* Distribute the no_reload checks so that maps can be better */
 959 
 960           if (htype = sec_seg) | (htype = sec_dir) | (htype = ndc_segment) | (htype = ndc_directory) then
 961                if ^bk_ss_$debugsw then do;                  /* Insert author and activity if possible */
 962 
 963 
 964 /*        set the author                */
 965 
 966                     reload_set_info.should_set.author = "1"b;
 967                     reload_set_info.author = addr (hp -> h.quota) -> author;
 968 
 969                end;
 970 
 971 
 972 /*        set bitcount author and safety switch as well as the audit_flag */
 973 
 974           if (htype = sec_seg) | (htype = sec_dir) | (htype = ndc_segment) | (htype = ndc_directory) then do;
 975                if ^bk_ss_$debugsw then do;                  /* Cannot set bitcount author in debug mode. */
 976                     reload_set_info.should_set.bc_author = "1"b;
 977                     reload_set_info.bc_author = hp -> h.bitcount_author;
 978                     reload_set_info.should_set.safety_sw = "1"b;
 979                     reload_set_info.safety_sw = hp -> h.switches.safety_sw;
 980                     reload_set_info.should_set.audit_flag = "1"b;
 981                     reload_set_info.audit_flag = hp -> h.switches.audit_flag;
 982                end;
 983 
 984                else do;
 985                     if ^bk_ss_$no_reload then do;
 986                          call hcs_$set_safety_sw (hp -> dname, hp -> ename, (hp -> h.safety_sw), code);
 987                          if code ^= 0 & code ^= error_table_$incorrect_access then
 988                               call backup_map_$fs_error_line (code, "hcs_$set_safety_sw", hp -> dname, hp -> ename);
 989                           call system_privilege_$set_entry_audit_switch ((hp -> dname), (hp -> ename), (hp -> h.audit_flag), code);
 990                           if code ^= 0 then call backup_map_$fs_error_line (code, "system_privilege_$set_entry_audit_switch", hp -> dname, hp -> ename);
 991                     end;
 992                end;
 993           end;
 994 
 995 
 996           if htype = sec_seg then do;
 997                if hp -> h.switches.entrypt_sw = "0"b then
 998                     call_limiter = 0;                       /* not to be used */
 999                else call_limiter = fixed (hp -> h.entrypt_bound, 14);
1000                if ^bk_ss_$debugsw then do;
1001                     if call_limiter ^= 0 then do;           /* avoid setfault if possible */
1002                          reload_set_info.should_set.entry_bound = "1"b;
1003                          reload_set_info.entry_bound = call_limiter;
1004                     end;
1005                end;
1006                else do;
1007                     if ^bk_ss_$no_reload then do;
1008                          call hcs_$set_entry_bound (hp -> h.dname, hp -> h.ename, call_limiter, code);
1009                          if code ^= 0 & code ^= error_table_$incorrect_access then
1010                               call backup_map_$fs_error_line (code, "hcs_$set_entry_bound", hp -> h.dname, hp -> h.ename);
1011                     end;
1012                end;
1013           end;                                              /*        add names           */
1014 
1015           i = fixed (bp -> br (1).nnames, 17);              /* how many names are there? */
1016           if i > 1 then call backup_util$add_names (hp -> h.dname, hp -> h.ename, np, i, "1"b);
1017 
1018 
1019 /*        replace the acl     */
1020 
1021           if hp -> h.aclc = 0 then
1022                aclp = null ();
1023           else aclp = pointer (hp, hp -> h.aclp);           /* Get pointer to array. */
1024           code = 0;
1025 
1026           if (htype = ndc_segment) | (htype = sec_seg) then do;
1027                if ^bk_ss_$no_reload then do;
1028                     call hcs_$replace_acl (hp -> h.dname, hp -> h.ename, aclp, hp -> h.aclc, "1"b, code);
1029                     if code ^= 0 & code ^= error_table_$incorrect_access then
1030                          call backup_map_$fs_error_line (code, "hcs_$replace_acl", hp -> h.dname, hp -> h.ename);
1031                     go to set_rb;                           /* Now set the ring brackets. */
1032                end;
1033           end;
1034           else if (htype = ndc_directory) | (htype = sec_dir) then do;
1035                if ^bk_ss_$no_reload then do;
1036                     call hcs_$replace_dir_acl (hp -> h.dname, hp -> h.ename, aclp, hp -> h.aclc, "0"b, code);
1037 
1038                     if code ^= 0 & code ^= error_table_$incorrect_access then
1039                          call backup_map_$fs_error_line (code, "hcs_$replace_dir_acl", hp -> h.dname, hp -> h.ename);
1040                     go to set_rb;
1041                end;
1042           end;
1043 
1044 /* Now reload the ring brackets */
1045 
1046           if bp -> br (1).rb1 = ""b then do;                /* if from old tape and no ring brackets defined */
1047                i = 0;                                       /* set flag indicating default ring brackets set */
1048                rings (1), rings (2), rings (3) = 4;         /* 4 rather than 5? questionable! */
1049           end;
1050           else do;                                          /* pick up ring brackets from branch information */
1051 set_rb:
1052                i = 1;                                       /* set flag */
1053                rings (1) = fixed (bp -> br (1).rb1, 6);
1054                rings (2) = fixed (bp -> br (1).rb2, 6);
1055                rings (3) = fixed (bp -> br (1).rb3, 6);
1056           end;
1057 
1058           if bk_ss_$enforce_minimum_ring then do;
1059                rings (1) = max (bk_ss_$minimum_ring, rings (1));
1060                rings (2) = max (bk_ss_$minimum_ring, rings (2));
1061                rings (3) = max (bk_ss_$minimum_ring, rings (3));
1062           end;
1063 
1064           if ^bk_ss_$no_reload then
1065                if bp -> br (1).dirsw then
1066                     call hcs_$set_dir_ring_brackets (hp -> h.dname, hp -> h.ename, rings, code);
1067                else call hcs_$set_ring_brackets (hp -> h.dname, hp -> h.ename, rings, code);
1068           call print_rbs (rings);
1069           if code ^= 0 & code ^= error_table_$incorrect_access then
1070                call backup_map_$fs_error_line (code, "set_ring_brackets", hp -> h.dname, hp -> h.ename);
1071           else if i = 0 then do;                            /* check flag and put line in map (but not typed on-line) */
1072                call ioa_$rs ("Default ring brackets assigned to ^a>^a", line, n, hp -> h.dname, hp -> h.ename);
1073                call backup_map_$directory_line (line_pointer, n);
1074           end;
1075 
1076 
1077           if code = error_table_$incorrect_access then
1078                call backup_map_$fs_error_line (code, "ACL, ring brackets, safety switch", hp -> h.dname, hp -> h.ename);
1079 
1080 /*        set times           */
1081 
1082           times.dtem = fixed (bp -> br (1).dtbm, 52);       /* Copy time modified from entry. */
1083           if ^bk_ss_$retrievesw then                        /* Restore dtd if reload */
1084                times.dtd = dtp;                             /* Get time dumped from header. */
1085           else times.dtd = 0;                               /* On retrieval set dtd to 0, force dumping */
1086           times.dtu = fixed (bp -> br (1).dtu, 52);         /* Copy time used from entry. */
1087           times.dtm = fixed (bp -> br (1).dtm, 52);         /* Copy time segment modified from entry. */
1088           if ^bk_ss_$no_reload then
1089                if ^bk_ss_$debugsw then do;                  /* Do if really reloading */
1090                     reload_set_info.should_set.tpd = "1"b;
1091                     reload_set_info.tpd = hp -> h.switches.tpd;
1092                     reload_set_info.should_set.dtem, reload_set_info.should_set.dtd, reload_set_info.should_set.dtu,
1093                          reload_set_info.should_set.dtm = "1"b;
1094                     reload_set_info.dtem = substr(bit (times.dtem, 52),1,36);
1095                     reload_set_info.dtd = substr(bit (times.dtd, 52),1,36);
1096                     reload_set_info.dtu = substr(bit (times.dtu, 52),1,36);
1097                     reload_set_info.dtm = substr(bit (times.dtm, 52),1,36);
1098                     call hphcs_$set_for_reloader (hp -> h.dname, hp -> h.ename, addr (reload_set_info), code);
1099                     if code ^= 0 then
1100                          call backup_map_$fs_error_line (code, "hphcs_$set_for_reloader", hp -> h.dname, hp -> h.ename);
1101 
1102                     if reload_set_info.author_code ^= 0 then
1103                          call backup_map_$fs_error_line ((reload_set_info.author_code), "set_for_reloader(author)",
1104                               hp -> h.dname, hp -> h.ename);
1105 
1106                     if reload_set_info.bc_author_code ^= 0 then
1107                          call backup_map_$fs_error_line ((reload_set_info.bc_author_code), "set_for_reloader(bc_author)",
1108                               hp -> h.dname, hp -> h.ename);
1109 
1110                     if reload_set_info.max_length_code ^= 0 then
1111                          call backup_map_$fs_error_line ((reload_set_info.max_length_code),
1112                               "set_for_reloader(max_length)", hp -> h.dname, hp -> h.ename);
1113 
1114                     if reload_set_info.entry_bound_code ^= 0 then
1115                          call backup_map_$fs_error_line ((reload_set_info.entry_bound_code),
1116                               "set_for_reloader(entry_bound)", hp -> h.dname, hp -> h.ename);
1117 
1118                end;
1119 
1120           go to next;                                       /* segment reloaded, get next logical record */
1121 
1122 /*^L*/
1123 
1124 CHECK_FOR_NEW_DIRECTORY:
1125      proc ();
1126           if hp -> h.dname ^= old_dname then do;
1127                old_dname = substr (hp -> h.dname, 1, hp -> h.dlen);
1128                new_dir = "1"b;
1129           end;
1130           return;
1131      end CHECK_FOR_NEW_DIRECTORY;
1132 
1133 PRINT_HEADER:
1134      proc ();
1135           if new_dir then do;
1136                if bk_ss_$mapsw then call backup_map_$directory_line (addr (hp -> h.dname), hp -> h.dlen);
1137                new_dir = "0"b;
1138           end;
1139           return;
1140      end PRINT_HEADER;
1141 
1142 /* -------------------------------------------------- */
1143 
1144 HAVE_SMA:
1145      proc returns (bit (1) aligned);
1146 
1147 
1148 /* intl proc to make sure we have sma on parent before appending a unique
1149    named branch for later rename .
1150    get_user_effmode is called to get the mode, rather than
1151    status_ in order to avoid vtoc io.  However get user effmode
1152    does not correctly return the initializers access.   We know
1153    that access_mode, when really computing access will give the
1154    initializer access.  For this reason, and for the sake of efficiency,
1155    we do not wish to check the users access if the user is the
1156    initializer.
1157    For all other users we must check the access to make sure sma is
1158    there.  However if the directory for which access is to be computed
1159    is the same directory for which we las computed access, then we can
1160    just return the previously computed value.  This is another optimization.
1161    If the user is not initializer then if the directory is new then
1162    if the access computation is successful then we will remember that
1163    new dirname and access to it.
1164    10/01/75 -- RE Mullen */
1165 
1166 dcl  ckdir char (168);
1167 dcl  ckent char (32);
1168 dcl  ckcode fixed bin (35);
1169 dcl  effmode fixed bin (5);
1170           if INITIALIZER then return ("1"b);                /* always true */
1171           else if substr (hp -> h.dname, 1, hp -> h.dlen) = hs_dirname then return (hs_bit);
1172                                                             /* access known */
1173                                                             /* try to determine access */
1174           call expand_pathname_ (substr (hp -> h.dname, 1, hp -> h.dlen), ckdir, ckent, ckcode);
1175           if ckcode ^= 0 then return ("0"b);
1176           call hcs_$get_user_effmode (ckdir, ckent, USERID, cu_$level_get (), effmode, ckcode);
1177           if ckcode ^= 0 then
1178                return ("0"b);
1179           else do;                                          /* update assoc mem */
1180                if (bit (effmode) & "01011"b) = "01011"b then
1181                     hs_bit = "1"b;
1182                else hs_bit = "0"b;
1183                hs_dirname = substr (hp -> h.dname, 1, hp -> h.dlen);
1184                                                             /* remember name */
1185           end;
1186 
1187           return (hs_bit);                                  /* tell caller the result */
1188 
1189      end HAVE_SMA;
1190 
1191 
1192 
1193 /* ----------------------------------------------------------- */
1194 
1195 
1196 UNCREATE:
1197      proc;                                                  /* to delete seg mistakenly appended */
1198 
1199 dcl  hcs_$delentry_file entry (char (*) aligned, char (*) aligned, fixed bin (35));
1200 dcl  uccode fixed bin (35);
1201 
1202           call hcs_$set_copysw (hp -> h.dname, hp -> h.ename, "0"b, uccode);
1203           call hcs_$delentry_file (hp -> h.dname, hp -> h.ename, uccode);
1204           if uccode ^= 0 then call backup_map_$fs_error_line (uccode, "deleting temp_seg", hp -> h.dname, hp -> h.ename);
1205 
1206      end UNCREATE;
1207 
1208 
1209 handle_rqo:
1210      proc;                                                  /* record_quota_overflow handler */
1211 
1212 
1213           code = error_table_$rqover;                       /* set the error */
1214           call backup_map_$fs_error_line (code, "backup_load", hp -> h.dname, hp -> h.ename);
1215           call UNCREATE;
1216           if bk_ss_$sub_entry then do;
1217                bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b;
1218                go to next;
1219           end;
1220           go to next;
1221 
1222      end handle_rqo;
1223 
1224 /*^L*/
1225 
1226 /* Prints ACLs and ring brackets for reload map */
1227 
1228 printers:
1229      procedure ();
1230 
1231 declare  text character (168);
1232 declare  text_l fixed binary (21);
1233 
1234 %include acl_structures;
1235 
1236 
1237 /* Print ring brackets */
1238 
1239 print_rbs:
1240      entry (rings);
1241 
1242 declare  rings (3) fixed binary (3) parameter;
1243 
1244           call ioa_$rsnnl ("Ring Brackets:^35t^(^d ^)", text, text_l, rings);
1245           call backup_map_$name_line (addr (text), text_l);
1246 
1247           return;
1248 
1249      end printers;
1250 
1251      end backup_load;