COMPILATION LISTING OF SEGMENT check_file_system_damage Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-05-05_1823.55_Fri_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1984 * 6* * * 7* *********************************************************** */ 8 9 10 /****^ HISTORY COMMENTS: 11* 1) change(85-09-05,Spitzer), approve(85-09-05,MCR7269), 12* audit(85-09-18,Blair), install(85-12-16,MR12.0-1001): 13* 1) Fix CA detection code. 2) Add -pn CA. 14* 2) change(88-08-25,TLNguyen), approve(88-08-25,MCR7962), 15* audit(88-09-14,Parisek), install(88-09-15,MR12.2-1110): 16* Remove the check_superior_dirs internal procedure because users don't 17* generally have a status access mode on their superior directories and 18* this procedure goes beyond what this program is documented or 19* supposed to do. 20* END HISTORY COMMENTS */ 21 22 check_file_system_damage: 23 cfsd: 24 proc; 25 26 /* *********************************************************************** 27* * Command for finding damaged segments and connection failures. * 28* * This program is useful after a system crash to check the state * 29* * of the libraries and system control directories * 30* * * 31* * Coded July 1980 by Jim Homan, with thanks to Warren Johnson for * 32* * his check_dsw command. * 33* * Bug fixes installed August 1980 by Warren Johnson. * 34* *********************************************************************** */ 35 36 /* Modified 3/8/84 by C Spitzer. modify for installation per MCRB amendments */ 37 /* Modified 1/6/85 by Keith Loepere to understand "new" error code from hcs_$star_. */ 38 39 /* **************************************************************************** 40* * * 41* * Usage: * 42* * * 43* * check_file_system_damage path {-control_args} * 44* * * 45* * path is a pathname specifying what is to be checked. It * 46* * may be a starname, and -wd is accepted. * 47* * * 48* * control_args may be any of the following: * 49* * * 50* * -pathname, specifies that the next argument is to be used as a * 51* * -pn pathname rather than as a control argument. * 52* * * 53* * -subtree, if this control argument is specified, then path must * 54* * -subt be a directory. All segments in the specified directory * 55* * and all directories below the specified directory are * 56* * checked. * 57* * * 58* * -multisegment_file, * 59* * -msf if this control argument is specified, then the components * 60* * of MSFs are checked. This is the default. * 61* * * 62* * -no_multisegment_file, * 63* * -no_msf, turns off checking of MSF. * 64* * * 65* * -brief, bf if this control argument is specified, then error * 66* * messages about incorrect access to directories and no star * 67* * name matches are suppressed. * 68* * * 69* * -call STR STR is a command to be executed for each segment which * 70* * is damaged. For each damaged segment, the command * 71* * executed is "STR path damaged". For each connection * 72* * failure, the executed is "STR path connection_failure". * 73* * The default action, when -call is not specified, is to * 74* * print out an error message for each damaged segment and * 75* * each connection failure. * 76* **************************************************************************** */ 77 78 /* external entries */ 79 80 dcl active_fnc_err_ entry options (variable); 81 dcl check_star_name_$entry entry (char (*), fixed (35)); 82 dcl com_err_ entry options (variable); 83 dcl cu_$af_return_arg entry (fixed, ptr, fixed (21), fixed (35)); 84 dcl cu_$arg_count entry returns (fixed); 85 dcl cu_$arg_ptr entry (fixed, ptr, fixed, fixed (35)); 86 dcl cu_$cp entry (ptr, fixed, fixed (35)); 87 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 88 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed (35)); 89 dcl get_system_free_area_ entry returns (ptr); 90 dcl get_wdir_ entry () returns (char (168)); 91 dcl hcs_$star_ entry (char (*), char (*), fixed (2), ptr, fixed, ptr, ptr, fixed (35)); 92 dcl hcs_$status_long entry (char (*), char (*), fixed (1), ptr, ptr, fixed (35)); 93 dcl ioa_ entry options (variable); 94 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 95 96 /* external static */ 97 98 dcl error_table_$bad_arg fixed (35) bin external static; 99 dcl error_table_$badopt fixed (35) bin external static; 100 dcl error_table_$inconsistent fixed (35) bin external static; 101 dcl error_table_$logical_volume_not_defined fixed (35) bin external static; 102 dcl error_table_$moderr fixed (35) bin external static; 103 dcl error_table_$noarg fixed (35) bin external static; 104 dcl error_table_$nomatch fixed (35) bin external static; 105 dcl error_table_$too_many_args fixed (35) bin external static; 106 dcl error_table_$vtoce_connection_fail fixed (35) bin external static; 107 108 /* internal static */ 109 110 dcl ME char (32) int static options (constant) init ("check_file_system_damage"); 111 112 /* automatic */ 113 114 dcl area_ptr ptr; /* pointer to area used for hcs_$star allocations */ 115 dcl argN fixed; /* number of argument being processed */ 116 dcl arglen fixed; /* length of any command argument */ 117 dcl argptr ptr; /* pointer to any command argument */ 118 dcl brief_switch bit (1) aligned; /* on if -brief specified */ 119 dcl call_switch bit (1) aligned; /* on if -call specified */ 120 dcl code fixed (35); /* error code returned by Multics subroutines */ 121 dcl command_line_length fixed init (0); /* length of command line argument */ 122 dcl command_line_ptr ptr; /* pointer to command line argument */ 123 dcl dname char (168); /* directory portion of pathname given as argument */ 124 dcl ename char (32); /* entryname portion of pathname given as argument */ 125 dcl max_depth fixed bin; /* number of dirs allowed to go down. default is 99999 */ 126 dcl msf_switch bit (1) aligned; /* on if -msf specified */ 127 dcl nargs fixed; /* number of arguments given to the command */ 128 dcl star_switch bit (1) aligned; /* on if pathname arg is a starname */ 129 dcl subroutine bit (1) aligned; /* on if entry thru subroutine interface */ 130 dcl subtree_switch bit (1) aligned; /* on if -subtree specified */ 131 132 /* based */ 133 134 dcl arg char (arglen) based (argptr); /* any command argument */ 135 dcl command_line char (command_line_length) based (command_line_ptr); 136 /* argument after -call */ 137 138 /* conditions */ 139 140 dcl cleanup condition; 141 142 /* builtins */ 143 144 dcl (addr, index, length, null, rtrim, substr, sum) builtin; 145 1 1 declare /* Structure returned by hcs_$status_long */ 1 2 1 3 1 branch_status aligned, /* automatic: hcs_$status uses a pointer */ 1 4 1 5 2 type bit(2) unaligned, /* type of entry: link, segment, dir */ 1 6 2 number_names bit(16) unaligned, /* unused by directory_status_ */ 1 7 2 names_rel_pointer bit(18) unaligned, /* unused by directory_status_ */ 1 8 2 date_time_modified bit(36) unaligned, /* date time modified */ 1 9 2 date_time_used bit(36) unaligned, /* date time entry used */ 1 10 2 mode bit(5) unaligned, /* effective access of caller */ 1 11 2 raw_mode bit(5) unaligned, 1 12 2 pad1 bit(8) unaligned, 1 13 2 records bit(18) unaligned, /* number of records in use */ 1 14 2 date_time_dumped bit(36) unaligned, /* date time last dumped */ 1 15 2 date_time_entry_modified bit(36) unaligned, /* date time entry modified */ 1 16 2 lvid bit(36) unaligned, /* logical volume id */ 1 17 2 current_length bit(12) unaligned, /* number of blocks currently allocated */ 1 18 2 bit_count bit(24) unaligned, /* bit count of entry */ 1 19 2 pad3 bit(8) unaligned, 1 20 2 copy_switch bit(1) unaligned, /* the copy switch */ 1 21 2 tpd bit(1) unaligned, /* transparent to paging device */ 1 22 2 mdir bit(1) unaligned, /* master directory switch */ 1 23 2 damaged_switch bit (1) unaligned, /* true if contents damaged */ 1 24 2 synchronized_switch bit (1) unaligned, /* true if a DM synchronized file */ 1 25 2 pad4 bit(5) unaligned, 1 26 2 ring_brackets (0:2) bit(6) unaligned, /* branch ring brackets */ 1 27 2 unique_id bit(36) unaligned, /* entry unique id */ 1 28 1 29 1 30 /* The types of each class of branch */ 1 31 segment_type bit(2) aligned internal static initial ("01"b), 1 32 directory_type bit(2) aligned internal static initial ("10"b), 1 33 msf_type bit(2) aligned internal static initial ("10"b), /* will eventually be different */ 1 34 link_type bit(2) aligned internal static initial ("00"b); 1 35 1 36 146 147 148 star_switch, subtree_switch, brief_switch, call_switch, subroutine = "0"b; 149 msf_switch = "1"b; 150 max_depth = 99999; 151 152 call cant_be_active_function (); 153 call check_number_of_args (1, 0, "check_file_system_damage path {-ctl_args}", nargs); 154 dname = ""; 155 argN = 1; 156 157 do while (argN <= nargs); 158 call cu_$arg_ptr (argN, argptr, arglen, code); 159 if /* case */ code ^= 0 160 then do; 161 call com_err_ (code, ME, "^/Error getting argument ^d.", argN); 162 return; 163 end; 164 else if index (arg, "-") ^= 1 165 then if dname = "" 166 then call get_starname_arg (arg, dname, ename, star_switch); 167 else do; 168 MULTIPLE_PATHS: call com_err_ (0, ME, "Multiple pathnames given. ^a", arg); 169 goto EXIT; 170 end; 171 else if arg = "-pn" | arg = "-pathname" 172 then if dname = "" 173 then do; 174 argN = argN + 1; 175 call get_required_arg (argN, "After -pathname.", argptr, arglen); 176 call expand_pathname_ (arg, dname, ename, code); 177 if code ^= 0 178 then do; 179 call com_err_ (code, ME, "^a", arg); 180 return; 181 end; 182 end; 183 else goto MULTIPLE_PATHS; 184 else if arg = "-wd" | arg = "-working_dir" 185 then if dname = "" 186 then call expand_pathname_ (get_wdir_ (), dname, ename, (0)); 187 else goto MULTIPLE_PATHS; 188 else if arg = "-subtree" | arg = "-subt" 189 then subtree_switch = "1"b; 190 else if arg = "-brief" | arg = "-bf" 191 then brief_switch = "1"b; 192 else if arg = "-msf" | arg = "-multisegment_file" 193 then msf_switch = "1"b; 194 else if arg = "-no_msf" | arg = "-no_multisegment_file" 195 then msf_switch = "0"b; 196 else if arg = "-dh" | arg = "-depth" 197 then do; 198 argN = argN + 1; 199 call get_required_arg (argN, "After -depth.", argptr, arglen); 200 max_depth = cv_dec_check_ (arg, code); 201 if code ^= 0 202 then do; 203 call com_err_ (0, ME, "Non-numeric after -depth. ^a", arg); 204 return; 205 end; 206 subtree_switch = "1"b; 207 end; 208 else if arg = "-call" 209 then do; 210 call_switch = "1"b; 211 argN = argN + 1; 212 call get_required_arg (argN, "After -call.", command_line_ptr, 213 command_line_length); 214 end; 215 else do; /* Error, unrecognized argument */ 216 if arglen > 0 217 then if substr (arg, 1, 1) = "-" 218 then call com_err_ (error_table_$badopt, ME, arg); 219 else call com_err_ (error_table_$bad_arg, ME, arg); 220 else ; 221 return; 222 end; 223 argN = argN + 1; 224 end; 225 226 if dname = "" 227 then do; 228 call com_err_ (error_table_$noarg, ME, "^/Usage: ^a path {-control_args}", ME); 229 goto EXIT; 230 end; 231 232 if subtree_switch & star_switch 233 then do; 234 call com_err_ (error_table_$inconsistent, ME, 235 "Pathname may not be a starname if -^[subtree^;depth^] option is used. ^a", (max_depth = 99999), 236 pathname_ (dname, ename)); 237 go to EXIT; 238 end; 239 else ; 240 241 area_ptr = get_system_free_area_ (); 242 243 if subtree_switch 244 then call survey_the_damage (pathname_ (dname, ename), "**", 1); 245 else if star_switch 246 then call survey_the_damage (dname, ename, 1); 247 else call check_entry (dname, ename, 1); 248 249 EXIT: /* all internal procs may go to here to after reporting errors */ 250 return; 251 252 check_file_system_damage_: 253 entry (Pdir, Pname, Pcode) returns (bit (36) aligned); 254 255 dcl Pdir char (*) parameter; /* directory name (input) */ 256 dcl Pname char (*) parameter; /* entry name (input)*/ 257 dcl Pcode fixed bin (35) parameter; /* error code (output) */ 258 259 dcl return_bits bit (36) aligned; 260 dcl 1 return_bits_based aligned based (addr (return_bits)), 261 2 damage bit (1) unaligned, /* ON = any damage */ 262 2 damaged_switch bit (1) unaligned, /* ON = damaged entry */ 263 2 connection_failure bit (1) unaligned, /* ON = connectin failure on entry */ 264 2 unused bit (33) unaligned; /* future expansion */ 265 266 return_bits = "0"b; 267 Pcode, code = 0; 268 269 subroutine = "1"b; 270 call_switch, msf_switch = "0"b; 271 max_depth = 0; 272 273 command_line_length = 0; 274 call check_entry (Pdir, Pname, 0); 275 if code ^= 0 276 then do; 277 Pcode = code; 278 return_bits = "0"b; 279 end; 280 else if return_bits ^= "0"b 281 then return_bits_based.damage = "1"b; 282 283 return (return_bits); 284 285 /* ********************************************************************** 286* * Internal procedure to check all entries in a directory that match * 287* * a starname. * 288* ********************************************************************** */ 289 290 survey_the_damage: 291 proc (dir, et, depth) recursive; 292 293 dcl dir char (*) parameter; /* Input-directory name */ 294 dcl et char (*) parameter; /* Input-starname */ 295 dcl depth fixed bin parameter; /* Input-number of dirs downwards we are */ 296 297 dcl ec fixed (35); /* error code */ 298 dcl i fixed; /* loop index */ 299 2 1 /* BEGIN INCLUDE FILE . . . star_structures.incl.pl1 */ 2 2 2 3 /* This include file contains structures for the hcs_$star_, 2 4* hcs_$star_list_ and hcs_$star_dir_list_ entry points. 2 5* 2 6* Written 23 October 1978 by Monte Davidoff. 2 7* Modified January 1979 by Michael R. Jordan to use unsigned and different pointers for different structures. 2 8* Modified June 1981 by C. Hornig to count link pathnames more efficiently. 2 9**/ 2 10 2 11 /* automatic */ 2 12 2 13 declare star_branch_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching branch count */ 2 14 declare star_entry_count fixed binary; /* hcs_$star_: number of matching entries */ 2 15 declare star_entry_ptr pointer; /* hcs_$star_: pointer to array of entry information */ 2 16 declare star_list_branch_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to array of info */ 2 17 declare star_link_count fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: matching link count */ 2 18 declare star_linkx fixed binary; /* hcs_$star_list_, hcs_$star_dir_list_: index into star_links */ 2 19 declare star_names_ptr pointer; /* hcs_$star_: pointer to array of entry names */ 2 20 declare star_list_names_ptr pointer; /* hcs_$star_list_, hcs_$star_dir_list_: ptr to entry names */ 2 21 declare star_select_sw fixed binary (3); /* hcs_$star_list_, hcs_$star_dir_list_: what info to return */ 2 22 2 23 /* based */ 2 24 2 25 /* hcs_$star_ entry structure */ 2 26 2 27 declare 1 star_entries (star_entry_count) aligned based (star_entry_ptr), 2 28 2 type fixed binary (2) unsigned unaligned, 2 29 /* storage system type */ 2 30 2 nnames fixed binary (16) unsigned unaligned, 2 31 /* number of names of entry that match star_name */ 2 32 2 nindex fixed binary (18) unsigned unaligned; 2 33 /* index of first name in star_names */ 2 34 2 35 /* hcs_$star_ name structure */ 2 36 2 37 declare star_names (sum (star_entries (*).nnames)) char (32) based (star_names_ptr); 2 38 2 39 /* hcs_$star_list_ branch structure */ 2 40 2 41 declare 1 star_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 2 42 2 type fixed binary (2) unsigned unaligned, 2 43 /* storage system type */ 2 44 2 nnames fixed binary (16) unsigned unaligned, 2 45 /* number of names of entry that match star_name */ 2 46 2 nindex fixed binary (18) unsigned unaligned, 2 47 /* index of first name in star_list_names */ 2 48 2 dtcm bit (36) unaligned, /* date-time contents of branch were last modified */ 2 49 2 dtu bit (36) unaligned, /* date-time branch was last used */ 2 50 2 mode bit (5) unaligned, /* user's access mode to the branch */ 2 51 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 2 52 2 master_dir bit (1) unaligned, /* is branch a master directory */ 2 53 2 pad bit (7) unaligned, 2 54 2 records fixed binary (18) unsigned unaligned; 2 55 /* records used by branch */ 2 56 2 57 /* hcs_$star_dir_list_ branch structure */ 2 58 2 59 declare 1 star_dir_list_branch (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 2 60 2 type fixed binary (2) unsigned unaligned, 2 61 /* storage system type */ 2 62 2 nnames fixed binary (16) unsigned unaligned, 2 63 /* number of names of entry that match star_name */ 2 64 2 nindex fixed binary (18) unsigned unaligned, 2 65 /* index of first name in star_list_names */ 2 66 2 dtem bit (36) unaligned, /* date-time directory entry of branch was last modified */ 2 67 2 pad bit (36) unaligned, 2 68 2 mode bit (5) unaligned, /* user's access mode to the branch */ 2 69 2 raw_mode bit (5) unaligned, /* user's ACL access mode */ 2 70 2 master_dir bit (1) unaligned, /* is branch a master directory */ 2 71 2 bit_count fixed binary (24) unaligned; 2 72 /* bit count of the branch */ 2 73 2 74 /* hcs_$star_list_ and hcs_$star_dir_list_ link structure */ 2 75 2 76 declare 1 star_links (star_branch_count + star_link_count) aligned based (star_list_branch_ptr), 2 77 2 type fixed binary (2) unsigned unaligned, 2 78 /* storage system type */ 2 79 2 nnames fixed binary (16) unsigned unaligned, 2 80 /* number of names of entry that match star_name */ 2 81 2 nindex fixed binary (18) unsigned unaligned, 2 82 /* index of first name in star_list_names */ 2 83 2 dtem bit (36) unaligned, /* date-time link was last modified */ 2 84 2 dtd bit (36) unaligned, /* date-time the link was last dumped */ 2 85 2 pathname_len fixed binary (18) unsigned unaligned, 2 86 /* length of the pathname of the link */ 2 87 2 pathname_index fixed binary (18) unsigned unaligned; 2 88 /* index of start of pathname in star_list_names */ 2 89 2 90 /* hcs_$star_list_ and hcs_$star_dir_list_ name array */ 2 91 2 92 declare star_list_names char (32) based (star_list_names_ptr) 2 93 dimension (star_links (star_branch_count + star_link_count).nindex 2 94 + star_links (star_branch_count + star_link_count).nnames 2 95 + divide (star_links (star_branch_count + star_link_count).pathname_len + 31, 32, 17, 0) 2 96 * binary ( 2 97 (star_links (star_branch_count + star_link_count).type = star_LINK) 2 98 & (star_select_sw >= star_LINKS_ONLY_WITH_LINK_PATHS), 1)); 2 99 2 100 /* hcs_$star_list_ and hcs_$star_dir_list_ link pathname */ 2 101 2 102 declare star_link_pathname char (star_links (star_linkx).pathname_len) 2 103 based (addr (star_list_names (star_links (star_linkx).pathname_index))); 2 104 2 105 /* internal static */ 2 106 2 107 /* star_select_sw values */ 2 108 2 109 declare star_LINKS_ONLY fixed binary (2) internal static options (constant) initial (1); 2 110 declare star_BRANCHES_ONLY fixed binary (2) internal static options (constant) initial (2); 2 111 declare star_ALL_ENTRIES fixed binary (2) internal static options (constant) initial (3); 2 112 declare star_LINKS_ONLY_WITH_LINK_PATHS 2 113 fixed binary (3) internal static options (constant) initial (5); 2 114 declare star_ALL_ENTRIES_WITH_LINK_PATHS 2 115 fixed binary (3) internal static options (constant) initial (7); 2 116 2 117 /* storage system types */ 2 118 2 119 declare star_LINK fixed binary (2) unsigned internal static options (constant) initial (0); 2 120 declare star_SEGMENT fixed binary (2) unsigned internal static options (constant) initial (1); 2 121 declare star_DIRECTORY fixed binary (2) unsigned internal static options (constant) initial (2); 2 122 2 123 /* END INCLUDE FILE . . . star_structures.incl.pl1 */ 300 301 302 if depth > max_depth 303 then return; 304 305 star_entry_ptr, star_names_ptr = null (); 306 307 on cleanup /* CLEANUP HANDLER */ 308 begin; 309 if star_names_ptr ^= null () 310 then free star_names; 311 else ; 312 if star_entry_ptr ^= null () 313 then free star_entries; 314 else ; 315 end; 316 317 call hcs_$star_ (dir, et, star_BRANCHES_ONLY, area_ptr, star_entry_count, star_entry_ptr, star_names_ptr, ec); 318 319 if ec ^= 0 320 then if (ec = error_table_$moderr | ec = error_table_$nomatch 321 | ec = error_table_$logical_volume_not_defined) & brief_switch 322 then ; 323 else call com_err_ (ec, ME, "^a", pathname_ (dir, et)); 324 else do i = 1 to star_entry_count by 1; 325 call check_entry (dir, star_names (star_entries (i).nindex), depth); 326 end; 327 CLEANUP: 328 if star_names_ptr ^= null () 329 then free star_names; 330 else ; 331 if star_entry_ptr ^= null () 332 then free star_entries; 333 else ; 334 return; 335 336 end survey_the_damage; 337 338 /* ********************************************************************** 339* * Internal procedure to check an individual branch for damage. * 340* * This procedure recalls survey_damage as needed to handle * 341* * subtrees and MSFs. * 342* ********************************************************************** */ 343 344 check_entry: 345 proc (d, e, depth); 346 347 dcl d char (*) parameter; /* Input-directory portion of pathname */ 348 dcl e char (*) parameter; /* Input-entryname */ 349 dcl depth fixed bin parameter; /* Input-number of dirs downward we are */ 350 351 dcl ec fixed (35); /* error code */ 352 dcl command char (command_line_length + 188); /* long enough for command line plus pathname plus */ 353 /* "connection_failure" plus spaces */ 354 355 call hcs_$status_long (d, e, 0, addr (branch_status), null (), ec); 356 if ec = error_table_$vtoce_connection_fail 357 then if call_switch 358 then do; 359 command = command_line || " " || rtrim (pathname_ (d, e)) || " connection_failure"; 360 call cu_$cp (addr (command), length (command), (0)); 361 end; 362 else if subroutine 363 then return_bits_based.connection_failure = "1"b; 364 else call ioa_ ("Connection failure: ^a", pathname_ (d, e)); 365 else if ec ^= 0 366 then if subroutine 367 then do; 368 code = ec; 369 return; 370 end; 371 else call com_err_ (ec, ME, "^a", pathname_ (d, e)); 372 else if branch_status.damaged_switch 373 then if call_switch 374 then do; 375 376 command = command_line || " " || rtrim (pathname_ (d, e)) || " damaged"; 377 call cu_$cp (addr (command), length (command), (0)); 378 end; 379 else if subroutine 380 then return_bits_based.damaged_switch = "1"b; 381 else call ioa_ ("Damage switch on: ^a", pathname_ (d, e)); 382 else if branch_status.type = directory_type 383 then if (msf_switch & branch_status.bit_count ^= "0"b) 384 | (branch_status.bit_count = "0"b & subtree_switch) 385 then if depth < max_depth 386 then call survey_the_damage (pathname_ (d, e), "**", depth + 1); 387 else ; /* would make it too far down */ 388 else ; 389 else ; /* not a directory */ 390 391 return; 392 393 end check_entry; 394 395 /* *********************************************************************** 396* * Internal procedure to check to see if command was called as active * 397* * function, and to report an error if it was. * 398* *********************************************************************** */ 399 400 cant_be_active_function: 401 proc; 402 403 dcl ec fixed (35); /* error code */ 404 405 call cu_$af_return_arg ((0), null (), (0), ec); /* call with dummy args, we just want the error code */ 406 if ec = 0 407 then do; 408 call active_fnc_err_ (0, ME, "This command cannot be called as an active function."); 409 go to EXIT; 410 end; 411 else return; 412 413 end cant_be_active_function; 414 415 /* ********************************************************************** 416* * Internal procedure to determine the number of arguments passed to * 417* * the command and ensure that the minimum and maximum number of * 418* * arguments for the command are not abused. * 419* ********************************************************************** */ 420 421 check_number_of_args: 422 proc (min_args, max_args, usage, nargs); 423 424 /* parameters */ 425 426 dcl min_args fixed parameter; /* Input-Minimum number of arguments needed by this command */ 427 dcl max_args fixed parameter; /* Input-Maximum number of arguments acceptable 428* to this command. (0 means no maximum) */ 429 dcl usage char (*) parameter; /* Input-Usage description for this command */ 430 dcl nargs fixed parameter; /* Output-Actual number of arguments given to command */ 431 432 nargs = cu_$arg_count (); 433 434 if nargs < min_args /* not enough arguments, tell user what to do */ 435 then call com_err_ (error_table_$noarg, ME, "^/^-Usage: ^a", usage); 436 else if nargs > max_args & max_args ^= 0 /* too many arguments, tell user what to do */ 437 then call com_err_ (error_table_$too_many_args, ME, "^/^-Usage: ^a", usage); 438 else return; 439 go to EXIT; 440 441 end check_number_of_args; 442 443 /* ********************************************************************** 444* * This internal procedure is used to get pointer and length for a * 445* * required argument. * 446* ********************************************************************** */ 447 448 get_required_arg: 449 proc (n, error_comment, ap, al); 450 451 dcl n fixed parameter; /* Input-number of the argument we want to get */ 452 dcl error_comment char (*) parameter; /* Input-comment to print with any error messages */ 453 dcl ap ptr parameter; /* Output-pointer to argument */ 454 dcl al fixed parameter; /* Output-length of argument */ 455 456 dcl arg char (al) based (ap); /* the argument itself */ 457 dcl ec fixed (35); /* error code */ 458 459 call cu_$arg_ptr (n, ap, al, ec); 460 if ec = 0 461 then if al > 0 /* check to make sure it's not another control arg */ 462 then if substr (arg, 1, 1) = "-" 463 then do; 464 ec = error_table_$noarg; 465 call com_err_ (ec, ME, error_comment); 466 go to EXIT; 467 end; 468 else ; 469 else ; 470 else do; 471 call com_err_ (ec, ME, error_comment); 472 go to EXIT; 473 end; 474 return; 475 476 end get_required_arg; 477 478 /* ********************************************************************** 479* * Internal procedure to get a pathname, which may be a starname. * 480* * -wd or -working_dir is accepted as meaning the working directory. * 481* ********************************************************************** */ 482 483 get_starname_arg: 484 proc (arg, dir, et, is_star); 485 486 dcl arg char (*) parameter; /* Input-path of the directory to usage (may be a starname) */ 487 dcl dir char (*) parameter; /* Output-directory portion of pathname */ 488 dcl et char (*) parameter; /* Output-entryname portion (starname) of pathname */ 489 dcl is_star bit (1) aligned parameter; /* Output-"1"b if entryname is a starname */ 490 491 dcl ec fixed (35); /* error code */ 492 493 call expand_pathname_ (arg, dir, et, ec); 494 if ec ^= 0 495 then do; 496 call com_err_ (ec, ME, "^a", arg); 497 go to EXIT; 498 end; 499 500 if dir = ">" & et = "" /* special case the ROOT */ 501 then is_star = "0"b; 502 else do; 503 call check_star_name_$entry (et, ec); 504 if ec > 2 505 then do; /* 1 and 2 have special meanings and do not indicate errors */ 506 call com_err_ (ec, ME, "^a", arg); 507 go to EXIT; 508 end; 509 else ; 510 if ec = 0 511 then is_star = "0"b; 512 else is_star = "1"b; 513 end; 514 return; 515 516 end get_starname_arg; 517 518 end check_file_system_damage; 519 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/05/00 1823.5 check_file_system_damage.pl1 >udd>sm>ds>w>ml>check_file_system_damage.pl1 146 1 11/22/82 1055.6 branch_status.incl.pl1 >ldd>incl>branch_status.incl.pl1 300 2 06/10/82 1145.5 star_structures.incl.pl1 >ldd>incl>star_structures.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. ME 000000 constant char(32) initial packed unaligned dcl 110 set ref 161* 168* 179* 203* 216* 219* 228* 228* 234* 323* 371* 408* 434* 436* 465* 471* 496* 506* Pcode parameter fixed bin(35,0) dcl 257 set ref 252 267* 277* Pdir parameter char packed unaligned dcl 255 set ref 252 274* Pname parameter char packed unaligned dcl 256 set ref 252 274* active_fnc_err_ 000010 constant entry external dcl 80 ref 408 addr builtin function dcl 144 ref 280 355 355 360 360 362 377 377 379 al parameter fixed bin(17,0) dcl 454 set ref 448 459* 460 460 ap parameter pointer dcl 453 set ref 448 459* 460 area_ptr 000100 automatic pointer dcl 114 set ref 241* 317* arg based char packed unaligned dcl 456 in procedure "get_required_arg" ref 460 arg parameter char packed unaligned dcl 486 in procedure "get_starname_arg" set ref 483 493* 496* 506* arg based char packed unaligned dcl 134 in procedure "cfsd" set ref 164 164* 168* 171 171 176* 179* 184 184 188 188 190 190 192 192 194 194 196 196 200* 203* 208 216 216* 219* argN 000102 automatic fixed bin(17,0) dcl 115 set ref 155* 157 158* 161* 174* 174 175* 198* 198 199* 211* 211 212* 223* 223 arglen 000103 automatic fixed bin(17,0) dcl 116 set ref 158* 164 164 164 168 168 171 171 175* 176 176 179 179 184 184 188 188 190 190 192 192 194 194 196 196 199* 200 200 203 203 208 216 216 216 216 219 219 argptr 000104 automatic pointer dcl 117 set ref 158* 164 164 168 171 171 175* 176 179 184 184 188 188 190 190 192 192 194 194 196 196 199* 200 203 208 216 216 219 bit_count 7(12) 000204 automatic bit(24) level 2 packed packed unaligned dcl 1-1 set ref 382 382 branch_status 000204 automatic structure level 1 dcl 1-1 set ref 355 355 brief_switch 000106 automatic bit(1) dcl 118 set ref 148* 190* 319 call_switch 000107 automatic bit(1) dcl 119 set ref 148* 210* 270* 356 372 check_star_name_$entry 000012 constant entry external dcl 81 ref 503 cleanup 000000 stack reference condition dcl 140 ref 307 code 000110 automatic fixed bin(35,0) dcl 120 set ref 158* 159 161* 176* 177 179* 200* 201 267* 275 277 368* com_err_ 000014 constant entry external dcl 82 ref 161 168 179 203 216 219 228 234 323 371 434 436 465 471 496 506 command 000101 automatic char packed unaligned dcl 352 set ref 359* 360 360 360 360 376* 377 377 377 377 command_line based char packed unaligned dcl 135 ref 359 376 command_line_length 000111 automatic fixed bin(17,0) initial dcl 121 set ref 121* 212* 273* 352 359 376 command_line_ptr 000112 automatic pointer dcl 122 set ref 212* 359 376 connection_failure 0(02) based bit(1) level 2 packed packed unaligned dcl 260 set ref 362* cu_$af_return_arg 000016 constant entry external dcl 83 ref 405 cu_$arg_count 000020 constant entry external dcl 84 ref 432 cu_$arg_ptr 000022 constant entry external dcl 85 ref 158 459 cu_$cp 000024 constant entry external dcl 86 ref 360 377 cv_dec_check_ 000026 constant entry external dcl 87 ref 200 d parameter char packed unaligned dcl 347 set ref 344 355* 359* 364* 364* 371* 371* 376* 381* 381* 382* 382* damage based bit(1) level 2 packed packed unaligned dcl 260 set ref 280* damaged_switch 0(01) based bit(1) level 2 in structure "return_bits_based" packed packed unaligned dcl 260 in procedure "cfsd" set ref 379* damaged_switch 10(11) 000204 automatic bit(1) level 2 in structure "branch_status" packed packed unaligned dcl 1-1 in procedure "cfsd" set ref 372 depth parameter fixed bin(17,0) dcl 295 in procedure "survey_the_damage" set ref 290 302 325* depth parameter fixed bin(17,0) dcl 349 in procedure "check_entry" ref 344 382 382 dir parameter char packed unaligned dcl 487 in procedure "get_starname_arg" set ref 483 493* 500 dir parameter char packed unaligned dcl 293 in procedure "survey_the_damage" set ref 290 317* 323* 323* 325* directory_type constant bit(2) initial dcl 1-1 ref 382 dname 000114 automatic char(168) packed unaligned dcl 123 set ref 154* 164 164* 171 176* 184 184* 226 234* 234* 243* 243* 245* 247* e parameter char packed unaligned dcl 348 set ref 344 355* 359* 364* 364* 371* 371* 376* 381* 381* 382* 382* ec 000254 automatic fixed bin(35,0) dcl 491 in procedure "get_starname_arg" set ref 493* 494 496* 503* 504 506* 510 ec 000226 automatic fixed bin(35,0) dcl 403 in procedure "cant_be_active_function" set ref 405* 406 ec 000100 automatic fixed bin(35,0) dcl 297 in procedure "survey_the_damage" set ref 317* 319 319 319 319 323* ec 000244 automatic fixed bin(35,0) dcl 457 in procedure "get_required_arg" set ref 459* 460 464* 465* 471* ec 000100 automatic fixed bin(35,0) dcl 351 in procedure "check_entry" set ref 355* 356 365 368 371* ename 000166 automatic char(32) packed unaligned dcl 124 set ref 164* 176* 184* 234* 234* 243* 243* 245* 247* error_comment parameter char packed unaligned dcl 452 set ref 448 465* 471* error_table_$bad_arg 000046 external static fixed bin(35,0) dcl 98 set ref 219* error_table_$badopt 000050 external static fixed bin(35,0) dcl 99 set ref 216* error_table_$inconsistent 000052 external static fixed bin(35,0) dcl 100 set ref 234* error_table_$logical_volume_not_defined 000054 external static fixed bin(35,0) dcl 101 ref 319 error_table_$moderr 000056 external static fixed bin(35,0) dcl 102 ref 319 error_table_$noarg 000060 external static fixed bin(35,0) dcl 103 set ref 228* 434* 464 error_table_$nomatch 000062 external static fixed bin(35,0) dcl 104 ref 319 error_table_$too_many_args 000064 external static fixed bin(35,0) dcl 105 set ref 436* error_table_$vtoce_connection_fail 000066 external static fixed bin(35,0) dcl 106 ref 356 et parameter char packed unaligned dcl 294 in procedure "survey_the_damage" set ref 290 317* 323* 323* et parameter char packed unaligned dcl 488 in procedure "get_starname_arg" set ref 483 493* 500 503* expand_pathname_ 000030 constant entry external dcl 88 ref 176 184 493 get_system_free_area_ 000032 constant entry external dcl 89 ref 241 get_wdir_ 000034 constant entry external dcl 90 ref 184 184 hcs_$star_ 000036 constant entry external dcl 91 ref 317 hcs_$status_long 000040 constant entry external dcl 92 ref 355 i 000101 automatic fixed bin(17,0) dcl 298 set ref 324* 325* index builtin function dcl 144 ref 164 ioa_ 000042 constant entry external dcl 93 ref 364 381 is_star parameter bit(1) dcl 489 set ref 483 500* 510* 512* length builtin function dcl 144 ref 360 360 377 377 max_args parameter fixed bin(17,0) dcl 427 ref 421 436 436 max_depth 000176 automatic fixed bin(17,0) dcl 125 set ref 150* 200* 234 271* 302 382 min_args parameter fixed bin(17,0) dcl 426 ref 421 434 msf_switch 000177 automatic bit(1) dcl 126 set ref 149* 192* 194* 270* 382 n parameter fixed bin(17,0) dcl 451 set ref 448 459* nargs parameter fixed bin(17,0) dcl 430 in procedure "check_number_of_args" set ref 421 432* 434 436 nargs 000200 automatic fixed bin(17,0) dcl 127 in procedure "cfsd" set ref 153* 157 nindex 0(18) based fixed bin(18,0) array level 2 packed packed unsigned unaligned dcl 2-27 ref 325 nnames 0(02) based fixed bin(16,0) array level 2 packed packed unsigned unaligned dcl 2-27 ref 309 327 null builtin function dcl 144 ref 305 309 312 327 331 355 355 405 405 pathname_ 000044 constant entry external dcl 94 ref 234 234 243 243 323 323 359 364 364 371 371 376 381 381 382 382 return_bits 000216 automatic bit(36) dcl 259 set ref 266* 278* 280 280 283 362 379 return_bits_based based structure level 1 dcl 260 rtrim builtin function dcl 144 ref 359 376 star_BRANCHES_ONLY 000037 constant fixed bin(2,0) initial dcl 2-110 set ref 317* star_entries based structure array level 1 dcl 2-27 ref 312 331 star_entry_count 000102 automatic fixed bin(17,0) dcl 2-14 set ref 309 312 317* 324 327 331 star_entry_ptr 000104 automatic pointer dcl 2-15 set ref 305* 309 312 312 317* 325 327 331 331 star_names based char(32) array packed unaligned dcl 2-37 set ref 309 325* 327 star_names_ptr 000106 automatic pointer dcl 2-19 set ref 305* 309 309 317* 325 327 327 star_switch 000201 automatic bit(1) dcl 128 set ref 148* 164* 232 245 subroutine 000202 automatic bit(1) dcl 129 set ref 148* 269* 362 365 379 substr builtin function dcl 144 ref 216 460 subtree_switch 000203 automatic bit(1) dcl 130 set ref 148* 188* 206* 232 243 382 sum builtin function dcl 144 ref 309 327 type 000204 automatic bit(2) level 2 packed packed unaligned dcl 1-1 set ref 382 usage parameter char packed unaligned dcl 429 set ref 421 434* 436* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. link_type internal static bit(2) initial dcl 1-1 msf_type internal static bit(2) initial dcl 1-1 segment_type internal static bit(2) initial dcl 1-1 star_ALL_ENTRIES internal static fixed bin(2,0) initial dcl 2-111 star_ALL_ENTRIES_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 2-114 star_DIRECTORY internal static fixed bin(2,0) initial unsigned dcl 2-121 star_LINK internal static fixed bin(2,0) initial unsigned dcl 2-119 star_LINKS_ONLY internal static fixed bin(2,0) initial dcl 2-109 star_LINKS_ONLY_WITH_LINK_PATHS internal static fixed bin(3,0) initial dcl 2-112 star_SEGMENT internal static fixed bin(2,0) initial unsigned dcl 2-120 star_branch_count automatic fixed bin(17,0) dcl 2-13 star_dir_list_branch based structure array level 1 dcl 2-59 star_link_count automatic fixed bin(17,0) dcl 2-17 star_link_pathname based char packed unaligned dcl 2-102 star_links based structure array level 1 dcl 2-76 star_linkx automatic fixed bin(17,0) dcl 2-18 star_list_branch based structure array level 1 dcl 2-41 star_list_branch_ptr automatic pointer dcl 2-16 star_list_names based char(32) array packed unaligned dcl 2-92 star_list_names_ptr automatic pointer dcl 2-20 star_select_sw automatic fixed bin(3,0) dcl 2-21 NAMES DECLARED BY EXPLICIT CONTEXT. CLEANUP 002130 constant label dcl 327 EXIT 001500 constant label dcl 249 ref 169 229 237 409 439 466 472 497 507 MULTIPLE_PATHS 000477 constant label dcl 168 ref 171 184 cant_be_active_function 003042 constant entry internal dcl 400 ref 152 cfsd 000274 constant entry external dcl 22 check_entry 002172 constant entry internal dcl 344 ref 247 274 325 check_file_system_damage 000306 constant entry external dcl 22 check_file_system_damage_ 001514 constant entry external dcl 252 check_number_of_args 003115 constant entry internal dcl 421 ref 153 get_required_arg 003242 constant entry internal dcl 448 ref 175 199 212 get_starname_arg 003357 constant entry internal dcl 483 ref 164 survey_the_damage 001617 constant entry internal dcl 290 ref 243 245 382 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4240 4330 3703 4250 Length 4630 3703 70 263 335 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cfsd 406 external procedure is an external procedure. survey_the_damage 166 internal procedure enables or reverts conditions. on unit on line 307 64 on unit check_entry 162 internal procedure uses auto adjustable storage. cant_be_active_function internal procedure shares stack frame of external procedure cfsd. check_number_of_args internal procedure shares stack frame of external procedure cfsd. get_required_arg internal procedure shares stack frame of external procedure cfsd. get_starname_arg internal procedure shares stack frame of external procedure cfsd. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cfsd 000100 area_ptr cfsd 000102 argN cfsd 000103 arglen cfsd 000104 argptr cfsd 000106 brief_switch cfsd 000107 call_switch cfsd 000110 code cfsd 000111 command_line_length cfsd 000112 command_line_ptr cfsd 000114 dname cfsd 000166 ename cfsd 000176 max_depth cfsd 000177 msf_switch cfsd 000200 nargs cfsd 000201 star_switch cfsd 000202 subroutine cfsd 000203 subtree_switch cfsd 000204 branch_status cfsd 000216 return_bits cfsd 000226 ec cant_be_active_function 000244 ec get_required_arg 000254 ec get_starname_arg check_entry 000100 ec check_entry 000101 command check_entry survey_the_damage 000100 ec survey_the_damage 000101 i survey_the_damage 000102 star_entry_count survey_the_damage 000104 star_entry_ptr survey_the_damage 000106 star_names_ptr survey_the_damage THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_other_desc return_mac alloc_auto_adj mpfx2 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ check_star_name_$entry com_err_ cu_$af_return_arg cu_$arg_count cu_$arg_ptr cu_$cp cv_dec_check_ expand_pathname_ get_system_free_area_ get_wdir_ hcs_$star_ hcs_$status_long ioa_ pathname_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$badopt error_table_$inconsistent error_table_$logical_volume_not_defined error_table_$moderr error_table_$noarg error_table_$nomatch error_table_$too_many_args error_table_$vtoce_connection_fail LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 121 000270 22 000273 148 000316 149 000323 150 000325 152 000327 153 000330 154 000341 155 000344 157 000346 158 000351 159 000366 161 000370 162 000420 164 000427 168 000477 169 000533 170 000534 171 000535 174 000551 175 000552 176 000563 177 000613 179 000615 180 000647 182 000656 184 000657 188 000731 190 000744 192 000757 194 000772 196 001004 198 001014 199 001015 200 001026 201 001053 203 001055 204 001111 206 001120 207 001122 208 001123 210 001127 211 001131 212 001132 214 001141 216 001142 219 001174 221 001217 223 001226 224 001227 226 001230 228 001234 229 001263 232 001264 234 001271 237 001351 241 001352 243 001361 245 001430 247 001456 249 001500 252 001507 266 001536 267 001537 269 001542 270 001544 271 001546 273 001547 274 001550 275 001572 277 001574 278 001576 279 001577 280 001600 283 001604 290 001616 302 001637 305 001644 307 001647 309 001663 312 001717 315 001726 317 001727 319 001775 323 002012 324 002064 325 002073 326 002126 327 002130 331 002162 334 002170 344 002171 352 002212 355 002223 356 002265 359 002274 360 002373 361 002413 362 002414 364 002421 365 002467 368 002474 369 002475 371 002476 372 002550 376 002556 377 002655 378 002675 379 002676 381 002703 382 002746 391 003041 400 003042 405 003043 406 003064 408 003066 409 003113 411 003114 421 003115 432 003126 434 003136 436 003177 438 003240 439 003241 448 003242 459 003253 460 003271 464 003304 465 003307 466 003330 469 003331 471 003332 472 003355 474 003356 483 003357 493 003402 494 003431 496 003433 497 003464 500 003465 503 003504 504 003522 506 003525 507 003556 510 003557 512 003564 514 003567 ----------------------------------------------------------- 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