COMPILATION LISTING OF SEGMENT l_patch Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/12/82 1245.5 mst Fri 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 12 13 /* Modified 1/29/75 by Larry Johnson to use new acl calls */ 14 /* MCR 4232 Rename to l_patch 12/13/79 S. Herbst */ 15 /* MCR 5346 09/04/81 by GA Texada to call appropriate hcs_ entries on linkage_error */ 16 17 l_patch: lpatch: proc; 18 19 /* External Procedures */ 20 21 dcl add_acl_entries_entry entry (char(*), char(*), ptr, fixed bin, fixed bin(35)) variable, 22 list_acl_entry entry (char(*), char(*), ptr, ptr, ptr, fixed bin, fixed bin(35)) variable, 23 delete_acl_entries_entry entry (char(*), char(*), ptr, fixed bin, fixed bin(35)) variable, 24 com_err_ entry options (variable), 25 command_query_ entry options (variable), 26 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), 27 cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin), 28 expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), 29 get_group_id_ entry returns (char (32) aligned), 30 hcs_$add_acl_entries entry (char(*), char(*), ptr, fixed bin, fixed bin(35)), 31 hcs_$delete_acl_entries entry (char(*), char(*), ptr, fixed bin, fixed bin(35)), 32 hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), 33 hcs_$list_acl entry (char(*), char(*), ptr, ptr, ptr, fixed bin, fixed bin(35)), 34 hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)), 35 hcs_$terminate_noname entry (ptr, fixed bin (35)), 36 installation_tools_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)), 37 installation_tools_$list_acl entry (char (*) aligned, char (*) aligned, ptr, ptr, ptr, fixed bin, fixed bin (35)), 38 installation_tools_$delete_acl_entries entry (char (*) aligned, char (*) aligned, ptr, fixed bin, fixed bin (35)), 39 ioa_ entry options (variable), 40 patch_entry entry(ptr, ptr, fixed bin, fixed bin(35)) variable, 41 installation_tools_$patch_ptr entry (ptr, ptr, fixed bin, fixed bin (35)), 42 ring_1_patch_$ptr entry (ptr, ptr, fixed bin, fixed bin(35)), 43 ring_zero_peek_ entry (ptr, ptr, fixed bin, fixed bin (35)); 44 45 dcl linkage_error condition; 46 47 dcl error_table_$argerr ext fixed bin (35); 48 49 /* Builtin Functions */ 50 51 dcl (addr, baseptr, substr, null, ptr) builtin; 52 53 /* Text References */ 54 55 dcl name int static fixed bin init (0), 56 number int static fixed bin init (1); 57 58 /* Internal Static Variables */ 59 60 dcl id int static char (7) aligned init ("l_patch"); 61 62 /* Automatic Variables */ 63 64 dcl argp ptr, 65 current_access bit (3), 66 patch_ptr ptr, 67 segptr ptr; 68 69 dcl answer char (16) varying, 70 dir char (168), 71 ename char (32); 72 73 dcl old_acl_sw bit (1) aligned init ("0"b); /* set if there was an old acl */ 74 dcl acl_sw bit (1) aligned init ("0"b); 75 76 dcl arglen fixed bin, 77 i fixed bin, 78 narg fixed bin, 79 nwords fixed bin, 80 offset fixed bin, 81 segno fixed bin, 82 sw fixed bin; 83 84 dcl code fixed bin (35); 85 86 dcl 1 new_acl aligned, 87 2 access_name char (32), 88 2 modes bit (36), 89 2 zero_pad bit (36), 90 2 status_code fixed bin (35); 91 92 dcl 1 old_acl aligned like new_acl; 93 94 dcl 1 acl_del_list aligned, 95 2 access_name char (32), 96 2 status_code fixed bin (35); 97 98 dcl 1 query_info aligned, 99 2 version fixed bin init (1), 100 2 yes_or_no_sw bit (1) unaligned init ("1"b), 101 2 supress_name_sw bit (1) unaligned init ("0"b), 102 2 status_code fixed bin (35) init (0), 103 2 query_code fixed bin (35) init (0); 104 105 dcl new_data (0:1023) fixed bin, 106 old_data (0:1023) fixed bin; 107 108 /* Based Storage */ 109 110 dcl arg char (arglen) unaligned based; 111 112 /* 113* 114**/ 115 116 narg = 1; 117 118 call cu_$arg_ptr (narg, argp, arglen, code); /* get first arg - segment name or segment number */ 119 if code ^= 0 then go to err1; 120 121 segno = cv_oct_check_ (argp -> arg, code); /* try to convert to octal number */ 122 123 if code ^= 0 then do; /* given a pathname */ 124 sw = name; 125 call expand_pathname_ (argp -> arg, dir, ename, code); 126 if code ^= 0 then go to err2; 127 end; 128 129 else do; /* given a segment number */ 130 sw = number; 131 segptr = baseptr (segno); /* construct a pointer */ 132 call hcs_$fs_get_path_name (segptr, dir, arglen, ename, code); 133 if code ^= 0 then go to err2; /* get the pathname of the segment */ 134 end; 135 136 narg = 2; /* get the offset to be patched */ 137 call cu_$arg_ptr (narg, argp, arglen, code); 138 if code ^= 0 then go to err1; 139 140 offset = cv_oct_check_ (argp -> arg, code); 141 if code ^= 0 then go to err4; 142 143 if sw = name then do; /* initate the segment */ 144 call hcs_$initiate (dir, ename, "", 0, 0, segptr, code); 145 if segptr = null then go to err3; /* if given pathname */ 146 end; 147 148 patch_ptr = ptr (segptr, offset); /* get location in segment to be patched */ 149 150 arg_fetch: 151 narg = narg + 1; 152 call cu_$arg_ptr (narg, argp, arglen, code); 153 if code ^= 0 then go to start; 154 new_data (narg-3) = cv_oct_check_ (argp -> arg, code); 155 if code ^= 0 then go to err4; 156 go to arg_fetch; 157 158 start: 159 if narg = 3 then go to err1; 160 nwords = narg - 3; 161 162 on linkage_error begin; 163 delete_acl_entries_entry = hcs_$delete_acl_entries; 164 add_acl_entries_entry = hcs_$add_acl_entries; 165 patch_entry = ring_1_patch_$ptr; 166 add_acl_entries_entry = hcs_$add_acl_entries; 167 list_acl_entry = hcs_$list_acl; 168 goto revert_linkage_error; 169 end; 170 /* set up for installation_tools_ as the "normal" gate */ 171 172 delete_acl_entries_entry = installation_tools_$delete_acl_entries; 173 add_acl_entries_entry = installation_tools_$add_acl_entries; 174 patch_entry = installation_tools_$patch_ptr; 175 add_acl_entries_entry = installation_tools_$add_acl_entries; 176 list_acl_entry = installation_tools_$list_acl; 177 revert_linkage_error: 178 revert linkage_error; 179 /* get current acl for user so that it can be reset later */ 180 181 old_acl.access_name = get_group_id_ (); 182 old_acl.modes, old_acl.zero_pad = "0"b; 183 old_acl.status_code = 0; 184 185 call list_acl_entry (dir, ename, null, null, addr (old_acl), 1, code); 186 if code ^= 0 then go to err3; 187 if old_acl.status_code = 0 then do; 188 old_acl_sw = "1"b; 189 current_access = substr (old_acl.modes, 1, 3); /* check to see if i have access */ 190 if current_access = "101"b | current_access = "111"b then go to acl_ok; 191 end; 192 193 /* set up new acl with rew access */ 194 195 new_acl.access_name = old_acl.access_name; 196 new_acl.modes = "111"b; 197 new_acl.zero_pad = "0"b; 198 199 call add_acl_entries_entry (dir, ename, addr (new_acl), 1, code); 200 if code = error_table_$argerr then do; 201 code = new_acl.status_code; 202 go to err3; 203 end; 204 if code ^= 0 then go to err3; 205 if new_acl.status_code ^= 0 then do; 206 code = new_acl.status_code; 207 go to err3; 208 end; 209 acl_sw = "1"b; /* remember that i set acl */ 210 acl_ok: 211 212 call ring_zero_peek_ (patch_ptr, addr (old_data), nwords, code); 213 if code ^= 0 then go to err2; 214 do i = 0 to nwords - 1; 215 call ioa_ ("^6o ^w to ^w", offset+i, old_data (i), new_data (i)); 216 end; 217 218 call command_query_ (addr (query_info), answer, id, "Type yes if patches are correct."); 219 if answer = "no" then go to finish; 220 221 222 call patch_entry (addr (new_data), patch_ptr, nwords, code); 223 if code ^= 0 then go to err3; 224 225 finish: 226 if acl_sw then if old_acl_sw then do; /* restore old acl */ 227 acl_sw = "0"b; 228 229 call add_acl_entries_entry (dir, ename, addr (old_acl), 1, code); 230 if code = error_table_$argerr then do; 231 code = old_acl.status_code; 232 go to err3; 233 end; 234 if code ^= 0 then go to err3; 235 end; 236 else do; /* delete the acl i added */ 237 acl_sw = "0"b; 238 acl_del_list.access_name = new_acl.access_name; 239 240 call delete_acl_entries_entry (dir, ename, addr (acl_del_list), 1, code); 241 if code = error_table_$argerr then do; 242 code = acl_del_list.status_code; 243 go to err3; 244 end; 245 if code ^= 0 then go to err3; 246 end; 247 248 if sw = name then /* terminate the segment if we initiated it */ 249 call hcs_$terminate_noname (segptr, code); 250 251 return; 252 err1: call com_err_ (code, id); 253 go to finish; 254 255 err2: call com_err_ (code, id, argp -> arg); 256 go to finish; 257 258 err3: call com_err_ (code, id, "^a>^a", dir, ename); 259 go to finish; 260 261 err4: call com_err_ (0, id, "Illegal octal number ^a", argp -> arg); 262 go to finish; 263 end l_patch; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/12/82 1112.7 l_patch.pl1 >spec>on>11/12/82>l_patch.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. access_name 000252 automatic char(32) level 2 in structure "old_acl" dcl 92 in procedure "lpatch" set ref 181* 195 access_name 000237 automatic char(32) level 2 in structure "new_acl" dcl 86 in procedure "lpatch" set ref 195* 238 access_name 000265 automatic char(32) level 2 in structure "acl_del_list" dcl 94 in procedure "lpatch" set ref 238* acl_del_list 000265 automatic structure level 1 dcl 94 set ref 240 240 acl_sw 000226 automatic bit(1) initial dcl 74 set ref 74* 209* 225 227* 237* add_acl_entries_entry 000100 automatic entry variable dcl 21 set ref 164* 166* 173* 175* 199 229 addr builtin function dcl 51 ref 185 185 199 199 210 210 218 218 222 222 229 229 240 240 answer 000136 automatic varying char(16) dcl 69 set ref 218* 219 arg based char unaligned dcl 110 set ref 121* 125* 140* 154* 255* 261* arglen 000227 automatic fixed bin(17,0) dcl 76 set ref 118* 121 121 125 125 132* 137* 140 140 152* 154 154 255 255 261 261 argp 000126 automatic pointer dcl 64 set ref 118* 121 125 137* 140 152* 154 255 261 baseptr builtin function dcl 51 ref 131 code 000236 automatic fixed bin(35,0) dcl 84 set ref 118* 119 121* 123 125* 126 132* 133 137* 138 140* 141 144* 152* 153 154* 155 185* 186 199* 200 201* 204 206* 210* 213 222* 223 229* 230 231* 234 240* 241 242* 245 248* 252* 255* 258* com_err_ 000012 constant entry external dcl 21 ref 252 255 258 261 command_query_ 000014 constant entry external dcl 21 ref 218 cu_$arg_ptr 000016 constant entry external dcl 21 ref 118 137 152 current_access 000130 automatic bit(3) unaligned dcl 64 set ref 189* 190 190 cv_oct_check_ 000020 constant entry external dcl 21 ref 121 140 154 delete_acl_entries_entry 000110 automatic entry variable dcl 21 set ref 163* 172* 240 dir 000143 automatic char(168) unaligned dcl 69 set ref 125* 132* 144* 185* 199* 229* 240* 258* ename 000215 automatic char(32) unaligned dcl 69 set ref 125* 132* 144* 185* 199* 229* 240* 258* error_table_$argerr 000060 external static fixed bin(35,0) dcl 47 ref 200 230 241 expand_pathname_ 000022 constant entry external dcl 21 ref 125 get_group_id_ 000024 constant entry external dcl 21 ref 181 hcs_$add_acl_entries 000026 constant entry external dcl 21 ref 164 166 hcs_$delete_acl_entries 000030 constant entry external dcl 21 ref 163 hcs_$fs_get_path_name 000032 constant entry external dcl 21 ref 132 hcs_$initiate 000036 constant entry external dcl 21 ref 144 hcs_$list_acl 000034 constant entry external dcl 21 ref 167 hcs_$terminate_noname 000040 constant entry external dcl 21 ref 248 i 000230 automatic fixed bin(17,0) dcl 76 set ref 214* 215 215 215* id 000010 internal static char(7) initial dcl 60 set ref 218* 252* 255* 258* 261* installation_tools_$add_acl_entries 000042 constant entry external dcl 21 ref 173 175 installation_tools_$delete_acl_entries 000046 constant entry external dcl 21 ref 172 installation_tools_$list_acl 000044 constant entry external dcl 21 ref 176 installation_tools_$patch_ptr 000052 constant entry external dcl 21 ref 174 ioa_ 000050 constant entry external dcl 21 ref 215 linkage_error 000120 stack reference condition dcl 45 ref 162 177 list_acl_entry 000104 automatic entry variable dcl 21 set ref 167* 176* 185 modes 10 000252 automatic bit(36) level 2 in structure "old_acl" dcl 92 in procedure "lpatch" set ref 182* 189 modes 10 000237 automatic bit(36) level 2 in structure "new_acl" dcl 86 in procedure "lpatch" set ref 196* name constant fixed bin(17,0) initial dcl 55 ref 124 143 248 narg 000231 automatic fixed bin(17,0) dcl 76 set ref 116* 118* 136* 137* 150* 150 152* 154 158 160 new_acl 000237 automatic structure level 1 dcl 86 set ref 199 199 new_data 000302 automatic fixed bin(17,0) array dcl 105 set ref 154* 215* 222 222 null builtin function dcl 51 ref 145 185 185 185 185 number constant fixed bin(17,0) initial dcl 55 ref 130 nwords 000232 automatic fixed bin(17,0) dcl 76 set ref 160* 210* 214 222* offset 000233 automatic fixed bin(17,0) dcl 76 set ref 140* 148 215 old_acl 000252 automatic structure level 1 dcl 92 set ref 185 185 229 229 old_acl_sw 000225 automatic bit(1) initial dcl 73 set ref 73* 188* 225 old_data 002302 automatic fixed bin(17,0) array dcl 105 set ref 210 210 215* patch_entry 000114 automatic entry variable dcl 21 set ref 165* 174* 222 patch_ptr 000132 automatic pointer dcl 64 set ref 148* 210* 222* ptr builtin function dcl 51 ref 148 query_code 3 000276 automatic fixed bin(35,0) initial level 2 dcl 98 set ref 98* query_info 000276 automatic structure level 1 dcl 98 set ref 218 218 ring_1_patch_$ptr 000054 constant entry external dcl 21 ref 165 ring_zero_peek_ 000056 constant entry external dcl 21 ref 210 segno 000234 automatic fixed bin(17,0) dcl 76 set ref 121* 131 segptr 000134 automatic pointer dcl 64 set ref 131* 132* 144* 145 148 248* status_code 2 000276 automatic fixed bin(35,0) initial level 2 in structure "query_info" dcl 98 in procedure "lpatch" set ref 98* status_code 10 000265 automatic fixed bin(35,0) level 2 in structure "acl_del_list" dcl 94 in procedure "lpatch" set ref 242 status_code 12 000252 automatic fixed bin(35,0) level 2 in structure "old_acl" dcl 92 in procedure "lpatch" set ref 183* 187 231 status_code 12 000237 automatic fixed bin(35,0) level 2 in structure "new_acl" dcl 86 in procedure "lpatch" set ref 201 205 206 substr builtin function dcl 51 ref 189 supress_name_sw 1(01) 000276 automatic bit(1) initial level 2 packed unaligned dcl 98 set ref 98* sw 000235 automatic fixed bin(17,0) dcl 76 set ref 124* 130* 143 248 version 000276 automatic fixed bin(17,0) initial level 2 dcl 98 set ref 98* yes_or_no_sw 1 000276 automatic bit(1) initial level 2 packed unaligned dcl 98 set ref 98* zero_pad 11 000252 automatic bit(36) level 2 in structure "old_acl" dcl 92 in procedure "lpatch" set ref 182* zero_pad 11 000237 automatic bit(36) level 2 in structure "new_acl" dcl 86 in procedure "lpatch" set ref 197* NAMES DECLARED BY EXPLICIT CONTEXT. acl_ok 000704 constant label dcl 210 ref 190 arg_fetch 000376 constant label dcl 150 ref 156 err1 001211 constant label dcl 252 ref 119 138 158 err2 001227 constant label dcl 255 ref 126 133 213 err3 001254 constant label dcl 258 ref 145 186 202 204 207 223 232 234 243 245 err4 001310 constant label dcl 261 ref 141 155 finish 001051 constant label dcl 225 ref 219 253 256 259 262 l_patch 000100 constant entry external dcl 17 lpatch 000070 constant entry external dcl 17 revert_linkage_error 000526 constant label dcl 177 ref 168 start 000446 constant label dcl 158 ref 153 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1622 1704 1354 1632 Length 2112 1354 62 172 246 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lpatch 2380 external procedure is an external procedure. on unit on line 162 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 id lpatch STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lpatch 000100 add_acl_entries_entry lpatch 000104 list_acl_entry lpatch 000110 delete_acl_entries_entry lpatch 000114 patch_entry lpatch 000126 argp lpatch 000130 current_access lpatch 000132 patch_ptr lpatch 000134 segptr lpatch 000136 answer lpatch 000143 dir lpatch 000215 ename lpatch 000225 old_acl_sw lpatch 000226 acl_sw lpatch 000227 arglen lpatch 000230 i lpatch 000231 narg lpatch 000232 nwords lpatch 000233 offset lpatch 000234 segno lpatch 000235 sw lpatch 000236 code lpatch 000237 new_acl lpatch 000252 old_acl lpatch 000265 acl_del_list lpatch 000276 query_info lpatch 000302 new_data lpatch 002302 old_data lpatch THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_var_desc call_var call_ext_out_desc call_ext_out return tra_ext enable ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ command_query_ cu_$arg_ptr cv_oct_check_ expand_pathname_ get_group_id_ hcs_$add_acl_entries hcs_$delete_acl_entries hcs_$fs_get_path_name hcs_$initiate hcs_$list_acl hcs_$terminate_noname installation_tools_$add_acl_entries installation_tools_$delete_acl_entries installation_tools_$list_acl installation_tools_$patch_ptr ioa_ ring_1_patch_$ptr ring_zero_peek_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$argerr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 73 000053 74 000054 98 000055 17 000067 116 000106 118 000110 119 000125 121 000127 123 000153 124 000155 125 000157 126 000207 127 000211 130 000212 131 000214 132 000220 133 000251 136 000253 137 000255 138 000272 140 000274 141 000320 143 000322 144 000324 145 000366 148 000372 150 000376 152 000377 153 000414 154 000416 155 000443 156 000445 158 000446 160 000451 162 000453 163 000467 164 000474 165 000477 167 000502 168 000505 172 000510 173 000515 174 000520 176 000523 177 000526 181 000527 182 000536 183 000540 185 000541 186 000606 187 000610 188 000612 189 000614 190 000617 195 000623 196 000626 197 000630 199 000631 200 000665 201 000671 202 000673 204 000674 205 000676 206 000700 207 000701 209 000702 210 000704 213 000723 214 000725 215 000734 216 000770 218 000772 219 001024 222 001031 223 001047 225 001051 227 001055 229 001056 230 001112 231 001116 232 001120 234 001121 235 001123 237 001124 238 001125 240 001130 241 001164 242 001170 243 001172 245 001173 248 001175 251 001210 252 001211 253 001226 255 001227 256 001253 258 001254 259 001307 261 001310 262 001347 ----------------------------------------------------------- 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