convert_access_audit_flags_.pl1 01/26/85 1315.1r w 01/22/85 1313.4 166284 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style1,^inddcls,^indnoniterdo,insnl,linecom,indcomtxt */ convert_access_audit_flags_$from_string: procedure (a_flag_str, a_flag_bits, a_ec); /* format: off */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* CONVERT_ACCESS_AUDIT_FLAGS_ */ /* */ /* Routine to convert a textual representation of the access audit flags to its bit */ /* string equivalent, or from the bit string to text. */ /* */ /* Entrypoints: */ /* */ /* convert_access_audit_flags_$from_string (char(*), bit(36)aligned, fixed bin(35)) */ /* This entry converts the textual representation of the flags to a */ /* bit string. */ /* */ /* convert_access_audit_flags_$edit_from_string(char(*),bit(36)aligned,fixed bin(35))*/ /* This entry accepts both a textual representation of the flags and a */ /* bit string of flags as input. The bit string is modified according */ /* to the flags specified in the textual representation. */ /* */ /* convert_access_audit_flags_$to_string (char(*), bit(36)aligned, fixed bin(35)) */ /* This entry converts the bit string of audit flags into a textual */ /* representation. */ /* convert_access_audit_flags_$to_string_long (bit(36)aligned, char(*),fixed bin(35))*/ /* This entry converts the bit string of audit flags into a detailed */ /* textual representation where more than one line is used for display. */ /* The character string may be very large (e.g. 1024 chars). */ /* */ /* Flag String Syntax: */ /* */ /* flag-string ::= flag-item [, flag-item] */ /* flag-item ::= object-type-keyword "=" grant-level-keyword "/" deny-level-keyword*/ /* flag-item ::= flag-type-keyword */ /* object-type-keyword = {Short_Object_Names in access_audit_names.incl.pl1} */ /* grant_level_keyword = {Short_Level_Names in access_audit_names.incl.pl1} */ /* flag-type-keyword = {Short_Flag_Names in access_audit_names.incl.pl1} */ /* */ /* Note1: "flags" is a term used a little loosely here. Some flags require more than a */ /* single bit and provide auditing "level" information in respect to granted or denied */ /* operations on a given object. See access_audit_flags.incl.pl1. */ /* */ /* Note2: This program replaces "convert_audit_" which performed the same function for */ /* the pre-MR11 audit flag scheme. */ /* */ /* History: */ /* 84-12-07 EJ Sharpe - changed flag string syntax */ /* 84-11-14 EJ Sharpe - created */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: on */ /* PARAMETERS */ dcl a_flag_str char (*) parameter; dcl a_flag_bits bit (36) aligned parameter; dcl a_ec fixed bin (35) parameter; dcl a_display_str char (*) parameter; dcl a_display_len fixed bin (21); /* AUTOMATIC */ dcl flag_index fixed bin; /* index into flags array */ dcl object_index fixed bin; /* index into object levels array */ dcl start_index fixed bin (21); /* index of first non-blank char in given string */ dcl end_index fixed bin (21); /* index of last non-blank char in given string */ dcl delimiter_index fixed bin (21); /* index of next "=", ",", or "-" */ dcl len fixed bin (21); /* length of text formatted by ioa_ */ dcl object_name_width fixed bin; /* width of object name in displays */ dcl level_name_width fixed bin; /* width of level name in displays */ dcl done bit (1); dcl 1 flags aligned like audit_flags_alt;/* our copy of the flags */ dcl ec fixed bin (35); dcl v_flag_str char (1024) varying; /* we'll build flag string here */ dcl flag_str_len fixed bin (21); /* length of given flags text str */ dcl flag_str_ptr pointer; /* pointer to same... */ dcl flag_substr_len fixed bin (21); /* length of portion unprocessed */ dcl flag_substr_ptr pointer; /* pointer to unprocessed portion */ dcl display_substr_len fixed bin (21); /* length of unused portion of caller's display string */ dcl display_substr_ptr pointer; /* pointer to unused portion */ dcl keyword_len fixed bin (21); /* length of next keyword */ dcl keyword_ptr pointer; /* pointer to the keyword */ /* BASED */ dcl based_flag_str char (flag_str_len) based (flag_str_ptr); /* caller's text string */ dcl based_flag_substr char (flag_substr_len) based (flag_substr_ptr); /* unprocessed portion of caller's text */ dcl based_display_substr char (display_substr_len) based (display_substr_ptr); /* unused portion of caller's text */ dcl based_keyword char (keyword_len) based (keyword_ptr); /* next keyword in caller's text */ dcl char_array (1044480) char (1) unaligned based; /* MISC */ dcl True bit (1) init ("1"b) int static options (constant); dcl False bit (1) init ("0"b) int static options (constant); dcl Display_Object_Format char (32) internal static options (constant) init ("^va ^va ^va"); dcl WhiteSpace char (2) internal static options (constant) init (" "); /* space and tab */ dcl error_table_$bad_arg fixed bin (35) external; dcl error_table_$smallarg fixed bin (35) external; dcl ioa_$rsnp entry options (variable); dcl before builtin; dcl after builtin; dcl lbound builtin; dcl rtrim builtin; dcl translate builtin; dcl unspec builtin; dcl length builtin; dcl index builtin; dcl substr builtin; dcl addr builtin; dcl verify builtin; dcl search builtin; dcl hbound builtin; %page; /* convert_access_audit_flags_$from_string: entry (a_flag_str, a_flag_bits, a_ec); */ unspec (flags) = ""b; goto from_string_join; convert_access_audit_flags_$edit_from_string: entry (a_flag_str, a_flag_bits, a_ec); unspec (flags) = a_flag_bits; from_string_join: ec = 0; /* init */ flag_str_len = length (a_flag_str); flag_str_ptr = addr (a_flag_str); /* avoid using ltrim and rtrim because we don't want to copy the string */ start_index = verify (based_flag_str, WhiteSpace); if start_index > 1 then do; /* adjust substr to strip leading spaces */ call move_substr (flag_str_ptr, flag_str_len, start_index - 1); end; else if start_index = 0 then do; flag_str_len = 0; /* string is all blank */ end; else /* nothing - no leading spaces */ ; end_index = search (based_flag_str, WhiteSpace); /* 1 = "all blank" - can't happen here 0 = "no trailing blanks" */ if end_index > 1 then do; flag_str_len = end_index - 1; /* adjust string length to strip trailing blanks */ /* make sure we didn't just hit an embedded blank */ flag_substr_ptr = addr (flag_str_ptr -> char_array (end_index)); /* substr is rest of caller's string */ flag_substr_len = length (a_flag_str) - (start_index + end_index) + 2; if verify (based_flag_substr, WhiteSpace) ^= 0 then ec = error_table_$bad_arg; end; else /* nothing - no trailing spaces */ ; if flag_str_len > 0 & ec = 0 then do; flag_substr_ptr = flag_str_ptr; /* we'll start with whole string */ flag_substr_len = flag_str_len; done = False; ec = 0; do while (^done & ec = 0); delimiter_index = search (based_flag_substr, ","); if delimiter_index = 1 | delimiter_index = flag_substr_len then do; ec = error_table_$bad_arg; end; else do; keyword_ptr = flag_substr_ptr; /* keyword is at beginning of the next substr */ if delimiter_index = 0 then do; /* keyword is rest of string */ keyword_len = flag_substr_len; done = True; /* nothing else in the string */ end; else do; keyword_len = delimiter_index - 1; /* pick off the keyword */ end; if index (based_keyword, "=") ^= 0 then do; /* it must be an object type keyword */ call process_object_keyword; /* sets flag index */ end; else do; /* it must be an normal flag keyword */ call process_flag_keyword; end; if ^done & ec = 0 then call move_substr (flag_substr_ptr, flag_substr_len, keyword_len + 1); end; end /* do while */; end; a_ec = ec; if ec = 0 then a_flag_bits = unspec (flags); return; %page; convert_access_audit_flags_$to_string: entry (a_flag_bits, a_flag_str, a_ec); ec = 0; unspec (flags) = a_flag_bits; v_flag_str = ""; /* init varying string we'll built text in */ if check_flag_bits () then do; do object_index = 1 to n_audit_objects; call append_object_level_pair (object_index); end; do flag_index = 1 to n_audit_flags; call append_flag (flag_index); end; if length (v_flag_str) > length (a_flag_str) /* caller give us enough room? */ then ec = error_table_$smallarg; else a_flag_str = v_flag_str; end; else ec = error_table_$bad_arg; a_ec = ec; return; %page; convert_access_audit_flags_$to_string_long: entry (a_flag_bits, a_display_str, a_display_len, a_ec); /* we'll build the display right in the caller's string */ ec = 0; unspec (flags) = a_flag_bits; display_substr_len = length (a_display_str); display_substr_ptr = addr (a_display_str); if check_flag_bits () then do; call set_object_display_widths; len = display_substr_len; if len < 1 then goto short_arg; call ioa_$rsnp (rtrim (Display_Object_Format) || "^/", based_display_substr, len, object_name_width, "Object", level_name_width, "Grant Level", level_name_width, "Deny Level"); call move_substr (display_substr_ptr, display_substr_len, len); do object_index = 1 to n_audit_objects; call display_object_level_pair (object_index); end; len = display_substr_len; call ioa_$rsnp ("^/^a", based_display_substr, len, "Audited Events:"); call move_substr (display_substr_ptr, display_substr_len, len); do flag_index = 1 to n_audit_flags; call display_flag (flag_index); end; end; else ec = error_table_$bad_arg; a_ec = ec; /* caller's display string was built in place */ a_display_len = length (a_display_str) - display_substr_len; return; short_arg: a_ec = error_table_$smallarg; return; %page; /* Internal Procedures for "FROM STRING" Entry */ lowercase: proc (str) returns (char (*)); dcl str char (*); return (translate (str, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ")); end lowercase; process_flag_keyword: proc (); dcl keyword char (32); dcl i fixed bin; dcl found bit (1); dcl switch bit (1); /* This procedure examines the current value of the keyword for what event type flag it represents */ if keyword_len > length (keyword) then do; ec = error_table_$bad_arg; end; else do; if substr (based_keyword, 1, 1) = "^" then do; switch = False; keyword = lowercase (substr (based_keyword, 2)); end; else do; switch = True; keyword = lowercase (based_keyword); end; found = False; do i = 1 to hbound (Short_Flag_Names, 1) while (^found); if keyword = lowercase (Short_Flag_Names (i)) then do; found = True; addr (flags) -> audit_flags_alt.flags (i) = switch; end; end; if ^found then ec = error_table_$bad_arg; end; end process_flag_keyword; process_object_keyword: proc (); dcl keyword char (40); dcl i fixed bin; dcl found bit (1); dcl object_index fixed bin; dcl level_index fixed bin (21); dcl based_level_pair char (level_pair_len) based (level_pair_ptr); dcl level_pair_len fixed bin (21); dcl level_pair_ptr pointer; if keyword_len > length (keyword) then do; BADARG: ec = error_table_$bad_arg; return; end; else do; level_index = index (based_keyword, "="); /* locate "grant/deny" */ if level_index < 2 /* need something before... */ | level_index >= keyword_len /* ...and after "=" */ then goto BADARG; keyword = lowercase (substr (based_keyword, 1, level_index - 1)); /* trim "grant/deny" pair, we'll deal with them later */ found = False; do i = 1 to hbound (Short_Object_Names, 1) while (^found); if keyword = lowercase (Short_Object_Names (i)) then do; found = True; object_index = i; /* save for process_audit_level_keyword */ end; end; if ^found then ec = error_table_$bad_arg; else do; level_pair_ptr = addr (keyword_ptr -> char_array (level_index + 1)); level_pair_len = keyword_len - level_index; call process_level_pair (object_index, based_level_pair); end; end; end process_object_keyword; process_level_pair: proc (object_index, level_pair); dcl object_index fixed bin parameter; dcl level_pair char (*) parameter; dcl level_index fixed bin; dcl found bit (1); dcl grant_key char (32); dcl deny_key char (32); if length (level_pair) > length (grant_key) then do; ec = error_table_$bad_arg; end; else if index (level_pair, "/") = 0 then do; ec = error_table_$bad_arg; end; else do; grant_key = lowercase (before (level_pair, "/")); deny_key = lowercase (after (level_pair, "/")); if grant_key ^= "" then do; found = False; do level_index = lbound (Short_Level_Names, 1) to hbound (Short_Level_Names, 1) while (^found); if grant_key = lowercase (Short_Level_Names (level_index)) then do; found = True; flags.objects (object_index).grant_level = level_index; if object_index = FSOBJ_AUDIT_OBJECT_INDEX & level_index = MODIFY_ACCESS then ec = error_table_$bad_arg; /* should have this level on FSATTR... */ end; end; if ^found then ec = error_table_$bad_arg; end; if deny_key ^= "" then do; found = False; do level_index = lbound (Short_Level_Names, 1) to hbound (Short_Level_Names, 1) while (^found); if deny_key = lowercase (Short_Level_Names (level_index)) then do; found = True; flags.objects (object_index).deny_level = level_index; if object_index = FSOBJ_AUDIT_OBJECT_INDEX & level_index = MODIFY_ACCESS then ec = error_table_$bad_arg; /* should have this level on FSATTR... */ end; end; if ^found then ec = error_table_$bad_arg; end; end; end process_level_pair; %page; /* MOVE_SUBSTR - procedure to move a char string pointer to the "right" and adjust the length */ move_substr: proc (substr_ptr, substr_len, n_chars); dcl substr_ptr pointer parameter; dcl substr_len fixed bin (21) parameter; dcl n_chars fixed bin (21) parameter; dcl char_array (substr_len) char (1) unaligned based; substr_ptr = addr (substr_ptr -> char_array (n_chars + 1)); substr_len = substr_len - n_chars; return; end move_substr; %page; /* Internal Procedures for "TO STRING" Entries */ check_flag_bits: proc () returns (bit (1)); /* routine to make sure pad is zero and MODIFY-ACCESS level not specified for file system objects (is legal on file system attributes) */ if addr (flags) -> audit_flags.pad ^= ""b then return (False); else if addr (flags) -> audit_flags.objects (FSOBJ_AUDIT_OBJECT_INDEX).deny_level = MODIFY_ACCESS then return (False); else if addr (flags) -> audit_flags.objects (FSOBJ_AUDIT_OBJECT_INDEX).grant_level = MODIFY_ACCESS then return (False); else return (True); end check_flag_bits; append_object_level_pair: proc (object_index); dcl object_index fixed bin parameter; if v_flag_str ^= "" then v_flag_str = v_flag_str || ","; v_flag_str = v_flag_str || rtrim (Short_Object_Names (object_index)) || "=" || rtrim (Short_Level_Names (flags.objects (object_index).grant_level)) || "/" || rtrim (Short_Level_Names (flags.objects (object_index).deny_level)); return; end append_object_level_pair; append_flag: proc (flag_index); dcl flag_index fixed bin parameter; if v_flag_str ^= "" then v_flag_str = v_flag_str || ","; if ^addr (flags) -> audit_flags_alt.flags (flag_index) then v_flag_str = v_flag_str || "^"; v_flag_str = v_flag_str || rtrim (Short_Flag_Names (flag_index)); return; end append_flag; set_object_display_widths: proc (); dcl i fixed bin; /* find longest strings we're going to display */ object_name_width = 0; do i = lbound (Long_Object_Names, 1) to hbound (Long_Object_Names, 1); len = length (rtrim (Long_Object_Names (i))); if len > object_name_width then object_name_width = len; end; level_name_width = 0; do i = lbound (Long_Level_Names, 1) to hbound (Long_Level_Names, 1); len = length (rtrim (Long_Level_Names (i))); if len > level_name_width then level_name_width = len; end; return; end set_object_display_widths; display_object_level_pair: proc (object_index); dcl object_index fixed bin parameter; len = display_substr_len; call ioa_$rsnp (Display_Object_Format, based_display_substr, len, object_name_width, Long_Object_Names (object_index), level_name_width, Long_Level_Names (flags.objects (object_index).grant_level), level_name_width, Long_Level_Names (flags.objects (object_index).deny_level)); call move_substr (display_substr_ptr, display_substr_len, len); return; end display_object_level_pair; display_flag: proc (flag_index); dcl flag_index fixed bin parameter; len = display_substr_len; call ioa_$rsnp ("^[^14t^^^;^15t^]^a", based_display_substr, len, ^flags.flags (flag_index), Long_Flag_Names (flag_index)); call move_substr (display_substr_ptr, display_substr_len, len); return; end display_flag; %page; %include access_audit_flags; %include access_audit_names; end convert_access_audit_flags_$from_string;  merge_access_audit_flags_.pl1 01/26/85 1315.1r w 01/22/85 1313.4 21672 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style1,^inddcls,^indnoniterdo,insnl,linecom,indcomtxt */ merge_access_audit_flags_: proc (a_flags_1, a_flags_2) returns (bit (36) aligned); /* format: off */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* MERGE_ACCESS_AUDIT_FLAGS_ */ /* */ /* Function which merges two sets of access audit flags. The result is a *logical* sum */ /* of the two arguments. For object levels, the result is the greater of the two. For */ /* the event oriented flags, the result of the logical "or" of the two. */ /* */ /* This program is primarily for use by the process creation software. The access audit */ /* flags of the project and user registration are merged to form the process access */ /* audit flags. */ /* */ /* History: */ /* 84-12-07 EJ Sharpe - minor upgrades /* 84-11-19 EJ Sharpe - created */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: on */ dcl a_flags_1 bit (36) aligned parameter; dcl a_flags_2 bit (36) aligned parameter; dcl 1 flags_1 aligned like audit_flags_alt; dcl 1 flags_2 aligned like audit_flags_alt; dcl 1 result aligned like audit_flags_alt; dcl object_index fixed bin; dcl flag_index fixed bin; dcl max builtin; dcl unspec builtin; unspec (flags_1) = a_flags_1; unspec (flags_2) = a_flags_2; unspec (result) = ""b; do object_index = 1 to n_audit_objects; result.objects (object_index).deny_level = max (flags_1.objects (object_index).deny_level, flags_2.objects (object_index).deny_level); result.objects (object_index).grant_level = max (flags_1.objects (object_index).grant_level, flags_2.objects (object_index).grant_level); end; do flag_index = 1 to n_audit_flags; result.flags (flag_index) = flags_1.flags (flag_index) | flags_2.flags (flag_index); end; return (unspec (result)); %include access_audit_flags; end merge_access_audit_flags_;  reclassify_dir.pl1 01/26/85 1315.1r w 01/22/85 1313.4 48978 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ reclassify_dir: proc; /* first version coded 09/29/74 J.C.Whitmore */ /* This procedure is used to change the access class of a segment, a directory and all immediately inferior segments, or a ring 1 multiple access class segment The three entry points are: 1. reclassify_dir path [access_class] 2. reclassify_seg path 3. reclassify_sys_seg path [access_class] If the optional access_class argument is omitted, the access class of the parent directory is assumed. Access to the system_privilege_ gate is assumed. */ dcl aptr ptr, alen fixed bin, arg char (alen) based (aptr), acc_class bit (72) aligned, ec fixed bin (35), d_priv fixed bin (35) init (1), /* 0 if we set dir priv here */ os_priv fixed bin (35) init (1), /* 0 if we set out-of-service priv here */ dir char (168), ent char (32), (rd_entry, rs_entry, rss_entry) bit (1) init ("0"b), whoami char (24), addr builtin; dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), com_err_ entry options (variable), convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)), hcs_$get_access_class entry (char (*), char (*), bit (72) aligned, fixed bin (35)), system_privilege_$dir_priv_on entry (fixed bin (35)), system_privilege_$dir_priv_off entry (fixed bin (35)), system_privilege_$soos_priv_on entry (fixed bin (35)), system_privilege_$soos_priv_off entry (fixed bin (35)), system_privilege_$reclassify_branch entry (char (*), char (*), bit (72) aligned, fixed bin (35)), system_privilege_$reclassify_node entry (char (*), char (*), bit (72) aligned, fixed bin (35)), system_privilege_$reclassify_sys_seg entry (char (*), char (*), bit (72) aligned, fixed bin (35)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl error_table_$noarg ext static fixed bin (35); dcl (linkage_error, cleanup) condition; whoami = "reclassify_dir"; /* name the entry point for com_err */ rd_entry = "1"b; /* reclass dir entry switch */ go to start; reclassify_seg: entry; whoami = "reclassify_seg"; /* ....for com_err */ rs_entry = "1"b; /* reclass seg entry switch */ go to start; reclassify_sys_seg: entry; whoami = "reclassify_sys_seg"; /* ....for com_err */ rss_entry = "1"b; /* reclass sys seg entry switch */ start: call cu_$arg_ptr (1, aptr, alen, ec); /* get the pathname */ if ec ^= 0 then do; err: call com_err_ (ec, whoami); go to clean_up; /* be sure we reset privileges */ end; if arg = "-wd" | arg = "-wdir" then alen = 0; call expand_path_ (aptr, alen, addr (dir), addr (ent), ec); if ec ^= 0 then go to err; on linkage_error go to abort; /* do something intelligent if user doesn't have access */ on cleanup go to clean_up; /* cleanup after a "quit" or ..... */ call system_privilege_$soos_priv_on (os_priv); /* be sure we have the needed privilege */ call system_privilege_$dir_priv_on (d_priv); if rs_entry then /* do one seg at access class of parent */ call system_privilege_$reclassify_branch (dir, ent, "0"b, ec); /* access class is ignored */ else do; /* the other entries may have another arg */ call cu_$arg_ptr (2, aptr, alen, ec); /* see if an access class was specified */ if ec ^= 0 then if ec = error_table_$noarg then /* none supplied so, */ if rss_entry then do; /* user really wanted to make the sys seg normal */ call system_privilege_$reclassify_branch (dir, ent, "0"b, ec); rss_entry = "0"b; /* we are done, this will make us fall through */ end; else do; call hcs_$get_access_class (dir, ent, acc_class, ec); /* assume level of parent */ if ec ^= 0 then go to err; /* not much we can do */ end; else go to err; /* wrong error from arg_ptr */ else do; /* we got a second argument */ call convert_authorization_$from_string (acc_class, arg, ec); /* convert to binary access class */ if ec ^= 0 then go to err; /* bad access class string */ end; if rd_entry then call system_privilege_$reclassify_node (dir, ent, acc_class, ec); else if rss_entry then /* see if we still want a sys seg */ call system_privilege_$reclassify_sys_seg (dir, ent, acc_class, ec); end; if ec ^= 0 then do; if dir = "> " then dir = ""; /* special case root for com_err */ call com_err_ (ec, whoami, "^a>^a", dir, ent); end; clean_up: if d_priv = 0 then call system_privilege_$dir_priv_off (ec); /* turn off if we set it */ if os_priv = 0 then call system_privilege_$soos_priv_off (ec); return; abort: call com_err_ (0, whoami, "This command requires privileged access not given to this user."); /* we don't have to worry about reseting privileges */ /* since we got here because user didn't have access */ return; end reclassify_dir;  reset_soos.pl1 02/16/88 1340.8rew 02/16/88 1247.0 34272 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1974 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-01-15,Lippard), approve(87-08-24,MCR7760), audit(88-01-28,Fawcett), install(88-02-16,MR12.2-1022): Make reset_soos work on segments. END HISTORY COMMENTS */ reset_soos: proc; /* procedure to reset the security-out-of-service-switch of a directory branch if the Access Isolation attributes are consistent. */ /* first version coded 09/29/74 J.C.Whitmore */ dcl aptr ptr, alen fixed bin, arg char (alen) based (aptr), ec fixed bin (35), dir char (168), ent char (32), d_priv fixed bin (35) init (1), os_priv fixed bin (35) init (1), seg_priv fixed bin (35) init (1); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), com_err_ entry options (variable), expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), pathname_ entry (char (*), char (*)) returns (char (168)), system_privilege_$check_mode_reset entry (char (*), char (*), fixed bin (35)), system_privilege_$dir_priv_on entry (fixed bin (35)), system_privilege_$dir_priv_off entry (fixed bin (35)), system_privilege_$seg_priv_on entry (fixed bin (35)), system_privilege_$seg_priv_off entry (fixed bin (35)), system_privilege_$soos_priv_on entry (fixed bin (35)), system_privilege_$soos_priv_off entry (fixed bin (35)); dcl (linkage_error, cleanup) condition; call cu_$arg_ptr (1, aptr, alen, ec); /* only one argument is expected */ if ec ^= 0 then do; call com_err_ (ec, "reset_soos"); return; end; if arg = "-wd" | arg = "-wdir" then alen = 0; call expand_pathname_ (arg, dir, ent, ec); if ec ^= 0 then do; call com_err_ (ec, "reset_soos", "^a", arg); return; end; on linkage_error go to abort; /* do something intelligent if user doesn't have access */ on cleanup go to clean_up; /* cleanup after a "quit" or .... */ call system_privilege_$dir_priv_on (d_priv); /* be sure we have correct privileges */ call system_privilege_$seg_priv_on (seg_priv); call system_privilege_$soos_priv_on (os_priv); call system_privilege_$check_mode_reset (dir, ent, ec); /* This does the work. */ if ec ^= 0 then call com_err_ (ec, "reset_soos", "^a", pathname_ (dir, ent)); clean_up: if d_priv = 0 then call system_privilege_$dir_priv_off (ec); /* turn off if we set it */ if seg_priv = 0 then call system_privilege_$seg_priv_off (ec); if os_priv = 0 then call system_privilege_$soos_priv_off (ec); return; abort: call com_err_ (0, "reset_soos", "This command requires privileged access not given to this user."); /* don't worry about reseting privileges because we */ /* got here because user didn't have access to do so */ return; end reset_soos;  set_process_audit_flags.pl1 04/23/86 1032.2rew 04/23/86 1028.0 117576 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-03-17,EJSharpe), approve(86-03-17,MCR7364), audit(86-03-21,Margolin), install(86-04-23,MR12.0-1045): Initial coding (taken from version which supported functional test debugging). END HISTORY COMMENTS */ /* format: style4,indattr */ set_process_audit_flags: procedure (); /* * * SET_PROCESS_AUDIT_FLAGS * * This module contains the privileged commands which manipulate * the process audit flags. * * display_process_audit_flags {-long|-brief} * Displays the audit flags for the current process. * * set_process_audit_flags {STR} * Sets the audit flags to the given string. If the * string is not supplied, a request loop is entered * where the current values are displayed, and new values * are requested. Flags not specified are turned off. * A "." terminates the loop. * * edit_process_audit_flags {STR} * Operates like set_process_audit_flags but changes * only the values of flags specified, leaving others * intact. * * The commands accept the following keywords in lieu of the * audit flags string: * * default - uses default values from sys_admin_data * all - turns all flags on and levels to maximum * none - turns all flags off and levels to minimum * * Notes: * As a future enhancement, the commands should accept a "-user STR" * argument which would allow manipulation of audit flags for other * live processes. * * History: * 1985-05-22, EJ Sharpe: initial coding * 1985-07-18, EJ Sharpe: cosmetic cleanup * */ %page; /* AUTOMATIC */ dcl ME automatic char (32); /* self identification */ dcl argl automatic fixed bin (21); /* command arg length */ dcl arglp automatic ptr; /* command arg list ptr */ dcl argp automatic ptr; /* command arg ptr */ dcl auto_audit_flags automatic bit (36) aligned; /* the binary flags */ dcl code automatic fixed bin (35); /* status code */ dcl edit_sw automatic bit (1) aligned; /* to distinguish the set and edit entries */ dcl flags_string automatic char (1024); /* audit flags converted from binary */ dcl input_flags automatic char (512); /* input audit flags */ dcl long_sw automatic bit (1); /* controls whether display of flags is long format */ dcl nargs automatic fixed bin; /* number of command line arguments */ dcl sadp automatic pointer; /* pointer to sys_admin_data */ /* BASED */ dcl arg char (argl) based (argp); /* command argument */ /* ENTRIES */ dcl access_audit_gate_$get_process_audit_flags entry (bit (36) aligned); dcl com_err_ entry () options (variable); dcl command_query_ entry () options (variable); dcl convert_access_audit_flags_$to_string entry (bit (36) aligned, char (*), fixed bin (35)); dcl convert_access_audit_flags_$to_string_long entry (bit (36) aligned, char (*), fixed bin (21), fixed bin (35)); dcl convert_access_audit_flags_$edit_from_string entry (char (*), bit (36) aligned, fixed bin (35)); dcl convert_access_audit_flags_$from_string entry (char (*), bit (36) aligned, fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_list_ptr entry (ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl ioa_ entry () options (variable); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl system_privilege_$set_process_audit_flags entry (bit (36) aligned); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); /* MISC */ dcl error_table_$bad_arg fixed bin (35) external; dcl PROMPT_EXPLANATION char (50) init ("Enter audit flags string or ""."" to exit.^/") static options (constant); dcl addr builtin; dcl length builtin; dcl null builtin; dcl rtrim builtin; %page; /* The flag setting procedures */ /* set_process_audit_flags: */ spaf: entry (); call cu_$arg_list_ptr (arglp); call SETUP ("set_process_audit_flags"); edit_sw = "0"b; goto SET_EDIT_COMMON; edit_process_audit_flags: epaf: entry (); call cu_$arg_list_ptr (arglp); call SETUP ("edit_process_audit_flags"); edit_sw = "1"b; SET_EDIT_COMMON: input_flags = ""; call PROCESS_SET_EDIT_ARGS (); /*** get current flags */ call access_audit_gate_$get_process_audit_flags (auto_audit_flags); if input_flags ^= "" then do; /* new flags given on command line */ call PROCESS_INPUT_FLAGS (input_flags, auto_audit_flags, "0"b); call system_privilege_$set_process_audit_flags (auto_audit_flags); end; else do; /* caller wants interactive loop */ call convert_access_audit_flags_$to_string (auto_audit_flags, flags_string, code); if code ^= 0 then call FATAL_ERROR (code, "Process audit flags in error."); call ioa_ ("current flags: ^a", flags_string); input_flags = ""; /* prime the loop */ /*** set up for the queries */ query_info.version = query_info_version_6; query_info.suppress_spacing = "1"b; query_info.prompt_after_explanation = "1"b; query_info.suppress_name_sw = "1"b; query_info.explanation_ptr = addr (PROMPT_EXPLANATION); query_info.explanation_len = length (rtrim (PROMPT_EXPLANATION)); do while (input_flags ^= "."); call command_query_ (addr (query_info), input_flags, ME, "enter flags: "); if input_flags ^= "." then do; call PROCESS_INPUT_FLAGS (input_flags, auto_audit_flags, "1"b); call convert_access_audit_flags_$to_string (auto_audit_flags, flags_string, code); if code ^= 0 then call FATAL_ERROR (code, "Internal error: converted flags in error."); call ioa_ ("^/new flags: ^a", flags_string); end; end; /* loop */ /*** we arrive here with the converted flags to be set for the process */ call system_privilege_$set_process_audit_flags (auto_audit_flags); end; return; %page; /* The flag display procedure */ display_process_audit_flags: dpaf: entry (); call cu_$arg_list_ptr (arglp); call SETUP ("display_process_audit_flags"); call PROCESS_DISPLAY_ARGS (); call access_audit_gate_$get_process_audit_flags (auto_audit_flags); flags_string = ""; if long_sw then call convert_access_audit_flags_$to_string_long (auto_audit_flags, flags_string, (0), code); else call convert_access_audit_flags_$to_string (auto_audit_flags, flags_string, code); if code ^= 0 then call FATAL_ERROR (code, "Process audit flags in error."); else call ioa_ ("^a", flags_string); return; %page; SETUP: procedure (P_entrypoint_name); dcl P_entrypoint_name char (*) parameter; /* entrypoint code */ ME = P_entrypoint_name; call cu_$arg_count (nargs, code); if code ^= 0 then call FATAL_ERROR (code); return; end SETUP; %page; PROCESS_DISPLAY_ARGS: procedure; /* procedure to process args for the display entry */ dcl arg_index automatic fixed bin; /* loop index */ /*** All we may have is the "-long" or "-brief" args */ long_sw = "0"b; do arg_index = 1 to nargs; call cu_$arg_ptr_rel (arg_index, argp, argl, code, arglp); if code ^= 0 then call FATAL_ERROR (code, "Unexpected error getting argument."); if arg = "-long" | arg = "-lg" then long_sw = "1"b; else if arg = "-brief" | arg = "-bf" then long_sw = "0"b; else goto USAGE; end; return; USAGE: call FATAL_ERROR (error_table_$bad_arg, "Usage is: ^a {-long|-brief}", ME); return; end PROCESS_DISPLAY_ARGS; %page; PROCESS_SET_EDIT_ARGS: procedure (); /* procedure to process args for the set and edit entries */ if nargs > 1 then goto USAGE; if nargs = 1 then do; call cu_$arg_ptr_rel (1, argp, argl, code, arglp); if code ^= 0 then call FATAL_ERROR (code, "Unexpected error getting arg."); input_flags = arg; end; return; USAGE: call FATAL_ERROR (0, "Usage is: ^a {FLAGS_STR}", ME); return; end PROCESS_SET_EDIT_ARGS; %page; FATAL_ERROR: procedure options (variable); /* Automatic */ dcl ec_ptr automatic ptr; /* pointer to error code argument */ dcl fatal_error automatic bit (1); /* indicates which entry we approached */ dcl ignore_len automatic fixed bin (21); /* dummy argument */ dcl l_arglp automatic ptr; /* arg list ptr for this proc */ dcl l_code automatic fixed bin (35); /* error code to use in this proc */ dcl message_buff automatic char (512); /* buffer for formatting caller's message */ dcl message_ptr automatic ptr; /* pointer to the formatted message */ dcl message_len automatic fixed bin (21); /* length of formatted message */ /* Based */ dcl ec fixed bin (35) based (ec_ptr); /* caller's error code (first arg) */ dcl message char (message_len) based (message_ptr); /* formatted message */ fatal_error = "1"b; goto ERROR_JOIN; WARNING: entry options (variable); fatal_error = "0"b; ERROR_JOIN: message_ptr = addr (message_buff); message_len = length (message_buff); call cu_$arg_list_ptr (l_arglp); call cu_$arg_ptr_rel (1, ec_ptr, ignore_len, l_code, l_arglp); if l_code ^= 0 then do; call com_err_ (l_code, ME, "Internal error: Error occurred during error handling."); goto MAIN_EXIT; /* punt */ end; call ioa_$general_rs (l_arglp, 2, 3, message, message_len, "0"b, "0"b); call com_err_ (ec, ME, message); if fatal_error then goto MAIN_EXIT; end FATAL_ERROR; MAIN_EXIT: return; %page; PROCESS_INPUT_FLAGS: procedure (P_input, P_audit_flags, P_interactive); dcl P_input char (*) parameter; dcl P_audit_flags bit (36) aligned parameter; dcl P_interactive bit (1) aligned parameter; if P_input = "default" then call GET_DEFAULT_FLAGS (P_audit_flags); else if P_input = "all" then call SET_ALL_FLAGS_ON (P_audit_flags); else if P_input = "none" then call SET_ALL_FLAGS_OFF (P_audit_flags); else do; /* we're supplied with a possible set of flags */ if edit_sw then call convert_access_audit_flags_$edit_from_string (P_input, P_audit_flags, code); else call convert_access_audit_flags_$from_string (P_input, P_audit_flags, code); if code ^= 0 then if P_interactive then call WARNING (code, "Input was: ^a.", P_input); else call FATAL_ERROR (code, "Input was: ^a.", P_input); end; return; %page; GET_DEFAULT_FLAGS: proc (P_flags); dcl P_flags bit (36) aligned parameter; dcl ADMIN_DIR char (168) init (">udd>SysAdmin>admin") static options (constant); dcl SYS_ADMIN_DATA char (32) init ("sys_admin_data") static options (constant); dcl ignore_bc automatic fixed bin (24); /* dummy argument */ dcl cleanup condition; sadp = null (); /* pointer is global due to incl requirement */ on cleanup call CLEAN_UP (); call initiate_file_ (ADMIN_DIR, SYS_ADMIN_DATA, R_ACCESS, sadp, ignore_bc, code); if code ^= 0 then call WARNING (code, "Could not open ^a.", pathname_ (ADMIN_DIR, SYS_ADMIN_DATA)); else do; P_flags = sys_admin_data.default_audit_flags; call CLEAN_UP (); /* terminate reference */ end; return; CLEAN_UP: proc (); dcl tsadp automatic pointer; /* temporary */ tsadp = sadp; if tsadp ^= null () then do; sadp = null (); call terminate_file_ (tsadp, (0), TERM_FILE_TERM, code); end; end CLEAN_UP; end GET_DEFAULT_FLAGS; %page; SET_ALL_FLAGS_ON: procedure (P_flags); dcl P_flags bit (36) aligned parameter; dcl flags automatic bit (36) aligned; flags = "777777777777"b3; addr (flags) -> audit_flags.pad = "0"b; /* clear pad */ P_flags = flags; return; end SET_ALL_FLAGS_ON; %page; SET_ALL_FLAGS_OFF: procedure (P_flags); dcl P_flags bit (36) aligned parameter; P_flags = "0"b; /* this one's easy! */ return; end SET_ALL_FLAGS_OFF; end PROCESS_INPUT_FLAGS; %page; %include access_audit_flags; %page; %include access_mode_values; %page; %include terminate_file; %page; %include query_info; %page; %include sys_admin_data; end set_process_audit_flags;  set_system_audit_flags.pl1 01/26/85 1315.1r w 01/22/85 1313.4 80496 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style1,^inddcls,^indnoniterdo,insnl,linecom,indcomtxt */ set_system_audit_flags: ssaf: procedure; /* format: off */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* SET_SYSTEM_AUDIT_FLAGS */ /* */ /* Command to set the system access audit enable flags and thresholds per command line */ /* per command line arguments. */ /* */ /* Usage: set_system_audit_flags -control_args */ /* */ /* */ /* DISPLAY_SYSTEM_AUDIT_FLAGS */ /* */ /* Command to display the current values of the system access auditing enable flags and */ /* thresholds. */ /* */ /* Usage: display_system_audit_flags */ /* */ /* */ /* History: */ /* 84-12-14 EJ Sharpe - changed display format */ /* 84-12-12 EJ Sharpe - initial coding */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: on */ /* AUTOMATIC */ dcl covert_channel_sw bit (1) aligned; dcl covert_channel_threshold bit (72) aligned; dcl successful_access_sw bit (1) aligned; dcl successful_access_threshold bit (72) aligned; dcl unsuccessful_access_sw bit (1) aligned; dcl unsuccessful_access_threshold bit (72) aligned; dcl ME char (32); dcl arglistptr pointer; dcl arglen fixed bin (21); dcl argptr pointer; dcl class_str char (172); dcl n_args fixed bin; dcl ec fixed bin (35); /* EXTERNAL CONSTANT */ dcl error_table_$bad_arg fixed bin (35) external; dcl error_table_$noarg fixed bin (35) external; dcl sys_info$audit_covert_channel bit (1) aligned external; dcl sys_info$covert_channel_threshold bit (72) aligned external; dcl sys_info$audit_successful_access bit (1) aligned external; dcl sys_info$successful_access_threshold bit (72) aligned external; dcl sys_info$audit_unsuccessful_access bit (1) aligned external; dcl sys_info$unsuccessful_access_threshold bit (72) aligned external; /* MISC */ dcl addr builtin; dcl arg char (arglen) based (argptr); dcl based_dblwd (2) bit (36) aligned based; /* for octal display of access class */ /* ENTRIES */ dcl hphcs_$set_sys_audit_thresholds entry (bit (1) aligned, bit (72) aligned, bit (1) aligned, bit (72) aligned, bit (1) aligned, bit (72) aligned, fixed bin (35)); dcl com_err_ entry options (variable); dcl convert_access_class_$to_string_short entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_access_class_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_count_rel entry (fixed bin, pointer, fixed bin (35)); dcl cu_$arg_list_ptr entry (pointer); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl ioa_ entry () options (variable); %page; /* set_system_audit_flags: procedure (); */ ME = "set_system_audit_flags"; call copy_values; call cu_$arg_list_ptr (arglistptr); call process_arguments; call hphcs_$set_sys_audit_thresholds (covert_channel_sw, covert_channel_threshold, successful_access_sw, successful_access_threshold, unsuccessful_access_sw, unsuccessful_access_threshold, ec); if ec ^= 0 then call ERROR (ec, "Could not set access audit parameters."); return; display_system_audit_flags: dsaf: entry (); ME = "display_system_audit_flags"; call cu_$arg_count (n_args, ec); if ec ^= 0 then call ERROR (ec, ""); if n_args ^= 0 then call ERROR (ec, "No arguments are recognized by this command."); call copy_values; call display_values; return; %page; /* COPY_VALUES - Internal procedure to copy the audit enable flags and thresholds out of sys_info */ copy_values: proc (); covert_channel_sw = sys_info$audit_covert_channel; covert_channel_threshold = sys_info$covert_channel_threshold; successful_access_sw = sys_info$audit_successful_access; successful_access_threshold = sys_info$successful_access_threshold; unsuccessful_access_sw = sys_info$audit_unsuccessful_access; unsuccessful_access_threshold = sys_info$unsuccessful_access_threshold; end copy_values; /* DISPLAY_VALUES - Internal procedure to display the current values of the access audit enable flags and thresholds */ display_values: proc (); call ioa_ ("Covert channel auditing ^[enabled,^;disabled.^]", covert_channel_sw); if covert_channel_sw then do; call convert_access_class_$to_string_short (covert_channel_threshold, class_str, ec); if class_str = "" then class_str = "system_low"; if ec ^= 0 then call com_err_ (ec, ME, "Illegal covert channel threshold ^w ^w.", addr (covert_channel_threshold) -> based_dblwd); else call ioa_ (" threshold = ^a.", class_str); end; call ioa_ ("Successful access auditing ^[enabled,^;disabled.^]", successful_access_sw); if successful_access_sw then do; call convert_access_class_$to_string_short (successful_access_threshold, class_str, ec); if class_str = "" then class_str = "system_low"; if ec ^= 0 then call com_err_ (ec, ME, "Illegal successful access threshold ^w ^w.", addr (successful_access_threshold) -> based_dblwd); else call ioa_ (" threshold = ^a.", class_str); end; call ioa_ ("Unsuccessful access auditing ^[enabled,^;disabled.^]", unsuccessful_access_sw); if unsuccessful_access_sw then do; call convert_access_class_$to_string_short (unsuccessful_access_threshold, class_str, ec); if class_str = "" then class_str = "system_low"; if ec ^= 0 then call com_err_ (ec, ME, "Illegal unsuccessful access threshold ^w ^w.", addr (unsuccessful_access_threshold) -> based_dblwd); else call ioa_ (" threshold = ^a.", class_str); end; return; end display_values; %page; /* PROCESS_ARGUMENTS - Internal procedure to process the command line arguments */ /* (used only by SET_system_audit_flags entrypoint) */ process_arguments: procedure (); dcl arg_no fixed bin; call cu_$arg_count_rel (n_args, arglistptr, ec); if ec ^= 0 then call ERROR (ec, "Unable to get argument count."); if n_args < 1 then call ERROR (error_table_$noarg, ""); arg_no = 1; do while (arg_no <= n_args); call get_arg ("next control argument"); if arg = "-covert_channel" | arg = "-cch" then do; call get_thresh ("covert channel threshold string", covert_channel_threshold); covert_channel_sw = "1"b; end; else if arg = "-no_covert_channel" | arg = "-ncch" then covert_channel_sw = "0"b; else if arg = "-successful_access" | arg = "-sa" then do; call get_thresh ("successful access threshold string", successful_access_threshold); successful_access_sw = "1"b; end; else if arg = "-no_successful_access" | arg = "-nsa" then successful_access_sw = "0"b; else if arg = "-unsuccessful_access" | arg = "-usa" then do; call get_thresh ("unsuccessful access threshold string", unsuccessful_access_threshold); unsuccessful_access_sw = "1"b; end; else if arg = "-no_unsuccessful_access" | arg = "-nusa" then unsuccessful_access_sw = "0"b; else call ERROR (error_table_$bad_arg, arg); arg_no = arg_no + 1; end; /* LOOP */ return; get_thresh: procedure (arg_name, thresh_var); /* procedure internal to process_arguments to get a threshold command line argument */ dcl arg_name char (*) parameter; dcl thresh_var bit (72) aligned parameter; arg_no = arg_no + 1; call get_arg (arg_name); call convert_access_class_$from_string (thresh_var, arg, ec); if ec ^= 0 then call ERROR (ec, arg); return; end get_thresh; get_arg: procedure (arg_name); /* procedure internal to process_arguments to get the next argument */ dcl arg_name char (*) parameter; call cu_$arg_ptr_rel (arg_no, argptr, arglen, ec, arglistptr); if ec ^= 0 then call ERROR (ec, arg_name); return; end get_arg; end process_arguments; %page; /* ERROR - internal procedure to report an error and exit the command */ ERROR: procedure (code, msg); dcl code fixed bin (35) parameter; dcl msg char (*) parameter; call com_err_ (code, ME, msg); goto ERROR_EXIT; end ERROR; ERROR_EXIT: end set_system_audit_flags;  set_system_priv.pl1 01/26/85 1315.1r w 01/22/85 1313.4 38358 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ set_system_priv: proc; /* initially coded by J. Whitmore - 10/15/74 */ /* modified at some point by C.T. Tavares for rcp priv. */ /* modified for better usage message, 1/81 by M.R. Jordan */ /* modified for comm privilege, 5/83 by E. N. Kittlitz */ /* This command allows the user with access to the system_privilege_ gate to turn on and off the individual system privilege bits for his process */ dcl ME char (15) static options (constant) init ("set_system_priv"); dcl aptr ptr, alen fixed bin, arg char (alen) based (aptr); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), cu_$arg_count entry (fixed bin, fixed bin (35)), (ioa_, com_err_) entry options (variable), (system_privilege_$ipc_priv_on, system_privilege_$ipc_priv_off, system_privilege_$dir_priv_on, system_privilege_$dir_priv_off, system_privilege_$seg_priv_on, system_privilege_$seg_priv_off, system_privilege_$ring1_priv_on, system_privilege_$ring1_priv_off, system_privilege_$soos_priv_on, system_privilege_$soos_priv_off, system_privilege_$rcp_priv_on, system_privilege_$rcp_priv_off, system_privilege_$comm_priv_on, system_privilege_$comm_priv_off) entry (fixed bin (35)); dcl ec fixed bin (35), action fixed bin (35), nargs fixed bin, ind fixed bin; dcl error_table_$badopt ext fixed bin (35); dcl error_table_$noarg fixed bin (35) ext; dcl linkage_error condition; %page; call cu_$arg_count (nargs, ec); if ec ^= 0 then do; call com_err_ (ec, ME); return; end; if nargs = 0 then do; call com_err_ (error_table_$noarg, ME, "^/Usage: set_system_priv privnames^/^7xwhere a privname can be: ipc, dir, seg, soos, ring1, rcp, or comm.^/^7xEach may be preceeded by ""^"" for negation."); return; end; on linkage_error go to abort; /* do something intelligent if user doesn't have access */ do ind = 1 to nargs; call cu_$arg_ptr (ind, aptr, alen, ec); if ec ^= 0 then do; call com_err_ (ec, ME, "^/Accessing argument ^d.", ind); return; end; if arg = "ipc" then call system_privilege_$ipc_priv_on (action); else if arg = "^ipc" then call system_privilege_$ipc_priv_off (action); else if arg = "dir" then call system_privilege_$dir_priv_on (action); else if arg = "^dir" then call system_privilege_$dir_priv_off (action); else if arg = "seg" then call system_privilege_$seg_priv_on (action); else if arg = "^seg" then call system_privilege_$seg_priv_off (action); else if arg = "soos" then call system_privilege_$soos_priv_on (action); else if arg = "^soos" then call system_privilege_$soos_priv_off (action); else if arg = "ring1" then call system_privilege_$ring1_priv_on (action); else if arg = "^ring1" then call system_privilege_$ring1_priv_off (action); else if arg = "rcp" then call system_privilege_$rcp_priv_on (action); else if arg = "^rcp" then call system_privilege_$rcp_priv_off (action); else if arg = "communications" | arg = "comm" then call system_privilege_$comm_priv_on (action); else if arg = "^communications" | arg = "^comm" then call system_privilege_$comm_priv_off (action); else do; action = 0; ec = error_table_$badopt; call com_err_ (ec, ME, "^a", arg); end; if action ^= 0 then call ioa_ ("Privilege already in state requested: ^a", arg); end; return; abort: call com_err_ (0, ME, "This command requires privileged access not given to this user."); /* don't worry about the state of the privileges, because */ /* we got here do to insufficient access to the gate */ return; end set_system_priv; 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