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