COMPILATION LISTING OF SEGMENT carry_dump Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 03/15/89 0828.2 mst Wed Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 carry_dump: proc; 12 13 /* This command reads a queue of carry requests and produces: 14* a backup tape containing the named segments and directory 15* subtrees, a tape log segment called TAPE_NUMBER.tape_log, 16* a list of requests called TAPE_NUMBER.input used to remake a tape, 17* and a directory named mail_to_carry containing PERSON.PROJECT 18* ASCII segments ("...loaded at...") which are carried on the tape 19* and mailed at the target site to notify requestors that their 20* requests have been loaded. 21* 22* Usage: carry_dump tape_number {queue_path} {-control_arg} 23* 24* where control_arg can be -force or -fc to write a tape even 25* if there are no requests in the queue. 26* If queue_path is not specified, the default pathname is: 27* 28* >daemon_dir_dir>carry_dir>carry.ms 29* 30* The remake_carry_tape command reads the file .input 31* that was written when tape was first made, and 32* makes another tape. The tape made can have a number different 33* from . 34* 35* Usage: remake_carry_tape tape_number {new_tape_number} 36* {-queue_dir path} 37* Steve Herbst 7/9/76 38*-notify feature added 04/18/79 S. Herbst */ 39 /* -trim added and bugs fixed 08/03/79 S. Herbst */ 40 /* -user added 01/09/80 S. Herbst */ 41 /* Modified to set dir_quota on append, Keith Loepere December 1984. */ 42 1 1 /* BEGIN INCLUDE FILE ... backup_control.incl.pl1 */ 1 2 /* Modified: July 1982 by G. Palter to add features for proper support of AIM in IMFT (version 4) */ 1 3 /* Modified: August 1983 by Robert Coren to add minimum access class enforcement */ 1 4 /* Modified: November 1983 by Robert Coren to add "upgrade_to_user_auth" flag */ 1 5 1 6 /* Hierarchy dumper/reloader subroutine control structure */ 1 7 1 8 dcl 1 backup_control aligned based (backup_control_ptr), 1 9 2 header, /* allows people to use like (!) */ 1 10 3 version character (8) unaligned, 1 11 3 tape_entry entry (character (*)) variable, /* returns next tape label */ 1 12 3 data_iocb pointer, /* -> I/O switch to use for dumping/loading if preattached */ 1 13 3 maximum_access_class bit (72) aligned, /* maximum access class for anything to be dumped */ 1 14 3 minimum_access_class bit (72) aligned, /* minimum access class for anything to be dumped */ 1 15 3 maximum_dir_access_class bit (72) aligned, /* no directory above this access class is dumped */ 1 16 3 user_for_access_check, /* data required to validate user's access */ 1 17 4 id character (32) unaligned, /* Person.Project.tag */ 1 18 4 authorization bit (72), /* the user's process authorization */ 1 19 4 ring fixed binary, /* the user's ring o execution */ 1 20 3 minimum_ring fixed binary, /* no ring bracket is set below this value */ 1 21 3 aim_translations, /* data required to translate AIM attributes on the tape */ 1 22 4 source_attributes_ptr pointer, 1 23 4 target_attributes_ptr pointer, 1 24 3 options aligned, 1 25 4 map_sw bit(1) unaligned, /* ON to write map segment */ 1 26 4 debug_sw bit (1) unaligned, /* ON to check quotas and not trim subtrees */ 1 27 4 no_reload_sw bit (1) unaligned, /* ON to not load for backup_load_ */ 1 28 4 hold_sw bit (1) unaligned, /* ON to not demount tape afterwards */ 1 29 4 preattached bit (1) unaligned, /* ON => perform loading/dumping to supplied I/O switch */ 1 30 4 error_file bit (1) unaligned, /* ON => generate an error file anyway */ 1 31 4 first bit (1) unaligned, /* ON => for reload, stop after all requests satisfied */ 1 32 4 caller_handles_conditions bit (1) unaligned, /* ON => caller of backup_dump_ handles faults */ 1 33 4 allow_dir_overwrite bit (1) unaligned, /* ON => allow reloaded seg to overwrite a dir */ 1 34 4 enforce_max_access_class bit (1) unaligned, /* ON => do not dump anything above given access class */ 1 35 4 dont_dump_upgraded_dirs bit (1) unaligned, /* ON => do not dump directories above given access class */ 1 36 4 check_effective_access bit (1) unaligned, /* ON => do not dump branches specified user can't touch */ 1 37 4 restore_access_class bit (1) unaligned, /* ON => restore AIM attributes even in debug mode */ 1 38 4 enforce_minimum_ring bit (1) unaligned, /* ON => do not give anything ring bracket below minimum */ 1 39 4 translate_access_class bit (1) unaligned, /* ON => translate access classes read from tape */ 1 40 4 enforce_min_access_class bit (1) unaligned, /* ON => do not dump anything below given access class */ 1 41 4 upgrade_to_user_auth bit (1) unaligned, /* ON => set access class of branch being dumped to user's authorization */ 1 42 4 pad bit (19) unaligned, 1 43 3 request_count fixed binary, /* # of entries to load or dump */ 1 44 2 requests (backup_control_request_count refer (backup_control.request_count)), 1 45 3 path character (168) unaligned, /* pathname of object to be dumped/loaded */ 1 46 3 new_path character (168) unaligned, /* pathname for object when reloading if not same as above */ 1 47 3 switches aligned, 1 48 4 no_primary_sw bit (1) unaligned, /* do not use primary pathname */ 1 49 4 trim_sw bit (1) unaligned, /* trim target directories */ 1 50 4 pad bit (34) unaligned, 1 51 3 found bit(1) aligned, /* ON => found on tape by backup_load_ (output) */ 1 52 3 loaded bit (1) aligned, /* ON => loaded by backup_load_ (output) */ 1 53 3 status_code fixed binary (35), /* ON => per-entry status code (output) */ 1 54 3 error_name character (65) unaligned; /* ON => some information about what happened (output) */ 1 55 1 56 dcl backup_control_ptr pointer; 1 57 1 58 dcl backup_control_request_count fixed binary; /* for allocations */ 1 59 1 60 dcl BACKUP_CONTROL_VERSION_5 character (8) static options (constant) initial ("hbc_0005"); 1 61 1 62 /* END INCLUDE FILE ... backup_control.incl.pl1 */ 43 44 dcl 1 request_info (request_index) aligned based, 45 2 sender char (32), 46 2 new_user char (32), 47 2 type_string char (32), 48 2 notify bit (1) aligned; 49 50 dcl SP_HT char (2) int static options (constant) init (" "); 51 dcl (mseg_dir, queue_dir) char (168) init (">daemon_dir_dir>carry_dir"); 52 dcl mseg_name char (32) init ("carry.ms"); 53 54 dcl (dn, input_path, mail_dir_path, path, new_dir_path, tape_log_path) char (168); 55 56 dcl line char (line_len) based (line_ptr); 57 dcl arg char (arg_len) based (arg_ptr); 58 dcl return_string char (return_len) varying based (return_ptr); 59 dcl mail_seg char (mail_seg_len) based (mail_seg_ptr); 60 dcl (buffer, header, warning_msg) char (500); 61 dcl err_string char (100); 62 dcl (en, new_user_id, sender_id, type_str) char (32); 63 dcl atime char (24); 64 dcl destination char (23); 65 dcl tape_number char (32); 66 dcl new_tape_number char (32) int static; 67 dcl newline char (1) int static init (" 68 "); 69 dcl id (id_limit) bit (72) aligned based (id_ptr); 70 71 dcl use_tape_number bit (1) aligned int static; 72 dcl active_function bit (1) aligned; 73 dcl remake_tape bit (1) aligned; 74 dcl (got_number, got_new_number, got_queue, got_tape) bit (1) aligned; 75 dcl (force_sw, new_dir_sw, no_requests, notify_sw, trim_sw, warn_subtree_sw) bit (1) aligned; 76 dcl tape_attached bit (1) aligned init ("0"b); 77 78 dcl area area based (area_ptr); 79 80 dcl (bk_iocb, input_iocb, mail_iocb, tape_log_iocb) ptr init (null); 81 dcl (eptr, nptr, id_ptr) ptr init (null); 82 dcl (area_ptr, arg_ptr, line_ptr, mail_seg_ptr, names_ptr, new_id_ptr, return_ptr) ptr; 83 dcl ptrs (2) ptr; 84 dcl (control_ptr, info_ptr) ptr init (null); 85 86 dcl (arg_count, arg_len, buffer_len, ecount, error_count, header_len, id_index, id_limit) fixed bin; 87 dcl (i, j, line_len, mail_count, mail_seg_len, names_count, request_index, return_len) fixed bin; 88 dcl mseg_index fixed bin init (0); 89 dcl type fixed bin (2); 90 dcl rings7 (3) fixed bin (3) init ((3)7); 91 dcl mail_seg_bc fixed bin (24); 92 dcl code fixed bin (35); 93 94 dcl 1 entries (ecount) aligned based (eptr), 95 2 type bit (2) unaligned, 96 2 nnames fixed bin (15) unaligned, 97 2 nindex fixed bin (17) unaligned; 98 99 dcl star_names (99) char (32) aligned based (nptr); 2 1 declare /* Structure returned by hcs_$status_long */ 2 2 2 3 1 branch_status aligned, /* automatic: hcs_$status uses a pointer */ 2 4 2 5 2 type bit(2) unaligned, /* type of entry: link, segment, dir */ 2 6 2 number_names bit(16) unaligned, /* unused by directory_status_ */ 2 7 2 names_rel_pointer bit(18) unaligned, /* unused by directory_status_ */ 2 8 2 date_time_modified bit(36) unaligned, /* date time modified */ 2 9 2 date_time_used bit(36) unaligned, /* date time entry used */ 2 10 2 mode bit(5) unaligned, /* effective access of caller */ 2 11 2 raw_mode bit(5) unaligned, 2 12 2 pad1 bit(8) unaligned, 2 13 2 records bit(18) unaligned, /* number of records in use */ 2 14 2 date_time_dumped bit(36) unaligned, /* date time last dumped */ 2 15 2 date_time_entry_modified bit(36) unaligned, /* date time entry modified */ 2 16 2 lvid bit(36) unaligned, /* logical volume id */ 2 17 2 current_length bit(12) unaligned, /* number of blocks currently allocated */ 2 18 2 bit_count bit(24) unaligned, /* bit count of entry */ 2 19 2 pad3 bit(8) unaligned, 2 20 2 copy_switch bit(1) unaligned, /* the copy switch */ 2 21 2 tpd bit(1) unaligned, /* transparent to paging device */ 2 22 2 mdir bit(1) unaligned, /* master directory switch */ 2 23 2 damaged_switch bit (1) unaligned, /* true if contents damaged */ 2 24 2 synchronized_switch bit (1) unaligned, /* true if a DM synchronized file */ 2 25 2 pad4 bit(5) unaligned, 2 26 2 ring_brackets (0:2) bit(6) unaligned, /* branch ring brackets */ 2 27 2 unique_id bit(36) unaligned, /* entry unique id */ 2 28 2 29 2 30 /* The types of each class of branch */ 2 31 segment_type bit(2) aligned internal static initial ("01"b), 2 32 directory_type bit(2) aligned internal static initial ("10"b), 2 33 msf_type bit(2) aligned internal static initial ("10"b), /* will eventually be different */ 2 34 link_type bit(2) aligned internal static initial ("00"b); 2 35 2 36 100 101 dcl names (names_count) char (32) based (names_ptr); 102 3 1 /* BEGIN INCLUDE FILE - - - create_branch_info.incl.pl1 - - - created January 1975 */ 3 2 3 3 3 4 /****^ HISTORY COMMENTS: 3 5* 1) change(89-01-16,TLNguyen), approve(89-01-16,MCR8049), 3 6* audit(89-02-03,Parisek), install(89-03-15,MR12.3-1025): 3 7* 1. Declare version constant properly. 3 8* 2. Remove version 1 since it was never referenced and to force 3 9* callers to upgrade their programs. 3 10* END HISTORY COMMENTS */ 3 11 3 12 3 13 /* Modified December 1984 for dir_quota, Keith Loepere. */ 3 14 3 15 /* this include files gives the argument structure for create_branch_ */ 3 16 3 17 dcl 1 create_branch_info aligned based, 3 18 2 version fixed bin, /* set this to the largest value given below */ 3 19 2 switches unaligned, 3 20 3 dir_sw bit (1) unaligned, /* if on, a directory branch is wanted */ 3 21 3 copy_sw bit (1) unaligned, /* if on, initiating segment will be done by copying */ 3 22 3 chase_sw bit (1) unaligned, /* if on, if pathname is a link, it will be chased */ 3 23 3 priv_upgrade_sw bit (1) unaligned, /* privileged creation (ring 1) of upgraded object */ 3 24 3 parent_ac_sw bit (1) unaligned, /* if on, use parent's access class for seg or dir created */ 3 25 3 mbz1 bit (31) unaligned, /* pad to full word */ 3 26 2 mode bit (3) unaligned, /* segment or directory for acl for userid */ 3 27 2 mbz2 bit (33) unaligned, /* pad to full word */ 3 28 2 rings (3) fixed bin (3), /* branch's ring brackets */ 3 29 2 userid char (32), /* user's access control name */ 3 30 2 bitcnt fixed bin (24), /* bit count of the segment */ 3 31 2 quota fixed bin (18), /* for directories, this am't of quota will be moved to it */ 3 32 2 access_class bit (72), /* is the access class of the body of the branch */ 3 33 2 dir_quota fixed bin (18); /* for directories, this am't of dir quota will be moved to it */ 3 34 3 35 dcl create_branch_version_2 fixed bin int static options (constant) init (2); 3 36 3 37 /* END INCLUDE FILE - - - create_branch_info.incl.pl1 - - - */ 3 38 103 104 dcl 1 cb_info like create_branch_info; 105 4 1 /* BEGIN INCLUDE FILE . . . mseg_return_args.incl.pl1 */ 4 2 4 3 4 4 /* structure returned when message is read from a message segment */ 4 5 4 6 4 7 dcl ms_arg_ptr ptr; 4 8 4 9 dcl 1 mseg_return_args based (ms_arg_ptr) aligned, 4 10 2 ms_ptr ptr, /* pointer to message */ 4 11 2 ms_len fixed bin (24), /* length of message in bits */ 4 12 2 sender_id char (32) unaligned, /* process-group ID of sender */ 4 13 2 level fixed bin, /* validation level of sender */ 4 14 2 ms_id bit (72), /* unique ID of message */ 4 15 2 sender_authorization bit (72), /* access authorization of message sender */ 4 16 2 access_class bit (72); /* message access class */ 4 17 4 18 4 19 /* END INCLUDE FILE . . . mseg_return_args.incl.pl1 */ 106 107 dcl 1 mseg_args like mseg_return_args; 108 5 1 /* BEGIN send_mail_info include file */ 5 2 5 3 dcl send_mail_info_version_2 fixed bin init(2); 5 4 5 5 dcl 1 send_mail_info aligned, 5 6 2 version fixed bin, /* = 2 */ 5 7 2 sent_from char(32) aligned, 5 8 2 switches, 5 9 3 wakeup bit(1) unal, 5 10 3 mbz1 bit(1) unal, 5 11 3 always_add bit(1) unal, 5 12 3 never_add bit(1) unal, 5 13 3 notify bit(1) unal, 5 14 3 acknowledge bit(1) unal, 5 15 3 mbz bit(30) unal; 5 16 5 17 /* END send_mail_info include file */ 109 110 dcl 1 dir_acl (1) aligned, 111 2 access_name char (32), 112 2 modes bit (36), 113 2 status_code fixed bin (35); 114 115 dcl error_table_$badopt fixed bin (35) ext; 116 dcl error_table_$end_of_info fixed bin (35) ext; 117 dcl error_table_$entlong fixed bin (35) ext; 118 dcl error_table_$no_message fixed bin (35) ext; 119 dcl error_table_$noentry fixed bin (35) ext; 120 dcl error_table_$not_act_fnc fixed bin (35) ext; 121 dcl error_table_$not_attached fixed bin (35) ext; 122 123 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 124 dcl (active_fnc_err_, active_fnc_err_$suppress_name) entry options (variable); 125 dcl backup_dump_ entry (ptr, fixed bin (35)); 126 dcl backup_util$get_real_name entry (ptr, ptr, fixed bin, fixed bin (35)); 127 dcl clock_ entry returns (fixed bin (71)); 128 dcl (com_err_, com_err_$suppress_name) entry options (variable); 129 dcl convert_status_code_ entry (fixed bin (35), char (*), char (*)); 130 dcl cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)); 131 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 132 dcl date_time_ entry (fixed bin (71), char (*)); 133 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 134 dcl get_group_id_ entry returns (char (32)); 135 dcl get_group_id_$tag_star entry returns (char (32)); 136 dcl get_system_free_area_ entry returns (ptr); 137 dcl get_temp_segments_ entry (char (*), (*)ptr, fixed bin (35)); 138 dcl hcs_$add_dir_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 139 dcl hcs_$create_branch_ entry (char (*), char (*), ptr, fixed bin (35)); 140 dcl hcs_$del_dir_tree entry (char (*), char (*), fixed bin (35)); 141 dcl hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 142 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (1), ptr, fixed bin (35)); 143 dcl hcs_$set_bc entry (char (*), char (*), fixed bin (24), fixed bin (35)); 144 dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); 145 dcl hcs_$status_ entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 146 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); 147 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 148 dcl hcs_$truncate_file entry (char (*), char (*), fixed bin (18), fixed bin (35)); 149 dcl ioa_ entry options (variable); 150 dcl ioa_$ioa_switch entry options (variable); 151 dcl ioa_$rs entry options (variable); 152 dcl ioa_$rsnnl entry options (variable); 153 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)); 154 dcl iox_$close entry (ptr, fixed bin (35)); 155 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 156 dcl iox_$error_output ptr ext; 157 dcl iox_$find_iocb entry (char (*), ptr, fixed bin (35)); 158 dcl iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 159 dcl iox_$open entry (ptr, fixed bin, bit (1), fixed bin (35)); 160 dcl iox_$position entry (ptr, fixed bin, fixed bin, fixed bin (35)); 161 dcl iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35)); 162 dcl message_segment_$close entry (fixed bin, fixed bin (35)); 163 dcl message_segment_$delete_index entry (fixed bin, bit (72)aligned, fixed bin (35)); 164 dcl message_segment_$incremental_read_index entry (fixed bin, ptr, bit (2)aligned, bit (72), ptr, fixed bin (35)); 165 dcl message_segment_$open entry (char (*), char (*), fixed bin, fixed bin (35)); 166 dcl message_segment_$read_index entry (fixed bin, ptr, bit (1)aligned, ptr, fixed bin (35)); 167 dcl release_temp_segments_ entry (char (*), (*)ptr, fixed bin (35)); 168 dcl send_mail_ entry (char (*), char (*), ptr, fixed bin (35)); 169 dcl send_message_$notify_mail entry options (variable); 170 171 dcl (addr, divide, fixed, index, length, null, ptr, reverse, rtrim, substr, unspec, verify) builtin; 172 173 dcl cleanup condition; 174 /* */ 175 remake_tape = "0"b; 176 177 call cu_$af_return_arg (arg_count, return_ptr, return_len, code); 178 if code = error_table_$not_act_fnc then active_function = "0"b; 179 else active_function = "1"b; 180 if arg_count = 0 then do; 181 USAGE: if active_function then call active_fnc_err_$suppress_name (0, "carry_dump", 182 "Usage: [carry_dump tape_number {queue_path} {-force}]"); 183 else call com_err_$suppress_name (0, "carry_dump", 184 "Usage: carry_dump tape_number {queue_path} {-force}"); 185 return; 186 end; 187 188 force_sw, got_tape, got_queue, no_requests = "0"b; 189 190 do i = 1 to arg_count; 191 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 192 if substr (arg, 1, 1) = "-" then 193 if arg = "-force" | arg = "-fc" then force_sw = "1"b; 194 else do; 195 code = error_table_$badopt; 196 if active_function then call active_fnc_err_ (code, "carry_dump", "^a", arg); 197 else call com_err_ (code, "carry_dump", "^a", arg); 198 return; 199 end; 200 else if ^got_tape then do; 201 got_tape = "1"b; 202 tape_number, new_tape_number = arg; 203 end; 204 else do; 205 if got_queue then go to USAGE; /* two queue paths given */ 206 got_queue = "1"b; 207 call expand_pathname_ (arg, mseg_dir, mseg_name, code); 208 if code ^= 0 then do; 209 call warn (code, "carry_dump", arg); 210 return; 211 end; 212 queue_dir = mseg_dir; 213 j = length (mseg_name)+1-verify (reverse (mseg_name), " "); 214 if j<4 | substr (mseg_name, j-2, 3) ^= ".ms" then 215 if j+3>length (mseg_name) then do; 216 call warn (error_table_$entlong, "carry_dump", rtrim (mseg_name) || ".ms"); 217 return; 218 end; 219 else substr (mseg_name, j+1, 3) = ".ms"; 220 end; 221 end; 222 223 if active_function then return_string = "false"; /* initialize */ 224 225 call message_segment_$open (mseg_dir, mseg_name, mseg_index, code); 226 if mseg_index = 0 then do; 227 call warn (code, "carry_dump", rtrim (mseg_dir) || ">" || mseg_name); 228 return; 229 end; 230 231 on condition (cleanup) call clean_up; 232 233 /* See if we can read first request */ 234 235 area_ptr = get_system_free_area_ (); 236 call message_segment_$read_index (mseg_index, area_ptr, "0"b, addr (mseg_args), code); 237 if code ^= 0 then 238 if force_sw then no_requests = "1"b; 239 else do; 240 MSEG_ERROR: if code = error_table_$no_message then 241 if active_function then call ioa_$ioa_switch (iox_$error_output, 242 "Queue ^a>^a is empty.", mseg_dir, mseg_name); 243 else call com_err_ (0, "carry_dump", "Queue ^a>^a is empty.", mseg_dir, mseg_name); 244 else call warn (code, "carry_dump", rtrim (mseg_dir) || ">" || mseg_name); 245 RETURN: call clean_up; 246 return; 247 end; 248 call ioa_$rsnnl ("^a>^a.input", input_path, (0), queue_dir, tape_number); 249 call hcs_$truncate_file (input_path, "", 0, code); /* prepare to write .input */ 250 call hcs_$set_bc (input_path, "", 0, code); 251 call iox_$attach_name ("carry_input", input_iocb, "vfile_ "||input_path, null, code); 252 if code ^= 0 then do; 253 INPUT_ERROR: call warn (code, "carry_dump", "^/Unable to attach ""carry_input"" to " || input_path); 254 go to RETURN; 255 end; 256 call iox_$open (input_iocb, 3, "0"b, code); 257 if code ^= 0 then do; 258 call warn (code, "carry_dump", "^/Unable to write " || input_path); 259 go to RETURN; 260 end; 261 262 /* Allocate room for message id's */ 263 264 id_limit = 128; 265 allocate id in (area) set (id_ptr); 266 id_index = 0; 267 268 i = index (mseg_name, "."); /* get destination from queue name prefix */ 269 if i ^= 0 & substr (mseg_name, i+1, 8) = "carry.ms" then do; 270 GET_DS: destination = substr (mseg_name, 1, i-1); 271 end; 272 else do; /* name given has no destination prefix */ 273 call hcs_$status_ (mseg_dir, mseg_name, 1, addr (branch_status), area_ptr, code); 274 if code ^= 0 then do; 275 NO_DS: call warn (code, "carry_dump", "^/Unable to determine carry destination. 276 Please give destination - prefixed name of queue " || rtrim (mseg_dir) || ">" || mseg_name); 277 go to RETURN; 278 end; 279 names_ptr = ptr (area_ptr, branch_status.names_rel_pointer); 280 names_count = fixed (branch_status.number_names); 281 do j = 1 to names_count; 282 mseg_name = names (j); 283 i = index (mseg_name, "."); 284 if i ^= 0 & substr (mseg_name, i+1, 8) = "carry.ms" then do; 285 free names in (area); 286 go to GET_DS; 287 end; 288 end; 289 free names in (area); 290 code = 0; 291 go to NO_DS; 292 end; 293 294 /* Write header line in .input */ 295 296 call date_time_ (clock_ (), atime); 297 call ioa_$rs ("Carry tape ^a to ^a written ^a", header, header_len, tape_number, destination, atime); 298 call iox_$put_chars (input_iocb, addr (header), header_len, code); 299 if code ^= 0 then do; 300 call warn (code, "carry_dump", "^/Unable to write " || input_path); 301 go to RETURN; 302 end; 303 304 if no_requests then go to MAKE_BLANK_TAPE; 305 306 /* Read queue into .input */ 307 308 code = 0; 309 310 do while (code = 0); 311 312 id_index = id_index+1; /* remember message id for later deletion */ 313 if id_index>id_limit then do; /* need more room for id array */ 314 id_limit = id_limit+64; 315 allocate id in (area) set (new_id_ptr); 316 do j = 1 to id_index-1; 317 new_id_ptr -> id (j) = id_ptr -> id (j); 318 end; 319 free id_ptr -> id in (area); 320 id_ptr = new_id_ptr; 321 end; 322 id (id_index) = mseg_args.ms_id; 323 324 sender_id = mseg_args.sender_id; 325 line_ptr = mseg_args.ms_ptr; 326 line_len = divide (mseg_args.ms_len+8, 9, 17, 0); 327 if substr (line, line_len, 1) = newline then line_len = line_len-1; 328 if substr (line, line_len - 5, 6) = " -hold" then do; /* hold request */ 329 line_len = line_len-6; 330 id_index = id_index-1; /* do not delete it from queue */ 331 end; 332 if substr (line, line_len - 7, 8) = " -notify" then do; 333 notify_sw = "1"b; 334 line_len = line_len - 8; 335 end; 336 else notify_sw = "0"b; 337 j = index (line, " -new_dir "); 338 if j ^= 0 then do; 339 new_dir_path = substr (line, j + 10); 340 line_len = j - 1; 341 end; 342 else new_dir_path = ""; 343 if substr (line, line_len - 5, 6) = " -trim" then do; 344 trim_sw = "1"b; 345 line_len = line_len - 6; 346 end; 347 else trim_sw = "0"b; 348 349 j = index (line, " -user "); 350 if j ^= 0 then do; 351 new_user_id = substr (line, j + 7); 352 line_len = j - 1; 353 end; 354 else new_user_id = ""; 355 356 if substr (line, 1, 8) ^= "Segment " & substr (line, 1, 8) ^= "Subtree " then do; 357 call hcs_$status_minf ((line), "", 1, type, 0, code); 358 if code ^= 0 then go to NEXT; 359 if type = 2 then type_str = "Subtree"; 360 else type_str = "Segment"; 361 call ioa_$rs ("^a ^a ^a^[ -user ^a^;^s^]^[ -trim^]^[ -notify^]", buffer, buffer_len, 362 type_str, substr (line, 1, line_len), sender_id, 363 new_user_id ^= "", new_user_id, trim_sw, notify_sw); 364 end; 365 else call ioa_$rs ("^a ^a^[ -user ^a^;^s^]^[ -trim^]^[ -notify^]", buffer, buffer_len, 366 substr (line, 1, line_len), sender_id, new_user_id ^= "", new_user_id, trim_sw, notify_sw); 367 368 if new_dir_path ^= "" then do; 369 substr (buffer, buffer_len, 10) = " -new_dir" || newline; 370 buffer_len = buffer_len + 9; 371 end; 372 373 call iox_$put_chars (input_iocb, addr (buffer), buffer_len, code); 374 375 if new_dir_path ^= "" then 376 call ioa_$ioa_switch (input_iocb, "^10xMove to directory ^a", new_dir_path); 377 378 NEXT: call message_segment_$incremental_read_index /* read next request from queue */ 379 (mseg_index, area_ptr, "01"b, mseg_args.ms_id, addr (mseg_args), code); 380 if code ^= 0 & code ^= error_table_$no_message then go to MSEG_ERROR; 381 end; 382 383 /* Position back and read header line from .input */ 384 385 call iox_$position (input_iocb, -1, 0, code); 386 387 call iox_$get_line (input_iocb, addr (buffer), length (buffer), line_len, code); 388 if code ^= 0 then do; 389 call warn (code, "carry_dump", "^/Unable to read " || input_path); 390 go to RETURN; 391 end; 392 go to COMMON; 393 /* */ 394 remake_carry_tape: entry; 395 396 remake_tape = "1"b; 397 398 call cu_$af_return_arg (arg_count, return_ptr, return_len, code); 399 if code = error_table_$not_act_fnc then active_function = "0"b; 400 else active_function = "1"b; 401 if arg_count = 0 then do; 402 USAGE2: if active_function then call active_fnc_err_$suppress_name (0, "remake_carry_tape", 403 "Usage: [remake_carry_tape tape_number {new_tape_number} {-queue_dir path}]"); 404 else call com_err_$suppress_name (0, "remake_carry_tape", 405 "Usage: remake_carry_tape tape_number {new_tape_number} {-queue_dir path}]"); 406 return; 407 end; 408 409 got_number, got_new_number = "0"b; 410 411 do i = 1 to arg_count; 412 413 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 414 415 if substr (arg, 1, 1) = "-" then 416 if arg = "-queue_dir" | arg = "-qd" then do; 417 i = i+1; 418 call cu_$arg_ptr (i, arg_ptr, arg_len, code); 419 call absolute_pathname_ (arg, queue_dir, code); 420 if code ^= 0 then do; 421 call com_err_ (code, "remake_carry_tape", "^a", arg); 422 return; 423 end; 424 end; 425 else do; 426 code = error_table_$badopt; 427 if active_function then call active_fnc_err_ (code, "remake_carry_tape", "^a", arg); 428 else call com_err_ (code, "remake_carry_tape", "^a", arg); 429 return; 430 end; 431 else if ^got_number then do; 432 tape_number = arg; 433 got_number = "1"b; 434 end; 435 else if ^got_new_number then do; 436 new_tape_number = arg; 437 got_new_number = "1"b; 438 end; 439 else go to USAGE2; 440 end; 441 if ^got_number then go to USAGE2; 442 if ^got_new_number then new_tape_number = tape_number; 443 444 call ioa_$rsnnl ("^a>^a.input", input_path, (0), queue_dir, tape_number); 445 call iox_$attach_name ("carry_input", input_iocb, "vfile_ "||input_path, null, code); 446 if code ^= 0 then go to INPUT_ERROR; 447 448 call iox_$open (input_iocb, 1, "0"b, code); 449 if code ^= 0 then do; 450 call warn (code, "carry_dump", "Unable to read " || input_path); 451 go to RETURN; 452 end; 453 454 call iox_$get_line (input_iocb, addr (buffer), length (buffer), line_len, code); 455 if code ^= 0 then do; 456 call warn (code, "carry_dump", "Unable to read " || input_path); 457 go to RETURN; 458 end; 459 460 /* Get destination from input file header */ 461 462 line_ptr = addr (buffer); 463 i = index (line, " written "); 464 j = index (reverse (substr (line, 1, i-1)), " ")-1; 465 destination = substr (line, i-j, j); 466 467 /* Build header line */ 468 469 call date_time_ (clock_ (), atime); 470 call ioa_$rs ("Carry tape ^a to ^a written ^a", header, header_len, new_tape_number, destination, atime); 471 /* */ 472 COMMON: call initialize_backup; 473 474 call attach_tape_log; /* write header line in .tape_log */ 475 476 use_tape_number = "1"b; /* make $tape_entry return tape id */ 477 478 /* Create directories to hold mail segs */ 479 480 cb_info.version = create_branch_version_2; 481 unspec (cb_info.switches) = "0"b; 482 cb_info.dir_sw, cb_info.parent_ac_sw = "1"b; 483 cb_info.mode = "111"b; 484 cb_info.mbz2, cb_info.access_class = "0"b; 485 cb_info.rings = rings7; 486 cb_info.userid = get_group_id_ (); 487 cb_info.bitcnt, cb_info.quota, cb_info.dir_quota = 0; 488 489 call ioa_$rsnnl ("^a>mail_to_carry", mail_dir_path, 168, queue_dir); 490 491 call create_mail_dir ("mail_to_carry"); 492 call create_mail_dir ("mail_to_send"); 493 /* */ 494 /* Queue input file to be dumped */ 495 496 request_index, control_ptr -> backup_control.request_count = 1; 497 control_ptr -> backup_control.path (1) = input_path; 498 control_ptr -> backup_control.new_path (1) = ""; 499 info_ptr -> request_info.type_string (1) = "Segment"; 500 info_ptr -> request_info.sender (1) = get_group_id_ (); 501 info_ptr -> request_info.new_user (1) = ""; 502 503 /* Queue carry requests (add them to backup_control structure) */ 504 505 call iox_$get_line (input_iocb, addr (buffer), length (buffer), buffer_len, code); 506 507 do while (code ^= error_table_$end_of_info); 508 509 request_index, control_ptr -> backup_control.request_count = request_index+1; 510 control_ptr -> backup_control.no_primary_sw (request_index) = "1"b; 511 512 line_ptr = addr (buffer); 513 line_len = buffer_len; 514 if substr (line, line_len, 1) = newline then line_len = line_len-1; 515 if substr (line, line_len - 8, 9) = " -new_dir" then do; /* carry -new_dir */ 516 new_dir_sw = "1"b; 517 line_len = line_len - 9; 518 end; 519 else new_dir_sw = "0"b; 520 if substr (line, line_len - 7, 8) = " -notify" then do; 521 info_ptr -> request_info.notify (request_index) = "1"b; 522 line_len = line_len - 8; 523 end; 524 else info_ptr -> request_info.notify (request_index) = "0"b; 525 if substr (line, line_len - 5, 6) = " -trim" then do; 526 control_ptr -> backup_control.trim_sw (request_index) = "1"b; 527 line_len = line_len - 6; 528 end; 529 else control_ptr -> backup_control.trim_sw (request_index) = "0"b; 530 i = index (line, " -user "); 531 if i ^= 0 then do; 532 info_ptr -> request_info.new_user (request_index) = substr (line, i + 7); 533 line_len = i - 1; 534 end; 535 else info_ptr -> request_info.new_user (request_index) = ""; 536 line_len = length(rtrim(substr(line,1,line_len))); 537 i = line_len+1-index(reverse(substr(line,1,line_len))," "); /* find last space */ 538 info_ptr -> request_info.sender (request_index) = substr (line, i+1); 539 info_ptr -> request_info.type_string (request_index) = substr (line, 1, 7); 540 path = substr (line, 9, i - 9); 541 542 control_ptr -> backup_control.path (request_index) = path; 543 if new_dir_sw then do; /* -new_dir */ 544 call expand_pathname_ (path, dn, en, code); 545 call iox_$get_line (input_iocb, addr (buffer), length (buffer), buffer_len, code); 546 i = index (buffer, "Move to directory ") + 18; /* start of new pathname */ 547 control_ptr -> backup_control.new_path (request_index) = 548 substr (buffer, i, buffer_len - i) || ">" || en; 549 end; 550 else control_ptr -> backup_control.new_path (request_index) = ""; 551 552 call iox_$get_line (input_iocb, addr (buffer), length (buffer), buffer_len, code); 553 end; 554 555 /* Dump .input and carry requests */ 556 557 tape_attached = "1"b; 558 control_ptr -> backup_control.hold_sw = "1"b; 559 560 call backup_dump_ (control_ptr, code); 561 562 if code ^= 0 then do; 563 if code = error_table_$not_attached then 564 call warn (0, "carry_dump", "Tape " || rtrim (new_tape_number) || " is not available."); 565 else call warn (code, "carry_dump", "^/Tape not written."); 566 go to RETURN; 567 end; 568 569 tape_attached = "0"b; 570 if active_function then return_string = "true"; /* tape written */ 571 /* */ 572 /* Look for errors and build segs to mail. These segs are named Person.Project 573* after the requestors and go in either of two directories: mail_to_send for 574* sending at this site and mail_to_carry for sending at the target site */ 575 576 error_count, mail_count = 0; 577 578 do i = 1 to control_ptr -> backup_control.request_count; 579 580 path = control_ptr -> backup_control.path (i); 581 type_str = info_ptr -> request_info.type_string (i); 582 sender_id = info_ptr -> request_info.sender (i); 583 /* remove instance tag */ 584 sender_id = substr (sender_id, 1, length (sender_id) - index (reverse (sender_id), ".")); 585 586 if control_ptr -> backup_control.status_code (i) ^= 0 then do; 587 588 if substr (control_ptr -> backup_control.error_name (i), 1, 13) = "(in subtree) " then do; 589 warn_subtree_sw = "1"b; 590 call convert_status_code_ 591 (control_ptr -> backup_control.status_code (i), "", err_string); 592 warning_msg = "Omitted some entries in " || control_ptr -> backup_control.path (i); 593 warning_msg = rtrim (warning_msg) || "^/^-"; 594 warning_msg = rtrim (warning_msg) || substr (control_ptr -> backup_control.error_name (i), 14); 595 warning_msg = rtrim (warning_msg) || ":^x"; 596 warning_msg = rtrim (warning_msg) || err_string; 597 call warn (0, "Warning", rtrim (warning_msg, SP_HT)); 598 end; 599 else do; 600 warn_subtree_sw = "0"b; 601 error_count = error_count + 1; 602 call warn (control_ptr -> backup_control.status_code (i), 603 control_ptr -> backup_control.error_name (i), 604 control_ptr -> backup_control.path (i)); 605 end; 606 607 /* Mail goes to requestor at this site */ 608 609 mail_count = mail_count + 1; 610 call ioa_$rsnnl ("vfile_ ^a>mail_to_send>^a -extend", 611 buffer, buffer_len, queue_dir, sender_id); 612 call iox_$attach_name ("carry_mail", mail_iocb, buffer, null, code); 613 call iox_$open (mail_iocb, 2, "0"b, code); 614 if warn_subtree_sw then call ioa_$ioa_switch (mail_iocb, "Warning: " || warning_msg); 615 else do; 616 call ioa_$ioa_switch (mail_iocb, "Unable to dump carry request ^a on tape ^a.", 617 path, new_tape_number); 618 call convert_status_code_ (control_ptr -> backup_control.status_code (i), "", err_string); 619 call ioa_$ioa_switch (mail_iocb, "^a: ^a", 620 control_ptr -> backup_control.error_name (i), err_string); 621 end; 622 end; 623 624 else do; 625 626 if info_ptr -> request_info.notify (i) then do; 627 mail_count = mail_count + 1; 628 call ioa_$rsnnl ("vfile_ ^a>mail_to_send>^a -extend", 629 buffer, buffer_len, queue_dir, sender_id); 630 call iox_$attach_name ("carry_mail", mail_iocb, buffer, null, code); 631 call iox_$open (mail_iocb, 2, "0"b, code); 632 call ioa_$ioa_switch (mail_iocb, "Dumped ^a on tape ^a.", path, new_tape_number); 633 call iox_$close (mail_iocb, code); 634 call iox_$detach_iocb (mail_iocb, code); 635 end; 636 637 /* Notification of loading gets carried and mailed to requestor at target site */ 638 639 if i > 1 then do; /* not .input */ 640 call ioa_$rsnnl ("vfile_ ^a>mail_to_carry>^a -extend", 641 buffer, buffer_len, queue_dir, sender_id); 642 call iox_$attach_name ("carry_mail", mail_iocb, buffer, null, code); 643 call iox_$open (mail_iocb, 2, "0"b, code); 644 if control_ptr -> backup_control.new_path (i) ^= "" then 645 path = control_ptr -> backup_control.new_path (i); 646 call ioa_$ioa_switch (mail_iocb, "^a ^a loaded at ^a from tape ^a.", 647 type_str, path, destination, new_tape_number); 648 end; 649 650 /* Append to .tape_log that this request was dumped */ 651 652 new_user_id = info_ptr -> request_info.new_user (i); 653 if control_ptr -> backup_control.new_path (i) ^= "" then do; 654 call expand_pathname_ (control_ptr -> backup_control.new_path (i), dn, en, code); 655 call ioa_$ioa_switch (tape_log_iocb, 656 "^a ^a ^a^[ -user ^a^;^s^]^[ -trim^] -new_dir^/^10xMove to directory ^a", 657 type_str, control_ptr -> backup_control.path (i), sender_id, new_user_id^="", new_user_id, 658 control_ptr -> backup_control.trim_sw (i), dn); 659 end; 660 else call ioa_$ioa_switch (tape_log_iocb, "^a ^a ^a^[ -user ^a^;^s^]^[ -trim^]", 661 type_str, path, sender_id, new_user_id ^= "", new_user_id, 662 control_ptr -> backup_control.trim_sw (i)); 663 end; 664 665 if mail_iocb ^= null then do; 666 call iox_$close (mail_iocb, code); 667 call iox_$detach_iocb (mail_iocb, code); 668 end; 669 end; 670 671 /* Dump .tape_log and mail_to_carry directory */ 672 673 control_ptr -> backup_control.request_count = 2; 674 control_ptr -> backup_control.path (1) = tape_log_path; 675 control_ptr -> backup_control.new_path (1) = ""; 676 control_ptr -> backup_control.path (2) = mail_dir_path; 677 control_ptr -> backup_control.new_path (2) = ""; 678 control_ptr -> backup_control.hold_sw = "0"b; 679 680 tape_attached, use_tape_number = "1"b; 681 682 call backup_dump_ (control_ptr, code); 683 684 if code ^= 0 then do; 685 buffer = "carry_dump"; 686 NO_TAPE_LOG: if active_function then return_string = "false"; 687 call warn (code, buffer, "Segment " || rtrim (tape_log_path) || " not dumped.^/Tape is invalid."); 688 go to RETURN; 689 end; 690 691 tape_attached = "0"b; 692 code = control_ptr -> backup_control.status_code (1); 693 if code ^= 0 then do; 694 buffer = control_ptr -> backup_control.error_name (1); 695 go to NO_TAPE_LOG; 696 end; 697 698 /* Delete all processed requests from queue */ 699 700 if ^remake_tape then do i = 1 to id_index; 701 call message_segment_$delete_index (mseg_index, id (i), code); 702 end; 703 704 call clean_up; 705 706 /* Send mail to requestors */ 707 708 if mail_count ^= 0 then do; 709 area_ptr = get_system_free_area_ (); 710 send_mail_info.version = 2; 711 send_mail_info.sent_from = ""; 712 unspec (send_mail_info.switches) = "0"b; 713 send_mail_info.always_add = "1"b; 714 call ioa_$rsnnl ("^a>mail_to_send", mail_dir_path, 168, queue_dir); 715 716 eptr, nptr = null; 717 on condition (cleanup) begin; 718 if eptr ^= null then free eptr -> entries in (area); 719 if nptr ^= null then free nptr -> star_names in (area); 720 end; 721 722 call hcs_$star_ (mail_dir_path, "**", 3 /* all */, area_ptr, ecount, eptr, nptr, code); 723 724 do i = 1 to ecount; 725 sender_id = star_names (entries (i).nindex); 726 call hcs_$initiate_count (mail_dir_path, sender_id, "", mail_seg_bc, 0, mail_seg_ptr, code); 727 if mail_seg_ptr ^= null then do; 728 mail_seg_len = divide (mail_seg_bc, 9, 17, 0); 729 730 call send_mail_ (sender_id, mail_seg, addr (send_mail_info), code); 731 call send_message_$notify_mail (sender_id, "", code); /* send notification */ 732 call hcs_$terminate_noname (mail_seg_ptr, code); 733 end; 734 end; 735 if eptr ^= null then free eptr -> entries in (area); 736 if nptr ^= null then free nptr -> star_names in (area); 737 end; 738 739 call ioa_ ("carry_dump: Normal termination."); 740 if error_count ^= 0 then call ioa_ ("^d request^[s^] omitted.", error_count, error_count > 1); 741 742 return; 743 /* */ 744 MAKE_BLANK_TAPE: 745 746 /* Write a tape containing only .input and no requests */ 747 748 call attach_tape_log; /* write header line in .tape_log */ 749 call ioa_$ioa_switch (tape_log_iocb, "Segment " || rtrim (tape_log_path) || " " 750 || rtrim (get_group_id_$tag_star (), ".*")); 751 call ioa_$ioa_switch (tape_log_iocb, "No requests submitted."); 752 call iox_$close (tape_log_iocb, code); 753 call iox_$detach_iocb (tape_log_iocb, code); 754 tape_log_iocb = null; 755 756 call ioa_$ioa_switch (input_iocb, "No requests submitted."); 757 call iox_$close (input_iocb, code); 758 call iox_$detach_iocb (input_iocb, code); 759 input_iocb = null; 760 761 call initialize_backup; 762 763 use_tape_number = "1"b; 764 765 control_ptr -> backup_control.request_count = 1; 766 control_ptr -> backup_control.path (1) = tape_log_path; 767 control_ptr -> backup_control.new_path (1) = ""; 768 control_ptr -> backup_control.status_code (1) = 0; 769 770 call backup_dump_ (control_ptr, code); 771 772 if code ^= 0 then do; 773 call warn (code, "carry_dump", "Tape " || rtrim (new_tape_number) || " not written."); 774 if active_function then return_string = "false"; 775 end; 776 else if control_ptr -> backup_control.status_code (1) ^= 0 then do; 777 call warn (control_ptr -> backup_control.status_code (1), 778 control_ptr -> backup_control.error_name (1), 779 "Error dumping " || rtrim (control_ptr -> backup_control.path (1)) 780 || "^/Tape " || rtrim (new_tape_number) || " not written."); 781 if active_function then return_string = "false"; 782 end; 783 else do; 784 call ioa_ ("No requests. Tape contains only ^a", tape_log_path); 785 if active_function then return_string = "true"; 786 end; 787 788 call clean_up; 789 790 return; 791 /* */ 792 carry_tape_entry: entry (tape_label); 793 794 /* This entry point, called by backup_dump_, returns carry_dump's tape_number 795* argument the first time it is called and "(another)" succeeding times. */ 796 797 dcl tape_label char (32); 798 799 if use_tape_number then tape_label = new_tape_number; 800 else tape_label = "(another)"; 801 use_tape_number = "0"b; 802 return; 803 /* */ 804 initialize_backup: proc; 805 806 /* This internal procedure allocates a control structure to drive backup_dump_ */ 807 808 call get_temp_segments_ ("carry_dump", ptrs, code); 809 if code ^= 0 then do; 810 call warn (code, "carry_dump", "Unable to allocate temp segs in process directory."); 811 go to RETURN; 812 end; 813 814 control_ptr = ptrs (1); 815 info_ptr = ptrs (2); 816 817 control_ptr -> backup_control.version = BACKUP_CONTROL_VERSION_5; 818 control_ptr -> backup_control.tape_entry = carry_tape_entry; 819 unspec (control_ptr -> backup_control.options) = "0"b; 820 control_ptr -> backup_control.debug_sw = "1"b; 821 control_ptr -> backup_control.request_count = 0; 822 823 end initialize_backup; 824 825 826 attach_tape_log: proc; 827 828 /* This internal procedure opens a tape log segment for writing and puts in a header line */ 829 830 call ioa_$rsnnl ("^a>^a.tape_log", tape_log_path, (0), queue_dir, new_tape_number); 831 call hcs_$truncate_file (tape_log_path, "", 0, code); 832 call hcs_$set_bc (tape_log_path, "", 0, code); 833 834 call iox_$attach_name ("carry_tape_log", tape_log_iocb, "vfile_ "||tape_log_path, null, code); 835 if code ^= 0 then do; 836 call warn (code, "carry_dump", "Unable to attach ""carry_tape_log"" to " || tape_log_path); 837 go to RETURN; 838 end; 839 call iox_$open (tape_log_iocb, 2, "0"b, code); 840 if code ^= 0 then do; 841 call warn (code, "carry_dump", "Unable to write " || tape_log_path); 842 go to RETURN; 843 end; 844 call iox_$put_chars (tape_log_iocb, addr (header), header_len, code); 845 if code ^= 0 then do; 846 call warn (code, "carry_dump", "Unable to write " || tape_log_path); 847 go to RETURN; 848 end; 849 850 end attach_tape_log; 851 /* */ 852 create_mail_dir: proc (a_name); 853 854 dcl a_name char (*); 855 856 /* This internal procedure deletes the old mail directory and creates a new one */ 857 858 call hcs_$status_minf (queue_dir, a_name, 1, 0, 0, code); 859 if code ^= error_table_$noentry then do; 860 dir_acl (1).access_name = cb_info.userid; 861 dir_acl (1).modes = "111"b; 862 call hcs_$add_dir_acl_entries (queue_dir, a_name, addr (dir_acl), 1, code); 863 call hcs_$del_dir_tree (queue_dir, a_name, code); 864 call hcs_$delentry_file (queue_dir, a_name, code); 865 end; 866 867 call hcs_$create_branch_ (queue_dir, a_name, addr (cb_info), code); 868 if code ^= 0 then do; 869 call ioa_$rsnnl ("^a^[>^]^a", mail_dir_path, 168, queue_dir, queue_dir ^= ">", a_name); 870 call warn (code, "carry_dump", "^/Unable to create directory " || mail_dir_path); 871 go to RETURN; 872 end; 873 874 end create_mail_dir; 875 /* */ 876 warn: proc (a_code, a_name, a_string); 877 878 /* This internal procedure prints an error message on error_output without signalling 879* in the case of an active function. In the case of a command, it calls com_err_. 880* We don't want active function error messages to abort exec_com's. */ 881 882 dcl a_code fixed bin (35); 883 dcl (a_name, a_string) char (*); 884 885 if active_function then do; 886 if a_name = "" then a_name = "carry_dump"; 887 if a_code = 0 then call ioa_$ioa_switch (iox_$error_output, "^a: " || a_string, a_name); 888 else do; 889 call convert_status_code_ (a_code, "", err_string); 890 call ioa_$ioa_switch (iox_$error_output, "^a: ^a " || a_string, a_name, err_string); 891 end; 892 end; 893 894 else if a_name = "" then call com_err_$suppress_name (a_code, "carry_dump", a_string); 895 else call com_err_ (a_code, a_name, a_string); 896 897 end warn; 898 899 900 clean_up: proc; 901 902 if tape_attached then do; 903 call iox_$find_iocb ("bk_output_1", bk_iocb, code); 904 call iox_$close (bk_iocb, code); 905 call iox_$detach_iocb (bk_iocb, code); 906 end; 907 if input_iocb ^= null then do; 908 call iox_$close (input_iocb, code); 909 call iox_$detach_iocb (input_iocb, code); 910 end; 911 if tape_log_iocb ^= null then do; 912 call iox_$close (tape_log_iocb, code); 913 call iox_$detach_iocb (tape_log_iocb, code); 914 end; 915 if control_ptr ^= null then call release_temp_segments_ ("carry_dump", ptrs, code); 916 917 if mseg_index ^= 0 then call message_segment_$close (mseg_index, code); 918 919 if id_ptr ^= null then free id in (area); 920 921 end clean_up; 922 923 924 end carry_dump; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/15/89 0800.0 carry_dump.pl1 >special_ldd>install>MR12.3-1025>carry_dump.pl1 43 1 11/21/83 1219.2 backup_control.incl.pl1 >ldd>include>backup_control.incl.pl1 100 2 11/22/82 0955.6 branch_status.incl.pl1 >ldd>include>branch_status.incl.pl1 103 3 03/15/89 0759.4 create_branch_info.incl.pl1 >special_ldd>install>MR12.3-1025>create_branch_info.incl.pl1 106 4 05/17/82 1411.5 mseg_return_args.incl.pl1 >ldd>include>mseg_return_args.incl.pl1 109 5 04/27/78 1504.4 send_mail_info.incl.pl1 >ldd>include>send_mail_info.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. BACKUP_CONTROL_VERSION_5 000000 constant char(8) initial packed unaligned dcl 1-60 ref 817 SP_HT constant char(2) initial packed unaligned dcl 50 ref 597 597 a_code parameter fixed bin(35,0) dcl 882 set ref 876 887 889* 894* 895* a_name parameter char packed unaligned dcl 854 in procedure "create_mail_dir" set ref 852 858* 862* 863* 864* 867* 869* a_name parameter char packed unaligned dcl 883 in procedure "warn" set ref 876 886 886* 887* 890* 894 895* a_string parameter char packed unaligned dcl 883 set ref 876 887 890 894* 895* absolute_pathname_ 000040 constant entry external dcl 123 ref 419 access_class 20 001657 automatic bit(72) level 2 packed packed unaligned dcl 104 set ref 484* access_name 001737 automatic char(32) array level 2 dcl 110 set ref 860* active_fnc_err_ 000042 constant entry external dcl 124 ref 196 427 active_fnc_err_$suppress_name 000044 constant entry external dcl 124 ref 181 402 active_function 001534 automatic bit(1) dcl 72 set ref 178* 179* 181 196 223 240 399* 400* 402 427 570 686 774 781 785 885 addr builtin function dcl 171 ref 236 236 273 273 298 298 373 373 378 378 387 387 454 454 462 505 505 512 545 545 552 552 730 730 844 844 862 862 867 867 always_add 11(02) 001725 automatic bit(1) level 3 packed packed unaligned dcl 5-5 set ref 713* area based area(1024) dcl 78 ref 265 285 289 315 319 718 719 735 736 919 area_ptr 001570 automatic pointer dcl 82 set ref 235* 236* 265 273* 279 285 289 315 319 378* 709* 718 719 722* 735 736 919 arg based char packed unaligned dcl 57 set ref 192 192 192 196* 197* 202 207* 209* 415 415 415 419* 421* 427* 428* 432 436 arg_count 001616 automatic fixed bin(17,0) dcl 86 set ref 177* 180 190 398* 401 411 arg_len 001617 automatic fixed bin(17,0) dcl 86 set ref 191* 192 192 192 196 196 197 197 202 207 207 209 209 413* 415 415 415 418* 419 419 421 421 427 427 428 428 432 436 arg_ptr 001572 automatic pointer dcl 82 set ref 191* 192 192 192 196 197 202 207 209 413* 415 415 415 418* 419 421 427 428 432 436 atime 001510 automatic char(24) packed unaligned dcl 63 set ref 296* 297* 469* 470* backup_control based structure level 1 dcl 1-8 backup_dump_ 000046 constant entry external dcl 125 ref 560 682 770 bitcnt 16 001657 automatic fixed bin(24,0) level 2 dcl 104 set ref 487* bk_iocb 001552 automatic pointer initial dcl 80 set ref 80* 903* 904* 905* branch_status 001645 automatic structure level 1 dcl 2-1 set ref 273 273 buffer 000630 automatic char(500) packed unaligned dcl 60 set ref 361* 365* 369* 373 373 387 387 387 387 454 454 454 454 462 505 505 505 505 512 545 545 545 545 546 547 552 552 552 552 610* 612* 628* 630* 640* 642* 685* 687* 694* buffer_len 001620 automatic fixed bin(17,0) dcl 86 set ref 361* 365* 369 370* 370 373* 505* 513 545* 547 552* 610* 628* 640* cb_info 001657 automatic structure level 1 unaligned dcl 104 set ref 867 867 cleanup 001752 stack reference condition dcl 173 ref 231 717 clock_ 000050 constant entry external dcl 127 ref 296 296 469 469 code 001644 automatic fixed bin(35,0) dcl 92 set ref 177* 178 191* 195* 196* 197* 207* 208 209* 225* 227* 236* 237 240 244* 249* 250* 251* 252 253* 256* 257 258* 273* 274 275* 290* 298* 299 300* 308* 310 357* 358 373* 378* 380 380 385* 387* 388 389* 398* 399 413* 418* 419* 420 421* 426* 427* 428* 445* 446 448* 449 450* 454* 455 456* 505* 507 544* 545* 552* 560* 562 563 565* 612* 613* 630* 631* 633* 634* 642* 643* 654* 666* 667* 682* 684 687* 692* 693 701* 722* 726* 730* 731* 732* 752* 753* 757* 758* 770* 772 773* 808* 809 810* 831* 832* 834* 835 836* 839* 840 841* 844* 845 846* 858* 859 862* 863* 864* 867* 868 870* 903* 904* 905* 908* 909* 912* 913* 915* 917* com_err_ 000052 constant entry external dcl 128 ref 197 243 421 428 895 com_err_$suppress_name 000054 constant entry external dcl 128 ref 183 404 894 control_ptr 001612 automatic pointer initial dcl 84 set ref 84* 496 497 498 509 510 526 529 542 547 550 558 560* 578 580 586 588 590 592 594 602 602 602 618 619 644 644 653 654 655 655 660 673 674 675 676 677 678 682* 692 694 765 766 767 768 770* 776 777 777 777 814* 817 818 819 820 821 915 convert_status_code_ 000056 constant entry external dcl 129 ref 590 618 889 create_branch_info based structure level 1 dcl 3-17 create_branch_version_2 constant fixed bin(17,0) initial dcl 3-35 ref 480 cu_$af_return_arg 000060 constant entry external dcl 130 ref 177 398 cu_$arg_ptr 000062 constant entry external dcl 131 ref 191 413 418 date_time_ 000064 constant entry external dcl 132 ref 296 469 debug_sw 36(01) based bit(1) level 4 packed packed unaligned dcl 1-8 set ref 820* destination 001516 automatic char(23) packed unaligned dcl 64 set ref 270* 297* 465* 470* 646* dir_acl 001737 automatic structure array level 1 dcl 110 set ref 862 862 dir_quota 22 001657 automatic fixed bin(18,0) level 2 dcl 104 set ref 487* dir_sw 1 001657 automatic bit(1) level 3 packed packed unaligned dcl 104 set ref 482* divide builtin function dcl 171 ref 326 728 dn 000234 automatic char(168) packed unaligned dcl 54 set ref 544* 654* 655* ecount 001621 automatic fixed bin(17,0) dcl 86 set ref 718 722* 724 735 en 001450 automatic char(32) packed unaligned dcl 62 set ref 544* 547 654* entries based structure array level 1 dcl 94 ref 718 735 eptr 001562 automatic pointer initial dcl 81 set ref 81* 716* 718 718 722* 725 735 735 err_string 001417 automatic char(100) packed unaligned dcl 61 set ref 590* 596 618* 619* 889* 890* error_count 001622 automatic fixed bin(17,0) dcl 86 set ref 576* 601* 601 740 740* 740 error_name 170 based char(65) array level 3 packed packed unaligned dcl 1-8 set ref 588 594 602* 619* 694 777* error_table_$badopt 000022 external static fixed bin(35,0) dcl 115 ref 195 426 error_table_$end_of_info 000024 external static fixed bin(35,0) dcl 116 ref 507 error_table_$entlong 000026 external static fixed bin(35,0) dcl 117 set ref 216* error_table_$no_message 000030 external static fixed bin(35,0) dcl 118 ref 240 380 error_table_$noentry 000032 external static fixed bin(35,0) dcl 119 ref 859 error_table_$not_act_fnc 000034 external static fixed bin(35,0) dcl 120 ref 178 399 error_table_$not_attached 000036 external static fixed bin(35,0) dcl 121 ref 563 expand_pathname_ 000066 constant entry external dcl 133 ref 207 544 654 fixed builtin function dcl 171 ref 280 force_sw 001542 automatic bit(1) dcl 75 set ref 188* 192* 237 get_group_id_ 000070 constant entry external dcl 134 ref 486 500 get_group_id_$tag_star 000072 constant entry external dcl 135 ref 749 get_system_free_area_ 000074 constant entry external dcl 136 ref 235 709 get_temp_segments_ 000076 constant entry external dcl 137 ref 808 got_new_number 001537 automatic bit(1) dcl 74 set ref 409* 435 437* 442 got_number 001536 automatic bit(1) dcl 74 set ref 409* 431 433* 441 got_queue 001540 automatic bit(1) dcl 74 set ref 188* 205 206* got_tape 001541 automatic bit(1) dcl 74 set ref 188* 200 201* hcs_$add_dir_acl_entries 000100 constant entry external dcl 138 ref 862 hcs_$create_branch_ 000102 constant entry external dcl 139 ref 867 hcs_$del_dir_tree 000104 constant entry external dcl 140 ref 863 hcs_$delentry_file 000106 constant entry external dcl 141 ref 864 hcs_$initiate_count 000110 constant entry external dcl 142 ref 726 hcs_$set_bc 000112 constant entry external dcl 143 ref 250 832 hcs_$star_ 000114 constant entry external dcl 144 ref 722 hcs_$status_ 000116 constant entry external dcl 145 ref 273 hcs_$status_minf 000120 constant entry external dcl 146 ref 357 858 hcs_$terminate_noname 000122 constant entry external dcl 147 ref 732 hcs_$truncate_file 000124 constant entry external dcl 148 ref 249 831 header based structure level 2 in structure "backup_control" dcl 1-8 in procedure "carry_dump" header 001025 automatic char(500) packed unaligned dcl 60 in procedure "carry_dump" set ref 297* 298 298 470* 844 844 header_len 001623 automatic fixed bin(17,0) dcl 86 set ref 297* 298* 470* 844* hold_sw 36(03) based bit(1) level 4 packed packed unaligned dcl 1-8 set ref 558* 678* i 001626 automatic fixed bin(17,0) dcl 87 set ref 190* 191* 268* 269 269 270 283* 284 284 411* 413* 417* 417 418* 463* 464 465 530* 531 532 533 537* 538 540 546* 547 547 578* 580 581 582 586 588 590 592 594 602 602 602 618 619 626 639 644 644 652 653 654 655 655 660* 700* 701* 724* 725* id based bit(72) array dcl 69 set ref 265 315 317* 317 319 322* 701* 919 id_index 001624 automatic fixed bin(17,0) dcl 86 set ref 266* 312* 312 313 316 322 330* 330 700 id_limit 001625 automatic fixed bin(17,0) dcl 86 set ref 264* 265 313 314* 314 315 319 919 id_ptr 001566 automatic pointer initial dcl 81 set ref 81* 265* 317 319 320* 322 701 919 919 index builtin function dcl 171 ref 268 283 337 349 463 464 530 537 546 584 info_ptr 001614 automatic pointer initial dcl 84 set ref 84* 499 500 501 521 524 532 535 538 539 581 582 626 652 815* input_iocb 001554 automatic pointer initial dcl 80 set ref 80* 251* 256* 298* 373* 375* 385* 387* 445* 448* 454* 505* 545* 552* 756* 757* 758* 759* 907 908* 909* input_path 000306 automatic char(168) packed unaligned dcl 54 set ref 248* 249* 250* 251 253 258 300 389 444* 445 450 456 497 ioa_ 000126 constant entry external dcl 149 ref 739 740 784 ioa_$ioa_switch 000130 constant entry external dcl 150 ref 240 375 614 616 619 632 646 655 660 749 751 756 887 890 ioa_$rs 000132 constant entry external dcl 151 ref 297 361 365 470 ioa_$rsnnl 000134 constant entry external dcl 152 ref 248 444 489 610 628 640 714 830 869 iox_$attach_name 000136 constant entry external dcl 153 ref 251 445 612 630 642 834 iox_$close 000140 constant entry external dcl 154 ref 633 666 752 757 904 908 912 iox_$detach_iocb 000142 constant entry external dcl 155 ref 634 667 753 758 905 909 913 iox_$error_output 000144 external static pointer dcl 156 set ref 240* 887* 890* iox_$find_iocb 000146 constant entry external dcl 157 ref 903 iox_$get_line 000150 constant entry external dcl 158 ref 387 454 505 545 552 iox_$open 000152 constant entry external dcl 159 ref 256 448 613 631 643 839 iox_$position 000154 constant entry external dcl 160 ref 385 iox_$put_chars 000156 constant entry external dcl 161 ref 298 373 844 j 001627 automatic fixed bin(17,0) dcl 87 set ref 213* 214 214 214 219 281* 282* 316* 317 317* 337* 338 339 340 349* 350 351 352 464* 465 465 length builtin function dcl 171 ref 213 214 387 387 454 454 505 505 536 545 545 552 552 584 line based char packed unaligned dcl 56 ref 327 328 332 337 339 343 349 351 356 356 357 361 361 365 365 463 464 465 514 515 520 525 530 532 536 537 538 539 540 line_len 001630 automatic fixed bin(17,0) dcl 87 set ref 326* 327 327 327* 327 328 328 329* 329 332 332 334* 334 337 339 340* 343 343 345* 345 349 351 352* 356 356 357 361 361 361 361 365 365 365 365 387* 454* 463 464 465 513* 514 514 514* 514 515 515 517* 517 520 520 522* 522 525 525 527* 527 530 532 533* 536* 536 536 537 537 537 538 539 540 line_ptr 001574 automatic pointer dcl 82 set ref 325* 327 328 332 337 339 343 349 351 356 356 357 361 361 365 365 462* 463 464 465 512* 514 515 520 525 530 532 536 537 538 539 540 mail_count 001631 automatic fixed bin(17,0) dcl 87 set ref 576* 609* 609 627* 627 708 mail_dir_path 000360 automatic char(168) packed unaligned dcl 54 set ref 489* 676 714* 722* 726* 869* 870 mail_iocb 001556 automatic pointer initial dcl 80 set ref 80* 612* 613* 614* 616* 619* 630* 631* 632* 633* 634* 642* 643* 646* 665 666* 667* mail_seg based char packed unaligned dcl 59 set ref 730* mail_seg_bc 001643 automatic fixed bin(24,0) dcl 91 set ref 726* 728 mail_seg_len 001632 automatic fixed bin(17,0) dcl 87 set ref 728* 730 730 mail_seg_ptr 001576 automatic pointer dcl 82 set ref 726* 727 730 732* mbz2 2(03) 001657 automatic bit(33) level 2 packed packed unaligned dcl 104 set ref 484* message_segment_$close 000160 constant entry external dcl 162 ref 917 message_segment_$delete_index 000162 constant entry external dcl 163 ref 701 message_segment_$incremental_read_index 000164 constant entry external dcl 164 ref 378 message_segment_$open 000166 constant entry external dcl 165 ref 225 message_segment_$read_index 000170 constant entry external dcl 166 ref 236 mode 2 001657 automatic bit(3) level 2 packed packed unaligned dcl 104 set ref 483* modes 10 001737 automatic bit(36) array level 2 dcl 110 set ref 861* ms_id 14 001702 automatic bit(72) level 2 packed packed unaligned dcl 107 set ref 322 378* ms_len 2 001702 automatic fixed bin(24,0) level 2 dcl 107 set ref 326 ms_ptr 001702 automatic pointer level 2 dcl 107 set ref 325 mseg_args 001702 automatic structure level 1 unaligned dcl 107 set ref 236 236 378 378 mseg_dir 000100 automatic char(168) initial packed unaligned dcl 51 set ref 51* 207* 212 225* 227 240* 243* 244 273* 275 mseg_index 001636 automatic fixed bin(17,0) initial dcl 88 set ref 88* 225* 226 236* 378* 701* 917 917* mseg_name 000224 automatic char(32) initial packed unaligned dcl 52 set ref 52* 207* 213 213 214 214 216 219* 225* 227 240* 243* 244 268 269 270 273* 275 282* 283 284 mseg_return_args based structure level 1 dcl 4-9 names based char(32) array packed unaligned dcl 101 ref 282 285 289 names_count 001633 automatic fixed bin(17,0) dcl 87 set ref 280* 281 285 289 names_ptr 001600 automatic pointer dcl 82 set ref 279* 282 285 289 names_rel_pointer 0(18) 001645 automatic bit(18) level 2 packed packed unaligned dcl 2-1 set ref 279 new_dir_path 000504 automatic char(168) packed unaligned dcl 54 set ref 339* 342* 368 375 375* new_dir_sw 001543 automatic bit(1) dcl 75 set ref 516* 519* 543 new_id_ptr 001602 automatic pointer dcl 82 set ref 315* 317 320 new_path 112 based char(168) array level 3 packed packed unaligned dcl 1-8 set ref 498* 547* 550* 644 644 653 654* 675* 677* 767* new_tape_number 000010 internal static char(32) packed unaligned dcl 66 set ref 202* 436* 442* 470* 563 616* 632* 646* 773 777 799 830* new_user 10 based char(32) array level 2 dcl 44 set ref 501* 532* 535* 652 new_user_id 001460 automatic char(32) packed unaligned dcl 62 set ref 351* 354* 361 361* 365 365* 652* 655 655* 660 660* newline 013240 constant char(1) initial packed unaligned dcl 67 ref 327 369 514 nindex 0(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 94 ref 725 no_primary_sw 164 based bit(1) array level 4 packed packed unaligned dcl 1-8 set ref 510* no_requests 001544 automatic bit(1) dcl 75 set ref 188* 237* 304 notify 30 based bit(1) array level 2 dcl 44 set ref 521* 524* 626 notify_sw 001545 automatic bit(1) dcl 75 set ref 333* 336* 361* 365* nptr 001564 automatic pointer initial dcl 81 set ref 81* 716* 719 719 722* 725 736 736 null builtin function dcl 171 ref 80 80 80 80 81 81 81 84 84 251 251 445 445 612 612 630 630 642 642 665 716 718 719 727 735 736 754 759 834 834 907 911 915 919 number_names 0(02) 001645 automatic bit(16) level 2 packed packed unaligned dcl 2-1 set ref 280 options 36 based structure level 3 dcl 1-8 set ref 819* parent_ac_sw 1(04) 001657 automatic bit(1) level 3 packed packed unaligned dcl 104 set ref 482* path 000432 automatic char(168) packed unaligned dcl 54 in procedure "carry_dump" set ref 540* 542 544* 580* 616* 632* 644* 646* 660* path 40 based char(168) array level 3 in structure "backup_control" packed packed unaligned dcl 1-8 in procedure "carry_dump" set ref 497* 542* 580 592 602* 655* 674* 676* 766* 777 ptr builtin function dcl 171 ref 279 ptrs 001606 automatic pointer array dcl 83 set ref 808* 814 815 915* queue_dir 000152 automatic char(168) initial packed unaligned dcl 51 set ref 51* 212* 248* 419* 444* 489* 610* 628* 640* 714* 830* 858* 862* 863* 864* 867* 869* 869 quota 17 001657 automatic fixed bin(18,0) level 2 dcl 104 set ref 487* release_temp_segments_ 000172 constant entry external dcl 167 ref 915 remake_tape 001535 automatic bit(1) dcl 73 set ref 175* 396* 700 request_count 37 based fixed bin(17,0) level 3 dcl 1-8 set ref 496* 509* 578 673* 765* 821* request_index 001634 automatic fixed bin(17,0) dcl 87 set ref 496* 509 509* 510 521 524 526 529 532 535 538 539 542 547 550 request_info based structure array level 1 dcl 44 requests 40 based structure array level 2 dcl 1-8 return_len 001635 automatic fixed bin(17,0) dcl 87 set ref 177* 223 398* 570 686 774 781 785 return_ptr 001604 automatic pointer dcl 82 set ref 177* 223 398* 570 686 774 781 785 return_string based varying char dcl 58 set ref 223* 570* 686* 774* 781* 785* reverse builtin function dcl 171 ref 213 464 537 584 rings 3 001657 automatic fixed bin(3,0) array level 2 dcl 104 set ref 485* rings7 001640 automatic fixed bin(3,0) initial array dcl 90 set ref 90* 90* 90* 485 rtrim builtin function dcl 171 ref 216 227 244 275 536 563 593 594 595 596 597 597 687 749 749 773 777 777 send_mail_ 000174 constant entry external dcl 168 ref 730 send_mail_info 001725 automatic structure level 1 dcl 5-5 set ref 730 730 send_mail_info_version_2 001724 automatic fixed bin(17,0) initial dcl 5-3 set ref 5-3* send_message_$notify_mail 000176 constant entry external dcl 169 ref 731 sender based char(32) array level 2 dcl 44 set ref 500* 538* 582 sender_id 001470 automatic char(32) packed unaligned dcl 62 in procedure "carry_dump" set ref 324* 361* 365* 582* 584* 584 584 584 610* 628* 640* 655* 660* 725* 726* 730* 731* sender_id 3 001702 automatic char(32) level 2 in structure "mseg_args" packed packed unaligned dcl 107 in procedure "carry_dump" set ref 324 sent_from 1 001725 automatic char(32) level 2 dcl 5-5 set ref 711* star_names based char(32) array dcl 99 ref 719 725 736 status_code 167 based fixed bin(35,0) array level 3 dcl 1-8 set ref 586 590* 602* 618* 692 768* 776 777* substr builtin function dcl 171 set ref 192 214 219* 269 270 284 327 328 332 339 343 351 356 356 361 361 365 365 369* 415 464 465 514 515 520 525 532 536 537 538 539 540 547 584 588 594 switches 164 based structure array level 3 in structure "backup_control" dcl 1-8 in procedure "carry_dump" switches 11 001725 automatic structure level 2 in structure "send_mail_info" dcl 5-5 in procedure "carry_dump" set ref 712* switches 1 001657 automatic structure level 2 in structure "cb_info" packed packed unaligned dcl 104 in procedure "carry_dump" set ref 481* tape_attached 001550 automatic bit(1) initial dcl 76 set ref 76* 557* 569* 680* 691* 902 tape_entry 2 based entry variable level 3 dcl 1-8 set ref 818* tape_label parameter char(32) packed unaligned dcl 797 set ref 792 799* 800* tape_log_iocb 001560 automatic pointer initial dcl 80 set ref 80* 655* 660* 749* 751* 752* 753* 754* 834* 839* 844* 911 912* 913* tape_log_path 000556 automatic char(168) packed unaligned dcl 54 set ref 674 687 749 766 784* 830* 831* 832* 834 836 841 846 tape_number 001524 automatic char(32) packed unaligned dcl 65 set ref 202* 248* 297* 432* 442 444* trim_sw 164(01) based bit(1) array level 4 in structure "backup_control" packed packed unaligned dcl 1-8 in procedure "carry_dump" set ref 526* 529* 655* 660* trim_sw 001546 automatic bit(1) dcl 75 in procedure "carry_dump" set ref 344* 347* 361* 365* type 001637 automatic fixed bin(2,0) dcl 89 set ref 357* 359 type_str 001500 automatic char(32) packed unaligned dcl 62 set ref 359* 360* 361* 581* 646* 655* 660* type_string 20 based char(32) array level 2 dcl 44 set ref 499* 539* 581 unspec builtin function dcl 171 set ref 481* 712* 819* use_tape_number 000020 internal static bit(1) dcl 71 set ref 476* 680* 763* 799 801* userid 6 001657 automatic char(32) level 2 packed packed unaligned dcl 104 set ref 486* 860 verify builtin function dcl 171 ref 213 version based char(8) level 3 in structure "backup_control" packed packed unaligned dcl 1-8 in procedure "carry_dump" set ref 817* version 001725 automatic fixed bin(17,0) level 2 in structure "send_mail_info" dcl 5-5 in procedure "carry_dump" set ref 710* version 001657 automatic fixed bin(17,0) level 2 in structure "cb_info" dcl 104 in procedure "carry_dump" set ref 480* warn_subtree_sw 001547 automatic bit(1) dcl 75 set ref 589* 600* 614 warning_msg 001222 automatic char(500) packed unaligned dcl 60 set ref 592* 593* 593 594* 594 595* 595 596* 596 597 597 614 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. backup_control_ptr automatic pointer dcl 1-56 backup_control_request_count automatic fixed bin(17,0) dcl 1-58 backup_util$get_real_name 000000 constant entry external dcl 126 directory_type internal static bit(2) initial dcl 2-1 link_type internal static bit(2) initial dcl 2-1 ms_arg_ptr automatic pointer dcl 4-7 msf_type internal static bit(2) initial dcl 2-1 segment_type internal static bit(2) initial dcl 2-1 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 005031 constant label dcl 472 ref 392 GET_DS 002503 constant label dcl 270 ref 286 INPUT_ERROR 002343 constant label dcl 253 ref 446 MAKE_BLANK_TAPE 010326 constant label dcl 744 set ref 304 MSEG_ERROR 001774 constant label dcl 240 ref 380 NEXT 003650 constant label dcl 378 ref 358 NO_DS 002553 constant label dcl 275 ref 291 NO_TAPE_LOG 007542 constant label dcl 686 ref 695 RETURN 002155 constant label dcl 245 ref 254 259 277 301 390 451 457 566 688 811 837 842 847 871 USAGE 001076 constant label dcl 181 ref 205 USAGE2 004044 constant label dcl 402 ref 435 441 attach_tape_log 011224 constant entry internal dcl 826 ref 474 744 carry_dump 001040 constant entry external dcl 11 carry_tape_entry 011076 constant entry external dcl 792 ref 818 clean_up 012377 constant entry internal dcl 900 ref 231 245 704 788 create_mail_dir 011576 constant entry internal dcl 852 ref 491 492 initialize_backup 011124 constant entry internal dcl 804 ref 472 761 remake_carry_tape 004005 constant entry external dcl 394 warn 012131 constant entry internal dcl 876 ref 209 216 227 244 253 258 275 300 389 450 456 563 565 597 602 687 773 777 810 836 841 846 870 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 14110 14310 13244 14120 Length 15012 13244 200 466 643 12 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME carry_dump 1618 external procedure is an external procedure. on unit on line 231 64 on unit on unit on line 717 64 on unit initialize_backup internal procedure shares stack frame of external procedure carry_dump. attach_tape_log internal procedure shares stack frame of external procedure carry_dump. create_mail_dir internal procedure shares stack frame of external procedure carry_dump. warn 102 internal procedure is called during a stack extension. clean_up 82 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 new_tape_number carry_dump 000020 use_tape_number carry_dump STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME carry_dump 000100 mseg_dir carry_dump 000152 queue_dir carry_dump 000224 mseg_name carry_dump 000234 dn carry_dump 000306 input_path carry_dump 000360 mail_dir_path carry_dump 000432 path carry_dump 000504 new_dir_path carry_dump 000556 tape_log_path carry_dump 000630 buffer carry_dump 001025 header carry_dump 001222 warning_msg carry_dump 001417 err_string carry_dump 001450 en carry_dump 001460 new_user_id carry_dump 001470 sender_id carry_dump 001500 type_str carry_dump 001510 atime carry_dump 001516 destination carry_dump 001524 tape_number carry_dump 001534 active_function carry_dump 001535 remake_tape carry_dump 001536 got_number carry_dump 001537 got_new_number carry_dump 001540 got_queue carry_dump 001541 got_tape carry_dump 001542 force_sw carry_dump 001543 new_dir_sw carry_dump 001544 no_requests carry_dump 001545 notify_sw carry_dump 001546 trim_sw carry_dump 001547 warn_subtree_sw carry_dump 001550 tape_attached carry_dump 001552 bk_iocb carry_dump 001554 input_iocb carry_dump 001556 mail_iocb carry_dump 001560 tape_log_iocb carry_dump 001562 eptr carry_dump 001564 nptr carry_dump 001566 id_ptr carry_dump 001570 area_ptr carry_dump 001572 arg_ptr carry_dump 001574 line_ptr carry_dump 001576 mail_seg_ptr carry_dump 001600 names_ptr carry_dump 001602 new_id_ptr carry_dump 001604 return_ptr carry_dump 001606 ptrs carry_dump 001612 control_ptr carry_dump 001614 info_ptr carry_dump 001616 arg_count carry_dump 001617 arg_len carry_dump 001620 buffer_len carry_dump 001621 ecount carry_dump 001622 error_count carry_dump 001623 header_len carry_dump 001624 id_index carry_dump 001625 id_limit carry_dump 001626 i carry_dump 001627 j carry_dump 001630 line_len carry_dump 001631 mail_count carry_dump 001632 mail_seg_len carry_dump 001633 names_count carry_dump 001634 request_index carry_dump 001635 return_len carry_dump 001636 mseg_index carry_dump 001637 type carry_dump 001640 rings7 carry_dump 001643 mail_seg_bc carry_dump 001644 code carry_dump 001645 branch_status carry_dump 001657 cb_info carry_dump 001702 mseg_args carry_dump 001724 send_mail_info_version_2 carry_dump 001725 send_mail_info carry_dump 001737 dir_acl carry_dump THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_ne_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return_mac enable_op shorten_stack ext_entry int_entry int_entry_desc set_chars_eis index_chars_eis op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ active_fnc_err_ active_fnc_err_$suppress_name backup_dump_ clock_ com_err_ com_err_$suppress_name convert_status_code_ cu_$af_return_arg cu_$arg_ptr date_time_ expand_pathname_ get_group_id_ get_group_id_$tag_star get_system_free_area_ get_temp_segments_ hcs_$add_dir_acl_entries hcs_$create_branch_ hcs_$del_dir_tree hcs_$delentry_file hcs_$initiate_count hcs_$set_bc hcs_$star_ hcs_$status_ hcs_$status_minf hcs_$terminate_noname hcs_$truncate_file ioa_ ioa_$ioa_switch ioa_$rs ioa_$rsnnl iox_$attach_name iox_$close iox_$detach_iocb iox_$find_iocb iox_$get_line iox_$open iox_$position iox_$put_chars message_segment_$close message_segment_$delete_index message_segment_$incremental_read_index message_segment_$open message_segment_$read_index release_temp_segments_ send_mail_ send_message_$notify_mail THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$end_of_info error_table_$entlong error_table_$no_message error_table_$noentry error_table_$not_act_fnc error_table_$not_attached iox_$error_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 51 000773 52 001001 76 001004 80 001005 81 001012 84 001015 88 001017 90 001020 5 3 001033 11 001037 175 001046 177 001047 178 001064 179 001072 180 001074 181 001076 183 001132 185 001163 188 001164 190 001170 191 001177 192 001214 195 001235 196 001240 197 001300 198 001335 199 001336 200 001337 201 001341 202 001343 203 001357 205 001361 206 001363 207 001365 208 001415 209 001417 210 001446 212 001447 213 001452 214 001467 216 001500 217 001553 219 001555 221 001561 223 001563 225 001576 226 001623 227 001625 228 001707 231 001711 235 001733 236 001742 237 001765 240 001774 243 002032 244 002073 245 002155 246 002162 248 002163 249 002221 250 002247 251 002275 252 002341 253 002343 254 002375 256 002376 257 002417 258 002421 259 002453 264 002454 265 002456 266 002464 268 002465 269 002476 270 002503 271 002510 273 002511 274 002551 275 002553 277 002645 279 002647 280 002654 281 002660 282 002667 283 002675 284 002706 285 002713 286 002717 288 002720 289 002722 290 002726 291 002727 296 002730 297 002754 298 003014 299 003033 300 003035 301 003067 304 003070 308 003072 310 003073 312 003076 313 003077 314 003102 315 003104 316 003112 317 003123 318 003133 319 003135 320 003141 322 003143 324 003152 325 003155 326 003157 327 003163 328 003172 329 003177 330 003201 332 003203 333 003210 334 003212 335 003214 336 003215 337 003216 338 003225 339 003226 340 003236 341 003241 342 003242 343 003245 344 003252 345 003254 346 003256 347 003257 349 003260 350 003267 351 003270 352 003300 353 003303 354 003304 356 003307 357 003317 358 003366 359 003371 360 003400 361 003403 364 003474 365 003476 368 003563 369 003570 370 003577 373 003601 375 003620 378 003650 380 003675 381 003702 385 003703 387 003723 388 003746 389 003750 390 004002 392 004003 394 004004 396 004013 398 004015 399 004032 400 004040 401 004042 402 004044 404 004102 406 004135 409 004136 411 004140 413 004147 415 004164 417 004202 418 004203 419 004220 420 004244 421 004246 422 004306 424 004307 426 004310 427 004313 428 004355 429 004414 430 004415 431 004416 432 004420 433 004424 434 004426 435 004427 436 004431 437 004436 440 004440 441 004442 442 004444 444 004452 445 004510 446 004554 448 004556 449 004577 450 004601 451 004633 454 004634 455 004657 456 004661 457 004713 462 004714 463 004716 464 004725 465 004737 469 004745 470 004771 472 005031 474 005032 476 005033 480 005036 481 005040 482 005041 483 005045 484 005047 485 005054 486 005060 487 005066 489 005071 491 005125 492 005136 496 005146 497 005152 498 005155 499 005160 500 005164 501 005177 505 005202 507 005225 509 005232 510 005237 512 005242 513 005244 514 005247 515 005255 516 005262 517 005264 518 005266 519 005267 520 005270 521 005275 522 005302 523 005304 524 005305 525 005311 526 005316 527 005321 528 005323 529 005324 530 005327 531 005336 532 005337 533 005354 534 005357 535 005360 536 005366 537 005400 538 005416 539 005430 540 005434 542 005441 543 005445 544 005447 545 005472 546 005515 547 005525 549 005562 550 005564 552 005570 553 005613 557 005614 558 005616 560 005621 562 005631 563 005633 565 005722 566 005752 569 005753 570 005754 576 005767 578 005771 580 006001 581 006007 582 006017 584 006024 586 006043 588 006047 589 006056 590 006060 592 006103 593 006123 594 006152 595 006211 596 006240 597 006267 598 006333 600 006335 601 006336 602 006337 609 006365 610 006366 612 006422 613 006460 614 006501 616 006527 618 006557 619 006605 622 006641 626 006642 627 006646 628 006647 630 006703 631 006741 632 006762 633 007012 634 007023 639 007034 640 007037 642 007073 643 007131 644 007152 646 007166 652 007225 653 007234 654 007245 655 007276 659 007366 660 007367 665 007450 666 007454 667 007465 669 007476 673 007500 674 007503 675 007506 676 007511 677 007514 678 007517 680 007521 682 007525 684 007535 685 007537 686 007542 687 007555 688 007633 691 007635 692 007636 693 007641 694 007642 695 007645 700 007646 701 007657 702 007674 704 007676 708 007702 709 007704 710 007713 711 007715 712 007720 713 007721 714 007723 716 007757 717 007762 718 007776 719 010005 720 010014 722 010015 724 010064 725 010073 726 010105 727 010147 728 010153 730 010156 731 010207 732 010230 734 010241 735 010243 736 010251 739 010257 740 010273 742 010325 744 010326 749 010327 751 010434 752 010455 753 010466 754 010477 756 010501 757 010521 758 010532 759 010543 761 010545 763 010546 765 010551 766 010554 767 010557 768 010562 770 010563 772 010573 773 010575 774 010660 775 010674 776 010675 777 010700 781 011016 782 011032 784 011033 785 011053 788 011066 790 011072 792 011073 799 011104 800 011115 801 011122 802 011123 804 011124 808 011125 809 011152 810 011154 811 011203 814 011204 815 011206 817 011210 818 011213 819 011217 820 011220 821 011222 823 011223 826 011224 830 011225 831 011264 832 011312 834 011340 835 011406 836 011410 837 011442 839 011443 840 011464 841 011466 842 011520 844 011521 845 011540 846 011542 847 011574 850 011575 852 011576 858 011607 859 011652 860 011656 861 011661 862 011663 863 011721 864 011744 867 011767 868 012020 869 012022 870 012074 871 012126 874 012127 876 012130 885 012151 886 012154 887 012166 888 012230 889 012231 890 012251 891 012317 892 012320 894 012321 895 012355 897 012375 900 012376 902 012404 903 012407 904 012433 905 012445 907 012457 908 012464 909 012475 911 012507 912 012514 913 012525 915 012537 917 012571 919 012605 921 012616 ----------------------------------------------------------- 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