COMPILATION LISTING OF SEGMENT get_raw_access_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1541.9 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 get_raw_access_: proc (tptr, tlng, user_name, ring, dmode, emode, code); 12 13 /* This procedure is given a pathname and returns the given user's access to the directory and entry. 14* It calls chase_ to chase any links, imbedded or otherwise. 15* The reason for using this procedure instead of hcs_$fs_get_path_name is to check a given user's access 16* through a chain of links, and also to get the real directory even if the entry doesn't exist. 17**/ 18 /* initially coded by M. Weaver 18 November 1970 */ 19 /* last modified by M. Weaver 8 January 1971 */ 20 21 dcl (tdir, dir, retpn) char (168); 22 dcl (ent, tent) char (32); 23 dcl user_name char (*); 24 dcl (ring, rl, rlev, lng, tlng, rlng) fixed bin; 25 dcl code fixed bin (35); 26 dcl (dmode, emode) fixed bin (5); 27 dcl (dptr, eptr, pptr, tptr, bptr, nptr) ptr; 28 dcl noent bit (1) aligned; 29 dcl name1 char (tlng) based (tptr); 30 dcl name2 char (lng) based (dptr); 31 dcl name3 char (lng) based (pptr); 32 dcl narea (0:959); /* area for names from status_; safer to put in stack */ 33 dcl (addr, fixed, index, null, ptr, substr, unspec) builtin; 34 35 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 36 dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); 37 dcl hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35)); 38 dcl (error_table_$root, error_table_$noentry) ext fixed bin (35); 39 dcl tarea (0:3); /* area for hcs_$status info */ 40 41 42 rl, rlev = 0; /* initialize recursion level indicators */ 43 bptr = addr (tarea); 44 nptr = addr (narea); /* set up pointer to names area */ 45 pptr = addr (tdir); /* will expand arg pathname into tdir */ 46 call absolute_pathname_ (name1, tdir, code); 47 if code ^= 0 then return; 48 rlng = index (tdir, " ") - 1; /* get length of expanded path name */ 49 50 call chase_ (pptr, rlng, retpn, code); 51 /* if all goes well, retpn will contain the real absolute pathname of path */ 52 if code ^= 0 then do; 53 if code = error_table_$noentry then do; /* directory is still OK */ 54 dir = retpn; /* only directory is returned in this case */ 55 dptr = addr (dir); /* this would normally get set later */ 56 noent = "1"b; /* return noentry code */ 57 go to get_dmode; 58 end; 59 else return; /* other non_zero codes */ 60 end; 61 noent = "0"b; 62 pptr = addr (retpn); 63 dptr = addr (dir); 64 eptr = addr (ent); 65 lng = index (retpn, " ") - 1; /* get relevant length for expand_path_ */ 66 call expand_pathname_ (name3, dir, ent, code); 67 if code ^= 0 then go to ret; 68 69 call hcs_$get_user_effmode (dir, ent, user_name, ring, emode, code); /* get user's access to entry */ 70 if code ^= 0 then go to ret; 71 72 /* the "extra" variable tent is used in case, at some future time, the above value of ent 73* is to be kept intact as a return argument. */ 74 75 get_dmode: pptr = addr (tdir); 76 eptr = addr (tent); 77 lng = index (dir, " ") - 1; /* get relevant length for expand_path_ */ 78 call expand_pathname_ (name2, tdir, tent, code); 79 if code ^= 0 then go to ret; 80 81 call hcs_$get_user_effmode (tdir, tent, user_name, ring, dmode, code); /* get user's access to directory */ 82 83 if code = 0 then if noent then code = error_table_$noentry; 84 else; 85 else if code = error_table_$root then do; 86 code = 0; 87 dmode = 0100b; /* All users have at least "re" access to root */ 88 end; 89 ret: return; 90 91 92 chase_: proc (pptr, tlng, retpn, code) recursive; 93 94 /* This procedure chases links. It is given a pathname, breaks it into a directory name and entry name 95* and calls itself recursively in order to catch imbedded links. After returning from a recursive call, it 96* checks the returned directory name and the given entry name to see if it has a link. 97* If it does, it checks to see whether there have already been 10 links and if the given user 98* has e access to the link's directory; if so, it gets the link pathname and "starts over". 99* If it has a branch, it returns the branch name concatenated with the entry name. 100**/ 101 102 /* initially coded by M. Weaver 19 November 1970 */ 103 104 dcl (path based (pptr), retpn, dir) char (168); 105 dcl (ent, tent) char (32); 106 dcl mode fixed bin (5); 107 dcl (lng, tlng, trl, elng, i) fixed bin; 108 dcl code fixed bin (35); 109 dcl (pptr, dptr, eptr) ptr; 110 dcl 1 link based aligned, 111 2 (type bit (2), nnames bit (16), nrp bit (18)) unaligned, 112 2 (dtem, dtd) bit (36) unaligned, 113 2 (pnl, pnrp) bit (18) unaligned; 114 dcl lpname char (168) aligned based; 115 dcl gt char (1) var; 116 117 dcl (error_table_$noaccess, error_table_$linkmoderr, error_table_$toomanylinks, 118 error_table_$pathlong) ext fixed bin; 119 dcl area_ entry (fixed bin, ptr); 120 dcl hcs_$status_ entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 121 122 /* * * * * * * * * * * * * * * * * * * * */ 123 124 125 dptr = addr (dir); 126 process: do i = tlng to 1 by -1 while (substr (path, i, 1) ^= ">"); end; 127 ent = substr (path, i+1, tlng-i); 128 if i = 1 then do; /* at root */ 129 retpn = ">"; 130 go to havadir; 131 end; 132 dir = substr (path, 1, i-1); 133 lng = i - 1; 134 trl = rl; /* save rl; # of links at lower levels doesn't affect this level */ 135 rlev = rlev + 1; /* go to deeper recursion level */ 136 137 call chase_ (dptr, lng, retpn, code); /* make recursive call */ 138 if code ^= 0 then return; 139 rlev = rlev - 1; /* return from deeper recursion level */ 140 141 havadir: call area_ (960, nptr); /* reinitialize each time; reuse same space */ 142 /* can't call freen_ on nptr */ 143 call hcs_$status_ (retpn, ent, 0, bptr, nptr, code); /* see if entry is a link or dir */ 144 if code ^= 0 then do; 145 noacc: if rlev > 0 & code = error_table_$noentry then code = error_table_$noaccess; 146 return; 147 end; 148 rl = trl; /* restore this level's link record */ 149 lng = index (retpn, " ") - 1; /* find no. of relevant characters in retpn */ 150 151 if bptr -> link.type = "00"b then do; 152 /* find out if user has access to use link */ 153 do i = lng to 1 by -1 while (substr (retpn, i, 1) ^= ">"); end; /* break into directory, entry */ 154 if i = 1 then dir = ">"; 155 else dir = substr (retpn, 1, i-1); 156 tent = substr (retpn, i+1, lng-i); 157 if user_name ^= "" then do; /* don't need to check this for oneself */ 158 call hcs_$get_user_effmode (dir, tent, user_name, ring, mode, code); 159 if code ^= 0 then go to noacc; 160 if ^substr (unspec (mode), 34, 1) then do; /* user doesn't have e access on dir */ 161 code = error_table_$linkmoderr; 162 return; 163 end; 164 end; 165 if rl >= 10 then do; /* can't chase any more */ 166 code = error_table_$toomanylinks; 167 return; 168 end; 169 /* get link pathname and start over */ 170 path = ptr (nptr, bptr -> link.pnrp) -> lpname; 171 tlng = fixed (bptr -> link.pnl, 18); /* get length of link pathname */ 172 rl = rl + 1; /* got another link */ 173 go to process; 174 end; 175 176 /* have a branch */ 177 /* check to be sure returned name isn't going to be too long */ 178 elng = index (ent, " "); /* keep extra count; use for preceding ">" */ 179 if elng = 0 then elng = 33; /* entry name is 32 characters or more */ 180 if lng = -1 then go to too_long; /* directory name = 168 characters */ 181 if lng + elng > 168 then do; /* name to be returned is too long */ 182 too_long: code = error_table_$pathlong; 183 return; 184 end; 185 rl = 0; 186 if lng = 1 then gt = ""; else gt = ">"; /* a single char absolute pathname must be ">" */ 187 retpn = substr (retpn, 1, lng) || gt || ent; 188 return; 189 end chase_; 190 end get_raw_access_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1455.8 get_raw_access_.pl1 >dumps>old>recomp>get_raw_access_.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. absolute_pathname_ 000012 constant entry external dcl 36 ref 46 addr builtin function dcl 33 ref 43 44 45 55 62 63 64 75 76 125 area_ 000032 constant entry external dcl 119 ref 141 bptr 000330 automatic pointer dcl 27 set ref 43* 143* 151 170 171 code parameter fixed bin(35,0) dcl 25 in procedure "get_raw_access_" set ref 11 46* 47 50* 52 53 66* 67 69* 70 78* 79 81* 83 83* 85 86* code parameter fixed bin(35,0) dcl 108 in procedure "chase_" set ref 92 137* 138 143* 144 145 145* 158* 159 161* 166* 182* dir 000100 automatic char(168) unaligned dcl 104 in procedure "chase_" set ref 125 132* 154* 155* 158* dir 000152 automatic char(168) unaligned dcl 21 in procedure "get_raw_access_" set ref 54* 55 63 66* 69* 77 dmode parameter fixed bin(5,0) dcl 26 set ref 11 81* 87* dptr 000200 automatic pointer dcl 109 in procedure "chase_" set ref 125* 137* dptr 000322 automatic pointer dcl 27 in procedure "get_raw_access_" set ref 55* 63* 78 elng 000175 automatic fixed bin(17,0) dcl 107 set ref 178* 179 179* 181 emode parameter fixed bin(5,0) dcl 26 set ref 11 69* ent 000276 automatic char(32) unaligned dcl 22 in procedure "get_raw_access_" set ref 64 66* 69* ent 000152 automatic char(32) unaligned dcl 105 in procedure "chase_" set ref 127* 143* 178 187 eptr 000324 automatic pointer dcl 27 set ref 64* 76* error_table_$linkmoderr 000024 external static fixed bin(17,0) dcl 117 ref 161 error_table_$noaccess 000022 external static fixed bin(17,0) dcl 117 ref 145 error_table_$noentry 000020 external static fixed bin(35,0) dcl 38 ref 53 83 145 error_table_$pathlong 000030 external static fixed bin(17,0) dcl 117 ref 182 error_table_$root 000016 external static fixed bin(35,0) dcl 38 ref 85 error_table_$toomanylinks 000026 external static fixed bin(17,0) dcl 117 ref 166 expand_pathname_ 000010 constant entry external dcl 35 ref 66 78 fixed builtin function dcl 33 ref 171 gt 000202 automatic varying char(1) dcl 115 set ref 186* 186* 187 hcs_$get_user_effmode 000014 constant entry external dcl 37 ref 69 81 158 hcs_$status_ 000034 constant entry external dcl 120 ref 143 i 000176 automatic fixed bin(17,0) dcl 107 set ref 126* 126* 127 127 128 132 133 153* 153* 154 155 156 156 index builtin function dcl 33 ref 48 65 77 149 178 link based structure level 1 dcl 110 lng 000320 automatic fixed bin(17,0) dcl 24 in procedure "get_raw_access_" set ref 65* 66 66 77* 78 78 lng 000173 automatic fixed bin(17,0) dcl 107 in procedure "chase_" set ref 133* 137* 149* 153 156 180 181 186 187 lpname based char(168) dcl 114 ref 170 mode 000172 automatic fixed bin(5,0) dcl 106 set ref 158* 160 name1 based char unaligned dcl 29 set ref 46* name2 based char unaligned dcl 30 set ref 78* name3 based char unaligned dcl 31 set ref 66* narea 000335 automatic fixed bin(17,0) array dcl 32 set ref 44 noent 000334 automatic bit(1) dcl 28 set ref 56* 61* 83 nptr 000332 automatic pointer dcl 27 set ref 44* 141* 143* 170 path based char(168) unaligned dcl 104 set ref 126 127 132 170* pnl 3 based bit(18) level 2 packed unaligned dcl 110 ref 171 pnrp 3(18) based bit(18) level 2 packed unaligned dcl 110 ref 170 pptr 000326 automatic pointer dcl 27 in procedure "get_raw_access_" set ref 45* 50* 62* 66 75* pptr parameter pointer dcl 109 in procedure "chase_" ref 92 126 127 132 170 ptr builtin function dcl 33 ref 170 retpn 000224 automatic char(168) unaligned dcl 21 in procedure "get_raw_access_" set ref 50* 54 62 65 retpn parameter char(168) unaligned dcl 104 in procedure "chase_" set ref 92 129* 137* 143* 149 153 155 156 187* 187 ring parameter fixed bin(17,0) dcl 24 set ref 11 69* 81* 158* rl 000316 automatic fixed bin(17,0) dcl 24 set ref 42* 134 148* 165 172* 172 185* rlev 000317 automatic fixed bin(17,0) dcl 24 set ref 42* 135* 135 139* 139 145 rlng 000321 automatic fixed bin(17,0) dcl 24 set ref 48* 50* substr builtin function dcl 33 ref 126 127 132 153 155 156 160 187 tarea 002235 automatic fixed bin(17,0) array dcl 39 set ref 43 tdir 000100 automatic char(168) unaligned dcl 21 set ref 45 46* 48 75 78* 81* tent 000306 automatic char(32) unaligned dcl 22 in procedure "get_raw_access_" set ref 76 78* 81* tent 000162 automatic char(32) unaligned dcl 105 in procedure "chase_" set ref 156* 158* tlng parameter fixed bin(17,0) dcl 107 in procedure "chase_" set ref 92 126 127 171* tlng parameter fixed bin(17,0) dcl 24 in procedure "get_raw_access_" ref 11 46 46 tptr parameter pointer dcl 27 ref 11 46 trl 000174 automatic fixed bin(17,0) dcl 107 set ref 134* 148 type based bit(2) level 2 packed unaligned dcl 110 ref 151 unspec builtin function dcl 33 ref 160 user_name parameter char unaligned dcl 23 set ref 11 69* 81* 157 158* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. eptr automatic pointer dcl 109 null builtin function dcl 33 NAMES DECLARED BY EXPLICIT CONTEXT. chase_ 000373 constant entry internal dcl 92 ref 50 137 get_dmode 000246 constant label dcl 75 ref 57 get_raw_access_ 000017 constant entry external dcl 11 havadir 000501 constant label dcl 141 ref 130 noacc 000557 constant label dcl 145 ref 159 process 000402 constant label dcl 126 ref 173 ret 000371 constant label dcl 89 ref 67 70 79 too_long 001003 constant label dcl 182 ref 180 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1222 1260 1054 1232 Length 1450 1054 36 153 145 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME get_raw_access_ 1246 external procedure is an external procedure. chase_ 172 internal procedure calls itself recursively. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME chase_ 000100 dir chase_ 000152 ent chase_ 000162 tent chase_ 000172 mode chase_ 000173 lng chase_ 000174 trl chase_ 000175 elng chase_ 000176 i chase_ 000200 dptr chase_ 000202 gt chase_ get_raw_access_ 000100 tdir get_raw_access_ 000152 dir get_raw_access_ 000224 retpn get_raw_access_ 000276 ent get_raw_access_ 000306 tent get_raw_access_ 000316 rl get_raw_access_ 000317 rlev get_raw_access_ 000320 lng get_raw_access_ 000321 rlng get_raw_access_ 000322 dptr get_raw_access_ 000324 eptr get_raw_access_ 000326 pptr get_raw_access_ 000330 bptr get_raw_access_ 000332 nptr get_raw_access_ 000334 noent get_raw_access_ 000335 narea get_raw_access_ 002235 tarea get_raw_access_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return shorten_stack ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ area_ expand_pathname_ hcs_$get_user_effmode hcs_$status_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$linkmoderr error_table_$noaccess error_table_$noentry error_table_$pathlong error_table_$root error_table_$toomanylinks LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000011 42 000032 43 000034 44 000036 45 000040 46 000042 47 000067 48 000072 50 000102 52 000116 53 000121 54 000124 55 000127 56 000131 57 000133 59 000134 61 000135 62 000136 63 000140 64 000142 65 000144 66 000154 67 000202 69 000205 70 000243 75 000246 76 000250 77 000252 78 000262 79 000311 81 000314 83 000352 84 000362 85 000363 86 000366 87 000367 89 000371 92 000372 125 000400 126 000402 126 000417 127 000422 128 000433 129 000436 130 000442 132 000443 133 000447 134 000452 135 000455 137 000456 138 000473 139 000476 141 000501 143 000515 144 000554 145 000557 146 000571 148 000572 149 000575 151 000606 153 000611 153 000623 154 000626 155 000634 156 000642 157 000652 158 000662 159 000720 160 000723 161 000726 162 000731 165 000732 166 000736 167 000741 170 000742 171 000754 172 000757 173 000760 178 000761 179 000772 180 000775 181 001000 182 001003 183 001006 185 001007 186 001010 186 001015 187 001021 188 001050 ----------------------------------------------------------- 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