



		    check_mdcs.pl1                  11/15/82  1852.7rew 11/15/82  1519.2       14868



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


/* CHECK_MDCS: Command to validate the contents of a master direcotry control segment */

/* Written June 1976 by Larry Johnson */

check_mdcs: proc;

dcl  name char (10) int static options (constant) init ("check_mdcs");
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  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  ioa_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  mdc_priv_$validate_uidpaths entry (char (*), fixed bin (35));

dcl  error_table_$bad_uidpath ext fixed bin (35);

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

	volume = arg;

	call mdc_priv_$validate_uidpaths (volume, code);
	if code = 0 then call ioa_ ("^a: No errors detected in ^a.mdcs", name, volume);
	else if code = error_table_$bad_uidpath then
	     call com_err_ (0, name, "One or more uidpaths in ^a.mdcs were invalid and were deleted.", volume);
	else call com_err_ (code, name, "^a", volume);
	return;

     end check_mdcs;




		    priv_move_quota_.pl1            11/15/82  1852.7rew 11/15/82  1519.0       29079



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


priv_move_quota_: proc (dirname, ename, qvalue, code);

/*  privileged quota moving subroutine.  SCV  5/75 */

dcl  hcs_$set_ips_mask entry (bit (36)aligned, bit (36) aligned);
dcl  system_privilege_$dir_priv_on entry (fixed bin (35));
dcl  system_privilege_$dir_priv_off entry (fixed bin (35));
dcl  hcs_$quota_move entry (char (*), char (*), fixed bin, fixed bin (35));
dcl  hcs_$dir_quota_move entry (char (*), char (*), fixed bin, fixed bin (35));
dcl  error_table_$badcall external fixed bin (35);
dcl  error_table_$action_not_performed external fixed bin (35);

dcl  any_other condition;

dcl (dirname, ename) char (*);
dcl  qvalue fixed bin (17);
dcl  code fixed bin (35);
dcl  action fixed bin (35);
dcl  old_mask bit (36) aligned init ((36)"0"b);
dcl  junk bit (36) aligned;
dcl  dir_sw bit (1) init ("0"b);

dcl  null builtin;

/*  */

MOVE:	code = error_table_$action_not_performed;	/* initialize the code in case of condition */

	action = 1;				/*  used to indicate that privileges are on */

	on any_other call reset_mask;			/*  make sure we turn them off is set */

	call hcs_$set_ips_mask ((36)"0"b, old_mask);

	call system_privilege_$dir_priv_on (action);
	if dir_sw then call hcs_$dir_quota_move (dirname, ename, qvalue, code);
	else call hcs_$quota_move (dirname, ename, qvalue, code);
	if action = 0 then call system_privilege_$dir_priv_off (action);
	action = 1;

	call hcs_$set_ips_mask (old_mask, junk);
	old_mask = "0"b;

RETURN:	return;

dir:	entry (dirname, ename, qvalue, code);

	dir_sw = "1"b;
	go to MOVE;

/*  */

reset_mask: proc ;

dcl 1 info aligned,
    2 mc_ptr ptr,
    2 version fixed bin,
    2 cond_name char (32) varying,
    2 info_pad (15) bit (36);

dcl  find_condition_info_ entry (ptr, ptr, fixed bin (35)),
     continue_to_signal_ entry (fixed bin (35));

dcl  ec fixed bin (35);

	     version = 1;				/* tell what version the structure is */

	     call find_condition_info_ (null, addr (info), ec); /* see what happened */

	     if action = 0 then
		call system_privilege_$dir_priv_off (action); /* reset what we did */
	     action = 1;				/* and cancel future effects */

	     if old_mask then do;			/* see if the ips mask was set */

		call hcs_$set_ips_mask (old_mask, junk); /* restore the mask */
		old_mask = (36)"0"b;		/* reset the value */
	     end;

	     if ec = 0 then				/* if all was well, and should be, look more */
		if cond_name = "linkage_error" then do; /* user faulted on system_privilege_ gate */

		     code = error_table_$badcall;
		     go to RETURN;			/* non local go to for a finish */

		end;

	     call continue_to_signal_ (ec);		/* let someone else handle the condition */

	     return;

	end reset_mask;
     end priv_move_quota_;




		    privileged_make_seg_.pl1        11/15/82  1852.7rew 11/15/82  1519.0       23184



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


privileged_make_seg_: proc (dname, ename, rname, mode, segp, ecode);

/* This subroutine is provided as a replacement for hcs_$make_seg
   for use by processes having access to the system_privilege_
   gate.  It should be used instead of hcs_$make_seg whenever it
   is desired to "make" a segment which can have an access class
   different from the process authorization.
*/

/* Written by J. Stern, 2/5/75 */


dcl  dname char (*);				/* directory name */
dcl  ename char (*);				/* entry name */
dcl  rname char (*);				/* reference name */
dcl  mode fixed bin (5);				/* access mode */
dcl  segp ptr;					/* segment pointer */
dcl  ecode fixed bin (35);				/* error code */
dcl  priv_code fixed bin (35);			/* code returned by dir_priv_on */
dcl  code1 fixed bin (35);				/* code returned by append_branch */
dcl  code2 fixed bin (35);				/* code returned by initiate */

dcl  null builtin;
dcl  error_table_$namedup fixed bin (35) ext static;
dcl  cleanup condition;

dcl  system_privilege_$dir_priv_on entry (fixed bin (35));
dcl  system_privilege_$dir_priv_off entry (fixed bin (35));
dcl  hcs_$append_branch entry (char (*), char (*), fixed bin (5), fixed bin (35));
dcl  system_privilege_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));

          segp = null();				/* like hcs_$make_seg does for caller		*/
	priv_code = 1;				/* indicates no change to dir privilege yet */
	on cleanup begin;
	     if priv_code = 0 then call system_privilege_$dir_priv_off (priv_code);
	end;

	call system_privilege_$dir_priv_on (priv_code);	/* turn on directory privilege */

	call hcs_$append_branch (dname, ename, mode, code1);

	if priv_code = 0 then			/* directory priv was not on before */
	     call system_privilege_$dir_priv_off (priv_code);
	priv_code = 1;

	if code1 ^= 0 then
	     if code1 ^= error_table_$namedup then go to set_code;

	call system_privilege_$initiate (dname, ename, rname, 0, 1, segp, code2);
	if code2 ^= 0 then ecode = code2;
	else
set_code:	ecode = code1;


     end privileged_make_seg_;




		    register_mdir.pl1               11/15/82  1852.7rew 11/15/82  1519.0       47223



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


/* REGISTER_MDIR: Command that will register an existing master directory in ring 1 */

/* Written April 1976 by Larry Johnson */

register_mdir: proc;

dcl  code fixed bin (35);
dcl  name char (13) int static options (constant) init ("register_mdir");
dcl  nargs fixed bin;
dcl  arg_ptr ptr;
dcl  arg_len fixed bin;
dcl  arg char (arg_len) based (arg_ptr);
dcl  path_ptr ptr;
dcl  path_len fixed bin init (0);
dcl  path char (path_len) based (path_ptr);
dcl  all_sw bit (1) init ("0"b);
dcl  bf_sw bit (1) init ("0"b);
dcl  dir char (168);
dcl  ename char (32);
dcl  i fixed bin;
dcl (reg_count, check_count) fixed bin init (0);

dcl  ioa_ entry options (variable);
dcl  com_err_ entry options (variable);
dcl  cu_$arg_count entry (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  mdc_priv_$register_mdir entry (char (*), char (*), fixed bin (35));
dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  sweep_disk_ entry (char (168) aligned, entry);

dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$mdc_not_mdir ext fixed bin (35);
dcl  error_table_$request_not_recognized ext fixed bin (35);
dcl  error_table_$noarg ext fixed bin (35);
dcl  error_table_$namedup ext fixed bin (35);

dcl (substr, addr, length, verify, reverse, null) builtin;


/* Scan arguments */

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

	do i = 1 to nargs;
	     call cu_$arg_ptr (i, arg_ptr, arg_len, code);
	     if code ^= 0 then do;
err:		call com_err_ (code, name);
		return;
	     end;
	     if substr (arg, 1, 1) = "-" then do;
		if arg = "-all" then all_sw = "1"b;
		else if arg = "-brief" | arg = "-bf" then bf_sw = "1"b;
		else do;
		     code = error_table_$badopt;
arg_err:		     call com_err_ (code, name, "^a", arg);
		     return;
		end;
	     end;
	     else if path_len = 0 then do;		/* No path yet */
		path_ptr = arg_ptr;
		path_len = arg_len;
	     end;
	     else do;
		code = error_table_$request_not_recognized;
		go to arg_err;
	     end;
	end;


/* Handel the case of a single directory to register */

	if ^all_sw then do;
	     if path_len = 0 then do;
		code = error_table_$noarg;
		go to err;
	     end;
	     call expand_path_ (path_ptr, path_len, addr (dir), addr (ename), code);
	     if code ^= 0 then do;
path_err:		call com_err_ (code, name, "^a", path);
		return;
	     end;

	     call mdc_priv_$register_mdir (dir, ename, code);
	     if code ^= 0 then call com_err_ (code, name, "^a>^a", dir, ename);
	     return;
	end;


/* If -all given, must scan a tree. Let sweep_disk_ do the work */

	if path_len = 0 then do;			/* No path given, assume root */
	     dir = ">";
	     ename = "";
	     call register;				/* Be sure root gets registered */
	end;
	else do;
	     call expand_path_ (path_ptr, path_len, addr (dir), addr (ename), code);
	     if code ^= 0 then go to path_err;
	     call register;
	     call expand_path_ (path_ptr, path_len, addr (dir), null, code);
	     if code ^= 0 then go to path_err;
	end;

	call sweep_disk_ ((dir), check_mdir);		/* Scan the hierarchy */
	call ioa_ ("^a: ^d directories checked, ^d registered.", name, check_count, reg_count);
	return;


/* This procedure is called by sweep_disk_ each time it finds something */

check_mdir: proc (sdn, sen, lvl, een, bptr, nptr);

dcl  sdn char (168) aligned;				/* Superior directory */
dcl  sen char (32) aligned;				/* Containing directory */
dcl  lvl fixed bin;
dcl  een char (32) aligned;				/* Name of thing found */
dcl (bptr, nptr) ptr;

dcl 1 branch based (bptr) aligned,			/* Structure passed by sweep_disk_ */
    2 type bit (2) unal,
    2 nname bit (16) unal,
    2 nindex bit (18) unal,
    2 dtm bit (36) unal,
    2 dtu bit (36) unal,
    2 mode bit (5) unal,
    2 pad bit (13) unal,
    2 records bit (18) unal;

	     if branch.type ^= "10"b then return;	/* Only check directorys */

	     dir = sdn;
	     if sen ^= "" then do;			/* Build directory name */
		i = verify (reverse (dir), " ");
		i = length (dir)-i+2;
		if dir ^= ">" then substr (dir, i, 1) = ">";
		else i = i-1;
		substr (dir, i+1) = sen;
	     end;
	     ename = een;
	     call register;
	     return;

	end check_mdir;


register:	proc;

	     check_count = check_count + 1;
	     call mdc_priv_$register_mdir (dir, ename, code);
	     if code = 0 then do;
		reg_count = reg_count + 1;
		if ^bf_sw then call ioa_ ("Registered ^a^v(>^)^a", dir, bin (dir ^= ">", 1), ename);
	     end;
	     else if code = error_table_$mdc_not_mdir then return;
	     else if code ^= error_table_$namedup then call com_err_ (code, name, "^a>^a", dir, ename);
	     return;

	end register;


     end register_mdir;




		    set_quota.pl1                   11/15/82  1852.7rew 11/15/82  1518.9       48015



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


/* quota manipulating commands

   set_quota, sq, requires a privileged entry to set a quota
   priv_move_quota, sets directory access isolation privileges before doing the move_quota function
   (actually by calling the priv_move_quota_ subroutine to do it)

   set_quota and priv_move_quota take pairs of arguments the first of which
   is the pathname (can be "-wd" or "-wdir") of the directory on which a quota
   is to be set, and the second of which specifies the value of the
   quota which is to be used.

   coded November 1969 MR Thompson
   to pl1 January 1970 JW Gintell
   modified May 1971  JW Gintell
   star convention added to get_quota Sept 1971  JW Gintell
   converted to version 2 Dec l972  JW Gintell
   priv_move_quota entry added 09/26/74  J. C. Whitmore
   */
set_quota: setquota: sq: proc;

dcl  pathname char (plen) based (pp),			/* command argument */
     dirname char (168) aligned,			/* returned by expand_path_ */
     ename char (32) aligned,				/*  " */
     quota char (qlen) based (qp),			/* command argument */
     qlen fixed bin (17),
     qvalue fixed bin (17),				/* value of quota */
     comname char (16) aligned,			/* name of command */
    (nargs, plen) fixed bin (17),
     code fixed bin (35),
     i fixed bin (17),
     entry_sw fixed bin,				/* 1 = sq, 2 = priv_mq */
     dir_sw bit (1) init ("0"b),			/* TRUE for dir quota */
     tup fixed bin (35),				/* date-time ptp updated */
    (tused, tquota) fixed bin (17) init (0),		/* total used and quota */
     prheadsw bit (1) aligned init ("1"b),		/* switch for printing heading */
     stars bit (1) aligned init (""b),			/* switch if stars found */
    (pp, qp, enp) ptr;
dcl  error_table_$badopt external fixed bin (35);
dcl  error_table_$badcall external fixed bin (35);

dcl  cu_$arg_count external entry (fixed bin (17)),
     cu_$arg_ptr external entry (fixed bin (17), ptr, fixed bin (17), fixed bin (35)),
     expand_path_ external entry (ptr, fixed bin (17), ptr, ptr, fixed bin (35)),
     ioa_ external entry options (variable),
     com_err_ external entry options (variable),

     hphcs_$quota_set external entry (char (*) aligned, fixed bin, fixed bin (35)),
     hphcs_$dir_quota_set external entry (char (*) aligned, fixed bin, fixed bin (35)),
     priv_move_quota_ entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (35)),
     priv_move_quota_$dir entry (char (*) aligned, char (*) aligned, fixed bin, fixed bin (35)),
     cv_dec_check_ external entry (char (*), fixed bin (35)) returns (fixed bin (17));
dcl (null, addr, substr) builtin;
dcl  linkage_error condition;



/*  */

SET:
	entry_sw = 1;
	enp = null;				/* expand_path_ will retn single string */
	comname = "set_quota";
	on condition (linkage_error) begin;		/* catch call to priv. entry  */
	     code = error_table_$badcall;
	     goto ERROR;				/* non local goto */
	end;
	go to COMMON;

set_dir_quota: entry;

	dir_sw = "1"b;
	go to SET;


priv_move_dir_quota: entry;

	dir_sw = "1"b;

priv_move_quota: entry;

	entry_sw = 2;
	enp = addr (ename);
	comname = "priv_move_quota";



COMMON:
	call cu_$arg_count (nargs);
	if nargs < 2 then do;
	     call ioa_ ("^a: not enough arguments", comname);
	     return;
	end;

	do i = 1 to nargs by 2;			/* arguments come in pairs */
	     call cu_$arg_ptr (i, pp, plen, code);	/* the first is a pathname */
	     if code ^= 0 then go to ERROR;
	     if substr (pathname, 1, 1) = "-" then do;
		if pathname = "-wd" | pathname = "-wdir" then plen = 0; /* expand path will then work */
		else do;
		     call com_err_ (error_table_$badopt, comname, pathname);
		     return;
		end;
	     end;

	     call cu_$arg_ptr (i+1, qp, qlen, code);	/* the second is a quota value */
	     if code ^= 0 then go to ERROR;
	     if qlen = 0 then go to ERROR;
	     qvalue = cv_dec_check_ (quota, code);	/* which must converted */
	     if code ^= 0 then go to NUMERR;		/* it must be decimal */

	     call expand_path_ (pp, plen, addr (dirname), enp, code);
	     if code ^= 0 then go to ERROR;
	     if entry_sw = 1 then do;			/* set_quota entry */
		if dir_sw then call hphcs_$dir_quota_set (dirname, qvalue, code);
		else call hphcs_$quota_set (dirname, qvalue, code);
	     end;
	     else do;				/* priv_move_quota entry */
		if dir_sw then call priv_move_quota_$dir (dirname, ename, qvalue, code);
		else call priv_move_quota_ (dirname, ename, qvalue, code);

	     end;
	     if code ^= 0 then go to ERROR;
ENDARG:	end;

RETURN:	return;

ERROR:
	if code = error_table_$badcall then
mess:	     call com_err_ ((0), "set_quota", "This command requires privileged access not given to this user.");
	else
	call com_err_ (code, comname, pathname);
	go to ENDARG;

NUMERR:	call com_err_ ((0), comname, "Numerical value for quota must be given - ^a", quota);
	go to ENDARG;

     end set_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
