retrieve_from_volume_.pl1 10/21/92 1511.6rew 10/21/92 1509.3 376938 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1991 * * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-08-10,GWMay), approve(88-10-05,MCR8005), audit(88-10-12,Farley), install(88-10-17,MR12.2-1173): Updated iox_ dcls and calls. Changed read mechanism to deal with incomplete data from dump tapes. 2) change(91-11-12,Schroth), approve(91-12-02,MCR8252), audit(92-10-15,Zimmerman), install(92-10-21,MR12.5-1035): Correct error in truncating segments containing embedded nulled pages. END HISTORY COMMENTS */ /* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/ retrieve_from_volume_: proc (a_rvcp, code); /* This proc searches a dump volume specified by the volume control seg for all the objects specified therein. If one is found, then the appropriate action, either entry appending, or object copying is attempted. If successful the operator, and the requestor if he indicated, are notified. The dump volume is searched until no more useful information can be read. It is then closed but not detached in case the next volume to be read should be the same. */ /* Modified by D. Vinograd 6/79 to change check for logical header, to correct authorization in notify messages, to fix bug in buffer truncation, and xxx. */ /* Modified 2/10/82 by GA Texada to delete a recovered branch if the object cannot be recovered (hardcore 347) */ /* Modified 4/27/82 by GA Texada to change error handling on read errors. */ /* Modified July 1982 by GA Texada to fix a bug introduced above. */ /* Modified: 8/82 by GA Texada to fix phx07704 */ /* Modified: 84-03-16 by BIM to put in temporary fix to retrieve multi-class segments. This introduces a security hole that is closed by code in ring zero that sets SOOS when retv-appending multiclass objects. */ /* Modified: 84-12-27 by Keith Loepere for version 2 create_branch_info. */ /* Modified 03/12/85 by Greg Texada to fix phx19165, don't give up so soon when resynching (D. Kitson) */ dcl a_rvcp ptr; dcl aclc fixed bin; dcl aclp ptr; dcl aclrp bit (18); dcl answer char (3) var; dcl att_desc char (256); dcl attributes bit (36); dcl nelt fixed bin (21); dcl code fixed bin (35); dcl crbp ptr; dcl dp ptr; dcl dtd bit (36); dcl dtm bit (36); dcl emode bit (36); dcl ename char (32) aligned; dcl cslx fixed bin; dcl nmx fixed bin; dcl rvlx fixed bin; dcl ignore fixed bin (35); dcl iocbp ptr; dcl long char (100) aligned; dcl message char (512) var init (""); dcl message_len fixed bin; dcl new_contentsp ptr; dcl nlc fixed bin; dcl nlp ptr; dcl nrp bit (18); dcl object_read bit (1); dcl object_size fixed bin (19); dcl objectp ptr; dcl page_bufferp ptr; dcl page_offset fixed bin (21); dcl pmode bit (36); dcl pname char (168) aligned; dcl pnl fixed bin; dcl pvid bit (36); dcl nel fixed bin (21); dcl requests_left fixed bin; dcl resynch_retry_count fixed bin; dcl resynching bit (1); dcl resynching_completed bit (1); dcl short char (8) aligned; dcl temp_dirname char (168); dcl temp_ename char (32); dcl type fixed bin; dcl uid bit (36); dcl volid bit (36); dcl volname char (32); dcl vtoce_volid (3) bit (36); dcl words_skipped fixed bin (35); dcl page bit (BITS_PER_PAGE) aligned based; dcl based_area area based (retv_data_.areap); dcl copy (divide (nel, CHARS_PER_WORD, 17, 0)) fixed bin based; dcl name_list (2) char (32) aligned based (nlp); dcl 1 local_entry like entry; dcl 1 local_retv_append_args like retv_append_args aligned; dcl 1 local_create_branch_info like create_branch_info aligned; dcl 1 local_mseg_return_args like mseg_return_args aligned; dcl 1 acl_list (1) based (aclp) aligned, 2 person char (32), 2 project char (32), 2 tag char (1), 2 mode bit (36), 2 ex_mode bit (36); dcl dates_set defined attributes position (1) bit (1); dcl dump_switches_set defined attributes position (2) bit (1); dcl dump_info_set defined attributes position (3) bit (1); dcl pc_switches_set defined attributes position (4) bit (1); dcl quota_info_set defined attributes position (5) bit (1); dcl word (size (backup_volume_header)) bit (36) based (recordp); dcl input_buf (divide (nelt, CHARS_PER_WORD, 17, 0)) bit (36) based (recordp); dcl string bit (BITS_PER_WORD * size (backup_volume_header)) based (recordp); dcl DELIMITED bit (1) aligned internal static options (constant) init ("1"b); dcl FORWARD_CHAR_POSITIONING fixed bin int static init (3) options (constant); dcl myname char (32) int static init ("retrieve_from_volume_") options (constant); dcl SEG fixed bin static init (1) options (constant); dcl sm bit (3) int static init ("110"b) options (constant); dcl directory fixed bin int static init (1) options (constant); dcl (error_table_$namedup, error_table_$data_loss, error_table_$force_unassign, error_table_$notadir, error_table_$resource_unavailable, error_table_$noentry, error_table_$moderr, error_table_$vtoce_connection_fail, error_table_$bad_segment, error_table_$device_end, error_table_$end_of_info, error_table_$root) fixed bin (35) ext static; dcl retv_notify_ entry (char (*), ptr, char (*)); dcl command_query_ entry options (variable); dcl hc_backup_$delete entry (char (*), char (*), fixed bin (35)); dcl hc_backup_$set_bc entry (char (*), char (*), fixed bin (24), fixed bin (24), fixed bin (35)); dcl hc_backup_$get_entry entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35)); dcl hc_backup_$decode_uidpath entry ((16) bit (36) aligned, char (*), char (*), fixed bin (35)); dcl suffixed_name_$make entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)); dcl hc_backup_$retv_status entry (char (*) aligned, char (*) aligned, bit (72) aligned, char (*) aligned, fixed bin, fixed bin, bit (36), bit (36), bit (36), bit (36), (3) bit (36), bit (36), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), ptr, fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl message_segment_$incremental_read_index entry (fixed bin, ptr, bit (2), bit (72) aligned, ptr, fixed bin (35)); dcl message_segment_$update_message_index entry (fixed bin, fixed bin, bit (72) aligned, ptr, fixed bin (35)); dcl retv_report_$error_output entry options (variable); dcl retv_report_$online_output entry options (variable); dcl hc_backup_$retv_check entry (char (*) aligned, char (*) aligned, fixed bin, bit (36), fixed bin (35)); dcl hc_backup_$retv_add_acl entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35)); dcl hc_backup_$retv_addname entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)); dcl hc_backup_$retv_hash_search entry (ptr, ptr, ptr, fixed bin (35)); dcl hc_backup_$retv_append entry (char (*) aligned, char (*) aligned, ptr, ptr, fixed bin (35)); dcl hc_backup_$retv_copy entry (char (*) aligned, char (*) aligned, bit (72) aligned, char (*) aligned, fixed bin, ptr, ptr, bit (36), fixed bin (35)); dcl (addcharno, addr, bit, divide, fixed, index, length, min, null, ptr, rtrim, size, substr, unspec) builtin; rvcp = a_rvcp; code = 0; if retv_vol_control.in_use_cnt = 0 then return; /* nothing to look at */ /* pick static ptr */ recordp = retv_data_.recordp; nlp = retv_data_.nlp; aclp = retv_data_.aclp; objectp = retv_data_.objectp; page_bufferp = retv_data_.page_buffer_ptr; /* initialize local variables */ ms_arg_ptr = addr (local_mseg_return_args); resynching = "0"b; resynching_completed = "0"b; iocbp = null; inputp = null; /* initialize mail structure */ /* construct attach description */ volname = retv_vol_control.volname; volid = retv_vol_control.volid; if retv_data_.input_volume_desc ^= "" then call ioa_$rsnnl (retv_data_.input_volume_desc, att_desc, (0), volname); else call ioa_$rsnnl ("tape_mult_ ^a -system", att_desc, (0), volname); /* Check if volume to be read is same as last volume read. If so then its already mounted and at load point. If not then detach old volume and attach new volume. In either case open volume */ if volname ^= retv_data_.last_volname then do; if retv_data_.input_iocbp ^= null then call iox_$detach_iocb (retv_data_.input_iocbp, ignore); iocbp = null; retry: call iox_$attach_name ("input_volume", iocbp, att_desc, null (), code); retv_data_.input_iocbp = iocbp; if code ^= 0 then do; if code = error_table_$resource_unavailable | code = error_table_$force_unassign then do; if ^retv_vol_control.skip_query then do; query_info.version = query_info_version_5; call command_query_ (addr (query_info), answer, myname, "^/^a^/^a", "The physical drive or dump volume is not available or is in use by an other process.", "Do you wish to retry the attachment "); if answer = "yes" then goto retry; else retv_vol_control.skip_query = "1"b; end; else code = -1; /* special code that we skipped volume */ end; call retv_report_$error_output (code, myname, "Unable to attach dump volume ^a via desc ^a", volname, att_desc); goto finish; end; end; else iocbp = retv_data_.input_iocbp; call iox_$open (iocbp, Stream_input, "0"b, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to open dump volume ^a", volname); goto finish; end; retv_data_.last_volname = volname; requests_left = retv_vol_control.n_entries; if retv_data_.long then do; call retv_report_$online_output (0, "", "Reading ^a looking for:", volname); do rvlx = 1 to retv_vol_control.n_entries; rvcep = addr (retv_vol_control.array (rvlx)); if rvce.in_use then do; if rvce.entry_retrieval then call retv_report_$online_output (0, "", "Entry retrieval of ^a^[>^]^[^a>^;^s^]^a", rvce.dirname, (rvce.dirname ^= ">"), (rvce.ename ^= ""), rvce.ename, rvce.entry_name); else call retv_report_$online_output (0, "", "Object retrieval of ^a^[>^]^a", rvce.dirname, (rvce.dirname ^= ">"), rvce.ename); end; end; end; /* This is the main reading loop. The reading scheme is like that of the reloader. Each read is checked for an error and if one occured recovery is attempted. Recovery is made a brute force resynching on the pattern contained in the record header. If a read is ok then then the header pattern is checked. If ok then the rest of the header is read and checked for type. If it is contents seg then a check is made to see if the segment is online. If not an attempt is made to recover it for latter retrievals. If the version of the header does not check then the data in the record is skipped. */ search_loop: nel = CHARS_PER_WORD * size (backup_volume_header); call read (recordp, nel, nelt, ^DELIMITED, code); call check_input_error; if backup_volume_record.pattern1 ^= pattern1 | backup_volume_record.pattern2 ^= pattern2 | backup_volume_record.pattern3 ^= pattern3 then do; code = -1; call check_input_error; /* treat as bad read */ end; pattern_match: nel = backup_volume_record.rec1_len - size (backup_volume_header) * CHARS_PER_WORD; call read (ptr (recordp, size (backup_volume_header)), nel, nelt, ^DELIMITED, code); call check_input_error; if backup_volume_record.rec1_type = contents_type then do; call record_contents_segment; goto search_loop; end; if backup_volume_record.rec1_type ^= vtoce_type then do; nel = backup_volume_record.rec2_len; if nel ^= 0 then call skip_chars; goto search_loop; end; if backup_volume_record.version ^= backup_volume_record_version_1 & backup_volume_record.version ^= backup_volume_record_version_2 then do; call retv_report_$error_output (0, myname, "Invalid volume record on dump volume ^a", volname); nel = backup_volume_record.rec2_len; if nel ^= 0 then call skip_chars; goto search_loop; end; if backup_volume_record.uid ^= "0"b then do; retv_data_.last_valid_puid = backup_volume_record.uid_path; retv_data_.last_valid_vtoce_ename = backup_volume_record.primary_name; end; /* inform operator of last valid object read */ if resynching_completed & backup_volume_record.uid ^= "0"b then do; resynching_completed = "0"b; call retv_report_$error_output (0, myname, "First object after resynching ^a on dump volume ^a", convert_puid_ (), volname); end; object_read = "0"b; /* Once an object has been read successfully the volume control segment is scanned for a uid match. */ do rvlx = 1 to retv_vol_control.n_entries; rvcep = addr (retv_vol_control.array (rvlx)); if rvce.in_use & rvce.uid = backup_volume_record.uid then do; /* The two following checks make sure that that we recover either the most recent object or the object specified by the requestor. As dump volumes are read in reverse chronological order once an object is recovered it should not be recovered again unless it comes from the same dump volume. The requestor may though want an object dumped within some specific time bracket. If the conditions are not met we skip the request and try the next one. */ /* Now read the request associated with this control segment entry */ call read_incremental_queue_message; inputp = mseg_return_args.ms_ptr; if (retv_input.object_recovered | retv_input.entry_recovered) & retv_input.volid ^= volid then goto check_next_request; if ^rvce.entry_retrieval then do; if (rvce.to_time ^= 0 & fixed (bit (backup_volume_record.time_dumped, 52), 52) > rvce.to_time) | (rvce.from_time ^= 0 & fixed (bit (backup_volume_record.time_dumped, 52), 52) < rvce.from_time) then goto check_next_request; end; /* The object is read only once even though there may be many request for it. When it was written on the dump volume it was written in a compact form with no full zero pages. Thus if csl does not equal records the zero pages must be reconstructed according to the file map. */ if ^object_read then do; object_read = "1"b; nel = backup_volume_record.rec2_len; if fixed (backup_volume_record.csl) = fixed (backup_volume_record.records) then do; call read (objectp, nel, nelt, (backup_volume_record.version > backup_volume_record_version_1), code); call check_input_error; end; else do; call read (page_bufferp, nel, nelt, (backup_volume_record.version > backup_volume_record_version_1), code); call check_input_error; page_offset = 0; do cslx = 0 to fixed (backup_volume_record.csl) - 1; if ^substr (backup_volume_record.fm (cslx), 1, 1) then do; ptr (objectp, cslx * WORDS_PER_PAGE) -> page = ptr (page_bufferp, page_offset) -> page; page_offset = page_offset + WORDS_PER_PAGE; end; else ptr (objectp, cslx * WORDS_PER_PAGE) -> page = "0"b; end; end; end; /* If the request is for entry retrieval then what has been recovered is a parent directory. First we locate the entry in the directory by name. Once located we constructed a name and access conrol lists. The we initialize some control structures and call a special entry in append which appends a given entry structure. If successful we notify the operator and requestor(if requested) and attemp to add the other names and the access information. If any failures occurr, the operator and possibly the requestor are notified. If though the request is for an object then the input buffer is truncated. Next a check is made to see if the object is already there. This may have happend as the result of a previous retrieval. If so we will only overwrite it if the dump copy is newer or the requestor has specified a time bracket. In either case the operator and possibly the requestor are notified. */ if rvce.entry_retrieval then do; call locate_entry; if ep ^= null then do; call build_name_list; call build_access_list; call init_append_args; call ioa_$rsnnl ("^a^[>^]^a", pname, pnl, rvce.dirname, rvce.dirname ^= ">", rvce.ename); retry_append: call hc_backup_$retv_append (pname, name_list (1), crbp, retv_append_argp, code); if code ^= 0 then do; if code = error_table_$namedup then do; call ioa_$rsnnl ("Failed to append branch ^a^[>^]^a " || "because object already there with other name", message, (0), pname, pname ^= ">", name_list (1)); call retv_notify_ ((message), inputp, myname); code = -1; end; retv_input.errcode = code; end; else do; retv_input.entry_recovered = "1"b; call ioa_$rsnnl ("Appended branch ^a^[>^]^a", message, message_len, pname, pname ^= ">", name_list (1)); call retv_notify_ ((message), inputp, myname); call hc_backup_$retv_add_acl (pname, name_list (1), aclp, aclc, code); if code ^= 0 then do; call convert_status_code_ (code, short, long); call ioa_$rsnnl ("Failed to append access list to ^a^[>^]^a because ^a", message, message_len, pname, pname ^= ">", name_list (1), long); call retv_notify_ ((message), inputp, myname); end; do nmx = 2 to nlc; call hc_backup_$retv_addname (pname, name_list (1), name_list (nmx), code); if code ^= 0 then do; call convert_status_code_ (code, short, long); call ioa_$rsnnl ("Failed to add name ^a to ^a^[>^]^a because ^a", message, message_len, name_list (nmx), pname, pname ^= ">", name_list (1), long); call retv_notify_ ((message), inputp, myname); end; end; end; end; else goto check_next_request; end; else do; object_size = fixed (backup_volume_record.csl, 18, 0) * WORDS_PER_PAGE; call hcs_$truncate_seg (objectp, object_size + 1, ignore); /* object_size + 1 is first word to discard */ if retv_input.new_dirname ^= "" then do; /* cross object retrieval */ call hc_backup_$retv_status (retv_input.new_dirname, "", retv_input.access_class, retv_input.requestor, retv_input.level, type, emode, pmode, uid, pvid, vtoce_volid, dtd, code); if code ^= 0 then do; if uid = "0"b then code = error_table_$noentry; else if type ^= directory then code = error_table_$notadir; else if ^((emode & sm) = sm | (pmode & sm) = sm) then code = error_table_$moderr; call convert_status_code_ (code, short, long); call ioa_$rsnnl ("Failed to cross retrieve into ^a because ^a", message, message_len, retv_input.new_dirname, long); call retv_notify_ ((message), inputp, myname); code = -1; goto set_code; end; ep = addr (local_entry); call hc_backup_$get_entry (retv_input.dirname, retv_input.ename, ep, code); if code ^= 0 then do; call convert_status_code_ (code, short, long); call ioa_$rsnnl ( "Failed to cross retrieve ^a^[>^]^a because unable to locate ^a^[>^]^a because ^a", message, message_len, retv_input.new_dirname, retv_input.new_dirname ^= ">", retv_input.new_ename, retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename, long); call retv_notify_ ((message), inputp, myname); code = -1; goto set_code; end; backup_volume_record.uid = entry.uid; backup_volume_record.dtd = "0"b; backup_volume_record.volid (*) = "0"b; call init_append_args; retv_append_args.cross_segment = "1"b; call hc_backup_$retv_append (retv_input.new_dirname, retv_input.new_ename, crbp, retv_append_argp, code); if code ^= 0 then do; call convert_status_code_ (code, short, long); call ioa_$rsnnl ("Failed to append cross retrieval branch ^a^[>^]^a because ^a", message, message_len, retv_input.new_dirname, retv_input.new_dirname ^= ">", retv_input.new_ename, long); call retv_notify_ ((message), inputp, myname); code = -1; goto set_code; end; call hc_backup_$retv_copy (retv_input.new_dirname, retv_input.new_ename, retv_input.access_class, retv_input.requestor, retv_input.level, addr (backup_volume_record.vtoce), objectp, attributes, code); if code ^= 0 then do; call convert_status_code_ (code, short, long); call ioa_$rsnnl ("Failed to copy cross retrieval object ^a^[>^]^a because ^a", message, message_len, retv_input.new_dirname, retv_input.new_dirname ^= ">", retv_input.new_ename, long); call retv_notify_ ((message), inputp, myname); code = -1; goto set_code; end; end; else do; /* object retrieval */ call hc_backup_$retv_check (rvce.dirname, rvce.ename, type, dtm, code); if code = error_table_$vtoce_connection_fail | code = 0 & backup_volume_record.dtm >= dtm | code = 0 & (rvce.from_time ^= 0 | rvce.to_time ^= 0) | code = 0 & rvce.previous then do; call hc_backup_$retv_copy (rvce.dirname, rvce.ename, retv_input.access_class, retv_input.requestor, retv_input.level, addr (backup_volume_record.vtoce), objectp, attributes, code); end; else if code = 0 then do; call ioa_$rsnnl ("Failed to recover object ^a^[>^]^a because more recent copy online", message, message_len, rvce.dirname, rvce.dirname ^= ">", rvce.ename); call retv_notify_ ((message), inputp, myname); retv_input.errcode = -1; /* in this case, we don't want to delete the recovered*/ goto update_message; /* branch, or we would leave a connection failure.*/ end; end; set_code: if code ^= 0 then do; retv_input.errcode = code; if retv_input.entry_recovered then do; if retv_append_args.cross_segment then call hc_backup_$delete ((retv_input.new_dirname), (retv_input.new_ename), code); else call hc_backup_$delete ((rvce.dirname), (rvce.ename), code); end; goto update_message; end; else do; if retv_input.new_dirname ^= "" then temp_dirname = retv_input.new_dirname; else temp_dirname = rvce.dirname; if retv_input.new_ename ^= "" then temp_ename = retv_input.new_ename; else temp_ename = rvce.ename; call ioa_$rsnnl ("Recovered ^[segment^;directory^] ^a^[>^]^a", message, message_len, type = SEG, temp_dirname, temp_dirname ^= ">", temp_ename); if ^backup_volume_record.dirsw then call set_bc (temp_dirname, temp_ename); call retv_notify_ ((message), inputp, myname); if attributes then do; call ioa_$rsnnl ("Failed to set ^[dates ^]^[dump_switches ^]^[dump_info ^]^[pc_switches ^]" || "^[quota_info^] for ^a^[>^]^a", message, message_len, dates_set, dump_switches_set, dump_info_set, pc_switches_set, quota_info_set, temp_dirname, temp_dirname ^= ">", temp_ename); call retv_notify_ ((message), inputp, myname); end; retv_input.object_recovered = "1"b; retv_input.errcode = 0; end; end; update_message: retv_input.volid = volid; call update_queue_message; if retv_vol_control.dump_type ^= incr then requests_left = requests_left - 1; if requests_left = 0 then do; call close; goto finish; end; end; check_next_request: end; if ^object_read then do; nel = backup_volume_record.rec2_len; if nel ^= 0 then do; /**** skip object, but use read procedure to skip the full object and check for object delimiters (if applicable). */ call read (objectp, nel, nelt, (backup_volume_record.version > backup_volume_record_version_1), code); call check_input_error; end; end; goto search_loop; finish: if inputp ^= null then free retv_input in (based_area); return; skip_chars: proc; /* This proc skips foward the number of chars specified in the variable nel. */ nelt = nel; call read (null (), nel, nelt, ^DELIMITED, code); call check_input_error; end skip_chars; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ check_input_error: proc; /* This proc checks for errors after a read of the dump volume. It we have reached the end of the volume then a non local return is made and the main routine returns to its caller. Otherwise if an error has occurred we attempted to recover. If we are already recovering we terminate the retrieval. Of course in the errorless case we just return */ if code ^= 0 | nelt ^= nel then do; if (code = error_table_$end_of_info | code = error_table_$device_end) then do; if resynching then do; call retv_report_$error_output (0, myname, "Resynchronization terminated by end of volume ^a", volname); call retv_report_$error_output (0, myname, "Skipped ^d words on dump volume ^a", words_skipped, volname); end; call close; goto finish; end; else do; if ^resynching then do; if nel ^= nelt then call retv_report_$error_output (0, myname, "Read did not complete on dump volume ^a", volname); if code = -1 then call retv_report_$error_output (0, myname, "Invalid dump record header on ^a", volname); else call retv_report_$error_output (code, myname, "I/O error reading dump volume ^a", volname); call retv_report_$error_output (0, myname, "Invalid input record on dump volume ^a after ^a - resynching started", volname, convert_puid_ ()); resynch_retry_count = 0; call resynch_input_volume; end; else do; /* already had an error */ resynch_retry_count = resynch_retry_count + 1; /* keep track so we don't try this forever */ if resynch_retry_count > 64 then do; call retv_report_$error_output (code, myname, "Resynchronization failed due to I/O error during resynching on volume ^a", volname); call close; goto finish; end; end; end; end; end check_input_error; close: proc; /* This proc closes the open switch. It does not detach it, as the next dump volume to be read may be the same volume just read. */ call iox_$close (iocbp, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to close input volume ^a", volname); end close; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ resynch_input_volume: proc; /* This proc resynchronizes a dump volume by stepping through the input one word at a time until it recognizes the volume header unique pattern or until we get to the end of the volume. An upper bound of one million words is placed on the loop so it will finish */ resynching = "1"b; input_buf (*) = "0"b; nel = CHARS_PER_WORD * size (backup_volume_header); call read (recordp, nel, nelt, ^DELIMITED, code); call check_input_error; words_skipped = 0; test: if word (1) = pattern1 & word (4) = pattern2 & word (7) = pattern3 then do; call retv_report_$error_output (0, myname, "Synchronization completed ^d words skipped on dump volume ^a", words_skipped, volname); resynching = "0"b; resynching_completed = "1"b; goto pattern_match; end; string = substr (string, 37, (size (backup_volume_header) - 1) * BITS_PER_WORD); nel = CHARS_PER_WORD; call read (addr (word (size (backup_volume_header))), nel, nelt, ^DELIMITED, code); call check_input_error; words_skipped = words_skipped + 1; if words_skipped > 256 * WORDS_PER_PAGE then do; /* put a limit on it */ call retv_report_$error_output (0, myname, "Resynchronization failed on dump volume ^a", volname); code = error_table_$end_of_info; call check_input_error; end; goto test; end resynch_input_volume; locate_entry: proc; /* This proc locates an entry in a temp copy of a directory by using an interface to the ring 0 hash routine. It returns a non null entry pointer if the entry was found */ ep = null; dp = objectp; np = addr (rvce.entry_name); call hc_backup_$retv_hash_search (dp, np, ep, code); if code ^= 0 then ep = null; if ep = null then return; if rvce.link_retrieval then if entry.bs then ep = null; end locate_entry; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ build_name_list: proc; /* This proc constructs an array of names associated with some entry. */ nlc = 0; do nrp = entry.name_frp repeat (np -> names.fp) while (nrp ^= "0"b); np = ptr (ep, nrp); nlc = nlc + 1; name_list (nlc) = np -> names.name; end; return; end build_name_list; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ build_access_list: proc; /* This proc constructs an array of access control items associated with some entry */ aclc = 0; if ^entry.bs then return; do aclrp = entry.acl_frp repeat (acl_entry.frp) while (aclrp ^= "0"b); aclep = ptr (ep, aclrp); aclc = aclc + 1; if acl_entry.pers_rp = "0"b then acl_list (aclc).person = "*"; else acl_list (aclc).person = ptr (ep, acl_entry.pers_rp) -> access_name.name; if acl_entry.proj_rp = "0"b then acl_list (aclc).project = "*"; else acl_list (aclc).project = ptr (ep, acl_entry.proj_rp) -> access_name.name; acl_list (aclc).tag = acl_entry.tag; acl_list (aclc).mode = acl_entry.mode; acl_list (aclc).ex_mode = acl_entry.ex_mode; end; return; end build_access_list; record_contents_segment: proc; /* This proc recovers a contents segment from the dump volume if it is not already online. */ contentsp = recordp; call suffixed_name_$make (backup_volume_contents.volname, "contents", ename, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to construct ^a.contents", backup_volume_contents.volname); return; end; call hcs_$make_seg (rtrim (retv_data_.sys_dir) || ">contents", ename, "", 01010b, new_contentsp, code); if code = 0 then new_contentsp -> copy = contentsp -> copy; end record_contents_segment; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ update_queue_message: proc; /* This proc updates an existant message in the retrieve's private queue */ retry_update: call message_segment_$update_message_index (retv_data_.qidx (retriever), size (retv_input) * BITS_PER_WORD, rvce.retv_ms_id, inputp, code); if code ^= 0 then do; if code = error_table_$bad_segment then do; call retv_report_$error_output (0, myname, "Private queue has been salvaged"); goto retry_update; end; else do; call retv_report_$error_output (code, myname, "Update of private queue failed"); goto finish; end; end; end update_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read_incremental_queue_message: proc; /* This proc reads a specified message from the retrievers private queue. It takes care to manage the allocated storage so it is not slowly eaten away */ if inputp ^= null then free retv_input in (based_area); reread: call message_segment_$incremental_read_index (retv_data_.qidx (retriever), retv_data_.areap, "00"b, rvce.retv_ms_id, ms_arg_ptr, code); if code ^= 0 then do; if code = error_table_$bad_segment then do; call retv_report_$error_output (0, myname, "Private queue has been salvaged"); goto reread; end; else do; call retv_report_$error_output (code, myname, "Read of private queue failed"); goto finish; end; end; end read_incremental_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ init_append_args: proc; /* This proc setups the control structures for the special entry appending call */ crbp = addr (local_create_branch_info); crbp -> create_branch_info.version = create_branch_version_2; if entry.bs then crbp -> create_branch_info.dir_sw = entry.dirsw; else crbp -> create_branch_info.dir_sw = "0"b; if entry.bs then crbp -> create_branch_info.copy_sw = entry.copysw; else crbp -> create_branch_info.copy_sw = "0"b; crbp -> create_branch_info.chase_sw = "0"b; crbp -> create_branch_info.parent_ac_sw = "0"b; crbp -> create_branch_info.priv_upgrade_sw = "1"b; crbp -> create_branch_info.mode = "0"b; if entry.bs then crbp -> create_branch_info.rings (*) = fixed (entry.ring_brackets (*), 3); else crbp -> create_branch_info.rings (*) = 0; crbp -> create_branch_info.userid = retv_input.requestor; if entry.bs then crbp -> create_branch_info.bitcnt = entry.bc; else crbp -> create_branch_info.bitcnt = 0; crbp -> create_branch_info.quota = 0; crbp -> create_branch_info.dir_quota = 0; if entry.bs then crbp -> create_branch_info.access_class = entry.access_class; else crbp -> create_branch_info.access_class = "0"b; unspec (local_retv_append_args) = "0"b; retv_append_argp = addr (local_retv_append_args); retv_append_args.version = RETV_APPEND_ARGS_VERSION_1; retv_append_args.level = retv_input.level; retv_append_args.access_authorization = retv_input.access_class; /* user auth at time of err */ retv_append_args.max_access_authorization = crbp -> create_branch_info.access_class; /* This is a LIE. We have no idea what the user's max */ /* authorization is. This is high enough to make the append succeed, and then */ /* append in ring zero will set it SOOS until an administrator wanders by. */ retv_append_args.ep = ep; retv_append_args.link = ^entry.bs; return; end init_append_args; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ convert_puid_: proc returns (char (168) var); /* This proc is used to convert a unique id pathname to an ascii pathname */ dcl dn char (168); dcl en char (32); dcl ret_dn char (168); call hc_backup_$decode_uidpath (retv_data_.last_valid_puid, dn, en, code); if code = error_table_$root then ; else if code ^= 0 then return ("UNKNOWN_PATH>" || rtrim (retv_data_.last_valid_vtoce_ename)); call ioa_$rsnnl ("^a^[>^]^[^a>^;^s^]^a", ret_dn, (0), dn, dn ^= ">", en ^= "", en, retv_data_.last_valid_vtoce_ename); return (ret_dn); end convert_puid_; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read: proc (return_buffer_ptr, Nrequested_chars, Nreturned_chars, Sdelimited, code); dcl return_buffer_ptr ptr, Nrequested_chars fixed bin (21), Nreturned_chars fixed bin (21), Sdelimited bit (1) aligned, code fixed bin (35); dcl input_buffer char (256 * CHARS_PER_PAGE) based (retv_data_.input_buffer_ptr); dcl return_string char (Nrequested_chars) based (return_buffer_ptr); dcl Nassign_chars fixed bin (21), Nread_chars fixed bin (21), end_of_record fixed bin, tape_check1 /* bit (72) */ char (8), tape_check2 /* bit (72) */ char (8); Nreturned_chars, Nread_chars, code = 0; do while (Nreturned_chars < Nrequested_chars & code = 0); if retv_data_.input_buffer_len = 0 then do; retv_data_.input_buffer_start = 1; if Sdelimited & Nreturned_chars = 0 then do; call iox_$get_chars (retv_data_.input_iocbp, addr (tape_check1), length (tape_check1), Nread_chars, code); if code ^= 0 then return; end; if return_buffer_ptr = null then do; call iox_$position (retv_data_.input_iocbp, FORWARD_CHAR_POSITIONING, Nrequested_chars - Nreturned_chars, code); Nreturned_chars = Nreturned_chars + Nrequested_chars; end; else do; call iox_$get_chars (retv_data_.input_iocbp, addcharno (return_buffer_ptr, Nreturned_chars), Nrequested_chars - Nreturned_chars, Nread_chars, code); Nreturned_chars = Nreturned_chars + Nread_chars; end; if code ^= 0 then return; if Sdelimited then do; call iox_$get_chars (retv_data_.input_iocbp, addr (tape_check2), length (tape_check2), Nread_chars, code); if code ^= 0 then return; if tape_check1 ^= tape_check2 then do; /* found a short segment, move */ /* return string into the temp input */ /* buffer and start parsing */ retv_data_.input_buffer_len = Nreturned_chars; substr (input_buffer, 1, retv_data_.input_buffer_len) = return_string; end; end; end; else if Sdelimited then do; tape_check1 = substr (input_buffer, retv_data_.input_buffer_start, length (tape_check1)); tape_check2 = ""; retv_data_.input_buffer_start = retv_data_.input_buffer_start + length (tape_check1); retv_data_.input_buffer_len = retv_data_.input_buffer_len - length (tape_check1); end; if retv_data_.input_buffer_len > 0 then do; Nassign_chars = min (retv_data_.input_buffer_len, Nrequested_chars); if Sdelimited then do; if tape_check1 ^= tape_check2 then do; end_of_record = index (substr (input_buffer, retv_data_.input_buffer_start, retv_data_.input_buffer_len), tape_check1); if end_of_record > 0 then do; Nassign_chars = end_of_record - 1; if Nrequested_chars ^= Nassign_chars then code = error_table_$data_loss; end; end; end; if return_buffer_ptr ^= null then return_string = substr (input_buffer, retv_data_.input_buffer_start, Nassign_chars); Nreturned_chars = Nassign_chars; retv_data_.input_buffer_start = retv_data_.input_buffer_start + Nassign_chars; retv_data_.input_buffer_len = retv_data_.input_buffer_len - Nassign_chars; if Sdelimited & retv_data_.input_buffer_len > 0 then do; retv_data_.input_buffer_start = retv_data_.input_buffer_start + length (tape_check2); substr (input_buffer, 1, retv_data_.input_buffer_len) = substr (input_buffer, retv_data_.input_buffer_start, retv_data_.input_buffer_len - length (tape_check2)) || tape_check2; retv_data_.input_buffer_start = 1; end; end; end; return; end read; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ set_bc: proc (dirname, ename); dcl old_bc fixed bin (24); dcl (dirname, ename) char (*); dcl new_bc fixed bin (24); /* This proc sets the bit count of the recovered object */ new_bc = 9 * backup_volume_record.rec2_len; if fixed (backup_volume_record.csl, 9) ^= fixed (backup_volume_record.records, 9) then new_bc = new_bc + WORDS_PER_PAGE * BITS_PER_WORD * (fixed (backup_volume_record.csl, 9) - fixed (backup_volume_record.records, 9)); call hc_backup_$set_bc (dirname, ename, new_bc, old_bc, code); if code ^= 0 then do; call convert_status_code_ (code, short, long); call ioa_$rsnnl ("^a^/Bit count could not be set for ^a>^a because ^a", message, 0, message, rvce.dirname, rvce.ename, long); return; end; if new_bc ^= old_bc then do; call ioa_$rsnnl ("^a^/Bit count of ^a>^a reset to ^d from ^d", message, 0, message, dirname, ename, new_bc, old_bc); end; end set_bc; %include retv_data_; %include retv_request; %include queue_msg_hdr; %include retv_input; %include mseg_return_args; %include backup_static_variables; %include backup_volume_contents; %include backup_volume_record; %include backup_volume_header; %include backup_pvol_info; %include fs_vol_label; %include vtoce; %include dir_entry; %include dir_name; %include dir_acl; %include retv_vol_control; %include retv_append_args; %include create_branch_info; %include iox_dcls; %include iox_modes; %include query_info; %include system_constants; end retrieve_from_volume_;  retriever.pl1 10/17/88 1530.8rew 10/17/88 1425.4 335007 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-11-17,GWMay), approve(86-11-17,MCR7445), audit(86-11-20,GDixon), install(86-11-21,MR12.0-1223): added entrypoint "test" for debugging the retriever from a user process without changes to the system volume retriever queues. 2) change(88-08-10,GWMay), approve(88-10-05,MCR8005), audit(88-10-12,Farley), install(88-10-17,MR12.2-1173): Added administrative support for two additional temporary work segments. END HISTORY COMMENTS */ /* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/ retriever: retrieve_from_volume: retv: proc; /* This is the main control routine of the volume retriever subsystem. It initializes the static control structure, parses the arguments, and controls which requests are processed. It uses two other routines, retv_vol_control_, to determine which dump volumes a request may be recovered from and retrieve_from_volume_, to recover objects from a specified dump volume. The major data bases created by this subsystem are in the process directory or in external static and are initialize/created for each invocation. */ /* Modified 6/79 by D. Vinograd to correct notification bug, add accounting control argument , add directory name space searching option, and xxx Modified: 12/18/81 by GA Texada to correct a bug in cross-retrieval (phx12113) Modified: 09/03/82 by GA Texada to fix a bug in scan_sub_tree when it calls submit_request. Modified: 3/83 by E. N. Kittlitz for 256K segments. Modified: 8/83 by GA Texada to make the "list" request go thru all the q's. Modified: 5/15/85 by GA Texada to ensure that retv_data_.qidx(X) is zeroed after calling message_segment_$delete */ dcl wdir char (168); dcl short char (8) aligned; dcl ac fixed bin; dcl options_string char (256); dcl osl fixed bin; dcl narg fixed bin; dcl answer char (3) var; dcl long char (100) aligned; dcl message char (256); dcl message_len fixed bin; dcl line char (32); dcl tp (9) ptr; dcl nelemt fixed bin (21); dcl rvcx fixed bin; dcl sorty fixed bin; dcl sortx fixed bin; dcl nvolx fixed bin; dcl q fixed bin; dcl qx fixed bin; dcl to_from bit (1); dcl retv_ms_id bit (72) aligned; dcl more_messages bit (1); dcl more_to_do bit (1); dcl dtm bit (36); dcl queue_name char (32); dcl step bit (1); dcl list bit (1); dcl code fixed bin (35); dcl type fixed bin; dcl ignore fixed bin (35); dcl arg char (argl) based (argp); dcl argl fixed bin; dcl argp ptr; dcl old_256K_switch bit (2) aligned; dcl based_area area based (retv_data_.areap); dcl LINK fixed bin static init (3) options (constant); dcl DIR fixed bin int static init (2) options (constant); dcl recursive_invocation bit (1) aligned int static init ("0"b); dcl myname char (32) int static init ("retrieve_from_volume") options (constant); dcl max_q_num fixed bin static init (3) options (constant); dcl 1 local_mseg_return_args like mseg_return_args aligned; dcl 1 local_retv_input like retv_input aligned; dcl error_table_$noentry ext fixed bin (35); dcl error_table_$resource_unavailable ext fixed bin (35); dcl error_table_$badopt fixed bin (35) ext; dcl error_table_$vtoce_connection_fail ext fixed bin (35); dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$no_message ext fixed bin (35); dcl sys_info$seg_size_256K fixed bin (19) ext static; dcl sys_info$max_seg_size fixed bin (18) ext static; dcl retv_vol_control_$sort entry (ptr, fixed bin (35)); dcl retv_notify_ entry (char (*), ptr, char (*)); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl get_wdir_ entry returns (char (168)); dcl retv_report_$error_output entry options (variable); dcl retv_report_$online_output entry options (variable); dcl message_segment_$close entry (fixed bin, fixed bin (35)); dcl message_segment_$open entry (char (*), char (*), fixed bin, fixed bin (35)); dcl message_segment_$delete entry (char (*), char (*), fixed bin (35)); dcl message_segment_$delete_index entry (fixed bin, bit (72) aligned, fixed bin (35)); dcl command_query_ entry options (variable); dcl system_privilege_$ring1_priv_on entry (fixed bin (35)); dcl system_privilege_$ring1_priv_off entry (fixed bin (35)); dcl system_privilege_$ipc_priv_on entry (fixed bin (35)); dcl system_privilege_$ipc_priv_off entry (fixed bin (35)); dcl retv_account_$create entry (fixed bin (35)); dcl retv_account_$update entry (char (*) aligned); dcl hc_backup_$retv_name_list entry (char (*) aligned, ptr, ptr, fixed bin, fixed bin (35)); dcl hc_backup_$retv_check entry (char (*) aligned, char (*) aligned, fixed bin, bit (36), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); dcl hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35)); dcl hcs_$set_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl date_time_ entry (fixed bin (71), char (*)); dcl get_system_free_area_ entry returns (ptr); dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl com_err_ entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl ioa_ entry options (variable); dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl ioa_$nnl entry options (variable); dcl message_segment_$create entry (char (*), char (*), fixed bin (35)); dcl message_segment_$add_index entry (fixed bin, ptr, fixed bin, bit (72) aligned, fixed bin (35)); dcl message_segment_$read_index entry (fixed bin, ptr, bit (1), ptr, fixed bin (35)); dcl retrieve_from_volume_ entry (ptr, fixed bin (35)); dcl retv_vol_control_ entry (ptr, fixed bin (35)); dcl message_segment_$incremental_read_index entry (fixed bin, ptr, bit (2), bit (72) aligned, ptr, fixed bin (35)); dcl message_segment_$update_message_index entry (fixed bin, fixed bin, bit (72) aligned, ptr, fixed bin (35)); dcl cleanup condition; dcl linkage_error condition; dcl (fixed, hbound, before) builtin; dcl addr builtin; dcl size builtin; dcl unspec builtin; dcl length builtin; dcl null builtin; dcl substr builtin; main: goto common; test: entry (test_dir); /* This entry point is the counter part to the test entry point in the */ /* enter_retrieval_request (err) command program. It is designed for use */ /* in testing the volume dumper/retriever. To use it type */ /* "retrieve_from_volume$test wdir" where wdir is the directory where you */ /* have created private message_segments named volume_retiever.ms and */ /* volume_retiever(1 2 3).ms for use as the retriever queues. */ /* Type "err$test wdir" before entering the retrieval request giving the */ /* same directory which contains the queue. */ dcl test_dir char (*); queue_dir = test_dir; return; common: /* protect against recursive invocation */ if recursive_invocation then do; call com_err_ (0, myname, "Recursive invocation not allowed "); return; end; /* initialize static variables */ old_256K_switch = ""b; tp (*) = null; retv_data_.ptrs = null; retv_data_.chars = ""; retv_data_.bits = ""b; retv_data_.sys_dir = ">daemon_dir_dir>volume_backup"; retv_data_.fixed = 0; retv_data_.all = "1"b; retv_data_.io_module = "tape_mult_"; /* and some local variables */ ms_arg_ptr = addr (local_mseg_return_args); q = 1; list = "0"b; wdir = get_wdir_ (); step = "0"b; /* initialize mail structure */ /* process arguments */ inputp, requestp = null; ac = 1; call cu_$arg_count (narg); do while (ac <= narg); call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then do; no_arg: call retv_report_$error_output (code, myname, "Unable to access arg after ^a", arg); goto finale; end; ac = ac + 1; if arg = "-step" then step = "1"b; else if arg = "-manual" then retv_data_.manual = "1"b; else if arg = "-long" then retv_data_.long = "1"b; else if arg = "-working_dir" | arg = "-wd" then retv_data_.sys_dir = wdir; else if arg = "-accounting" then retv_data_.accounting = "1"b; else if arg = "-all" | arg = "-a" then ; else if arg = "-error_on" then retv_data_.err_online = "1"b; else if arg = "-list" then list = "1"b; else if arg = "-input_volume_desc" then do; call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then goto no_arg; ac = ac + 1; retv_data_.input_volume_desc = arg; retv_data_.io_module = before (arg, " "); end; else if arg = "-q" | arg = "-queue" then do; retv_data_.all = "0"b; call cu_$arg_ptr (ac, argp, argl, code); if code ^= 0 then goto no_arg; ac = ac + 1; q = cv_oct_check_ (arg, code); if code ^= 0 | (q < 1 | q > 3) then do; call retv_report_$error_output (0, myname, "Invalid queue number ^a", arg); goto finale; end; end; else do; call retv_report_$error_output (error_table_$badopt, myname, "^a", arg); goto finale; end; end; retv_data_.queue = q; on cleanup call clean_it_up; recursive_invocation = "1"b; start: call message_segment_$open (queue_dir, queue_seg_ (), retv_data_.qidx (user), code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to open user queue ^a>^a", queue_dir, queue_seg_ ()); goto finish; end; call message_segment_$open (wdir, "volume_retriever.ms", retv_data_.qidx (retriever), code); if code ^= 0 & code ^= error_table_$noentry then do; call retv_report_$error_output (code, myname, "Unable to open private queue ^a>volume_retriever.ms", wdir); goto finale; end; retv_data_.arg_init = "1"b; retv_data_.areap = get_system_free_area_ (); /* create temp segs and set static ptrs */ call get_temp_segments_ (myname, tp, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to create temp segs"); goto finale; end; retv_data_.nlp = tp (1); retv_data_.aclp = tp (2); retv_data_.recordp = tp (3); retv_data_.objectp = tp (4); retv_data_.vlp = tp (5); retv_data_.contentsp = tp (6); retv_data_.skip = tp (7); retv_data_.input_buffer_ptr = tp (8); retv_data_.page_buffer_ptr = tp (9); call hcs_$set_256K_switch ("11"b, (""b), code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Could not enable 256KW segments."); go to finale; end; call hcs_$set_max_length_seg (retv_data_.objectp, sys_info$seg_size_256K, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Could not make 256K word temp seg (7)."); go to finale; end; call hcs_$set_max_length_seg (retv_data_.input_buffer_ptr, sys_info$seg_size_256K, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Could not make 256K word temp seg (8)."); go to finale; end; call hcs_$set_max_length_seg (retv_data_.page_buffer_ptr, sys_info$seg_size_256K, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Could not make 256K word temp seg (9)."); go to finale; end; on linkage_error begin; call retv_report_$error_output (0, myname, "AIM ring 1 and ipc privileges not enabled."); goto set_cleanup; end; call system_privilege_$ring1_priv_on (ignore); call system_privilege_$ipc_priv_on (ignore); /* establish cleanup handler and set flag */ set_cleanup: revert linkage_error; if retv_data_.qidx (retriever) ^= 0 then do; call read_queue_message (retriever); do while (more_messages); inputp = mseg_return_args.ms_ptr; call ioa_ ("ID: ^a Retrieval request of ^a^[>^]^a for ^a", substr (request_id_ (retv_input.msg_time), 7, 8), retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename, retv_input.requestor); call ioa_$rsnnl ( "^[-skip ^]^[-subtree ^]^[-notify ^]^[-previous ^]^[-to ^a ^;^s ^]^[-from ^a ^;^s^]^[-new path ^a^[->^]^a^;^s^]", options_string, osl, retv_input.skip_it, retv_input.subtree, retv_input.notify, retv_input.previous, retv_input.to_time ^= 0 & ^retv_input.previous, time_ (retv_input.to_time), retv_input.from_time ^= 0, time_ (retv_input.from_time), retv_input.new_dirname ^= "", retv_input.new_dirname, retv_input.new_dirname ^= ">", retv_input.new_ename); if osl > 1 then call ioa_ ("options: ^a", options_string); if ^list & step then do; reread1: call ioa_$nnl ("command: "); call iox_$get_line (iox_$user_input, addr (line), length (line), nelemt, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Command read error"); goto reread1; end; line = substr (line, 1, nelemt - 1); if line = "quit" | line = "q" then goto finish; else if line = "skip" | line = "s" then do; retv_input.skip_it = "1"b; call update_queue_message; end; else if line = "cancel" | line = "c" then do; if ^retv_input.proxy then call delete_queue_message (user, retv_input.user_ms_id); call delete_queue_message (retriever, mseg_return_args.ms_id); end; else if line = "proceed" | line = "p" then do; retv_input.skip_it = "0"b; call update_queue_message; end; else if line = "help" | line = "h" then do; call ioa_ ("Allowable commands are quit(q)^/skip(s)^/cancel(c)^/proceed(p)^/help(h)"); goto reread1; end; else do; call ioa_ ("Unrecognized command: ^a", line); goto reread1; end; end; call read_incremental_queue_message (retriever); end; if list then goto finish; /* go to the next q */ end; /* create retriever's private queue if necessary */ else do; if list then goto finale; call message_segment_$create (wdir, "volume_retriever.ms", code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to create private queue ^a>volume_retriever.ms", wdir); goto finish; end; call message_segment_$open (wdir, "volume_retriever.ms", retv_data_.qidx (retriever), code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to open private queue ^a>volume_retriever.ms", wdir); goto finish; end; end; /* Read each request from user queue. If the request is not valid then delete it. If the caller wants to review each request before processing then display each request . */ user_queue: call read_queue_message (user); do while (more_messages); requestp = mseg_return_args.ms_ptr; if retv_request.version ^= retv_request_version_2 then do; call retv_report_$error_output (0, myname, "Invalid version of retrieval request encountered and deleted"); call delete_queue_message (user, mseg_return_args.ms_id); goto next; end; if step then do; call ioa_ ("ID: ^a Retrieval request of ^a^[>^]^a for ^a", substr (request_id_ (retv_request.msg_time), 7, 8), retv_request.dirname, retv_request.dirname ^= ">", retv_request.ename, mseg_return_args.sender_id); call ioa_$rsnnl ( "^[-subtree ^]^[-notify ^]^[-previous ^]^[-to ^a ^;^s ^]^[-from ^a ^;^s^]^[-new path ^a^[->^]^a^;^s^]", options_string, osl, retv_request.subtree, retv_request.notify, retv_request.previous, retv_request.to_time ^= 0 & ^retv_request.previous, time_ (retv_request.to_time), retv_request.from_time ^= 0, time_ (retv_request.from_time), retv_request.new_dirname ^= "", retv_request.new_dirname, retv_request.new_dirname ^= ">", retv_request.new_ename); if osl > 1 then call ioa_ ("options: ^a", options_string); reread: call ioa_$nnl ("command: "); call iox_$get_line (iox_$user_input, addr (line), length (line), nelemt, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Command read error"); goto reread; end; line = substr (line, 1, nelemt - 1); if line = "quit" | line = "q" then goto finish; else if line = "skip" | line = "s" then goto next; else if line = "cancel" | line = "c" then do; call delete_queue_message (user, mseg_return_args.ms_id); goto next; end; else if line = "proceed" | line = "p" then ; else if line = "help" | line = "h" then do; call ioa_ ("Allowable commands are quit (q)^/skip (s)^/cancel (c)^/proceed (p)^/help (h)"); goto reread; end; else do; call ioa_ ("Unrecognized command: ^a", line); goto reread; end; end; unspec (local_retv_input) = "0"b; local_retv_input.request = retv_request; local_retv_input.user_ms_id = mseg_return_args.ms_id; local_retv_input.access_class = mseg_return_args.sender_authorization; local_retv_input.level = mseg_return_args.level; local_retv_input.q_num = retv_data_.queue; local_retv_input.requestor = mseg_return_args.sender_id; local_retv_input.submission_time = fixed (mseg_return_args.ms_id, 71); call message_segment_$add_index (retv_data_.qidx (retriever), addr (local_retv_input), size (local_retv_input) * 36, retv_ms_id, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to add to private queue ^a>volume_retriever.ms", wdir); next: call read_incremental_queue_message (user); end; /* This is the main recovery loop. Each dump volume that has a volume control seg is read After each dump volume is read the private queue is scanned to check for any requests that may have been satisified. If one is found then a check is made to see if all is well. This check is necessary since the retrieval of an entry may make a whole subtree accessible. If all is well then the request is marked as completed in the private queue. If a subtree retrieval was requested then the subtree is scanned. */ recovery_loop: /* Loop through the queue setting the in_progress flag. This flag will be used latter to determine if a request has not been satisfied */ call read_queue_message (retriever); do while (more_messages); inputp = mseg_return_args.ms_ptr; if ^retv_input.skip_it then do; retv_input.retv_ms_id = mseg_return_args.ms_id; call retv_vol_control_ (inputp, code); if code ^= 0 then retv_input.errcode = code; retv_input.in_progress = "1"b; call update_queue_message; end; call read_incremental_queue_message (retriever); end; /* if any dump volumes - setup accounting */ if retv_data_.nvol > 0 & retv_data_.accounting then do; call retv_account_$create (code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Accounting error"); goto finish; end; end; do rvcx = 1 to retv_data_.nvol; /* sort the control seg */ call retv_vol_control_$sort (retv_data_.rvcp (rvcx), code); end; do rvcx = 1 to retv_data_.nvol; /* scan the volumes */ rvcp = retv_data_.rvcp (rvcx); call retrieve_from_volume_ (rvcp, code); if code ^= 0 then do; if code = -1 then call ioa_ ("Volume ^a in use - it will be skipped", retv_vol_control.volname); else if code = error_table_$resource_unavailable then do; query_info.version = query_info_version_5; call command_query_ (addr (query_info), answer, myname, "^/^a^/^a", "The physical drive or dump volume is not available or is in use by another process.", "Do you wish to continue the retrieval "); if answer = "no" then goto finish; end; else call retv_report_$error_output (code, myname, "Error processing volume ^a", retv_vol_control.volname); end; call read_queue_message (retriever); do while (more_messages); inputp = mseg_return_args.ms_ptr; if retv_input.object_recovered | retv_input.entry_recovered | retv_input.errcode ^= 0 then do; if retv_input.errcode = 0 then do; if retv_input.new_dirname ^= "" then /* cross-retrieval */ call hc_backup_$retv_check (retv_input.new_dirname, retv_input.new_ename, type, dtm, code); else call hc_backup_$retv_check (retv_input.dirname, retv_input.ename, type, dtm, code); if code ^= 0 & code ^= error_table_$vtoce_connection_fail then call retv_report_$error_output (code, myname, "Request check failed for ^[^a^[>^]^a^3s^;^3s^a^[>^]^a^]", (retv_input.new_dirname = ""), retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename, retv_input.new_dirname, retv_input.new_dirname ^= ">", retv_input.new_ename); if code = 0 then do; if retv_input.subtree & type = DIR then do; to_from = (retv_input.to_time ^= 0) | (retv_input.from_time ^= 0); call scan_sub_tree (retv_input.dirname, retv_input.ename, to_from, ignore); end; if retv_input.entry_retrieval then do; call ioa_$rsnnl ("Recovery of object ^a^[>^]^a not necessary as object already there", message, message_len, retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename); call retv_notify_ (message, inputp, myname); end; if ^retv_input.proxy then call delete_queue_message (user, retv_input.user_ms_id); call delete_queue_message (retriever, retv_input.retv_ms_id); if retv_data_.accounting then call retv_account_$update (retv_input.requestor); end; end; /* Having completed a request we now scan all other volume control segments for the same request and delete it if we find it. We must take care to delete the right request since more then one request may exist for the same object. */ do sortx = 1 to retv_data_.nvol; rvcp = retv_data_.rvcp (sortx); do sorty = 1 to retv_vol_control.n_entries; rvcep = addr (retv_vol_control.array (sorty)); if rvce.in_use & (rvce.uid = retv_input.uid) & (rvce.retv_ms_id = retv_input.retv_ms_id) then do; retv_vol_control.in_use_cnt = retv_vol_control.in_use_cnt - 1; rvce.in_use = "0"b; end; end; end; end; call read_incremental_queue_message (retriever); end; end; /* When we get here all the requests that were queued in volume control segments have been processed for better or for worse. When a request is looked for on a dump volume the in_progress switch is set. If nothing is found then a message is reported to the operator, and if requested to the requestor. Then the request is deleted from the private queue, and the user queue. Note that proxy requests, because they are issued by the retriever do not exist in the user queue. */ call read_queue_message (retriever); do while (more_messages); inputp = mseg_return_args.ms_ptr; if retv_input.in_progress & (^retv_input.object_recovered & ^retv_input.entry_recovered) then do; if retv_input.errcode ^= -1 then do; call hc_backup_$retv_check (retv_input.dirname, retv_input.ename, type, dtm, code); if code = 0 then do; call ioa_$rsnnl ("Recovery of object ^a^[>^]^a not necessary as already there", message, message_len, retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename); end; else do; if retv_input.errcode = 0 then long = "object not found on dump media"; else call convert_status_code_ (retv_input.errcode, short, long); call ioa_$rsnnl ("Failed to recover ^a^[>^]^a for ^a because ^a", message, message_len, retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename, retv_input.requestor, long); end; call retv_notify_ (message, inputp, myname); end; if ^retv_input.proxy then call delete_queue_message (user, retv_input.user_ms_id); call delete_queue_message (retriever, retv_input.retv_ms_id); end; call read_incremental_queue_message (retriever); end; /* delete the volume control segs */ do nvolx = 1 to retv_data_.nvol; rvcp = retv_data_.rvcp (nvolx); if rvcp ^= null then do; call hcs_$delentry_seg (rvcp, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to delete control seg ^a.control", retv_vol_control.volname); end; end; retv_data_.rvcp (*) = null; retv_data_.nvol = 0; /* Now go through the private queue once more to see if any requests remain. If one does reset some control flags. Then go back to the main recovery loop */ more_to_do = "0"b; call read_queue_message (retriever); do while (more_messages); inputp = mseg_return_args.ms_ptr; if ^retv_input.skip_it then do; retv_input.uid = "0"b; retv_input.volid = "0"b; retv_input.entry_retrieval = "0"b; retv_input.in_progress = "0"b; retv_input.entry_name = ""; retv_input.entry_recovered = "0"b; retv_input.object_recovered = "0"b; retv_input.errcode = 0; call update_queue_message; more_to_do = "1"b; end; call read_incremental_queue_message (retriever); end; if more_to_do then goto recovery_loop; else do; call message_segment_$delete (wdir, "volume_retriever.ms", code); retv_data_.qidx (retriever) = 0; /* so it can be reused later */ if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to delete private queue ^a>volume_retriever.ms", wdir); end; finish: if retv_data_.queue ^= max_q_num & retv_data_.all then do; retv_data_.queue = retv_data_.queue + 1; goto start; end; finale: call clean_it_up; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ queue_seg_: proc returns (char (32)); /* This proc constructs the user queue segment name and returns it */ call ioa_$rsnnl ("volume_retriever_^d.ms", queue_name, (0), retv_data_.queue); return (queue_name); end queue_seg_; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read_queue_message: proc (idx); dcl idx fixed bin; /* This proc reads the first message from the specified queue. */ more_messages = "1"b; read: call message_segment_$read_index (retv_data_.qidx (idx), retv_data_.areap, "0"b, ms_arg_ptr, code); if code ^= 0 then do; if code = error_table_$no_message then more_messages = "0"b; else if code = error_table_$bad_segment then do; call retv_report_$error_output (0, myname, "^[Private^;User^] queue has been salvaged", idx = retriever); goto read; end; else do; call retv_report_$error_output (code, myname, "^[Private^;User^] queue read failed", retriever = idx); goto finish; end; end; end read_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ update_queue_message: proc; /* This proc updates a specified message in the private queue. */ reupdate: call message_segment_$update_message_index (retv_data_.qidx (retriever), size (retv_input) * 36, mseg_return_args.ms_id, inputp, code); if code ^= 0 then do; if code = error_table_$bad_segment then do; call retv_report_$error_output (0, myname, "Private retriever queue ^a>volume_retriever.ms has been salvaged", wdir); goto reupdate; end; else call retv_report_$error_output (code, myname, "Private queue ^a>volume_retriever.ms update failed", wdir); end; end update_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ read_incremental_queue_message: proc (idx); dcl idx fixed bin; /* This proc reads the next message from the specified queue. */ if idx = retriever then do; if inputp ^= null then free retv_input in (based_area); inputp = null; end; else do; if requestp ^= null then free retv_request in (based_area); requestp = null; end; retry_inc: call message_segment_$incremental_read_index (retv_data_.qidx (idx), retv_data_.areap, "01"b, mseg_return_args.ms_id, ms_arg_ptr, code); if code ^= 0 then do; if code = error_table_$bad_segment then do; call retv_report_$error_output (0, myname, "^[Private^;User^] queue has been salvaged", idx = retriever); goto retry_inc; end; else if code = error_table_$no_message then more_messages = "0"b; else do; call retv_report_$error_output (code, myname, "^[Private^;User^] queue read failed", retriever = idx); goto finish; end; end; end read_incremental_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ scan_sub_tree: proc (dn, en, force, ec); /* This proc scans a directory and checks if each object in the directory is accessable. If not it submitts a proxy requests for the missing object. If any object encountered is a directory then we recurse to the next level. This proc is used during subtree retrieval to check for what is missing at some level inferior to the subtree node and to issue the necessary request to get the object back. In certain cases even if the object is there a request is submitted. An example of this is a general request to move an existant subtree back in time. */ dcl (dn, en) char (*) aligned; dcl dtm bit (36); dcl force bit (1); dcl nlp ptr; dcl pname char (168) aligned; dcl ec fixed bin (35); dcl (nlc, ndx, type) fixed bin; dcl names (1) char (32) aligned based (nlp); call ioa_$rsnnl ("^a^[>^]^a", pname, (0), dn, dn ^= ">", en); nlc = 0; ec = 0; call hc_backup_$retv_name_list (pname, retv_data_.areap, nlp, nlc, ec); if ec ^= 0 then do; call retv_report_$error_output (ec, myname, "Unable to list names of ^a", pname); return; end; do ndx = 1 to nlc; ec = 0; call hc_backup_$retv_check (pname, names (ndx), type, dtm, ec); if ec ^= 0 & ec ^= error_table_$vtoce_connection_fail then call retv_report_$error_output (ec, myname, "Subtree check failed for ^a>^a", pname, names (ndx)); if ((ec = error_table_$vtoce_connection_fail) | force) & type ^= LINK then do; call submit_request (pname, names (ndx), type); end; if ec = 0 & type = DIR then call scan_sub_tree (pname, names (ndx), force, ec); end; free names in (based_area); end scan_sub_tree; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ submit_request: proc (dn, en, type); /* This proc makes up a proxy request. A proxy request occurs when the retriever, during a subtree request, discovers something missing. The proxy request, while submitted by the retriever, preserves the requestor's access_class, validation level, etc. It differs from the normal request in that it does not have a specific request in the user's queue. */ dcl (dn, en) char (*) aligned; dcl type fixed bin; unspec (local_retv_input) = "0"b; local_retv_input.request = retv_input.request; local_retv_input.dirname = dn; local_retv_input.ename = en; local_retv_input.user_ms_id = retv_input.user_ms_id; local_retv_input.access_class = retv_input.access_class; local_retv_input.level = retv_input.level; local_retv_input.q_num = retv_input.q_num; local_retv_input.requestor = retv_input.requestor; local_retv_input.proxy = "1"b; local_retv_input.submission_time = fixed (mseg_return_args.ms_id, 71); call message_segment_$add_index (retv_data_.qidx (retriever), addr (local_retv_input), size (retv_input) * 36, retv_ms_id, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Proxy update error"); else if retv_data_.long then call retv_report_$online_output (0, myname, "Proxy submission of ^[directory^;segment^] ^a^[>^]^a", type = DIR, dn, (dn ^= ">"), en); end submit_request; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ delete_queue_message: proc (idx, msid); dcl idx fixed bin; dcl msid bit (72) aligned; /* This proc deletes the specified message just read from the specified queue */ call message_segment_$delete_index (retv_data_.qidx (idx), msid, code); if code ^= 0 then call retv_report_$error_output (code, myname, "^[Private^;User^] queue delete failed", retriever = idx); end delete_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ time_: proc (bin_time) returns (char (24)); /* This proc converts a binary time into a suitable prinable form and returns it. */ dcl bin_time fixed bin (71); dcl time_string char (24); call date_time_ (bin_time, time_string); return (time_string); end time_; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ clean_it_up: proc; /* This proc cleans up and frees whats ever left around */ if requestp ^= null then free retv_request in (based_area); if inputp ^= null then free retv_input in (based_area); if tp (1) ^= null then do; call hcs_$truncate_seg (retv_data_.objectp, 0, ignore); /* clean up our 256K seg */ call hcs_$set_max_length_seg (retv_data_.objectp, (sys_info$max_seg_size), ignore); /* be a good neighbour */ call hcs_$truncate_seg (retv_data_.input_buffer_ptr, 0, ignore); /* clean up our 256K seg */ call hcs_$set_max_length_seg (retv_data_.input_buffer_ptr, (sys_info$max_seg_size), ignore); /* be a good neighbour */ call hcs_$truncate_seg (retv_data_.page_buffer_ptr, 0, ignore); /* clean up our 256K seg */ call hcs_$set_max_length_seg (retv_data_.page_buffer_ptr, (sys_info$max_seg_size), ignore); /* be a good neighbour */ call release_temp_segments_ (myname, tp, ignore); end; if retv_data_.error_iocbp ^= null then do; call iox_$close (retv_data_.error_iocbp, ignore); call iox_$detach_iocb (retv_data_.error_iocbp, ignore); end; if retv_data_.input_iocbp ^= null then do; call iox_$close (retv_data_.input_iocbp, ignore); call iox_$detach_iocb (retv_data_.input_iocbp, ignore); end; do nvolx = 1 to retv_data_.nvol; call hcs_$delentry_seg (retv_data_.rvcp (nvolx), ignore); end; do qx = 1 to hbound (retv_data_.qidx, 1); call message_segment_$close (retv_data_.qidx (qx), ignore); end; call hcs_$set_256K_switch (old_256K_switch, (""b), ignore); on linkage_error goto end_clean_it_up; call system_privilege_$ring1_priv_off (ignore); call system_privilege_$ipc_priv_off (ignore); end_clean_it_up: recursive_invocation = "0"b; end clean_it_up; %include retv_data_; %include retv_request; %include retv_input; %include mseg_return_args; %include retv_vol_control; %include queue_msg_hdr; %include query_info; %include iox_dcls; end retriever;  retv_account_.pl1 10/17/88 1530.8r w 10/17/88 1428.0 28305 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ retv_account_: proc; /* This routine provides all the accounting functions for the volume retriever. It creates and initializes the account segment in the directory >system_control_1>volume_backup_accounts with a time stamp name. For each object that the retriever recovers, the requestors name is entered into the account segment, if not already there, and the objects recovered count is incremented by one. A test entry is provided to bypass the system directory. */ dcl test_dir char (*); dcl ename char (32) aligned; dcl code fixed bin (35); dcl enl fixed bin; dcl time_string char (15) aligned; dcl i fixed bin; dcl found bit (1); dcl requestor char (*); dcl myname char (32) int static init ("retv_account_") options (constant); dcl retv_report_$error_output entry options (variable); dcl get_wdir_ entry returns (char (168) aligned); dcl date_time_ entry (fixed bin (71), char (*) aligned); dcl ioa_$rsnnl entry options (variable); dcl hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), ptr, fixed bin (35)); dcl (addr, substr, clock) builtin; %include retv_data_; %include retv_account_seg; create: entry (code); /* This entry creates an retrieval account seg with a time stamp name, initializes it and sets the static ptr to it. */ code = 0; call date_time_ (clock (), time_string); call ioa_$rsnnl ("^a.^a.^a", ename, enl, "retv_account", substr (time_string, 1, 8), substr (time_string, 11, 4)); call hcs_$make_seg (retv_account_dir, ename, "", 01011b, rasp, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to create ^a>^a", retv_account_dir, ename); return; end; retv_account_seg.version = retv_account_seg_version_1; retv_data_.rasp = rasp; return; update: entry (requestor); /* This entry adds the requestors name to the next empty slot in the accounting table, if not already in the table, and incremets the count of objects recovered. */ rasp = retv_data_.rasp; found = "0"b; do i = 1 to retv_account_seg.next while (^found); rasep = addr (retv_account_seg.array (i)); if rase.requestor = requestor then do; found = "1"b; rase.n_objects = rase.n_objects + 1; end; end; if ^found then do; retv_account_seg.next = retv_account_seg.next + 1; rasep = addr (retv_account_seg.array (i)); rase.requestor = requestor; rase.n_objects = 1; end; return; test: entry (test_dir); /* This entry allows testing by resetting the directory in which the account seg is created */ retv_account_dir = test_dir; return; end retv_account_;  retv_notify_.pl1 11/17/82 1640.9rew 11/17/82 1626.4 20376 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ retv_notify_: proc (message, inputp, myname); /* This proc prints informative messages and notifies the user if requested */ dcl message char (*); dcl myname char (*); dcl new_message char (256); dcl code fixed bin (35); dcl ignore fixed bin(35); dcl ioa_ entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl retv_report_$error_output entry options (variable); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl send_message_$notify_mail entry (char (*), char (*), fixed bin (35)); dcl send_mail_$access_class entry (char (*), char (*), ptr, bit (72) aligned, fixed bin (35)); dcl (addr, substr, after, reverse) builtin; %include retv_input; %include retv_request; %include send_mail_info; %include queue_msg_hdr; send_mail_info.version = send_mail_info_version_2; send_mail_info.sent_from = "Volume Retriever"; send_mail_info.wakeup = "0"b; send_mail_info.always_add = "1"b; send_mail_info.never_add = "0"b; send_mail_info.acknowledge = "0"b; call ioa_ ("^a", message); if retv_input.notify then do; call ioa_$rsnnl ("ID: ^a ^a", new_message, (0), substr (request_id_ (retv_input.msg_time), 7, 8), message); call send_mail_$access_class (mail_destination_ (), new_message, addr (send_mail_info), retv_input.access_class, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to notify ^a", mail_destination_ ()); call send_message_$notify_mail (mail_destination_ (), "", ignore); end; mail_destination_: proc returns (char (32)); /* This proc constructs the mail/send_message destination from the requestor's name */ return (reverse (after (reverse (retv_input.requestor), "."))); end mail_destination_; end retv_notify_;  retv_report_.pl1 10/17/88 1530.8r w 10/17/88 1428.0 35829 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ retv_report_: proc; /* This routine is used by the volume retriever to report and log error and status messages. It is modled after the system routine com_err_. When called for the first time in a volume retriever invocation, it creates, in the working directory, an error file, in which it logs all error and status messages. If requested it also writes error messages on the stream error_output. */ dcl code fixed bin (35); dcl icode fixed bin (35); dcl tstring char (24); dcl uname char (32); dcl caller char (*); dcl message char (*); dcl argp ptr; dcl retv_string char (512); dcl control_string char (32) aligned; dcl len fixed bin; dcl error_output bit (1); dcl short char (8) aligned; dcl long char (100) aligned; dcl myname char (15) static init ("retv_report_") options (constant); dcl iox_$error_output ptr ext; dcl date_time_ entry (fixed bin (71), char (*)); dcl cu_$arg_list_ptr entry (ptr); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin, bit (1) aligned, bit (1) aligned); dcl iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35)); dcl iox_$open entry (ptr, fixed bin, bit (36), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl ioa_$ioa_switch entry options (variable); dcl retv_report_$online_output entry options (variable); dcl null builtin; dcl clock builtin; dcl substr builtin; %include retv_data_; %include iox_modes; error_output: entry (icode, caller, message); /* If an error file is not attached then fabricate a name with a data/time stamp, attach and open it. If successsful then report via online mechanism. */ if retv_data_.disable_error_report then return; error_output = "1"b; if retv_data_.error_iocbp = null then do; /* error file not attached */ call date_time_ (clock, tstring); uname = "retv_err." || substr (tstring, 1, 8)||"."|| substr (tstring, 11, 4); call iox_$attach_ioname ("error_file", retv_data_.error_iocbp, "vfile_ " || uname, code); if code ^= 0 then do; call retv_report_$online_output (code, myname, "Unable to attach error file"); return; end; call iox_$open (retv_data_.error_iocbp, Stream_output, ""b, code); if code ^= 0 then do; call retv_report_$online_output (code, myname, "Error opening error file"); return; end; call retv_report_$online_output (0, myname, "Error file ^a created", uname); end; common: /* If given a non-zero code convert to a message */ if icode ^= 0 then do; call convert_status_code_ (icode, short, long); control_string = "^a:^x^a;^x^a"; end; else do; short, long = ""; control_string = "^a:^x^a^s"; end; /* pick up arg list ptr */ call cu_$arg_list_ptr (argp); /* convert args to message */ call ioa_$general_rs (argp, 3, 4, retv_string, len, "0"b, "0"b); if error_output then /* write to file if specified */ call ioa_$ioa_switch (retv_data_.error_iocbp, control_string, caller, substr (retv_string, 1, len), long); /* Write online if requested, if args not initialized yet, or if online entry */ if (error_output & retv_data_.err_online) | ^error_output | ^retv_data_.arg_init then call ioa_$ioa_switch (iox_$error_output, control_string, caller, substr (retv_string, 1, len), long); return; online_output: entry (icode, caller, message); error_output = "0"b; goto common; end retv_report_;  retv_vol_control_.pl1 10/10/89 1423.0rew 10/10/89 1355.3 371394 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(89-08-31,GWMay), approve(89-10-03,MCR8135), audit(89-10-04,Beattie), install(89-10-10,MR12.3-1089): Updated to process version 3 of backup_volume_log.incl.pl1 structures. END HISTORY COMMENTS */ /* format: style1,ind2,^inddcls,ifthenstmt,dclind2,declareind2,ifthendo,ifthen*/ retv_vol_control_: proc (inputp, code); /* This routine computes the set of volumes that a retrieval request might be found on and then creates, if not already existent, the retriever_volume_control segment for that volume and adds an entry to it for the retrieval request. If the object does not have a branch in the hierarchy then the parent tree is searched until a existant superior directory is found. This directory is then recovered and the branch structure is appended. */ /* Modified 6/79 by D. Vinograd to add directory name space searching from files created by volume dumper. This feature means that if the directory name space file is available then one can check if an entry name is in the directory dumped on tape and thus not have to read the tape during branch retrieval. Modified: 8/83 by GA Texada to 1) not look in the volume logs when -manual has been specified. 2) announce only once that a volume may be searched when contents seg is missing. 3) Reformatted and moved the %include's too. */ dcl answer char (3) var; dcl a_rvcp ptr; dcl message char (256); dcl char_num char (32); dcl code fixed bin (35); dcl comp_cycle_uid bit (36); dcl found bit (1); dcl comp_indx fixed bin; dcl comp_open_time fixed bin (71); dcl cons_cycle_uid bit (36); dcl cons_indx fixed bin; dcl cons_open_time fixed bin (71); dcl contents_idx fixed bin; dcl control_name char (32); dcl dirname char (168); dcl done bit (1); dcl emode bit (36); dcl ename char (32); dcl entry_name char (32); dcl entry_retrieval bit (1); dcl rvlx fixed bin; dcl idx fixed bin; dcl lns fixed bin; dcl logged bit (1); dcl test_name char (32); dcl ignore fixed bin (35); dcl incr_indx fixed bin; dcl incr_close_time fixed bin (71); dcl cons_close_time fixed bin (71); dcl comp_close_time fixed bin (71); dcl incr_open_time fixed bin (71); dcl latest_indx fixed bin; dcl link_retrieval bit (1); dcl lock bit (1); dcl lsearch_name char (32); dcl ncp ptr; dcl nelemt fixed bin; dcl no_contents_seg bit (1); dcl num fixed bin; dcl object_retrieval bit (1); dcl old_dirname char (168); dcl open_time fixed bin (71); dcl parent_check bit (1); dcl pmode bit (36); dcl psearch_name char (32); dcl pvid bit (36); dcl recursion_level fixed bin; dcl search_name char (32); dcl sortx fixed bin; dcl sorty fixed bin; dcl start_numeric fixed bin; dcl type fixed bin; dcl uid bit (36); dcl vdtd bit (36) aligned; dcl vlx fixed bin; dcl volid bit (36); dcl volname char (32); dcl vtoce_derived_volname char (32); dcl fcbp ptr; dcl vtoce_volid (3) bit (36); dcl dump_type fixed bin; dcl nsp ptr; dcl based_char_string char (1048576) based (ptr (contents_namesp, backup_volume_contents.offset (contents_idx))); dcl name_string based (nsp) char (lns); dcl 1 local_rvce like rvce aligned; dcl 1 volume_id aligned, 2 char char (2) unaligned, 2 num fixed bin unaligned; dcl myname char (32) static init ("retv_vol_control_") options (constant); dcl segment fixed bin int static init (1) options (constant); dcl DIR fixed bin int static init (2) options (constant); dcl LINK fixed bin int static init (3) options (constant); dcl rw bit (3) int static init ("101"b) options (constant); dcl sm bit (3) int static init ("110"b) options (constant); dcl iox_$user_input ptr ext; dcl error_table_$action_not_performed ext fixed bin (35); dcl error_table_$segfault ext fixed bin (35); dcl error_table_$bad_volid ext fixed bin (35); dcl error_table_$locked_by_this_process ext fixed bin (35); dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$invalid_lock_reset ext fixed bin (35); dcl retv_notify_ entry (char (*), ptr, char (*)); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$fs_move_seg entry (ptr, ptr, fixed bin (1), fixed bin (35)); dcl msf_manager_$close entry (ptr); dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35)); dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin, fixed bin (35)); dcl suffixed_name_$make entry (char (*), char (*), char (*), fixed bin (35)); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl ioa_ entry options (variable); dcl ioa_$nnl entry options (variable); dcl iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); dcl command_query_ entry options (variable); dcl retv_report_$error_output entry options (variable); dcl retv_report_$online_output entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl message_segment_$update_message_index entry (fixed bin, fixed bin, bit (72) aligned, ptr, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl mdc_$find_volname entry (bit (36), char (*), char (*), fixed bin (35)); dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)); dcl hc_backup_$retv_status entry (char (*), char (*), bit (72) aligned, char (*) aligned, fixed bin, fixed bin, bit (36), bit (36), bit (36), bit (36), (3) bit (36), bit (36) aligned, fixed bin (35)); dcl seg_fault_error condition; dcl min builtin; dcl hbound builtin; dcl index builtin; dcl ptr builtin; dcl unspec builtin; dcl null builtin; dcl search builtin; dcl max builtin; dcl addr builtin; dcl length builtin; dcl size builtin; dcl substr builtin; dcl rtrim builtin; /* initialize local variables to default values */ code = 0; lock = "0"b; vtoce_derived_volname = ""; entry_name = ""; link_retrieval = "0"b; parent_check = "0"b; entry_retrieval = "0"b; object_retrieval = "0"b; vtoce_volid (*) = "0"b; uid = "0"b; vdtd = "0"b; emode = "0"b; pmode = "0"b; logged = "0"b; bvlp, rvcp, rvcep = null; contentsp, contents_namesp = null; recursion_level = 0; /* pick up static ptrs */ skip = retv_data_.skip; vlp = retv_data_.vlp; /* copy args from input structure */ dirname = retv_input.dirname; ename = retv_input.ename; /* Check to see if object in hierarchy. if so get what ever information we can about it. If not in the hierarcy then the uid will be zero */ status: call hc_backup_$retv_status (dirname, ename, retv_input.access_class, retv_input.requestor, retv_input.level, type, emode, pmode, uid, pvid, vtoce_volid, vdtd, code); /* In cross retrieval case object must exist and must be a segment. Check that this is so */ if retv_input.new_dirname ^= "" then do; if recursion_level ^= 0 | uid = "0"b then do; call ioa_$rsnnl ("Cannot locate ^a^[>^]^a for cross retrieval ", message, 0, dirname, dirname ^= ">", ename); call retv_notify_ (message, inputp, myname); code = -1; goto finish; end; if type ^= segment then do; call ioa_$rsnnl ("Cross directory retrieval of ^a^[>^]^a not allowed", message, 0, dirname, dirname ^= ">", ename); call retv_notify_ (message, inputp, myname); code = -1; goto finish; end; end; /* First check to see if requestor has the correct access. Access must be sufficient to modify the object either directly or be able to set access at the parent level to do so. */ if uid ^= "0"b & type ^= LINK then do; if type = segment & ((emode & rw) = rw | (pmode & sm) = sm) then goto access_ok; if (type = DIR | type = LINK) & ((emode & sm) = sm | (pmode & sm) = sm) then goto access_ok; call ioa_$rsnnl ("Incorrect access to retrieve ^a^[>^]^a", message, 0, dirname, dirname ^= ">", ename); code = -1; call retv_notify_ (message, inputp, myname); goto finish; access_ok: if parent_check then entry_retrieval = "1"b; else object_retrieval = "1"b; /* If dump information exists then determine the most recent volume id by back scanning the volume log for a match. The volume log is located by converting the object's pvid to name and initiating that name in the sub-system dir. If a time bracket has been specified then the found volume must fit within it. Save the volume name and id if found */ if ^retv_data_.manual & (vtoce_volid (incr) ^= "0"b | vtoce_volid (cons) ^= "0"b | vtoce_volid (comp) ^= "0"b) then do; call find_volume_log; if bvlp = null then do; no_volog: call retv_report_$error_output (code, myname, "Unable to locate ^a.volog", psearch_name); goto finish; end; if ^lock then call lock_volume_log; if code ^= 0 then do; volog_lock_err: call retv_report_$error_output (code, myname, "Error locking ^a", psearch_name); goto finish; end; lock = "1"b; incr_open_time = 0; cons_open_time = 0; comp_open_time = 0; incr_close_time = 0; cons_close_time = 0; comp_close_time = 0; incr_indx, cons_indx, comp_indx = 0; do idx = backup_volume_log.next to 1 by -1; bvlep = addr (backup_volume_log.array (idx)); if vtoce_volid (incr) ^= "0"b & vtoce_volid (incr) = bvle.volid then do; incr_open_time = bvle.open_time; incr_close_time = bvle.close_time; incr_indx = idx; end; else if vtoce_volid (cons) ^= "0"b & vtoce_volid (cons) = bvle.volid then do; cons_open_time = bvle.open_time; cons_close_time = bvle.close_time; cons_indx = idx; end; else if vtoce_volid (comp) ^= "0"b & vtoce_volid (comp) = bvle.volid then do; comp_open_time = bvle.open_time; comp_close_time = bvle.close_time; comp_indx = idx; end; end; if retv_input.to_time ^= 0 then do; if incr_open_time > retv_input.to_time then incr_indx = 0; if cons_open_time > retv_input.to_time then cons_indx = 0; if comp_open_time > retv_input.to_time then comp_indx = 0; end; if retv_input.from_time ^= 0 then do; if incr_close_time < retv_input.from_time then incr_indx = 0; if cons_close_time < retv_input.from_time then cons_indx = 0; if comp_close_time < retv_input.from_time then comp_indx = 0; end; latest_indx = max (incr_indx, cons_indx, comp_indx); if latest_indx ^= 0 then do; bvlep = addr (backup_volume_log.array (latest_indx)); vtoce_derived_volname = bvle.volname; end; end; /* Now search the volume log as if there was no dump information, as well there might. Find the volume log, if not already found, lock it, and back scan it. If no time bracket is specified then we skip over incremental tapes that are superceeded by consolidated tape and consolidated tapes that are superceeded by complete dumps. If a time bracket is specified then we look at all the dump volumes in case the object was deleted prematurely. For each dump volume we find we add it to the volume list. Once the volume list is complete then try to save time by searching the contents seg for that volume if it is available. If it is and the object is not found in it then we can skip that dump volume. If the contents seg can not be found then the object is assumed to be on the dump volume. For each dump volume a search request is entered into the volume control segment. If this segemnt does not exist then it is created */ if ^retv_data_.manual | (retv_data_.manual & recursion_level > 1) then do; if bvlp = null then do; call find_volume_log; if bvlp = null then goto no_volog; end; if ^lock then do; call lock_volume_log; if code ^= 0 then goto volog_lock_err; end; lock = "1"b; vlx = 0; if retv_input.to_time = 0 & retv_input.from_time = 0 then do; incr_open_time = 0; cons_open_time = 0; comp_open_time = 0; cons_cycle_uid = "0"b; comp_cycle_uid = "0"b; do idx = backup_volume_log.next to 1 by -1; bvlep = addr (backup_volume_log.array (idx)); if bvle.dump_type = incr then do; if cons_open_time ^= 0 | comp_open_time ^= 0 then do; if (cons_open_time ^= 0 & cons_open_time < bvle.close_time) | (comp_open_time ^= 0 & comp_open_time < bvle.close_time) then call update_volume_list; end; else do; call update_volume_list; incr_open_time = get_open_time (); end; end; else if bvle.dump_type = cons then do; if comp_open_time ^= 0 then do; if comp_open_time < bvle.close_time | cons_cycle_uid = bvle.cycle_uid then call update_volume_list; end; else do; call update_volume_list; cons_open_time = get_open_time (); cons_cycle_uid = bvle.cycle_uid; end; end; else if bvle.dump_type = comp then do; if comp_cycle_uid ^= "0"b then do; if comp_cycle_uid = bvle.cycle_uid then call update_volume_list; comp_open_time = get_open_time (); end; else do; comp_cycle_uid = bvle.cycle_uid; comp_open_time = get_open_time (); call update_volume_list; end; end; end; end; else do idx = backup_volume_log.next to 1 by -1; bvlep = addr (backup_volume_log.array (idx)); call update_volume_list; end; end; else do; done = "0"b; do vlx = 1 by 1 while (^done); call get_volname; retv_volume_list (vlx).open_time = 0; if retv_volume_list (vlx).volname = "." then done = "1"b; else retv_volume_list (vlx).use = "1"b; end; retv_volume_list.next = vlx - 2; end; do rvlx = 1 to retv_volume_list.next; if retv_volume_list (rvlx).use then do; volname = retv_volume_list (rvlx).volname; volid = retv_volume_list (rvlx).volid; open_time = retv_volume_list (rvlx).open_time; dump_type = retv_volume_list (rvlx).dump_type; call find_contents_seg; if contentsp = null then do; no_contents_seg = "1"b; if entry_retrieval | retv_input.to_time ^= 0 | retv_input.from_time ^= 0 | vtoce_derived_volname = volname | vtoce_derived_volname = "" then do; call log_uid; if ^(retv_volume_list (rvlx).announced) then do; call retv_report_$online_output (0, myname, "May search volume ^a because contents segment not available", volname); retv_volume_list (rvlx).announced = "1"b; end; end; end; else do; call search_contents_seg (contents_idx, found); if found then call log_uid; call term_contents_segs; end; end; end; end; /* We come here if an entry must be recovered, either because it does not already exist, or because the request is for a link. If the entry does not exist then we reset dirname and ename to indicate that it is the parent directory that is wanted. */ else do; recursion_level = recursion_level + 1; if type = LINK then link_retrieval = "1"b; parent_check = "1"b; entry_name = ename; old_dirname = dirname; call expand_pathname_ (old_dirname, dirname, ename, code); if code ^= 0 then do; call ioa_$rsnnl ("Unable to expand ^a^[>^]^a", message, 0, retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename); code = -1; call retv_notify_ (message, inputp, myname); goto finish; end; goto status; end; finish: if code ^= 0 & code ^= -1 then do; call retv_report_$error_output (code, myname, "ERROR"); code = 0; end; if ^logged & (code ^= -1) then do; call ioa_$rsnnl ("Online records indicate that ^a^[>^]^a^[>^a^;^s^] can not be found for^/retrieval of ^a^[>^]^a", message, (0), dirname, dirname ^= ">", ename, entry_name ^= "", entry_name, retv_input.dirname, retv_input.dirname ^= ">", retv_input.ename); call retv_notify_ (message, inputp, myname); code = -1; end; if lock then call unlock_volume_log; return; sort: entry (a_rvcp, code); /* This entry re sorts the entries in the control seg by the contents index. This index marks the relative position on the dump medium of each file. Thus sorting the entries allows the scan function in retrieve_from_volume_ to operate a max efficiency. */ rvcp = a_rvcp; code = 0; do sortx = 1 to retv_vol_control.n_entries; do sorty = 1 to retv_vol_control.n_entries; if retv_vol_control.array (sorty).in_use then do; if retv_vol_control.array (sorty).contentsx < retv_vol_control.array (sortx).contentsx then do; local_rvce = retv_vol_control.array (sortx); retv_vol_control.array (sortx) = retv_vol_control.array (sorty); retv_vol_control.array (sorty) = local_rvce; end; end; end; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ update_volume_list: proc; dcl (new_entry, use) bit (1); dcl (vlx, sortx) fixed bin; /* This proc is called to add a dump volume to the volume list associated with some object. It is added to the list if it contains any segments or directories from this volume and it is not already in the list or in the dont use list. If the dump volume was created with a different dim then the one that will be used to read it the operator is queried as to wheter he wants to use it. If not it is added to the don't use list so the question is asked only once */ if bvle.dir_num = 0 & bvle.seg_num = 0 then return; do sortx = 1 to retv_skip_list.next; if bvle.volname = retv_skip_list (sortx).volname then return; /* dont use it */ end; do sortx = 1 to retv_volume_list.next while (retv_volume_list (sortx).volname ^= bvle.volname & retv_volume_list (sortx).volid ^= bvle.volid); /* already in list */ end; if sortx > retv_volume_list.next then do; /* add or update to the list */ vlx, retv_volume_list.next = retv_volume_list.next + 1; new_entry = "1"b; end; else do; new_entry = "0"b; vlx = sortx; end; use = "1"b; if retv_input.to_time ^= 0 & bvle.open_time > retv_input.to_time then use = "0"b; if bvle.open_time > retv_input.submission_time then use = "0"b; if retv_input.from_time ^= 0 & bvle.close_time < retv_input.from_time then use = "0"b; retv_volume_list (vlx).volname = bvle.volname; retv_volume_list (vlx).volid = bvle.volid; retv_volume_list (vlx).use = use | retv_volume_list (vlx).use; if new_entry then do; retv_volume_list (vlx).open_time = bvle.open_time; retv_volume_list (vlx).announced, retv_volume_list (vlx).unused = "0"b; end; else retv_volume_list (vlx).open_time = min (bvle.open_time, retv_volume_list (vlx).open_time); retv_volume_list (vlx).close_time = max (retv_volume_list (vlx).close_time, bvle.close_time); retv_volume_list (vlx).dump_type = bvle.dump_type; if bvle.io_module ^= retv_data_.io_module then do; query_info.version = query_info_version_5; call command_query_ (addr (query_info), answer, myname, "^a ^a ^a ^a^/^a", "io outer module", bvle.io_module, "which wrote volume", bvle.volname, "different than that specified to read volume. Do you wish to use the volume ?"); if answer = "no" then do; retv_volume_list (vlx).use = "0"b; retv_skip_list.next = retv_skip_list.next + 1; retv_skip_list (retv_skip_list.next).volname = bvle.volname; end; end; return; end update_volume_list; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ find_volume_log: proc; /* This proc is called to located the volume log associated with an object. It does this by converting the physical volume id of the object to a physical volume name and searching for it in the sub-system directory. If the volume log is found a few validity checks are made also. */ bvlp = null; psearch_name = ""; call mdc_$find_volname (pvid, psearch_name, lsearch_name, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to convert pvid to pvname"); return; end; call suffixed_name_$make (psearch_name, "volog", search_name, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to construct ^a.volog", psearch_name); return; end; on seg_fault_error begin; bvlp = null; code = error_table_$segfault; goto find_volume_log_ret; end; call hcs_$initiate ((retv_data_.sys_dir), search_name, "", 0, 0, bvlp, code); if bvlp ^= null then do; code = 0; if backup_volume_log.pvname = pvname & backup_volume_log.pvid = pvid & (backup_volume_log.version = backup_volume_log_version_1) | (backup_volume_log.version = backup_volume_log_version_2) | (backup_volume_log.version = backup_volume_log_version_3) then ; else do; bvlp = null; code = error_table_$bad_segment; call retv_report_$error_output (code, myname, "Invalid volog ^a>^a found", retv_data_.sys_dir, search_name); end; end; find_volume_log_ret: if bvlp = null then call retv_report_$error_output (code, myname, "Unable to locate ^a>^a", retv_data_.sys_dir, search_name); return; end find_volume_log; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ lock_volume_log: proc; /* This proc locks the volume log. It treats invalid lock ids and mylocks as recoverable errors. For all others it returns an error code and leaves the volume log unlocked */ call set_lock_$lock (backup_volume_log.lock, -1, code); if code ^= 0 then if code = error_table_$invalid_lock_reset then code = 0; if code = error_table_$locked_by_this_process then do; call retv_report_$error_output (code, myname, "Volume log ^a", psearch_name); code = 0; call unlock_volume_log; call lock_volume_log; end; return; end lock_volume_log; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ unlock_volume_log: proc; /* This proc unlocks the volume log. */ call set_lock_$unlock (backup_volume_log.lock, ignore); return; end unlock_volume_log; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ create_control_seg: proc; dcl (nvol_idx, insert_idx) fixed bin; /* This proc is caled to create a volume control seg for some specified dump volume. The volume control seg is created in the process directory and a pointer to it is mainted in a static array. The order of pointers in the static array is very important for it determines the order in which the dump volumes will be read. For this reason empty volume control segments may be created as place markers so that a time wise order is maintained. Once the volume control segment has been located and verified a set of checks is carried out to see if the object should be recovered(searched for) from this dump volume. If so an entry is made in the control segment and the queue entry is updated to reflect this. */ rvcp = null; call suffixed_name_$make (volname, "control", control_name, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to construct ^a.control", volname); return; end; call hcs_$make_seg ("", control_name, "", 01010b, rvcp, code); if rvcp = null then do; bad_seg: call retv_report_$error_output (code, myname, "Unable to create control seg ^a", control_name); return; end; /* new control seg */ if code = 0 then do; retv_vol_control.version = retv_vol_control_version_1; retv_vol_control.volname = volname; retv_vol_control.volid = volid; retv_vol_control.open_time = open_time; retv_vol_control.dump_type = dump_type; do nvol_idx = 1 to retv_data_.nvol while (retv_data_.rvcp (nvol_idx) -> retv_vol_control.open_time > open_time); end; if nvol_idx > retv_data_.nvol then do; /* no match */ if retv_data_.nvol = hbound (retv_data_.rvcp, 1) then do; rvcp = null; call retv_report_$error_output (0, myname, "Limit of ^d control segs exceeded.", hbound (retv_data_.rvcp, 1)); code = error_table_$action_not_performed; return; end; retv_data_.nvol = retv_data_.nvol + 1; retv_data_.rvcp (retv_data_.nvol) = rvcp; end; else do; insert_idx = nvol_idx; do nvol_idx = retv_data_.nvol to insert_idx by -1; retv_data_.rvcp (nvol_idx + 1) = retv_data_.rvcp (nvol_idx); end; retv_data_.rvcp (insert_idx) = rvcp; retv_data_.nvol = retv_data_.nvol + 1; end; end; code = 0; end create_control_seg; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ log_uid: proc; /* This proc is called to insert a retrieval request in a specific control seg */ call create_control_seg; if rvcp = null then goto finish; retv_vol_control.n_entries = retv_vol_control.n_entries + 1; retv_vol_control.in_use_cnt = retv_vol_control.in_use_cnt + 1; rvcep = addr (retv_vol_control.array (retv_vol_control.n_entries)); rvce.in_use = "1"b; rvce.uid = uid; rvce.contentsx = contents_idx; rvce.vdtd = vdtd; rvce.dirname = dirname; rvce.ename = ename; rvce.entry_name = entry_name; rvce.to_time = retv_input.to_time; rvce.from_time = retv_input.from_time; rvce.queue = retv_data_.queue; rvce.retv_ms_id = retv_input.retv_ms_id; rvce.entry_retrieval = entry_retrieval; rvce.link_retrieval = link_retrieval; rvce.no_contents_seg = no_contents_seg; rvce.object_retrieval = object_retrieval; rvce.vtoce_volname = (vtoce_derived_volname ^= ""); rvce.previous = retv_input.previous; if retv_input.uid = "0"b then do; retv_input.entry_name = rvce.entry_name; retv_input.entry_retrieval = entry_retrieval; retv_input.uid = rvce.uid; call update_queue_message; end; logged = "1"b; return; end log_uid; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ find_contents_seg: proc; /* This proc locates the contents segment, if it exists, in the sub-system directory. If found it performs a few validity tests to be sure. The contents segment of a dump volume contains an array of uids, one for each object that was written on this volume */ contentsp = null; call suffixed_name_$make (volname, "contents", search_name, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to construct ^a.contents", volname); return; end; call hcs_$initiate (rtrim (retv_data_.sys_dir) || ">contents", search_name, "", 0, 0, contentsp, code); on seg_fault_error begin; /* it may not be there */ contentsp = null; code = error_table_$segfault; goto find_contents_seg_ret; end; if contentsp ^= null then do; if backup_volume_contents.version ^= backup_volume_contents_version_3 then call convert_contents_seg; if contentsp ^= null then do; if (backup_volume_contents.volname = volname & backup_volume_contents.volid = volid & backup_volume_contents.version = backup_volume_contents_version_3) then return; else do; contentsp = null; code = error_table_$bad_segment; call retv_report_$error_output (code, myname, "Invalid contents seg ^a>contents>^a", retv_data_.sys_dir, search_name); end; end; end; find_contents_seg_ret: if contentsp = null then call retv_report_$error_output (code, myname, "Unable to access ^a>contents>^a", retv_data_.sys_dir, search_name); return; end find_contents_seg; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ search_contents_seg: proc (contents_idx, found); dcl (contents_idx, startx, endx) fixed bin; dcl found bit (1); /* This proc searchs the contents segment for a match. If one is found then a code of zero is returned */ found = "0"b; do contents_idx = backup_volume_contents.next to 1 by -1; if backup_volume_contents.uid (contents_idx) = uid then do; if entry_retrieval & backup_volume_contents.offset (contents_idx) > 0 then do; call find_contents_names_seg; if contents_namesp ^= null then do; nsp = addr (based_char_string); lns = index (based_char_string, ">>") + 1; if index (name_string, rtrim (entry_name)) ^= 0 then do; startx = 1; endx = index (name_string, ">"); do while (endx > 0); test_name = substr (name_string, startx, endx - 1); if test_name = entry_name then goto gotit; startx = startx + endx; endx = index (substr (name_string, startx), ">"); end; if substr (name_string, startx, lns - startx - 1) = entry_name then goto gotit; end; end; call msf_manager_$close (fcbp); end; else do; gotit: found = "1"b; return; end; end; end; return; end search_contents_seg; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ update_queue_message: proc; /* This proc updates an existant message in the retrievers privite queue */ retry_update: call message_segment_$update_message_index (retv_data_.qidx (retriever), size (retv_input) * 36, retv_input.retv_ms_id, inputp, code); if code = error_table_$bad_segment then do; call retv_report_$error_output (code, myname, "Private queue has been salvaged"); goto retry_update; end; if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to update request in private queue"); end update_queue_message; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ get_volname: proc; /* This proc reads a dump volume name and converts it to a volume id. Volume names are restricted to two or less acsii characters preceeding a numeric value(eg ic12345 is ok but qwqw01 is not). */ request: call ioa_$nnl ("Type retrieval volume name: "); /* Make up request line. */ call iox_$get_line (iox_$user_input, addr (retv_volume_list (vlx).volname), length (retv_volume_list (vlx).volname), nelemt, code); if code ^= 0 then do; call ioa_ ("input error"); goto request; end; retv_volume_list (vlx).volname = substr (retv_volume_list (vlx).volname, 1, nelemt - 1); /* strip new line */ if retv_volume_list (vlx).volname = "." then return; call set_volid_; if code ^= 0 then do; call ioa_ ("Invalid volume id ^a specified.", retv_volume_list (vlx).volname); goto request; end; return; end get_volname; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ set_volid_: proc; /* This proc constructs a volume id from a volume name. This is a interim measure until all dump volume are registered and have a unique id. This construction restricts the volume name to two or less non numeric characters followed by any numeric value lest then 262144. */ /* when rcp_ interface is defined call rcp_$volname_info (retv_volume_list(vlx).volname, retv_volume_list(vlx).volid, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to set volid"); but until then fudge it */ start_numeric = search (retv_volume_list (vlx).volname, "0123456789"); if start_numeric > 3 | start_numeric = 0 then do; bad_volid: code = error_table_$bad_volid; return; end; else do; if start_numeric > 1 then volume_id.char = substr (retv_volume_list (vlx).volname, 1, start_numeric - 1); else volume_id.char = ""; char_num = substr (retv_volume_list (vlx).volname, start_numeric, length (retv_volume_list (vlx).volname) - start_numeric); num = cv_dec_check_ (char_num, code); if code ^= 0 then goto bad_volid; volume_id.num = num; end; retv_volume_list (vlx).volid = unspec (volume_id); return; end set_volid_; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ get_open_time: proc returns (fixed bin (71)); dcl temp fixed bin (71); dcl jdx fixed bin; if bvle.dump_type = incr then return (bvle.open_time); do jdx = idx to 1 by -1; if backup_volume_log.array (jdx).cycle_uid = bvle.cycle_uid then temp = backup_volume_log.array (jdx).open_time; end; return (temp); end get_open_time; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ find_contents_names_seg: proc; /* This proc locates the contents_names segment, if it exists, in the sub-system directory. The contents_names segment of a dump volume contains the name space of the dirs dumped on the dump volume. */ contents_namesp = null; call suffixed_name_$make (volname, "contents_names", search_name, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to construct ^a.contents_name", volname); return; end; on seg_fault_error begin; /* it may not be there */ contents_namesp = null; goto find_contents_names_seg_ret; end; call msf_manager_$open (rtrim (retv_data_.sys_dir) || ">contents", search_name, fcbp, code); if code ^= 0 then do; call retv_report_$error_output (code, myname, "Unable to open ^a>contents>^a", retv_data_.sys_dir, search_name); return; end; call msf_manager_$get_ptr (fcbp, (backup_volume_contents.component (contents_idx)), "0"b, contents_namesp, 0, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to get ptr to component ^d of ^a>contents>^a", backup_volume_contents.component (contents_idx), retv_data_.sys_dir, search_name); find_contents_names_seg_ret: return; end find_contents_names_seg; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ convert_contents_seg: proc; dcl contents_idx fixed bin; call get_temp_segment_ (myname, ncp, code); if code ^= 0 then do; call retv_report_$online_output (code, myname, "Unable to get temp for contents seg conversion"); contentsp = null; return; end; ncp -> backup_volume_contents.version = backup_volume_contents_version_3; if backup_volume_contents.version = 2 then do; ncp -> backup_volume_contents.volname = v2_backup_volume_contents.volname; ncp -> backup_volume_contents.volid = v2_backup_volume_contents.volid; ncp -> backup_volume_contents.next = v2_backup_volume_contents.next; end; else if backup_volume_contents.version = 1 then do; ncp -> backup_volume_contents.volname = v1_backup_volume_contents.volname; ncp -> backup_volume_contents.volid = v1_backup_volume_contents.volid; ncp -> backup_volume_contents.next = v1_backup_volume_contents.next; end; else do; call retv_report_$online_output (0, myname, "Unable to convert ^a.contents because of unknown version ^d", volname, backup_volume_contents.version); contentsp = null; call release_temp_segment_ (myname, ncp, ignore); return; end; do contents_idx = 1 to ncp -> backup_volume_contents.next; if backup_volume_contents.version = 1 then do; ncp -> backup_volume_contents (contents_idx).uid = v1_backup_volume_contents (contents_idx).uid; ncp -> backup_volume_contents (contents_idx).component = 0; ncp -> backup_volume_contents (contents_idx).offset = 0; ncp -> backup_volume_contents (contents_idx).tape_loc = 0; end; else if backup_volume_contents.version = 2 then do; if v2_backup_volume_contents (contents_idx).offset = -1 then do; ncp -> backup_volume_contents (contents_idx).component = 0; ncp -> backup_volume_contents (contents_idx).offset = 0; end; else do; ncp -> backup_volume_contents (contents_idx).component = v2_backup_volume_contents (contents_idx).component; ncp -> backup_volume_contents (contents_idx).offset = v2_backup_volume_contents (contents_idx).offset; end; ncp -> backup_volume_contents (contents_idx).uid = v2_backup_volume_contents (contents_idx).uid; end; end; call hcs_$fs_move_seg (ncp, contentsp, 1, code); if code ^= 0 then do; call retv_report_$online_output (code, myname, "Unable to move converted contents seg"); contentsp = null; end; call release_temp_segment_ (myname, ncp, ignore); end convert_contents_seg; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ term_contents_segs: proc; dcl segp ptr; /* This proc terminates the contents and contents name segs */ do segp = contentsp; if segp ^= null then call hcs_$terminate_noname (segp, code); if code ^= 0 then call retv_report_$error_output (code, myname, "Unable to terminate contents segs"); end; end term_contents_segs; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ %include retv_data_; %include retv_volume_list; %include retv_request; %include queue_msg_hdr; %include retv_input; %include retv_vol_control; %include backup_volume_contents; %include backup_volume_log; %include backup_volume_header; %include backup_pvol_info; %include fs_vol_label; %include backup_static_variables; %include retv_skip_list; %include query_info; end retv_vol_control_; 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