



		    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
