backup_control_mgr_.pl1 11/11/89 1112.9r w 11/11/89 0809.5 132984 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * *********************************************************** */ /* Centralized module to convert between various versions of the backup_control structure */ /* Created: July 1982 by G. Palter */ /* format: style4,delnl,insnl,ifthenstmt,ifthen */ backup_control_mgr_: procedure (); return; /* not an entrypoint */ /* Parameters */ dcl P_backup_control_ptr pointer parameter; /* -> caller's possibly older backup_control structure */ dcl P_code fixed binary (35) parameter; /* Remaining declarations */ dcl 1 tape_entry_overlay aligned based, /* I wish PL/I had nulle */ 2 environmentptr pointer, 2 codeptr pointer; dcl system_area area based (system_area_ptr); dcl system_area_ptr pointer; dcl idx fixed binary; /* format: off */ dcl (error_table_$noalloc, error_table_$unimplemented_version) fixed binary (35) external; /* format: on */ dcl get_system_free_area_ entry () returns (pointer); dcl (addr, null, string) builtin; dcl area condition; %page; /* Older versions of the backup_control structure */ dcl 1 v1_backup_control aligned based (backup_control_ptr), 2 header, 3 backup_control_version fixed binary, 3 tape_entry entry (char (*)) variable, 3 options aligned, 4 map_sw bit (1) unaligned, 4 debug_sw bit (1) unaligned, 4 no_reload_sw bit (1) unaligned, 4 hold_sw bit (1) unaligned, 4 must_be_zero bit (32) unaligned, 3 request_count fixed binary, 2 requests (0 refer (v1_backup_control.request_count)), 3 path character (168) unaligned, 3 new_path character (168) unaligned, 3 found bit (1) aligned, 3 loaded bit (1) aligned, 3 status_code fixed binary (35), 3 error_name character (65) unaligned; dcl 1 v2_backup_control aligned based (backup_control_ptr), 2 header, 3 backup_control_version fixed binary, 3 tape_entry entry (char (*)) variable, 3 options aligned, 4 map_sw bit (1) unaligned, 4 debug_sw bit (1) unaligned, 4 no_reload_sw bit (1) unaligned, 4 hold_sw bit (1) unaligned, 4 must_be_zero bit (32) unaligned, 3 request_count fixed binary, 2 requests (0 refer (v2_backup_control.request_count)), 3 path character (168) unaligned, 3 new_path character (168) unaligned, 3 switches aligned, 4 no_primary_sw bit (1) unaligned, 4 trim_sw bit (1) unaligned, 4 zero_pad bit (34) unaligned, 3 found bit (1) aligned, 3 loaded bit (1) aligned, 3 status_code fixed binary (35), 3 error_name character (65) unaligned; dcl 1 v3_backup_control aligned based (backup_control_ptr), 2 header, 3 backup_control_version fixed binary, 3 tape_entry entry (character (*)) variable, 3 data_iocb pointer, 3 options aligned, 4 map_sw bit (1) unaligned, 4 debug_sw bit (1) unaligned, 4 no_reload_sw bit (1) unaligned, 4 hold_sw bit (1) unaligned, 4 preattached bit (1) unaligned, 4 error_file bit (1) unaligned, 4 first bit (1) unaligned, 4 caller_handles_conditions bit (1) unaligned, 4 allow_dir_overwrite bit (1) unaligned, 4 pad bit (27) unaligned, 3 request_count fixed binary, 2 requests (0 refer (v3_backup_control.request_count)), 3 path character (168) unaligned, 3 new_path character (168) unaligned, 3 switches aligned, 4 no_primary_sw bit (1) unaligned, 4 trim_sw bit (1) unaligned, 4 pad bit (34) unaligned, 3 found bit (1) aligned, 3 loaded bit (1) aligned, 3 status_code fixed binary (35), 3 error_name character (65) unaligned; dcl 1 v4_backup_control aligned based (backup_control_ptr), 2 header, /* allows people to use like (!) */ 3 backup_control_version character (8) unaligned, 3 tape_entry entry (character (*)) variable, /* returns next tape label */ 3 data_iocb pointer, /* -> I/O switch to use for dumping/loading if preattached */ 3 maximum_access_class bit (72) aligned, /* maximum access class for anything to be dumped */ 3 maximum_dir_access_class bit (72) aligned, /* no directory above this access class is dumped */ 3 user_for_access_check, /* data required to validate user's access */ 4 id character (32) unaligned, /* Person.Project.tag */ 4 authorization bit (72), /* the user's process authorization */ 4 ring fixed binary, /* the user's ring o execution */ 3 minimum_ring fixed binary, /* no ring bracket is set below this value */ 3 aim_translations, /* data required to translate AIM attributes on the tape */ 4 source_attributes_ptr pointer, 4 target_attributes_ptr pointer, 3 options aligned, 4 map_sw bit(1) unaligned, /* ON to write map segment */ 4 debug_sw bit (1) unaligned, /* ON to check quotas and not trim subtrees */ 4 no_reload_sw bit (1) unaligned, /* ON to not load for backup_load_ */ 4 hold_sw bit (1) unaligned, /* ON to not demount tape afterwards */ 4 preattached bit (1) unaligned, /* ON => perform loading/dumping to supplied I/O switch */ 4 error_file bit (1) unaligned, /* ON => generate an error file anyway */ 4 first bit (1) unaligned, /* ON => for reload, stop after all requests satisfied */ 4 caller_handles_conditions bit (1) unaligned, /* ON => caller of backup_dump_ handles faults */ 4 allow_dir_overwrite bit (1) unaligned, /* ON => allow reloaded seg to overwrite a dir */ 4 enforce_max_access_class bit (1) unaligned, /* ON => do not dump anything above given access class */ 4 dont_dump_upgraded_dirs bit (1) unaligned, /* ON => do not dump directories above given access class */ 4 check_effective_access bit (1) unaligned, /* ON => do not dump branches specified user can't touch */ 4 restore_access_class bit (1) unaligned, /* ON => restore AIM attributes even in debug mode */ 4 enforce_minimum_ring bit (1) unaligned, /* ON => do not give anything ring bracket below minimum */ 4 translate_access_class bit (1) unaligned, /* ON => translate access classes read from tape */ 4 pad bit (21) unaligned, 3 request_count fixed binary, /* # of entries to load or dump */ 2 requests (0 refer (v4_backup_control.request_count)), 3 path character (168) unaligned, /* pathname of object to be dumped/loaded */ 3 new_path character (168) unaligned, /* pathname for object when reloading if not same as above */ 3 switches aligned, 4 no_primary_sw bit (1) unaligned, /* do not use primary pathname */ 4 trim_sw bit (1) unaligned, /* trim target directories */ 4 pad bit (34) unaligned, 3 found bit(1) aligned, /* ON => found on tape by backup_load_ (output) */ 3 loaded bit (1) aligned, /* ON => loaded by backup_load_ (output) */ 3 status_code fixed binary (35), /* ON => per-entry status code (output) */ 3 error_name character (65) unaligned; /* ON => some information about what happened (output) */ dcl BACKUP_CONTROL_VERSION_4 character (8) static options (constant) initial ("hbc_0004"); %page; /* Converts the supplied input structure to the current version (if necessary) */ initiate: entry (P_backup_control_ptr, P_code); backup_control_ptr = P_backup_control_ptr; P_code = 0; /* assume success */ if backup_control.version = BACKUP_CONTROL_VERSION_5 then do; bk_ss_$control_ptr = backup_control_ptr; /* no problems: it's the current version */ return; end; if v1_backup_control.backup_control_version = 1 then backup_control_request_count = v1_backup_control.request_count; else if v2_backup_control.backup_control_version = 2 then backup_control_request_count = v2_backup_control.request_count; else if v3_backup_control.backup_control_version = 3 then backup_control_request_count = v3_backup_control.request_count; else if v4_backup_control.backup_control_version = BACKUP_CONTROL_VERSION_4 then backup_control_request_count = v4_backup_control.request_count; else do; /* unrecognized version */ P_code = error_table_$unimplemented_version; return; end; system_area_ptr = get_system_free_area_ (); on condition (area) begin; /* just in case we can't allocate it */ P_code = error_table_$noalloc; go to RETURN_FROM_INITIATE; end; allocate backup_control in (system_area) set (bk_ss_$control_ptr); revert condition (area); bk_ss_$control_ptr -> backup_control.version = BACKUP_CONTROL_VERSION_5; string (bk_ss_$control_ptr -> backup_control.options) = ""b; /* make sure all new options are off */ addr (bk_ss_$control_ptr -> backup_control.tape_entry) -> tape_entry_overlay = null (); bk_ss_$control_ptr -> backup_control.data_iocb = null (); bk_ss_$control_ptr -> backup_control.maximum_access_class = ""b; bk_ss_$control_ptr -> backup_control.minimum_access_class = ""b; bk_ss_$control_ptr -> backup_control.maximum_dir_access_class = ""b; bk_ss_$control_ptr -> backup_control.user_for_access_check.id = ""; bk_ss_$control_ptr -> backup_control.user_for_access_check.authorization = ""b; bk_ss_$control_ptr -> backup_control.user_for_access_check.ring = 0; bk_ss_$control_ptr -> backup_control.minimum_ring = 0; bk_ss_$control_ptr -> backup_control.aim_translations.source_attributes_ptr = null (); bk_ss_$control_ptr -> backup_control.aim_translations.target_attributes_ptr = null (); /* and give everything else reasonable default values */ if v1_backup_control.backup_control_version = 1 then do; bk_ss_$control_ptr -> backup_control.header = v1_backup_control.header, by name; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; string (bk_ss_$control_ptr -> backup_control.requests (idx).switches) = ""b; bk_ss_$control_ptr -> backup_control.requests (idx) = v1_backup_control.requests (idx), by name; end; end; if v2_backup_control.backup_control_version = 2 then do; bk_ss_$control_ptr -> backup_control.header = v2_backup_control.header, by name; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; string (bk_ss_$control_ptr -> backup_control.requests (idx).switches) = ""b; bk_ss_$control_ptr -> backup_control.requests (idx) = v2_backup_control.requests (idx), by name; end; end; if v3_backup_control.backup_control_version = 3 then do; bk_ss_$control_ptr -> backup_control.header = v3_backup_control.header, by name; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; string (bk_ss_$control_ptr -> backup_control.requests (idx).switches) = ""b; bk_ss_$control_ptr -> backup_control.requests (idx) = v3_backup_control.requests (idx), by name; end; end; if v4_backup_control.backup_control_version = BACKUP_CONTROL_VERSION_4 then do; bk_ss_$control_ptr -> backup_control.header = v4_backup_control.header, by name; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; string (bk_ss_$control_ptr -> backup_control.requests (idx).switches) = ""b; bk_ss_$control_ptr -> backup_control.requests (idx) = v4_backup_control.requests (idx), by name; end; end; RETURN_FROM_INITIATE: return; %page; /* Destroys the internal control structure (if any) but first copies the results into the caller's structure */ terminate: entry (P_backup_control_ptr); if P_backup_control_ptr = bk_ss_$control_ptr then /* nothing to do: caller supplied proper version */ return; backup_control_ptr = P_backup_control_ptr; system_area_ptr = get_system_free_area_ (); if v1_backup_control.backup_control_version = 1 then do; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; v1_backup_control.requests (idx).found = bk_ss_$control_ptr -> backup_control.requests (idx).found; v1_backup_control.requests (idx).loaded = bk_ss_$control_ptr -> backup_control.requests (idx).loaded; v1_backup_control.requests (idx).status_code = bk_ss_$control_ptr -> backup_control.requests (idx).status_code; v1_backup_control.requests (idx).error_name = bk_ss_$control_ptr -> backup_control.requests (idx).error_name; end; end; if v2_backup_control.backup_control_version = 2 then do; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; v2_backup_control.requests (idx).found = bk_ss_$control_ptr -> backup_control.requests (idx).found; v2_backup_control.requests (idx).loaded = bk_ss_$control_ptr -> backup_control.requests (idx).loaded; v2_backup_control.requests (idx).status_code = bk_ss_$control_ptr -> backup_control.requests (idx).status_code; v2_backup_control.requests (idx).error_name = bk_ss_$control_ptr -> backup_control.requests (idx).error_name; end; end; if v3_backup_control.backup_control_version = 3 then do; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; v3_backup_control.requests (idx).found = bk_ss_$control_ptr -> backup_control.requests (idx).found; v3_backup_control.requests (idx).loaded = bk_ss_$control_ptr -> backup_control.requests (idx).loaded; v3_backup_control.requests (idx).status_code = bk_ss_$control_ptr -> backup_control.requests (idx).status_code; v3_backup_control.requests (idx).error_name = bk_ss_$control_ptr -> backup_control.requests (idx).error_name; end; end; if v4_backup_control.backup_control_version = BACKUP_CONTROL_VERSION_4 then do; do idx = 1 to bk_ss_$control_ptr -> backup_control.request_count; v4_backup_control.requests (idx).found = bk_ss_$control_ptr -> backup_control.requests (idx).found; v4_backup_control.requests (idx).loaded = bk_ss_$control_ptr -> backup_control.requests (idx).loaded; v4_backup_control.requests (idx).status_code = bk_ss_$control_ptr -> backup_control.requests (idx).status_code; v4_backup_control.requests (idx).error_name = bk_ss_$control_ptr -> backup_control.requests (idx).error_name; end; end; free bk_ss_$control_ptr -> backup_control in (system_area); bk_ss_$control_ptr = null (); /* all gone */ return; %page; %include backup_control; %page; %include bk_ss_; end backup_control_mgr_;  backup_load.pl1 11/11/89 1112.9rew 11/11/89 0807.4 458856 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* The hierarchy reloader/retriever */ /* Created: February 1969 by R. C. Daley. */ /* Modified: 16 June 1970 by R. H. Campbell */ /* Modified: 21 October 1970 by R. J. Feiertag */ /* Modified: 10 May 1971 by R. A. Tilden */ /* Modified: 11 Nov 1973 by E. Stone to allow selected users to use 256K segs */ /* Modified: 22 July 1974 by R. E. Mullen for sec_seg + sec_dir types */ /* Modified: 21 October 1974 by A. Kobziar to handle access_mode field */ /* Modified: February 1975 by R. E. Mullen for tape, cpu, and paging speedups */ /* Modified: July 1975 by R. Bratt for new KST cleanup scheme, to burn our bridges behind us, to cleanup, and to fix an IACL reloading bug */ /* Modified: Autumn 1975 by R. E. Mullen to retune for NSS by not calling status_long for access_mode and to not set max length and entrybound when already set by create_branch_ */ /* Modified: February 1976 by R. Bratt to improve KST cleanup */ /* Modified: May 1976 by R. Bratt to handle deleted PVs */ /* Modified: September 1976 by R. Bratt to not do KST cleanup ditty */ /* Modified: 2 November 1977 by S. Herbst to add backup_load_ entry point */ /* Modified: 3 August 1979 by S. Herbst to add -trim and fix bugs */ /* Modified: 17 July 1980 by S. Herbst to test for phcs_ and hphcs_ access */ /* Modified: 6 November 1980 by G. Palter for version 3 backup_control structure */ /* Modified: 8 January 1981 by G. Palter to fix a bug which prevented reloading all entries in a directory which already existed online if the reloading process didn't already have "sma" access on the directory */ /* Modified: December 1981 by C. Hornig to remove calls to hphcs_$set_dir_size */ /* Modified: 21 January 1982 by S. Herbst to test for access to system_privilege_ in addition to phcs_ and hphcs_ */ /* Modified: 5 February 1982 by S. Herbst to retrieve an entire MSF without haing to specify ">**" */ /* Modified: 23 March 1982 by S. Herbst to omit date comparision on second pass for directories */ /* Modified: May 1982 by Benson I. Margulies to do ACLs straight forwardly */ /* Modified: July 1982 by G. Palter to add features for IMFT support of AIM: enforce a minimum ring for all created branches, restore the access class of the branch even if in debug mode, and translate access classes between systems */ /* BIM: 10/82: removed acl printing */ /* BIM: 2/83: Consider status_for_backup version 0 equivalent to 2 to */ /* clean up after hardcore bug in 10.0 */ /* Modified February 1983, E. N. Kittlitz. 256K segments */ /* Modified 1985-03-21, BIM: fixed prehistoric busted condition handler. -------- -- Fixed not to force access in no-reload mode. phx18650 -- does not reset transparency switches. phx17329 -- mishandling empty acls. phx17310 -- unitialized variables in cross-dumping. phx16651 -- rqovers on the map do not always get to level 2. phx13714 -- catching command_error conditions */ /****^ HISTORY COMMENTS: 1) change(87-07-15,GDixon), approve(87-07-15,MCR7617), audit(87-07-16,RBarstad), install(87-07-16,MR12.1-1041): Modified for change to backup_record_types.incl.pl1. 2) change(88-05-11,Lippard), approve(88-05-02,MCR7881), audit(88-06-15,Fawcett), install(88-08-02,MR12.2-1074): Changed to add reloading of the audit_flag attribute. This changed the reload_set_version to 2. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,ifthenstmt,ifthen */ backup_load: procedure (); dcl (i, n, hcnt, scnt, type, htype) fixed bin, /* temporary storage */ (old_trans_sw, sys_type, ts) fixed bin (2), /* Save previous settings of transparent switches. */ bc fixed bin, /* Segment bit count. */ dtd_test bit (36) aligned, /* time from backup to test for later copy */ (dtp, dtd, dtu, dtem, dtsm) fixed bin (52), /* Storage for various times. */ (np, ap, segptr, bp, aclp, ix) ptr, pp ptr, /* Use in an incl file. */ dump_date char (24), /* Storage for conversion of time record written. */ ring fixed bin (3), /* ring number for reloading initial ACLs */ old_dname char (168) varying init (""), /* Previous directory name. */ new_dir bit (1) aligned init ("1"b), /* set if name header needs printing */ optionsw fixed bin (2), /* Copy of option switch. */ save_ename char (32) aligned, /* real pri name of reloaded seg */ save_elen fixed bin, MRS fixed bin init (0), /* if nonzero must read seg still */ FRS fixed bin init (0), /* if nonzero reload directly to target seg, else pdir */ INITIALIZER bit (1) aligned init ("0"b), /* "1"b => user has total access */ hs_dirname char (168) varying aligned init (""), /* last dir for which HAVE_SMA was called */ hs_bit bit (1) init ("0"b), /* result of HAVE_SMA call */ USERID char (32), /* used by HAVE_SMA intl proc */ access_class bit (72) aligned, /* access class of branch */ (a_code, dir_priv_code, code) fixed bin (35), control_ptr ptr, /* ptr to control structure for backup_load_ */ octal_string character (32) aligned, dirname_dirname character (168), dirname_ename character (32); dcl old_256K_switch bit (2) aligned; dcl (cleanup, record_quota_overflow) condition; dcl label_index fixed bin; dcl temp_dir char (168) aligned, /* TEMPORARY CODE */ temp_entry char (32) aligned, /* TEMPORARY CODE */ temp_length fixed bin; /* TEMPORARY CODE */ dcl stptr ptr; /* pointer to status_long return area */ dcl 1 status aligned, /* status long return area */ ( 2 type bit (2), 2 nnames bit (16), 2 nrp bit (18), 2 dtm bit (36), 2 dtu bit (36), 2 mode bit (5), 2 padding bit (13), 2 records bit (18), 2 dtd bit (36), 2 dtem bit (36), 2 acct bit (36), 2 curlen bit (12), 2 bitcnt bit (24), 2 did bit (4), 2 mdid bit (4), 2 copysw bit (1), 2 pad2 bit (9), 2 rbs (0:2) bit (6), 2 uid bit (36) ) unaligned; dcl 1 inacl_info aligned, 2 sia_relp (0:7) bit (18), 2 sia_count (0:7) fixed bin, 2 dia_relp (0:7) bit (18), 2 dia_count (0:7) fixed bin; dcl rings (3) fixed bin (3); /* Ring brackets for non directory segments */ dcl reload_init bit (1) static initial ("1"b); /* Internal static. */ dcl line char (300) static, /* Output line(s) buffer. */ line_pointer ptr static, /* Pointer to line buffer. */ (hp, seg_buff) ptr static; dcl (phcs_sw, hphcs_sw, system_priv_sw) bit (1) init ("0"b); /* for testing access to gates */ dcl text char (32) varying; dcl ( error_table_$namedup, error_table_$noentry, error_table_$pvid_not_found, error_table_$vtoce_connection_fail, error_table_$moderr, error_table_$no_dir, error_table_$no_info, error_table_$no_e_permission, error_table_$incorrect_access, error_table_$rqover ) ext fixed bin (35); dcl sys_info$access_class_ceiling ext bit (72) aligned; dcl sys_info$default_max_length ext fixed bin (35); dcl sys_info$seg_size_256K fixed bin (19) ext; dcl linkage_error condition; dcl (addr, bit, clock, divide, fixed, max, min, null, pointer, substr, unspec, verify) builtin; dcl test_entry entry variable; dcl backup_control_mgr_$initiate entry (pointer, fixed binary (35)), backup_control_mgr_$terminate entry (pointer), backup_load_dir_list$build_tree entry (char (168) aligned, char (*) aligned, fixed bin, fixed bin (24), fixed bin (2), char (*) aligned, bit (72) aligned, fixed bin (35)), backup_load_dir_list entry (ptr, fixed bin (35)), backup_map_$name_line entry (ptr, fixed bin (21)), backup_map_$beginning_line entry (fixed bin (52), ptr, fixed bin), backup_map_$detail_line2 entry (char (32) aligned, fixed bin (9), char (10) aligned, fixed bin (52), fixed bin (52), fixed bin (52), fixed bin (52), fixed bin (52)), ( backup_map_$directory_line, backup_map_$on_line ) entry (ptr, fixed bin), backup_map_$error_line entry () options (variable), backup_map_$fs_error_line entry (fixed bin (35), char (*) aligned, char (*) aligned, char (*) aligned), backup_map_$terminal_line entry (fixed bin (52), fixed bin (35)), backup_util$add_names entry (char (168) aligned, char (32) aligned, ptr, fixed bin, bit (1)), backup_util$delete_name entry (char (168) aligned, char (32) aligned, fixed bin (35)), backup_util$give_access entry (char (168) aligned, char (32) aligned, fixed bin (35)), backup_util$idline entry (char (*), char (*), ptr, fixed bin), bk_input$input_init entry (fixed bin (35)), bk_input$rd_tape entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)), bk_retrieve$check_retrieval ext entry (fixed bin), bk_retrieve$flag_msf entry (fixed bin), bk_retrieve$parse_retrieval_control ext entry (char (168), fixed bin, ptr, fixed bin), bk_retrieve$parse_structure entry (ptr, fixed bin), bk_retrieve$report_retrieval ext entry, convert_aim_attributes_ entry (bit (72) aligned, character (32) aligned), cu_$arg_count entry (fixed bin), cu_$arg_list_ptr entry (ptr), cu_$level_get entry returns (fixed bin (3)), hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35)), hcs_$proc_info entry (bit (36) aligned, char (32), char (32), bit (36) aligned), bk_arg_reader_$reload_arg_reader entry (fixed bin, ptr, fixed bin (35)), date_time_ entry (fixed bin (52), char (*)), unique_chars_ entry (bit (*) aligned) returns (char (15) aligned), expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl hphcs_$set_for_reloader entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)), hphcs_$delentry_file entry (char (*) aligned, char (*) aligned, fixed bin (35)), hcs_$set_copysw entry (char (*) aligned, char (*) aligned, bit (1) aligned, fixed bin (35)), hcs_$set_entry_bound entry (char (*) aligned, char (*) aligned, fixed bin (14), fixed bin (35)), hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), hcs_$chname_file entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), hcs_$list_inacl_all entry (char (*) aligned, ptr, ptr, ptr, fixed bin (35)), hcs_$set_max_length entry (char (*), char (*), fixed bin (19), fixed bin (35)), phcs_$set_max_length entry (char (*) aligned, char (*) aligned, fixed bin (19), fixed bin (35)), /* TEMPORARY CODE */ hcs_$fs_get_path_name entry (ptr, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35)), /* TEMPORARY CODE */ hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)), hcs_$set_safety_sw entry (char (*) aligned, char (*) aligned, bit (1), fixed bin (35)), ( hcs_$replace_acl, hcs_$replace_dir_acl ) entry (char (*) aligned, char (*) aligned, ptr, fixed bin, bit (1), fixed bin (35)), ( hcs_$replace_inacl, hcs_$replace_dir_inacl ) entry (char (*) aligned, char (*) aligned, ptr, fixed bin, bit (1), fixed bin (3), fixed bin (35)), ( hcs_$set_ring_brackets, hcs_$set_dir_ring_brackets ) entry (char (*) aligned, char (*) aligned, (3) fixed bin (3), fixed bin (35)), hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), fixed bin, fixed bin (35)), hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin (5), fixed bin (5), fixed bin (35)), hcs_$status_long entry (char (*) aligned, char (*) aligned, fixed bin (1), ptr, ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)), hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)), hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)), pathname_ entry (character (*), character (*)) returns (character (168)), system_privilege_$dir_priv_off entry (fixed binary (35)), system_privilege_$dir_priv_on entry (fixed binary (35)), system_privilege_$initiate entry (char (*) aligned, char (*) aligned, char (*), fixed bin, fixed bin (2), ptr, fixed bin (35)), system_privilege_$set_entry_audit_switch entry (char (*), char (*), bit (1), fixed bin (35)), translate_aim_attributes_ entry (pointer, bit (72) aligned, pointer, bit (72) aligned, fixed binary (35)); dcl ( bk_input$input_finish, com_err_, ioa_$rsnnl, ioa_$rs, hphcs_$suspend_quota, hphcs_$restore_quota ) external entry options (variable); dcl hphcs_$fs_get_trans_sw entry (fixed bin (2), fixed bin (2)); dcl mover (scnt) based; /* To move words into new segment */ dcl call_limiter fixed bin (14); /* */ %include backup_dir_list; %page; %include bk_ss_; %page; %include bk_nss_info; %page; %include reload_set_info; %page; %include backup_fs_times; %page; %include backup_control; %page; %include backup_preamble_header; %page; %include backup_record_types; /* */ bk_ss_$sub_entry = "0"b; if bk_ss_$myname = " " then bk_ss_$myname = "backup_load"; /* set up name if called directly */ /* read in arguments and set switches */ call cu_$arg_count (i); /* Get the number of input arguments */ if i ^= 0 then do; /* Don't bother if no args */ call cu_$arg_list_ptr (ap); /* Get pointer to argument list */ call bk_arg_reader_$reload_arg_reader (1, ap, code); /* Do the work */ if code ^= 0 then do; /* Uh Oh, Trouble */ call com_err_ (code, "backup_load", ""); return; end; end; if ^bk_ss_$debugsw then do; /* check phcs_ and hphcs_ access */ phcs_sw, hphcs_sw = "0"b; on linkage_error begin; phcs_sw = "1"b; go to TRY2; end; test_entry = phcs_$set_max_length; /* test access to phcs_ gate */ TRY2: on linkage_error begin; hphcs_sw = "1"b; go to TRY3; end; test_entry = hphcs_$delentry_file; /* test access to hphcs_ gate */ TRY3: on linkage_error begin; system_priv_sw = "1"b; go to TRY4; end; test_entry = system_privilege_$initiate; /* test access to system_privilege_ gate */ TRY4: revert linkage_error; if phcs_sw | hphcs_sw | system_priv_sw then do; text = ""; call com_err_ (error_table_$moderr, bk_ss_$myname, "^[phcs_ ^]^[hphcs_ ^]^[system_privilege_^] Use -debug control argument to avoid calling privileged gates.", phcs_sw, hphcs_sw, system_priv_sw); go to RETURN; end; end; old_256K_switch = ""b; /* initialize for cleanup */ on cleanup begin; call hcs_$set_256K_switch (old_256K_switch, (""b), (0)); end; go to COMMON; backup_load_: entry (control_ptr, a_code); bk_ss_$sub_entry = "1"b; a_code = 0; call backup_control_mgr_$initiate (control_ptr, a_code); if a_code ^= 0 then return; dir_priv_code = -1; /* for cleanup handler */ old_256K_switch = ""b; /* ditto */ on condition (cleanup) begin; if dir_priv_code = 0 then call system_privilege_$dir_priv_off ((0)); call hcs_$set_256K_switch (old_256K_switch, (""b), (0)); call backup_control_mgr_$terminate (control_ptr); end; if bk_ss_$control_ptr -> backup_control.debug_sw then do; bk_ss_$debugsw = "1"b; bk_ss_$trimsw = "0"b; end; else bk_ss_$debugsw = "0"b; bk_ss_$mapsw = bk_ss_$control_ptr -> backup_control.map_sw; bk_ss_$no_reload = bk_ss_$control_ptr -> backup_control.no_reload_sw; bk_ss_$holdsw = bk_ss_$control_ptr -> backup_control.hold_sw; bk_ss_$allow_dir_overwrite = bk_ss_$control_ptr -> backup_control.allow_dir_overwrite; bk_ss_$preattached = bk_ss_$control_ptr -> backup_control.preattached; if bk_ss_$preattached then bk_ss_$data_iocb = bk_ss_$control_ptr -> backup_control.data_iocb; bk_ss_$sub_entry_errfile = bk_ss_$control_ptr -> backup_control.error_file; bk_ss_$onlysw = bk_ss_$control_ptr -> backup_control.first; bk_ss_$restore_access_class = bk_ss_$control_ptr -> backup_control.restore_access_class; if bk_ss_$restore_access_class then do; /* turn on directory privilege */ on condition (linkage_error) begin; a_code = error_table_$moderr; go to RETURN; end; call system_privilege_$dir_priv_on (dir_priv_code); if (dir_priv_code ^= 0) & (dir_priv_code ^= 1) then do; a_code = code; /* couldn't get it */ go to RETURN; end; revert condition (linkage_error); end; bk_ss_$enforce_minimum_ring = bk_ss_$control_ptr -> backup_control.enforce_minimum_ring; if bk_ss_$enforce_minimum_ring then bk_ss_$minimum_ring = bk_ss_$control_ptr -> backup_control.minimum_ring; bk_ss_$translate_access_class = bk_ss_$control_ptr -> backup_control.translate_access_class; if bk_ss_$translate_access_class then do; bk_ss_$source_attributes_ptr = bk_ss_$control_ptr -> backup_control.source_attributes_ptr; bk_ss_$target_attributes_ptr = bk_ss_$control_ptr -> backup_control.target_attributes_ptr; end; do i = 1 to bk_ss_$control_ptr -> backup_control.request_count; if verify (bk_ss_$control_ptr -> backup_control.new_path (i), "") = 0 then bk_ss_$control_ptr -> backup_control.new_path (i) = ""; /* can't have new pathname all zeros */ bk_ss_$control_ptr -> backup_control.found (i) = "0"b; bk_ss_$control_ptr -> backup_control.loaded (i) = "0"b; bk_ss_$control_ptr -> backup_control.status_code (i) = 0; bk_ss_$control_ptr -> backup_control.error_name = ""; end; bk_ss_$qchecksw = "1"b; if bk_ss_$control_ptr -> backup_control.request_count = 0 then bk_ss_$retrievesw = "0"b; else bk_ss_$retrievesw = "1"b; bk_ss_$myname = "backup_load_"; COMMON: call hcs_$set_256K_switch ("11"b, old_256K_switch, code); /* enable 256K connnections, ignore code */ if reload_init then do; call hcs_$make_seg ("", "reload_preamble", "", 01011b, hp, code); call hcs_$make_seg ("", "reload_temp", "", 01011b, seg_buff, code); /* Make segment buffer. */ /* THE FOLLOWING TWELVE LINES SHOULD BE REMOVED WHEN 256K SEGMENTS ARE INSTALLED. */ if ^bk_ss_$debugsw then do; /* TEMPORARY CODE */ call hcs_$fs_get_path_name (seg_buff, temp_dir, temp_length, temp_entry, code); /* TEMPORARY CODE */ on linkage_error begin; if bk_ss_$sub_entry then call backup_map_$fs_error_line (error_table_$no_e_permission, (bk_ss_$myname), ">sl1", "phcs_$set_max_length"); else call com_err_ (error_table_$no_e_permission, bk_ss_$myname, ">sl1>phcs_$set_max_length^/Use -debug control argument."); go to RETURN; end; call phcs_$set_max_length (temp_dir, temp_entry, sys_info$seg_size_256K, code); /* TEMPORARY CODE */ revert linkage_error; end; /* TEMPORARY CODE */ call hcs_$set_max_length_seg (seg_buff, sys_info$seg_size_256K, code); line_pointer = addr (line); /* Set up pointer to line buffer. */ reload_init = ""b; end; start: if bk_ss_$retrievesw then do; /* Is this a retrieval */ if bk_ss_$sub_entry then call bk_retrieve$parse_structure (hp, label_index); else call bk_retrieve$parse_retrieval_control (bk_ss_$rname, bk_ss_$rsize, hp, label_index); /* pass retrieve seg name */ /* and preamble seg pointer for init */ go to loc_label (label_index); /* go to appropriate place on return */ end; loc_label (1): parsed: if ^bk_ss_$debugsw then do; /* Check if this can be done. */ if ^bk_ss_$qchecksw then /* Now check if it should be done */ call hphcs_$suspend_quota; /* Disable quota-checking. */ call hphcs_$fs_get_trans_sw (11b, old_trans_sw); /* Set transparent usage, modification switches. */ if (bk_ss_$myname = "reload") | (bk_ss_$myname = "iload") then do; if ^bk_ss_$qchecksw then if ^bk_ss_$no_reload then FRS = 1; /* reload to target diectly */ end; end; call hcs_$proc_info ((""b), USERID, (""), (""b)); /* pid, pdir, lockid not needed */ if USERID = "Initializer.SysDaemon.z" then INITIALIZER = "1"b; call bk_input$input_init (code); /* initialize tape read package */ if code ^= 0 then do; call backup_map_$fs_error_line (code, "backup_load", "bk_input$input_init", ""); if bk_ss_$sub_entry then a_code = code; go to terminate; /* Give up. */ end; n = 0; /* set length of id line */ if bk_ss_$mapsw then /* Are we preparing a map listing? */ /* Format id line */ call backup_util$idline (substr (bk_ss_$rname, 1, bk_ss_$rsize), "5 May 1982.", line_pointer, n); stptr = addr (status); /* get pointer to status_long return structure */ dtp = clock; /* Get starting time. */ call backup_map_$beginning_line (dtp, line_pointer, n); /* Begin reload. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Main Processing Loop */ loc_label (2): next: /* get first of next logical record */ if MRS ^= 0 then do; /* must complete read of last seg */ call bk_input$rd_tape (null (), (0), seg_buff, scnt, code); if code = 2 then code = 0; /* ok if run onto new tape */ if code ^= 0 then go to TAPE_DONE; call hcs_$truncate_seg (seg_buff, 0, (code));/* throw away data */ MRS = 0; /* done with flushing read */ end; if FRS = 0 then do; call bk_input$rd_tape (hp, hcnt, seg_buff, scnt, code); /* read hdr, read seg to pdir */ end; else do; /* read hdr only, seg to pdir later */ call bk_input$rd_tape (hp, hcnt, null (), scnt, code); /* just header */ if scnt > 0 then MRS = 1; /* remember to read seg later */ end; TAPE_DONE: if code ^= 0 then do; /* check for end of last reload tape */ if code = 1 then code = 0; /* Is this the end of the last tape? */ if bk_ss_$sub_entry then a_code = code; /* finish up and quit */ loc_label (3): stop: call bk_input$input_finish; /* if done, clean up i/o */ loc_label (4): terminate: if bk_ss_$retrievesw then call bk_retrieve$report_retrieval; /* Report if doing a retrieval. */ loc_label (5): reported: if ^bk_ss_$debugsw then do; /* Is this a real run? */ if ^bk_ss_$qchecksw then /* Should we restore quota checking? */ call hphcs_$restore_quota; /* Enable quota-checking. */ call hphcs_$fs_get_trans_sw (old_trans_sw, ts); /* Restore switch settings. */ end; dtp = clock; /* Get stopping time. */ call backup_map_$terminal_line (dtp, code); /* Type normal or abnormal termination comment. */ call hcs_$truncate_seg (hp, 0, code); /* Clean up the buffer segments. */ call hcs_$truncate_seg (seg_buff, 0, code); /* .. */ if bk_ss_$myname = "backup_load" | bk_ss_$myname = "backup_load_" then bk_ss_$myname = " "; /* reset name if we set it */ RETURN: call hcs_$set_256K_switch (old_256K_switch, (""b), (0)); if bk_ss_$sub_entry then do; if dir_priv_code = 0 then call system_privilege_$dir_priv_off ((0)); call backup_control_mgr_$terminate (control_ptr); end; return; /* end of job */ end; /* make check for physical volume recovery */ /* and skip if pvnames don't match */ /**** CORRECT FOR BUG IN 10.0 WHERE status_version = 0 but SHOULD = 2. */ if hp -> h.status_version = 0 then hp -> h.status_version = 2; if bk_ss_$pvsw & hp -> h.status_version >= 2 & hp -> h.nss_info_relp ^= "0"b then if pointer (hp, hp -> h.nss_info_relp) -> bk_nss_info.pvname ^= bk_ss_$pvname then go to next; htype = hp -> h.record_type; /* Pick up record type. */ dtp = hp -> h.dtd; /* pickup date and time record dumped */ dtd_test = substr (bit (dtp, 52), 1, 36); /* convert it to bit 36 for testing */ call CHECK_FOR_NEW_DIRECTORY (); if bk_ss_$retrievesw then do; /* If retrieval check for correct seg */ if bk_ss_$datesw /* Has a comparison date been given? */ then if dtp < bk_ss_$date then go to next; /* Must be copy dumped on or after the given date */ call bk_retrieve$check_retrieval (label_index); go to loc_label (label_index); /* if match go to checked else to next */ end; else if htype = ndc_directory_list then go to checked; /* 2nd pass for directory */ /* On reload check dates to see if later version already present */ else do; /* Reload not retrieve */ if ^bk_ss_$no_reload then do; get_dates: call hcs_$status_long (hp -> h.dname, hp -> h.ename, 0, stptr, null, code); /* get branch data */ if code ^= 0 then if code = error_table_$noentry then go to checked; /* New Segment */ else if code = error_table_$no_dir then go to checked; /* New segment in reload */ else if code = error_table_$moderr | code = error_table_$incorrect_access then do; give_acc: call backup_util$give_access (hp -> h.dname, hp -> h.ename, code); /* Try to give ourselves access */ if code ^= 0 then do; call backup_map_$fs_error_line (code, "add_acl_entries backup_util$give_access", hp -> h.dname, hp -> h.ename); go to next; end; else go to get_dates; /* Go try again */ end; /* end of easily recognizable errors */ else if ^bk_ss_$debugsw & (code = error_table_$pvid_not_found | code = error_table_$vtoce_connection_fail) then do; call hphcs_$delentry_file (hp -> h.dname, hp -> h.ename, code); if code = 0 then go to checked; if code = error_table_$moderr | code = error_table_$incorrect_access | code = error_table_$no_info then goto give_acc; call backup_map_$fs_error_line (code, "hphcs_$delentry_file", hp -> h.dname, hp -> h.ename); go to next; end; else do; /* Strange error so give up */ call backup_map_$fs_error_line (code, "hcs_$status_long", hp -> h.dname, hp -> h.ename); go to next; end; /* Now actually check the dates */ if dtd_test < status.dtm then /* if dump earlier than seg in system */ if dtd_test < status.dtem then /* and earlier than branch in system */ if ^bk_ss_$ignore_dates then /* and the system dates are not unmeaningless */ go to next; /* then go get next */ end; /* finished with date testing */ end; /* Now start checking segment type on tape */ loc_label (6): checked: type = 0; /* Set up type for build_tree. */ if (htype = ndc_directory | htype = ndc_directory_list | htype = sec_dir) & hp -> h.bitcnt ^= 0 then /* MSF */ call bk_retrieve$flag_msf (bk_ss_$retrieval_index); if bk_ss_$translate_access_class then do; /* translate access class read from tape */ call translate_aim_attributes_ (bk_ss_$source_attributes_ptr, hp -> h.access_class, bk_ss_$target_attributes_ptr, access_class, code); if code ^= 0 then do; call convert_aim_attributes_ (hp -> h.access_class, octal_string); call backup_map_$error_line (code, bk_ss_$myname, "Attempting to translate access class ^a for ^a.", octal_string, pathname_ ((hp -> h.dname), (hp -> h.ename))); go to next; end; hp -> h.access_class = access_class; end; if htype = ndc_directory_list then do; /* Is it the results of list_dir? */ /* Directory listing: clean it out if "trim" was specified and reload the links */ do_directory_list: type = 3; /* Set up type code. */ optionsw = 0; /* Set up option switch. */ call PRINT_HEADER (); if (htype = ndc_directory_list) & ^bk_ss_$no_reload then if ^HAVE_SMA () then do; /* force access so reload will work properly */ call expand_pathname_ ((hp -> h.dname), dirname_dirname, dirname_ename, (0)); /* get it as two pieces */ call backup_util$give_access ((dirname_dirname), (dirname_ename), code); if code ^= 0 then do; call backup_map_$fs_error_line (code, "backup_util$give_access", hp -> h.dname, ""); go to next; /* forget trying the rest: don't have sma on the dir */ end; end; if bk_ss_$qchecksw then on record_quota_overflow begin; code = error_table_$rqover; if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b; call UNCREATE; go to no_dir; end; if bk_ss_$sub_entry then bk_ss_$trimsw = bk_ss_$control_ptr -> backup_control.trim_sw (bk_ss_$path_index); call backup_load_dir_list (hp, code); /* Go process the record. */ if bk_ss_$qchecksw then revert record_quota_overflow; if code ^= 0 then do; /* Comment if any errors. */ no_dir: call backup_map_$fs_error_line (code, "backup_load_dir_list", hp -> h.dname, ""); go to next; end; /* Replace Initial ACL in as many rings as possible */ if (htype = ndc_directory_list) & ^bk_ss_$no_reload then do; unspec (inacl_info) = "0"b; /* see if have to delete any existing ones */ call hcs_$list_inacl_all (hp -> h.dname, null, null, addr (inacl_info), code); if code ^= 0 then do; call backup_map_$fs_error_line (code, "hcs_$list_inacl_all", hp -> h.dname, ""); do ring = 0 to 7; /* mark non zero to force setting */ inacl_info.sia_count (ring) = 1; inacl_info.dia_count (ring) = 1; end; end; do ring = cu_$level_get () to 7; /* Replace all initial ACL's from this ring on up. */ if (hp -> h.inaclc (ring) > 0) | (inacl_info.sia_count (ring) > 0) then do; if hp -> h.inaclc (ring) = 0 then aclp = null (); else aclp = pointer (hp, hp -> h.inaclp (ring)); /* Get a pointer to initial ACL. */ call hcs_$replace_inacl (hp -> h.dname, "", aclp, hp -> h.inaclc (ring), "1"b, ring, code); if code ^= 0 then /* Replace the initial ACL. */ call backup_map_$fs_error_line (code, "hcs_$replace_inacl", hp -> h.dname, ""); end; if (hp -> h.dir_inaclc (ring) > 0) | (inacl_info.dia_count (ring) > 0) then do; if hp -> h.inaclc (ring) = 0 then aclp = null (); else aclp = pointer (hp, hp -> h.dir_inaclp (ring)); /* Get a pointer to directory initial ACL. */ call hcs_$replace_dir_inacl (hp -> h.dname, "", aclp, hp -> h.dir_inaclc (ring), "1"b, ring, code); if code ^= 0 then /* Replace the directory initial ACL. */ call backup_map_$fs_error_line (code, "hcs_$replace_dir_inacl", hp -> h.dname, ""); end; end; end; go to next; end; bp = pointer (hp, hp -> h.bp); /* Get pointer to branch info. */ np = pointer (hp, bp -> br (1).namerp); /* Get pointer to name array. */ optionsw = fixed (bp -> br (1).optionsw, 2); /* Get option switch for call. */ /* check for segment type record */ if (htype = ndc_segment) | (htype = sec_seg) then go to load_it; /* Is the record of a complete segment? */ /* check for directory type information in this record */ if (htype = ndc_directory) | (htype = sec_dir) then do; /* Is it a directory's info? */ do_directory: if bk_ss_$no_reload then go to load_it; type = 2; /* Set up type for build_tree. */ do i = 1 to fixed (bp -> br (1).nnames, 17); /* Examine each name. */ ix = addr (np -> name (i)); /* Get pointer to this name element. */ call hcs_$status_minf (hp -> h.dname, ix -> name (1).string, 0, sys_type, bc, code); if code ^= 0 then do; /* Error detected? */ if code ^= error_table_$noentry then /* Entry missing, OK. */ if code ^= error_table_$no_dir then /* Directory missing, OK. */ call backup_map_$fs_error_line (code, "status_minf in backup_load", /* Give comment. */ hp -> h.dname, ix -> name (1).string); end; else if sys_type = 2 then do; /* Entry exists, is it a directory? */ /* See if a directory with a conflicting name exists. If so, then assume that it is the directory we are trying to reload so add all reload info (names acls etc.) to it. */ if i > 1 then do; /* Ignore swap on first name. */ np -> name (1).size = ix -> name (1).size; /* Replace first name with current one. */ np -> name (1).string = ix -> name (1).string; /* .. */ ix -> name (1).size = bit (hp -> h.elen, 17); /* Replace name with (first) name in header. */ ix -> name (1).string = hp -> h.ename; /* .. */ hp -> h.elen = fixed (np -> name (1).size, 17); /* Replace name in header with this one. */ hp -> h.ename = np -> name (1).string; /* .. */ end; go to load_it; /* Go do normal processing. */ end; end; go to load_it; /* Go load the info. */ end; call date_time_ (dtp, dump_date); /* Convert the dump date. */ call ioa_$rs ("Unrecognized record type ^d written ^a by ^a:^/^a>^a^/", line, n, htype, dump_date, hp -> h.dumper_id, hp -> h.dname, hp -> h.ename); call backup_map_$on_line (line_pointer, n); go to next; /* Go try the next record. */ /* * * * * * * * * * * * * * * * * * * * * Make entry for this segment or link. */ load_it: if MRS ^= 0 then do; /* seg reload direct to target */ if ^(HAVE_SMA ()) then do; /* dont dare */ call bk_input$rd_tape (null (), (0), seg_buff, scnt, code); MRS = 0; if code ^= 0 then do; if code = 2 then code = 0; if code = 0 then go to next; else go to TAPE_DONE; end; end; else do; save_ename = hp -> h.ename; /* save real pri name */ save_elen = hp -> h.elen; /* and its length */ hp -> h.ename = unique_chars_ (""b) || substr (save_ename, 1, 17); /* make funny name */ hp -> h.elen = min (32, 15 + save_elen); end; end; if (htype = sec_seg) | (htype = sec_dir) then do; access_class = hp -> h.access_class; if (access_class & (^sys_info$access_class_ceiling)) ^= "0"b then go to set_ac; /* pre AIM */ if htype = sec_seg then do; if hp -> h.switches.multiple_class then type = 4; /* a upgraded segment */ end; else do; if hp -> h.switches.multiple_class then type = 5; /* a upgraded directory */ end; end; else do; set_ac: access_class = "0"b; /* old branch */ end; if bk_ss_$sub_entry then bk_ss_$trimsw = bk_ss_$control_ptr -> backup_control.trim_sw (bk_ss_$path_index); bk_ss_$hp = hp; call backup_load_dir_list$build_tree (hp -> h.dname, hp -> h.ename, type, hp -> h.bitcnt, optionsw, "", access_class, code); if code ^= 0 then do; call backup_map_$fs_error_line (code, "build_tree", hp -> h.dname, hp -> h.ename); if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b; go to next; /* and go get next logical record */ end; else if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "1"b; unspec (reload_set_info) = "0"b; reload_set_info.version = reload_set_version_2; if ((htype = ndc_segment) | (htype = sec_seg)) then do; if ^bk_ss_$debugsw then do; if hp -> h.max_length ^= sys_info$default_max_length then do; /* only set if create_branch_ didn't */ /* already set correct value */ /* thus possibly avoiding setfault */ reload_set_info.should_set.max_length = "1"b; reload_set_info.max_length = hp -> h.max_length; end; end; else if ^bk_ss_$no_reload then do; call hcs_$set_max_length ((hp -> h.dname), (hp -> h.ename), (hp -> h.max_length), code); if code ^= 0 then /* Attempt to set max length of segment. */ call backup_map_$fs_error_line (code, "hcs_$set_max_length", hp -> dname, hp -> ename); end; end; /* /* SKIP SEGMENT INITIATION AND COPYING IF NOT RELOADING /* */ if ^bk_ss_$no_reload then if scnt > 0 then do; /* Any segment to reload? */ if MRS = 0 then do; /* has been read to pdir already */ if bk_ss_$debugsw & ^bk_ss_$restore_access_class then call hcs_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code); else call system_privilege_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code); if code ^= 0 then do; call backup_map_$fs_error_line (code, "initiate", hp -> h.dname, hp -> h.ename); go to next; /* go get next logical record */ end; if bk_ss_$qchecksw /* If checking quotas */ then do; on record_quota_overflow call handle_rqo; segptr -> mover = seg_buff -> mover; /* move it from temp seg */ revert record_quota_overflow; /* revert the condition */ end; else segptr -> mover = seg_buff -> mover; /* reload segment from temp i/o segment */ call hcs_$terminate_noname (segptr, code); /* terminate segment after reloading */ if code ^= 0 then /* Print comment for error in terminate. */ call backup_map_$fs_error_line (code, "terminate_noname", hp -> h.dname, hp -> h.ename); end; else do; /* must still read seg & rename */ if bk_ss_$debugsw & ^bk_ss_$restore_access_class then call hcs_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code); else call system_privilege_$initiate (hp -> h.dname, hp -> h.ename, "", 0, 1, segptr, code); if code ^= 0 then do; call backup_map_$fs_error_line (code, "initiate", hp -> h.dname, hp -> h.ename); call UNCREATE; go to next; end; /* seg has been initiated, actually couldn't fail.. */ if bk_ss_$qchecksw then on record_quota_overflow call handle_rqo; call bk_input$rd_tape (null (), (0), segptr, scnt, code); /* read data into seg */ if bk_ss_$qchecksw then revert record_quota_overflow; MRS = 0; /* remember this is done */ if code ^= 0 then do; /* tape trouble or EOT */ call UNCREATE; if code = 2 then code = 0; if code ^= 0 then go to TAPE_DONE; /* err or no more tapes */ else go to next; end; /* code from tape nonzero */ call hcs_$terminate_noname (segptr, code); if code ^= 0 then call backup_map_$fs_error_line (code, "terminate", hp -> h.dname, hp -> h.ename); /* now must put pri name on seg */ call hcs_$chname_file (hp -> h.dname, hp -> h.ename, hp -> h.ename, save_ename, code); if code ^= 0 then do; if code = error_table_$namedup then do; /* only sensible err */ call backup_util$delete_name (hp -> h.dname, save_ename, code); if code ^= 0 then do; /* can't happen */ uncreate: if bk_ss_$sub_entry then do; bk_ss_$control_ptr -> backup_control.status_code (bk_ss_$path_index) = error_table_$namedup; bk_ss_$control_ptr -> backup_control.error_name (bk_ss_$path_index) = "backup_util$delete_name"; bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b; end; call UNCREATE; go to next; end; else do; /* name was deleted */ call hcs_$chname_file (hp -> h.dname, hp -> h.ename, hp -> h.ename, save_ename, code); if code ^= 0 then go to uncreate; end; end; else go to uncreate; end; hp -> h.ename = save_ename; hp -> h.elen = save_elen; end; /* end loading seg from tape */ end; /* end loading seg */ dtd = fixed (bp -> br (1).dtd, 52); /* Get times from branch structure. */ dtu = fixed (bp -> br (1).dtu, 52); dtem = fixed (bp -> br (1).dtbm, 52); dtsm = fixed (bp -> br (1).dtm, 52); call PRINT_HEADER (); if bk_ss_$mapsw then call backup_map_$detail_line2 (hp -> h.ename, divide (scnt + 1023, 1024, 9, 0), RECORD_TYPE (htype), dtp, dtem, dtd, dtu, dtsm); /* Distribute the no_reload checks so that maps can be better */ if (htype = sec_seg) | (htype = sec_dir) | (htype = ndc_segment) | (htype = ndc_directory) then if ^bk_ss_$debugsw then do; /* Insert author and activity if possible */ /* set the author */ reload_set_info.should_set.author = "1"b; reload_set_info.author = addr (hp -> h.quota) -> author; end; /* set bitcount author and safety switch as well as the audit_flag */ if (htype = sec_seg) | (htype = sec_dir) | (htype = ndc_segment) | (htype = ndc_directory) then do; if ^bk_ss_$debugsw then do; /* Cannot set bitcount author in debug mode. */ reload_set_info.should_set.bc_author = "1"b; reload_set_info.bc_author = hp -> h.bitcount_author; reload_set_info.should_set.safety_sw = "1"b; reload_set_info.safety_sw = hp -> h.switches.safety_sw; reload_set_info.should_set.audit_flag = "1"b; reload_set_info.audit_flag = hp -> h.switches.audit_flag; end; else do; if ^bk_ss_$no_reload then do; call hcs_$set_safety_sw (hp -> dname, hp -> ename, (hp -> h.safety_sw), code); if code ^= 0 & code ^= error_table_$incorrect_access then call backup_map_$fs_error_line (code, "hcs_$set_safety_sw", hp -> dname, hp -> ename); call system_privilege_$set_entry_audit_switch ((hp -> dname), (hp -> ename), (hp -> h.audit_flag), code); if code ^= 0 then call backup_map_$fs_error_line (code, "system_privilege_$set_entry_audit_switch", hp -> dname, hp -> ename); end; end; end; if htype = sec_seg then do; if hp -> h.switches.entrypt_sw = "0"b then call_limiter = 0; /* not to be used */ else call_limiter = fixed (hp -> h.entrypt_bound, 14); if ^bk_ss_$debugsw then do; if call_limiter ^= 0 then do; /* avoid setfault if possible */ reload_set_info.should_set.entry_bound = "1"b; reload_set_info.entry_bound = call_limiter; end; end; else do; if ^bk_ss_$no_reload then do; call hcs_$set_entry_bound (hp -> h.dname, hp -> h.ename, call_limiter, code); if code ^= 0 & code ^= error_table_$incorrect_access then call backup_map_$fs_error_line (code, "hcs_$set_entry_bound", hp -> h.dname, hp -> h.ename); end; end; end; /* add names */ i = fixed (bp -> br (1).nnames, 17); /* how many names are there? */ if i > 1 then call backup_util$add_names (hp -> h.dname, hp -> h.ename, np, i, "1"b); /* replace the acl */ if hp -> h.aclc = 0 then aclp = null (); else aclp = pointer (hp, hp -> h.aclp); /* Get pointer to array. */ code = 0; if (htype = ndc_segment) | (htype = sec_seg) then do; if ^bk_ss_$no_reload then do; call hcs_$replace_acl (hp -> h.dname, hp -> h.ename, aclp, hp -> h.aclc, "1"b, code); if code ^= 0 & code ^= error_table_$incorrect_access then call backup_map_$fs_error_line (code, "hcs_$replace_acl", hp -> h.dname, hp -> h.ename); go to set_rb; /* Now set the ring brackets. */ end; end; else if (htype = ndc_directory) | (htype = sec_dir) then do; if ^bk_ss_$no_reload then do; call hcs_$replace_dir_acl (hp -> h.dname, hp -> h.ename, aclp, hp -> h.aclc, "0"b, code); if code ^= 0 & code ^= error_table_$incorrect_access then call backup_map_$fs_error_line (code, "hcs_$replace_dir_acl", hp -> h.dname, hp -> h.ename); go to set_rb; end; end; /* Now reload the ring brackets */ if bp -> br (1).rb1 = ""b then do; /* if from old tape and no ring brackets defined */ i = 0; /* set flag indicating default ring brackets set */ rings (1), rings (2), rings (3) = 4; /* 4 rather than 5? questionable! */ end; else do; /* pick up ring brackets from branch information */ set_rb: i = 1; /* set flag */ rings (1) = fixed (bp -> br (1).rb1, 6); rings (2) = fixed (bp -> br (1).rb2, 6); rings (3) = fixed (bp -> br (1).rb3, 6); end; if bk_ss_$enforce_minimum_ring then do; rings (1) = max (bk_ss_$minimum_ring, rings (1)); rings (2) = max (bk_ss_$minimum_ring, rings (2)); rings (3) = max (bk_ss_$minimum_ring, rings (3)); end; if ^bk_ss_$no_reload then if bp -> br (1).dirsw then call hcs_$set_dir_ring_brackets (hp -> h.dname, hp -> h.ename, rings, code); else call hcs_$set_ring_brackets (hp -> h.dname, hp -> h.ename, rings, code); call print_rbs (rings); if code ^= 0 & code ^= error_table_$incorrect_access then call backup_map_$fs_error_line (code, "set_ring_brackets", hp -> h.dname, hp -> h.ename); else if i = 0 then do; /* check flag and put line in map (but not typed on-line) */ call ioa_$rs ("Default ring brackets assigned to ^a>^a", line, n, hp -> h.dname, hp -> h.ename); call backup_map_$directory_line (line_pointer, n); end; if code = error_table_$incorrect_access then call backup_map_$fs_error_line (code, "ACL, ring brackets, safety switch", hp -> h.dname, hp -> h.ename); /* set times */ times.dtem = fixed (bp -> br (1).dtbm, 52); /* Copy time modified from entry. */ if ^bk_ss_$retrievesw then /* Restore dtd if reload */ times.dtd = dtp; /* Get time dumped from header. */ else times.dtd = 0; /* On retrieval set dtd to 0, force dumping */ times.dtu = fixed (bp -> br (1).dtu, 52); /* Copy time used from entry. */ times.dtm = fixed (bp -> br (1).dtm, 52); /* Copy time segment modified from entry. */ if ^bk_ss_$no_reload then if ^bk_ss_$debugsw then do; /* Do if really reloading */ reload_set_info.should_set.tpd = "1"b; reload_set_info.tpd = hp -> h.switches.tpd; reload_set_info.should_set.dtem, reload_set_info.should_set.dtd, reload_set_info.should_set.dtu, reload_set_info.should_set.dtm = "1"b; reload_set_info.dtem = substr(bit (times.dtem, 52),1,36); reload_set_info.dtd = substr(bit (times.dtd, 52),1,36); reload_set_info.dtu = substr(bit (times.dtu, 52),1,36); reload_set_info.dtm = substr(bit (times.dtm, 52),1,36); call hphcs_$set_for_reloader (hp -> h.dname, hp -> h.ename, addr (reload_set_info), code); if code ^= 0 then call backup_map_$fs_error_line (code, "hphcs_$set_for_reloader", hp -> h.dname, hp -> h.ename); if reload_set_info.author_code ^= 0 then call backup_map_$fs_error_line ((reload_set_info.author_code), "set_for_reloader(author)", hp -> h.dname, hp -> h.ename); if reload_set_info.bc_author_code ^= 0 then call backup_map_$fs_error_line ((reload_set_info.bc_author_code), "set_for_reloader(bc_author)", hp -> h.dname, hp -> h.ename); if reload_set_info.max_length_code ^= 0 then call backup_map_$fs_error_line ((reload_set_info.max_length_code), "set_for_reloader(max_length)", hp -> h.dname, hp -> h.ename); if reload_set_info.entry_bound_code ^= 0 then call backup_map_$fs_error_line ((reload_set_info.entry_bound_code), "set_for_reloader(entry_bound)", hp -> h.dname, hp -> h.ename); end; go to next; /* segment reloaded, get next logical record */ /* */ CHECK_FOR_NEW_DIRECTORY: proc (); if hp -> h.dname ^= old_dname then do; old_dname = substr (hp -> h.dname, 1, hp -> h.dlen); new_dir = "1"b; end; return; end CHECK_FOR_NEW_DIRECTORY; PRINT_HEADER: proc (); if new_dir then do; if bk_ss_$mapsw then call backup_map_$directory_line (addr (hp -> h.dname), hp -> h.dlen); new_dir = "0"b; end; return; end PRINT_HEADER; /* -------------------------------------------------- */ HAVE_SMA: proc returns (bit (1) aligned); /* intl proc to make sure we have sma on parent before appending a unique named branch for later rename . get_user_effmode is called to get the mode, rather than status_ in order to avoid vtoc io. However get user effmode does not correctly return the initializers access. We know that access_mode, when really computing access will give the initializer access. For this reason, and for the sake of efficiency, we do not wish to check the users access if the user is the initializer. For all other users we must check the access to make sure sma is there. However if the directory for which access is to be computed is the same directory for which we las computed access, then we can just return the previously computed value. This is another optimization. If the user is not initializer then if the directory is new then if the access computation is successful then we will remember that new dirname and access to it. 10/01/75 -- RE Mullen */ dcl ckdir char (168); dcl ckent char (32); dcl ckcode fixed bin (35); dcl effmode fixed bin (5); if INITIALIZER then return ("1"b); /* always true */ else if substr (hp -> h.dname, 1, hp -> h.dlen) = hs_dirname then return (hs_bit); /* access known */ /* try to determine access */ call expand_pathname_ (substr (hp -> h.dname, 1, hp -> h.dlen), ckdir, ckent, ckcode); if ckcode ^= 0 then return ("0"b); call hcs_$get_user_effmode (ckdir, ckent, USERID, cu_$level_get (), effmode, ckcode); if ckcode ^= 0 then return ("0"b); else do; /* update assoc mem */ if (bit (effmode) & "01011"b) = "01011"b then hs_bit = "1"b; else hs_bit = "0"b; hs_dirname = substr (hp -> h.dname, 1, hp -> h.dlen); /* remember name */ end; return (hs_bit); /* tell caller the result */ end HAVE_SMA; /* ----------------------------------------------------------- */ UNCREATE: proc; /* to delete seg mistakenly appended */ dcl hcs_$delentry_file entry (char (*) aligned, char (*) aligned, fixed bin (35)); dcl uccode fixed bin (35); call hcs_$set_copysw (hp -> h.dname, hp -> h.ename, "0"b, uccode); call hcs_$delentry_file (hp -> h.dname, hp -> h.ename, uccode); if uccode ^= 0 then call backup_map_$fs_error_line (uccode, "deleting temp_seg", hp -> h.dname, hp -> h.ename); end UNCREATE; handle_rqo: proc; /* record_quota_overflow handler */ code = error_table_$rqover; /* set the error */ call backup_map_$fs_error_line (code, "backup_load", hp -> h.dname, hp -> h.ename); call UNCREATE; if bk_ss_$sub_entry then do; bk_ss_$control_ptr -> backup_control.loaded (bk_ss_$path_index) = "0"b; go to next; end; go to next; end handle_rqo; /* */ /* Prints ACLs and ring brackets for reload map */ printers: procedure (); declare text character (168); declare text_l fixed binary (21); %include acl_structures; /* Print ring brackets */ print_rbs: entry (rings); declare rings (3) fixed binary (3) parameter; call ioa_$rsnnl ("Ring Brackets:^35t^(^d ^)", text, text_l, rings); call backup_map_$name_line (addr (text), text_l); return; end printers; end backup_load;  backup_load_dir_list.pl1 11/11/89 1112.9r w 11/11/89 0809.5 346104 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Creates entries for the hierarhcy reloader/retriever and also processes the "directory_list" record */ /* Modified: 17 June 1970 by R. H. Campbell */ /* Modified: 16 November 1972 by M. A. Meer */ /* Modified: 20 December 1972 by A. Downing to make calls to old area package */ /* Modified: 21 October 1974 by A. Kobziar to add access_class arg to $build_tree */ /* Modified: 21 July 1975 by R. Bratt to fix bug in setting code and to remove pre 18-0 stuff */ /* Modified: Fall 1975 by R. E. Mullen for interim NSS reloader */ /* Modified: Winter 1976 by R. E. Mullen to speed up reloading for NSS by calling list_dir_fast */ /* Modified: February 1976 by T. VanVleck to remove change made by A. Kobziar to move quota on retrievals */ /* Modified: April 1976 by R. Bratt to reload sons_lvid and to expunge dir quota reloading krock */ /* Modified: 9 November 1977 by Steve Herbst */ /* Modified: 21 January 1982 by S. Herbst to not cross-retrieve a segment in place of an existing directory */ /* Modified: July 1982 by G. Palter to add features for IMFT support of AIM: enforce a minimum ring for all created branches, restore the access class of the branch even if in debug mode, and translate access classes between systems */ /* Fixed to use default rb's of 7,7 for dirs, 5,5,5 for segs 01/03/83 S. Herbst */ /* Modified to set dir_quota when appending on 12/84 by Keith Loepere. */ /* format: style4,delnl,insnl,ifthenstmt,ifthen */ backup_load_dir_list: procedure (hp1, code2) options (rename ((area_, old_area_), (alloc_, old_alloc_), (freen_, old_freen_))); dcl hp1 ptr, /* Pointer to preamble header structure. */ code2 fixed bin (35); /* Returned error code. */ dcl dname char (168) aligned, /* Directory path name. */ ename char (32) aligned, /* entry name */ pname char (*) aligned, /* Link path name if link. */ (code3, saved_code) fixed bin (35), /* Error code */ bit_count fixed bin (24), /* segment bit count */ optionsw fixed bin (2); /* Entry option switch. */ dcl dtp fixed bin (52); /* Times. */ dcl access_class bit (72) aligned; dcl (access_class_octal, tape_access_class_octal) character (32) aligned; dcl (access_class_text, tape_access_class_text) character (256); dcl ( hp, /* Pointer to preamble header. */ pp, /* Pointer to link path name. */ dqip, /* Pointer to dirquota info */ nip, /* pointer to nss_info */ sys_bp, tape_bp, /* Pointers to branch info arrays. */ sys_lp, tape_lp, /* Pointers to link info arrays. */ sys_links, tape_links, /* Pointers to chained link names. */ sys_dirs, tape_dirs, /* Pointers to chained directory names. */ sys_segs, tape_segs, /* Pointers to chained segment names. */ tape_ix, tape_np ) ptr; /* Pointers to current link info, name array. */ dcl ( sys_bc, tape_bc, /* Number of branches in directory. */ sys_lc, tape_lc, /* Number of links in directory. */ sys_segs_names, tape_segs_names, /* Number of segments in array. */ sys_dirs_names, tape_dirs_names, /* Number of directories in array. */ sys_links_names, tape_links_names, /* Number of links in array. */ tape_i, /* Index into link array for reload. */ rtype, /* Type of record for rebuild */ j ) fixed bin; dcl code fixed bin (35); dcl listp ptr static initial (null), /* Pointer to area for list_dir. */ list_area (65536) based (listp); /* Area for list_dir. */ dcl blank_time fixed bin (52) static options (constant) initial (-1); %include bk_ss_; %include bk_nss_info; dcl ( error_table_$noaccess, error_table_$namedup, error_table_$badpath, error_table_$root, error_table_$no_dir, error_table_$no_info, error_table_$incorrect_access, error_table_$ai_restricted ) fixed bin (35) ext; dcl sys_info$access_class_ceiling ext static bit (72) aligned; dcl name1_np based bit (18) aligned, /* Overlay to chain entry names. */ chars (0:8) fixed bin based; /* Overlay for comparison of names. */ dcl attempt fixed binary init (0); /* Counter to prevent loops. */ dcl rings (3) static fixed binary (6); /* Ring bracket array. */ dcl ETYPE_SEG fixed bin static options (constant) init (0); dcl ETYPE_LINK fixed bin static options (constant) init (1); dcl ETYPE_DIR fixed bin static options (constant) init (2); dcl ETYPE_PARENT_DIR fixed bin static options (constant) init (3); dcl ETYPE_UPGRADED_SEG fixed bin static options (constant) init (4); dcl ETYPE_UPGRADED_DIR fixed bin static options (constant) init (5); dcl routine (0:5) static options (constant) char (34) aligned initial ("append_seg", "append_link", "append_dir", "append_par_dir", "append_sp_seg", "append_up_dir"); dcl creating_directory static options (constant) character (19) initial ("Creating directory:"); dcl current_user char (32) aligned; dcl current_ring fixed bin; dcl old_area_ entry (fixed bin, ptr); /* call old_area_ instead of area_ */ dcl backup_load_dir_list$build_tree entry (char (168) aligned, char (32) aligned, fixed bin, fixed bin (24), fixed bin (2), char (*) aligned, bit (72) aligned, fixed bin (35)), backup_map_$detail_line2 entry (char (32) aligned, fixed bin (9), char (20) aligned, fixed bin (52), fixed bin (52), fixed bin (52), fixed bin (52), fixed bin (52)), backup_map_$directory_line entry (ptr, fixed bin), backup_map_$error_line entry () options (variable), backup_map_$fs_error_line entry (fixed bin (35), char (*) aligned, char (*) aligned, char (*) aligned), backup_util$add_names entry (char (168) aligned, char (32) aligned, ptr, fixed bin, fixed bin (1)), ( backup_util$delete_name, backup_util$give_access ) entry (char (168) aligned, char (32) aligned, fixed bin (35)); dcl cu_$level_get returns (fixed bin (6)), get_group_id_ ext entry returns (char (32) aligned), expand_pathname_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), convert_authorization_$to_string_short entry (bit (72) aligned, char (*), fixed bin (35)), convert_aim_attributes_ entry (bit (72) aligned, char (32) aligned), aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned), hcs_$append_branchx entry (char (*) aligned, char (*) aligned, fixed bin (5), (3) fixed bin (6), char (*) aligned, fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)), hcs_$create_branch_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)), hcs_$quota_move entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (35)), hcs_$append_link entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), hcs_$list_dir entry (char (*) aligned, (*) fixed bin, ptr, fixed bin, ptr, fixed bin, fixed bin (35)), hcs_$list_dir_fast entry (char (*) aligned, (*) fixed bin, ptr, fixed bin, ptr, fixed bin, fixed bin (35)), hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), hphcs_$set_backup_times entry (char (*) aligned, char (*) aligned, 1, 2 fixed bin (52), 2 fixed bin (52), 2 fixed bin (52), 2 fixed bin (52), fixed bin (35)), hcs_$status_ entry (char (*) aligned, char (*) aligned, fixed bin (1), ptr, ptr, fixed bin (35)), hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)), hcs_$get_access_class entry (char (*) aligned, char (*) aligned, bit (72) aligned, fixed bin (35)), hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)); dcl hphcs_$quota_reload entry (char (*) aligned, fixed bin, fixed bin (35), fixed bin (35), fixed bin, fixed bin (1), fixed bin (35)), hphcs_$dir_quota_restor entry (char (*) aligned, fixed bin, fixed bin (71), bit (36) aligned, fixed bin, fixed bin (1), fixed bin (35)), hphcs_$set_auth external entry (char (*) aligned, char (*) aligned, fixed bin, char (*) aligned, fixed bin (35)), hphcs_$set_sons_lvid entry (char (*) aligned, char (*) aligned, bit (36) aligned, fixed bin (35)), mdc_$find_lvname entry (bit (36) aligned, char (*), fixed bin (35)), ioa_$rsnnl entry options (variable), pathname_ entry (char (*), char (*)) returns (char (168)), system_privilege_$aim_check_soos external entry (char (*) aligned, char (*) aligned, fixed bin (35)); dcl (addr, bit, char, divide, fixed, length, max, null, pointer, ptr, rel, rtrim, substr, unspec) builtin; %include backup_record_types; %include backup_dir_list; %include backup_fs_times; %include backup_preamble_header; /* */ /* ENTRY to backup_load_dir_list it begins here */ code2 = 0; hp = hp1; /* Copy pointer to preamble header. */ current_user = get_group_id_ (); current_ring = cu_$level_get (); rtype = hp -> h.record_type; if rtype = ETYPE_DIR | rtype = ETYPE_PARENT_DIR | rtype = ETYPE_UPGRADED_DIR then rings (1), rings (2), rings (3) = 7; /* default for directories */ else rings (1), rings (2), rings (3) = 5; /* default for segments */ dtp = hp -> h.dtd; /* Copy time dumped from header. */ tape_bp = pointer (hp, hp -> h.bp); /* Make pointer to branch array. */ tape_bc = hp -> h.bc; /* Copy branch count from header. */ tape_lp = pointer (hp, hp -> h.lp); /* Make pointer to link array. */ tape_lc = hp -> h.lc; /* Copy link count from header. */ if bk_ss_$trimsw then do; /* Are we to prune excess entry names? */ if listp = null then do; /* Have we been had before? */ call hcs_$make_seg ("", "reload_area", "", 01011b, listp, code); /* Get segment for area. */ if listp = null then do; /* Successful? */ code2 = code; /* Return error code. */ go to check_ac_class; /* Skip to check parent section. */ end; end; call old_area_ (65536, listp); /* Clear area and get contents of system directory. */ call hcs_$list_dir_fast (hp -> h.dname, listp -> list_area, sys_bp, sys_bc, sys_lp, sys_lc, code); if code = 0 then do; /* Was call successful? */ if sys_lc > 0 then do; /* Are there any links in the system? */ call chain_links (sys_lp, sys_lc, sys_links, sys_links_names, 0); /* Chain all their names together. */ call chain_links (tape_lp, tape_lc, tape_links, tape_links_names, 1); /* Chain the names from the tape. */ call prune (sys_links, sys_links_names, tape_links, tape_links_names); /* Compare them and remove excess. */ end; if sys_bc > 0 then do; /* Are there any branches in the system? */ call chain_branches (sys_bp, sys_bc, sys_dirs, sys_dirs_names, sys_segs, sys_segs_names, 0); /* Chain names into two lists. */ call chain_branches (tape_bp, tape_bc, tape_dirs, tape_dirs_names, tape_segs, tape_segs_names, 1) ; /* Chain names from tape. */ if sys_dirs ^= null then if bk_ss_$dir_trim then /* Are there any directory names on line */ call prune (sys_dirs, sys_dirs_names, tape_dirs, tape_dirs_names); if sys_segs ^= null then /* Are there any segments in the system? */ call prune (sys_segs, sys_segs_names, tape_segs, tape_segs_names); /* Yes, examine and prune them. */ end; end; else if code ^= error_table_$no_dir then /* Gripe if unsuccessful (no access: no directory). */ call backup_map_$fs_error_line (code, "hcs_$list_dir_fast", hp -> h.dname, ""); code2 = code; /* Save error code. */ call hcs_$truncate_seg (listp, 0, code); /* Free up pages of segment. */ end; /* */ check_ac_class: /* See if should do the work */ if (hp -> h.access_class & (^sys_info$access_class_ceiling)) ^= "0"b then do; hp -> h.access_class, hp -> h.multiple_class = "0"b; /* old values */ end; rtype = ETYPE_DIR; /* assume regular directory */ if hp -> h.record_type = ndc_directory_list then if hp -> h.multiple_class then rtype = ETYPE_UPGRADED_DIR; /* an upgraded directory */ call hcs_$get_access_class (hp -> h.dname, "", access_class, code); if code ^= 0 then do; /* try creating parent(s) */ if hp -> h.record_type = ndc_directory_list then access_class = hp -> h.access_class; else access_class = "0"b; call backup_load_dir_list$build_tree (hp -> h.dname, "", rtype, 0, 0, "", access_class, code); if code ^= 0 then do; /* print error and give up */ call backup_map_$fs_error_line (code, "backup_load_dir_list$build_tree", hp -> h.dname, ""); code2 = code; /* return code */ go to bldl_ret; end; end; else if (current_ring <= 1) | bk_ss_$restore_access_class then do; /* insure that online branch has the same access class */ if hp -> h.record_type = ndc_directory_list then do; if ^aim_check_$equal (hp -> h.access_class, access_class) then do; call convert_authorization_$to_string_short (access_class, access_class_text, code); if code ^= 0 then do; call convert_aim_attributes_ (access_class, access_class_octal); access_class_text = access_class_octal; end; call convert_authorization_$to_string_short (bk_ss_$hp -> h.access_class, tape_access_class_text, code); if code ^= 0 then do; call convert_aim_attributes_ (bk_ss_$hp -> h.access_class, tape_access_class_octal); tape_access_class_text = tape_access_class_octal; end; call backup_map_$error_line (error_table_$ai_restricted, bk_ss_$myname, "Access class of branch ^a online (^[^a^;^ssystem_low^]) is not equal to access class on (^[^a^;^ssystem_low^])." , hp -> h.dname, (access_class_text ^= ""), access_class_text, (tape_access_class_text ^= ""), tape_access_class_text); code2 = error_table_$ai_restricted; go to bldl_ret; /* can't do this */ end; else go to reload_links; /* great match! */ end; /* use the access class in the parent */ end; /* */ reload_links: do tape_i = 1 to tape_lc; /* Reload each link. */ tape_ix = addr (tape_lp -> lk (tape_i)); /* Get pointer to this element. */ tape_np = pointer (tape_lp, tape_ix -> lk (1).namerp); /* Get first name. */ pp = pointer (tape_lp, tape_ix -> lk (1).pathnamerp); /* Get path name. */ call backup_load_dir_list$build_tree (hp -> h.dname, tape_np -> name (1).string, ETYPE_LINK, 0, 0, substr (pp -> path.name, 1, fixed (path.size, 17)), access_class, code); if code ^= 0 then do; /* If unsuccessful, print error comment. */ call backup_map_$fs_error_line (code, "backup_load_dir_list$build_tree", hp -> h.dname, tape_np -> name (1).string); go to next_link; /* Go get next link. */ end; call backup_util$add_names (hp -> h.dname, tape_np -> name (1).string, tape_np, fixed (tape_ix -> lk (1).nnames, 17), 0); /* if no_reload will simply print names in the map */ if ^bk_ss_$no_reload then do; times.dtem = fixed (tape_ix -> lk (1).dtm, 52); /* Copy time entry modified. */ times.dtd = dtp; /* Get new dump time. */ if ^bk_ss_$debugsw then call hphcs_$set_backup_times (hp -> h.dname, tape_np -> name (1).string, times, code); else code = 0; /* don't try */ if code ^= 0 then call backup_map_$fs_error_line /* If error reported, give comment. */ (code, "hphcs_$set_backup_times", hp -> h.dname, tape_np -> name (1).string); if hp -> h.record_type = ndc_directory_list then if ^(bk_ss_$debugsw) then do; call hphcs_$set_auth (hp -> h.dname, tape_np -> name (1).string, 0, pp -> path.author, code) ; if code ^= 0 then call backup_map_$fs_error_line (code, "hphcs_$set_auth", hp -> h.dname, tape_np -> name (1).string); end; end; next_link: end; if ^bk_ss_$no_reload & ^bk_ss_$debugsw then do; if (hp -> h.nss_info_relp ^= "0"b) & hp -> h.master_dir & ^bk_ss_$no_setlvid then do; /* must set sons lvid */ nip = ptr (hp, hp -> h.nss_info_relp); call mdc_$find_lvname (nip -> bk_nss_info.lvid, (""), code); if code = 0 then call hphcs_$set_sons_lvid (hp -> h.dname, "", nip -> bk_nss_info.lvid, code); if code ^= 0 then call backup_map_$fs_error_line (code, "hphcs_$set_sons_lvid", hp -> h.dname, ""); end; if bk_ss_$quotasw then do; /* Are we to restor quotas? */ call hphcs_$quota_reload (hp -> h.dname, hp -> h.quota, /* Reload secondary storage quotas. */ hp -> h.trp, hp -> h.tlu, hp -> h.inf_acct, hp -> h.term_acct, code); if code ^= 0 then call backup_map_$fs_error_line (code, "hphcs_$quota_reload", hp -> h.dname, ""); if hp -> dq_info_relp ^= ""b then do; /* if dirquota info is on tape */ dqip = ptr (hp, hp -> h.dq_info_relp); /* get ptr to dirquota info */ call hphcs_$dir_quota_restor (hp -> h.dname, dqip -> bk_dq_info.quota, dqip -> bk_dq_info.ltrp, dqip -> bk_dq_info.tlu, dqip -> bk_dq_info.inf_acct, dqip -> bk_dq_info.term_acct, code); end; if code ^= 0 then call backup_map_$fs_error_line (code, "hphcs_$dir_quota_restor", hp -> h.dname, ""); end; else if hp -> h.quota ^= 0 then do; /* -noquota was specified */ call ioa_$rsnnl ("Created directory ^a, quota should be ^d but -noquota specified", access_class_text, j, hp -> h.dname, hp -> h.quota); call backup_map_$directory_line (addr (access_class_text), j); end; if rtype = ETYPE_UPGRADED_DIR then do; /* a upgraded directory, created oos, so turn off now */ call system_privilege_$aim_check_soos (hp -> h.dname, "", code); if code ^= 0 then call backup_map_$fs_error_line (code, "system_privilege_$aim_check_soos", hp -> h.dname, ""); end; end; bldl_ret: return; /* Return to caller. */ /* */ /* Make branch in heirarchy for reloader * * * * * * * * * * * * */ build_tree: entry (dname, ename, type, bit_count, optionsw, pname, class, code3); dcl blank char (1) init (""), /* For blank line on map */ dir character (168) aligned, /* New directory path name. */ entry character (32) aligned, /* New entry name. */ dirsw fixed binary (1), class bit (72) aligned, /* access_class for append */ sys_type fixed binary (2), /* 0 = link, 1 = segment, 2 = directory. */ type fixed bin, branch_ptr pointer; dcl 1 status_info aligned, /* structure filled by hcs_$status_ */ ( 2 type bit (2), 2 nnames bit (16), 2 nrp bit (18), 2 dtm bit (36), 2 dtu bit (36), 2 mode bit (5), 2 pad bit (13), 2 records bit (18) ) unal; /* type : 0=seg, 1=link, 2=dir, 3=parent_dir, 4=upgraded_segment, 5=upgraded_directory */ %include create_branch_info; dcl 1 branch_info like create_branch_info aligned; /* need auto stor for the structure */ current_user = get_group_id_ (); current_ring = cu_$level_get (); if type = ETYPE_DIR | type = ETYPE_PARENT_DIR | type = ETYPE_UPGRADED_DIR then rings (1), rings (2), rings (3) = 7; /* default for directories */ else rings (1), rings (2), rings (3) = 5; /* default for segments */ dirsw = fixed ((type = ETYPE_DIR) | (type = ETYPE_UPGRADED_DIR), 1); /* get dirsw into bin (1) format */ if type = ETYPE_PARENT_DIR then go to no_access; /* Is only superior directory wanted? */ retry: attempt = attempt + 1; /* Count this call to append. */ if bk_ss_$no_reload then do; /* If debuging on line, skip below */ code3 = 0; /* Zero out code before returning */ go to bt_ret; end; if attempt > 3 then go to failed; /* Too many (noaccess, namedup, success)? */ if type ^= ETYPE_LINK then do; /* Try to append in specified directory */ if (current_ring > 1) & ^bk_ss_$restore_access_class then do; if bk_ss_$enforce_minimum_ring then do; rings (1) = max (bk_ss_$minimum_ring, rings (1)); rings (2) = max (bk_ss_$minimum_ring, rings (2)); rings (3) = max (bk_ss_$minimum_ring, rings (3)); end; call hcs_$append_branchx (dname, ename, 01111b, rings, current_user, dirsw, optionsw, bit_count, code3); end; else do; unspec (branch_info) = "0"b; branch_info.version = create_branch_version_2; branch_info.mode = "111"b; if type = ETYPE_SEG | type = ETYPE_UPGRADED_SEG then do; /* segment */ if bk_ss_$hp = null then go to default_rb; branch_ptr = ptr (bk_ss_$hp, bk_ss_$hp -> h.bp); if branch_ptr -> br (1).rb1 = "0"b then go to default_rb; branch_info.rings (1) = fixed (branch_ptr -> br (1).rb1, 6); branch_info.rings (2) = fixed (branch_ptr -> br (1).rb2, 6); branch_info.rings (3) = fixed (branch_ptr -> br (1).rb3, 6); end; else do; default_rb: branch_info.rings (1) = rings (1); branch_info.rings (2) = rings (2); branch_info.rings (3) = rings (3); end; if bk_ss_$enforce_minimum_ring then do; branch_info.rings (1) = max (bk_ss_$minimum_ring, branch_info.rings (1)); branch_info.rings (2) = max (bk_ss_$minimum_ring, branch_info.rings (2)); branch_info.rings (3) = max (bk_ss_$minimum_ring, branch_info.rings (3)); end; branch_info.userid = current_user; branch_info.switches.dir_sw = bit (dirsw, 1); branch_info.switches.copy_sw = substr (bit (optionsw, 2), 1, 1); branch_info.switches.chase_sw = "0"b; /* don't chase links */ if (type = ETYPE_UPGRADED_SEG) | (type = ETYPE_UPGRADED_DIR) then /* set for upgraded creation */ branch_info.switches.priv_upgrade_sw = "1"b; else branch_info.switches.priv_upgrade_sw = "0"b; branch_info.quota = 0; branch_info.dir_quota = 0; branch_info.bitcnt = bit_count; branch_info.access_class = class; call hcs_$create_branch_ (dname, ename, addr (branch_info), code3); if code3 ^= 0 then if code3 = error_table_$ai_restricted then do; call convert_authorization_$to_string_short (class, access_class_text, code); if code ^= 0 then do; call convert_aim_attributes_ (class, access_class_octal); access_class_text = access_class_octal; end; call backup_map_$error_line (code3, bk_ss_$myname, "Can not create branch ^a with access class ^[^a^;^ssystem_low^].", pathname_ ((dname), (ename)), (access_class_text ^= ""), access_class_text); go to bt_ret; end; end; end; else call hcs_$append_link (dname, ename, pname, code3); /* No, it's a link, try to append it. */ if code3 = error_table_$no_dir then do; no_access: if char (dname, 4) = "> " then do; /* Is it the root directory? */ code3 = error_table_$root; /* Set error code3. */ go to bt_ret; /* Give up. */ end; call expand_pathname_ (dname, dir, entry, code); /* Separate last entry from path */ if code ^= 0 then do; /* OK? */ call backup_map_$fs_error_line (code, "expand_pathname_", dname, ename); /* Gripe. */ go to bt_ret; /* Give up. */ end; if type ^= ETYPE_PARENT_DIR then if bk_ss_$mapsw then do; /* Is request to create superior directory? */ call backup_map_$directory_line (addr (blank), 1); /* Skip a line. */ call backup_map_$directory_line (addr (creating_directory), length (creating_directory)); call backup_map_$directory_line (addr (dname), length (rtrim (dname))); end; call backup_load_dir_list$build_tree (dir, entry, ETYPE_DIR, 0, 0, "", class, code3); /* Try creating directory */ if code3 = 0 then do; /* Successful? */ if type = ETYPE_PARENT_DIR then go to bt_ret; /* Do we have to create an entry? */ code3 = error_table_$noaccess; /* Set up error code3. */ go to retry; /* Retry creating original branch. */ end; else if code3 = error_table_$root then code3 = error_table_$badpath; end; else if code3 = error_table_$namedup then do; /* Did name already exist in directory? */ saved_code = code3; if (type = ETYPE_DIR) | (type = ETYPE_UPGRADED_DIR) then do; /* Were we trying to create directory? */ call hcs_$status_ (dname, ename, 0, addr (status_info), null (), code3); /* Don't chase links. */ sys_type = fixed (status_info.type); if code3 ^= 0 then /* Was call successful? */ if code3 = error_table_$no_info | code3 = error_table_$incorrect_access then do; give_acc: /* If no access, then recurse to get it. */ call backup_util$give_access (dname, ename, code3); if code3 = 0 then go to retry; /* Recurse to give ourselves access. */ else do; code3 = saved_code; go to bt_ret; end; end; else do; code3 = saved_code; go to bt_ret; /* Don't muddle about, it may be a directory. */ end; if sys_type = ETYPE_DIR then /* If name conflict, then dir already created. */ if (status_info.mode & "01011"b) ^= "01011"b then go to give_acc; /* If no access, then recurse to get it. */ else go to bt_ret; /* Directory is there. */ end; if bk_ss_$retrievesw & bk_ss_$cross_retrievesw & ^bk_ss_$allow_dir_overwrite then do; call hcs_$status_minf (dname, ename, 1, sys_type, 0, 0); if sys_type = ETYPE_DIR then do; call backup_map_$fs_error_line (code3, rtrim (bk_ss_$myname) || ": Attempt to cross-retrieve a segment in place of a directory or link to a directory.", dname, ename); go to bt_ret; end; end; if ^bk_ss_$no_reload then /* really loading something */ call backup_util$delete_name (dname, ename, code3); /* Not a directory, try to remove name. */ else code3 = 0; /* Don't create errors if not reloading. */ if code3 = 0 then do; /* Was name removed successfully? */ code3 = error_table_$namedup; /* Set up error code3 */ go to retry; /* Try append again. */ end; end; else if code3 = error_table_$no_info | code3 = error_table_$incorrect_access then do; saved_code = code3; call backup_load_dir_list$build_tree (dname, "", ETYPE_PARENT_DIR, 0, 0, "", class, code3); if code3 = 0 then go to retry; /* Recurse to get access to parent. */ else code3 = saved_code; /* end of recursion */ end; else if code3 ^= 0 then /* Was, perchance, all OK? */ failed: call backup_map_$fs_error_line (code3, routine (type), dname, ename); bt_ret: return; /* */ chain_branches: procedure (abp, bc, dir_root, dir_root_count, seg_root, seg_root_count, sys_tape_sw); /* proc to chain two branch lists */ dcl (abp, bp, dir_root, seg_root, prev_dir, prev_seg, ix, np, jx) pointer; dcl (bc, i, j, dir_root_count, seg_root_count, sys_tape_sw, sw, ic, dc, sc) fixed binary; bp = abp; /* Copy pointer to branch array. */ dc, sc = 0; /* Initialize directory, segment counts. */ if sys_tape_sw = 0 then sw = bc + 1; /* names from system */ else sw = 0; /* names from tape */ prev_dir, prev_seg = null; /* Indicate no previous names. */ do i = 1 to bc; /* Scan all branches. */ if sw = 0 then ic = i; /* link foward if from tape */ else ic = sw - i; /* link backward if in system */ ix = addr (bp -> br (ic)); /* Get pointer to this entry. */ np = pointer (ix, ix -> br (1).namerp); /* Get pointer to name array. */ if ix -> br (1).dirsw then /* Is this a directory? */ do j = 1 to fixed (ix -> br (1).nnames, 17); /* Yes, scan all its names. */ jx = addr (np -> name (j)); /* Get pointer to this name. */ if prev_dir = null then dir_root = jx; /* Were there any previous names? */ else prev_dir -> name1_np = rel (jx); /* Yes, point previous name to this. */ prev_dir = jx; /* Save this pointer for next time. */ dc = dc + 1; /* Count one directory name. */ end; else do j = 1 to fixed (ix -> br (1).nnames, 17); /* No, scan all its names. */ jx = addr (np -> name (j)); /* Get pointer to this name. */ if prev_seg = null then seg_root = jx; /* Were there any previous names? */ else prev_seg -> name1_np = rel (jx); /* Yes, chain previous name to this one. */ prev_seg = jx; /* Save this pointer for next time. */ sc = sc + 1; /* Count one segment name. */ end; end; if prev_dir = null then dir_root = null; /* Were there any directory names? */ else prev_dir -> name1_np = ""b; /* Yes, clear pointer in last name. */ if prev_seg = null then seg_root = null; /* Were there any segment names? */ else prev_seg -> name1_np = ""b; /* Yes, clear pointer in last name. */ dir_root_count = dc; /* Return count of directory names. */ seg_root_count = sc; /* Return count of segment names. */ end chain_branches; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ chain_links: procedure (alp, lc, root, root_count, sys_tape_sw); /* Proc to chain one link list */ dcl (alp, lp, root, previous, ix, np, jx) pointer; dcl (i, j, lc, root_count, sys_tape_sw, sw, ic, rc) fixed bin; lp = alp; /* Copy pointer to link array. */ rc = 0; /* Initialize count of number of names. */ if sys_tape_sw = 0 then sw = lc + 1; /* names from system */ else sw = 0; /* names from tape */ previous = null; /* Indicate no previous name. */ do i = 1 to lc; /* Scan all links. */ if sw = 0 then ic = i; /* names from tape thread foward */ else ic = sw - i; /* names in system thread backward */ ix = addr (lp -> lk (ic)); /* Get pointer to this entry. */ np = pointer (ix, ix -> lk (1).namerp); /* Extract pointer to its name array. */ do j = 1 to fixed (ix -> lk (1).nnames, 17); /* Scan each name. */ jx = addr (np -> name (j)); /* Get pointer to this name. */ if previous = null then root = jx; /* Any prevoius name? */ else previous -> name1_np = rel (jx); /* Yes, chain it to this one. */ previous = jx; /* Save this name for next time. */ rc = rc + 1; /* Count one name. */ end; end; if previous = null then root = null; /* Were there any names? */ else previous -> name1_np = ""b; /* Yes, clear final pointer. */ root_count = rc; /* Return count of number of names. */ end chain_links; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ prune: procedure (sys_root, sys_count, tape_root, tape_count);/* Procedure to prune excess entry names. */ dcl ( sys_root, tape_root, /* Pointers to the name lists. */ sys_np, tape_np ) pointer; /* Pointers to current names. */ dcl (k, sys_count, tape_count) fixed bin; dcl code fixed bin (35); if sys_root ^= null then do; /* If there are system names, */ if tape_root = null then do; /* If there are names on the tape, */ sys_np = sys_root; /* Copy pointer to system names. */ tape_np = pointer (tape_root, ""b); /* Fix pointer for end-of-names condition. */ go to force_delete; /* Start removal of all names in system. */ end; call sort_name_list (sys_root, sys_count); /* We must sort both lists. */ call sort_name_list (tape_root, tape_count); /* .. */ sys_np = sys_root; /* Copy pointer to system names. */ tape_np = tape_root; /* Copy pointer to names from tape. */ compare: do while (rel (sys_np)); /* Examine all system names. */ if rel (tape_np) then do k = 1 to 8; /* Have we finished all tape names? */ if sys_np -> chars (k) < tape_np -> chars (k) then do; /* If true, name in system not on tape */ force_delete: if bk_ss_$no_reload then code = 0; /* Not really reloading */ else call backup_util$delete_name (hp -> h.dname, sys_np -> name (1).string, code); if code ^= 0 then call backup_map_$fs_error_line /* If unsuccessful, error comment. */ (code, "backup_util$delete_name", hp -> h.dname, sys_np -> name (1).string); else if bk_ss_$mapsw then /* If all OK, write map_ if enabled. */ call backup_map_$detail_line2 (sys_np -> name (1).string, -1, "deleted", dtp, blank_time, -1, blank_time, blank_time); sys_np = pointer (sys_np, sys_np -> name1_np); /* Walk to next system name. */ go to compare; /* Go check for termination condition. */ end; if sys_np -> chars (k) > tape_np -> chars (k) then do; /* Name on tape not in system. */ tape_np = pointer (tape_np, tape_np -> name1_np); /* Walk to next tape name. */ go to compare; /* Go check terminating condition. */ end; end; /* No more names on tape, */ else go to force_delete; /* Force deletion of remaining system names. */ /* Name in system matches name on tape; leave it. */ sys_np = pointer (sys_np, sys_np -> name1_np); /* Walk to next name in system. */ tape_np = pointer (tape_np, tape_np -> name1_np); /* Walk to next name on tape. */ end; end; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ sort_name_list: procedure (root, count); /* Procedure to sort chained name list. */ dcl root ptr, (count, i, j, k, l, m, n, q, xi, xj, xk, xl, xq) fixed bin, ( vxi, vxj, vxk, vxq, v (count), np ) ptr, Cut fixed bin int static init (12), x (count) fixed bin, stacki (18) fixed bin, stackj (18) fixed bin; dcl 1 name_structure based aligned, 2 relnp bit (18) aligned, /* relative pointer to next name */ 2 name_string char (32) aligned; /* this is the name */ /* Set up arrays of pointers to names and indices of pointers */ if root = null then go to sort_ret; np = root; /* get pointer to first name structure */ if count = 1 then do; /* Not much to do here */ np -> relnp = ""b; go to sort_ret; /* Return */ end; do n = 1 to count; v (n) = np; x (n) = n; np = ptr (np, np -> name1_np); end; n = count; if n <= 15 then do; /* Do a fast shell sort for few names */ i = n; /* Initialize interval for shell sort */ do; down: i = 2 * divide (i, 4, 17, 0) + 1; /* Set the interval size for the sort */ do j = 1 to n - i; /* In steps of i so don't overshoot array */ k = j + i; /* Next higher index */ xk = x (k); /* Index from index array */ vxk = v (xk); /* Pointer for name comparison */ up: l = k - i; /* Lower index (will change inside the loop) */ xl = x (l); /* Lower index from index array */ if v (xl) -> name_string <= vxk -> name_string then go to in_order; x (k) = xl; /* Out of order so swap in index array */ k = l; /* Check next lower element in steps of size i */ if k > i then go to up; /* If there is a lower element then try it */ in_order: x (k) = xk; /* Put highest index away */ end; if i > 1 then go to down; /* Try next smaller interval size */ go to thread; /* Now thread the names */ end; end; i, m = 1; j = n; /* Now sort */ /* Start by getting and ordering first middle and last elements in current list */ /* Arrange indices accordingly since only they get sorted and set test value to middle value */ sloop: k = i; l = j; q = divide (i + j, 2, 17, 0); xi = x (i); xj = x (j); xq = x (q); vxi = v (xi); vxj = v (xj); vxq = v (xq); if vxq -> name_string < vxi -> name_string then if vxj -> name_string < vxi -> name_string then if vxq -> name_string < vxj -> name_string then do; x (i) = xq; x (q) = xj; x (j) = xi; vxq = vxj; end; else do; x (i) = xj; x (j) = xi; end; else do; x (i) = xq; x (q) = xi; vxq = vxi; end; else if vxj -> name_string < vxq -> name_string then if vxi -> name_string < vxj -> name_string then do; x (q) = xj; x (j) = xq; vxq = vxj; end; else do; x (q) = xi; x (i) = xj; x (j) = xq; vxq = vxi; end; /* Now order into lists above and below the test value */ lloop: l = l - 1; xl = x (l); if v (xl) -> name_string > vxq -> name_string then go to lloop; kloop: k = k + 1; xk = x (k); if v (xk) -> name_string < vxq -> name_string then go to kloop; if k <= l then do; x (k) = xl; x (l) = xk; go to lloop; end; if l - i < j - k then do; stacki (m) = k; stackj (m) = j; j = l; end; else do; stacki (m) = i; stackj (m) = l; i = k; end; m = m + 1; test: if j - i > Cut then go to sloop; if i = 1 then if i < j then go to sloop; /* Bubble sort if small number of names in this list */ /* Note that we do this for the lists headed by stacki(n) */ do i = i + 1 by 1 while (i <= j); k = i; xk = x (k); vxk = v (xk); bubble: l = k - 1; xl = x (l); if v (xl) -> name_string <= vxk -> name_string then go to ok; x (k) = xl; x (l) = xk; k = l; go to bubble; ok: end; /* Start work on the next list */ m = m - 1; if m = 0 then go to thread; i = stacki (m); j = stackj (m); go to test; thread: /* rethread the names in correct order */ xi = x (1); /* get first index */ np = v (xi); /* get first pointer */ root = np; /* point root to first name */ do i = 1 to n; /* now loop doing the rethread */ xi = x (i); np -> relnp = rel (v (xi)); /* np points to current and v(xi) points to next */ np = v (xi); end; np -> relnp = ""b; /* zero out last */ sort_ret: return; end sort_name_list; end prune; end backup_load_dir_list;  backup_map_.pl1 11/11/89 1112.9rew 11/11/89 0809.5 264123 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-03-03,GWMay), approve(87-03-03,MCR7627), audit(87-03-13,Farley), install(87-03-30,MR12.1-1018): removed on any_other condition. added a switch for handling dumper invokations vs reloader. END HISTORY COMMENTS */ /* Routines to format and write hierarchy backup/reload map lines */ /* Modified: 4 April 1970 by R. H. Campbell */ /* Modified: June 1971 by R. A. Tilden to add line counter */ /* Modified: 28 February 1980 by S. Herbst to write errors on error_output */ /* Modified: November 1980 by A. R. Downing to provide entry points to be used by the copy_dump_tape command to produce backup-like maps */ /* Modified: 19 October 1980 by G. Palter to create error file for subroutine entries if desired */ /* Modified: 21 January 1982 by S. Herbst to fix call to convert_status_code_ */ /* Modified: 7 May 1982 by G. Palter to make all entries respect the map flag */ /* Modified: July 1982 by G. Palter to add error_line entry */ /* Modified: 1985-03-19, BIM; any_other handler that gets out to level 2, detect error_table_$no_move */ /* format: style4,delnl,insnl,ifthenstmt,ifthen */ backup_map_: procedure (pointer, count); return; /* not a real entry */ dcl pointer pointer, count fixed binary, string character (count) based (pointer); dcl (addr, index, length, max, min, null, rtrim, substr, unspec) builtin; dcl i, n, nt, (ap, sp) pointer; dcl long_info character (100) aligned; dcl ignore character (8); dcl dir char (168) aligned internal static, /* settable by copy_dump_tape */ map_name character (32) internal static initial (""), dirname char (12), ent char (32), rings (3) fixed binary (3), code fixed binary (35); dcl ( error_table_$namedup, error_table_$ioname_not_found ) fixed binary (35) external; dcl backup_map character (32) init (""); /* Entry name of map segment. */ dcl unique_chars_ entry (bit (*) aligned) returns (character (15) aligned); /* Get unique name. */ dcl backup_map_$error_line entry () options (variable), backup_map_$heading_line entry, com_err_ entry options (variable), convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned), cu_$arg_count entry (fixed binary), cu_$arg_list_ptr entry (pointer), cv_bin_$dec entry (fixed binary, character (*) aligned), date_time_ entry (fixed binary (52), character (*) aligned), ( ioa_, ioa_$rs ) entry options (variable), /* Various arguments. */ ioa_$general_rs entry (pointer, fixed binary, fixed binary, character (*), fixed binary (21), bit (1) aligned, bit (1) aligned), ios_$attach entry (character (*), character (*), character (*), character (*), bit (72) aligned), ios_$detach entry (character (*), character (*), character (*), bit (72) aligned), ios_$write entry (character (*), pointer, fixed binary, fixed binary, fixed binary, bit (72) aligned), ios_$write_ptr entry (pointer, fixed binary, fixed binary), pathname_ entry (character (*), character (*)) returns (character (168)); dcl iox_$error_output ptr ext; dcl iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35)); /* For making a map or error file */ dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*) aligned, fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)), hcs_$acl_add1 entry (char (*) aligned, char (*), char (*) aligned, fixed bin (5), (3) fixed binary (3), fixed bin (35)), get_group_id_$tag_star returns (char (32) aligned), hcs_$fs_search_get_wdir entry (ptr, fixed bin), expand_pathname_ entry (char (*), char (*) aligned, char (*), fixed bin (35)), cu_$level_get returns (fixed bin); dcl not_initialized bit (1) static initial ("1"b), /* Initialization switch. */ page_size fixed bin static initial (55); /* Number of lines on a page */ dcl ( old_blocks fixed binary, /* Last values on detail line. */ (old_dtp, old_dtd, old_dtu, old_dtem, old_dtsm) fixed binary (52) ) static initial (-1); dcl line character (200) static, /* Output buffer. */ linep pointer static, /* Pointer to it. */ lines fixed bin static; /* How many have been written on current page */ dcl 1 p based (ap) aligned, /* Overlay for faster processing. */ 2 c (0:1) character (1) unaligned; /* Packed synchronous character array. */ dcl ascii character (12) aligned; /* Return string for call to cv_bin_$dec. */ dcl calendar_line character (24) aligned; /* Return string for call to date_time_. */ dcl (nl, eject, ht) static character (1); dcl 1 header1 static, /* First header line contains tape id */ 2 top character (1), /* New page character, usually */ 2 eol character (1), /* Skip a line */ 2 tapenames character (100) init (""), /* Text given to tapes entry */ length_hdr1 static fixed bin init (2); dcl 1 header2 static, /* Column headings. */ 2 name character (30) initial (" ENTRY NAME"), 2 blocks character (7) initial ("BLOCKS"), 2 type character (11) initial ("REC_TYPE"), 2 dtp character (7) initial ("TIME"), 2 dtem character (17) initial ("ENTRY_MODIFIED"), 2 dtd character (16) initial ("LAST_DUMPED"), 2 dtu character (17) initial ("LAST_USED"), 2 dtsm character (13) initial ("SEG._MODIFIED"), 2 eol character (1), /* End of line */ detail_ptr pointer static, /* Pointer to detail line. */ 1 detail static, /* Format for map detail lines. */ 2 sp character (1) init (""), /* Blank, col 0. */ 2 ( name character (32), /* Entry(name, col. 1 - 32. */ blocks character (3), /* Number of 1024-word blocks, col. 33 - 35. */ sp1 character (1), /* Blank, col. 36. */ record_type character (10) ) initial (""), /* Logical record type, col. 37 - 46. */ 2 dtp, /* Time entry processed. */ 3 ( sp1 character (1), /* Blank, col. 47. */ time character (6) ) initial (""), /* Time, col. 48 - 53. */ 2 dtem, /* Date and time entry modified. */ 3 ( sp character (1), /* Blank, col. 54. */ date character (8), /* Date, col. 55 - 62. */ sp1 character (1), /* Blank, col. 63. */ time character (6) ) initial (""), /* Time, col. 64 - 69. */ 2 dtd, /* Date and time last dumped. */ 3 ( sp2 character (2), /* Blanks, col. 70 - 71. */ date character (8), /* Date, col. 72 - 79. */ sp1 character (1), /* Blank, col. 80. */ time character (6) ) initial (""), /* Time, col. 81 - 86. */ 2 dtu, /* Date and time entry used. */ 3 ( sp character (1), /* Blank, col. 87. */ date character (8), /* Date, col. 88 - 95. */ sp1 character (1), /* Blank, col. 96. */ time character (6) ) initial (""), /* Time, col. 97 - 102. */ 2 dtsm, /* Date and time segment modified. */ 3 ( sp2 character (2), /* Blanks, col. 103 - 104. */ date character (8), /* Date, col. 105 - 112. */ sp1 character (1), /* Blank, col. 113. */ time character (6) ) initial (""); /* Time, col. 114 - 119. */ /* */ %include io_status; %page; %include backup_control; %page; %include bk_ss_; /* */ initializer: /* Initialize static storage. */ procedure; unspec (ht) = "000001001"b; /* Initialize character constants. */ unspec (nl) = "000001010"b; /* .. */ header1.eol, header2.eol = nl; /* .. */ unspec (eject) = "000001100"b; /* .. */ linep = addr (line); /* Set addresses compiler refuses to */ detail_ptr = addr (detail); /* .. */ not_initialized = ""b; /* Indicate our work is done. */ end initializer; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ update: procedure (old, new, date, time); /* Update stored times and place in detail line. */ dcl (old, new) fixed binary (52), /* The times. */ date character (8), time character (6); /* Date and time structure elements. */ old = new; /* Save for next time. */ date, time = ""; /* Blank the fields */ if old > 0 then do; /* Is it a "real" time? */ call date_time_ (old, calendar_line); /* Convert the value. */ date = substr (calendar_line, 1, 8); /* Rearrange the date and time. */ time = substr (calendar_line, 11, 6); end; else if old = 0 then time = "ZERO"; /* Has it ever been set? */ end update; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ trim: procedure (inp1, in_length); /* Procedure to replace blank strings with HT's. */ dcl (inp1, inp, outp) pointer; /* Pointers to aligned strings, may be same. */ dcl ( in_length, /* Number of characters in input string. */ nl_count, /* Number of NL's found at end of line. */ line_length, /* Temporary storage. */ field_begin, /* Beginning of 10-col. field. */ field_end, /* End of 10-col. field. */ last_non_blank, /* Last non-blank character in field. */ char_count ) fixed binary; /* Accumulating character count. */ dcl sample character (1); /* Sample character for comparisons. */ inp = inp1; /* Copy pointers to buffers. */ outp = linep; /* .. */ char_count = 0; /* Output string empty now. */ line_length = in_length; /* Get supplied line length. */ line_length = min (length (line), line_length) - 1; /* Convert to synchronous subscript. */ nl_count = 0; /* Clear count of NL characters. */ do line_length = line_length by -1 to 0; /* Trim off trailing blanks. */ sample = inp -> p.c (line_length); /* Get current character. */ if sample = nl then /* Is it a new-line? */ nl_count = nl_count + 1; /* Yes, count it. */ else if sample ^= ht then /* No, is it a tabulate? */ if sample ^= " " then /* No, is it a space? */ go to end_of_line; /* No, it is the last graphic. */ end; end_of_line: field_begin = 0; /* Set pointer to beginning of first field. */ do field_end = 9 by 10 to line_length; /* Consider each 10-col. field in turn. */ /* Search back for non-blank character. */ do last_non_blank = field_end by -1 to field_begin while (inp -> p.c (last_non_blank) = " "); end; do field_begin = field_begin to last_non_blank; /* Copy initial string. */ outp -> p.c (char_count) = inp -> p.c (field_begin); char_count = char_count + 1; /* Count this character. */ end; if field_end - last_non_blank > 1 then do; /* More than one blank? */ outp -> p.c (char_count) = ht; /* Insert a tabulate character. */ char_count = char_count + 1; /* Bump for one character. */ end; else if field_end - last_non_blank = 1 then do; /* Only one character blank? */ outp -> p.c (char_count) = " "; /* Insert a blank. */ char_count = char_count + 1; /* Count it. */ end; field_begin = field_end + 1; /* Set pointer to beginning of next field. */ end; do field_begin = field_begin to line_length; /* Copy remaining partial field. */ outp -> p.c (char_count) = inp -> p.c (field_begin); /* Move it. */ char_count = char_count + 1; /* Count this character. */ end; append_nl: outp -> p.c (char_count) = nl; /* Append NL character. */ char_count = char_count + 1; /* Bump character count. */ if nl_count > 1 then do; /* More to do? */ nl_count = nl_count - 1; /* Count this one. */ go to append_nl; /* Put on another one. */ end; n = char_count; /* Return output string length to caller. */ end trim; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ try_write: procedure (linep, n); /* Procedure to write a line */ dcl linep pointer, n fixed bin; /* its location and length */ dcl sub_err_ entry () options (variable); dcl error_table_$no_move fixed bin (35) ext static; bk_ss_$writing_map = "1"b; /* make map faults go to level 2, not silently get caught by backup_dump's wierd handler */ sp = addr (status); /* Set up pointer to status string. */ try_write: if lines > page_size then /* check if new page needed */ call backup_map_$heading_line; call ios_$write ("map", linep, 0, n, nt, sp -> status_bits); /* Try to write the line. */ if status.code = error_table_$no_move then do; call sub_err_ (status.code, "backup_map_", ACTION_CAN_RESTART, null (), (0), "Possible record quota overflow converting the map from an SSF or an MSF. Type ""start"" to retry."); go to try_write; end; if status.code = error_table_$ioname_not_found then do; /* Was map attached? */ try_attach: backup_map = unique_chars_ (""b) || ".backup.map"; /* Make up new map name. */ map_name = backup_map; /* static copy */ rings (1), rings (2), rings (3) = max ((cu_$level_get ()), 4); call hcs_$fs_search_get_wdir (addr (dir), length (dir)); call hcs_$append_branchx ((dir), (backup_map), 01011b, rings, (get_group_id_$tag_star ()), 0b, 0b, 0b, (0)) ; call hcs_$acl_add1 (dir, backup_map, "*.SysDaemon.*", 01011b, rings, (0)); call ios_$attach ("map", "file", backup_map, "w", sp -> status_bits); if status.code = 0 then do; /* Was attach successful? */ call ioa_ ("Map attached to file ""^a"".", backup_map); go to try_write; /* Now write the line. */ end; end; if status.code ^= 0 then do; /* Was write successful? */ discontinue_map: call com_err_ (status.code, "backup_map_", "^[^a^[>^]^a^]^/Map discontinued.", backup_map ^= "", dir, dir ^= ">", backup_map); bk_ss_$mapsw = ""b; go to exit; end; else if nt ^= n then do; /* Were all characters "transmitted"? */ call ioa_ ("backup_map_: Partial transmission; map will be detached."); call ios_$detach ("map", "", "", sp -> status_bits); /* Detach the map. */ if status.code = 0 then /* Detached OK? */ go to try_attach; /* Yes, get new segment and reattach. */ go to discontinue_map; /* No, gripe and clear switch. */ end; lines = lines + 1; /* Count this line */ bk_ss_$writing_map = "0"b; return; /* Return to caller. */ %include sub_err_flags; end try_write; /* */ directory_line: entry (pointer, count); /* Entry to write map line. */ if bk_ss_$mapsw then do; call trim (pointer, count); /* Move line to buffer, trim it, append NL. */ call try_write (linep, n); /* Write the line */ end; go to exit; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ on_line: entry (pointer, count); /* Entry to write on and off line. */ if not_initialized then call initializer; /* Set us up if necessary. */ call trim (pointer, count); /* Move, trim, and format line. */ write_on_line: if ^bk_ss_$sub_entry then call ios_$write_ptr (linep, 0, n); if ^bk_ss_$mapsw then go to exit; /* Finished if no map */ call try_write (addr (nl), 1); /* Skip a line */ call try_write (linep, n); /* Write the message */ go to exit; /* Finished */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ beginning_line: entry (time, pointer, count); /* Entry to write and type beginning comment. */ dcl time fixed binary (52); /* Time processing began. */ if not_initialized then call initializer; /* Set us up if necessary. */ call date_time_ (time, calendar_line); /* Convert the time. */ if ^bk_ss_$sub_entry then call ioa_ ("Begin at ^a", calendar_line); lines = 1; /* We are starting new page */ if ^bk_ss_$mapsw then go to exit; /* finished if no map */ call ioa_$rs ("^a^[. ^]Begin at ^a", line, n, pointer -> string, count ^= 0, calendar_line); if bk_ss_$brief_mapsw then do; /* skip two lines if -brief_map */ call try_write (addr (nl), 1); lines = lines + 1; /* extra nl */ end; else do; call try_write (addr (eject), 1); /* Else skip to new page. */ lines = 1; end; call try_write (linep, n); /* Write the line */ header1.top = nl; /* Disable eject in header */ go to try_head; /* Go emit page headings */ /* * * * ** * * * * * * * * * * * * * * * * * * * * * * * * */ terminal_line: entry (time, flag); /* Entry to write and type termination comment. */ dcl flag fixed binary; /* Error code. */ if not_initialized then call initializer; /* Rare, but possible */ call date_time_ (time, calendar_line); /* Convert the time. */ if flag = 0 then /* Make up appropriate comment. */ call ioa_$rs ("Normal termination ^a.", line, n, calendar_line); else call ioa_$rs ("Error ^d; Abnormal termination ^a.", line, n, flag, calendar_line); if ^bk_ss_$sub_entry then call ios_$write_ptr (linep, 0, n); if ^bk_ss_$mapsw then go to exit; /* Write map if specified */ call try_write (addr (nl), 1); /* Blank line */ call try_write (linep, n); /* Terminate line */ lines = page_size + 1; /* If they add to map, they'll start new page */ go to exit; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ heading_line: entry; /* Entry to write heading line. */ if ^bk_ss_$mapsw then go to exit; lines = 0; /* Reset line count */ header1.top = eject; /* Ensure new page */ try_head: lines = lines + 1; /* Number of chars in header */ call try_write (addr (header1), length_hdr1); /* First header line */ call try_write (addr (header2), 119); /* Second one */ go to exit; /* All done */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ detail_line2: entry /* Entry to write detail line. */ (name, blocks, type, dtp, dtem, dtd, dtu, dtsm); dcl name character (32) aligned, /* Entry name. */ blocks fixed binary (9), /* Number of blocks if segment. */ type character (10) aligned, /* Record type. */ (dtp, dtd, dtu, dtem, dtsm) fixed binary (52); /* Date/times. */ if ^bk_ss_$mapsw then go to exit; if dtd ^= old_dtd then /* Is previous dump time the same? */ call update (old_dtd, dtd, detail.dtd.date, detail.dtd.time); /* No, update printed version. */ detail.name = name; /* Copy the entry name. */ if blocks ^= old_blocks then do; /* Same blocks entry as before? */ old_blocks = blocks; /* Remember for next time. */ if old_blocks >= 0 then do; /* Real number of blocks? */ call cv_bin_$dec (old_blocks, ascii); /* Convert the value. */ detail.blocks = substr (ascii, 10, 3); /* Insert in detail line. */ end; else detail.blocks = ""; /* No, blank out field. */ end; detail.record_type = type; /* Copy logical record type. */ if dtp ^= old_dtp then /* Is the time processed the same? */ call update (old_dtp, dtp, ignore, detail.dtp.time); /* No, update printed version. */ if dtu ^= old_dtu then /* Is time used different? */ call update (old_dtu, dtu, detail.dtu.date, detail.dtu.time); /* Yes, update it. */ if dtem ^= old_dtem then /* Update time entry modified if different. */ call update (old_dtem, dtem, detail.dtem.date, detail.dtem.time); if dtsm ^= old_dtsm then /* Update time segment modified if different. */ call update (old_dtsm, dtsm, detail.dtsm.date, detail.dtsm.time); call trim (detail_ptr, 120); /* Move to line buffer and trim blanks. */ call try_write (linep, n); /* Go write the line. */ go to exit; /* Finished */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ name_line: entry (pointer, count); /* Entry to write additional names indented. */ if ^bk_ss_$mapsw then go to exit; ap = pointer; /* Copy input pointer. */ linep -> p.c (0) = ht; /* Prefix line with HT. */ do i = 0 to min (length (line) - 1, count) - 1; /* Scan the characters. */ linep -> p.c (i + 1) = ap -> p.c (i); /* Move this character. */ end; call trim (linep, i + 1); /* Compute total character count. */ call try_write (linep, n); /* Go write the line. */ go to exit; /* Finished */ /* */ /* Write an error message to the error file, the map, and online: calling sequence identical to com_err_ */ error_line: entry (P_code, P_module_name); dcl P_code fixed binary (35) parameter; dcl P_module_name character (*) parameter; dcl message_buffer character (1024); dcl user_message_lth fixed binary (21); dcl message_lth fixed binary; dcl arg_list_ptr pointer; dcl n_arguments fixed binary; dcl sname character (16); dcl efile_name character (64) static; /* name of the error file */ dcl date_name_ entry (character (*), character (*), character (*), character (*), fixed binary (35)); if bk_ss_$mapsw | ^bk_ss_$sub_entry | bk_ss_$sub_entry_errfile then do; if not_initialized then call initializer (); message_lth = 0; call cu_$arg_count (n_arguments); if P_module_name ^= "" then do; call add_text (rtrim (P_module_name)); if (P_code ^= 0) | (n_arguments > 2) then call add_text (": "); end; if P_code ^= 0 then do; call convert_status_code_ (P_code, ((8)" "), long_info); call add_text (rtrim (long_info)); if n_arguments > 2 then call add_text (" "); end; if n_arguments > 2 then do; call cu_$arg_list_ptr (arg_list_ptr); begin; dcl rest_of_message_buffer character (length (message_buffer) - message_lth) unaligned defined (message_buffer) position (message_lth + 1); call ioa_$general_rs (arg_list_ptr, 3, 4, rest_of_message_buffer, user_message_lth, "0"b, "1"b); end; message_lth = message_lth + user_message_lth; end; else call add_text (nl); /* make sure it ends with a newline */ if bk_ss_$sub_entry then do; /* record lossage in data structure */ bk_ss_$control_ptr -> backup_control.status_code (bk_ss_$path_index) = P_code; bk_ss_$control_ptr -> backup_control.error_name (bk_ss_$path_index) = P_module_name; if bk_ss_$sub_entry_errfile then go to WRITE_ERROR_FILE; else if bk_ss_$mapsw then go to WRITE_MAP_LINE; else go to RETURN_FROM_ERROR_LINE; /* skip writing online */ end; if bk_ss_$err_onlinesw then do; /* write the message online */ WRITE_ONLINE: call iox_$put_chars (iox_$error_output, addr (message_buffer), message_lth, code); if ^bk_ss_$mapsw then go to RETURN_FROM_ERROR_LINE; else go to WRITE_MAP_LINE; end; else do; /* write the message into the error file */ WRITE_ERROR_FILE: sp = addr (status); call ios_$write ("err_file", addr (message_buffer), 0, message_lth, nt, sp -> status_bits); if status.code = error_table_$ioname_not_found then do; dirname = ""; /* no error file: try to create one */ efile_name = ""; sname = bk_ss_$myname; if ^bk_ss_$debugsw then if (bk_ss_$myname = "reload") | (bk_ss_$myname = "iload") then dirname = ">reload_dir"; ATTACH_ERROR_FILE: call date_name_ (dirname, sname, "ef", efile_name, code); if code ^= 0 then go to STOP_ERROR_FILE; if dirname = ">reload_dir" then efile_name = ">reload_dir>" || substr (efile_name, 1, length (efile_name) - length (">reload_dir>")); i = index (efile_name, " ") - 1; rings (1), rings (2), rings (3) = max ((cu_$level_get ()), 4); call expand_pathname_ (substr (efile_name, 1, i), dir, ent, code); call hcs_$append_branchx ((dir), (ent), 01011b, rings, (get_group_id_$tag_star ()), 0b, 0b, 0b, code); if (code = 0) | (code = error_table_$namedup) then call hcs_$acl_add1 (dir, ent, "*.SysDaemon.*", 01011b, rings, code); call ios_$attach ("err_file", "file", efile_name, "w", sp -> status_bits); if status.code = 0 then do; /* inform user that there's an error file */ call ioa_ ("Error file attached to file ""^a"".", efile_name); go to WRITE_ERROR_FILE; /* and try again */ end; end; if status.code ^= 0 then do; /* couldn't write to the file: switch to online */ STOP_ERROR_FILE: call com_err_ (status.code, "backup_map_", "Error file discontinued."); bk_ss_$err_onlinesw = "1"b; go to WRITE_ONLINE; end; else if nt ^= message_lth then do; /* didn't put everyhting into the file */ call ioa_ ("backup_map_: Partial transmission; error file ^a will be detached.", efile_name); call ios_$detach ("err_file", "", "", sp -> status_bits); if status.code = 0 then go to ATTACH_ERROR_FILE; /* try again if we detached it */ go to STOP_ERROR_FILE; /* otherwise, go online */ end; end; WRITE_MAP_LINE: if bk_ss_$mapsw then do; /* put it into the map */ call try_write (addr (nl), 1); call try_write (addr (message_buffer), message_lth); end; end; RETURN_FROM_ERROR_LINE: return; /* Older entry to print error messages */ fs_error_line: entry (fs_code, fs_comment, fs_dir, fs_entry); dcl fs_code fixed binary (35) parameter; dcl fs_comment character (*) aligned parameter; /* offending procedure */ dcl fs_dir character (*) aligned parameter; /* offending directory path name */ dcl fs_entry character (*) aligned parameter; /* offending entry */ if substr (fs_entry, 1, 1) = ">" then /* some routines call us incorrectly */ call backup_map_$error_line (fs_code, (fs_comment), fs_entry); else if fs_entry = "" then /* not really a pathname */ call backup_map_$error_line (fs_code, (fs_comment), fs_dir); else call backup_map_$error_line (fs_code, (fs_comment), pathname_ ((fs_dir), (fs_entry))); return; /* Adds a piece of text to the message buffer */ add_text: procedure (p_text); dcl p_text character (*) parameter; dcl rest_of_message_buffer character (length (message_buffer) - message_lth) unaligned defined (message_buffer) position (message_lth + 1); if length (p_text) <= length (rest_of_message_buffer) then do; substr (rest_of_message_buffer, 1, length (p_text)) = p_text; message_lth = message_lth + length (p_text); end; else do; rest_of_message_buffer = substr (p_text, 1, length (rest_of_message_buffer)); message_lth = message_lth + length (rest_of_message_buffer); end; return; end add_text; /* */ tapes: entry (pointer, count); /* Entry to specify first (tape info) header */ if not_initialized then call initializer; /* Set us up if necessary */ call ioa_$rs ("^a", header1.tapenames, n, pointer -> string); /* Insert info */ if substr (header1.tapenames, 1, 4) = " " then length_hdr1 = 2; else length_hdr1 = n + 2; /* Set size */ lines = page_size + 1; /* Cause new page */ exit: bk_ss_$writing_map = "0"b; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ get_map_name: /* for copy_dump_tape */ entry () returns (character (32)); return (map_name); /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ init_for_cdt: /* for copy_dump_tape */ entry (tape_list); dcl (save_debug_sw, save_mapsw, save_sub_entry, save_tape_sw, save_bf_mapsw) bit (1) internal static; dcl tape_list character (128) varying; dcl get_wdir_ entry () returns (character (168)); lines = 0; if tape_list ^= "" then /* set of tapes used by copy_dump_tape for output map */ header1.tapenames = tape_list; save_debug_sw = bk_ss_$debugsw; /* will be changing these while copy_dump_tape running */ save_mapsw = bk_ss_$mapsw; save_sub_entry = bk_ss_$sub_entry; save_tape_sw = bk_ss_$tapesw; save_bf_mapsw = bk_ss_$brief_mapsw; bk_ss_$sub_entry, bk_ss_$debugsw, bk_ss_$mapsw = "1"b; bk_ss_$brief_mapsw, bk_ss_$tapesw = "0"b; not_initialized = "1"b; /* force backup_map_ to reinitialize itself */ dir = get_wdir_ (); /* use working directory for the map */ header1.top = " "; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ detach_for_cdt: /* for copy_dump_tape */ entry (a_code); dcl a_code fixed binary (35) parameter; sp = addr (status); /* establish where the bits go */ call ios_$detach ("map", "", "", sp -> status_bits); /* detach the map */ a_code = status.code; bk_ss_$debugsw = save_debug_sw; /* restore items saved during copy_dump_tape */ bk_ss_$mapsw = save_mapsw; bk_ss_$sub_entry = save_sub_entry; bk_ss_$tapesw = save_tape_sw; bk_ss_$brief_mapsw = save_bf_mapsw; return; end backup_map_;  backup_util.pl1 11/11/89 1112.9r w 11/11/89 0809.5 131895 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Utility procedure for backup reloader. */ backup_util: proc (dname, ename); /* Created by R H Campbell. */ /* Modified 2 April 1970, R H Campbell. */ /* Modified 21 October 1970, R. J. Feiertag to scrunch ring brackets. */ /* modified on 12.11.72 by A. Downing to increase the size of (name_area) */ /* modified by Kobziar on 11-20-73 to not print err for obsolete CACLs */ /* last modified by Kobziar 10-21-74 to add access_mode arg to $build_tree call */ /* last modified by R. Bratt 7-18-75 to remove pre 18-0 dinosaurs */ /* MCR 4310 add missing options to map 01/28/80 S. Herbst */ /* Modified: 17 November 1980 by G. Palter to allow backup_util$add_names to be called with other than the primary name */ /* obsolete and useless $replace_acl entry removed 5/3/82 BIM */ dcl (dname character (168), /* directory path name */ ename character (32)) aligned; /* entry name */ dcl (i, j, k, l) fixed bin, /* Temporary storage. */ a_code fixed bin, /* return status code */ code fixed bin, /* file system error code */ access_class bit (72) aligned, /* access_class of path */ esw fixed bin, /* Entry switch */ area_ptr ptr, /* ptr to system_free_area */ ix pointer; /* Pointer to array element. */ dcl (error_table_$moderr, error_table_$user_not_found, error_table_$nonamerr, error_table_$logical_volume_not_connected, error_table_$vtoce_connection_fail, error_table_$logical_volume_not_defined, error_table_$noentry, error_table_$bad_ring_brackets, error_table_$incorrect_access, error_table_$no_info, error_table_$fulldir, error_table_$segnamedup, error_table_$namedup, error_table_$safety_sw_on, error_table_$copy_sw_on) fixed bin ext; dcl init static bit (1) initial ("1"b), /* Flag to cause static initialization. */ group_id static character (32) aligned; /* Our name.project.tag. */ dcl 1 name (1) based (np) aligned, 2 size bit (17), 2 string character (32); dcl 1 stat_area, /* structure returned by status_ for get_real_name */ 2 (pad1 bit (18), nrp bit (18), pad2 bit (108)) unaligned; dcl names (1) char (32) based; /* primary entry name */ dcl (oldp, newp) ptr, /* pathnames for get_primary name */ (oldn based (oldp), newn based (newp)) char (168), newl fixed bin; /* length of revised pathname */ dcl (dir, work) char (168), ent char (32); /* workspace */ dcl backup_map_$fs_error_line entry (fixed bin, char (*) aligned, char (168) aligned, char (32) aligned), backup_map_$name_line entry (pointer, fixed binary), backup_load_dir_list$build_tree entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (24), fixed bin (2), char (*) aligned, bit (72) aligned, fixed bin), (backup_util$delete_name, backup_util$give_access) entry (char (168) aligned, char (32) aligned, fixed bin); dcl get_group_id_ entry returns (character (32)), get_system_free_area_ entry returns (ptr), hcs_$add_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin), hcs_$add_dir_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin), hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), fixed bin (24), fixed bin), hcs_$chname_file entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, fixed binary), (hcs_$del_dir_tree, hcs_$delentry_file) entry (char (*) aligned, char (*) aligned, fixed binary), hcs_$status_ entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin), hcs_$get_access_class entry (char (*) aligned, char (*) aligned, bit (72) aligned, fixed bin), hcs_$set_copysw entry (char (*) aligned, char (*) aligned, bit (1), fixed bin), hcs_$set_safety_sw entry (char (*) aligned, char (*) aligned, bit (1), fixed bin); dcl (addr, empty, fixed, index, length, min, pointer, substr, rtrim) builtin; %include bk_ss_; %include acl_structures; add_names: entry (dname, ename, np, nnames, list_names); /* Entry to add all names to entry. */ dcl np ptr, /* Pointer to names. */ nnames fixed bin, /* Number of names. */ list_names bit (1); /* Flag to enable writing of names. */ do i = 1 to nnames; ix = addr (np -> name (i)); /* Get pointer to this array element. */ if (ename ^= ix -> name(1).string) then do; /* not added yet */ if bk_ss_$no_reload then go to print_name; /* Not reloading so print the name only */ add: call hcs_$chname_file (dname, ename, "", ix -> name (1).string, code); /* Try to add the name. */ if code = error_table_$namedup then do; /* Was name already in directory? */ call backup_util$delete_name (dname, ix -> name (1).string, code); /* Try to remove the name. */ if code = 0 then go to add; /* Removal successful? */ end; /* Any errors here will be reported by delete_name. */ else if code = error_table_$segnamedup then; /* Leave name already on branch */ else if code ^= 0 then /* If unsuccessful, don't write name line. */ call backup_map_$fs_error_line (code, "chname_file in add_names", dname, ix -> name (1).string); else if bk_ss_$mapsw & list_names then /* Write the name if map desired. */ print_name: call backup_map_$name_line (addr (ix -> name (1).string), fixed (ix -> name (1).size, 17)); end; end; return; /* Return to caller. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ delete_name: entry (dname, ename, a_code); /* Entry to remove offending name from directory. */ call hcs_$chname_file (dname, ename, ename, "", code); /* Try to remove the name from its entry. */ if code = error_table_$nonamerr then do; /* Is it the last name on its entry? */ delete: call hcs_$delentry_file (dname, ename, code); /* try simple delete first */ if code = error_table_$moderr | code = error_table_$incorrect_access then do; /* Do we have right access? */ get_access: call backup_util$give_access (dname, ename, code); /* Try to change it. */ if code = 0 then go to delete; /* try again if changed successfully */ end; else if code = error_table_$safety_sw_on then do; /* Turn off the safety switch, else if necessary. */ call hcs_$set_safety_sw (dname, ename, "0"b, code); if code = 0 then go to delete; /* Try again if successful. */ call backup_map_$fs_error_line (code, "backup_util$delete_name", dname, ename); end; else if code = error_table_$copy_sw_on then do; /* Turn off copy switch */ call hcs_$set_copysw (dname, ename, "0"b, code); if code = 0 then go to delete; call backup_map_$fs_error_line (code, "backup_util$delete_name", dname, ename); end; else if code = error_table_$user_not_found then go to get_access; /* Were we on the ACL at all? */ else if code = error_table_$fulldir then do; /* was it a non-empty directory? */ call hcs_$del_dir_tree (dname, ename, code); /* yes, delete inferior entries */ if code = 0 then go to delete; call backup_map_$fs_error_line (code, "backup_util$delete_name", dname, ename); end; else if code ^= 0 then /* If unsuccessful, give error comment. */ call backup_map_$fs_error_line (code, "backup_util$delete_name", dname, ename); end; else if code ^= 0 then /* If unexpected error, give error comment. */ call backup_map_$fs_error_line (code, "backup_util$delete_name", dname, ename); a_code = code; /* return status */ return; /* Return to caller. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ give_access: entry (dname, ename, a_code); /* Entry to give ourselves access to entry. */ dcl seg_aclp ptr int static, dir_aclp ptr int static; dcl 1 seg_acl (1) aligned like segment_acl_entry int static; dcl 1 dir_acl (1) aligned like directory_acl_entry int static; dcl type fixed bin (2), bitcnt fixed bin (24); if init then do; /* Must we initialize? */ group_id = get_group_id_ (); /* Get our ID code. */ seg_acl.access_name (1), dir_acl.access_name (1) = group_id; seg_acl.mode = "111"b; seg_acl.extended_mode = ""b; dir_acl.mode = "111"b; seg_aclp = addr (seg_acl); dir_aclp = addr (dir_acl); init = ""b; /* Clear flag. */ end; call hcs_$status_minf (dname, ename, 1, type, bitcnt, code); if code ^= 0 then if code = error_table_$logical_volume_not_defined then code = 0; else if code = error_table_$logical_volume_not_connected then code = 0; else if code = error_table_$vtoce_connection_fail then code = 0; else go to ret; if type = 0 then go to ret; if type = 1 then call hcs_$add_acl_entries (dname, ename, seg_aclp, 1, code); /* put us on ACL */ else call hcs_$add_dir_acl_entries (dname, ename, dir_aclp, 1, code); if code = error_table_$no_info | code = error_table_$incorrect_access then do; call hcs_$get_access_class (dname, "", access_class, code); if code ^= 0 then access_class = "0"b; /* try with this value */ call backup_load_dir_list$build_tree (dname, "", 3, 0, 0, "", access_class, code); end; /* If we cannot get access, then recurse. */ ret: a_code = code; /* Return status */ return; /* Return to caller. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ get_real_name: entry (oldp, newp, newl, a_code); /* entry to get a "more proper" version of a pathname */ l = 0; /* l is current length of output pathname */ work = ""; /* new pathname built here, level by level */ i = index (oldn, " "); /* determine length of old pathname */ if i = 0 then i = 169; /* it may be the full 168 */ j = 1; /* current position on input pathname */ do while (j < i - 1); /* scan entire input name */ k = index (substr (oldn, j), ">"); /* find next directory level */ if k = 0 then go to done; /* if there isn't one, scan is finished */ dir = substr (oldn, 1, j + k - 2); /* save directories so far seen */ j = j + k; /* move along input */ if j = 2 then dir = ">"; /* status wants a trailing ">" only for the root */ k = index (substr (oldn, j), ">"); /* next level is entry name for this level */ if k = 0 then ent = substr (oldn, j, i - j); /* if there isn't another level, use remainder of input */ else ent = substr (oldn, j, k - 1); /* otherwise characters up to next ">" */ area_ptr = get_system_free_area_ (); call hcs_$status_ (dir, ent, 1, addr (stat_area), area_ptr, code); /* get the names of this entity */ if code ^= 0 then if code = error_table_$logical_volume_not_connected then code = 0; else if code = error_table_$logical_volume_not_defined then code = 0; else if code = error_table_$vtoce_connection_fail then code = 0; else do; /* if something was wrong */ if code ^= error_table_$noentry then go to grn_ret; /* it had better be entry not found */ work = substr (work, 1, l) || ">" || substr (oldn, j, i - j); /* it was, tack on unfound part of input */ l = l + i - j + 1; /* compute total length of result */ go to done; /* job is done */ end; work = substr (work, 1, l) || ">" || pointer (area_ptr, stat_area.nrp) -> names (1); l = index (work, " ") - 1; /* new length with new primary name appended */ end; done: code = 0; /* return zero if nothing was done */ newl = l; /* set the length argument */ if oldn = work then go to grn_ret; /* see if anything useful was accomplished */ if l = 0 then go to grn_ret; /* pathname didn't have any ">"s */ newn = work; /* hand over the new pathname */ code = 1; /* and say we did so */ grn_ret: a_code = code; /* Return status code */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ idline: entry (rfile, rdate, linep, n); /* entry to format retriever's signature line */ dcl (rfile, rdate) char (*), /* retrieval control file, retriever version */ linep ptr, line char (300) based (linep), /* output line */ n fixed bin; /* its length */ call append (rtrim (bk_ss_$myname)); /* insert our name in id line */ call append ((rdate)); /* add version of loader */ if rfile ^= "" then call append (rtrim (rfile)); /* control file to be used */ call append ("map"); /* Report map option setting */ if bk_ss_$quotasw then call append ("quota"); /* Report setting of quota restoration switch. */ else call append ("noquota"); if bk_ss_$onlysw then call append ("first"); /* Report satisfaction criterion */ else call append ("last"); if bk_ss_$trimsw then call append ("trim"); /* Report pruning option setting. */ else call append ("notrim"); if bk_ss_$debugsw then call append ("debug"); /* Report debug mode setting. */ if bk_ss_$dir_trim then call append ("dir_trim"); /* for reload system release */ if bk_ss_$err_onlinesw then call append ("error_on"); if bk_ss_$ignore_dates then call append ("ignore_dates"); /* for reload system release */ if bk_ss_$no_primary then call append ("noprimary"); /* do not use primary pathnames */ if bk_ss_$no_reload then call append ("noreload"); /* testing reloader */ if bk_ss_$no_setlvid then call append ("nosetlvid"); /* don't set logical voilume id */ if bk_ss_$qchecksw then call append ("qcheck"); /* check quotas */ else call append ("noqcheck"); /* default */ return; append: procedure (string); /* Append string to identification line */ dcl string character (*) aligned; /* What to append. */ if n < length (line) then do; /* Is there room in buffer? */ n = n + 1; /* Count it. */ substr (line, n, 1) = " "; /* Prepend a blank. */ i = min (length (line) - n, length (string)); /* Don't overflow. */ substr (line, n + 1, i) = string; /* Append this string. */ n = n + i; /* Count length. */ end; end append; end backup_util;  bk_arg_reader_.pl1 11/11/89 1112.9r w 11/11/89 0806.0 151902 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ bk_arg_reader_: proc (iac, ialp, ocode); /* Created by M A Meer in November 1972 */ /* This routine reads and handles the arguments * for all directly callable dumper and reloader modules. * * Usage: dcl bk_arg_reader_ entry (fixed bin, pointer, fixed bin (35)); * * call bk_arg_reader_ (iac, ialp, ocode); * * where * * 1) iac is the first argument to be examined (Input). * * 2) ialp is a pointer to the argument list (Input). * * 3) ocode is a standard status code (Output). * */ /* -no_primary added 08/03/79 S. Herbst */ /* Error message fixed 01/07/80 S. Herbst */ /* -dprint and -no_dprint added 03/19/80 S. Herbst */ /* -setdtd and -nosetdtd added 07/01/81 S. Herbst */ /* -ds, -he, -q and -rqt added for dprinting maps 12/01/81 S. Herbst */ dcl MAX_QUEUES fixed bin int static init (4); /* highest dprint queue number */ dcl (iac, ac, al) fixed bin, arg_array (20) char (32) aligned, (ocode, code) fixed bin (35), (ialp, alp, ap) ptr, (entrysw, interval) fixed bin, (arg_date, time_now) fixed bin (52), (cflag, oflag, rflag, tflag, wflag, pvflag) bit (1) aligned init (""b), (got_queue, got_request_type) bit (1) aligned, (default_queue, fixed_queue, max_queue) fixed bin, i fixed bin, buffer char (168), generic_type char (32), local_rqt char (24), (error_table_$argerr, error_table_$badopt, error_table_$badpath, error_table_$noarg) fixed bin (35) ext, error_table_$id_not_found fixed bin (35) ext, arg char (al) based, op char (32), op1 char (1); dcl dump fixed bin static init (1), reload fixed bin static init (2), array fixed bin static init (3), norm fixed bin static init (0); dcl com_err_ entry options (variable), clock_ entry (fixed bin (52)), convert_date_to_binary_ entry (char (*), fixed bin (52), fixed bin (35)), cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr), cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin), iod_info_$generic_type entry (char (*), char (32), fixed bin (35)), iod_info_$queue_data entry (char (*), fixed bin, fixed bin, fixed bin (35)), (index, substr) builtin; /* */ /* bk_arg_reader_: entry(iac, ialp, ocode); This is the entry which begins here */ entrysw = norm; /* regular entry */ go to common; dump_arg_reader: entry (iac, ialp, ocode); entrysw = dump; /* read dumper args */ go to common; reload_arg_reader: entry (iac, ialp, ocode); entrysw = reload; /* reload entry */ goto common; array_arg_reader: entry (arg_array, ocode); entrysw = array; ac = 0; common: ocode = 0; /* set up and copy args */ if entrysw ^= array then do; ac = iac - 1; /* first arg to fetch */ alp = ialp; /* arg list pointer */ end; got_queue, got_request_type = "0"b; bk_ss_$pathsw = ""b; /* initialize the path switch */ start: ac = ac + 1; /* get next arg */ if entrysw ^= array then do; call cu_$arg_ptr_rel (ac, ap, al, code, alp); if code ^= 0 then if code = error_table_$noarg then if cflag | oflag | tflag | wflag | rflag | pvflag then go to noarg; else do; if got_queue | got_request_type then do; if got_request_type then local_rqt = bk_ss_$dprint_request_type; else local_rqt = "printer"; call iod_info_$queue_data (local_rqt, default_queue, max_queue, code); if code ^= 0 then do; call com_err_ (code, bk_ss_$myname, "Invalid dprint request_type ^a", local_rqt); go to err_ret; end; if bk_ss_$dprint_queue > max_queue then fixed_queue = max_queue; else fixed_queue = 0; if fixed_queue ^= 0 then do; call com_err_ (0, bk_ss_$myname, "(warning) Specified queue number ^d is invalid for request type ^a; using ^d instead.", bk_ss_$dprint_queue, local_rqt, fixed_queue); bk_ss_$dprint_queue = fixed_queue; end; end; go to ret; end; else do; /* code other than noargs */ call com_err_ (code, bk_ss_$myname); go to err_ret; end; end; else do; /* handle arg array */ if arg_array (ac) = "" | arg_array (ac) = " " then goto start; /* skip null args */ al = 32; /* set default */ ap = addr (arg_array (ac)); end; if cflag then do; /* this is a control file name */ if al = 0 then go to noarg; if entrysw = dump then /* this is dumper entry */ if substr (ap -> arg, al-5, 5) ^= ".dump" then bk_ss_$control_name = ap -> arg || ".dump"; else bk_ss_$control_name = ap -> arg; if entrysw = reload then do; /* this is a retrieval */ bk_ss_$retrievesw = "1"b; /* Let the world know. */ bk_ss_$qchecksw = "1"b; /* Don't suspend quotas during retrieve. */ bk_ss_$rname = ap -> arg; /* retrieval file name */ bk_ss_$rsize = al; /* length of name */ end; cflag = ""b; /* turn off flag */ go to start; end; else if oflag then do; /* this must be operator name */ if al = 0 then go to noarg; else bk_ss_$operator = ap -> arg; oflag = ""b; /* turn off flag */ go to start; end; else if tflag then do; /* this must be number of tapes */ if al = 0 then bk_ss_$ntapes = 1; /* default value */ else if ap -> arg = "2" then bk_ss_$ntapes = 2; else bk_ss_$ntapes = 1; tflag = ""b; /* turn off flag */ go to start; end; else if wflag then do; /* this must be wakeup interval in minutes */ if al = 0 then go to noarg; /* null arg not allowed */ interval = cv_dec_check_ ((ap -> arg), code); if code ^= 0 then do; bad_interval: call com_err_ (code, bk_ss_$myname, "Interval number ^a", ap -> arg); go to err_ret; end; if interval <= 0 then go to bad_interval; if interval > 360 then go to bad_interval; bk_ss_$wakeup_interval = interval * 60000000; /* interval converted to microseconds */ wflag = ""b; go to start; end; else if rflag then do; /* restart at directory given */ if al = 0 then go to noarg; if substr (ap -> arg, 1, 1) ^= ">" then do; /* must be pathname */ code = error_table_$badpath; call com_err_ (code, bk_ss_$myname, "Full path of restart directory required. ^a", ap -> arg); go to err_ret; end; bk_ss_$restart_dumpsw = "1"b; bk_ss_$restart_path = ap -> arg; bk_ss_$restart_plen = al; rflag = ""b; /* reset flag */ go to start; end; else if pvflag then do; /* physical volume recovery */ if al = 0 then goto noarg; /* like all the rest */ bk_ss_$pvsw = "1"b; /* turn on the switch */ bk_ss_$pvname = ap -> arg; /* set the variable */ pvflag = "0"b; goto start; end; if al > 0 then do; /* ignore null arguments */ op, op1 = ap -> arg; /* extract first characters for comparison */ if op1 = "-" then do; /* only if leading hyphen */ op, op1 = substr (ap -> arg, 2); /* drop leading hyphen */ end; /* PROCESS ARGUMENTS FOR ALL BACKUP ENTRIES */ if op = "control" then do; /* Flag next arg as control file name */ cflag = "1"b; go to start; /* Get next arg */ end; else if op = "operator" then oflag = "1"b; /* flag next arg as operator name */ else if op = "all" then bk_ss_$datesw, bk_ss_$dtdsw = ""b; /* ignore all date criteria */ else if op = "debug" then do; /* disable quota, transparent switches */ bk_ss_$debugsw = "1"b; /* in user reload ... */ bk_ss_$trimsw = ""b; /* don't trim since will be foverwriting */ end; else if op = "nodebug" then bk_ss_$debugsw = ""b; /* no debug, default */ else if op = "map" then bk_ss_$mapsw = "1"b; /* output a map */ else if op = "nomap" then do; /* do not output a map */ bk_ss_$mapsw = ""b; bk_ss_$tapesw = "1"b; /* must have tape or map switch */ end; else if op = "brief_map" | op = "bfmap" then bk_ss_$mapsw, bk_ss_$brief_mapsw = "1"b; else if op = "destination" | op = "ds" then do; bk_ss_$dprint_destination = get_value ("-destination", 24); bk_ss_$dprint_destination_setsw = "1"b; end; else if op = "dprint" | op = "dp" then bk_ss_$dprintsw = "1"b; /* whether to dprint maps when done */ else if op = "header" | op = "he" then do; bk_ss_$dprint_heading = get_value ("-header", 64); bk_ss_$dprint_heading_setsw = "1"b; end; else if op = "nodprint" | op = "no_dprint" | op = "ndp" then bk_ss_$dprintsw = "0"b; else if op = "hold" then bk_ss_$holdsw = "1"b; /* do not dismount */ else if op = "nohold" then bk_ss_$holdsw = ""b; /* dismount, default */ else if op = "primary" | op = "pri" then bk_ss_$no_primary = "0"b; /* whether to use primary pathnames */ else if op = "no_primary" | op = "npri" | op = "noprimary" then bk_ss_$no_primary = "1"b; else if op = "pvname" then pvflag = "1"b; /* enable physival volume recovery */ else if op = "queue" | op = "q" then do; buffer = get_value ("-queue", 100); i = cv_dec_check_ (buffer, code); if code ^= 0 | i < 1 | i > MAX_QUEUES then do; call com_err_ (0, bk_ss_$myname, "Invalid queue number ^a", buffer); go to err_ret; end; bk_ss_$dprint_queue = i; got_queue = "1"b; end; else if op = "request_type" | op = "rqt" then do; buffer = get_value ("-request_type", 24); call iod_info_$generic_type (buffer, generic_type, code); if code ^= 0 then if code = error_table_$id_not_found then do; call com_err_ (0, bk_ss_$myname, "Unknown dprint request type ^a", buffer); go to err_ret; end; else call com_err_ (0, bk_ss_$myname, "Warning -- Unable to check request type ^a", buffer); else if generic_type ^= "printer" then do; call com_err_ (0, bk_ss_$myname, "Dprint request type ^a is not of generic type ""printer"".", buffer); code = 1; go to err_ret; end; bk_ss_$dprint_request_type = buffer; bk_ss_$dprint_request_type_setsw, got_request_type = "1"b; end; else if op = "error_on" then bk_ss_$err_onlinesw = "1"b; /* output errors online */ else if op = "error_of" then bk_ss_$err_onlinesw = ""b; /* output errors into a file */ else if op1 = ">" | op = "retrieve" then do; /* was argument a pathname */ if bk_ss_$myname = "backup_load" | bk_ss_$myname = "retrieve" then do; /* Is this a retrieval */ bk_ss_$retrievesw = "1"b; /* Tell the world */ bk_ss_$qchecksw = "1"b; /* Don't suspend quotas during retrieve. */ bk_ss_$rname = ap -> arg; /* Save retrieve control seg name */ bk_ss_$rsize = al; /* Save length of name */ end; else if entrysw = dump /* We must be dumping */ then do; bk_ss_$pathsw = "1"b; /* set switch, we have a starting pathname */ bk_ss_$save_plen = al; /* save length of pathname */ bk_ss_$save_path = ap -> arg; /* save pathname of starting directory */ end; else do; /* not dumping or retrieving */ code = error_table_$badopt; call com_err_ ((0), bk_ss_$myname, "Pathname argument not accepted by this command. ^a", ap -> arg); go to err_ret; end; end; /* DUMPER ARGUMENT PROCESSING */ else if entrysw ^= reload then do; /* Not reloader entry */ if op = "wakeup" then do; /* Flag next arg as wakeup interval in minutes */ if bk_ss_$myname = "start_dump" | bk_ss_$myname = "catchup_dump" then wflag = "1"b; else go to badopt; /* Illegal arg for other entries */ go to start; end; else if op = "tapes" then tflag = "1"b; /* flag next arg as number of tapes */ else if op = "restart" then rflag = "1"b; /* flag next arg as restart pathname */ else if op = "1tape" then do; /* handle a "1tape" arg */ bk_ss_$ntapes = 1; /* insert number of tapes requested */ bk_ss_$tapesw = "1"b; /* set tape option on */ end; else if op = "2tapes" then do; /* same as above */ bk_ss_$ntapes = 2; bk_ss_$tapesw = "1"b; end; else if op = "only" then bk_ss_$onlysw = "1"b; /* suppress hierarchy sweep */ else if op = "sweep" then bk_ss_$onlysw = ""b; /* sweep hierarchy, default */ else if op = "dtd" then bk_ss_$dtdsw = "1"b; /* check if changed since last dumped */ else if op = "setdtd" then bk_ss_$set_dtd, bk_ss_$set_dtd_explicit = "1"b; /* always set dtd */ else if op = "nosetdtd" then do; /* never set dtd */ bk_ss_$set_dtd = "0"b; bk_ss_$set_dtd_explicit = "1"b; end; else if op = "tape" then bk_ss_$tapesw = "1"b; /* output a tape, default */ else if op = "notape" then do; bk_ss_$tapesw = ""b; /* do not write a tape */ bk_ss_$mapsw = "1"b; /* must have tape or map switch */ end; else if op = "nooutput" then bk_ss_$no_output = "1"b; /* test run or debugging dumper */ else if op = "output" then bk_ss_$no_output = "0"b; /* output dumper stuff if tapesw is on */ else if op = "nocontin" then bk_ss_$no_contin = "1"b; /* end dump after catchup pass. */ else if op = "contin" then bk_ss_$no_contin = "0"b; /* continue incremental after catchup pass */ else go to try_date; /* see if this is a date */ end; /* END OF DUMPER ARGS */ /* PROCESS RELOAD AND RETRIEVE ARGUMENTS */ else if entrysw = reload then do; if op = "quota" then bk_ss_$quotasw = "1"b; /* set to modify quota on reload */ else if op = "noquota" then bk_ss_$quotasw = ""b; /* do not modify quota, default */ else if op = "trim" then bk_ss_$trimsw = "1"b; /* trim directory on reload */ else if op = "notrim" then bk_ss_$trimsw = ""b; /* no trim on reload, default */ else if op = "reload" then bk_ss_$no_reload = ""b; /* Allow appending and writing in hierarchy */ else if op = "noreload" then bk_ss_$no_reload = "1"b; /* NO appending or writing in hierarchy */ else if op = "first" then bk_ss_$onlysw = "1"b; /* take first occurence on retrieval */ else if op = "last" then bk_ss_$onlysw = ""b; /* take last occurence on retrieval */ else if op = "qcheck" then bk_ss_$qchecksw = "1"b; /* Don't suspend quota checking. */ else if op = "noqcheck" then bk_ss_$qchecksw = "0"b; /* Suspend quota checking. */ else if op = "setlvid" then bk_ss_$no_setlvid = "0"b; /* set sons lvid */ else if op = "nosetlvid" then bk_ss_$no_setlvid = "1"b; /* don't set sons lvid */ else go to try_date; /* see if this is a date */ end; /* END OF RELOAD, RETRIEVE ARGS */ else try_date: if op1 <= "9" & op1 >= "0" then do; convert_date: call convert_date_to_binary_ (ap -> arg, arg_date, code); if code ^= 0 then go to error_print; call clock_ (time_now); /* get current date, time */ if arg_date > time_now then bk_ss_$date = arg_date-86400000000; /* given date - 24 hours */ else bk_ss_$date = arg_date; bk_ss_$datesw = "1"b; /* set switch to check date */ end; else do; if index (ap -> arg, " ") ^= 0 then go to convert_date; /* possibly a date */ badopt: code = error_table_$badopt; error_print: call com_err_ (code, bk_ss_$myname, ap -> arg); go to err_ret; end; end; go to start; /* get next arg */ noarg: call com_err_ (error_table_$noarg, bk_ss_$myname, "After -^a", op); code = error_table_$argerr; err_ret: ocode = code; /* return an error code */ ret: return; %page; get_value: proc (P_name, P_limit) returns (char (*)); /* Returns the char string following the current control arg P_name */ dcl P_name char (*); dcl P_limit fixed bin; ac = ac + 1; if entrysw ^= array then do; call cu_$arg_ptr_rel (ac, ap, al, code, alp); if code ^= 0 then do; call com_err_ (0, bk_ss_$myname, "No value specified for ^a", P_name); go to err_ret; end; if al > P_limit then do; call com_err_ (0, bk_ss_$myname, "Value for ^a exceeds maximum number of characters ^d", P_name, P_limit); code = 1; go to err_ret; end; end; else do; /* array_arg_reader entrypoint */ al = 32; ap = addr (arg_array (ac)); end; return (ap -> arg); end get_value; /* */ % include bk_ss_; end bk_arg_reader_;  bk_input.pl1 11/11/89 1112.9r w 11/11/89 0806.7 122292 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ %; /* Tape input procedure for backup system. */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ bk_input: /* Created February 1969, R C Daley. */ procedure; /* Modified 7 February 1970, R H Campbell. */ /* Modified 10/25/65 by S. Herbst */ /* changed to use tape_mult_ 9/77 by Noel I. Morris */ /* Modified 11/9/77 by Steve Herbst */ /* Changed to call command_query_ except for "20 unexplained errors" query 02/28/80 S. Herbst */ /* Modified: 17 October 1980 by G. Palter to obey bk_ss_$preattached */ /* Attach description changed from char(32) to char(168) to hold user comments 05/14/81 S. Herbst */ dcl (tape_label, first_tape_label) char (64) init (""); dcl answer char (64) aligned varying; dcl (temp, skipped, error_count) fixed binary, nelemt fixed bin (22), code fixed bin (35), attach_descrip char (168), line character (132), yes_sw bit (1), (buffer, tp) pointer; dcl iocbp1 ptr static init (null ()), (held, mounted, remount_first_tape) bit (1) static initial ("0"b), blanks char (4) static init (""); /* To reset tape label */ dcl buf_size fixed bin; dcl tape_dim_data_$tdcm_buf_size fixed bin external; dcl searching_for_header static character (21) initial ("Searching for header."); dcl end_of_reel_encountered static character (24) initial ("End of reel encountered."); dcl end_of_readable_data static character (21) initial ("End of readable data."); dcl 1 header aligned static options (constant), /* Backup logical record header */ 2 zz1 char (32) init (" z z z z z z z z z z z z z z z z"), 2 english char (56) init ("This is the beginning of a backup logical record."), 2 zz2 char (32) init (" z z z z z z z z z z z z z z z z"); dcl 1 theader aligned, 2 compare, 3 zz1 char (32), 3 english char (56), 3 zz2 char (32), 2 hdrcnt fixed bin, 2 segcnt fixed bin, 2 space (32: 255); dcl (addr, length, mod, null, rtrim, substr, unspec) builtin; dcl iox_$error_output ptr ext; dcl iox_$user_input ptr ext; dcl backup_map_$fs_error_line entry (fixed bin (35), char (*), char (168), char (32)), (backup_map_$tapes, backup_map_$on_line) entry (pointer, fixed binary), command_query_$yes_no entry options (variable), (ioa_$rsnnl, ioa_$nnl, ioa_) entry options (variable), command_query_ entry options (variable), iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)), iox_$open entry (ptr, fixed bin, bit (1), fixed bin (35)), iox_$close entry (ptr, fixed bin (35)), iox_$detach_iocb entry (ptr, fixed bin (35)), iox_$get_chars entry (ptr, ptr, fixed bin (22), fixed bin (22), fixed bin (35)), iox_$get_line entry (ptr, ptr, fixed bin (22), fixed bin, fixed bin (35)), parse_tape_reel_name_ entry (char (*), char (*)); dcl (error_table_$end_of_info, error_table_$improper_data_format, error_table_$data_improperly_terminated, error_table_$dev_nt_assnd) ext fixed bin; /* File system code. */ /* */ %include query_info; %page; %include iox_modes; %page; %include bk_ss_; %page; %include backup_control; /* */ input_init: entry (istat); /* entry to initialize backup input procedure */ dcl istat fixed bin (35); /* Error code (returned). */ buffer = addr (line); /* Set up pointer to buffer for comments. */ if bk_ss_$preattached then do; /* caller has already setup I/O switch */ mounted = "1"b; /* say it's moutned */ iocbp1 = bk_ss_$data_iocb; istat = 0; end; else if held then istat = 0; /* -hold last time */ else do; if mounted then call unmount; /* unmount any previous tapes */ call mount (istat); /* mount first reload tape(s) */ end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ rd_tape: entry (lblptr, lblcnt, segptr, segcnt, rstat); /* to get next backup record from tape */ dcl lblptr pointer, /* pointer to preamble area */ lblcnt fixed binary, /* size of preamble (returned) */ segptr pointer, /* pointer to segment area */ segcnt fixed binary, /* length of segment if any (returned) */ rstat fixed bin (35); /* status code (returned) */ dcl req fixed bin; dcl header_only fixed bin int static init (1); dcl segment_only fixed bin int static init (2); dcl both fixed bin int static init (3); if lblptr = null then req = segment_only; else if segptr = null then req = header_only; else req = both; if ^mounted then do; /* Abort if no tape mounted. */ rstat = error_table_$dev_nt_assnd; return; end; buffer = addr (line); /* Set up pointer to buffer for comments. */ skipped, error_count, rstat = 0; if req = segment_only then go to READ_SEG; getnext: if req = segment_only then do; /* must have not found rest of segment */ rstat = 2; return; end; call iox_$get_chars (iocbp1, addr (theader), 128, nelemt, code); if code ^= 0 then do; /* Check for tape reading error */ if code = error_table_$end_of_info then go to eor; /* check end of reel */ go to tsterr; /* check for further tsterrors */ end; if unspec (theader.compare) ^= unspec (header) then do; if skipped = 0 then /* Is this the first time? */ call backup_map_$on_line (addr (searching_for_header), length (searching_for_header)); skipped = skipped + 1; /* Count this physical record skipped. */ call iox_$get_chars (iocbp1, addr (theader), 896, nelemt, code); if code = error_table_$end_of_info then go to eor; /* check end of reel */ if code ^= 0 then go to tsterr; /* check for read error spacing */ go to getnext; /* try again to read header */ end; if skipped ^= 0 then do; /* Did we have to skip any records? */ call ioa_$rsnnl ("^d 256-word blocks skipped.", line, temp, skipped); /* Make up comment. */ call backup_map_$on_line (buffer, temp); /* Type the comment. */ skipped = 0; /* Clear the count. */ end; lblcnt = theader.hdrcnt; /* pick up preamble length in words */ segcnt = theader.segcnt; /* pick up segment length in words */ temp = theader.hdrcnt + 32 + 255; /* adjust to read preamble to end of physical record */ temp = temp - mod (temp, 256) - 32; /* 32 words have already been read. */ call iox_$get_chars (iocbp1, lblptr, temp * 4, nelemt, code); if code = error_table_$end_of_info then go to eor; /* check end of reel */ if code ^= 0 then go to tsterr; if req = header_only then return; /* header has been read */ READ_SEG: if segcnt > 0 then do; temp = segcnt + 255; /* adjust to read segment to end of physical record */ temp = temp - mod (temp, 256); /* .. */ call iox_$get_chars (iocbp1, segptr, temp * 4, nelemt, code); if code = error_table_$end_of_info then go to eor; /* check end of reel */ if code ^= 0 then go to tsterr; end; return; /* exit to caller */ eor: call backup_map_$on_line (addr (end_of_reel_encountered), length (end_of_reel_encountered)); go to remount; /* go to mount next tape if any */ tsterr: if code = error_table_$data_improperly_terminated then do; call backup_map_$on_line (addr (end_of_readable_data), length (end_of_readable_data)); go to remount; /* go to mount next reel if any */ end; err: call backup_map_$fs_error_line (code, "bk_input", "primary_reload_tape", ""); /* We used to go to remount for code = */ /* et_$improper_data_format also, but now */ /* we fall thru and eventually query user. */ /* It was found that usually the rest */ /* of the tape was readable after all. */ error_count = error_count + 1; /* bump error count */ if error_count > 20 then do; /* more than 20 successive unexplained errors */ call backup_map_$fs_error_line (code, bk_ss_$myname, "More than 20 unexplained errors", ""); call command_query_$yes_no (yes_sw, 0, bk_ss_$myname, "20 unrecoverable I/O errors have occurred; the tape is probably unreadable. Do you want to try further?", "More than 20 unexplained errors. Do you want to try for 20 more?"); if ^yes_sw then go to remount; /* try next tape */ error_count = 0; /* try 20 more times */ end; go to getnext; /* and try to find next record on this reel */ remount: if bk_ss_$sub_entry then do; /* get next tape label from tape_entry */ call bk_ss_$control_ptr -> backup_control.tape_entry (tape_label); if tape_label = "" then go to no_more; else go to next; end; unspec (query_info) = "0"b; query_info.version = query_info_version_5; query_info.yes_or_no_sw = "1"b; query_info.question_iocbp, query_info.answer_iocbp = null; call command_query_ (addr (query_info), answer, bk_ss_$myname, "Are there any more tapes to be reloaded?"); if answer = "no" then do; no_more: rstat = 1; /* indicate normal termination */ return; end; next: call unmount; /* unmount current reel(s) */ error_count = 0; call mount (rstat); /* mount next reel(s) if any */ if rstat ^= 0 then return; /* return if no more reels to load */ skipped = 0; /* Reset count of records skipped. */ go to getnext; /* otherwise, continue on new reel(s) */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ input_finish: entry; /* to terminate reload (by program) */ buffer = addr (line); /* Set up pointer to buffer for comments. */ if bk_ss_$preattached then; else if mounted then if ^bk_ss_$holdsw then call unmount; /* unmount any reel(s) still mounted */ else if first_tape_label ^= tape_label then do; /* -hold with a multi-volume set */ call unmount; /* dismount last tape */ remount_first_tape = "1"b; /* and mount the first */ call mount (rstat); held = "1"b; end; else do; held = "1"b; /* -hold: don't unmount */ call iox_$close (iocbp1, code); call iox_$open (iocbp1, Stream_input, "0"b, code); end; /* just rewind tape */ return; /* */ mount: procedure (mount_status); /* internal procedure to mount first or next reel(s) */ dcl mount_status fixed bin (35); /* Error code (returned). */ if remount_first_tape then do; remount_first_tape = "0"b; tape_label = first_tape_label; end; else do; if bk_ss_$sub_entry then do; /* get tape label from tape_entry */ if tape_label = "" then call bk_ss_$control_ptr -> backup_control.tape_entry (tape_label); end; else do; unspec (query_info) = "0"b; query_info.version = query_info_version_5; query_info.suppress_name_sw = "1"b; query_info.question_iocbp, query_info.answer_iocbp = null; call command_query_ (addr (query_info), answer, bk_ss_$myname, "Input tape label:"); tape_label = answer; end; if first_tape_label = "" then first_tape_label = tape_label; end; buf_size = 2080; /* default is small buffer */ if ^bk_ss_$debugsw then if (bk_ss_$myname = "reload") | (bk_ss_$myname = "iload") then do; buf_size = 4160; /* system reload so big buffer */ tape_label = rtrim (tape_label) || ",sys"; /* we want to be a system process */ end; tape_dim_data_$tdcm_buf_size = buf_size; call parse_tape_reel_name_ (tape_label, attach_descrip); call iox_$attach_ioname ("bk_input_1", iocbp1, "tape_mult_ " || attach_descrip, code); if code ^= 0 then do; call backup_map_$fs_error_line (code, "bk_input", "attach bk_input_1", ""); go to MOUNT_ERROR; end; call iox_$open (iocbp1, Stream_input, "0"b, code); tape_dim_data_$tdcm_buf_size = 2080; /* reset */ if code ^= 0 then call backup_map_$fs_error_line (code, "bk_input", "open bk_input_1", ""); else do; call ioa_$rsnnl ("Tape label: ^a.", line, temp, tape_label); call backup_map_$tapes (buffer, temp); end; MOUNT_ERROR: mount_status = code; mounted = (code = 0); /* set mounted switch */ end mount; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ unmount: procedure; /* internal procedure to unmount current reel(s) */ held = "0"b; call iox_$close (iocbp1, code); if code ^= 0 then call backup_map_$fs_error_line (code, "bk_input", "close bk_input_1", ""); call iox_$detach_iocb (iocbp1, code); if code ^= 0 then call backup_map_$fs_error_line (code, "bk_input", "detach bk_input_1", ""); mounted = "0"b; call backup_map_$tapes (addr (blanks), 4); /* Reset label info in map header */ end unmount; end bk_input;  bk_retrieve.pl1 11/11/89 1112.9r w 11/11/89 0809.5 214047 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ bk_retrieve: proc; /* extracted from backup_load */ /* Modified 16 June 1970, R H Campbell. */ /* Modified 21 October 1970, R. J. Feiertag */ /* Modified 10 May 1971, R. A. Tilden */ /* Modified 22 July 1974 RE Mullen */ /* Modified 23 July 1975, R. Bratt to remove knowledge of pre 18-0 backup tape formats */ /* Entry points check_structure and parse structure added 11/9/77 by Steve Herbst */ /* -no_primary added 08/03/79 S. Herbst */ /* Modified to avoid page boundary hardware bug 098; installed on MCR 4311 to fix errmsgs 02/05/80 S. Herbst */ /* Hierarchy level restriction removed for reloading commands 07/18/80 S. Herbst */ /* Changed not to cross-retrieve a segment in place of an existing directory 01/21/82 S. Herbst */ /* Changed to retrieve an entire MSF without ">**" 02/05/82 S. Herbst */ dcl (i, j, k, l, n, htype) fixed bin, /* temporary storage */ path_name char (168), /* Complete path name of entry. */ old_dname char (168) init (""), /* Previous directory name. */ code fixed bin (35); dcl line char (300) static, /* Output line(s) buffer. */ line_pointer ptr static, /* Pointer to line buffer. */ hp ptr static, a_hp ptr; dcl nl char (1) static; /* Newline used in parsing retrieval control */ dcl rname char (168) aligned, /* Retrieval control input name, dirname */ rdname char (168) static aligned, /* Retrieval control dirname */ rename char (32) aligned static, /* ..entry name */ (rsize, rbc) fixed bin; /* size of rname, bit count of file */ dcl (rptr, reqptr) ptr static; /* ptr to retrieval control (raw, parsed) */ dcl (parsed, next, stop, terminate, reported, checked) fixed bin static; dcl label_index fixed bin; dcl (rlines, rfin, rcomp, /* no. requests, no. complete, no. unique */ rcurr, ncurr) fixed bin static, /* current request, next newname */ grt_count fixed bin; /* number of >'s in a pathname */ dcl 1 req based (reqptr) aligned, /* parsed request array */ 2 path_copy char (168), /* to avoid CMPC failure near page boundary, Bug 098 */ 2 opt (1000), /* options for, status of, a request */ 3 (rename, /* new name was provided */ exact, /* load only this entity */ synonym, /* this entry is a synonym for the one specified by renamo */ found, /* something by this name was found */ finished, /* request has been satisfied fully */ spare) bit (1) unaligned, 2 srch (1000), /* data by which to retrieve */ 3 (len, /* significant chars in search name */ grt, /* number of >'s in search name */ control_index, /* index of backup_control entry for backup_load_ */ renamo) fixed bin, /* index of newname or of primary entry if a synonym */ 3 name char (168), /* name to look for */ 2 newn (200), /* name by which to reload */ 3 (ndlen, nelen, ngrt) fixed bin, /* lengths of next fields, number of ">"s in dname */ 3 ndname char (168); /* new pathname */ dcl (rscan (1000000) char (1), rmove char (1000000)) based, /* overlays for parsing */ rset bit (6) based; /* overlay for setting field of bits */ dcl (error_table_$badcall, error_table_$bad_string, error_table_$smallarg, error_table_$badpath, error_table_$noentry, error_table_$no_dir, error_table_$no_s_permission, error_table_$moderr, error_table_$no_info, error_table_$arg_ignored, error_table_$segknown) external fixed bin (35); dcl (addr, baseptr, divide, fixed, index, length, reverse, rtrim, substr, unspec, verify) builtin; dcl backup_map_$fs_error_line entry (fixed bin (35), char (*) aligned, char (*) aligned, char (*) aligned), backup_map_$on_line entry (ptr, fixed bin), backup_util$get_real_name entry (ptr, ptr, fixed bin, fixed bin (35)), expand_pathname_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)), hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)), hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*), fixed bin, fixed bin (2), ptr, fixed bin (35)); dcl (com_err_, ioa_, ioa_$rsnnl) ext entry options (variable); /* */ %include bk_ss_; %page; %include backup_control; %page; %include backup_preamble_header; %page; %include backup_record_types; /* */ /* Check whether this tape record is to be reloaded by scanning retrieval request segment. */ check_retrieval: entry (label_index); if rfin = rcomp then do; /* If all unique requests are fully satisfied */ call ioa_$rsnnl ("^a: all requests satisfied.", line, n, bk_ss_$myname); call backup_map_$on_line (line_pointer, n); /* inform the world of success */ label_index = stop; /* and terminate retrieval */ go to exit; end; htype = hp -> h.record_type; hp -> h.dlen = length (rtrim (hp -> h.dname)); path_name = substr (hp -> h.dname, 1, hp -> h.dlen) || ">"; /* prepare full name of tape record */ n = hp -> h.dlen + 1; /* set the length */ if hp -> h.elen ^= 0 then do; /* if there is an entry name, tack it on */ hp -> h.elen = length (rtrim (hp -> h.ename)); substr (path_name, n + 1) = substr (hp -> h.ename, 1, hp -> h.elen) || ">"; n = n + hp -> h.elen + 1; /* recompute length */ end; if rcurr ^= 0 then do; /* if we are currently working on a subtree request */ i = rcurr; /* set i in case of match */ req.path_copy = req.srch.name (i); if substr (path_name, 1, req.srch.len (i)) = req.path_copy then go to match; /* first part of pathname matches */ if bk_ss_$onlysw & req.opt.found (i) then do; /* no longer matching, and wanted only first */ req.opt.finished (i) = "1"b; /* mark previous request completed */ if req.opt.synonym (i) then req.opt.finished (req.srch.renamo (i)) = "1"b; /* and his twin */ rfin = rfin + 1; /* number of fully completed increases */ end; end; do i = 1 to rlines; /* look for applicable request */ if i = rcurr then go to next_test; /* skip possible request previously checked */ if req.opt.finished (i) then go to next_test; /* skip completed request */ if req.opt.exact (i) then do; /* exact means don't load subtree */ if n = req.srch.len (i) & substr (path_name, 1, n) = req.srch.name (i) then go to match; /* exactly the item requested */ end; else do; req.path_copy = req.srch.name (i); if substr (path_name, 1, req.srch.len (i)) = req.path_copy then go to match; /* pathname matches */ end; next_test: end; rcurr = 0; /* not working on anything */ label_index = next; /* don't process this tape record */ go to exit; match: bk_ss_$retrieval_index = i; /* save; backup_load uses it */ if bk_ss_$sub_entry then bk_ss_$path_index = req.srch.control_index (i); if htype ^= ndc_directory & htype ^= sec_dir then do; req.opt.found (i) = "1"b; /* indicate something interesting encountered */ if req.opt.synonym (i) then req.opt.found (req.srch.renamo (i)) = "1"b; /* on twin too */ if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.found (bk_ss_$path_index) = "1"b; end; if bk_ss_$onlysw then do; /* special processing with -first option */ if req.opt.exact (i) then do; /* if only exact match was wanted, this is it */ if htype ^= ndc_directory & htype ^= sec_dir then do; req.opt.finished (i) = "1"b; /* so mark it, and its brother if any */ if req.opt.synonym (i) then req.opt.finished (req.srch.renamo (i)) = "1"b; rfin = rfin + 1; /* count number of requests complete */ end; end; if rcurr ^= 0 then /* avoid OOB */ if req.opt.finished (rcurr) then rcurr = 0; /* we delayed resetting this so it could be used in loop */ end; if ^req.opt.exact (i) then rcurr = i; /* indicate we are currently interested in a subtree */ if req.opt.rename (i) then do; /* check whether to load it under its own name */ bk_ss_$cross_retrievesw = "1"b; ncurr = req.srch.renamo (i); /* get index of new name */ if req.opt.synonym (i) then ncurr = req.srch.renamo (ncurr); /* indirect if necessary */ grt_count = req.srch.grt (i); j = 0; /* count of ">"s in tape dirname */ if req.newn.ndlen (ncurr) = 0 then do; /* check whether replacing only entry name */ if (htype = ndc_directory_list) then do; do i = 1 to hp -> h.dlen; /* scan for entry name portion */ if addr (hp -> h.dname) -> rscan (i) = ">" then do; j = j + 1; /* count subpath */ if j = grt_count then do; /* found the place */ hp -> h.dname = substr (hp -> h.dname, 1, i) || substr (req.newn.ndname (ncurr), 1, req.newn.nelen (ncurr)); hp -> h.dlen = i + req.newn.nelen (ncurr); go to renamed; /* finished renaming */ end; end; end; go to renamed; end; hp -> h.ename = req.newn.ndname (ncurr); /* change name */ hp -> h.elen = req.newn.nelen (ncurr); /* and its length */ go to renamed; /* go load it */ end; if (htype = ndc_directory_list) then do; do i = 1 to hp -> h.dlen; /* scan old dirname */ if addr (hp -> h.dname) -> rscan (i) = ">" then do; j = j + 1; /* count partial path */ if j = grt_count + 1 then do; /* looking for one > beyond the old path */ partial: hp -> h.dname = substr (req.newn.ndname (ncurr), 1, req.newn.ndlen (ncurr)) || substr (hp -> h.dname, i, hp -> h.dlen - i + 1); hp -> h.dlen = hp -> h.dlen - i + 1 + req.newn.ndlen (ncurr); go to renamed; /* partial path substituted */ end; end; end; dironly: hp -> h.dlen = req.newn.ndlen (ncurr); /* complete replacement */ hp -> h.dname = substr (req.newn.ndname (ncurr), 1, hp -> h.dlen); go to renamed; end; do i = 1 to hp -> h.dlen; /* scan entire tape dirname */ if addr (hp -> h.dname) -> rscan (i) = ">" then do; /* if it is end of partial path, count it */ j = j + 1; /* increment total */ if j = grt_count then do; /* check whether this is size of dirname */ k = index (substr (hp -> h.dname, i + 1), ">"); /* look for another one */ if k = 0 then go to dironly; /* if not, dirname only needs changing */ i = i + k; /* replace this many levels of dirname */ go to partial; /* rename front end of path */ end; end; end; hp -> h.dlen = req.newn.ndlen (ncurr) - req.newn.nelen (ncurr) - 1; /* replace both d- and e- names */ hp -> h.dname = substr (req.newn.ndname (ncurr), 1, hp -> h.dlen); hp -> h.elen = req.newn.nelen (ncurr); hp -> h.ename = substr (req.newn.ndname (ncurr), hp -> h.dlen + 2, hp -> h.elen); renamed: end; else bk_ss_$cross_retrievesw = "0"b; label_index = checked; /* reload (renamed) entity */ go to exit; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ flag_msf: entry (A_index); dcl A_index fixed bin; rcurr = A_index; /* doing a subtree (MSF) */ req.opt.exact (A_index) = "0"b; /* retrieve the whole subtree */ if req.opt.synonym (A_index) then req.opt.exact (req.srch.renamo (A_index)) = "0"b; /* get the twin too in case it matters */ return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* Entry to parse the retrieval file and convert it into tabular form */ parse_retrieval_control: entry (rname, rsize, a_hp, label_index); if bk_ss_$sub_entry then do; call backup_map_$fs_error_line (error_table_$badcall, "bk_retrieve$parse_retrieval_control", "^/This entry point must be called via backup_load, reload or retrieve", ""); label_index = terminate; end; go to COMMON; parse_structure: entry (a_hp, label_index); if ^bk_ss_$sub_entry then do; call backup_map_$fs_error_line (error_table_$badcall, "bk_retrieve$parse_structure", "^/This entry point must be called via backup_load_", ""); label_index = terminate; end; COMMON: hp = a_hp; /* Copy argument into static and save */ unspec (nl) = "000001010"b; /* Newline character */ rfin, rlines = 0; /* convert retrieval file to tabular form */ parsed = 1; /* set up label index words */ next = 2; stop = 3; terminate = 4; reported = 5; checked = 6; if ^bk_ss_$sub_entry then do; line_pointer = addr (line); call expand_pathname_ (substr (rname, 1, rsize), rdname, rename, code); if code ^= 0 then do; call com_err_ (code, bk_ss_$myname, rname); go to reported_exit; /* cannot proceed without legal pathname */ end; call hcs_$initiate_count (rdname, rename, "", rbc, 1, rptr, code); if code ^= 0 & code ^= error_table_$segknown then do; call com_err_ (code, bk_ss_$myname, "^a>^a", rdname, rename); go to reported_exit; /* cannot proceed without instructions */ end; end; call hcs_$make_seg ("", "retrieval_control", "", 01011b, reqptr, code); if code ^= 0 & code ^= error_table_$segknown then do; call com_err_ (code, bk_ss_$myname, "retrieval_control"); reported_exit: label_index = reported; /* cannot proceed without storage */ go to exit; end; call hcs_$truncate_seg (reqptr, 0, 0); /* be sure it's zeroes */ ncurr, rcurr, i = 1; /* new names, requests, character cursors */ if bk_ss_$sub_entry then do; rlines, rcomp = bk_ss_$control_ptr -> backup_control.request_count; if rlines > 500 then go to parsed_enough; do rcurr = 1 to rlines; line = bk_ss_$control_ptr -> backup_control.path (rcurr); if substr (line, 1, 1) ^= ">" then do; bk_ss_$control_ptr -> backup_control.status_code (rcurr) = error_table_$badpath; label_index = terminate; go to exit; end; req.srch.control_index (rcurr) = rcurr; /* one req.srch per backup_control entry so far */ req.srch.name (rcurr) = line; req.srch.len (rcurr) = length (line) + 1 - verify (reverse (line), " "); if bk_ss_$control_ptr -> backup_control.new_path (rcurr) ^= "" then do; /* cross-retrieval */ req.opt.rename (rcurr) = "1"b; req.srch.renamo (rcurr) = ncurr; j = 0; /* count >'s in search name */ do k = 1 to req.srch.len (rcurr); if addr (req.srch.name (rcurr)) -> rscan (k) = ">" then j = j + 1; end; req.srch.grt (rcurr) = j; line = bk_ss_$control_ptr -> backup_control.new_path (rcurr); n = length (rtrim (line)); bk_ss_$no_primary = bk_ss_$control_ptr -> backup_control.no_primary_sw (rcurr); j = 0; call count_grts; ncurr = ncurr + 1; n = req.srch.len (rcurr); end; else req.opt.rename (rcurr) = "0"b; req.opt.exact (rcurr) = "0"b; /* load everything underneath specified entry */ end; end; else do; rbc = divide (rbc, 9, 17, 0); /* compute number of characters to scan */ do while (i < rbc); /* scan the file one line at a time */ if rlines > 500 then go to parsed_enough; /* maximum requests at one time */ do j = i by 1 to rbc while (rptr -> rscan (j) ^= nl); /* isolate one request line */ end; n = j - i; /* length without newline character */ k = i; /* save beginning of line index */ i = j + 1; /* one past the newline */ if n = 0 then go to parse_next; /* ignore blank line */ line = substr (rptr -> rmove, k, n); /* extract line to facilitate further scanning */ if substr (line, 1, 1) ^= ">" then do; /* at least the lefthand side must be a pathname */ call com_err_ (error_table_$badpath, bk_ss_$myname, "search arg of ^a", line); go to bad_p; end; j = index (line, "="); /* check for rename option */ if j = 0 then do; /* renaming was not specified */ req.opt.rename (rcurr) = ""b; /* turn off the switch */ req.srch.name (rcurr) = substr (line, 1, n); /* move in pathname to seek */ req.srch.len (rcurr) = n; /* and its length */ end; else do; /* renaming was specified */ if j = n then do; /* line ending in "=" is an error */ call com_err_ (error_table_$bad_string, bk_ss_$myname, "no new name in ^a", line); go to bad_p; /* give up */ end; req.opt.rename (rcurr) = "1"b; /* so indicate */ req.srch.name (rcurr) = substr (line, 1, j - 1); /* move search argument */ req.srch.len (rcurr) = j - 1; /* length of sought pathname */ req.srch.renamo (rcurr) = ncurr; /* location of new name */ call count_grts; /* count ">"'s in pathname */ ncurr = ncurr + 1; /* prepare for next renaming */ n = j - 1; /* length ignoring righthand side */ end; call see_stars; /* look for stars in search name */ j = 0; /* count >'s in search name */ do k = 1 to req.srch.len (rcurr); if addr (req.srch.name (rcurr)) -> rscan (k) = ">" then j = j + 1; end; req.srch.grt (rcurr) = j; rcurr = rcurr + 1; /* next request */ rlines = rlines + 1; parse_next: end; call hcs_$terminate_noname (rptr, code); /* ascii version no longer needed */ if code ^= 0 then call backup_map_$fs_error_line (code, "terminate_noname", rname, ""); rcomp = rlines; /* number of requests to fulfill first option */ end; do i = 1 to rlines; /* see if abbreviations were typed and get fuller names */ if bk_ss_$sub_entry then bk_ss_$no_primary = bk_ss_$control_ptr -> backup_control.no_primary_sw (i); if ^bk_ss_$no_primary then do; call backup_util$get_real_name (addr (req.srch.name (i)), addr (req.srch.name (rcurr)), req.srch.len (rcurr), code); if code > 1 & code ^= error_table_$noentry & code ^= error_table_$no_dir & code ^= error_table_$no_s_permission & code ^= error_table_$moderr & code ^= error_table_$no_info then do; bk_ss_$path_index = i; call backup_map_$fs_error_line (code, (bk_ss_$myname), "get_real_name for "||req.srch.name (i), ""); go to bad_p; end; else if code = 1 then do; /* another name was generated */ req.opt (rcurr) = req.opt (i); req.opt.synonym (rcurr) = "1"b; /* indicate duplicate entry */ req.srch.renamo (rcurr) = i; /* point out original request */ req.srch.control_index (rcurr) = req.srch.control_index (i); /* index of backup_control entry for backup_load_ */ req.srch.grt (rcurr) = req.srch.grt (i); /* copy the original's > count */ req.srch.name (rcurr) = substr (req.srch.name (rcurr), 1, req.srch.len (rcurr)) || ">"; req.srch.len (rcurr) = req.srch.len (rcurr) + 1; /* ">" added for comparisons */ rcurr = rcurr + 1; rlines = rlines + 1; end; end; else code = 0; req.srch.name (i) = substr (req.srch.name (i), 1, req.srch.len (i)) || ">"; /* append ">" for comparisons */ req.srch.len (i) = req.srch.len (i) + 1; /* adjust size */ end; rcurr = 0; /* indicate no "current" request */ label_index = parsed; /* proceed to load the tape */ go to exit; parsed_enough: call ioa_$rsnnl /* here if too many requests for request table */ ("^a: over 500 retrieval requests. Reload ended.", line, n, bk_ss_$myname); call backup_map_$on_line (line_pointer, n); /* print complaint */ bad_p: call hcs_$terminate_noname (rptr, code); /* get rid of useless parsed data */ code = error_table_$arg_ignored; rlines = 0; /* say we don't have any requests */ label_index = terminate; /* abort run */ return; count_grts: proc; req.newn.ngrt (ncurr) = 0; /* prepare to count ">"s */ if substr (line, j + 1, 1) = ">" then do; /* see if dirname or entry name */ req.newn.ndname (ncurr) = substr (line, j + 1, n - j); /* save new dirname */ req.newn.ndlen (ncurr) = n - j; /* ..and its length */ if ^bk_ss_$no_primary then call backup_util$get_real_name /* use primary pathname */ (addr (req.newn.ndname (ncurr)), addr (req.newn.ndname (ncurr)), req.newn.ndlen (ncurr), code); else code = 0; do k = 1 to req.newn.ndlen (ncurr); /* count its ">"s */ if addr (req.newn.ndname (ncurr)) -> rscan (k) = ">" then do; req.newn.ngrt (ncurr) = req.newn.ngrt (ncurr) + 1; l = k; /* we need to know where the last one was */ end; end; req.newn.nelen (ncurr) = req.newn.ndlen (ncurr) - l; /* split off and save entry name */ end; else do; /* store entry name */ req.newn.ndlen (ncurr) = 0; /* no dirname */ req.newn.ndname (ncurr) = substr (line, j + 1, n - j); req.newn.nelen (ncurr) = n - j; end; end count_grts; see_stars: proc; if substr (req.srch.name (rcurr), n - 2, 3) = ">**" then do; /* hierarchy load is wanted */ req.opt.exact (rcurr) = ""b; /* don't want exact match only */ substr (req.srch.name (rcurr), n - 2, 3) = ""; /* reset global indicator */ req.srch.len (rcurr) = n - 3; /* lower length */ if req.opt.rename (rcurr) then do; /* special rules for subtree renaming */ l = 1; /* prepare to count ">"s in search name */ do k = 2 to req.srch.len (rcurr); /* to check that request is not to change hierarchy level */ if addr (req.srch.name (rcurr)) -> rscan (k) = ">" then l = l + 1; end; end; end; else req.opt.exact (rcurr) = "1"b; /* exact match is wanted */ req.opt.found (rcurr), req.opt.finished (rcurr), req.opt.synonym (rcurr) = ""b; end see_stars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* Entry to prepare notification of what was accomplished */ report_retrieval: entry; dcl unsatisfied bit (1) aligned; if rlines = 0 then go to exit; if bk_ss_$sub_entry then go to reportend; call hcs_$initiate_count (rdname, rename, "", rbc, 1, rptr, code); if code ^= 0 & code ^= error_table_$segknown then do; /* cannot report if we can't access request file */ call backup_map_$fs_error_line (code, "initiate", rdname, rename); go to reportend; end; rbc = divide (rbc, 9, 17, 0); /* who knows if it changed? */ i, k = 1; /* ascii index, request index */ unsatisfied = ""b; /* Flags first unsatisfied request */ next_req: n = index (substr (rptr -> rmove, i, rbc), nl); /* Look for next new line character */ if n ^= 0 then /* Found one */ if ^req.opt (k).found then do; /* Was this request satisfied? */ if ^unsatisfied then do; /* Was previous unsatisfied request found? */ call ioa_ ("The following requests were not satisfied:"); /* NO! */ unsatisfied = "1"b; /* Mark unsatisfied request encountered */ end; call ioa_ ("^a^/ Search name: ^a", substr (rptr -> rmove, i, n-1), substr (req.srch (k).name, 1, req.srch (k).len)); end; i = i + n; /* Increment index to continue scan of request file */ k = k + 1; /* Increment parsed request index */ if i < rbc then go to next_req; /* Continue if more input */ call hcs_$terminate_noname (rptr, code); /* get rid of ascii requests */ reportend: call hcs_$truncate_seg (reqptr, 0, code); /* get rid of parsed requests */ exit: return; end;  bk_ss_.cds 11/11/89 1112.9rew 11/11/89 0807.8 106290 /* *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * *********************************************************** */ /* Hierarchy dumper/reloader subsystem static data */ /* Created: June 1982 by G. Palter from ALM source with modifications for true AIM support in IMFT */ /* Modified: August 1983 by Robert Coren to add minimum_access_class */ /* Modified: November 1983 by Robert Coren to add upgrade_to_user_auth */ /* HISTORY COMMENTS: 1) change(87-03-03,GWMay), approve(87-03-03,MCR7627), audit(87-03-13,Farley), install(87-03-30,MR12.1-1018): added a switch, writing_map, to indicate when the dump map is being written. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,ifthenstmt,ifthen */ bk_ss_: procedure () options (variable); dcl 1 bk_static aligned, /* static data */ 2 allow_dir_overwrite bit (1), /* ON => allows reloaded segment to replace a directory */ 2 areap pointer, /* -> directory list */ 2 brief_mapsw bit (1), /* ON => suppress form-feeds in maps */ 2 caller_handles_conditions bit (1), /* ON => caller traps errors for us */ 2 control_name character (168) unaligned, /* dump control segment pathname */ 2 control_ptr pointer, /* -> control structure for subroutine entries */ 2 cross_retrievesw bit (1), /* ON => cross retrieveing an entry */ 2 data_iocb pointer, /* -> I/O switch if preattached by caller */ 2 date fixed binary (52), /* dump anything modified after this date */ 2 datesw bit (1), /* ON => dump/reload by date/time modified */ 2 debugsw bit (1), /* ON => do not use privileged entries */ 2 dir_trim bit (1), /* ON => delete directories when trimming on reload */ 2 dprint_destination character (24) unaligned, /* destination for dprinting maps */ 2 dprint_destination_setsw bit (1), /* ON => destination (above) is set */ 2 dprint_heading character (64) unaligned, /* heading for dprinting maps */ 2 dprint_heading_setsw bit (1), /* ON => heading is set */ 2 dprint_queue fixed binary, /* queue for dprint requests */ 2 dprint_request_type character (24) unaligned, /* request type for dprint requests */ 2 dprint_request_type_setsw bit (1), /* ON => request type is set */ 2 dprintsw bit (1), /* ON => dprint maps */ 2 dtdsw bit (1), /* ON => dump by date/time dumped */ 2 ename character (32), /* name of branch to dump */ 2 err_label label variable, /* error recovery label */ 2 err_onlinesw bit (1), /* ON => print errors online */ 2 error fixed binary, /* indicates error recovery method */ 2 holdsw bit (1), /* ON => do not unmount tape when done */ 2 hp pointer, /* -> preamble segment */ 2 ignore_dates bit (1), /* ON => reload without checking dates */ 2 mapsw bit (1), /* ON => produce a map */ 2 myname character (16) unaligned, /* name of module invoked (backup_dump, reload, ...) */ 2 namesw bit (1), /* ON => dump only the named branch */ 2 no_contin bit (1), /* ON => stop dumping after a catchup dump */ 2 no_output bit (1), /* ON => do not actually make the tape */ 2 no_primary bit (1), /* ON => do not use primary pathnames */ 2 no_reload bit (1), /* ON => do not reload anything into storage system */ 2 no_setlvid bit (1), /* ON => do not set sons LVID when reloading */ 2 ntapes fixed binary, /* # of tapes to make (1 or 2) */ 2 onlysw bit (1), /* ON => do not dump subtree contents or stop on first match on reload */ 2 operator character (32) unaligned, /* name of operator running dump/reload */ 2 path_index fixed binary, /* index in backup_control structure being processed */ 2 pathsw bit (1), /* ON => have starting directory for a dump */ 2 preattached bit (1), /* ON => use caller's I/O switch for I/O */ 2 pvsw bit (1), /* ON => reload only for given physical volume */ 2 pvname character (32), /* name of volume for reload */ 2 qchecksw bit (1), /* ON => do not suspend quota checking */ 2 quotasw bit (1), /* ON => restore quota from tape */ 2 restart_dumpsw bit (1), /* ON => restart dump from given directory */ 2 restart_path character (168), /* pathname of where to restart dump */ 2 restart_plen fixed binary, /* length of said pathname */ 2 retrieval_index fixed binary, /* index of object in bk_retrieve's table */ 2 retrievesw bit (1), /* ON => retrieval vs. reload */ 2 rlen fixed binary, /* length of current restart dirname */ 2 rname character (168) unaligned, /* pathname of retrieval control segment */ 2 rsize fixed binary, /* size of above pathname */ 2 save_path character (168) unaligned, /* saved pathname (for subtree dumping) */ 2 save_plen fixed binary, /* length of saved pathname */ 2 save_time fixed binary (52), /* starting time of dump/reload */ 2 segptr pointer, /* -> segment being dumper */ 2 set_dtd bit (1), /* ON => set date/time dumped */ 2 set_dtd_explicit bit (1), /* ON => above was set by user/operator */ 2 sp pointer, /* -> output buffer */ 2 sub_entry bit (1), /* ON => backup_dump_/backup_load_ */ 2 sub_entry_errfile bit (1), /* ON => produce error file even when subroutine call */ 2 tapesw bit (1), /* ON => produce output */ 2 trimsw bit (1), /* ON => trim contents when reloading */ 2 volume_set_name character (32) unaligned, /* tape volume name (unimplemented) */ 2 wakeup_interval fixed binary (52), /* wakeup interval for incremental dumps */ 2 wasnt_known bit (1), /* ON => must terminate segment being dumped */ 2 enforce_max_access_class bit (1), /* ON => don't dump anything above give access class */ 2 maximum_access_class bit (72), /* the maximum access class to enforce on all branches */ 2 enforce_min_access_class bit (1), /* ON => don't dump anything below give access class */ 2 minimum_access_class bit (72), /* the minimum access class to enforce on all branches */ 2 dont_dump_upgraded_dirs bit (1), /* ON => don't dump any directory above given access class */ 2 maximum_dir_access_class bit (72), /* the access class to enforce on directories */ 2 check_effective_access bit (1), /* ON => don't dump branches given user can't access */ 2 upgrade_to_user_auth bit (1), /* ON => set access class of branch being dumped to user's authorization */ 2 user_id character (32) unaligned, /* the user's Person.Project.tag */ 2 user_authorization bit (72), /* the user's process authorization */ 2 user_ring fixed binary, /* the user's ring of execution */ 2 restore_access_class bit (1), /* ON => restore access class even when debugging */ 2 enforce_minimum_ring bit (1), /* ON => don't give anything lower ring bracket */ 2 minimum_ring fixed binary, /* the minimum ring bracket to be used */ 2 translate_access_class bit (1), /* ON => translate access classes read from tape */ 2 source_attributes_ptr pointer, /* -> source system's AIM attributes */ 2 target_attributes_ptr pointer, /* -> target system's AIM attributes */ 2 writing_map bit (1); /* ON => in backup_map$try_write */ dcl 1 err_label_structure aligned based (addr (bk_static.err_label)), 2 codeptr pointer, 2 environmentptr pointer; dcl 1 cds_control automatic aligned like cds_args; dcl code fixed binary (35); dcl BK_SS_ character (32) static options (constant) initial ("bk_ss_"); dcl com_err_ entry () options (variable); dcl create_data_segment_ entry (pointer, fixed binary (35)); dcl (addr, currentsize, null, string, unspec) builtin; %page; /* Supply initial values for static data */ unspec (bk_static) = ""b; err_label_structure = null (); bk_static.areap = null (); bk_static.hp = null (); bk_static.segptr = null (); bk_static.sp = null (); bk_static.control_ptr = null (); bk_static.data_iocb = null (); bk_static.date = 0; bk_static.save_time = 0; bk_static.wakeup_interval = 0; bk_static.cross_retrievesw = "0"b; bk_static.allow_dir_overwrite = "0"b; bk_static.control_name = ""; bk_static.datesw = "0"b; bk_static.debugsw = "0"b; bk_static.dir_trim = "0"b; bk_static.dprint_destination = ""; bk_static.dprint_destination_setsw = "0"b; bk_static.dprint_heading = ""; bk_static.dprint_heading_setsw = "0"b; bk_static.dprint_queue = -1; bk_static.dprint_request_type = ""; bk_static.dprint_request_type_setsw = "0"b; bk_static.dprintsw = "1"b; bk_static.dtdsw = "0"b; bk_static.ename = ""; bk_static.err_onlinesw = "0"b; bk_static.error = 0; bk_static.holdsw = "0"b; bk_static.ignore_dates = "0"b; bk_static.mapsw = "1"b; bk_static.brief_mapsw = "0"b; bk_static.myname = ""; bk_static.namesw = "0"b; bk_static.no_contin = "0"b; bk_static.no_output = "0"b; bk_static.no_primary = "0"b; bk_static.no_reload = "0"b; bk_static.no_setlvid = "0"b; bk_static.ntapes = 1; bk_static.onlysw = "0"b; bk_static.operator = ""; bk_static.path_index = 1; bk_static.pathsw = "0"b; bk_static.pvsw = "0"b; bk_static.pvname = ""; bk_static.qchecksw = "0"b; bk_static.quotasw = "0"b; bk_static.rlen = 0; bk_static.restart_dumpsw = "0"b; bk_static.restart_plen = 0; bk_static.restart_path = ""; bk_static.retrieval_index = 1; bk_static.retrievesw = "0"b; bk_static.rsize = 0; bk_static.rname = ""; bk_static.save_plen = 0; bk_static.save_path = ""; bk_static.set_dtd = "0"b; bk_static.set_dtd_explicit = "0"b; bk_static.sub_entry = "0"b; bk_static.sub_entry_errfile = "0"b; bk_static.caller_handles_conditions = "0"b; bk_static.tapesw = "1"b; bk_static.trimsw = "0"b; bk_static.volume_set_name = ""; bk_static.wasnt_known = "0"b; bk_static.preattached = "0"b; bk_static.enforce_max_access_class = "0"b; bk_static.maximum_access_class = ""b; bk_static.enforce_min_access_class = "0"b; bk_static.minimum_access_class = ""b; bk_static.dont_dump_upgraded_dirs = "0"b; bk_static.maximum_dir_access_class = ""b; bk_static.check_effective_access = "0"b; bk_static.upgrade_to_user_auth = "0"b; bk_static.user_id = ""; bk_static.user_authorization = ""b; bk_static.user_ring = 0; bk_static.restore_access_class = "0"b; bk_static.enforce_minimum_ring = "0"b; bk_static.minimum_ring = 0; bk_static.translate_access_class = "0"b; bk_static.source_attributes_ptr = null (); bk_static.target_attributes_ptr = null (); /* Fill in CDS description and create the data segment */ cds_control.sections (1).p = null (); cds_control.sections (1).len = 0; cds_control.sections (1).struct_name = ""; cds_control.sections (2).p = addr (bk_static); cds_control.sections (2).len = currentsize (bk_static); cds_control.sections (2).struct_name = "bk_static"; cds_control.seg_name = BK_SS_; cds_control.num_exclude_names = 0; cds_control.exclude_array_ptr = null (); string (cds_control.switches) = ""b; cds_control.have_static = "1"b; call create_data_segment_ (addr (cds_control), code); if code ^= 0 then call com_err_ (code, BK_SS_); return; %page; %include cds_args; end bk_ss_;  reload.pl1 11/11/89 1112.9rew 11/11/89 0805.5 121050 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ %; /* Driver for mload procedure. */ /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ reload: /* Created 21 May 1969, R H Campbell. */ procedure; /* Modified 15 March 1970, R H Campbell. */ /* Last mod by Kobziar, 1 May 75 to add system_release entry */ /* -dprint and -no_dprint added 03/19/80 S. Herbst */ /* Changed dprinting to see -ds, -he, and -rqt 12/01/81 S. Herbst */ /* Changed to dprint -no_endpage since map is already page-formatted 01/21/82 S. Herbst */ /* Updated dprint_defaults structure to reflect latest dprint_arg.incl.pl1 04/01/85 Steve Herbst */ /****^ HISTORY COMMENTS: 1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686), audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): Updated to use version 9 of dprint_msg structure. 2) change(88-10-27,Brunelle), approve(88-10-27,MCR7911), audit(88-10-18,Wallman), install(88-10-28,MR12.2-1199): Upgraded to use new version of dprint_args structure. END HISTORY COMMENTS */ dcl (cold, complete, print_map, array) bit (1) init ("0"b); /* Flags to remember mode of operation. */ dcl map_name char (64), /* The reload map segment name. */ arg_array (20) char (32) aligned; dcl (dir char (168), ent char (32)) aligned, rings (3) fixed bin (6), error_table_$noarg ext fixed bin, error_table_$namedup ext fixed bin; dcl device char (8); /* Device map is attached to. */ dcl mode char (0); /* Mode of attachment. */ dcl tchar char (1) based; /* Test character */ dcl mname char (32); dcl code fixed bin; /* Error status code. */ dcl (l, n) fixed bin; /* Temporary. */ dcl (ap, alp, sp) pointer; /* Pointer to argument, IO status string. */ dcl arg based char (n); dcl error_table_$ionmat external fixed bin; /* Error code from ios_. */ dcl date_name_ entry (char (*), char (*), char (*), char (*), fixed bin); dcl backup_load entry; dcl com_err_ entry options (variable), cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin), cu_$arg_list_ptr entry (pointer), bk_arg_reader_$reload_arg_reader entry (fixed bin, pointer, fixed bin), bk_arg_reader_$array_arg_reader entry ((20) char (32) aligned, fixed bin), dprint_ entry (char(*) aligned, char(*) aligned, ptr, fixed bin), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin), hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1), fixed bin, fixed bin (35), fixed bin), hcs_$append_branchx entry (char (*) aligned, char (*) aligned, fixed bin (5), (3) fixed bin (6), char (*) aligned, fixed bin (1), fixed bin (1), fixed bin (24), fixed bin), hcs_$acl_add1 entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), (3) fixed bin (6), fixed bin), get_group_id_$tag_star returns (char (32) aligned), cu_$level_get returns (fixed bin), (ioa_, ioa_$rsnnl) entry options (variable), /* Variable arguments. */ ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned), ios_$detach entry (char (*), char (*), char (*), bit (72) aligned), ios_$get_at_entry_ entry (char (*), char (*), char (*), char (*), fixed bin), unique_chars_ entry (bit (*) aligned) returns (char (15) aligned); dcl (addr, max) builtin; % include bk_ss_; % include io_status; % include dprint_arg; dcl 1 dprint_defaults aligned, /* argument structure */ 2 version fixed bin init (9), /* version number of dcl */ 2 copies fixed bin init (1), /* number of copies wanted */ 2 delete fixed bin init(0), /* 1=delete after print */ 2 queue fixed bin init(-1), /* default print queue */ 2 pt_pch fixed bin init (1), /* 1=print, 2=punch */ 2 notify fixed bin init (0), /* 1 = notify user when done */ 2 heading char (64) init (""), /* first page heading */ 2 output_module fixed bin init (1), /* 1=print, 2=7punch, 3=mcc, 4=raw */ 2 dest char (12) init (""), /* destination */ /* limit of version 1 structure */ 2 carriage_control, /* Carriage control flags. */ 3 nep bit (1) unal init ("0"b), /* TRUE if print thru perf. */ 3 single bit (1) unal init ("0"b), /* TRUE if ignore FF and VT */ 3 non_edited bit (1) unal init ("0"b), /* TRUE if printing in non-edited mode */ 3 truncate bit (1) unal init ("0"b), /* TRUE if truncating lines at line length */ 3 center_top_label bit (1) unal init ("0"b), /* TRUE if top label to be centered */ 3 center_bottom_label bit (1) unal init ("0"b), /* TRUE if bottom label to be centered */ 3 esc bit (1) unal init ("0"b), 3 no_separator bit (1) unal init ("0"b), 3 line_nbrs bit (1) unal init ("0"b), 3 padding bit (27) unal init ((27)"0"b), 2 pad (30) fixed bin init ((30)0), 2 forms char (8) init (""), /* forms required */ 2 lmargin fixed bin init (0), /* left margin */ 2 line_lth fixed bin init (-1), /* max line lth */ /* limit of version 2 structure */ 2 class char(8) init (""), /* obsolete: device class */ 2 page_lth fixed bin init (-1), /* Paper length arg */ /* limit of version 3 structure */ 2 top_label char(136) init (""), /* top-of-page label */ 2 bottom_label char(136) init (""), /* bottom-of-page label */ /* limit of version 4 structure */ 2 bit_count fixed bin (35) init (0), 2 form_name char (24) init (""), 2 destination char (24) init (""), 2 chan_stop_path char (168) init (""), /* limit of version 5 structure */ 2 request_type char (24) unaligned init (""), /* default request type */ 2 defer_until_process_termination fixed bin init (0), /* 1 = don't process terminates */ 2 forms_name char (64) unaligned init (""); /* */ join_reload: cold = ""b; /* Entry for complete reload on "warm" system. */ print_map = "1"b; /* Set flags to indicate operation. */ bk_ss_$myname = "reload"; go to squo; /* Go to common code. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ reload_arg_array: entry (arg_array); array = "1"b; /* set flag */ goto join_reload; /* use common code */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** * */ system_release: entry; /* trim everything, tape info overwrites always */ cold = "0"b; print_map = "0"b; bk_ss_$myname = "reload"; /* function as a reload */ bk_ss_$ignore_dates = "1"b; /* all info on tape gets in */ bk_ss_$dir_trim = "1"b; /* directories go too */ go to squo; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ iload: entry; /* For complete (initial) reload on "cold" system. */ cold = "1"b; /* Set up flags. */ print_map = "0"b; /* .. */ bk_ss_$myname = "iload"; squo: bk_ss_$trimsw = "1"b; /* Set to trim for reload */ complete = "1"b; /* Complete dump wanted */ bk_ss_$quotasw = "1"b; /* Allow quota setting on reload */ go to reset_control; /* Go start processing. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ retrieve: entry; /* Entry to start retrieve-by-name. */ cold, complete, print_map = ""b; /* Set up flags for retrieval. */ bk_ss_$quotasw = ""b; /* No quota changing on retrieval */ bk_ss_$datesw = ""b; /* Flag to load segment dumped after given date */ bk_ss_$myname = "retrieve"; bk_ss_$trimsw = ""b; /* No trim on retrieve */ reset_control: bk_ss_$sub_entry = "0"b; bk_ss_$pvname = ""; bk_ss_$pvsw = "0"b; bk_ss_$rname = ""; bk_ss_$retrievesw = "0"b; bk_ss_$rsize = 0; start: n = 1; /* Set up to read first arg if any */ if ^complete then do; /* This is a retrieval */ call cu_$arg_ptr (1, ap, n, code); if code ^= 0 then do; /* arg is required */ call com_err_ (code, bk_ss_$myname, "Control file path required."); go to ended; end; if ap -> tchar = "-" then do; /* Prepare to call argument reader */ n = 1; /* Start with first arg */ go to arg_reader; end; bk_ss_$rname = ap -> arg; /* Save retrieval control file name */ bk_ss_$retrievesw = "1"b; /* Flag retrieval */ bk_ss_$rsize = n; /* And length. */ n = 2; /* Set up arg number for arg reader */ end; arg_reader: bk_ss_$mapsw = "1"b; /* First set some switches */ if ^array then do; call cu_$arg_list_ptr (alp); /* Get a pointer to the argument list */ call bk_arg_reader_$reload_arg_reader (n, alp, code); end; else call bk_arg_reader_$array_arg_reader (arg_array, code); if code ^= 0 then if code ^= error_table_$noarg then go to ended; if bk_ss_$myname = "retrieve" /* Is this supposed to be a retrieval */ then if bk_ss_$retrievesw /* If this is a retrieval */ then call ioa_$rsnnl ("^a.retrieve.map", map_name, l, bk_ss_$rname); /* Construct name using argument. */ else do; call ioa_ ("No retrieval file argument given"); go to ended; end; else if bk_ss_$debugsw then do; /* Just debuging or user trying to use this */ call date_name_ ("", "", "reload.map", mname, code); /* Make up a map name */ if code ^= 0 then do; call com_err_ (code, "reload", "Termination on error from date_name_"); go to ended; end; map_name = mname; /* Copy map name */ l = 32; end; else do; /* This is for real */ if cold then do; /* For COLD reload */ rings (1), rings (2), rings (3) = 7; call hcs_$append_branchx (">", "reload_dir", 01011b, rings, (get_group_id_$tag_star ()), 1, 0, 0, code); if code ^= 0 then if code ^= error_table_$namedup then go to ended; /* Can it be created? */ call hcs_$acl_add1 (">", "reload_dir", "*.SysDaemon.*", 01011b, rings, code); if code ^= 0 then go to ended; end; /* Put map in special directory */ call ioa_$rsnnl (">reload_dir>^a.reload.map", map_name, l, unique_chars_ (""b)); end; rings (1), rings (2), rings (3) = max ((cu_$level_get ()), 4); call expand_path_ (addr (map_name), l, addr (dir), addr (ent), code); call hcs_$append_branchx (dir, ent, 01011b, rings, (get_group_id_$tag_star ()), 0, 0, 0, code); if (code = 0) | (code = error_table_$namedup) then call hcs_$acl_add1 (dir, ent, "*.SysDaemon.*", 01011b, rings, code); sp = addr (status); /* Set up pointer to status structure. */ call ios_$attach ("map", "file_", map_name, "w", sp -> status_bits); /* Try to attach the map. */ if status.code = error_table_$ionmat then do; /* If name already attached, use it. */ if print_map then do; /* Will we need the name of the map file? */ call ios_$get_at_entry_ ("map", device, map_name, mode, code); /* Get AT info. */ if code = 0 then do; /* OK? */ if device ^= "file_" then /* Is it a file? */ print_map = ""b; /* No, we can't print it. */ end; else do; /* No, gripe. */ call com_err_ (code, bk_ss_$myname, "ios_$get_at_entry_ for map"); print_map = ""b; /* We can't print the map. */ end; end; end; else if status.code ^= 0 then do; /* All OK? */ call com_err_ (status.code, bk_ss_$myname, "ios_$attach for ^a", map_name); go to ended; /* Quit. */ end; call backup_load (); /* Start the loading */ done: call ios_$detach ("map", "", "", sp -> status_bits); /* Detach the map. */ if status.code ^= 0 then /* If not all OK, type comment, but ignore. */ call com_err_ (status.code, bk_ss_$myname, "ios_$detach for ^a", map_name); if print_map & bk_ss_$dprintsw then do; /* Can we print the map? */ dpap = addr(dprint_arg_buf); dprint_arg_buf = dprint_defaults; dprint_arg.nep = "1"b; /* -no_endpage since map is already page-formatted */ dprint_arg_buf.queue = bk_ss_$dprint_queue; if bk_ss_$dprint_destination_setsw then dprint_arg_buf.destination = bk_ss_$dprint_destination; else dprint_arg_buf.destination = "BACKUP"; if bk_ss_$dprint_heading_setsw then dprint_arg_buf.heading = bk_ss_$dprint_heading; else dprint_arg_buf.heading = "RELOAD MAP"; if bk_ss_$dprint_request_type_setsw then dprint_arg_buf.request_type = bk_ss_$dprint_request_type; call hcs_$status_minf (dir, ent, 1, 0, dprint_arg_buf.bit_count, code); call dprint_ ( dir, ent, dpap, code ); if code ^= 0 then call com_err_ ( code, bk_ss_$myname, "Unable to dprint map." ); end; ended: bk_ss_$myname = ""; /* we are no more */ end reload; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved