COMPILATION LISTING OF SEGMENT pool_manager_ 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 0833.3 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 /* format: style2,indcomtxt */ 11 12 pool_manager_: 13 proc; 14 15 /* System storage pool management module */ 16 17 /* Coded January 1975 by Stan C. Vestal */ 18 /* Modified in Sept. 1975 by J. C. Whitmore to fix quota reference bug in clean_pool entry */ 19 /* Modified in April 1976 by J. C. Whitmore to check for non-terminal quota when closing pool */ 20 /* Modified 84-01-05 BIM to stop gratuitously fooling with quota. 21* personid dirs are never given terminal quota now, 22* since users lack access to take advantage of it. 23* For perfection, card stuff should set max lengths. */ 24 /* Modified 84-12-27 by Keith Loepere to set dir_quota. */ 25 /* Modified 85-01-30 by Keith Loepere to be smarter about same. */ 26 27 return; /* shouldn't be called here */ 28 29 dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); 30 dcl convert_authorization_$encode 31 entry (bit (72) aligned, char (*)); 32 dcl cu_$level_get entry returns (fixed bin); 33 dcl delete_$path entry (char (*), char (*), bit (6), char (*), fixed bin (35)); 34 dcl expand_pathname_ entry (character (*), character (*), character (*), fixed binary (35)); 35 dcl get_authorization_ entry returns (bit (72) aligned); 36 dcl get_group_id_$tag_star entry returns (char (32)); 37 dcl get_system_free_area_ entry returns (ptr); 38 dcl hcs_$add_dir_acl_entries 39 entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 40 dcl hcs_$add_dir_inacl_entries 41 entry (char (*), char (*), ptr, fixed bin, fixed bin, fixed bin (35)); 42 dcl hcs_$create_branch_ entry (char (*), char (*), ptr, fixed bin (35)); 43 dcl hcs_$get_access_class entry (char (*), char (*), bit (72) aligned, fixed bin (35)); 44 dcl hcs_$quota_get entry (char (*), fixed bin (18), fixed bin (35), bit (36) aligned, fixed bin, 45 fixed bin (1), fixed bin, fixed bin (35)); 46 dcl hcs_$quota_move entry (char (*), char (*), fixed bin (18), fixed bin (35)); 47 dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); 48 dcl hcs_$star_list_ entry (char (*), char (*), fixed bin (3), ptr, fixed bin, fixed bin, ptr, ptr, 49 fixed bin (35)); 50 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 51 dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), 52 fixed bin (35)); 53 dcl priv_move_quota_ entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (35)); 54 dcl system_privilege_$dir_priv_off 55 entry (fixed bin (35)); 56 dcl system_privilege_$dir_priv_on 57 entry (fixed bin (35)); 58 declare pathname_ entry (character (*), character (*)) returns (character (168)); 59 60 dcl error_table_$ai_restricted 61 external fixed bin (35); 62 dcl error_table_$action_not_performed 63 external fixed bin (35); 64 dcl error_table_$rqover external fixed bin (35); 65 dcl error_table_$invalid_move_qmax 66 external fixed bin (35); 67 dcl error_table_$invalid_move_quota 68 external fixed bin (35); 69 dcl error_table_$namedup external fixed bin (35); 70 dcl error_table_$no_dir external fixed bin (35); 71 dcl error_table_$nomatch external fixed bin (35); 72 dcl error_table_$nondirseg external fixed bin (35); 73 dcl error_table_$noentry external fixed bin (35); 74 dcl error_table_$notadir external fixed bin (35); 75 76 77 dcl a_path char (*); 78 dcl a_personid char (*); /* person name for this pool entry */ 79 dcl a_grace_quota fixed bin; /* quota to be left on access class dir over used */ 80 dcl ac bit (72) aligned; /* bit rep of access_class for desired personid dir */ 81 dcl access bit (36) aligned; /* mode to set in inacl of access_class_dir */ 82 dcl access_class_dir char (32); /* entry name for the access_class directory */ 83 dcl access_class_path char (168); /* full pathname of access_class_dir */ 84 dcl access_quota fixed bin (18); /* quota on access_class_dir */ 85 dcl access_used fixed bin; /* pages used on access_class_dir */ 86 dcl age fixed bin; /* age olde than which segs are to be deleted */ 87 dcl all_switches bit (6); /* for both */ 88 dcl bc fixed bin; /* number of dirs and segs in dir */ 89 dcl bitcnt fixed bin (24); /* bit count of branch entry */ 90 dcl caller_auth bit (72) aligned; /* access_class of the process */ 91 dcl code fixed bin (35); /* error code */ 92 dcl dir_switches bit (6); /* and for dirs */ 93 dcl dir_lk_switches bit (6); /* and for dirs and links only */ 94 dcl dum72 bit (72) aligned; /* dummy for time storage */ 95 dcl ec fixed bin (35); /* return error code */ 96 dcl grace_quota fixed bin; /* amount of quota in excess of used to leave of dir */ 97 dcl i fixed bin; /* loop index */ 98 dcl infqcnt fixed bin; /* no. of inferior dirs with terminal quota */ 99 dcl key_path (2) char (168) int static init (">ddd>tape_pool", ">ddd>cards"); 100 dcl keyword (2) char (168) int static init ("System_Tape_Pool", "System_Card_Pool"); 101 dcl lc fixed bin; /* numbe of links in dir */ 102 dcl limit fixed bin (71); /* max age of segment to be deleted */ 103 dcl mask bit (36) aligned; 104 dcl mask_set bit (1) aligned; 105 dcl msdays fixed bin (71); /* age in microseconds */ 106 dcl need_priv bit (1) int static;/* on if the process is upgraded WRT root */ 107 dcl no_of_keywords fixed bin init (2);/* number of known keywords */ 108 dcl now fixed bin (71); /* time of day in clock_ terms */ 109 dcl old_mask bit (36) aligned; 110 dcl path char (168); /* pathname of personid dir */ 111 dcl person_path char (168); /* pathname of personid dir */ 112 dcl personid char (32); 113 dcl pool_access_class bit (72) aligned int static; 114 /* access class of the pool dirs */ 115 dcl pool_dir_parent char (168); /* dir portion of pool root */ 116 dcl pool_dirname char (32); /* entry portion of pool root */ 117 dcl pool_root_dir char (168); /* pool root directory */ 118 dcl priv_code fixed bin (35) init (1); 119 dcl quota fixed bin; /* desired quota on the access class dir */ 120 dcl quota_change fixed bin (18); /* amount of quota to move */ 121 dcl root char (168); /* path of the pool root or keyword */ 122 dcl root_quota fixed bin (18); /* quota on pool_root_dir */ 123 dcl root_used fixed bin; /* pages used in pool_root_dir */ 124 dcl rt char (*); 125 dcl seg_switches bit (6); /* delete_$path switches for segments */ 126 dcl taccsw fixed bin (1); /* on if terminal quota on this dir */ 127 dcl trp fixed bin (35); /* time-record product */ 128 dcl tup bit (36) aligned; /* time trp last updated */ 129 dcl type fixed bin (2); /* branch type from status_minf */ 130 dcl (adumdir, pdumdir) char (168); /* pathnames */ 131 dcl (aname, pname, sname) char (32); /* directory and segment names */ 132 dcl (area_ptr, eptr, nptr, aep, peptr, pnptr, pep, septr, snptr, sep) 133 ptr init (null); 134 dcl (j, k) fixed bin; /* loop indices */ 135 dcl (no_of_adirs, no_of_pdirs, no_of_segs) 136 fixed bin; 137 dcl (person_del_count, seg_del_count) 138 fixed bin; /* number of deletes performed */ 139 140 dcl 1 create_info aligned like create_branch_info; 141 /* real storage for the create branch structure */ 142 1 1 /* BEGIN INCLUDE FILE - - - create_branch_info.incl.pl1 - - - created January 1975 */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(89-01-16,TLNguyen), approve(89-01-16,MCR8049), 1 6* audit(89-02-03,Parisek), install(89-03-15,MR12.3-1025): 1 7* 1. Declare version constant properly. 1 8* 2. Remove version 1 since it was never referenced and to force 1 9* callers to upgrade their programs. 1 10* END HISTORY COMMENTS */ 1 11 1 12 1 13 /* Modified December 1984 for dir_quota, Keith Loepere. */ 1 14 1 15 /* this include files gives the argument structure for create_branch_ */ 1 16 1 17 dcl 1 create_branch_info aligned based, 1 18 2 version fixed bin, /* set this to the largest value given below */ 1 19 2 switches unaligned, 1 20 3 dir_sw bit (1) unaligned, /* if on, a directory branch is wanted */ 1 21 3 copy_sw bit (1) unaligned, /* if on, initiating segment will be done by copying */ 1 22 3 chase_sw bit (1) unaligned, /* if on, if pathname is a link, it will be chased */ 1 23 3 priv_upgrade_sw bit (1) unaligned, /* privileged creation (ring 1) of upgraded object */ 1 24 3 parent_ac_sw bit (1) unaligned, /* if on, use parent's access class for seg or dir created */ 1 25 3 mbz1 bit (31) unaligned, /* pad to full word */ 1 26 2 mode bit (3) unaligned, /* segment or directory for acl for userid */ 1 27 2 mbz2 bit (33) unaligned, /* pad to full word */ 1 28 2 rings (3) fixed bin (3), /* branch's ring brackets */ 1 29 2 userid char (32), /* user's access control name */ 1 30 2 bitcnt fixed bin (24), /* bit count of the segment */ 1 31 2 quota fixed bin (18), /* for directories, this am't of quota will be moved to it */ 1 32 2 access_class bit (72), /* is the access class of the body of the branch */ 1 33 2 dir_quota fixed bin (18); /* for directories, this am't of dir quota will be moved to it */ 1 34 1 35 dcl create_branch_version_2 fixed bin int static options (constant) init (2); 1 36 1 37 /* END INCLUDE FILE - - - create_branch_info.incl.pl1 - - - */ 1 38 143 144 145 dcl acl_count fixed bin; /* number of acl entries */ 146 147 dcl 1 dir_acl (2) aligned, /* ACL structure for hcs_ entries */ 148 2 access_name char (32), /* access name */ 149 2 dir_modes bit (36), /* sma for the dir, bits 0,1,2 resp. */ 150 2 status_codes fixed bin (35); /* status for the access_name */ 151 152 dcl entries (bc + lc) bit (144) aligned based; 153 154 dcl 1 branch aligned based, 155 ( 2 type bit (2), 156 2 nname bit (16), 157 2 nindex bit (18), 158 2 dtm bit (36), 159 2 dtu bit (36), 160 2 mode bit (5), 161 2 pad bit (13), 162 2 records bit (18) 163 ) unaligned; 164 165 dcl names (1000) char (32) aligned based; 166 167 dcl (addr, clock, divide, fixed, index, max, min, null, rtrim, substr, unspec) 168 builtin; 169 170 dcl (any_other, cleanup) condition; 171 172 dcl 1 status_info aligned, 173 ( 2 type bit (2), 174 2 nnames bit (16), 175 2 nrp bit (18), 176 2 dtm bit (36), 177 2 dtu bit (36), 178 2 mode bit (5), 179 2 pad1 bit (13), 180 2 records bit (18), 181 2 dtd bit (36), 182 2 dtem bit (36), 183 2 pad2 bit (36), 184 2 curlen bit (12), 185 2 bitcnt bit (24), 186 2 did bit (4), 187 2 pad3 bit (4), 188 2 copysw bit (9), 189 2 pad4 bit (9), 190 2 rbs (0:2) bit (6), 191 2 uid bit (36) 192 ) unaligned; 193 194 195 init: 196 entry (rt, quota, access, ec); /* first entry point called by a process managing pools */ 197 198 /* This entry requires that the caller have access to the system_privilege_ gate */ 199 200 root = rt; 201 202 call parse_root; 203 204 call expand_pathname_ (pool_root_dir, pool_dir_parent, pool_dirname, ec); 205 if ec ^= 0 206 then return; /* trouble? */ 207 208 call hcs_$get_access_class (pool_dir_parent, pool_dirname, pool_access_class, ec); 209 /* used to determine if pool exists */ 210 if ec ^= 0 211 then return; /* it doesn't, can't continue */ 212 213 if aim_check_$equal (caller_auth, pool_access_class) 214 then need_priv = "0"b; 215 else need_priv = "1"b; /* must be able to call system_privilege_ gate */ 216 217 call hcs_$get_access_class (pool_root_dir, access_class_dir, pool_access_class, code); 218 /* dir already exist */ 219 220 if code = 0 221 then do; /* yes, were through */ 222 if ^aim_check_$equal (caller_auth, pool_access_class) 223 then do; 224 ec = error_table_$ai_restricted; 225 return; 226 end; 227 acl_count = 1; 228 dir_acl (1).dir_modes = "111"b || (33)"0"b; 229 dir_acl (1).access_name = get_group_id_$tag_star (); 230 mask = (36)"0"b; 231 mask_set = "0"b; 232 on cleanup call clean_up; 233 on any_other go to condition_error; 234 if need_priv 235 then do; /* only set the privileges when needed */ 236 call hcs_$set_ips_mask (mask, old_mask); 237 mask_set = "1"b; 238 call system_privilege_$dir_priv_on (priv_code); 239 end; 240 call hcs_$add_dir_acl_entries (pool_root_dir, access_class_dir, addr (dir_acl), acl_count, ec); 241 242 if priv_code = 0 243 then do; /* be sure we reset privileges as found */ 244 call system_privilege_$dir_priv_off (priv_code); 245 priv_code = 1; /* so we won't do it again */ 246 end; 247 248 revert any_other; /* we don't want to catch ips signals */ 249 250 if mask_set 251 then do; 252 mask_set = "0"b; 253 call hcs_$set_ips_mask (old_mask, mask); 254 /* let'er rip */ 255 end; 256 257 return; 258 end; 259 260 if code = error_table_$noentry 261 then do; /* have to create it */ 262 /* build branch structure */ 263 264 create_info.version = create_branch_version_2; 265 create_info.copy_sw = "0"b; 266 create_info.chase_sw = "0"b; /* we should never chase a link to create */ 267 create_info.priv_upgrade_sw = "0"b; /* not a ring 1 special seg */ 268 create_info.parent_ac_sw = "0"b; /* we will give the access class */ 269 create_info.mbz1 = (31)"0"b; /* this must be zero */ 270 create_info.bitcnt = 0; 271 create_info.mbz2 = (33)"0"b; 272 create_info.dir_sw = "1"b; 273 create_info.mode = "100"b; 274 create_info.userid = "*.*.*"; /* always give "s" to *.*.* */ 275 i = cu_$level_get (); /* to get around a compiler bug */ 276 create_info.rings (*) = i; 277 create_info.quota = quota; 278 create_info.dir_quota = max (10, divide (quota, 10, 17)); 279 pool_access_class = caller_auth; /* save this for future calls */ 280 create_info.access_class = pool_access_class; 281 282 mask_set = "0"b; /* info to the handler */ 283 mask = (36)"0"b; 284 285 on cleanup call clean_up; 286 on any_other go to condition_error; 287 288 if need_priv 289 then do; /* only when we need to */ 290 call hcs_$set_ips_mask (mask, old_mask); 291 mask_set = "1"b; 292 293 call system_privilege_$dir_priv_on (priv_code); 294 end; 295 296 create_branch: 297 call hcs_$create_branch_ (pool_root_dir, access_class_dir, addr (create_info), code); 298 299 if code = error_table_$invalid_move_qmax 300 then if create_info.dir_quota = 0 301 then go to error; 302 else do; /* try create without dir quota */ 303 create_info.dir_quota = 0; 304 go to create_branch; 305 end; 306 else if code ^= 0 307 then go to error; /* unable to create */ 308 309 acl_count = 2; /* set the ACL of access_class_dir */ 310 dir_acl (1).access_name = get_group_id_$tag_star (); 311 /* sma for *.SysDaemon.* */ 312 dir_acl (1).dir_modes = "111"b || (33)"0"b; 313 dir_acl (2).dir_modes = "100"b || (33)"0"b; 314 /* there is only s to *.*.* at this level */ 315 dir_acl (2).access_name = "*.*.*"; 316 317 call hcs_$add_dir_acl_entries (pool_root_dir, access_class_dir, addr (dir_acl), acl_count, code); 318 319 if code ^= 0 320 then go to error; 321 322 if priv_code = 0 323 then /* if we set the priv, reset it */ 324 call system_privilege_$dir_priv_off (priv_code); 325 326 priv_code = 1; /* so we don't try again */ 327 328 revert any_other; /* let ips signals fall through */ 329 330 if mask_set 331 then do; 332 mask_set = "0"b; 333 call hcs_$set_ips_mask (old_mask, mask); 334 /* restore the mask as we found it */ 335 end; 336 337 dir_acl (2).dir_modes = access & "100"b || (33)"0"b; 338 /* set initial ACL as caller requested (limit = s) */ 339 340 call hcs_$add_dir_inacl_entries (pool_root_dir, access_class_dir, addr (dir_acl), acl_count, 4, ec); 341 342 return; 343 end; 344 345 go to error; 346 347 open_user_pool: 348 entry (rt, a_personid, a_path, ec); 349 350 personid = a_personid; 351 root = rt; 352 353 path, a_path = ""; 354 355 call parse_root; /* determine the pool root directory name */ 356 357 access_class_path = pathname_ (pool_root_dir, access_class_dir); 358 359 /* see if there is sufficient quota to create the person directory */ 360 361 call hcs_$quota_get (access_class_path, access_quota, trp, tup, infqcnt, taccsw, access_used, ec); 362 if ec ^= 0 363 then return; /* OOPS */ 364 365 if access_quota <= access_used 366 then /* cover all bets, must be greater */ 367 call add_quota (root, (access_used - access_quota) + 2, ec); 368 /* try for quota of 2 pages */ 369 /* if not enough quota, keep going..user's dir may exist */ 370 /* don't check the code */ 371 372 /* build create_branch_ structure */ 373 374 create_info.version = create_branch_version_2; 375 create_info.copy_sw = "0"b; 376 create_info.chase_sw = "0"b; /* don't want to chase any links */ 377 create_info.priv_upgrade_sw = "0"b; /* not a ring 1 special seg */ 378 create_info.mbz1 = "0"b; /* must be zero */ 379 create_info.mbz2 = (33)"0"b; 380 create_info.bitcnt = 0; 381 create_info.dir_sw = "1"b; 382 create_info.mode = "100"b; /* new dir will have "s" to personid at the start */ 383 i = cu_$level_get (); /* to get around a compiler bug */ 384 create_info.rings (*) = i; 385 create_info.userid = substr (personid, 1, index (personid, " ") - 1) || ".*.*"; 386 create_info.quota = 0; 387 create_info.dir_quota = 0; 388 create_info.access_class = caller_auth; /* we always run at the callers authorization */ 389 390 call hcs_$create_branch_ (access_class_path, personid, addr (create_info), ec); 391 392 if ec = error_table_$namedup | ec = 0 393 then do; /* keep going as long as it is there */ 394 395 acl_count = 2; 396 dir_acl (1).dir_modes = "111"b || (33)"0"b; 397 dir_acl (1).access_name = get_group_id_$tag_star (); 398 dir_acl (2).dir_modes = "100"b || (33)"0"b; 399 /* give the user only s permission */ 400 dir_acl (2).access_name = rtrim (personid) || ".*.*"; 401 /* so he can't delete while we are writing */ 402 call hcs_$add_dir_acl_entries (access_class_path, personid, addr (dir_acl), acl_count, ec); 403 404 if ec ^= 0 405 then return; 406 407 person_path = pathname_ (access_class_path, personid); 408 /* build pathname */ 409 a_path = person_path; /* quota set to zero, give user the pathname */ 410 ec = 0; /* return good status */ 411 return; 412 end; 413 return; /* code was not namedup or 0 */ 414 415 416 417 add_quota: 418 entry (rt, quota, ec); 419 420 /* This entry requires that the caller have access to the system_privilege_ gate */ 421 422 ec = 0; /* be ready for a clean exit */ 423 if quota = 0 424 then return; /* meaningless call */ 425 426 root = rt; 427 428 call parse_root; /* determine the pool_root_dir */ 429 430 if quota < 0 431 then do; /* user wants to move quota back to pool_root_dir */ 432 433 access_class_path = pathname_ (pool_root_dir, access_class_dir); 434 call hcs_$quota_get (access_class_path, access_quota, trp, tup, infqcnt, taccsw, access_used, ec); 435 /* get quota info for the dir */ 436 437 if ec ^= 0 438 then return; 439 440 if access_used = 0 441 then access_used = 1; /* min used = 1, can't make quota non-terminal */ 442 443 if access_used >= access_quota 444 then do; /* any quota to move? */ 445 if -quota >= access_quota 446 then ec = error_table_$invalid_move_quota; 447 /* choose an error code */ 448 else ec = error_table_$rqover; 449 return; 450 end; 451 452 quota_change = -(min (-quota, (access_quota - access_used))); 453 /* move only what is not in use */ 454 455 end; 456 else do; /* move quota to the access class pool dir */ 457 458 call hcs_$quota_get (pool_root_dir, root_quota, trp, tup, infqcnt, taccsw, root_used, ec); 459 /* get quota data on pool_root_dir */ 460 461 if ec ^= 0 462 then return; 463 464 if root_used = 0 465 then root_used = 1; /* min used = 1, can't make root non-terminal */ 466 467 if root_used >= root_quota 468 then do; /* see if there is any to move */ 469 if quota >= root_quota 470 then ec = error_table_$invalid_move_quota; 471 /* choose an error code */ 472 else ec = error_table_$rqover; 473 return; 474 end; 475 476 quota_change = min (root_quota - root_used, quota); 477 /* can move only up to used */ 478 end; 479 480 if need_priv 481 then /* only use the privileged call if needed */ 482 call priv_move_quota_ ((pool_root_dir), (access_class_dir), (quota_change), ec); 483 else call hcs_$quota_move (pool_root_dir, access_class_dir, quota_change, ec); 484 485 return; 486 487 close_user_pool: 488 entry (rt, a_personid, quota, access, ec); 489 490 root = rt; 491 personid = a_personid; 492 call parse_root; /* determine the pool root dir */ 493 494 access_class_path = pathname_ (pool_root_dir, access_class_dir); 495 acl_count = 1; /* replace the acl for Person.*.* */ 496 dir_acl (1).access_name = rtrim (personid) || ".*.*"; 497 dir_acl (1).dir_modes = access & "110"b || (33)"0"b; 498 /* "sm" limit on caller specified access */ 499 call hcs_$add_dir_acl_entries (access_class_path, personid, addr (dir_acl), acl_count, ec); 500 if ec ^= 0 501 then return; 502 return; /* all done */ 503 504 505 506 find_pool: 507 entry (rt, ac, a_personid, a_path, ec); 508 509 path, a_path = ""; 510 personid = a_personid; 511 root = rt; 512 513 call parse_root; /* find the pool_root_dir */ 514 515 call convert_authorization_$encode (ac, access_class_dir); 516 /* might be asking about some other level */ 517 518 if access_class_dir = "" 519 then access_class_dir = "system_low"; 520 521 access_class_path = pathname_ (pool_root_dir, access_class_dir); 522 523 call hcs_$status_minf (access_class_path, personid, 0, type, bitcnt, code); 524 525 if code ^= 0 526 then do; /* non-zero code may be useful */ 527 528 if code = error_table_$noentry | code = error_table_$no_dir 529 then do; /* access_class_dir>personid does not exist */ 530 code = error_table_$noentry; 531 return_path: 532 a_path = pathname_ (access_class_path, personid); 533 ec = code; /* return the correct path and tell him it doesn't exist */ 534 return; 535 end; 536 537 a_path = ""; /* don't give him a path for any other error */ 538 ec = code; /* copy the code and let the user figure it out */ 539 return; 540 541 end; 542 543 /* zero code means we found a branch */ 544 545 if type = 2 546 then go to return_path; /* must be a directory, however */ 547 548 ec = error_table_$notadir; /* if a seg or link, tell him not found */ 549 a_path = ""; 550 return; 551 552 553 554 clean_pool: 555 entry (rt, age, a_grace_quota, ec); /* garbage collection entry */ 556 557 /* This entry requires that the caller have access to the system_privilege_ gate */ 558 559 /* We will walk through the entire pool hierarchy deleting entries which should 560* not be there or have been there too long */ 561 562 priv_code = 1; /* only reset privileges if set */ 563 mask_set = "0"b; /* we have not changed the ips mask yet */ 564 mask = (36)"0"b; 565 566 on cleanup call clean_up; /* establish handlers for consistency */ 567 on any_other go to condition_error; 568 569 call hcs_$set_ips_mask (mask, old_mask); /* don't want any interrupts */ 570 mask_set = "1"b; 571 call system_privilege_$dir_priv_on (priv_code); 572 573 root = rt; /* copy args */ 574 call parse_root; /* get pname and auth for caller */ 575 576 msdays = age * 86400000000; /* convert time to msecs */ 577 now = clock (); 578 limit = now - msdays; 579 580 grace_quota = max (0, a_grace_quota); /* must be 0 or positive */ 581 area_ptr = get_system_free_area_ (); 582 583 seg_switches = "100100"b; /* for force deleting segments only - no questions */ 584 dir_switches = "101000"b; /* deletes dirs only */ 585 all_switches = "101110"b; /* deletes everything */ 586 dir_lk_switches = "101010"b; /* deletes just directory or link */ 587 588 call hcs_$star_list_ (pool_root_dir, "*", 2, area_ptr, bc, lc, eptr, nptr, code); 589 590 if code = error_table_$nomatch 591 then do; /* empty pool */ 592 empty: 593 ec = 0; /* we did what was asked */ 594 if priv_code = 0 595 then call system_privilege_$dir_priv_off (priv_code); 596 /* undo what we did */ 597 priv_code = 1; 598 revert any_other; /* now the handler can be reset */ 599 call clean_up; /* free storage and reset privileges */ 600 return; 601 end; 602 603 if code ^= 0 604 then go to error; /* all other codes are bad news */ 605 606 no_of_adirs = bc + lc; /* number of entries in pool */ 607 608 start_adir_loop: 609 do i = 1 to no_of_adirs; /* look at each entry in the pool root dir */ 610 611 aep = addr (eptr -> entries (i)); /* get ptr to an entry */ 612 if aep -> branch.type ^= "10"b 613 then go to end_adir_loop; /* if not a dir, then skip it */ 614 615 aname = nptr -> names (fixed (aep -> branch.nindex, 17)); 616 /* get its name */ 617 adumdir = pathname_ (pool_root_dir, aname); /* and make a pname */ 618 619 call hcs_$star_list_ (adumdir, "*", 3, area_ptr, bc, lc, peptr, pnptr, code); 620 /* now look in it */ 621 622 if code = error_table_$nomatch 623 then do; /* it is empty */ 624 code = 0; 625 no_of_pdirs, person_del_count = 0; 626 go to start_pdir_loop; 627 end; 628 629 if code ^= 0 630 then go to end_adir_loop; /* oh well, try the next one */ 631 632 person_del_count = 0; /* its not empty, init the delete count */ 633 no_of_pdirs = bc + lc; /* no of entries in the access_class_dir */ 634 635 start_pdir_loop: 636 do j = 1 to no_of_pdirs; /* look at everything in this access_class_dir */ 637 pep = addr (peptr -> entries (j)); /* get an entry */ 638 pname = pnptr -> names (fixed (pep -> branch.nindex, 17)); 639 /* build a name */ 640 pdumdir = pathname_ (adumdir, pname); 641 642 if pep -> branch.type ^= "10"b 643 then do; /* if not a dir then delete it */ 644 delete_pdir: 645 call delete_$path (adumdir, pname, all_switches, "pool_manager_", code); 646 if code = 0 647 then person_del_count = person_del_count + 1; 648 /* bump the count */ 649 go to end_pdir_loop; 650 end; 651 652 call hcs_$status_long (adumdir, pname, 0, addr (status_info), null, code); 653 if code ^= 0 654 then go to end_pdir_loop; /* trouble, try the next one */ 655 656 dum72 = "0"b; /* see if we can delete it without looking at entries */ 657 substr (dum72, 21, 36) = status_info.dtem; 658 /* get the dtem */ 659 if dum72 < unspec (limit) 660 then go to delete_pdir; /* is it old */ 661 662 call hcs_$star_list_ (pdumdir, "**", 3, area_ptr, bc, lc, septr, snptr, code); 663 /* no, must search it */ 664 665 if code = error_table_$nomatch 666 then do; /* empty? */ 667 code = 0; 668 no_of_segs, seg_del_count = 0; 669 go to start_seg_loop; 670 end; 671 672 if code ^= 0 673 then go to end_pdir_loop; /* keep trying */ 674 675 seg_del_count = 0; /* get ready to look at segs in the person dir */ 676 no_of_segs = bc + lc; 677 start_seg_loop: 678 do k = 1 to no_of_segs; /* look at each entry in person dir */ 679 sep = addr (septr -> entries (k)); /* get the entry */ 680 sname = snptr -> names (fixed (sep -> branch.nindex, 17)); 681 if sep -> branch.type ^= "01"b 682 then do; /* delete if not a segment */ 683 call delete_$path (pdumdir, sname, dir_lk_switches, "pool_manager_", code); 684 if code = 0 685 then do; /* we deleted it */ 686 seg_del_count = seg_del_count + 1; 687 go to end_seg_loop; 688 end; 689 if code ^= error_table_$nondirseg 690 then go to end_seg_loop; /* someone using it */ 691 /* otherwise, it was an MSF */ 692 end; 693 694 695 dum72 = "0"b; 696 substr (dum72, 21, 36) = sep -> branch.dtm; 697 /* get its age */ 698 699 if dum72 < unspec (limit) 700 then do; /* can we delete it */ 701 702 call delete_$path (pdumdir, sname, seg_switches, "pool_manager_", code); 703 if code = 0 704 then seg_del_count = seg_del_count + 1; 705 /* bump the delete count */ 706 call hcs_$quota_move (adumdir, pname, -fixed (sep -> branch.records), code); 707 /* recover quota */ 708 end; 709 end_seg_loop: 710 end; 711 if seg_del_count = no_of_segs 712 then do; /* is the dir empty */ 713 call delete_$path (adumdir, pname, dir_switches, "pool_manager_", code); 714 /* if so delete it */ 715 if code = 0 716 then person_del_count = person_del_count + 1; 717 end; 718 719 end_pdir_loop: 720 if septr ^= null 721 then free septr -> entries; 722 if snptr ^= null 723 then free snptr -> names; 724 725 end; 726 727 if person_del_count = no_of_pdirs 728 then do; /* is the access class dir empty */ 729 call delete_$path (pool_root_dir, aname, dir_switches, "pool_manager_", code); 730 if code = 0 731 then go to end_adir_loop; /* when deleted, we are done */ 732 /* otherwise try to move back to grace quota */ 733 end; 734 735 call hcs_$quota_get (adumdir, access_quota, trp, tup, infqcnt, taccsw, access_used, code); 736 if code ^= 0 737 then go to end_adir_loop; 738 739 quota_change = access_quota - max ((access_used + grace_quota), 1); 740 /* adjust the quota */ 741 if quota_change ^= 0 742 then /* if anything to move.... */ 743 call hcs_$quota_move (pool_root_dir, aname, (-quota_change), code); 744 745 end_adir_loop: 746 if peptr ^= null 747 then free peptr -> entries; 748 if pnptr ^= null 749 then free pnptr -> names; 750 751 end; 752 753 ec, code = 0; /* just to be sure we say all is well */ 754 755 if priv_code = 0 756 then call system_privilege_$dir_priv_off (priv_code); 757 priv_code = 1; /* make it safe to revert the condition handler */ 758 759 revert any_other; /* in case a condition occurs from clean_up */ 760 761 call clean_up; 762 763 return; 764 765 /* */ 766 767 error: 768 ec = code; /* copy the status */ 769 770 if priv_code = 0 771 then call system_privilege_$dir_priv_off (priv_code); 772 priv_code = 1; 773 774 revert any_other; 775 776 call clean_up; 777 778 return; /* and exit */ 779 780 781 condition_error: /* Some condition occured. Don't know the status of anything so we must */ 782 /* return a failure code so we don't fool the caller */ 783 ec = error_table_$action_not_performed; 784 785 if priv_code = 0 786 then call system_privilege_$dir_priv_off (priv_code); 787 priv_code = 1; 788 789 revert any_other; /* in case of a condition during clean_up */ 790 791 call clean_up; 792 793 return; 794 795 parse_root: 796 proc; 797 798 do i = 1 to no_of_keywords; /* check for keyword match */ 799 if root = keyword (i) 800 then go to hit; /* found a match */ 801 else ; /* keep looking */ 802 end; 803 804 pool_root_dir = root; /* must be a pathname */ 805 go to get_auth; /* determine the authorization */ 806 807 hit: 808 pool_root_dir = key_path (i); /* select the appropriate path */ 809 810 get_auth: 811 caller_auth = get_authorization_ (); /* get the access_class of the process */ 812 813 call convert_authorization_$encode (caller_auth, access_class_dir); 814 /* convert to a unique name */ 815 816 if access_class_dir = "" 817 then access_class_dir = "system_low"; 818 819 return; 820 821 822 end; 823 824 825 clean_up: 826 proc; 827 828 /* This internal proc is the handler for all conditions, cleanup, and a 829* general tidying up routine. However, if there is a default handler 830* active which will call this, we are open to recursive errors or a tight loop. 831* The freen_ proc could signal the area condition and there could be a 832* linkage error on system_privilege_. So, beware of the conditions at the 833* time it is called. */ 834 835 836 if priv_code = 0 837 then call system_privilege_$dir_priv_off (priv_code); 838 /* turn priv off in case one is left */ 839 priv_code = 1; /* don't do it again */ 840 841 if mask_set 842 then do; 843 844 mask_set = "0"b; /* reset before any ips signal can interrupt */ 845 call hcs_$set_ips_mask (old_mask, mask);/* open the gate */ 846 847 end; 848 849 850 if septr ^= null 851 then free septr -> entries; 852 if snptr ^= null 853 then free snptr -> names; 854 if peptr ^= null 855 then free peptr -> entries; 856 if pnptr ^= null 857 then free pnptr -> names; 858 if eptr ^= null 859 then free eptr -> entries; 860 if nptr ^= null 861 then free nptr -> names; 862 863 864 return; 865 end; 866 867 end pool_manager_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/15/89 0800.0 pool_manager_.pl1 >special_ldd>install>MR12.3-1025>pool_manager_.pl1 143 1 03/15/89 0759.4 create_branch_info.incl.pl1 >special_ldd>install>MR12.3-1025>create_branch_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. a_grace_quota parameter fixed bin(17,0) dcl 79 ref 554 580 a_path parameter char packed unaligned dcl 77 set ref 347 353* 409* 506 509* 531* 537* 549* a_personid parameter char packed unaligned dcl 78 ref 347 350 487 491 506 510 ac parameter bit(72) dcl 80 set ref 506 515* access parameter bit(36) dcl 81 ref 195 337 487 497 access_class 20 001001 automatic bit(72) level 2 dcl 140 set ref 280* 388* access_class_dir 000100 automatic char(32) packed unaligned dcl 82 set ref 217* 240* 296* 317* 340* 357* 433* 480 483* 494* 515* 518 518* 521* 813* 816 816* access_class_path 000110 automatic char(168) packed unaligned dcl 83 set ref 357* 361* 390* 402* 407* 433* 434* 494* 499* 521* 523* 531* access_name 001025 automatic char(32) array level 2 dcl 147 set ref 229* 310* 315* 397* 400* 496* access_quota 000162 automatic fixed bin(18,0) dcl 84 set ref 361* 365 365 434* 443 445 452 735* 739 access_used 000163 automatic fixed bin(17,0) dcl 85 set ref 361* 365 365 434* 440 440* 443 452 735* 739 acl_count 001024 automatic fixed bin(17,0) dcl 145 set ref 227* 240* 309* 317* 340* 395* 402* 495* 499* addr builtin function dcl 167 ref 240 240 296 296 317 317 340 340 390 390 402 402 499 499 611 637 652 652 679 adumdir 000572 automatic char(168) packed unaligned dcl 130 set ref 617* 619* 640* 644* 652* 706* 713* 735* aep 000754 automatic pointer initial dcl 132 set ref 132* 611* 612 615 age parameter fixed bin(17,0) dcl 86 ref 554 576 aim_check_$equal 000014 constant entry external dcl 29 ref 213 222 all_switches 000164 automatic bit(6) packed unaligned dcl 87 set ref 585* 644* aname 000716 automatic char(32) packed unaligned dcl 131 set ref 615* 617* 729* 741* any_other 001052 stack reference condition dcl 170 ref 233 248 286 328 567 598 759 774 789 area_ptr 000746 automatic pointer initial dcl 132 set ref 132* 581* 588* 619* 662* bc 000165 automatic fixed bin(17,0) dcl 88 set ref 588* 606 619* 633 662* 676 719 745 850 854 858 bitcnt 000166 automatic fixed bin(24,0) dcl 89 in procedure "pool_manager_" set ref 523* bitcnt 16 001001 automatic fixed bin(24,0) level 2 in structure "create_info" dcl 140 in procedure "pool_manager_" set ref 270* 380* branch based structure level 1 dcl 154 caller_auth 000170 automatic bit(72) dcl 90 set ref 213* 222* 279 388 810* 813* chase_sw 1(02) 001001 automatic bit(1) level 3 packed packed unaligned dcl 140 set ref 266* 376* cleanup 001060 stack reference condition dcl 170 ref 232 285 566 clock builtin function dcl 167 ref 577 code 000172 automatic fixed bin(35,0) dcl 91 set ref 217* 220 260 296* 299 306 317* 319 523* 525 528 528 530* 533 538 588* 590 603 619* 622 624* 629 644* 646 652* 653 662* 665 667* 672 683* 684 689 702* 703 706* 713* 715 729* 730 735* 736 741* 753* 767 convert_authorization_$encode 000016 constant entry external dcl 30 ref 515 813 copy_sw 1(01) 001001 automatic bit(1) level 3 packed packed unaligned dcl 140 set ref 265* 375* create_branch_info based structure level 1 dcl 1-17 create_branch_version_2 constant fixed bin(17,0) initial dcl 1-35 ref 264 374 create_info 001001 automatic structure level 1 dcl 140 set ref 296 296 390 390 cu_$level_get 000020 constant entry external dcl 32 ref 275 383 delete_$path 000022 constant entry external dcl 33 ref 644 683 702 713 729 dir_acl 001025 automatic structure array level 1 dcl 147 set ref 240 240 317 317 340 340 402 402 499 499 dir_lk_switches 000174 automatic bit(6) packed unaligned dcl 93 set ref 586* 683* dir_modes 10 001025 automatic bit(36) array level 2 dcl 147 set ref 228* 312* 313* 337* 396* 398* 497* dir_quota 22 001001 automatic fixed bin(18,0) level 2 dcl 140 set ref 278* 299 303* 387* dir_sw 1 001001 automatic bit(1) level 3 packed packed unaligned dcl 140 set ref 272* 381* dir_switches 000173 automatic bit(6) packed unaligned dcl 92 set ref 584* 713* 729* divide builtin function dcl 167 ref 278 dtem 5 001066 automatic bit(36) level 2 packed packed unaligned dcl 172 set ref 657 dtm 1 based bit(36) level 2 packed packed unaligned dcl 154 ref 696 dum72 000176 automatic bit(72) dcl 94 set ref 656* 657* 659 695* 696* 699 ec parameter fixed bin(35,0) dcl 95 set ref 195 204* 205 208* 210 224* 240* 340* 347 361* 362 365* 390* 392 392 402* 404 410* 417 422* 434* 437 445* 448* 458* 461 469* 472* 480* 483* 487 499* 500 506 533* 538* 548* 554 592* 753* 767* 781* entries based bit(144) array dcl 152 set ref 611 637 679 719 745 850 854 858 eptr 000750 automatic pointer initial dcl 132 set ref 132* 588* 611 858 858 error_table_$action_not_performed 000072 external static fixed bin(35,0) dcl 62 ref 781 error_table_$ai_restricted 000070 external static fixed bin(35,0) dcl 60 ref 224 error_table_$invalid_move_qmax 000076 external static fixed bin(35,0) dcl 65 ref 299 error_table_$invalid_move_quota 000100 external static fixed bin(35,0) dcl 67 ref 445 469 error_table_$namedup 000102 external static fixed bin(35,0) dcl 69 ref 392 error_table_$no_dir 000104 external static fixed bin(35,0) dcl 70 ref 528 error_table_$noentry 000112 external static fixed bin(35,0) dcl 73 ref 260 528 530 error_table_$nomatch 000106 external static fixed bin(35,0) dcl 71 ref 590 622 665 error_table_$nondirseg 000110 external static fixed bin(35,0) dcl 72 ref 689 error_table_$notadir 000114 external static fixed bin(35,0) dcl 74 ref 548 error_table_$rqover 000074 external static fixed bin(35,0) dcl 64 ref 448 472 expand_pathname_ 000024 constant entry external dcl 34 ref 204 fixed builtin function dcl 167 ref 615 638 680 706 get_authorization_ 000026 constant entry external dcl 35 ref 810 get_group_id_$tag_star 000030 constant entry external dcl 36 ref 229 310 397 get_system_free_area_ 000032 constant entry external dcl 37 ref 581 grace_quota 000200 automatic fixed bin(17,0) dcl 96 set ref 580* 739 hcs_$add_dir_acl_entries 000034 constant entry external dcl 38 ref 240 317 402 499 hcs_$add_dir_inacl_entries 000036 constant entry external dcl 40 ref 340 hcs_$create_branch_ 000040 constant entry external dcl 42 ref 296 390 hcs_$get_access_class 000042 constant entry external dcl 43 ref 208 217 hcs_$quota_get 000044 constant entry external dcl 44 ref 361 434 458 735 hcs_$quota_move 000046 constant entry external dcl 46 ref 483 706 741 hcs_$set_ips_mask 000050 constant entry external dcl 47 ref 236 253 290 333 569 845 hcs_$star_list_ 000052 constant entry external dcl 48 ref 588 619 662 hcs_$status_long 000054 constant entry external dcl 50 ref 652 hcs_$status_minf 000056 constant entry external dcl 51 ref 523 i 000201 automatic fixed bin(17,0) dcl 97 set ref 275* 276 383* 384 608* 611* 798* 799* 807 index builtin function dcl 167 ref 385 infqcnt 000202 automatic fixed bin(17,0) dcl 98 set ref 361* 434* 458* 735* j 000772 automatic fixed bin(17,0) dcl 134 set ref 635* 637* k 000773 automatic fixed bin(17,0) dcl 134 set ref 677* 679* key_path 000124 constant char(168) initial array packed unaligned dcl 99 ref 807 keyword 000000 constant char(168) initial array packed unaligned dcl 100 ref 799 lc 000203 automatic fixed bin(17,0) dcl 101 set ref 588* 606 619* 633 662* 676 719 745 850 854 858 limit 000204 automatic fixed bin(71,0) dcl 102 set ref 578* 659 699 mask 000206 automatic bit(36) dcl 103 set ref 230* 236* 253* 283* 290* 333* 564* 569* 845* mask_set 000207 automatic bit(1) dcl 104 set ref 231* 237* 250 252* 282* 291* 330 332* 563* 570* 841 844* max builtin function dcl 167 ref 278 580 739 mbz1 1(05) 001001 automatic bit(31) level 3 packed packed unaligned dcl 140 set ref 269* 378* mbz2 2(03) 001001 automatic bit(33) level 2 packed packed unaligned dcl 140 set ref 271* 379* min builtin function dcl 167 ref 452 476 mode 2 001001 automatic bit(3) level 2 packed packed unaligned dcl 140 set ref 273* 382* msdays 000210 automatic fixed bin(71,0) dcl 105 set ref 576* 578 names based char(32) array dcl 165 ref 615 638 680 722 748 852 856 860 need_priv 000010 internal static bit(1) packed unaligned dcl 106 set ref 213* 215* 234 288 480 nindex 0(18) based bit(18) level 2 packed packed unaligned dcl 154 ref 615 638 680 no_of_adirs 000774 automatic fixed bin(17,0) dcl 135 set ref 606* 608 no_of_keywords 000212 automatic fixed bin(17,0) initial dcl 107 set ref 107* 798 no_of_pdirs 000775 automatic fixed bin(17,0) dcl 135 set ref 625* 633* 635 727 no_of_segs 000776 automatic fixed bin(17,0) dcl 135 set ref 668* 676* 677 711 now 000214 automatic fixed bin(71,0) dcl 108 set ref 577* 578 nptr 000752 automatic pointer initial dcl 132 set ref 132* 588* 615 860 860 null builtin function dcl 167 ref 132 132 132 132 132 132 132 132 132 132 652 652 719 722 745 748 850 852 854 856 858 860 old_mask 000216 automatic bit(36) dcl 109 set ref 236* 253* 290* 333* 569* 845* parent_ac_sw 1(04) 001001 automatic bit(1) level 3 packed packed unaligned dcl 140 set ref 268* path 000217 automatic char(168) packed unaligned dcl 110 set ref 353* 509* pathname_ 000066 constant entry external dcl 58 ref 357 407 433 494 521 531 617 640 pdumdir 000644 automatic char(168) packed unaligned dcl 130 set ref 640* 662* 683* 702* pep 000762 automatic pointer initial dcl 132 set ref 132* 637* 638 642 peptr 000756 automatic pointer initial dcl 132 set ref 132* 619* 637 745 745 854 854 person_del_count 000777 automatic fixed bin(17,0) dcl 137 set ref 625* 632* 646* 646 715* 715 727 person_path 000271 automatic char(168) packed unaligned dcl 111 set ref 407* 409 personid 000343 automatic char(32) packed unaligned dcl 112 set ref 350* 385 385 390* 400 402* 407* 491* 496 499* 510* 523* 531* pname 000726 automatic char(32) packed unaligned dcl 131 set ref 638* 640* 644* 652* 706* 713* pnptr 000760 automatic pointer initial dcl 132 set ref 132* 619* 638 748 748 856 856 pool_access_class 000012 internal static bit(72) dcl 113 set ref 208* 213* 217* 222* 279* 280 pool_dir_parent 000353 automatic char(168) packed unaligned dcl 115 set ref 204* 208* pool_dirname 000425 automatic char(32) packed unaligned dcl 116 set ref 204* 208* pool_root_dir 000435 automatic char(168) packed unaligned dcl 117 set ref 204* 217* 240* 296* 317* 340* 357* 433* 458* 480 483* 494* 521* 588* 617* 729* 741* 804* 807* priv_code 000507 automatic fixed bin(35,0) initial dcl 118 set ref 118* 238* 242 244* 245* 293* 322 322* 326* 562* 571* 594 594* 597* 755 755* 757* 770 770* 772* 785 785* 787* 836 836* 839* priv_move_quota_ 000060 constant entry external dcl 53 ref 480 priv_upgrade_sw 1(03) 001001 automatic bit(1) level 3 packed packed unaligned dcl 140 set ref 267* 377* quota parameter fixed bin(17,0) dcl 119 in procedure "pool_manager_" ref 195 277 278 417 423 430 445 452 469 476 487 quota 17 001001 automatic fixed bin(18,0) level 2 in structure "create_info" dcl 140 in procedure "pool_manager_" set ref 277* 386* quota_change 000510 automatic fixed bin(18,0) dcl 120 set ref 452* 476* 480 483* 739* 741 741 records 3(18) based bit(18) level 2 packed packed unaligned dcl 154 ref 706 rings 3 001001 automatic fixed bin(3,0) array level 2 dcl 140 set ref 276* 384* root 000511 automatic char(168) packed unaligned dcl 121 set ref 200* 351* 365* 426* 490* 511* 573* 799 804 root_quota 000563 automatic fixed bin(18,0) dcl 122 set ref 458* 467 469 476 root_used 000564 automatic fixed bin(17,0) dcl 123 set ref 458* 464 464* 467 476 rt parameter char packed unaligned dcl 124 ref 195 200 347 351 417 426 487 490 506 511 554 573 rtrim builtin function dcl 167 ref 400 496 seg_del_count 001000 automatic fixed bin(17,0) dcl 137 set ref 668* 675* 686* 686 703* 703 711 seg_switches 000565 automatic bit(6) packed unaligned dcl 125 set ref 583* 702* sep 000770 automatic pointer initial dcl 132 set ref 132* 679* 680 681 696 706 septr 000764 automatic pointer initial dcl 132 set ref 132* 662* 679 719 719 850 850 sname 000736 automatic char(32) packed unaligned dcl 131 set ref 680* 683* 702* snptr 000766 automatic pointer initial dcl 132 set ref 132* 662* 680 722 722 852 852 status_info 001066 automatic structure level 1 dcl 172 set ref 652 652 substr builtin function dcl 167 set ref 385 657* 696* switches 1 001001 automatic structure level 2 packed packed unaligned dcl 140 system_privilege_$dir_priv_off 000062 constant entry external dcl 54 ref 244 322 594 755 770 785 836 system_privilege_$dir_priv_on 000064 constant entry external dcl 56 ref 238 293 571 taccsw 000566 automatic fixed bin(1,0) dcl 126 set ref 361* 434* 458* 735* trp 000567 automatic fixed bin(35,0) dcl 127 set ref 361* 434* 458* 735* tup 000570 automatic bit(36) dcl 128 set ref 361* 434* 458* 735* type 000571 automatic fixed bin(2,0) dcl 129 in procedure "pool_manager_" set ref 523* 545 type based bit(2) level 2 in structure "branch" packed packed unaligned dcl 154 in procedure "pool_manager_" ref 612 642 681 unspec builtin function dcl 167 ref 659 699 userid 6 001001 automatic char(32) level 2 dcl 140 set ref 274* 385* version 001001 automatic fixed bin(17,0) level 2 dcl 140 set ref 264* 374* NAMES DECLARED BY EXPLICIT CONTEXT. add_quota 002046 constant entry external dcl 417 ref 365 clean_pool 003067 constant entry external dcl 554 clean_up 004623 constant entry internal dcl 825 ref 232 285 566 599 761 776 791 close_user_pool 002411 constant entry external dcl 487 condition_error 004512 constant label dcl 781 ref 233 286 567 create_branch 001132 constant label dcl 296 ref 304 delete_pdir 003555 constant label dcl 644 ref 659 empty 003320 constant label dcl 592 end_adir_loop 004423 constant label dcl 745 ref 612 629 730 736 end_pdir_loop 004232 constant label dcl 719 ref 649 653 672 end_seg_loop 004165 constant label dcl 709 ref 687 689 error 004467 constant label dcl 767 ref 299 306 319 345 603 find_pool 002576 constant entry external dcl 506 get_auth 004566 constant label dcl 810 ref 805 hit 004562 constant label dcl 807 ref 799 init 000361 constant entry external dcl 195 open_user_pool 001355 constant entry external dcl 347 parse_root 004535 constant entry internal dcl 795 ref 202 355 428 492 513 574 pool_manager_ 000345 constant entry external dcl 12 return_path 002773 constant label dcl 531 ref 545 start_adir_loop 003346 constant label dcl 608 start_pdir_loop 003505 constant label dcl 635 set ref 626 start_seg_loop 003764 constant label dcl 677 ref 669 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5502 5620 4752 5512 Length 6160 4752 116 324 527 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME pool_manager_ 774 external procedure is an external procedure. on unit on line 232 64 on unit on unit on line 233 64 on unit on unit on line 285 64 on unit on unit on line 286 64 on unit on unit on line 566 64 on unit on unit on line 567 64 on unit parse_root internal procedure shares stack frame of external procedure pool_manager_. clean_up 74 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 need_priv pool_manager_ 000012 pool_access_class pool_manager_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME pool_manager_ 000100 access_class_dir pool_manager_ 000110 access_class_path pool_manager_ 000162 access_quota pool_manager_ 000163 access_used pool_manager_ 000164 all_switches pool_manager_ 000165 bc pool_manager_ 000166 bitcnt pool_manager_ 000170 caller_auth pool_manager_ 000172 code pool_manager_ 000173 dir_switches pool_manager_ 000174 dir_lk_switches pool_manager_ 000176 dum72 pool_manager_ 000200 grace_quota pool_manager_ 000201 i pool_manager_ 000202 infqcnt pool_manager_ 000203 lc pool_manager_ 000204 limit pool_manager_ 000206 mask pool_manager_ 000207 mask_set pool_manager_ 000210 msdays pool_manager_ 000212 no_of_keywords pool_manager_ 000214 now pool_manager_ 000216 old_mask pool_manager_ 000217 path pool_manager_ 000271 person_path pool_manager_ 000343 personid pool_manager_ 000353 pool_dir_parent pool_manager_ 000425 pool_dirname pool_manager_ 000435 pool_root_dir pool_manager_ 000507 priv_code pool_manager_ 000510 quota_change pool_manager_ 000511 root pool_manager_ 000563 root_quota pool_manager_ 000564 root_used pool_manager_ 000565 seg_switches pool_manager_ 000566 taccsw pool_manager_ 000567 trp pool_manager_ 000570 tup pool_manager_ 000571 type pool_manager_ 000572 adumdir pool_manager_ 000644 pdumdir pool_manager_ 000716 aname pool_manager_ 000726 pname pool_manager_ 000736 sname pool_manager_ 000746 area_ptr pool_manager_ 000750 eptr pool_manager_ 000752 nptr pool_manager_ 000754 aep pool_manager_ 000756 peptr pool_manager_ 000760 pnptr pool_manager_ 000762 pep pool_manager_ 000764 septr pool_manager_ 000766 snptr pool_manager_ 000770 sep pool_manager_ 000772 j pool_manager_ 000773 k pool_manager_ 000774 no_of_adirs pool_manager_ 000775 no_of_pdirs pool_manager_ 000776 no_of_segs pool_manager_ 000777 person_del_count pool_manager_ 001000 seg_del_count pool_manager_ 001001 create_info pool_manager_ 001024 acl_count pool_manager_ 001025 dir_acl pool_manager_ 001066 status_info pool_manager_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_in_desc call_ext_out_desc call_ext_out call_int_this call_int_other return_mac tra_ext_1 mpfx2 enable_op shorten_stack ext_entry ext_entry_desc int_entry op_freen_ clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. aim_check_$equal convert_authorization_$encode cu_$level_get delete_$path expand_pathname_ get_authorization_ get_group_id_$tag_star get_system_free_area_ hcs_$add_dir_acl_entries hcs_$add_dir_inacl_entries hcs_$create_branch_ hcs_$get_access_class hcs_$quota_get hcs_$quota_move hcs_$set_ips_mask hcs_$star_list_ hcs_$status_long hcs_$status_minf pathname_ priv_move_quota_ system_privilege_$dir_priv_off system_privilege_$dir_priv_on THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$ai_restricted error_table_$invalid_move_qmax error_table_$invalid_move_quota error_table_$namedup error_table_$no_dir error_table_$noentry error_table_$nomatch error_table_$nondirseg error_table_$notadir error_table_$rqover LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 107 000323 118 000325 132 000327 12 000344 27 000353 195 000354 200 000404 202 000412 204 000413 205 000437 208 000441 210 000466 213 000470 215 000511 217 000514 220 000540 222 000542 224 000560 225 000563 227 000564 228 000566 229 000570 230 000602 231 000603 232 000604 233 000626 234 000645 236 000650 237 000660 238 000662 240 000671 242 000724 244 000726 245 000735 248 000737 250 000740 252 000742 253 000743 257 000754 260 000755 264 000760 265 000762 266 000764 267 000766 268 000770 269 000772 270 000774 271 000775 272 000777 273 001001 274 001005 275 001010 276 001016 277 001027 278 001031 279 001036 280 001041 282 001043 283 001044 285 001045 286 001067 288 001106 290 001111 291 001121 293 001123 296 001132 299 001161 303 001167 304 001170 306 001171 309 001173 310 001175 312 001207 313 001211 315 001213 317 001216 319 001251 322 001253 326 001264 328 001266 330 001267 332 001271 333 001272 337 001303 340 001306 342 001346 345 001347 347 001350 350 001404 351 001414 353 001422 355 001435 357 001436 361 001456 362 001521 365 001523 374 001552 375 001554 376 001556 377 001560 378 001562 379 001564 380 001566 381 001567 382 001571 383 001575 384 001604 385 001615 386 001641 387 001643 388 001644 390 001647 392 001676 395 001704 396 001706 397 001710 398 001721 400 001723 402 001751 404 002005 407 002007 409 002027 410 002037 411 002040 413 002041 417 002042 422 002067 423 002070 426 002072 428 002100 430 002101 433 002103 434 002123 437 002166 440 002170 443 002174 445 002176 448 002205 449 002210 452 002211 455 002223 458 002224 461 002267 464 002271 467 002275 469 002277 472 002306 473 002311 476 002312 480 002320 483 002357 485 002403 487 002404 490 002440 491 002446 492 002456 494 002457 495 002477 496 002501 497 002527 499 002533 500 002566 502 002570 506 002571 509 002625 510 002640 511 002650 513 002656 515 002657 518 002675 521 002704 523 002724 525 002762 528 002764 530 002771 531 002773 533 003025 534 003027 537 003030 538 003040 539 003042 545 003043 548 003046 549 003051 550 003061 554 003062 562 003106 563 003110 564 003111 566 003112 567 003134 569 003153 570 003164 571 003166 573 003175 574 003203 576 003204 577 003211 578 003213 580 003215 581 003223 583 003232 584 003234 585 003236 586 003240 588 003242 590 003314 592 003320 594 003321 597 003331 598 003333 599 003334 600 003340 603 003341 606 003343 608 003346 611 003355 612 003361 615 003365 617 003375 619 003415 622 003467 624 003473 625 003474 626 003476 629 003477 632 003501 633 003502 635 003505 637 003515 638 003521 640 003531 642 003551 644 003555 646 003612 649 003615 652 003616 653 003657 656 003661 657 003663 659 003671 662 003674 665 003746 667 003752 668 003753 669 003755 672 003756 675 003760 676 003761 677 003764 679 003773 680 003777 681 004007 683 004013 684 004050 686 004052 687 004053 689 004054 695 004057 696 004061 699 004070 702 004073 703 004130 706 004133 709 004165 711 004167 713 004172 715 004227 719 004232 722 004243 725 004251 727 004253 729 004256 730 004313 735 004315 736 004360 739 004362 741 004373 745 004423 748 004434 751 004442 753 004444 755 004446 757 004457 759 004461 761 004462 763 004466 767 004467 770 004471 772 004502 774 004504 776 004505 778 004511 781 004512 785 004515 787 004525 789 004527 791 004530 793 004534 795 004535 798 004536 799 004545 802 004554 804 004556 805 004561 807 004562 810 004566 813 004575 816 004612 819 004621 825 004622 836 004630 839 004641 841 004644 844 004646 845 004647 850 004660 852 004672 854 004701 856 004713 858 004722 860 004734 864 004743 ----------------------------------------------------------- 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