



		    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
