mdc_check_mdcs_.pl1 11/11/89 1101.5rew 11/11/89 0802.5 60912 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,indcomtxt */ /* MDC_CHECK_MDCS_: Procedure that validates the contents of a master directory control segment. */ /* Written April 1976 by Larry Johnson */ /* Modified 8303-12-07 BIM for correct quota precision */ mdc_check_mdcs_: proc (mdcsp, code); dcl code fixed bin (35); /* Stanard status code */ dcl quota_used fixed bin (18); dcl (p, q) ptr; dcl (i, j) fixed bin; dcl 1 list aligned based, /* Format of lined list */ 2 next bit (18) unal, 2 fill bit (18) unal; dcl admin_gate_$syserr entry options (variable); dcl clock_ entry returns (fixed bin (71)); dcl error_table_$bad_segment ext fixed bin (35); dcl (addr, bin, ptr, rel, unspec) builtin; %include mdcs; /* All lists are checked for proper threading */ call check_thread (mdcs.acct_offset); call check_thread (mdcs.dir_offset); call check_thread (mdcs.restrict_path); call check_thread (mdcs.default_path); /* Check that things that should be zero are */ if mdcs.free_bits ^= "0"b then do; call admin_gate_$syserr (4, "mdc_check_mdcs_: Volume ^a had non-zero mdcs.free_bits.", mdcs.volume); mdcs.free_bits = "0"b; end; if unspec (mdcs.fill) ^= "0"b then do; call admin_gate_$syserr (4, "mdc_check_mdcs_: Volume ^a had non-zero mdcs.fill.", mdcs.volume); unspec (mdcs.fill) = "0"b; end; /* Check that each directory entry points to a valid account entry */ mdirp = ptr (mdcsp, mdcs.dir_offset); /* Start of directory list */ do while (rel (mdirp) ^= "0"b); /* Scan list */ call check_ascii ("directory", mdirent.owner, mdirp); if mdirent.quota < 1 then do; /* bad quota */ call admin_gate_$syserr (4, "mdc_check_mdcs_: Invalid master directory quota changed from ^d to 1 on ^a.", mdirent.quota, mdcs.volume); mdirent.quota = 1; end; acctp = ptr (mdcsp, mdcs.acct_offset); /* Scan down qccount list */ do while (rel (acctp) ^= "0"b); if rel (acctp) = mdirent.quota_offset then go to next_mdir; acctp = ptr (mdcsp, acctent.next); end; call admin_gate_$syserr (4, "mdc_check_mdcs_: Invalid quota account offset at ^a|^o", mdcs.volume, bin (rel (mdirp), 18)); go to return_code; next_mdir: mdirp = ptr (mdcsp, mdirent.next); end; /* Now check that each quota account has the correct quota used */ i = 0; /* For checking order of entries */ acctp = ptr (mdcsp, mdcs.acct_offset); do while (rel (acctp) ^= "0"b); call check_thread (acctent.restrict_path); call check_ascii ("account", acctent.name, acctp); j = 0; /* Compute sort code of entry */ if acctent.name.person = "*" then j = j + 2; if acctent.name.project = "*" then j = j + 1; if j < i then do; /* Error */ call admin_gate_$syserr (4, "mdc_check_mdcs_: Account entry at ^a|^o for ^a.^a out of sequence.", mdcs.volume, bin (rel (acctp), 18), acctent.name.person, acctent.name.project); go to return_code; end; else i = j; /* For next one */ quota_used = 0; /* A counter */ mdirp = ptr (mdcsp, mdcs.dir_offset); /* Scan directory list */ do while (rel (mdirp) ^= "0"b); if mdirent.quota_offset = rel (acctp) then /* If account owns directory */ quota_used = quota_used + mdirent.quota; mdirp = ptr (mdcsp, mdirent.next); end; if quota_used ^= acctent.quota_used then do; /* If in error */ call admin_gate_$syserr (4, "mdc_check_mdcs_: Quota used of ^a for ^a.^a changed from ^d to ^d.", mdcs.volume, acctent.name.person, acctent.name.project, acctent.quota_used, quota_used); acctent.quota_used = quota_used; /* Set it right */ end; if acctent.trp < 0 then do; /* Bad time record product */ call admin_gate_$syserr (4, "mdc_check_mdcs_: TRP of ^a.^a on ^a changed from ^d to 0.", acctent.person, acctent.project, mdcs.volume, acctent.trp); acctent.trp = 0; end; acctp = ptr (mdcsp, acctent.next); end; code = 0; mdcs.time_checked = clock_ (); return; return_code: code = error_table_$bad_segment; return; /* Procedure to check list threading. Each entry is checked to see that it falls within the segment, and there are no circular threads */ check_thread: proc (head); dcl head bit (18) aligned; /* Pointer to list head */ if head = "0"b then return; /* Empty list */ p = ptr (mdcsp, head); /* Head of list */ check3: if p -> list.fill ^= "0"b then do; call admin_gate_$syserr (4, "mdc_check_mdcs_: Fill bits zeroed at ^a|^o", mdcs.volume, bin (rel (p), 18)); p -> list.fill = "0"b; end; if p -> list.next = "0"b then return; /* End */ q = ptr (mdcsp, head); /* Start at beginning again */ check2: if rel (p) = rel (q) then go to check1; /* Caught up to current point */ if rel (q) = p -> list.next then do; /* Loop */ call admin_gate_$syserr (4, "mdc_check_mdcs_: Circular list pointer at ^a|^o", mdcs.volume, bin (rel (p), 18)); go to return_code; end; q = ptr (mdcsp, q -> list.next); go to check2; check1: p = ptr (mdcsp, p -> list.next); go to check3; end check_thread; /* Procedure to check strings for ASCII. */ check_ascii: proc (type, name, p); dcl type char (*); dcl p ptr; dcl 1 name aligned, 2 person char (22) unal, 2 project char (9) unal; dcl bit_person bit (198) unal based; dcl bit_project bit (81) unal based; if addr (name.person) -> bit_person & (22)"110000000"b then do; call admin_gate_$syserr (4, "mdc_check_mdcs_: Non ascii person name in ^a entry at ^a|^o", type, mdcs.volume, bin (rel (p), 18)); go to return_code; end; if addr (name.project) -> bit_project & (9)"110000000"b then do; call admin_gate_$syserr (4, "mdc_check_mdcs_: Non ascii project name in ^a entry at ^a|^o", type, mdcs.volume, bin (rel (p), 18)); go to return_code; end; return; end check_ascii; end mdc_check_mdcs_;  mdc_create_.pl1 11/11/89 1101.5rew 11/11/89 0802.5 121023 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(89-02-27,TLNguyen), approve(89-02-27,MCR8049), audit(89-02-28,Parisek), install(89-03-15,MR12.3-1025): a. removed references to create_branch_version_1. b. fixed a stringsize error. 2) change(89-03-31,TLNguyen), approve(89-03-31,PBF8049), audit(89-03-31,Farley), install(89-04-24,MR12.3-1031): Reinstated the check for create_branch_version_1 in order to retain binary compatibility. END HISTORY COMMENTS */ /* format: style3,indcomtxt */ /* MDC_CREATE_: Procedure to create a master directory */ /* Written March 1976 by Larry Johnson */ /* Modified September 1977 by Larry Johnson */ /* Modified 83-12-07 BIM for correct quota precisions */ /* Modified 84-11-01 by EJ Sharpe for new dirx_acct entry */ /* Modified 84-12-27 by Keith Loepere for dir_quota */ mdc_create_: proc; dcl arg_dir char (*); /* Name of containing directory */ dcl arg_ename char (*); /* Name of new directory */ dcl arg_volume char (*); /* Logical volume name */ dcl arg_mode bit (36) aligned; /* Mode needed on new directory */ dcl arg_rings (3) fixed bin (3); /* Ring brackets of new directory */ dcl arg_userid char (*); /* Name to be added to acl */ dcl arg_quota fixed bin (18); /* Quota of new directory */ dcl arg_acct_id char (*); /* quota account to use for this mdir */ dcl arg_owner_id char (*); /* user_id who'll be the owner of this mdir */ dcl arg_info_ptr ptr; /* Pointer to create_branch_info structure */ dcl arg_code fixed bin (35); /* Status code */ /* static storage */ dcl create_branch_version_1 fixed bin int static options (constant) init (1); /* Automatic storage */ dcl dir char (168); /* Copy of arg_dir */ dcl ename char (32); /* Copy of arg_ename */ dcl volume char (32); /* Copy of arg_volume */ dcl cbip ptr; /* Copy of create branch_info structure */ dcl aip ptr; /* Copy of arg_info_ptr */ dcl code fixed bin (35); /* Status code */ dcl quota_left fixed bin (35); /* Quota left in account */ dcl quota_used fixed bin (35); /* Updated quota used */ dcl owner_person char (22); dcl owner_project char (9); dcl owner_id char (32); dcl acct_person char (22); dcl acct_project char (9); dcl acct_id char (32); dcl access bit (36) aligned; /* Access to logical volume */ dcl uid_pathname (0:15) bit (36) aligned; /* UID pathaneme of master directory */ dcl voluid bit (36) aligned; /* UID of logical volume */ dcl current_quota fixed bin (18); dcl trp fixed bin (71); /* Time record product */ /* External things */ dcl admin_gate_$append_master_dir entry (char (*), char (*), ptr, bit (36) aligned, dim (0:15) bit (36) aligned, fixed bin (35)); dcl admin_gate_$delete_master_dir entry (dim (0:15) bit (36) aligned, fixed bin (71), fixed bin (35)); dcl admin_gate_$get_uidpath entry (char (*), char (*), dim (0:15) bit (36) aligned, fixed bin (35)); dcl admin_gate_$mdir_status entry (char (*), char (*), dim (0:15) bit (36) aligned, bit (36) aligned, fixed bin (18), fixed bin (35)); dcl admin_gate_$syserr entry options (variable); dcl get_authorization_ entry returns (bit (72) aligned); dcl get_group_id_ entry() returns(char(32)); dcl mdc_lock_$cleanup entry; dcl mdc_lock_$reset entry; dcl mdc_lock_$set entry (fixed bin (35)); dcl mdc_parse_acct_$star entry (char (*), char (*), char (*), fixed bin (35)); dcl mdc_util_$check_pathent entry (bit (18) aligned, dim (0:15) bit (36) aligned, fixed bin (35)); dcl mdc_util_$find_matching_acctent entry (ptr, char (*), char (*), ptr); dcl mdc_util_$find_mdirent entry (ptr, dim (0:15) bit (36) aligned, ptr); dcl mdc_util_$free_mdirent entry (ptr); dcl mdc_util_$get_mdirent entry (ptr, ptr, fixed bin (35)); dcl mdc_util_$thread_mdirent entry (ptr); dcl mdcs_util_$find_mdcs entry (char (*), ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$find_mdcs_uid entry (bit (36) aligned, ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$term_mdcs entry (ptr); dcl error_table_$argerr ext fixed bin (35); dcl error_table_$noentry ext fixed bin (35); dcl error_table_$mdc_bad_quota ext fixed bin (35); dcl error_table_$mdc_no_quota ext fixed bin (35); dcl error_table_$mdc_no_quota_account ext fixed bin (35); dcl error_table_$mdc_unregistered_mdir ext fixed bin (35); dcl error_table_$mdc_illegal_owner ext fixed bin (35); dcl error_table_$mdc_exec_access ext fixed bin (35); dcl cleanup condition; dcl (ptr, rel, addr, bin, null, substr) builtin; %include create_branch_info; dcl 1 auto_branch_info like create_branch_info aligned automatic; dcl 1 cbi like create_branch_info aligned based (cbip); %include mdcs; %include access_mode_values; /* Entry to create master directory with out info structure */ dir: entry (arg_dir, arg_ename, arg_volume, arg_mode, arg_rings, arg_userid, arg_quota, arg_code); owner_id, acct_id = ""; /* default to caller id */ cbip = addr (auto_branch_info); /* Pointer to build param list */ dir = arg_dir; /* Copy parameters */ ename = arg_ename; volume = arg_volume; cbi.mode = substr (arg_mode, 1, 3); cbi.rings = arg_rings; cbi.userid = arg_userid; cbi.quota = arg_quota; cbi.dir_quota = 0; cbi.version = create_branch_version_2; /* Complete info structure */ cbi.dir_sw = "1"b; cbi.copy_sw = "0"b; cbi.chase_sw = "1"b; cbi.priv_upgrade_sw = "0"b; cbi.parent_ac_sw = "1"b; cbi.mbz1 = "0"b; cbi.mbz2 = "0"b; cbi.bitcnt = 0; cbi.access_class = get_authorization_ (); go to common; /* Entry to create master directory with info structure */ dirx: entry (arg_dir, arg_ename, arg_volume, arg_info_ptr, arg_code); owner_id, acct_id = ""; /* default to caller's user_id */ dirx_join: cbip = addr (auto_branch_info); /* Pointer to my copy of info structure */ dir = arg_dir; /* Copy params */ ename = arg_ename; volume = arg_volume; aip = arg_info_ptr; /* Pointer to callers info structure */ cbi = aip -> cbi; /* Copy entrure structuee */ if cbi.version < create_branch_version_1 | cbi.version > create_branch_version_2 /* Check some requirements */ | ^cbi.dir_sw | cbi.priv_upgrade_sw | cbi.mbz1 ^= "0"b | cbi.mbz2 ^= "0"b then do; arg_code = error_table_$argerr; return; end; go to common; /* Entry same as "dirx" but with added arguments to specify quota account and/or mdir owner */ dirx_acct: entry (arg_dir, arg_ename, arg_volume, arg_info_ptr, arg_acct_id, arg_owner_id, arg_code); owner_id = arg_owner_id; /* copy our special args */ if owner_id = get_group_id_ () then owner_id = ""; /* caller really did'nt need this */ acct_id = arg_acct_id; if acct_id = get_group_id_ () then acct_id = ""; /* caller really did'nt need this */ if acct_id = "" then acct_id = owner_id; /* use owner for matching an account */ goto dirx_join; /* Common coding for all create entries */ common: mdcsp = null; on cleanup call clean_up; call mdc_lock_$set (code); if code ^= 0 then go to return_code; /* Unable to set lock */ call mdcs_util_$find_mdcs (volume, mdcsp, access, code); /* Find control segment */ if code ^= 0 then go to unlock_return; if (owner_id ^= "") & (acct_id ^= "") /* caller specified owner/acct ? */ then if ((access & E_ACCESS) ^= E_ACCESS) /* then better be a volume administrator */ then do; code = error_table_$mdc_exec_access; goto term_return; end; call mdc_parse_acct_$star (acct_id, acct_person, acct_project, code); /* Find out who i am */ if code ^= 0 then go to term_return; call mdc_parse_acct_$star (owner_id, owner_person, owner_project, code); if code ^= 0 then go to term_return; if owner_person = "*" | owner_project = "*" then do; code = error_table_$mdc_illegal_owner; goto term_return; end; call mdc_util_$find_matching_acctent (mdcsp, acct_person, acct_project, acctp); /* And find my quota account */ if acctp = null then do; code = error_table_$mdc_no_quota_account; go to term_return; end; if (acctent.restrict_path ^= "0"b) | (mdcs.default_path ^= "0"b) then do; /* Check pathname restrictions */ call admin_gate_$get_uidpath (dir, "", uid_pathname, code); /* Get parents uid path */ if code ^= 0 then go to term_return; if acctent.restrict_path then call mdc_util_$check_pathent (acctent.restrict_path, uid_pathname, code); else call mdc_util_$check_pathent (mdcs.default_path, uid_pathname, code); if code ^= 0 then go to term_return; end; if cbi.quota ^> 0 then do; /* Now some quota checks */ code = error_table_$mdc_bad_quota; go to term_return; end; quota_left = acctent.quota - acctent.quota_used; if cbi.quota > quota_left then do; code = error_table_$mdc_no_quota; go to term_return; end; call mdc_util_$get_mdirent (mdcsp, mdirp, code); /* Get new directory entry */ if code ^= 0 then go to term_return; mdirent.owner.person = owner_person; /* Initialize it */ mdirent.owner.project = owner_project; mdirent.quota_offset = rel (acctp); mdirent.quota = cbi.quota; quota_used = acctent.quota_used + cbi.quota; call admin_gate_$append_master_dir (dir, ename, cbip, mdcs.uid, mdirent.uidpath, code); if code ^= 0 then do; call mdc_util_$free_mdirent (mdirp); go to term_return; end; acctent.quota_used = quota_used; call mdc_util_$thread_mdirent (mdirp); good_return: code = 0; term_return: call mdcs_util_$term_mdcs (mdcsp); unlock_return: call mdc_lock_$reset; return_code: arg_code = code; return; /* Entry to delete a master directory */ delete: entry (arg_dir, arg_ename, arg_code); dir = arg_dir; ename = arg_ename; mdcsp = null; call admin_gate_$mdir_status (dir, ename, uid_pathname, voluid, current_quota, code); if code ^= 0 then go to return_code; on cleanup call clean_up; call mdc_lock_$set (code); /* Set mdcs lock */ if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs_uid (voluid, mdcsp, access, code); /* Find MDCS */ if code = error_table_$noentry then do; /* MDCS is gone */ call admin_gate_$delete_master_dir (uid_pathname, trp, code); if code ^= 0 then go to unlock_return; call admin_gate_$syserr (4, "mdc_create_$delete: No MDCS for ^a^[>^]^a. Directory deleted.", dir, (dir ^= ">"), ename); code = 0; go to unlock_return; end; else if code ^= 0 then go to unlock_return; call mdc_util_$find_mdirent (mdcsp, uid_pathname, mdirp); /* Find my directorys entry */ if mdirp = null then do; code = error_table_$mdc_unregistered_mdir; go to term_return; end; acctp = ptr (mdcsp, mdirent.quota_offset); /* Pointer to quota account entry */ quota_used = acctent.quota_used - mdirent.quota; /* Calc new quota, in case delete works */ if quota_used < 0 then quota_used = 0; call admin_gate_$delete_master_dir (uid_pathname, trp, code); /* Now delete it */ if code ^= 0 then go to term_return; call mdc_util_$free_mdirent (mdirp); /* Don't need directry entry */ acctent.quota_used = quota_used; /* Update quota account */ if trp < 0 then call admin_gate_$syserr (4, "mdc_create_$delete: TRP for ^a^v(>^)^a on ^a negative (^d).", dir, bin (dir ^= ">", 1), ename, mdcs.volume, trp); else acctent.trp = fb71_add ((acctent.trp), trp); /* Update time record prodcut */ go to good_return; /* Cleanup handler */ clean_up: proc; if mdcsp ^= null then call mdcs_util_$term_mdcs (mdcsp); call mdc_lock_$cleanup; return; end clean_up; /* Procedure to do fixed bin(71) adds without overflow */ fb71_add: proc (a, b) returns (fixed bin (71)); dcl (a, b, c) fixed bin (71); dcl fb71_max fixed bin (71) int static options (constant) init (11111111111111111111111111111111111111111111111111111111111111111111111b); c = fb71_max - a; if b <= c then return (a + b); else return (fb71_max); end fb71_add; /* BEGIN MESSAGE DOCUMENTATION Message: mdc_create_$delete: TRP for DIRNAME on LVNAME negative. S: $log T: $run M: While deleting master directory DIRNAME, an invalid negative time-record product was found. The invalid number has been ignored, but volume accounting data may have been lost. A: $ignore Message: mdc_create_$delete: No MDCS for DIRNAME. S: $log T: $run M: When deleting master directory DIRNAME, the master directory control segment (MDCS) could not found. The directory was deleted anyway. A: $ignore END MESSAGE DOCUMENTATION */ end mdc_create_;  mdc_init_.pl1 11/11/89 1101.5rew 11/11/89 0802.5 9207 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDC_INIT_ - Called once per bootload to initialize master directory control */ /* Written September 1977 by Larry Johnson */ mdc_init_: proc; dcl mdc_lock_$mdc_data_init entry; /* Currently, the only thing to do is initialize the mdc_data segment used by mdc_lock_ */ call mdc_lock_$mdc_data_init; return; end mdc_init_;  mdc_lock_.pl1 11/11/89 1101.5rew 11/11/89 0802.5 69210 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDC_LOCK_: Entries which handle the master directory control lock */ /* Written April 1976 by Larry Johnson */ /* Bug fixed September 1977 by Larry Johnson */ mdc_lock_: proc; /* Parameters */ dcl arg_code fixed bin (35); /* Automatic */ dcl code fixed bin (35); dcl vl fixed bin; /* Validation level */ dcl mdc_data_rings (3) fixed bin (3); /* Static */ dcl saved_data_ptr ptr int static init (null); dcl test_mode bit (1) int static init ("0"b); /* For debugging */ /* Constants */ dcl mdc_data_dir char (32) int static options (constant) init (">system_library_1"); dcl mdc_data_ename char (32) int static options (constant) init ("mdc_data"); %include mdc_data; /* External stuff */ dcl admin_gate_$syserr_error_code entry options (variable); dcl clock_ entry returns (fixed bin (52)); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_group_id_ entry returns (char (32)); dcl get_lock_id_ entry returns (bit (36)); dcl get_ring_ entry returns (fixed bin); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$truncate_file entry (char (*), char (*), fixed bin (19), fixed bin (35)); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), dim (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)); dcl admin_gate_$reclassify_sys_seg entry (char (*), char (*), bit (72) aligned, fixed bin (35)); dcl get_max_authorization_ entry returns (bit (72) aligned); dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); dcl error_table_$invalid_lock_reset ext fixed bin (35); dcl error_table_$namedup ext fixed bin (35); dcl (null) builtin; /* Entries to handle the mdcs lock */ set: entry (arg_code); if test_mode then do; arg_code = 0; return; end; call find_mdc_data; /* Get pointer */ call set_lock_$lock (mdc_data.lock, 30, code); if code = 0 then go to locked; /* Locked ok */ if code = error_table_$invalid_lock_reset then do; /* Recoverable error */ call admin_gate_$syserr_error_code (4, code, "mdcs_util_$lock:"); code = 0; go to locked; end; arg_code = code; return; /* Lock failed */ locked: mdc_data.lock_cnt = mdc_data.lock_cnt + 1; /* Do some meters */ mdc_data.time_locked = clock_ (); mdc_data.locker_name = get_group_id_ (); arg_code = code; return; reset: entry; if test_mode then return; call find_mdc_data; unlock_common: mdc_data.unlock_cnt = mdc_data.unlock_cnt + 1; mdc_data.time_spent_locked = mdc_data.time_spent_locked + clock_ () - mdc_data.time_locked; call set_lock_$unlock (mdc_data.lock, code); if code ^= 0 then call admin_gate_$syserr_error_code (4, code, "mdcs_util_$unlock:"); return; /* Entry called by cleanup handlers on crawl-out. It is not certain that the lock is locked */ cleanup: entry; if test_mode then return; if saved_data_ptr = null then return; /* Never called lock */ mdc_datap = saved_data_ptr; if mdc_data.lock ^= get_lock_id_ () then return; /* Not locked by me */ go to unlock_common; /* Join std path */ /* Entry to set test mode */ set_test_mode: entry; test_mode = "1"b; return; /* Internal procedure to get a pointer to the mdc_data segment */ find_mdc_data: proc; dcl mdc_data_err condition; if saved_data_ptr ^= null then do; /* Pointer already knwon */ mdc_datap = saved_data_ptr; return; end; call cu_$level_get (vl); call cu_$level_set (get_ring_ ()); call hcs_$initiate (mdc_data_dir, mdc_data_ename, "", 0, 0, saved_data_ptr, code); call cu_$level_set (vl); if saved_data_ptr ^= null then do; /* It worked */ mdc_datap = saved_data_ptr; return; end; call admin_gate_$syserr_error_code (4, code, "mdc_lock_: Unable to initiate ^a>^a.", mdc_data_dir, mdc_data_ename); signal mdc_data_err; /* I don't know what else to do now */ return; end find_mdc_data; /* Initialization entry to create the mdc_data segment which contains the lock */ mdc_data_init: entry; if test_mode then return; mdc_data_rings = get_ring_ (); call hcs_$append_branchx (mdc_data_dir, mdc_data_ename, 01010b, mdc_data_rings, "*.*.*", 0, 0, 0, code); if (code ^= 0) & (code ^= error_table_$namedup) then do; call admin_gate_$syserr_error_code (0, code, "mdc_lock_$mdc_data_init: Unable to create ^a>^a.", mdc_data_dir, mdc_data_ename); return; end; if code = error_table_$namedup then do; call hcs_$truncate_file (mdc_data_dir, mdc_data_ename, 0, code); if code ^= 0 then do; call admin_gate_$syserr_error_code (0, code, "mdc_lock_$mdc_data_init: Unable to truncate ^a>^a.", mdc_data_dir, mdc_data_ename); return; end; end; call admin_gate_$reclassify_sys_seg (mdc_data_dir, mdc_data_ename, get_max_authorization_ (), code); if code ^= 0 then call admin_gate_$syserr_error_code (0, code, "mdc_lock_$mdc_data_init: Unable to reclassify ^a>^a.", mdc_data_dir, mdc_data_ename); return; /* BEGIN MESSAGE DOCUMENTATION Message: mdc_lock_$lock: LOCK ERROR MESSAGE. S: $log T: $run M: A master directory operation failed because of a problem with the master directory control lock. A: $ignore Message: mdc_lock_$unlock: LOCK ERROR MESSAGE. S: $log T: $run M: At the completion of a master directory control operation, some error occured unlocking the master directory control lock. A: $ignore Message: mdc_lock_: Unable to initiate PATHNAME. REASON. S: $log T: $run M: Master directory control was unable to initiate PATHNAME, which contains the master directory control lock, because of REASON. The master directory control operation requested was not performed. A: $ignore Message: mdc_lock_$mdc_data_init: Unable to create PATHNAME. REASON. S: $info T: $init M: Master directory control was unable to create the segment PATHNAME, to be used for the master directory control lock, for the REASON given. Subsequent master directory control operations may fail. A: ignore Message: mdc_lock_$mdc_data_init: Unable to truncate PATHNAME. REASON. S: $info T: $init M: Master directory control was unable to truncate the segment PATHNAME for the REASON given. This segment is to be used for the master directory control lock. Subsequent master directory control operations may fail. A: $ignore Message: mdc_lock_$mdc_data_init: Unable to reclassify PATHNAME. REASON. S: $info T: $init M: Master directory control was unable to reclassify the segment PATHNAME to its proper access class for the REASON given. This segment is to be used for the master directory control lock. Subsequent master directory control operations may fail. END MESSAGE DOCUMENTATION */ end mdc_lock_;  mdc_parse_acct_.pl1 11/11/89 1101.5rew 11/11/89 0802.5 36522 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDC_PARSE_ACCT_: Contains entries for parsing user.project.tag strings */ /* Written April 1976 by Larry Johnson */ mdc_parse_acct_: proc (arg_acct, arg_person, arg_project, arg_code); dcl arg_acct char (*); /* Account name to parse */ dcl arg_person char (*); /* Person will be returned here */ dcl arg_project char (*); /* Project will be returned here */ dcl arg_code fixed bin (35); dcl acct char (32); dcl person char (22); dcl project char (9); dcl tag char (1); dcl i fixed bin; dcl star_sw bit (1); /* Set if "*" should be substituted for "" */ dcl check_ascii (4) bit (72) int static options (constant) init ((4) (8)"110000000"b); dcl get_group_id_$tag_star entry returns (char (32)); dcl error_table_$mdc_illegal_account ext fixed bin (35); dcl (index, length, substr, unspec) builtin; /* The normal entry starts here. Stars are not substituted for blank components */ star_sw = "0"b; go to start; /* Enter here to have stars substituted for missing components */ star: entry (arg_acct, arg_person, arg_project, arg_code); star_sw = "1"b; /* Now parse it */ start: if length (arg_acct) > length (acct) then /* If given long string, be sure it isn't truncated */ if substr (arg_acct, length (acct) + 1) ^= "" then go to bad; acct = arg_acct; if acct = "" then acct = get_group_id_$tag_star (); /* A standard default */ if unspec (acct) & unspec (check_ascii) then go to bad; /* Crude test for good ascii */ i = index (acct, " "); /* Check for imbedded blanks */ if i > 0 then if substr (acct, i) ^= "" then go to bad; call next_component (person); /* Remove person */ call next_component (project); /* Remove project */ call next_component (tag); /* Remove tag */ if acct ^= "" then go to bad; /* String should be exhausted by now */ if star_sw then do; /* Substitute stars for blanks */ if person = "" then person = "*"; if project = "" then project = "*"; end; arg_person = person; /* Done */ arg_project = project; arg_code = 0; return; bad: arg_person, arg_project = ""; arg_code = error_table_$mdc_illegal_account; return; /* This entry just returns the name of the default account */ default: entry (arg_person, arg_project); arg_person = "Initializer"; arg_project = "SysDaemon"; return; /* Internal procedure that strips the next component off the input string */ next_component: proc (s); dcl s char (*); if acct = "" then do; /* If string is exhausted */ s = ""; return; end; i = index (acct, "."); /* Find bounds of component */ if i = 0 then do; /* No more points */ i = index (acct, " "); /* Find end of word */ if i = 0 then i = length (acct) + 1; if i - 1 > length (s) then go to bad; /* Too long */ s = acct; /* Use rest of string */ acct = ""; /* String exhausted */ end; else if i = 1 then do; /* Point is first */ s = ""; /* This component is null */ acct = substr (acct, 2); /* Strip off point */ end; else do; /* Something before point */ if i - 1 > length (s) then go to bad; /* Too much */ s = substr (acct, 1, i - 1); /* Copy it */ if i + 1 > length (acct) then acct = ""; /* Finished out string */ else acct = substr (acct, i + 1); /* Save rest */ end; return; end next_component; end mdc_parse_acct_;  mdc_repair_.pl1 11/11/89 1101.5rew 11/11/89 0800.0 163341 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,indcomtxt */ /* MDC_REPAIR_: This modules contains a collection of privlidged and/or repair entries */ /* Written March 1976 by Larry Johnson */ /* Modified 83-12-07 BIM for quota repair when validating uidpaths */ /* Modified 84-08-29 by EJ Sharpe - new param lists for make_mdcs, rename_mdcs, update_hvid, and delete_mdcs */ /* Modified 84-09-04 by EJSharpe to change refs to hdx to volume_registration_mgr_ change "hvid" to "lvid" change "hvname" to "lvname" */ /* Modified 84-10-30 by EJ Sharpe to use pl1 area instead of area_ and some minor fixes */ /* Modified 84-11-08 by EJ Sharpe to use based bit array for copying MDCS */ /* Modified 85-02-21 by EJ Sharpe to use syserr_constants.incl.pl1 and fix bad call to admin_gate_$syserr_binary */ /* Modified 85-05-13 by EJ Sharpe to use admin_gate_$mdir_status_uid_priv, also to set dir privileges on validate_uidpaths entry. */ mdc_repair_: procedure; /* Arguments */ dcl arg_volume char (*); dcl arg_code fixed bin (35); dcl arg_dir char (*); dcl arg_ename char (*); dcl arg_ptr ptr; dcl arg_uid bit (36) aligned; dcl arg_new_uid bit (36) aligned; dcl arg_newvol char (*); /* Automatic */ dcl volume char (32); dcl r0_volume bit (36) aligned; dcl temp_lvname char (32); dcl code fixed bin (35); dcl voluid bit (36) aligned; dcl uidpath (0:15) bit (36) aligned; dcl quota fixed bin (18); dcl dir char (168); dcl dirl fixed bin; dcl ename char (32); dcl access bit (36) aligned; dcl p ptr; dcl newvol char (32); dcl new_voluid bit (36) aligned; dcl person char (22); dcl project char (9); dcl msg char (50); dcl call_check bit (1); dcl paths_deleted bit (1); dcl next_rel bit (18); dcl set_privileges bit (1) init ("0"b); /* tells cleanup to reset the privileges */ dcl old_privileges bit (36) aligned; /* save privileges for restoration */ dcl based_seg_size fixed bin (18); dcl based_seg_bit_array (based_seg_size) bit (36) aligned based; dcl 1 status_struc aligned like status_branch; /* External things */ dcl admin_gate_$decode_uidpath entry (dim (0:15) bit (36) aligned, char (*), char (*), fixed bin (35)); dcl admin_gate_$mdir_status entry (char (*), char (*), dim (0:15) bit (36) aligned, bit (36) aligned, fixed bin (18), fixed bin (35)); dcl admin_gate_$mdir_status_uid_priv entry ((0:15) bit (36) aligned, character (*), character (*), bit (36) aligned, fixed binary (18), fixed binary (35)); dcl admin_gate_$reset_privileges entry (bit (36) aligned); dcl admin_gate_$set_privileges entry (bit (36) aligned, bit (36) aligned); dcl admin_gate_$syserr entry options (variable); dcl admin_gate_$syserr_binary entry options (variable); dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); dcl volume_registration_mgr_$find_lvname entry (bit (36) aligned, char (*), fixed bin (35)); dcl mdc_check_mdcs_ entry (ptr, fixed bin (35)); dcl mdc_lock_$cleanup entry; dcl mdc_lock_$reset entry; dcl mdc_lock_$set entry (fixed bin (35)); dcl mdc_lock_$set_test_mode entry; dcl mdc_parse_acct_$default entry (char (*), char (*)); dcl mdc_util_$find_acctent entry (ptr, char (*), char (*), ptr); dcl mdc_util_$find_mdirent entry (ptr, dim (0:15) bit (36) aligned, ptr); dcl mdc_util_$free_mdirent entry (ptr); dcl mdc_util_$free_pathent entry (bit (18) aligned, ptr); dcl mdc_util_$get_acctent entry (ptr, ptr, fixed bin (35)); dcl mdc_util_$get_mdirent entry (ptr, ptr, fixed bin (35)); dcl mdc_util_$thread_acctent entry (ptr); dcl mdc_util_$thread_mdirent entry (ptr); dcl mdcs_util_$create_mdcs entry (char (*), bit (36) aligned, fixed bin (35)); dcl mdcs_util_$delete_mdcs entry (char (*), bit (36) aligned, fixed bin (35)); dcl mdcs_util_$find_mdcs entry (char (*), ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$find_mdcs_and_check entry (char (*), ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$find_mdcs_uid entry (bit (36) aligned, ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$rename_mdcs entry (char (*), bit (36) aligned, char (*), fixed bin (35)); dcl mdcs_util_$set_mdcsdir entry (char (*)); dcl mdcs_util_$term_mdcs entry (ptr); dcl mdcs_util_$update_lvid entry (char (*), bit (36) aligned, bit (36) aligned, fixed bin (35)); dcl error_table_$namedup ext fixed bin (35); dcl error_table_$bad_uidpath ext fixed bin (35); dcl cleanup condition; dcl (addr, rtrim, bin, ptr, null, rel) builtin; %page; /* Entry to create a master directory control segment (MDCS) */ make_mdcs: entry (arg_volume, arg_uid, arg_code); /* This entry is called by volume_registration_mgr_$add_lvr when a new LV is registered */ volume = arg_volume; voluid = arg_uid; on cleanup call mdc_lock_$cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$create_mdcs (volume, voluid, code); /* Try to create it */ go to unlock_return; /* Most entries return to one of the following labels to exit. */ good_return: code = 0; term_return: call mdcs_util_$term_mdcs (mdcsp); unlock_return: call mdc_lock_$reset; return_code: arg_code = code; return; /* Special entry call from ring1 during system initiaization to create a mdcs. It performs the same function as make_mdcs, but does not set locks or call any volume registration entries. */ recreate_mdcs: entry (arg_volume, arg_uid, arg_code); volume = arg_volume; voluid = arg_uid; call mdcs_util_$create_mdcs (volume, voluid, code); go to return_code; %page; /* Entry that will copy the mdcs to an outer ring */ copy_mdcs: entry (arg_volume, arg_ptr, arg_code); volume = arg_volume; p = arg_ptr; arg_code = 0; mdcsp = null; on cleanup call reg_cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs (volume, mdcsp, access, code); if code ^= 0 then go to unlock_return; call hcs_$fs_get_path_name (mdcsp, dir, dirl, ename, code); if code ^= 0 then goto term_return; call hcs_$status_long (dir, ename, 0, addr (status_struc), null (), code); if code ^= 0 then goto term_return; based_seg_size = status_struc.current_length * 1024; p -> based_seg_bit_array = mdcsp -> based_seg_bit_array; go to good_return; %page; /* Entry to rename a mdcs */ rename_mdcs: entry (arg_volume, arg_uid, arg_newvol, arg_code); /* This entry is called by volume_registrtaion_mgr_$change_lvr when the name of an LV is changed */ volume = arg_volume; newvol = arg_newvol; voluid = arg_uid; on cleanup call mdc_lock_$cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$rename_mdcs (volume, voluid, newvol, code); go to unlock_return; /* Entry to store a new unique id for a logical volume */ update_lvid: entry (arg_volume, arg_uid, arg_new_uid, arg_code); /* This entry is called by volume_registration_mgr_$change_lvr when the UID of an LV is changed */ volume = arg_volume; voluid = arg_uid; /* Old uid */ new_voluid = arg_new_uid; on cleanup call mdc_lock_$cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$update_lvid (volume, voluid, new_voluid, code); go to unlock_return; /* Entry to delete a mdcs. It will fail if the mdcs is not empty */ delete_mdcs: entry (arg_volume, arg_uid, arg_code); /* THis entry is called by volume_registration_mgr_$delete_lvr when an LV registration is deleted */ volume = arg_volume; voluid = arg_uid; on cleanup call mdc_lock_$cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$delete_mdcs (volume, voluid, code); go to unlock_return; /* Debugging entry that changes the name of the mdcs directory */ set_mdcsdir: entry (arg_dir); dir = arg_dir; call mdcs_util_$set_mdcsdir (dir); call mdc_lock_$set_test_mode; return; %page; /* This entry, given a pathname of maybe a master directory, updates ring1 to be consistent */ register_mdir: entry (arg_dir, arg_ename, arg_code); dir = arg_dir; ename = arg_ename; arg_code = 0; call admin_gate_$mdir_status (dir, ename, uidpath, voluid, quota, code); /* Be sure its a master dir */ if code ^= 0 then go to return_code; mdcsp = null; on cleanup call reg_cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs_uid (voluid, mdcsp, access, code); /* This finds the MDCS, given uid */ if code ^= 0 then go to unlock_return; call mdc_util_$find_mdirent (mdcsp, uidpath, mdirp); /* See if directry registered */ if mdirp ^= null then do; /* It is */ call fix_mdirent_quota (mdirp, dir, ename, quota, code); if code = 0 then code = error_table_$namedup; go to term_return; end; call mdc_util_$get_mdirent (mdcsp, mdirp, code); /* Get free directory entry */ if code ^= 0 then go to term_return; mdirent.uidpath = uidpath; /* Initialize it */ mdirent.quota = quota; call mdc_parse_acct_$default (person, project); /* Get name of default account */ mdirent.owner.person = person; mdirent.owner.project = project; call mdc_util_$find_acctent (mdcsp, person, project, acctp); /* Find default quota account */ if acctp = null then do; /* Must make one */ call mdc_util_$get_acctent (mdcsp, acctp, code); if code ^= 0 then go to term_return; acctent.name.person = person; acctent.name.project = project; call mdc_util_$thread_acctent (acctp); end; mdirent.quota_offset = rel (acctp); /* Mdir entry complete */ call mdc_util_$thread_mdirent (mdirp); call admin_gate_$syserr (LOG, "mdc_repair_$register_mdir: ^a^[>^]^a registered on ^a, quota=^d.", dir, bin (dir ^= ">", 1), ename, mdcs.volume, quota); call mdc_check_mdcs_ (mdcsp, code); /* This will repair quota accpunt */ go to term_return; %page; /* This entry checks all the uid pathnames in an mdcs and deletes any that do not point at real directorys anymore. */ validate_uidpaths: entry (arg_volume, arg_code); volume = arg_volume; arg_code = 0; mdcsp = null; on cleanup call reg_cleanup; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs_and_check (volume, mdcsp, access, code); if code ^= 0 then go to unlock_return; /* Cant find volume */ call admin_gate_$set_privileges (DIR_PRIVILEGE, old_privileges); set_privileges = "1"b; paths_deleted, call_check = "0"b; msg = "volume path restriction list"; call check_restrict (mdcs.restrict_path); msg = "volume default path restriction list"; call check_restrict (mdcs.default_path); do mdirp = ptr (mdcsp, mdcs.dir_offset) repeat (ptr (mdcsp, next_rel)) while (rel (mdirp) ^= "0"b); /* Scan all master directory entries */ next_rel = mdirent.next; /* Save in case this entry deleted */ call admin_gate_$mdir_status_uid_priv (mdirent.uidpath, dir, ename, r0_volume, quota, code); if code = error_table_$bad_uidpath then do; /* Found a bad entry */ /*** decode_uidpath returns as much as is available */ call admin_gate_$decode_uidpath (mdirent.uidpath, dir, ename, code); call admin_gate_$syserr_binary (LOG, addr (mdirent.uidpath), SB_mdc_del_uidpath, SBL_mdc_del_uidpath, "mdc_repair_$validate_uidpaths: Master directory entry with bad uidpath deleted from ^a. ^a>??", volume, dir); call mdc_util_$free_mdirent (mdirp); call_check = "1"b; /* Must call mdc_check_mdcs to fix quota */ paths_deleted = "1"b; end; else if r0_volume ^= mdcs.uid then do; /* it exists, but does not belong to us */ temp_lvname = ""; call volume_registration_mgr_$find_lvname (r0_volume, temp_lvname, (0)); call admin_gate_$syserr_binary (LOG, addr (mdirent.uidpath), SB_mdc_del_uidpath, SBL_mdc_del_uidpath, "mdc_repair_$validate_uidpaths: Master directory ^a^[>^]^a entry for wrong logical volume (^w ^a) deleted from ^a.", dir, (dir ^= ">"), ename, r0_volume, temp_lvname, volume); call mdc_util_$free_mdirent (mdirp); call_check = "1"b; paths_deleted = "1"b; end; else /* valid path, lets check some more */ call fix_mdirent_quota (mdirp, dir, ename, quota, code); /* ignore code */ end; do acctp = ptr (mdcsp, mdcs.acct_offset) repeat (ptr (mdcsp, acctent.next)) while (rel (acctp) ^= "0"b); msg = "path restriction for " || rtrim (acctent.person) || "." || rtrim (acctent.project); call check_restrict (acctent.restrict_path); end; if call_check then call mdc_check_mdcs_ (mdcsp, code); if paths_deleted then code = error_table_$bad_uidpath; else code = 0; call admin_gate_$reset_privileges (old_privileges); go to term_return; check_restrict: proc (head); /* Check each entry in a restriction list */ dcl head bit (18) aligned; do pathp = ptr (mdcsp, head) repeat (ptr (mdcsp, next_rel)) while (rel (pathp) ^= "0"b); next_rel = pathent.next; /* Save in case this entry deleted */ call admin_gate_$decode_uidpath (pathent.uidpath, dir, ename, code); if code = error_table_$bad_uidpath then do; /* Found a bad one */ call admin_gate_$syserr_binary (LOG, addr (pathent.uidpath), SB_mdc_del_uidpath, SBL_mdc_del_uidpath, "mdc_repair_$validate_uidpaths: Bad uidpath name deleted from ^a for ^a. ^a>??", msg, volume, dir); call mdc_util_$free_pathent (head, pathp); paths_deleted = "1"b; end; end; return; end check_restrict; fix_mdirent_quota: procedure (Mdirp, Dir_name, Ename, Quota, Code); declare Mdirp pointer; declare Quota fixed bin (18); declare Dir_name char (168); declare Ename char (32); declare Code fixed bin (35); if Quota < 1 then do; /* this is bad */ call admin_gate_$syserr (LOG, "mdc_repair_: Quota of ^d reported by ring 0 for ^a^[>^]^a on ^a. 1 assumed.", Quota, Dir_name, Dir_name ^= ">", Ename, Mdirp -> mdcs.volume); Quota = 1; end; if Quota ^= Mdirp -> mdirent.quota then do; /* Check quota */ call admin_gate_$syserr (LOG, "mdc_repair_: Quota for ^a^[>^]^a on ^a changed from ^d to ^d.", Dir_name, Dir_name ^= ">", Ename, mdcs.volume, Mdirp -> mdirent.quota, Quota); mdirent.quota = Quota; /* Fix it */ call mdc_check_mdcs_ (mdcsp, Code); /* This repairs quota account */ end; end fix_mdirent_quota; %page; /* Cleanup handler */ reg_cleanup: proc; if mdcsp ^= null then call mdcs_util_$term_mdcs (mdcsp); if set_privileges then call admin_gate_$reset_privileges (old_privileges); call mdc_lock_$cleanup; return; end reg_cleanup; /* format: off */ %page; %include mdcs; %page; %include syserr_constants; %page; %include syserr_binary_def; %page; %include status_structures; %page; %include aim_privileges; %page; /* BEGIN MESSAGE DOCUMENTATION Message: mdc_repair_$register_mdir: Quota of N reported by ring 0 for DIRNAME on LVNAME. 1 assumed. S: $log T: $run M: The master directory DIRNAME for volume LVNAME has been found to have an invalid quota. The quota has been assumed to be 1. The message can only appear as a result of a register_mdir command performed by a system administrator. A: $ignore Message: mdc_repair_$register_mdir: Quota for DIRNAME on LVNAME changed from OLD to NEW. S: $log T: $run M: The quota of master directory DIRNAME was found be different from the quota recorded in the MDCS. The real quota is assumed to be correct and the MDCS is updated to reflect this quota. This may happen if a set_quota command had been used on a master directory. This message can only appear as a result of a register_mdir command performed by a system administrator. A: $ignore Message: mdc_repair_$register_mdir: DIRNAME registered on LVNAME, quota=N. S: $log T: $run M: The master directory DIRNAME has been found which had not been recorded in the MDCS for volume LVNAME. The master directory has been registered and the quota of N has been charged to the Initializer.SysDaemon quota account. This problem may have been caused by the loss and subsequent retreival of the master directory control segment, or by retreving a master directory. This message can only appear as a result of a register_mdir command performed by a system administrator. A: $ignore Message: mdc_repair_:validate_uidpaths: Master directory entry with bad uidpath deleted from LVNAME. PARTIAL-PATHNAME. S: $log T: $run M: The master directory control segment for LVNAME contains an entry for a mastr directory which no longer exists. The entry has been deleted and the quota is returned to the account from which it was drawn. This can happen if a master directory control segment has been lost and retreived, or if a mastr directory has been lost. A: $ignore END MESSAGE DOCUMENTATION */ end mdc_repair_;  mdc_set_.pl1 11/11/89 1101.5r w 11/11/89 0802.6 126477 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,indcomtxt */ /* MDC_SET_: Entries which perform set type functions on master directories */ /* Written March 1976 by Larry Johnson */ /* Modified September 1977 by Larry Johnson to add delete_volume quota entry */ /* Modified 83-12-07 BIM for correct quota precisions */ mdc_set_: procedure; /* Arguments */ dcl arg_volume char (*); /* Logical volume name */ dcl arg_acct char (*); /* Name of a quota account */ dcl arg_sw bit (1) aligned; /* Quota change switch */ dcl arg_volume_quota fixed bin (35); /* A quota, or quota adjustment */ dcl arg_mdir_quota fixed bin (18); dcl arg_code fixed bin (35); dcl arg_dir char (*); dcl arg_ename char (*); dcl arg_uidpath (0:15) bit (36) aligned; /* Uid pathname of directory */ dcl arg_index fixed bin; /* Array index on dumper call */ dcl arg_increment fixed bin; /* Amount to add on dumper call */ /* Automatic storage */ dcl volume char (32); dcl code fixed bin (35); dcl sw bit (1); /* Copy of arg_sw */ dcl person char (22); /* Person part of account name */ dcl project char (9); /* Project part of account name */ dcl acct char (32); /* Copy of account name */ dcl new_acct bit (1); /* Set if new account is being added */ dcl (i, j) fixed bin; dcl access bit (36) aligned; /* Access to logical volume */ dcl voluid bit (36) aligned; /* Logical volume unique id */ dcl uid_pathname (0:15) bit (36) aligned; dcl dir char (168); dcl ename char (32); dcl (quota, new_quota, delta_quota, quota_used) fixed bin (35); /* Used in quota calculations (enough precision for vol or dir) */ dcl current_quota fixed bin (18); dcl tacctp ptr; /* Second pointer to an acctent */ dcl 1 owner_struct aligned, 2 person char (22) unal, 2 project char (9) unal; /* Entry variables */ dcl admin_gate_$mdir_status entry (char (*), char (*), dim (0:15) bit (36) aligned, bit (36) aligned, fixed bin (18), fixed bin (35)); dcl admin_gate_$set_mdir_quota entry (dim (0:15) bit (36) aligned, fixed bin (18), fixed bin (35)); dcl mdc_lock_$cleanup entry; dcl mdc_lock_$reset entry; dcl mdc_lock_$set entry (fixed bin (35)); dcl mdc_parse_acct_ entry (char (*), char (*), char (*), fixed bin (35)); dcl mdc_parse_acct_$star entry (char (*), char (*), char (*), fixed bin (35)); dcl mdc_util_$find_acctent entry (ptr, char (*), char (*), ptr); dcl mdc_util_$find_matching_acctent entry (ptr, char (*), char (*), ptr); dcl mdc_util_$find_mdirent entry (ptr, dim (0:15) bit (36) aligned, ptr); dcl mdc_util_$get_acctent entry (ptr, ptr, fixed bin (35)); dcl mdc_util_$thread_acctent entry (ptr); dcl mdc_util_$free_pathent entry (bit (18) aligned, ptr); dcl mdc_util_$free_acctent entry (ptr); dcl mdcs_util_$find_mdcs entry (char (*), ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$find_mdcs_uid entry (bit (36) aligned, ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$term_mdcs entry (ptr); dcl error_table_$argerr ext fixed bin (35); dcl error_table_$mdc_mdir_registered ext fixed bin (35); dcl error_table_$mdc_bad_quota ext fixed bin (35); dcl error_table_$mdc_exec_access ext fixed bin (35); dcl error_table_$mdc_illegal_account ext fixed bin (35); dcl error_table_$mdc_no_access ext fixed bin (35); dcl error_table_$mdc_no_account ext fixed bin (35); dcl error_table_$mdc_no_quota ext fixed bin (35); dcl error_table_$mdc_no_quota_account ext fixed bin (35); dcl error_table_$mdc_not_mdir ext fixed bin (35); dcl error_table_$mdc_unregistered_mdir ext fixed bin (35); dcl cleanup condition; dcl (ptr, rel, null, substr, string) builtin; /* Set volume quota for a quota account */ volume_quota: entry (arg_volume, arg_acct, arg_sw, arg_volume_quota, arg_code); volume = arg_volume; /* Copy volume */ mdcsp = null; on cleanup call clean_up; call locate_vol; if ^exec_access () then go to not_exec; /* Executive access to volume required */ sw = arg_sw; /* Copy params */ new_quota = arg_volume_quota; acct = arg_acct; call mdc_parse_acct_$star (acct, person, project, code); if code ^= 0 then go to term_return; new_acct = "0"b; /* Assume old account for now */ call mdc_util_$find_acctent (mdcsp, person, project, acctp); /* Find current entry */ if acctp = null then do; /* Account does not exist */ if sw then do; /* Can't do incremental on new account */ code = error_table_$mdc_no_account; go to term_return; end; new_acct = "1"b; /* Remember that this is new */ call mdc_util_$get_acctent (mdcsp, acctp, code); /* Get free entry */ if code ^= 0 then go to term_return; acctent.name.person = person; /* Initialize new entry */ acctent.name.project = project; end; if sw then new_quota = acctent.quota + new_quota; /* If incremental change */ if new_quota < 0 then new_quota = 0; acctent.quota = new_quota; /* Update mdcs */ if new_acct then call mdc_util_$thread_acctent (acctp); /* New entry must be threaded */ good_exit: code = 0; term_return: call mdcs_util_$term_mdcs (mdcsp); unlock_return: call mdc_lock_$reset; return_code: arg_code = code; return; not_exec: code = error_table_$mdc_exec_access; go to term_return; /* Entry to delete a quota account */ delete_volume_quota: entry (arg_volume, arg_acct, arg_code); volume = arg_volume; mdcsp = null; on cleanup call clean_up; call locate_vol; if ^exec_access () then go to not_exec; acct = arg_acct; call mdc_parse_acct_$star (acct, person, project, code); if code ^= 0 then go to term_return; /* Bad account */ call mdc_util_$find_acctent (mdcsp, person, project, acctp); if acctp = null then do; /* Given non-existent account */ code = error_table_$mdc_no_account; go to term_return; end; /* Make sure no master directories derive quota from this account */ do mdirp = ptr (mdcsp, mdcs.dir_offset) repeat (ptr (mdcsp, mdirent.next)) while (rel (mdirp) ^= "0"b); if mdirent.quota_offset = rel (acctp) then do; code = error_table_$mdc_mdir_registered; go to term_return; end; end; do while (acctent.restrict_path ^= "0"b); /* Free anya restrict path */ pathp = ptr (mdcsp, acctent.restrict_path); call mdc_util_$free_pathent (acctent.restrict_path, pathp); end; call mdc_util_$free_acctent (acctp); /* Finally,, free the account entry */ go to good_exit; mdir_owner: entry (arg_dir, arg_ename, arg_acct, arg_code); dir = arg_dir; /* Copy arguments */ ename = arg_ename; acct = arg_acct; mdcsp = null; on cleanup call clean_up; call locate_dir; /* Find my directory */ if ^exec_access () then go to not_exec; call mdc_parse_acct_$star (acct, person, project, code); if code ^= 0 then go to term_return; if person = "*" | project = "*" then do; /* Must be real person */ code = error_table_$mdc_illegal_account; go to term_return; end; owner_struct.person = person; /* Build structure to move */ owner_struct.project = project; string (mdirent.owner) = string (owner_struct); /* This is the update */ go to good_exit; /* Entry to set the quota on a master directory */ mdir_quota: entry (arg_dir, arg_ename, arg_sw, arg_mdir_quota, arg_code); dir = arg_dir; ename = arg_ename; sw = arg_sw; quota = arg_mdir_quota; mdcsp = null; on cleanup call clean_up; call locate_dir; /* Find master dir */ acctp = ptr (mdcsp, mdirent.quota_offset); /* Pointer to account entry */ /* Check for access to perform update */ if ^exec_access () then do; /* If not volume executive, perform user checks */ call mdc_parse_acct_ ("", person, project, code); /* Find out my account */ if code ^= 0 then go to term_return; if person = mdirent.owner.person & /* If I am owner */ project = mdirent.owner.project then go to access_ok; call mdc_util_$find_matching_acctent (mdcsp, person, project, tacctp); /* Find my quota account */ if tacctp ^= acctp then do; /* If not a match, error */ code = error_table_$mdc_no_access; go to term_return; end; end; access_ok: /* Check for sufficient quota */ if sw then delta_quota = quota; /* Compute change in quota */ else delta_quota = quota - mdirent.quota; new_quota = mdirent.quota + delta_quota; /* New directory quota */ quota_used = acctent.quota_used + delta_quota; /* New quota used for account */ if new_quota < 1 then do; /* If directory quota illegal */ code = error_table_$mdc_bad_quota; go to term_return; end; if quota_used > acctent.quota then do; /* No quota in account */ code = error_table_$mdc_no_quota; go to term_return; end; /* Now do update */ call admin_gate_$set_mdir_quota (uid_pathname, (new_quota), code); if code ^= 0 then go to term_return; mdirent.quota = new_quota; acctent.quota_used = quota_used; go to good_exit; /* Entry to change a master directory's quota account */ mdir_account: entry (arg_dir, arg_ename, arg_acct, arg_code); dir = arg_dir; ename = arg_ename; acct = arg_acct; mdcsp = null; on cleanup call clean_up; call locate_dir; /* Find it */ if ^exec_access () then go to not_exec; /* Must be volume executive */ acctp = ptr (mdcsp, mdirent.quota_offset); /* Current quota account */ call mdc_parse_acct_$star (acct, person, project, code); if code ^= 0 then go to term_return; if acct ^= "" then do; /* If an account was given */ call mdc_util_$find_acctent (mdcsp, person, project, tacctp); if tacctp = null then do; /* No such account */ code = error_table_$mdc_no_account; go to term_return; end; end; else do; /* If no acct, use callers quota account */ call mdc_util_$find_matching_acctent (mdcsp, person, project, tacctp); if tacctp = null then do; code = error_table_$mdc_no_quota_account; go to term_return; end; end; if acctp = tacctp then go to good_exit; /* Already done */ quota_used = tacctp -> acctent.quota_used + mdirent.quota; /* Check quota in new account */ if quota_used > tacctp -> acctent.quota then do; code = error_table_$mdc_no_quota; go to term_return; end; mdirent.quota_offset = rel (tacctp); /* Do the update */ tacctp -> acctent.quota_used = quota_used; quota_used = acctent.quota_used - mdirent.quota; /* Quota for old account */ if quota_used < 0 then quota_used = 0; acctent.quota_used = quota_used; go to good_exit; /* Entry to record dumper statistics */ dmpr_usage: entry (arg_volume, arg_uidpath, arg_index, arg_increment, arg_code); volume = arg_volume; /* Copy params */ uid_pathname = arg_uidpath; i = arg_index; j = arg_increment; if i < 1 | i > 3 | j < 0 then do; arg_code = error_table_$argerr; return; end; mdcsp = null; on cleanup call clean_up; call locate_vol; call mdc_util_$find_mdirent (mdcsp, uid_pathname, mdirp); /* Find directory */ if mdirp = null then do; code = error_table_$mdc_not_mdir; go to term_return; end; acctp = ptr (mdcsp, mdirent.quota_offset); /* Ready to do update */ call dmpr_add (mdcs.backup); call dmpr_add (acctent.backup); call dmpr_add (mdirent.backup); go to good_exit; /* Procedure to perform adds for dumper */ dmpr_add: proc (stats); dcl stats (3) fixed bin (35); dcl dp_temp fixed bin (71); /* Double precision temporary */ dcl sp_max fixed bin (35) int static options (constant) init (11111111111111111111111111111111111b); dp_temp = stats (i); /* Copy current */ dp_temp = dp_temp + j; /* Add increment */ if dp_temp > sp_max then dp_temp = sp_max; /* Fix single precision overflow */ stats (i) = dp_temp; return; end dmpr_add; /* Internal procedure whichs loactes the MDCS and mdirent for a directory */ locate_dir: proc; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call admin_gate_$mdir_status (dir, ename, uid_pathname, voluid, current_quota, code); if code ^= 0 then go to unlock_return; call mdcs_util_$find_mdcs_uid (voluid, mdcsp, access, code); /* Find mdcs */ if code ^= 0 then go to unlock_return; call mdc_util_$find_mdirent (mdcsp, uid_pathname, mdirp); /* Find directory entry */ if mdirp = null then do; code = error_table_$mdc_unregistered_mdir; go to term_return; end; return; end locate_dir; locate_vol: proc; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs (volume, mdcsp, access, code); if code ^= 0 then go to unlock_return; return; end locate_vol; /* Function which checks for exec access to volume */ exec_access: proc returns (bit (1)); return ((access & E_ACCESS) = E_ACCESS); end exec_access; /* Cleanup handler */ clean_up: proc; if mdcsp ^= null then call mdcs_util_$term_mdcs (mdcsp); call mdc_lock_$cleanup; return; end clean_up; %include access_mode_values; %include mdcs; end mdc_set_;  mdc_set_path_.pl1 11/11/89 1101.5r w 11/11/89 0802.6 98793 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDC_SET_PATH_: This module contains entries for managing master directory path restrictions */ /* Written April 1976 by Larry Johnson */ mdc_set_path_: proc; /* Arguments */ dcl arg_volume char (*); /* A hierarchy volume name */ dcl arg_dirs (*) char (*); /* Array of directory names */ dcl arg_status (*) fixed bin (35); /* One status code for each directory */ dcl arg_type fixed bin; /* Indicator for type of chage: 0=replace, 1=add, 2=delete */ dcl arg_code fixed bin (35); dcl arg_acct char (*); /* Name of a quota account */ /* Automatic */ dcl volume char (32); dcl ndirs fixed bin; /* Number of directories in arg_dirs */ dcl type fixed bin; dcl code fixed bin (35); dcl acct char (32); dcl person char (22); dcl project char (9); dcl share bit (1) init ("0"b); /* Set when account shares volume default */ dcl (i, j) fixed bin; dcl dir char (168); dcl access bit (36) aligned; /* External stuff */ dcl admin_gate_$get_uidpath entry (char (*), char (*), dim (0:15) bit (36) aligned, fixed bin (35)); dcl mdc_lock_$cleanup entry; dcl mdc_lock_$reset entry; dcl mdc_lock_$set entry (fixed bin (35)); dcl mdc_parse_acct_$star entry (char (*), char (*), char (*), fixed bin (35)); dcl mdc_util_$check_pathent entry (bit (18) aligned, dim (0:15) bit (36) aligned, fixed bin (35)); dcl mdc_util_$find_acctent entry (ptr, char (*), char (*), ptr); dcl mdc_util_$find_matching_acctent entry (ptr, char (*), char (*), ptr); dcl mdc_util_$find_pathent entry (bit (18) aligned, dim (0:15) bit (36) aligned, ptr); dcl mdc_util_$free_pathent entry (bit (18) aligned, ptr); dcl mdc_util_$get_pathent entry (ptr, ptr, fixed bin (35)); dcl mdc_util_$thread_pathent entry (bit (18) aligned, ptr); dcl mdcs_util_$find_mdcs entry (char (*), ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$term_mdcs entry (ptr); dcl error_table_$argerr ext fixed bin (35); dcl error_table_$mdc_exec_access ext fixed bin (35); dcl error_table_$mdc_no_account ext fixed bin (35); dcl error_table_$mdc_no_quota_account ext fixed bin (35); dcl error_table_$mdc_path_dup ext fixed bin (35); dcl error_table_$mdc_path_dup_args ext fixed bin (35); dcl error_table_$mdc_path_not_found ext fixed bin (35); dcl error_table_$mdc_path_restrict ext fixed bin (35); dcl error_table_$mdc_some_error ext fixed bin (35); dcl cleanup condition; dcl (null, hbound, ptr, rel, unspec, substr) builtin; %include mdcs; /* Entry to make adjustments in volume default path */ volume_default: entry (arg_volume, arg_dirs, arg_status, arg_type, arg_code); call test_params; mdcsp = null; on cleanup call clean_up; call locate_vol; call path_adjust (mdcs.default_path, "0"b); /* Go do the work */ term_return: call mdcs_util_$term_mdcs (mdcsp); unlock_return: call mdc_lock_$reset; return_code: arg_code = code; return; /* Entry to set volume restriction path */ volume_restrict: entry (arg_volume, arg_dirs, arg_status, arg_type, arg_code); call test_params; mdcsp = null; on cleanup call clean_up; call locate_vol; call path_adjust (mdcs.restrict_path, "0"b); go to term_return; /* Entryy to set path restriction for individual accoount */ account_restrict: entry (arg_volume, arg_acct, arg_dirs, arg_status, arg_type, arg_code); call test_params; acct = arg_acct; call mdc_parse_acct_$star (acct, person, project, code); if code ^= 0 then go to return_code; mdcsp = null; on cleanup call clean_up; call locate_vol; if ^substr (access, 2, 1) then do; /* exec access required */ code = error_table_$mdc_exec_access; go to term_return; end; if acct ^= "" then do; /* If quota account given */ call mdc_util_$find_acctent (mdcsp, person, project, acctp); /* Find entry to update */ if acctp = null then do; code = error_table_$mdc_no_account; go to term_return; end; end; else do; /* User callers quota account */ call mdc_util_$find_matching_acctent (mdcsp, person, project, acctp); if acctp = null then do; code = error_table_$mdc_no_quota_account; go to term_return; end; end; share = (acctent.restrict_path = "0"b); /* Set if this shares volume default */ call path_adjust (acctent.restrict_path, mdcs.restrict_path); go to term_return; /* This preocedure does some basic argument checking and copying */ test_params: proc; volume = arg_volume; ndirs = hbound (arg_dirs, 1); /* Count of directorys given */ type = arg_type; if type < 0 | type > 2 then do; argerr: code = error_table_$argerr; go to return_code; end; if ndirs < 0 then go to argerr; if type ^= 0 then /* If add or delte, there must be dierectories */ if ndirs ^> 0 then go to argerr; return; end test_params; /* Internal procedure that sets lock and locates mdcs */ locate_vol: proc; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs (volume, mdcsp, access, code); if code ^= 0 then go to unlock_return; return; end locate_vol; /* Cleanup handler */ clean_up: proc; if mdcsp ^= null then call mdcs_util_$term_mdcs (mdcsp); call mdc_lock_$cleanup; return; end clean_up; /* Procedure that does the work of adjusting the path list */ path_adjust: proc (head, restrict_head); dcl head bit (18) aligned; /* Head of list being updated */ dcl restrict_head bit (18) aligned; /* List of restrictions on update (or "0"b) */ dcl one_ok bit (1); dcl (needed, next_ptr) fixed bin; dcl codes (ndirs) fixed bin (35); /* Enough codes for arguments given */ dcl 1 paths (ndirs) aligned, 2 list, 3 uidpath (0:15) bit (36) aligned; /* Enough paths for each argument */ one_ok = "0"b; /* None definitely ok yet */ /* Attemp to translate each directory given into a uidpath */ do i = 1 to ndirs; /* This first loop gets the uidpath of each dir given */ dir = arg_dirs (i); /* Copy it */ call admin_gate_$get_uidpath (dir, "", paths.uidpath (i, *), code); codes (i) = code; if code = 0 then one_ok = "1"b; /* At least one ok */ end; if ^one_ok & ndirs > 0 then go to return_code_array; /* Give up if all paths bad */ /* Check the list of uidpaths for duplicates */ do i = 2 to ndirs; if codes (i) = 0 then do j = 1 to i-1; if codes (j) = 0 then if unspec (paths.list (i)) = unspec (paths.list (j)) then codes (i) = error_table_$mdc_path_dup_args; end; end; /* Check here for adding duplicates or deleting non-existent items */ if type ^= 0 then do; one_ok = "0"b; do i = 1 to ndirs; if codes (i) = 0 then do; /* If passed previous tests */ if share then call mdc_util_$find_pathent (mdcs.default_path, paths.uidpath (i, *), pathp); else call mdc_util_$find_pathent (head, paths.uidpath (i, *), pathp); if type = 1 & pathp ^= null then codes (i) = error_table_$mdc_path_dup; /* Add of exisiting entry */ else if type = 2 & pathp = null then codes (i) = error_table_$mdc_path_not_found; /* Delete of missing item */ else one_ok = "1"b; /* At least one in list passes */ end; end; if ^one_ok then go to return_code_array; end; /* Be sure that any new paths do not violate a restriction */ if restrict_head ^= "0"b & (type = 0 | type = 1) then do; one_ok = "0"b; do i = 1 to ndirs; if codes (i) = 0 then do; call mdc_util_$check_pathent (restrict_head, paths.uidpath (i, *), code); codes (i) = code; if code = 0 then one_ok = "1"b; end; end; if ^one_ok then go to return_code_array; end; /* Now calculate how many pathent structures will be needed. They all get allocated before update begins */ needed = 0; /* Number needed for new paths */ if type = 0 | type = 1 then do i = 1 to ndirs; /* Only necessary for replace or add */ if codes (i) = 0 then needed = needed + 1; end; if share & (type = 1 | type = 2) then do; /* Must do this before deletes and adds */ pathp = ptr (mdcsp, mdcs.default_path); /* Start of list */ do while (rel (pathp) ^= "0"b); needed = needed + 1; /* Just count number in list so it can be copied */ pathp = ptr (mdcsp, pathent.next); end; end; /* Use a begin block to allocat an array of pointers so that all pathents can be allocated */ begin; dcl pathents (needed) ptr; do i = 1 to needed; call mdc_util_$get_pathent (mdcsp, pathents (i), code); if code ^= 0 then do; /* Ran out of space */ do j = 1 to i-1; /* Release the ones just allocated */ call mdc_util_$free_pathent ("0"b, pathents (i)); end; go to term_return; end; end; /* Now copy the default path list if required */ next_ptr = 1; /* Index into list of new pathents */ if share & (type = 1 | type = 2) then do; /* Must make copy of list for the account */ pathp = ptr (mdcsp, mdcs.default_path); /* Head of list */ do while (rel (pathp) ^= "0"b); pathents (next_ptr) -> pathent = pathent; next_ptr = next_ptr + 1; pathp = ptr (mdcsp, pathent.next); end; do j = next_ptr -1 to 1 by -1; /* thread in reverse order so list looks the same */ call mdc_util_$thread_pathent (head, pathents (j)); end; end; /* If doing a replace, delete the old list */ if type = 0 then do while (head ^= "0"b); pathp = ptr (mdcsp, head); call mdc_util_$free_pathent (head, pathp); end; /* Now really do the update */ if type = 2 then do i = 1 to ndirs; /* Delete */ if codes (i) = 0 then do; call mdc_util_$find_pathent (head, paths.uidpath (i, *), pathp); if pathp ^= null then call mdc_util_$free_pathent (head, pathp); end; end; else do i = 1 to ndirs; /* Replace or add */ if codes (i) = 0 then do; pathp = pathents (next_ptr); next_ptr = next_ptr + 1; pathent.uidpath = paths.uidpath (i, *); call mdc_util_$thread_pathent (head, pathp); end; end; end; return_code_array: code = 0; do i = 1 to ndirs; if codes (i) ^= 0 then code = error_table_$mdc_some_error; arg_status (i) = codes (i); end; return; end path_adjust; end mdc_set_path_;  mdc_status_.pl1 11/11/89 1101.5r w 11/11/89 0802.6 135288 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDC_STATUS_: Procedure that performs status operations from MDCS */ /* Written April 1976 by Larry Johnson */ /* Modified September 1977 by Larry Johnson */ mdc_status_: proc; /* Parameters */ dcl arg_volume char (*); /* Name of volume in question */ dcl arg_argp ptr; /* Pointer to argument structure */ dcl arg_volume_datap ptr; /* Pointer to volume_data structure returned here */ dcl arg_code fixed bin (35); dcl 1 arg_names (msargs.names) aligned based (msargs.namesp), 2 person char (22) unal, 2 project char (9) unal; /* Automatic */ dcl code fixed bin (35); dcl volume char (32); dcl access bit (36) aligned; /* Access to logical volume */ dcl person char (22); dcl project char (9); dcl last_ownerp ptr; dcl (p, q) ptr; dcl 1 auto_args like msargs aligned automatic; /* Things allocated in system free area */ dcl free_area_ptr ptr init (null); /* Pointer to the area */ dcl free_area area based (free_area_ptr); dcl pnamep ptr init (null); dcl 1 pname (msargs.nnames) based (pnamep), /* List of names */ 2 person char (22) unal, 2 project char (9) unal; dcl oname_head ptr init (null); /* Pointer to a list of owner structrutes */ dcl oname_tail ptr; dcl onamep ptr; dcl 1 oname aligned based (onamep), /* One of these allocated for each owner processed */ 2 person char (22) unal, 2 project char (9) unal, 2 list_end ptr, 2 next ptr; /* External stuff */ dcl admin_gate_$decode_uidpath entry (dim (0:15) bit (36) aligned, char (*), char (*), fixed bin (35)); dcl mdc_lock_$set entry (fixed bin (35)); dcl mdc_lock_$reset entry; dcl mdc_lock_$cleanup entry; dcl mdcs_util_$find_mdcs entry (char (*), ptr, bit (36) aligned, fixed bin (35)); dcl mdcs_util_$term_mdcs entry (ptr); dcl mdc_parse_acct_ entry (char (*), char (*), char (*), fixed bin (35)); dcl mdc_util_$find_matching_acctent entry (ptr, char (*), char (*), ptr); dcl get_system_free_area_ entry returns (ptr); dcl error_table_$mdc_exec_access ext fixed bin (35); dcl error_table_$area_too_small ext fixed bin (35); dcl error_table_$argerr ext fixed bin (35); dcl error_table_$root ext fixed bin (35); dcl cleanup condition; dcl (addr, null, ptr, rel, substr, addrel, size, string) builtin; %include mdc_status_args; %include mdc_status_info; %include mdcs; /* Entry to perform mdc_$status operation */ list: entry (arg_volume, arg_argp, arg_volume_datap, arg_code); call copy_args; /* Get argument list */ mdcsp = null; on cleanup call clean_up; call locate_vol; /* Get mdcs pointer and check access */ call make_volume_data; if ^msargs.exec then call get_user_info; /* For non-privlidged user */ else call get_exec_info; /* For volume executive */ arg_volume_datap = volume_datap; /* Return the anser */ code = 0; term_return: call mdcs_util_$term_mdcs (mdcsp); unlock_return: call mdc_lock_$reset; return_code: call free_storage; arg_code = code; return; /* This procedure does the work for a normal user call. */ /* A user gets his quota account and a list of his directories */ get_user_info: proc; call mdc_parse_acct_ ("", person, project, code); /* This is to see who I am */ if code ^= 0 then go to term_return; call mdc_util_$find_matching_acctent (mdcsp, person, project, acctp); /* Find my account */ if acctp ^= null then do; /* There is one */ call make_account_data; volume_data.accountp = account_datap; /* Return pointer to caller */ if msargs.restrict then if acctent.restrict_path ^= "0"b then call copy_restrict_path (account_data.restrictp, acctent.restrict_path); else call copy_restrict_path (account_data.restrictp, mdcs.default_path); end; call make_owner_data; /* Get structure to head directory list */ owner_data.person = person; owner_data.project = project; volume_data.ownerp = owner_datap; if ^msargs.dirs then return; p = null; mdirp = ptr (mdcsp, mdcs.dir_offset); /* Head of directory list for volume */ do while (rel (mdirp) ^= "0"b); /* Scan list */ if mdirent.person = person & mdirent.project = project then do; /* Its mine */ call make_dir_data; acctp = ptr (mdcsp, mdirent.quota_offset); dir_data.person = acctent.person; dir_data.project = acctent.project; dir_data.quota = mdirent.quota; call make_path_data (mdirent.uidpath); dir_data.pathp = path_datap; if p = null then owner_data.dirp = dir_datap; /* Thread on list */ else p -> dir_data.next = dir_datap; p = dir_datap; end; mdirp = ptr (mdcsp, mdirent.next); end; return; end get_user_info; /* Procedre to get data for a volumeexecutive call */ get_exec_info: proc; if ^(msargs.account | msargs.owner) then msargs.account = "1"b; if msargs.account then call build_account_list; else call build_owner_list; if msargs.restrict then do; call copy_restrict_path (volume_data.defaultp, mdcs.default_path); call copy_restrict_path (volume_data.restrictp, mdcs.restrict_path); end; end get_exec_info; build_account_list: proc; p = null; do acctp = ptr (mdcsp, mdcs.acct_offset) repeat (ptr (mdcsp, acctent.next)) while (rel (acctp) ^= "0"b); if account_needed () then do; /* Data requested here */ call make_account_data; /* Get place to stor data */ if p = null then volume_data.accountp = account_datap; /* Chain it */ else p -> account_data.next = account_datap; p = account_datap; /* Remember end of list */ q = null; do mdirp = ptr (mdcsp, mdcs.dir_offset) repeat (ptr (mdcsp, mdirent.next)) while (rel (mdirp) ^= "0"b); if mdirent.quota_offset = rel (acctp) then do; /* If chaged to this account */ call make_dir_data; if q = null then account_data.dirp = dir_datap; /* Chain it */ else q -> dir_data.next = dir_datap; q = dir_datap; dir_data.person = mdirent.person; dir_data.project = mdirent.project; dir_data.quota = mdirent.quota; if msargs.backup then dir_data.backup = mdirent.backup; call make_path_data (mdirent.uidpath); dir_data.pathp = path_datap; end; end; end; end; return; end build_account_list; account_needed: proc returns (bit (1)); dcl i fixed bin; if msargs.nnames = 0 then return ("1"b); do i = 1 to msargs.nnames; if ((pname.person (i) = "") | (pname.person (i) = acctent.person)) & ((pname.project (i) = "") | (pname.project (i) = acctent.project)) then return ("1"b); end; return ("0"b); end account_needed; build_owner_list: proc; p = null; last_ownerp = null; do mdirp = ptr (mdcsp, mdcs.dir_offset) repeat (ptr (mdcsp, mdirent.next)) while (rel (mdirp) ^= "0"b); if owner_needed () then do; /* Check of owner requested */ call find_onamep; /* Get pointer to structure for this owner */ call make_dir_data; /* Build entry for new directory */ acctp = ptr (mdcsp, mdirent.quota_offset); dir_data.person = acctent.person; /* Copy quota account name */ dir_data.project = acctent.project; dir_data.quota = mdirent.quota; if msargs.backup then dir_data.backup = mdirent.backup; if oname.list_end = null then owner_data.dirp = dir_datap; /* First dir for owner */ else oname.list_end -> dir_data.next = dir_datap; oname.list_end = dir_datap; call make_path_data (mdirent.uidpath); dir_data.pathp = path_datap; end; end; return; end build_owner_list; owner_needed: proc returns (bit (1)); dcl i fixed bin; if msargs.nnames = 0 then return ("1"b); do i = 1 to msargs.nnames; if ((pname.person (i) = "") | (pname.person (i) = "*") | (pname.person (i) = mdirent.person)) & ((pname.project (i) = "") | (pname.project (i) = "*") | (pname.project (i) = mdirent.project)) then return ("1"b); end; return ("0"b); end owner_needed; find_onamep: proc; owner_datap = null; do onamep = oname_head repeat (oname.next) while (onamep ^= null); /* Scan existing list */ if oname.person = mdirent.person & oname.project = mdirent.project then return; end; if free_area_ptr = null then free_area_ptr = get_system_free_area_ (); allocate oname in (free_area); oname.person = mdirent.person; oname.project = mdirent.project; oname.list_end = null; oname.next = null; if oname_head = null then oname_head = onamep; /* Thread on list */ else oname_tail -> oname.next = onamep; oname_tail = onamep; call make_owner_data; /* Build structure for caller */ owner_data.person = mdirent.person; owner_data.project = mdirent.project; if last_ownerp = null then volume_data.ownerp = owner_datap; /* If first */ else last_ownerp -> owner_data.next = owner_datap; last_ownerp = owner_datap; return; end find_onamep; /* Copy arguments into stack */ copy_args: proc; dcl i fixed bin; arg_code = 0; arg_volume_datap = null; volume = arg_volume; argp = addr (auto_args); msargs.version = arg_argp -> msargs.version; if msargs.version ^= 1 then do; code = error_table_$argerr; go to return_code; end; msargs.output_size = arg_argp -> msargs.output_size; string (msargs.flags) = string (arg_argp -> msargs.flags); msargs.nnames = arg_argp -> msargs.nnames; msargs.namesp = arg_argp -> msargs.namesp; msargs.output_ptr = arg_argp -> msargs.output_ptr; if ^msargs.exec then do; /* Ignore volume exec requests */ msargs.account = "0"b; msargs.owner = "0"b; msargs.backup = "0"b; msargs.accounting = "0"b; end; if ^(msargs.account | msargs.owner) then msargs.nnames = 0; if msargs.nnames > 0 then do; if free_area_ptr = null then free_area_ptr = get_system_free_area_ (); on area begin; code = error_table_$area_too_small; go to return_code; end; allocate pname in (free_area); do i = 1 to msargs.nnames; pname.person (i) = arg_names.person (i); pname.project (i) = arg_names.project (i); end; end; return; end copy_args; /* Procedure to find mdcs and check access */ locate_vol: proc; call mdc_lock_$set (code); if code ^= 0 then go to return_code; call mdcs_util_$find_mdcs (volume, mdcsp, access, code); if code ^= 0 then go to unlock_return; if msargs.exec & ^substr (access, 2, 1) then do; code = error_table_$mdc_exec_access; go to term_return; end; return; end locate_vol; /* Procedure to allocate an initialize a volume_data structire */ make_volume_data: proc; call get_block (volume_datap, size (volume_data)); volume_data.version = 1; volume_data.accountp = null; volume_data.ownerp = null; volume_data.defaultp = null; volume_data.restrictp = null; volume_data.backup = 0; return; end make_volume_data; /* Procedure to allocate and initialize an account_data sructure */ make_account_data: proc; call get_block (account_datap, size (account_data)); account_data.next = null; account_data.person = acctent.person; /* Copy data from acctent in mdcs */ account_data.project = acctent.project; account_data.quota = acctent.quota; account_data.quota_used = acctent.quota_used; if msargs.backup then account_data.backup = acctent.backup; if msargs.accounting then account_data.trp = acctent.trp; account_data.dirp = null; account_data.restrictp = null; return; end make_account_data; /* Procedure to allocate and initialize an owner_data structure */ make_owner_data: proc; call get_block (owner_datap, size (owner_data)); owner_data.next = null; owner_data.person = ""; owner_data.project = ""; owner_data.dirp = null; return; end make_owner_data; /* Procedure to allocate and initialize a path_data structure */ make_path_data: proc (up); dcl up (0:15) bit (36) aligned; call get_block (path_datap, size (path_data)); path_data.next = null; call admin_gate_$decode_uidpath (up, path_data.dir, path_data.ename, path_data.code); if path_data.code = error_table_$root then path_data.code = 0; return; end make_path_data; /* Procedure to allocate and initialize a dir_data structure */ make_dir_data: proc; call get_block (dir_datap, size (dir_data)); dir_data.next = null; dir_data.pathp = null; dir_data.person = ""; dir_data.project = ""; dir_data.quota = 0; dir_data.backup = 0; return; end make_dir_data; /* Procedure to get a block of words in the callers output area */ get_block: proc (p, n); dcl p ptr; /* Returnd pointer to words gotten */ dcl n fixed bin (19); /* Number of words needed */ if substr (rel (msargs.output_ptr), 18, 1) then do; /* If at odd address */ msargs.output_ptr = addrel (msargs.output_ptr, 1); msargs.output_size = msargs.output_size - 1; end; if n > msargs.output_size then do; code = error_table_$area_too_small; go to term_return; end; p = msargs.output_ptr; msargs.output_ptr = addrel (msargs.output_ptr, n); msargs.output_size = msargs.output_size - n; return; end get_block; /* Procedure that copys a list of restricting pathnames */ copy_restrict_path: proc (p, o); dcl p ptr; dcl o bit (18) aligned; dcl q ptr init (null); do pathp = ptr (mdcsp, o) repeat (ptr (mdcsp, pathent.next)) while (rel (pathp) ^= "0"b); call make_path_data (pathent.uidpath); if q = null then p = path_datap; else q -> path_data.next = path_datap; q = path_datap; end; return; end copy_restrict_path; /* Cleanup handler */ clean_up: proc; if mdcsp ^= null then call mdcs_util_$term_mdcs (mdcsp); call mdc_lock_$cleanup; call free_storage; return; end clean_up; free_storage: proc; if pnamep ^= null then free pname; p = oname_head; do while (p ^= null); onamep = p; p = oname.next; free oname; end; return; end free_storage; end mdc_status_;  mdc_util_.pl1 11/11/89 1101.5r w 11/11/89 0802.6 86958 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDC_UTIL_: Collection of primitives for maintaining Master Directory Control Segments */ /* All the functions of allocating and freeing items in an MDCS, or threading and unthreading them, are located in this module */ /* Written March 1976 by Larry Johnson */ mdc_util_: proc; /* Parameters */ dcl arg_code fixed bin (35); /* A standard status code */ dcl arg_mdcsp ptr; /* Pointer to MDCS */ dcl arg_mdirp ptr; /* Pointer to directory entry in mdcs */ dcl arg_acctp ptr; /* Pointer to account entry in mdcs */ dcl arg_person char (*); /* Person part of quota account name */ dcl arg_project char (*); /* Project part of quota account name */ dcl arg_uidpath (0:15) bit (36) aligned; /* UID pathname of master directory */ dcl arg_pathhead bit (18) aligned; /* Rel pointer to first entry in pathname list */ dcl arg_pathp ptr; /* Automatic storage */ dcl (i, j) fixed bin; dcl tacctp ptr; /* Temp pointer to account entry */ dcl prev_offset bit (18); /* Used while following threads */ dcl (addr, null, ptr, unspec, rel) builtin; dcl error_table_$file_is_full ext fixed bin (35); dcl error_table_$mdc_path_restrict ext fixed bin (35); dcl area condition; %include mdcs; /* Entry to get a free directory entry in the mdcs */ get_mdirent: entry (arg_mdcsp, arg_mdirp, arg_code); mdcsp = arg_mdcsp; arg_mdirp = null; /* In case error return */ on area go to full_file; allocate mdirent in (mdcs.area) set (mdirp); /* Create new directory entry */ unspec (mdirent) = "0"b; /* Return an empty entry */ arg_mdirp = mdirp; /* Set return pointer */ arg_code = 0; return; full_file: arg_code = error_table_$file_is_full; return; /* Entry to thread in a completed directory entry */ thread_mdirent: entry (arg_mdirp); mdirp = arg_mdirp; mdcsp = ptr (mdirp, 0); /* Header at start of segment */ mdirent.next = mdcs.dir_offset; /* Make next old list head */ mdcs.dir_offset = rel (mdirp); /* And set new head */ return; /* Entry to find the directory entry for a given uid pathname */ find_mdirent: entry (arg_mdcsp, arg_uidpath, arg_mdirp); mdcsp = arg_mdcsp; arg_mdirp = null; mdirp = ptr (mdcsp, mdcs.dir_offset); /* Head of list */ do while (rel (mdirp) ^= "0"b); if unspec (mdirent.uidpath) = unspec (arg_uidpath) then do; arg_mdirp = mdirp; /* Found it */ return; end; mdirp = ptr (mdcsp, mdirent.next); end; return; /* Entry to free a directory entry */ free_mdirent: entry (arg_mdirp); mdirp = arg_mdirp; mdcsp = ptr (mdirp, 0); call unthread (mdcs.dir_offset, mdirp); /* Unthread if from list */ unspec (mdirent) = "0"b; /* Clear out entry */ free mdirent in (mdcs.area); arg_mdirp = null; /* Invalidate callers pointer */ return; /* Entry to get a free account entry */ get_acctent: entry (arg_mdcsp, arg_acctp, arg_code); mdcsp = arg_mdcsp; arg_acctp = null; on area go to full_file; allocate acctent in (mdcs.area) set (acctp); unspec (acctent) = "0"b; /* Clear new entry */ arg_acctp = acctp; arg_code = 0; return; /* Entry to free an account entry */ free_acctent: entry (arg_acctp); acctp = arg_acctp; mdcsp = ptr (acctp, 0); call unthread (mdcs.acct_offset, acctp); /* Remove from list */ unspec (acctent) = "0"b; /* Clear free entry */ free acctent in (mdcs.area); arg_acctp = null; return; /* Entry to thread an account entry into the list according to the account name. Account names are divided into classes as for acls: 0. Person.Project 1. Person.* 2. *.Project 3. *.* All entries are ordered by class, and new entries go at the end of their class. */ thread_acctent: entry (arg_acctp); acctp = arg_acctp; mdcsp = ptr (acctp, 0); if mdcs.acct_offset = "0"b then do; /* If list is empty, thread at head */ acctent.next = "0"b; /* This is last */ mdcs.acct_offset = rel (acctp); return; end; i = 0; /* Compute class of new account name */ if acctent.name.person = "*" then i = i + 2; if acctent.name.project = "*" then i = i + 1; prev_offset = "0"b; /* Save previous pointer here when scanning list */ tacctp = ptr (mdcsp, mdcs.acct_offset); /* Head of list */ thacct_loop: j = 0; /* Compute class of entry */ if tacctp -> acctent.name.person = "*" then j = j + 2; if tacctp -> acctent.name.project = "*" then j = j + 1; if i < j then do; /* New class less than old, so it goes here */ acctent.next = rel (tacctp); /* Next pointer of new entry */ if prev_offset = "0"b then /* If inserting at head of list */ mdcs.acct_offset = rel (acctp); else do; /* Inserting in middle */ tacctp = ptr (mdcsp, prev_offset); tacctp -> acctent.next = rel (acctp); end; end; else if tacctp -> acctent.next = "0"b then do; /* Reached end of list */ acctent.next = "0"b; /* Thread on end */ tacctp -> acctent.next = rel (acctp); end; else do; /* Step to next one */ prev_offset = rel (tacctp); tacctp = ptr (mdcsp, tacctp -> acctent.next); go to thacct_loop; end; return; /* Entry to find an account entry in the mdcs */ find_acctent: entry (arg_mdcsp, arg_person, arg_project, arg_acctp); arg_acctp = null; mdcsp = arg_mdcsp; acctp = ptr (mdcsp, mdcs.acct_offset); do while (rel (acctp) ^= "0"b); if acctent.name.person = arg_person & acctent.name.project = arg_project then do; arg_acctp = acctp; return; end; acctp = ptr (mdcsp, acctent.next); end; return; /* Entry to find the proper quota account given person and project names */ find_matching_acctent: entry (arg_mdcsp, arg_person, arg_project, arg_acctp); mdcsp = arg_mdcsp; arg_acctp = null; acctp = ptr (mdcsp, mdcs.acct_offset); /* First in list */ do while (rel (acctp) ^= "0"b); if (arg_person = acctent.person | acctent.person = "*") & (arg_project = acctent.project | acctent.project = "*") then do; arg_acctp = acctp; return; end; acctp = ptr (mdcsp, acctent.next); end; return; /* Entry to get a free pathname entry */ get_pathent: entry (arg_mdcsp, arg_pathp, arg_code); mdcsp = arg_mdcsp; arg_pathp = null; on area go to full_file; allocate pathent in (mdcs.area) set (pathp); unspec (pathent) = "0"b; arg_code = 0; arg_pathp = pathp; return; /* Entry to thread in a new pathname entry */ thread_pathent: entry (arg_pathhead, arg_pathp); pathp = arg_pathp; pathent.next = arg_pathhead; /* Make new entry point at current head */ arg_pathhead = rel (pathp); /* And make the head the new entry */ return; /* Entry that will search a pathent list for a given pathname */ find_pathent: entry (arg_pathhead, arg_uidpath, arg_pathp); arg_pathp = null; mdcsp = ptr (addr (arg_pathhead), 0); pathp = ptr (mdcsp, arg_pathhead); /* First in list */ do while (rel (pathp) ^= "0"b); /* Scan entire list */ if unspec (pathent.uidpath) = unspec (arg_uidpath) then do; arg_pathp = pathp; /* Go it */ return; end; pathp = ptr (mdcsp, pathent.next); end; return; /* Failed */ /* Entry to unthread and free a pathname entry */ free_pathent: entry (arg_pathhead, arg_pathp); pathp = arg_pathp; mdcsp = ptr (pathp, 0); call unthread (arg_pathhead, pathp); unspec (pathent) = "0"b; free pathent in (mdcs.area); arg_pathp = null; return; /* Entry to check a pathname to see if it matches some element in a list */ check_pathent: entry (arg_pathhead, arg_uidpath, arg_code); arg_code = 0; if arg_pathhead = "0"b then return; /* Everything matches an empty list */ mdcsp = ptr (addr (arg_pathhead), 0); pathp = ptr (mdcsp, arg_pathhead); /* First element in list */ do while (rel (pathp) ^= "0"b); do i = 0 to 15 while (pathent.uidpath (i) ^= "0"b); if pathent.uidpath (i) ^= arg_uidpath (i) then go to check_next; end; return; check_next: pathp = ptr (mdcsp, pathent.next); end; arg_code = error_table_$mdc_path_restrict; return; /* Internal procedure that unthreads something from a list */ unthread: proc (head, p); dcl head bit (18) aligned; /* Rel pointer to head of list */ dcl p ptr; /* The element to unthread */ dcl q ptr; dcl 1 list aligned based, /* All lists look like this */ 2 next bit (18) unal, 2 fill bit (18) unal; if head = "0"b then return; /* Empty list is no problem */ if head = rel (p) then do; /* Unthreading first thing in list */ head = p -> list.next; /* Make head second thing list */ return; end; q = ptr (mdcsp, head); /* Start of list */ do while (q -> list.next ^= "0"b); /* Do until end */ if q -> list.next = rel (p) then do; /* Found entry before the one being removed */ q -> list.next = p -> list.next; /* This does the unthreading */ return; /* Done */ end; q = ptr (mdcsp, q -> list.next); end; return; /* Wasn't in list */ end unthread; end mdc_util_;  mdcs_util_.pl1 11/11/89 1101.5rew 11/11/89 0802.6 111366 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* MDCS_UTIL_: Collection of primitives for maintaining Master Directory Control Segments */ /* Written April 1976 by Larry Johnson */ /* Modified September 1977 by Larry Johnson */ /* Modified Aug 1984 by EJ Sharpe for new param lists for delete_mdcs, rename_mdcs, and update_hvid. UID is passed from mdc_repair_ rather than obtained by calling hdx. */ /* Modified Sept 1984 by EJ Sharpe - change refs to "hdx" to "volume_registration_mgr_" change "hvid" to "lvid" change "hvname" to "lvname" */ /* Modified 84-10-30 by EJ Sharpe to upgrade to new volume_registration_mgr_$get_access which returns bit (36) */ mdcs_util_: proc; /* Parameters */ dcl arg_code fixed bin (35); /* A standard status code */ dcl arg_volume char (*); /* Logical volume name */ dcl arg_mdcsp ptr; /* Pointer to MDCS */ dcl arg_uid bit (36) aligned; /* Unique id of a volume */ dcl arg_new_uid bit (36) aligned; /* Unique id of a volume */ dcl arg_access bit (36) aligned; /* Access to logical volume */ dcl arg_newvol char (*); /* New volume name on rename */ dcl arg_dir char (*); /* Automatic storage */ dcl code fixed bin (35); dcl rings (3) fixed bin (3); /* Array of ring brackets */ dcl i fixed bin; dcl ename char (32); /* Entry name of segment */ dcl volume char (32) var; dcl temp_vol char (32); dcl uid bit (36) aligned; dcl access bit (36) aligned; dcl vl fixed bin; /* Callers validation level */ dcl current_ring fixed bin; dcl old_ename char (32); dcl new_uid bit (36) aligned; dcl must_check_mdcs bit (1); dcl pub_bit bit (1) aligned; /* ignored return value from volume_registration_mgr_$get_access */ /* Entry variables */ dcl area_ entry (fixed bin (18), ptr); dcl get_ring_ entry returns (fixed bin); dcl clock_ entry returns (fixed bin (71)); dcl cu_$level_set entry (fixed bin); dcl cu_$level_get entry (fixed bin); dcl admin_gate_$reclassify_sys_seg entry (char (*), char (*), bit (72) aligned, fixed bin (35)); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), dim (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$delentry_seg entry (ptr, fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)); dcl hcs_$chname_seg entry (ptr, char (*), char (*), fixed bin (35)); dcl volume_registration_mgr_$find_lvname entry (bit (36) aligned, char (*), fixed bin (35)); dcl volume_registration_mgr_$find_lvid entry (char (*), bit (36) aligned, fixed bin (35)); dcl volume_registration_mgr_$get_access entry (char (*), fixed bin, bit (36) aligned, bit (1) aligned, fixed bin (35)); dcl mdc_check_mdcs_ entry (ptr, fixed bin (35)); dcl (addr, verify, reverse, null, length, size, substr) builtin; dcl sys_info$max_seg_size ext fixed bin (18); dcl sys_info$time_of_bootload ext fixed bin (71); dcl sys_info$access_class_ceiling ext bit (72) aligned; dcl error_table_$bad_arg ext fixed bin (35); dcl error_table_$namedup ext fixed bin (35); dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$mdc_mdirs_registered ext fixed bin (35); /* Constants */ dcl mdcsdir char (168) int static init (">lv"); dcl mdcs_suffix char (5) int static options (constant) init (".mdcs"); %include mdcs; /* Entry to initialize a master directory control segment */ create_mdcs: entry (arg_volume, arg_uid, arg_code); volume = arg_volume; uid = arg_uid; call make_mdcs_name; /* Build name of mdcs */ if arg_code ^= 0 then return; call set_validation_level; rings = current_ring; call hcs_$append_branchx (mdcsdir, ename, 01010b, rings, "*.*.*", 0, 0, 0, arg_code); if arg_code ^= 0 then if arg_code ^= error_table_$namedup then go to reset_return; /* Namedup ok for now */ if arg_code = 0 then do; call admin_gate_$reclassify_sys_seg (mdcsdir, ename, sys_info$access_class_ceiling, arg_code); if arg_code ^= 0 then go to reset_return; end; call hcs_$initiate (mdcsdir, ename, "", 0, 0, mdcsp, code); /* Find seg */ if mdcsp = null then do; /* This should work */ arg_code = code; go to reset_return; end; if arg_code = 0 then go to cr_ok; /* If append worked ok, then go initialize */ /* Otherwise, check reason for namedup */ if mdcs.version = 0 & ^mdcs.init then do; /* Seems to be empty seg */ call hcs_$truncate_seg (mdcsp, 0, arg_code); /* Really empty now */ if arg_code = 0 then go to cr_ok; else go to term_return; end; call validate_header; /* See if header is reasonable */ if arg_code ^= 0 then go to term_return; call mdc_check_mdcs_ (mdcsp, arg_code); /* Not, look at rest */ if arg_code ^= 0 then go to term_return; arg_code = error_table_$namedup; /* This means old mdcs valid */ go to term_return; cr_ok: mdcs.version = mdcs_version; /* Initiailize new mdcs */ mdcs.volume = volume; mdcs.uid = uid; mdcs.area_size = sys_info$max_seg_size - size (mdcs_head); /* Rest of seg is area */ call area_ (mdcs.area_size, addr (mdcs.area)); /* This makes empty area */ mdcs.init = "1"b; /* Succeeded */ arg_code = 0; term_return: call hcs_$terminate_noname (mdcsp, code); reset_return: call reset_validation_level; return; /* Entry to find and initiate a master directory control segment */ find_mdcs: entry (arg_volume, arg_mdcsp, arg_access, arg_code); must_check_mdcs = "0"b; /* Check of mdcs is not mandatory */ find_start: volume = arg_volume; arg_mdcsp = null; arg_access = "0"b; call set_validation_level; call volume_registration_mgr_$find_lvid ((volume), uid, arg_code); /* See if registered */ if arg_code ^= 0 then go to reset_return; findcom: call volume_registration_mgr_$get_access ((volume), vl, access, pub_bit, arg_code); if arg_code ^= 0 then go to reset_return; call make_mdcs_name; if arg_code ^= 0 then go to reset_return; call hcs_$initiate (mdcsdir, ename, "", 0, 0, mdcsp, arg_code); /* Find segment */ if mdcsp = null then go to reset_return; call validate_header; /* Be sure header is reasnalbe */ if arg_code ^= 0 then go to term_return; /* Now call mdc_check_mdcs_ to validate the MDCS. This is not always done, as it is too expensive. */ if must_check_mdcs | /* If check requested by caller */ mdcs.time_checked < sys_info$time_of_bootload | /* Hasn't been check this bootload */ mdcs.time_checked > clock_ () | /* The time last checked seems wierd */ (clock_ () - mdcs.time_checked > 12*3600*1000000) then do; /* Or it hasnt been checked for 12 hours */ call mdc_check_mdcs_ (mdcsp, arg_code); if arg_code ^= 0 then go to term_return; end; arg_mdcsp = mdcsp; /* Ok */ arg_access = access; arg_code = 0; go to reset_return; /* This entry is the same as find_mdcs, excpet that a check of the mdcs is always performed */ find_mdcs_and_check: entry (arg_volume, arg_mdcsp, arg_access, arg_code); must_check_mdcs = "1"b; go to find_start; /* Entry to find the mdcs given a uid */ find_mdcs_uid: entry (arg_uid, arg_mdcsp, arg_access, arg_code); uid = arg_uid; arg_mdcsp = null; arg_access = "0"b; call set_validation_level; call volume_registration_mgr_$find_lvname (uid, temp_vol, arg_code); if arg_code ^= 0 then go to reset_return; volume = temp_vol; must_check_mdcs = "0"b; go to findcom; /* Join regular path */ /* Entry to terminate a mdcs */ term_mdcs: entry (arg_mdcsp); mdcsp = arg_mdcsp; if mdcsp = null then return; call set_validation_level; arg_mdcsp = null; go to term_return; /* Entry to delete a master directory control segment by name */ delete_mdcs: entry (arg_volume, arg_uid, arg_code); volume = arg_volume; uid = arg_uid; call make_mdcs_name; /* Get name of mdcs */ if arg_code ^= 0 then return; call set_validation_level; call hcs_$initiate (mdcsdir, ename, "", 0, 0, mdcsp, arg_code); if mdcsp = null then go to reset_return; /* Never was one */ call validate_header; if arg_code ^= 0 then go to term_return; delete_common: if mdcs.dir_offset ^= "0"b then do; /* Still directories registered */ arg_code = error_table_$mdc_mdirs_registered; go to term_return; end; mdcs.init = "0"b; /* Make it look empty */ mdcs.version = 0; call hcs_$delentry_seg (mdcsp, arg_code); go to reset_return; /* Entry to delete a master directory control segment by pointer */ delete_mdcsp: entry (arg_mdcsp, arg_code); mdcsp = arg_mdcsp; call set_validation_level; go to delete_common; /* Entry to perform mdcs part of renaming a logical volume */ rename_mdcs: entry (arg_volume, arg_uid, arg_newvol, arg_code); volume = arg_volume; uid = arg_uid; call make_mdcs_name; /* Make name of old mdcs */ if arg_code ^= 0 then return; call set_validation_level; call hcs_$initiate (mdcsdir, ename, "", 0, 0, mdcsp, arg_code); if mdcsp = null then go to reset_return; /* Cant find it */ call validate_header; /* Among other things, this checks that the uid of the new name is the same as uid for old name in mdcs */ if arg_code ^= 0 then go to term_return; old_ename = ename; /* Save old name */ volume = arg_newvol; /* New name */ call make_mdcs_name; /* Build new mdcs name */ if arg_code ^= 0 then go to term_return; call hcs_$chname_seg (mdcsp, old_ename, ename, arg_code); if arg_code ^= 0 then go to term_return; mdcs.volume = volume; /* This must agree with new name */ arg_code = 0; go to term_return; /* Entry that will change the unique id of a logical volume */ /* This may be a disaster if the are master directories registered */ update_lvid: entry (arg_volume, arg_uid, arg_new_uid, arg_code); volume = arg_volume; uid = arg_uid; /* This is the _o_l_d uid */ new_uid = arg_new_uid; call make_mdcs_name; if arg_code ^= 0 then return; call set_validation_level; call hcs_$initiate (mdcsdir, ename, "", 0, 0, mdcsp, arg_code); if arg_code ^= 0 then go to reset_return; call validate_header; /* This checks that old uid is ok */ if arg_code ^= 0 then return; mdcs.uid = new_uid; /* This is the whole update */ arg_code = 0; go to term_return; /* Debugging entry that stores name of the directory containing mdcs */ set_mdcsdir: entry (arg_dir); mdcsdir = arg_dir; return; /* Internal procedure to form name of master directory control segment */ make_mdcs_name: proc; arg_code = 0; if length (volume) = 0 then do; bad_name: arg_code = error_table_$bad_arg; return; end; i = verify (reverse (volume), " "); /* Check for trailing blanks */ if i = 0 then go to bad_name; i = length (volume) - i + 1; if i > (length (ename) - length (mdcs_suffix)) then go to bad_name; ename = substr (volume, 1, i) || mdcs_suffix; return; end make_mdcs_name; /* Procedure to handle validation level */ set_validation_level: proc; call cu_$level_get (vl); current_ring = get_ring_ (); call cu_$level_set (current_ring); return; end set_validation_level; reset_validation_level: proc; call cu_$level_set (vl); return; end reset_validation_level; /* Internal procedure that looks at the mdcs header */ validate_header: proc; if mdcs.version ^= mdcs_version then go to bad_header; if ^mdcs.init then go to bad_header; if mdcs.volume ^= volume then go to bad_header; if mdcs.uid ^= uid then go to bad_header; arg_code = 0; return; bad_header: arg_code = error_table_$bad_segment; return; end validate_header; end mdcs_util_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved