/* format: style4,delnl,insnl,^ifthendo */ imft_convert_acs: procedure (); /* Finds all segments and the targets of all links in the working directory with names that match **.imft.acs, and changes all instances of "r" on their ACLs to "w" and vice versa. Written for conversion to Version 3 of IMFT, at which point the meanings of the ACL terms on ACSs were reversed. To make sure that each ACS is converted exactly once, an indexed vfile is maintained whose keys are the UIDs of segments whose ACLs have been converted. */ /* Written April 5, 1983 by Robert Coren */ dcl area_ptr pointer; dcl dirname char (168); dcl ename char (32); dcl real_dirname char (168); dcl real_ename char (32); dcl code fixed bin (35); dcl i fixed bin; dcl target_type fixed bin (2); dcl 1 auto_status_branch aligned like status_branch; dcl com_err_ entry options (variable); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl get_wdir_ entry () returns (char (168)); dcl hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl hcs_$list_acl entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)); dcl hcs_$replace_acl entry (char (*), char (*), ptr, fixed bin, bit (1), fixed bin (35)); dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)); dcl iox_$close entry (ptr, fixed bin (35)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$detach_iocb entry (ptr, fixed bin (35)); dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl ( error_table_$key_duplication, error_table_$nomatch, error_table_$noentry, error_table_$too_many_args ) fixed bin (35) external static; dcl static_iocbp pointer internal static; dcl 1 static_ak_info internal static aligned, 2 header like ak_info.header, 2 key char (4); dcl NAME char (16) internal static options (constant) init ("imft_convert_acs"); dcl IMFT_ACS char (8) internal static options (constant) init ("imft_acs"); dcl ACS_LIST_FILE char (13) internal static options (constant) init ("imft_acs_list"); dcl SYSCTL_DIR char (17) internal static options (constant) init (">system_control_1"); dcl acs_list_dir char (152) internal static init (">system_control_1"); dcl (bool, null, rtrim, unspec) builtin; dcl cleanup condition; star_entry_ptr, star_names_ptr = null (); dirname = get_wdir_ (); area_ptr = get_system_free_area_ (); on cleanup begin; if star_names_ptr ^= null () then free star_names; if star_entry_ptr ^= null () then free star_entries; end; call hcs_$star_ (dirname, "**.imft.acs", star_ALL_ENTRIES, area_ptr, star_entry_count, star_entry_ptr, star_names_ptr, code); if code = error_table_$nomatch then return; /* if there are none, then this directory isn't interesting */ if code ^= 0 then do; /* any other error is worth reporting */ call com_err_ (code, NAME, "Could not list entries in ^a", dirname); return; end; do i = 1 to star_entry_count; if star_entries (i).type = star_DIRECTORY then ; /* directories with such a name are unlikely, but ignore them anyway */ else do; ename = star_names (star_entries (i).nindex); if star_entries (i).type = star_LINK then do; /* get its target */ call hcs_$get_link_target (dirname, ename, real_dirname, real_ename, code); if code = 0 then do; call hcs_$status_minf (real_dirname, real_ename, 1, target_type, (0), code); if /* tree */ code ^= 0 then call com_err_ (code, NAME, "Could not get entry type of ^a", pathname_ (real_dirname, real_ename)); else if target_type = star_DIRECTORY then ; else call convert_acl (real_dirname, real_ename); end; else if code ^= error_table_$noentry /* null links are uninteresting, but anything else should eb reported */ then call com_err_ (code, NAME, "Could not get target of ^a", pathname_ (dirname, ename)); end; else call convert_acl (dirname, ename); end; end; free star_names; free star_entries; return; %page; /* entry to attach and open the vfile containing the list of already-processed segments */ imft_open_acs_list: entry; call iox_$attach_name (IMFT_ACS, static_iocbp, "vfile_ " || rtrim (pathname_ (acs_list_dir, ACS_LIST_FILE)), null (), code); if code ^= 0 then do; call com_err_ (code, NAME, "Could not attach ^a", pathname_ (acs_list_dir, ACS_LIST_FILE)); return; end; call iox_$open (static_iocbp, Keyed_sequential_update, "0"b, code); if code ^= 0 then do; call com_err_ (code, NAME, "Could not open ^a", pathname_ (acs_list_dir, ACS_LIST_FILE)); return; end; unspec (static_ak_info) = ""b; static_ak_info.input_key, static_ak_info.input_desc = "1"b; static_ak_info.key_len = 4; return; /* entry to close and detach the vfile */ imft_close_acs_list: entry; call iox_$close (static_iocbp, code); call iox_$detach_iocb (static_iocbp, code); return; /* entry to change the directory in which the ACS list is kept */ imft_test_acs_list: entry; dcl nargs fixed bin; dcl argp pointer; dcl argl fixed bin (21); dcl arg char (argl) based (argp); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, NAME); return; end; if nargs > 1 then do; call com_err_ (error_table_$too_many_args, NAME, "^/Usage: imft_test_acs_list {dir_path}"); return; end; if nargs = 1 then do; call cu_$arg_ptr (1, argp, argl, code); call expand_pathname_ (arg, dirname, ename, code); if code ^= 0 then do; call com_err_ (code, NAME, arg); return; end; acs_list_dir = pathname_ (dirname, ename); end; else acs_list_dir = SYSCTL_DIR; /* no argument means restore the default */ return; %page; convert_acl: procedure (P_dirname, P_ename); /* Given a directory and entry name, picks up the ACL of the segment and changes all instances of "r" access to "w" and vice versa */ dcl P_dirname char (*) parameter; dcl P_ename char (*) parameter; dcl dirname char (168); dcl ename char (32); dcl rw_check bit (3); dcl i fixed bin; dcl already_done bit (1); dirname = P_dirname; ename = P_ename; call hcs_$status_long (dirname, ename, 1, addr (auto_status_branch), null (), code); /* in order to get unique ID */ if code ^= 0 then do; call com_err_ (code, NAME, "Could not get unique ID of ^a", pathname_ (dirname, ename)); return; end; call update_acs_list (auto_status_branch.uid, already_done, code); if code ^= 0 then do; call com_err_ (code, NAME, "Could not update ACS list with ^a", pathname_ (dirname, ename)); return; end; if already_done /* then don't do it again */ then return; call hcs_$list_acl (dirname, ename, area_ptr, acl_ptr, null (), acl_count, code); if code ^= 0 then do; call com_err_ (code, NAME, "Could not list ACL of ^a", pathname_ (dirname, ename)); return; end; on cleanup free segment_acl_array; do i = 1 to acl_count; rw_check = segment_acl_array (i).mode & RW_ACCESS; /* find current state of r and w */ if rw_check = RW_ACCESS | rw_check = N_ACCESS then ; /* if both on or both off, leave it alone */ else segment_acl_array (i).mode = bool (segment_acl_array (i).mode, RW_ACCESS, "0110"b); /* switch R and W, leave anything else alone */ end; call hcs_$replace_acl (dirname, ename, acl_ptr, acl_count, "1"b, code); if code ^= 0 then call com_err_ (code, NAME, "Could not replace ACL on ^a", pathname_ (dirname, ename)); free segment_acl_array; return; end convert_acl; %page; /* add a key to the index corresponding to the unique ID of the current segment, or return an indication that it is already there */ update_acs_list: procedure (P_uid, P_already_done, P_code); dcl P_uid bit (36) parameter; dcl P_already_done bit (1) parameter; dcl P_code fixed bin (35) parameter; unspec (static_ak_info.key) = P_uid; call iox_$control (static_iocbp, "add_key", addr (static_ak_info), P_code); if P_code = error_table_$key_duplication /* this means it's already there */ then do; P_code = 0; P_already_done = "1"b; end; else if P_code = 0 then P_already_done = "0"b; return; end update_acs_list; %page; %include acl_structures; %page; %include access_mode_values; %page; %include star_structures; %page; %include status_structures; %page; %include iox_modes; %page; %include ak_info; end imft_convert_acs; */ ----------------------------------------------------------- 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 */