



		    delete_volume_quota.pl1         11/04/82  1901.2rew 11/04/82  1613.2       13635



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* DELETE_VOLUME_QUOTA - Command to delete a quota account from a logial volume */

/* Written March 1977 by Larry Johnson */

delete_volume_quota: dlvq: proc;

dcl  name char (19) int static options (constant) init ("delete_volume_quota");
dcl  code fixed bin (35);
dcl  arg_ptr ptr;
dcl  arg_len fixed bin;
dcl  arg char (arg_len) based (arg_ptr);
dcl  volume char (32);
dcl  account char (32);

dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  mdc_$delete_volume_quota entry (char (*), char (*), fixed bin (35));

	call cu_$arg_ptr (1, arg_ptr, arg_len, code);
	if code ^= 0 then do;
print_usage:   call com_err_ (0, name, "Usage: ^a volume account", name);
	     return;
	end;
	volume = arg;

	call cu_$arg_ptr (2, arg_ptr, arg_len, code);
	if code ^= 0 then go to print_usage;
	account = arg;

	call mdc_$delete_volume_quota (volume, account, code);
	if code ^= 0 then call com_err_ (code, name);
	return;

     end delete_volume_quota;




		    list_mdir.pl1                   11/19/84  1039.2rew 11/18/84  1429.7      203031



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */

/* format: style2,indcomtxt */
/* LIST_MDIR: Command for listing master directory information */

/* Written May 1976 by Larry Johnson */
/* Modified September 1977 by Larry Johnson to fix some bugs */
/* Modified 83-12-07 BIM for quota precisions */

list_mdir:
lmd:
     procedure options (variable);

	dcl     name		 char (9) int static options (constant) init ("list_mdir");
	dcl     code		 fixed bin (35);
	dcl     ptr_array		 (1) ptr init (null);
						/* Used by get_temp_segments_ */
	dcl     acct		 char (32);	/* Name of a user or quota account */
	dcl     quota_sum		 fixed bin (35) init (0);
						/* Total quota chaged to users account */
	dcl     quota_other		 fixed bin (35) init (0);
						/* Total quota charged to other accounts */
	dcl     quota_total		 fixed bin (35) init (0);
						/* Total for all directories */
	dcl     max_dir_name_len	 fixed bin;
	dcl     max_account_len	 fixed bin;
	dcl     max_owner_len	 fixed bin;
	dcl     entry_name		 entry variable;

	dcl     quota_sw		 bit (1) init ("0"b);
						/* Set if -quota used */
	dcl     dir_sw		 bit (1) init ("0"b);
						/* Set if -dr used  */
	dcl     brief_sw		 bit (1) init ("0"b);
						/* Set if -brief used */
	dcl     long_sw		 bit (1) init ("0"b);
						/* Set if -long used */
	dcl     all_sw		 bit (1) init ("0"b);
						/* Set if -all used */
	dcl     restrict_sw		 bit (1) init ("0"b);
						/* Set if -restrict used */
	dcl     account_sw		 bit (1) init ("0"b);
						/* Set if -account used */
	dcl     owner_sw		 bit (1) init ("0"b);
						/* Set if -owner used */
	dcl     volume		 char (32);	/* Logical volume name */

	dcl     arg_no		 fixed bin init (1);/* Current argument being processed */
	dcl     nargs		 fixed bin;	/* Argument count */
	dcl     arg_ptr		 ptr;
	dcl     arg_len		 fixed bin;
	dcl     arg		 char (arg_len) based (arg_ptr);
	dcl     arg_list_ptr	 ptr;		/* Pointer to argument list */
	dcl     more_args		 bit (1) init ("0"b);
						/* Set while args remain to process */

	dcl     list_length		 fixed bin int static options (constant) init (256);
						/*  length of allocated arrays */
	dcl     1 based_list	 aligned based,	/* Model list */
		2 name		 (list_length) aligned,
		  3 person	 char (22) unal,
		  3 project	 char (9) unal;

	dcl     owner_listl		 fixed bin init (0);/* Number of entries in list */
	dcl     account_listl	 fixed bin init (0);/* Number of entries in list */
	dcl     work_seg_ptr	 ptr;

	dcl     1 work_seg		 aligned based (work_seg_ptr),
		2 owner_list	 like based_list aligned,
		2 account_list	 like based_list aligned,
		2 rest_of_seg	 bit (36) aligned;

	dcl     1 auto_msargs	 aligned automatic like msargs;


/* External stuff */

	dcl     com_err_		 entry options (variable);
	dcl     cu_$arg_count	 entry (fixed bin);
	dcl     cu_$arg_ptr_rel	 entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr);
	dcl     cu_$arg_list_ptr	 entry (ptr);
	dcl     get_temp_segments_	 entry (char (*), dim (*) ptr, fixed bin (35));
	dcl     release_temp_segments_ entry (char (*), dim (*) ptr, fixed bin (35));
	dcl     ioa_		 entry options (variable);
	dcl     mdc_$status		 entry (char (*), ptr, ptr, fixed bin (35));
	dcl     convert_status_code_	 entry (fixed bin (35), char (8) aligned, char (100) aligned);

	dcl     error_table_$badopt	 ext fixed bin (35);
	dcl     error_table_$mdc_illegal_account
				 ext fixed bin (35);
	dcl     error_table_$bad_uidpath
				 ext fixed bin (35);
	dcl     sys_info$max_seg_size	 ext fixed bin (19);

	dcl     (addr, index, length, rtrim, string, verify, null, substr, bin, rel, max)
				 builtin;

	dcl     cleanup		 condition;

%include mdc_status_args;

%include mdc_status_info;

/* Command starts here */

	call cu_$arg_count (nargs);			/* See if any args */
	if nargs = 0
	then do;					/* None */
		call com_err_ (0, name, "Usage: ^a volume -control_args-", name);
		return;
	     end;

	call cu_$arg_list_ptr (arg_list_ptr);

	on cleanup call clean_up;

	call get_work_seg;				/* This allocates a work area */

	call scan_args;				/* Process the argument list */

	call make_call;				/* Call mdc_ for data */

	call print_results;				/* This does all the work */

done:
	call clean_up;

	return;


/* Procedure that allocates a temp segment for a work area */

get_work_seg:
     proc;

	call get_temp_segments_ (name, ptr_array, code);
	if code ^= 0
	then do;
		call com_err_ (code, name, "Allocating temp segment");
		go to done;
	     end;

	work_seg_ptr = ptr_array (1);
	return;

     end get_work_seg;

/* Procedure to process the argument list */

scan_args:
     proc;

	call get_arg;				/* Get first argument */
	volume = arg;				/* Which is volume name */

	do while (more_args);			/* Now check for control arguments */
	     call get_arg;
	     if arg = "-quota"
	     then quota_sw = "1"b;
	     else if arg = "-directory" | arg = "-dr"
	     then dir_sw = "1"b;
	     else if arg = "-brief" | arg = "-bf"
	     then brief_sw = "1"b;
	     else if arg = "-long" | arg = "-lg"
	     then long_sw = "1"b;
	     else if arg = "-all" | arg = "-a"
	     then all_sw = "1"b;
	     else if arg = "-restrict"
	     then restrict_sw = "1"b;
	     else if arg = "-owner"
	     then do;
		     call build_list (addr (owner_list), owner_listl);
		     owner_sw = "1"b;
		end;
	     else if arg = "-account"
	     then do;
		     call build_list (addr (account_list), account_listl);
		     account_sw = "1"b;
		end;
	     else do;
		     call com_err_ (error_table_$badopt, name, "^a", arg);
		     go to done;
		end;
	end;
	if ^(quota_sw | dir_sw)
	then quota_sw, dir_sw = "1"b;
	if all_sw & ^owner_sw
	then account_sw = "1"b;
	return;

     end scan_args;


/* Procedure to get the next argument from the command line */

get_arg:
     proc;

	call cu_$arg_ptr_rel (arg_no, arg_ptr, arg_len, code, arg_list_ptr);
	if code ^= 0
	then do;					/* This is a programming error */
		call com_err_ (code, name, "Arg ^d.", arg_no);
		go to done;
	     end;

	arg_no = arg_no + 1;
	more_args = (arg_no <= nargs);

	return;

put_arg:
     entry;					/* Entry to "return" an arg if too many checked */

	arg_no = arg_no - 1;
	more_args = (arg_no <= nargs);
	return;

     end get_arg;

/* Procedure to build a list of account names */

build_list:
     proc (p, n);

	dcl     p			 ptr;		/* Pointer to list */
	dcl     n			 fixed bin;	/* Current length of list */
	dcl     arg_name		 char (16);	/* For error messages */

	arg_name = arg;				/* Save control arg name */
	do while (more_args);			/* Scan for elements */
	     call get_arg;
	     if substr (arg, 1, 1) = "-"
	     then do;				/* Control arg found, scanned too far */
		     call put_arg;			/* Back up over control arg */
		     return;
		end;
	     if n = list_length
	     then do;				/* Too many ags */
		     call com_err_ (0, name, "Too many arguments after ^a.", arg_name);
		     go to done;
		end;

	     n = n + 1;
	     call parse_acct (p, n);
	end;

	return;

     end build_list;

/* Procedure to parse an account name into components */

parse_acct:
     proc (p, n);

	dcl     p			 ptr;		/* Pointer to list to store result */
	dcl     n			 fixed bin;	/* Position in list */

	dcl     person		 char (22);
	dcl     project		 char (9);
	dcl     tag		 char (1);
	dcl     i			 fixed bin;

	if arg_len > length (acct)
	then /* Check for argument too long */
	     if substr (arg, length (acct) + 1) ^= ""
	     then do;
bad_acct:
		     call com_err_ (error_table_$mdc_illegal_account, name, "^a", arg);
		     go to done;
		end;

	acct = arg;
	i = index (acct, " ");			/* Check for imbedded blanks */
	if i > 0
	then if substr (acct, i) ^= " "
	     then go to bad_acct;

	call parse_acct_comp (person);		/* Strip off person */
	if code ^= 0
	then go to bad_acct;
	call parse_acct_comp (project);		/* Strip off project */
	if code ^= 0
	then go to bad_acct;
	call parse_acct_comp (tag);			/* And the tag */
	if code ^= 0
	then go to bad_acct;

	if acct ^= ""
	then go to bad_acct;			/* Should not be any thing left */

	p -> based_list.person (n) = person;		/* Store result */
	p -> based_list.project (n) = project;
	return;

     end parse_acct;

/* Internal procedure that strips the next component off the input string */

parse_acct_comp:
     proc (s);

	dcl     s			 char (*);
	dcl     i			 fixed bin;

	code = 0;
	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 do;				/* Too long */
			code = -1;
			return;
		     end;
		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 do;				/* Too much */
			code = -1;
			return;
		     end;
		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 parse_acct_comp;

/* Procedure to build mdc_$status param list and make the call */

make_call:
     proc;

	argp = addr (auto_msargs);			/* Param list built here */
	msargs.version = 1;
	string (msargs.flags) = "0"b;
	msargs.nnames = 0;
	msargs.namesp = null;
	msargs.output_ptr = addr (work_seg.rest_of_seg);
	msargs.output_size = sys_info$max_seg_size - bin (rel (msargs.output_ptr), 18);

	msargs.exec = owner_sw | account_sw | all_sw;
	msargs.dirs = dir_sw;
	msargs.restrict = restrict_sw;

	if account_sw
	then do;
		msargs.account = "1"b;
		msargs.nnames = account_listl;
		msargs.namesp = addr (work_seg.account_list);
	     end;
	else if owner_sw
	then do;
		msargs.owner = "1"b;
		msargs.nnames = owner_listl;
		msargs.namesp = addr (work_seg.owner_list);
	     end;

	call mdc_$status (volume, argp, volume_datap, code);
	if code ^= 0
	then do;
		call com_err_ (code, name, "^a", volume);
		go to done;
	     end;
	return;

     end make_call;

/* Procedure that prints the results of the mdc_$status calll */

print_results:
     proc;

	if msargs.exec
	then call print_exec_results;			/* Volume executive call */
	else call print_user_results;			/* User call */
	return;

     end print_results;


print_user_results:
     proc;

	dcl     flag		 char (1);	/* Used to "star" funny directories */
	dcl     print_star		 bit (1) init ("0"b);
						/* Set if star must be explained  */
	dcl     ndirs		 fixed bin init (0);/* Number of directories printed */

	account_datap = volume_data.accountp;
	owner_datap = volume_data.ownerp;
	if dir_sw
	then do;					/* Directorues requested */
		call ioa_ ("");
		if owner_data.dirp = null
		then call ioa_ ("No master directories on ^a", volume);
		else do;
			if ^brief_sw
			then call ioa_ ("QUOTA^-PATHNAME");
			do dir_datap = owner_data.dirp repeat (dir_data.next) while (dir_datap ^= null);
			     path_datap = dir_data.pathp;
			     flag = "";
			     if quota_sw & account_datap ^= null
			     then do;
				     if string (account_data.name) = string (dir_data.name)
				     then /* Charged to users account */
					quota_sum = quota_sum + dir_data.quota;
				     else do;	/* Charged to some other account */
					     flag = "*";
					     print_star = "1"b;
					     quota_other = quota_other + dir_data.quota;
					end;
				end;
			     call ioa_ ("^d^a^-^a", dir_data.quota, flag, pathname ());
			     ndirs = ndirs + 1;
			     quota_total = quota_total + dir_data.quota;
			     if path_data.code ^= 0
			     then call print_path_error (10);
						/* Some error converting name */
			end;
			if print_star & ^brief_sw
			then call ioa_ ("* indicates directories not charged to the ^a quota account.", account ());
		     end;
	     end;
	if quota_sw
	then do;
		call ioa_ ("");
		if account_datap = null
		then do;
			call ioa_ ("No quota account for ^a on logical volume ^a.", owner (), volume);
			if ndirs > 1
			then call quota_p1;
		     end;
		else do;
			call quota_p2;
			if dir_sw
			then if quota_sum ^= account_data.quota_used
			     then call quota_p3;
			if quota_other > 0
			then call quota_p1;
		     end;
	     end;
	call ioa_ ("");
	if restrict_sw
	then if account_datap ^= null
	     then do;
		     if account_data.restrictp = null
		     then call ioa_ ("There is no master directory path restriction for ^a", account ());
		     else call print_restrict (1, account_data.restrictp);
		end;
	return;

     end print_user_results;

/* Print variuos quota messages */

quota_p1:
     proc;

	if brief_sw
	then call ioa_ ("Total assigned to ^a is ^d.", owner (), quota_total);
	else call ioa_ ("Total quota assigned to directories owned by ^a is ^d.", owner (), quota_total);

     end quota_p1;

quota_p2:
     proc;

	if brief_sw
	then call ioa_ ("Quota available is ^d, assigned is ^d.", account_data.quota, account_data.quota_used);
	else call ioa_ ("Quota available to ^a is ^d, quota assigned is ^d.", account (), account_data.quota,
		account_data.quota_used);

     end quota_p2;

quota_p3:
     proc;

	call ioa_ ("Quota assigned to ^a is ^d.", owner (), quota_sum);

     end quota_p3;

/* Procedure to do printing for volume executive */

print_exec_results:
     proc;

	if account_sw
	then do;
		max_account_len = 7;
		call walk_account (volume_data.accountp, get_max_account_len);
		if dir_sw
		then call print_dir_list_by_account;
		if quota_sw
		then call print_quota_by_account;
	     end;
	else do;
		max_owner_len = 5;
		call walk_owner (volume_data.ownerp, get_max_owner_len);
		if dir_sw
		then call print_dir_list_by_owner;
		if quota_sw
		then call print_quota_by_owner;
	     end;

	return;

     end print_exec_results;

/* Procedures that print exec data by account */

print_dir_list_by_account:
     proc;


	if volume_data.accountp = null
	then do;					/* No accounts returned */
		if account_listl = 0
		then call ioa_ ("No quota accounts on volume ^a.", volume);
		else call ioa_ ("No quota accounts on ^a match requests.", volume);
		go to done;
	     end;

	max_account_len = 7;			/* Compute length of longest account */
	call walk_account (volume_data.accountp, get_max_account_len);

	if long_sw
	then do;
		max_dir_name_len = 5;		/* Get length of longes owner */
		call walk_account_then_dir (volume_data.accountp, get_max_dir_name_len);
		entry_name = print_account_owner_and_dir;
		call ioa_ ("^/^va  ^va  QUOTA  PATHNAME", max_account_len, "ACCOUNT", max_dir_name_len, "OWNER");
	     end;
	else do;
		entry_name = print_account_and_dir;
		call ioa_ ("^/^va  QUOTA  PATHNAME", max_account_len, "ACCOUNT");
	     end;

	call walk_account_then_dir (volume_data.accountp, entry_name);

	return;

     end print_dir_list_by_account;


print_quota_by_account:
     proc;

	call ioa_ ("^/^va  ASSIGNED  AVAILABLE", max_account_len, "ACCOUNT");
	call walk_account (volume_data.accountp, print_account_quota);
	return;

     end print_quota_by_account;

/* Procedures that print exec data by owner */

print_dir_list_by_owner:
     proc;
	if volume_data.ownerp = null
	then do;
		call ioa_ ("No directory owners on ^a match requests.", volume);
		go to done;
	     end;

	if long_sw
	then do;
		max_dir_name_len = 7;		/* Must get longest account name */
		call walk_owner_then_dir (volume_data.ownerp, get_max_dir_name_len);
		call ioa_ ("^/^va  ^va  QUOTA PATHNAME", max_owner_len, "OWNER", max_dir_name_len, "ACCOUNT");
		entry_name = print_owner_account_and_dir;
	     end;
	else do;
		call ioa_ ("^/^va  QUOTA  PATHNAME", max_owner_len, "OWNER");
		entry_name = print_owner_and_dir;
	     end;

	call walk_owner_then_dir (volume_data.ownerp, entry_name);
	return;

     end print_dir_list_by_owner;


print_quota_by_owner:
     proc;

	call ioa_ ("^/^va  QUOTA", max_owner_len, "OWNER");
	call walk_owner (volume_data.ownerp, print_owner_quota);
	return;

     end print_quota_by_owner;

/* Procedures that walk lists in various ways, making calls as they go */

walk_account_then_dir:
     proc (p, e);

	dcl     p			 ptr;
	dcl     e			 entry variable;

	do account_datap = p repeat (account_data.next) while (account_datap ^= null);
	     do dir_datap = account_data.dirp repeat (dir_data.next) while (dir_datap ^= null);
		call e;
	     end;
	end;

	return;

     end walk_account_then_dir;

walk_account:
     proc (p, e);

	dcl     p			 ptr;
	dcl     e			 entry variable;

	do account_datap = p repeat (account_data.next) while (account_datap ^= null);
	     call e;
	end;
	return;

     end walk_account;

walk_owner:
     proc (p, e);

	dcl     p			 ptr;
	dcl     e			 entry variable;

	do owner_datap = p repeat (owner_data.next) while (owner_datap ^= null);
	     call e;
	end;
	return;

     end walk_owner;

walk_owner_then_dir:
     proc (p, e);

	dcl     p			 ptr;
	dcl     e			 entry variable;

	do owner_datap = p repeat (owner_data.next) while (owner_datap ^= null);
	     do dir_datap = owner_data.dirp repeat (dir_data.next) while (dir_datap ^= null);
		call e;
	     end;
	end;
	return;

     end walk_owner_then_dir;

/* These procedures are the targets of proc_caller and do all the work of printing exec data */

print_account_and_dir:
     proc;

	path_datap = dir_data.pathp;
	call ioa_ ("^va  ^6a ^a", max_account_len, account (), qedit (dir_data.quota), pathname ());
	if path_data.code ^= 0
	then call print_path_error (max_account_len + 9);
	return;

     end print_account_and_dir;

print_account_owner_and_dir:
     proc;

	path_datap = dir_data.pathp;
	call ioa_ ("^va  ^va  ^6a ^a", max_account_len, account (), max_dir_name_len, dir_name (),
	     qedit (dir_data.quota), pathname ());
	if path_data.code ^= 0
	then call print_path_error (max_account_len + max_dir_name_len + 11);
	return;

     end print_account_owner_and_dir;


print_account_quota:
     proc;

	call ioa_ ("^va  ^9a ^a", max_account_len, account (), qedit (account_data.quota_used),
	     qedit (account_data.quota));
	return;

     end print_account_quota;

print_owner_and_dir:
     proc;

	path_datap = dir_data.pathp;
	call ioa_ ("^va  ^6a ^a", max_owner_len, owner (), qedit (dir_data.quota), pathname ());
	if path_data.code ^= 0
	then call print_path_error (max_owner_len + 9);
	return;

     end print_owner_and_dir;

print_owner_account_and_dir:
     proc;

	path_datap = dir_data.pathp;
	call ioa_ ("^va  ^va  ^6a ^a", max_owner_len, owner (), max_dir_name_len, dir_name (), qedit (dir_data.quota),
	     pathname ());
	if path_data.code ^= 0
	then call print_path_error (max_owner_len + max_dir_name_len + 11);
	return;

     end print_owner_account_and_dir;

get_max_dir_name_len:
     proc;

	max_dir_name_len = max (max_dir_name_len, length (dir_name ()));
	return;

     end get_max_dir_name_len;

get_max_account_len:
     proc;

	max_account_len = max (max_account_len, length (account ()));
	return;

     end get_max_account_len;

get_max_owner_len:
     proc;

	max_owner_len = max (max_owner_len, length (owner ()));
	return;

     end get_max_owner_len;


print_owner_quota:
     proc;

	quota_sum = 0;
	do dir_datap = owner_data.dirp repeat (dir_data.next) while (dir_datap ^= null);
	     quota_sum = quota_sum + dir_data.quota;
	end;
	call ioa_ ("^va  ^a", max_owner_len, owner (), qedit (quota_sum));
	return;

     end print_owner_quota;

/* Procedure to print a pathname restriction list */

print_restrict:
     proc (n, p);

	dcl     n			 fixed bin;	/* Index to messages */
	dcl     p			 ptr;		/* Pointer to list */

	dcl     restrict_msg	 (1) char (64) var int static options (constant)
				 init ("Master directories are restricted to");

	path_datap = p;
	if path_data.next = null & path_data.code = 0
	then do;					/* Simple case, 1 dir, no errors */
		call ioa_ ("^a ^a", restrict_msg (n), pathname ());
		return;
	     end;
	call ioa_ ("^a:", restrict_msg (n));		/* Heading for a long list */
	do path_datap = p repeat (path_data.next) while (path_datap ^= null);
	     call ioa_ ("^-^a", pathname ());
	     if path_data.code ^= 0
	     then call print_path_error (10);
	end;
	return;

     end print_restrict;

/* Procedure called for bad pathnames to print an error */

print_path_error:
     proc (n);

	dcl     n			 fixed bin;	/* Number of columns to indent */
	dcl     (
	        long_info		 char (100),
	        short_info		 char (8)
	        )			 aligned;

	call convert_status_code_ (path_data.code, short_info, long_info);
	call ioa_ ("^vx(Error: ^a)", n, long_info);
	return;

     end print_path_error;

/* Internal procedure that edit various things */

pathname:
     proc returns (char (201) var);

	dcl     work		 char (201) var;

	if path_data.dir = ""
	then work = "-????-";
	else work = rtrim (path_data.dir);
	if work ^= ">"
	then work = work || ">";
	if path_data.ename = ""
	then do;
		if work ^= ">" | path_data.code = error_table_$bad_uidpath
		then work = work || "-????-";
	     end;
	else work = work || rtrim (path_data.ename);

	return (work);

     end pathname;

account:
     proc returns (char (32) var);

	return (rtrim (account_data.person) || "." || rtrim (account_data.project));

     end account;

owner:
     proc returns (char (32) var);

	return (rtrim (owner_data.person) || "." || rtrim (owner_data.project));

     end owner;

dir_name:
     proc returns (char (32) var);

	return (rtrim (dir_data.person) || "." || rtrim (dir_data.project));

     end dir_name;

	declare qedit		 generic (DQ when (fixed bin (18)), VQ when (fixed bin (35)));
DQ:
     proc (d) returns (char (16) varying);

	dcl     d			 fixed bin (18);
	dcl     edit		 picture "zzzzzzzz9";

	edit = d;
	go to COMMON;

VQ:
     entry (v) returns (char (16) varying);

	declare v			 fixed bin (35);

	edit = v;

COMMON:
	return (ltrim (edit));

     end DQ;


/* Cleanup handler */

clean_up:
     proc;

	if ptr_array (1) ^= null
	then call release_temp_segments_ (name, ptr_array, code);
	return;

     end clean_up;

     end list_mdir;




		    set_mdir_account.pl1            11/04/82  1901.2rew 11/04/82  1613.1       16794



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* SET_MDIR_ACCOUNT:  Command to change the quota account of a master directory */

/* Written March 1976 by Larry Johnson */

set_mdir_account: smda: proc;

dcl  code fixed bin (35);				/* System status code */
dcl  name char (16) int static options (constant) init ("set_mdir_account");
dcl  arg_ptr ptr;
dcl  arg_len fixed bin;
dcl  arg char (arg_len) based (arg_ptr);
dcl  dir char (168);
dcl  ename char (32);
dcl  account char (32);

dcl  ioa_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  mdc_$set_mdir_account entry (char (*), char (*), char (*), fixed bin (35));
dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));

dcl (addr) builtin;

	call cu_$arg_ptr (1, arg_ptr, arg_len, code);	/* Get path */
	if code ^= 0 then do;
	     call ioa_ ("Usage: ^a path -account-", name);
	     return;
	end;
	call expand_path_ (arg_ptr, arg_len, addr (dir), addr (ename), code);
	if code ^= 0 then do;
	     call com_err_ (code, name, "^a", arg);
	     return;
	end;

	call cu_$arg_ptr (2, arg_ptr, arg_len, code);	/* New account */
	if code ^= 0 then account = "";		/* Standard default */
	else account = arg;

	call mdc_$set_mdir_account (dir, ename, account, code);
	if code ^= 0 then call com_err_ (code, name);
	return;

     end set_mdir_account;




		    set_mdir_owner.pl1              11/04/82  1901.2rew 11/04/82  1613.1       16983



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* SET_MDIR_OWNER: Command to change the owner of a master directory */

/* Written March 1976 by Larry Johnson */

set_mdir_owner: smdo: proc;

dcl  code fixed bin (35);				/* system status code */
dcl  name char (14) int static options (constant) init ("set_mdir_owner");
dcl  arg_ptr ptr;
dcl  arg_len fixed bin;
dcl  arg char (arg_len) based (arg_ptr);
dcl  dir char (168);
dcl  ename char (32);
dcl  owner char (32);

dcl  ioa_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  mdc_$set_mdir_owner entry (char (*), char (*), char (*), fixed bin (35));
dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  get_group_id_$tag_star entry returns (char (32));

dcl (addr) builtin;

	call cu_$arg_ptr (1, arg_ptr, arg_len, code);	/* get path */
	if code ^= 0 then do;
	     call ioa_ ("Usage: ^a path -owner-", name);
	     return;
	end;
	call expand_path_ (arg_ptr, arg_len, addr (dir), addr (ename), code);
	if code ^= 0 then do;
	     call com_err_ (code, name, "^a", arg);
	     return;
	end;

	call cu_$arg_ptr (2, arg_ptr, arg_len, code);	/* new owner */
	if code ^= 0 then owner = get_group_id_$tag_star ();
	else owner = arg;

	call mdc_$set_mdir_owner (dir, ename, owner, code);
	if code ^= 0 then call com_err_ (code, name);
	return;

     end set_mdir_owner;




		    set_mdir_quota.pl1              11/19/84  1039.2rew 11/18/84  1430.0       26856



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */

/* format: style2,indcomtxt */

/* SET_MDIR_QUOTA: Command to set quota on a master directory. */

/* Written March 1976 by Larry Johnson */
/* Modified 83-12-07 BIM for correct quota precision */

set_mdir_quota:
smdq:
     procedure options (variable);

	dcl     name		 char (14) int static options (constant) init ("set_mdir_quota");
	dcl     code		 fixed bin (35);
	dcl     arg_ptr		 ptr;
	dcl     arg_len		 fixed bin;
	dcl     arg		 char (arg_len) based (arg_ptr);
	dcl     dir		 char (168);
	dcl     ename		 char (32);
	dcl     quota		 fixed bin (18);
	dcl     i			 fixed bin;
	dcl     sw		 bit (1) aligned;
	dcl     nargs		 fixed bin;
	dcl     j			 fixed bin;

	dcl     cu_$arg_ptr		 entry (fixed bin, ptr, fixed bin, fixed bin (35));
	dcl     ioa_		 entry options (variable);
	dcl     com_err_		 entry options (variable);
	dcl     expand_path_	 entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
	dcl     mdc_$set_mdir_quota	 entry (char (*), char (*), bit (1) aligned, fixed bin (18), fixed bin (35));
	dcl     cv_dec_check_	 entry (char (*), fixed bin) returns (fixed bin (35));
	dcl     cu_$arg_count	 entry (fixed bin);
	dcl     pathname_		 entry (character (*), character (*)) returns (character (168));

	dcl     (addr, bin, substr)	 builtin;

	call cu_$arg_count (nargs);
	if nargs = 0
	then do;
		call ioa_ ("Usage: ^a path quota", name);
		return;
	     end;

	do j = 1 to nargs by 2;
	     call cu_$arg_ptr (j, arg_ptr, arg_len, code);/* Path name */
	     if code ^= 0
	     then do;
		     call com_err_ (code, name);	/* Should not happen */
		     return;
		end;
	     call expand_path_ (arg_ptr, arg_len, addr (dir), addr (ename), code);
	     if code ^= 0
	     then do;
		     call com_err_ (code, name, "^a", arg);
		     go to next;
		end;

	     call cu_$arg_ptr (j + 1, arg_ptr, arg_len, code);
						/* Get new quota */
	     if code ^= 0
	     then do;
		     call com_err_ (code, name, "Quota for ^a.", pathname_ (dir, ename));
		     return;
		end;
	     quota = cv_dec_check_ (arg, i);
	     if i ^= 0
	     then do;
		     call com_err_ (0, name, "Quota for ^a must be numeric: ^a", pathname_ (dir, ename), arg);
		     go to next;
		end;

	     if substr (arg, 1, 1) = "+" | substr (arg, 1, 1) = "-"
	     then sw = "1"b;
	     else sw = "0"b;

	     call mdc_$set_mdir_quota (dir, ename, sw, quota, code);
	     if code ^= 0
	     then call com_err_ (code, name, "^a", pathname_ (dir, ename));
next:
	end;
	return;

     end set_mdir_quota;




		    set_volume_quota.pl1            11/19/84  1039.2rew 11/18/84  1430.0       24102



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   * Copyright (c) 1972 by Massachusetts Institute of        *
   * Technology and Honeywell Information Systems, Inc.      *
   *                                                         *
   *********************************************************** */


/* format: style2,indcomtxt */

/* SET_VOLUME_QUOTA: Command to set logical volume quota for a quota account */

/* Written March 1976 by Larry Johnson */
/* Modified 83-12-07 BIM for correct precision of quota */

set_volume_quota:
svq:
     procedure options (variable);

	dcl     name		 char (16) int static options (constant) init ("set_volume_quota");
	dcl     code		 fixed bin (35);	/* System status code */
	dcl     arg_ptr		 ptr;		/* Pointer to command argument */
	dcl     arg_len		 fixed bin;	/* Length of command argument */
	dcl     arg		 char (arg_len) based (arg_ptr);
						/* The argument */
	dcl     volume		 char (32);	/* Logical volume name */
	dcl     account		 char (32);	/* Name of quota account */
	dcl     quota		 fixed bin (35);	/* The quota to set */

	dcl     i			 fixed bin;
	dcl     sw		 bit (1) aligned;

	dcl     cu_$arg_ptr		 entry (fixed bin, ptr, fixed bin, fixed bin (35));
	dcl     com_err_		 entry options (variable);
	dcl     ioa_		 entry options (variable);
	dcl     cv_dec_check_	 entry (char (*), fixed bin) returns (fixed bin (35));
	dcl     mdc_$set_volume_quota	 entry (char (*), char (*), bit (1) aligned, fixed bin (35), fixed bin (35));
	dcl     get_group_id_$tag_star entry returns (char (32));

	dcl     substr		 builtin;


	call cu_$arg_ptr (1, arg_ptr, arg_len, code);	/* Get volume name */
	if code ^= 0
	then do;
		call ioa_ ("Usage: ^a volume quota -account-", name);
		return;
	     end;
	volume = arg;

	call cu_$arg_ptr (2, arg_ptr, arg_len, code);	/* Get quota */
	if code ^= 0
	then do;
		call com_err_ (code, name, "Quota");
		return;
	     end;

	quota = cv_dec_check_ (arg, i);
	if i ^= 0
	then do;
		call com_err_ (0, name, "Quota must be numeric: ^a", arg);
		return;
	     end;

	if substr (arg, 1, 1) = "+" | substr (arg, 1, 1) = "-"
	then sw = "1"b;				/* Incremental */
	else sw = "0"b;

	call cu_$arg_ptr (3, arg_ptr, arg_len, code);	/* Get account name */
	if code ^= 0
	then account = get_group_id_$tag_star ();
	else account = arg;

	call mdc_$set_volume_quota (volume, account, sw, quota, code);
	if code ^= 0
	then call com_err_ (code, name, "^a", volume);
	return;

     end set_volume_quota;





		    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
