



		    convert_v2_pnt_.pl1             08/05/87  0754.1r   08/04/87  1541.0       82683



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* CONVERT_V2_PNT_: This subroutine is the target of the gate entry
   pnt_admin_gate_$convert_v2_pnt.  It converts the specified PNT from 
   a version 2 (or 1) MSTB to a version 3 MSTB and converts all pre-MR11
   PNT entries to the new MR11 format.  PNT entries were changed to
   accomodate 32 character-long passwords, support AIM ranges, and 
   include a version number.  */

/* format: style2 */

convert_v2_pnt_:
     procedure (P_dirname, P_entryname, P_code);

/**** Modified 84-12-14 by EJ Sharpe to call convert_MR10_2_audit_flags_ */
/**** Written 1984-08-08 by E. Swenson */

/* Parameters */

	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_dirname		 char (*) parameter;
	dcl     P_entryname		 char (*) parameter;
	dcl     P_table_ptr		 ptr parameter;
	dcl     P_septr		 ptr parameter;
	dcl     P_teptr		 ptr parameter;
	dcl     P_ec		 fixed bin (35) parameter;

/* Automatic */

	dcl     code		 fixed bin (35);
	dcl     dirname		 char (168);
	dcl     entryname		 char (32);
	dcl     entryname_with_suffix	 char (32);
	dcl     new_entryname	 char (32);
	dcl     old_entryname	 char (32);
	dcl     old_newname		 char (32);
	dcl     saved_level		 fixed bin (3);
	dcl     table_ptr		 ptr;

/* External Entries */

	dcl     convert_MR10_2_audit_flags_ entry (bit (36) aligned);
	dcl     convert_v2_mstb_	 entry (char (*), char (*), char (*), char (*), entry, fixed bin (18) unsigned,
				 fixed bin (35));
	dcl     hcs_$chname_file	 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     hcs_$level_get	 entry (fixed bin (3));
	dcl     hcs_$level_set	 entry (fixed bin (3));
	dcl     get_ring_		 entry () returns (fixed bin (3));
	dcl     ms_table_mgr_v2_$close entry (ptr, fixed bin (35));
	dcl     ms_table_mgr_$delete	 entry (char (*), char (*), fixed bin (35));
	dcl     ms_table_mgr_v2_$open	 entry (char (*), char (*), char (*) aligned, ptr, ptr, fixed bin (35));
	dcl     suffixed_name_$make	 entry (char (*), char (*), char (32), fixed bin (35));
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));

/* Conditions */

	dcl     cleanup		 condition;

/* Program */

	dirname = P_dirname;			/* Copy arguments -- we're a gate */
	entryname = P_entryname;

	saved_level = -1;				/* For cleanup handler */
	on condition (cleanup)
	     begin;
		if saved_level ^= -1
		then do;
			call hcs_$level_set (saved_level);
			saved_level = -1;
		     end;
	     end;

	call hcs_$level_get (saved_level);
	call hcs_$level_set (get_ring_ ());

/**** First check to see if the PNT exists and is a valid PNT */

	call suffixed_name_$make (entryname, "pnt", entryname_with_suffix, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	call ms_table_mgr_v2_$open (dirname, entryname, "PNT", table_ptr, (null ()), code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

/**** That was all we needed, close it now. */

	call ms_table_mgr_v2_$close (table_ptr, (0));

	new_entryname = rtrim (substr (entryname, 1, 16)) || "." || unique_chars_ (""b);

	call convert_v2_mstb_ (dirname, entryname, dirname, new_entryname, convert_v2_pnte_, size (pnt_entry), code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	old_newname = rtrim (substr (entryname, 1, 16)) || "." || unique_chars_ (""b);

/* Add shriekname to old PNT */

	call hcs_$chname_file (dirname, entryname, "", old_newname, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

/* Delete real name from old PNT */

	call hcs_$chname_file (dirname, entryname, entryname, "", code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

/* Rename the new one to the real name.  Enforce the new suffix convention. */

	call hcs_$chname_file (dirname, new_entryname, new_entryname, entryname_with_suffix, code);

RETURN_TO_CALLER:
	call hcs_$level_set (saved_level);
	saved_level = -1;
	P_code = code;
	return;
%page;
convert_v2_pnte_:
     entry (P_table_ptr, P_septr, P_teptr, P_ec);

	dcl     1 pnte_v0		 aligned like pnt_entry_v0 based (P_septr);
	dcl     1 pnte_v2		 aligned like pnt_entry based (P_teptr);

/**** This is the declaration of the old pnt entry format.  It is 
      here only to be used in the conversion of the old format to
      Version 2 pnt entries. */

	declare 1 pnt_entry_v0	 aligned,		/* declaration of a single PNT entry */
		2 password	 character (8),	/* person's password */
		2 card_password	 character (8),
		2 public,
		  3 user_id	 character (32),	/* user ID (for alias entries */
		  3 alias		 character (8),
		  3 default_project	 character (16),	/* user's default project */
		  3 flags,			/* one-bit flags */
		    4 has_password	 bit (1) unaligned,
		    4 has_card_password
				 bit (1) unaligned,
		    4 trap	 bit (1) unal,	/* If this password is used, holler */
		    4 lock	 bit (1) unal,	/* prevent login if on. */
		    4 nochange	 bit (1) unal,	/* user cannot change password */
		    4 must_change	 bit unal,	/* user must change password at next login */
		    4 pw_time_lock	 bit (1) unal,	/* if password has a time lock */
		    4 generate_pw	 bit (1) unal,	/* ON if we give new pw, OFF lets user select new pw */
		    4 last_bad_pw_reported
				 bit (1) unal,	/* ON if user has NOT been told about last bad password  */
		    4 pads	 bit (27) unal,
		  3 n_good_pw	 fixed bin,	/* Number of good passwords */
		  3 n_bad_pw	 fixed bin,	/* Number of wrong passwords */
		  3 n_bad_pw_since_good
				 fixed bin,	/* Number of wrong passwords since good */
		  3 time_last_good_pw
				 fixed bin (71),
		  3 time_last_bad_pw fixed bin (71),	/* When pw was last given wrong */
		  3 bad_pw_term_id	 character (4),	/* where bad password from */
		  3 bad_pw_line_type fixed bin (17),	/* ... */
		  3 bad_pw_term_type character (32),
		  3 time_pw_changed	 fixed bin (71),	/* When password was modified by user */
		  3 password_timelock
				 fixed bin (71),	/* Password is locked up until here */
		  3 person_authorization
				 bit (72),	/* authorization of this person */
		  3 default_person_authorization
				 bit (72),	/* default authorization of this person */
		  3 audit		 bit (36);	/* audit flags for person */

	dcl     1 pnte_v0_auto	 aligned like pnt_entry_v0 automatic;

/* The following copy is necessary because the entries in Version 1
   and Version 2 MSTBs are not necessarily on an even word boundary.
   Thus, the fixed bin (71) values in the pnt_entry structure would
   not always copy correctly. */

	pnte_v0_auto = pnte_v0;

/* copy the version 0 entry to our version 2 entry. */

	pnte_v2.version = PNT_ENTRY_VERSION_2;
	pnte_v2.private.pw_flags.short_pw = "1"b;	/* There weren't long ones */
	pnte_v2.private.pw_flags.short_network_pw = "1"b; /* ditto */
	pnte_v2.private.password = pnte_v0_auto.password;
	pnte_v2.private.network_password = pnte_v0_auto.card_password;
	pnte_v2.public.user_id = pnte_v0_auto.public.user_id;
	pnte_v2.public.alias = pnte_v0_auto.public.alias;
	pnte_v2.public.default_project = pnte_v0_auto.public.default_project;
	string (pnte_v2.public.flags) = string (pnte_v0_auto.public.flags);
	pnte_v2.public.n_good_pw = pnte_v0_auto.public.n_good_pw;
	pnte_v2.public.n_bad_pw = pnte_v0_auto.public.n_bad_pw;
	pnte_v2.public.n_bad_pw_since_good = pnte_v0_auto.public.n_bad_pw_since_good;
	pnte_v2.public.time_pw_changed = pnte_v0_auto.public.time_pw_changed;
	pnte_v2.public.time_last_good_pw = pnte_v0_auto.public.time_last_good_pw;
	pnte_v2.public.time_last_bad_pw = pnte_v0_auto.public.time_last_bad_pw;
	pnte_v2.public.bad_pw_term_id = pnte_v0_auto.public.bad_pw_term_id;

/**** The following code will prevent new PNTs from having an invalid 
      value in the bad_pw_line_type field.  Evidently, something didn't
      check this before and there are invalid numbers in these fields
      in existing V0 PNTs. */

	if pnte_v0_auto.public.bad_pw_line_type > max_line_type
	then pnte_v2.public.bad_pw_line_type = LINE_UNKNOWN;
	else pnte_v2.public.bad_pw_line_type = pnte_v0_auto.public.bad_pw_line_type;

	pnte_v2.public.bad_pw_term_type = pnte_v0_auto.public.bad_pw_term_type;
	pnte_v2.public.password_timelock = pnte_v0_auto.public.password_timelock;
	pnte_v2.public.default_person_authorization = pnte_v0_auto.public.default_person_authorization;
	pnte_v2.public.audit = pnte_v0_auto.public.audit;
	call convert_MR10_2_audit_flags_ (pnte_v2.public.audit);
	pnte_v2.pad (*) = ""b;			/* Zero out the pad area */


/* The authorization has become a range.  We set the minimum authorization
   to system_low for compatibility.  Note that we are assuming that
   system_low is represented by ""b.  If at some future time we support
   an access_class_floor, then this code should be changed to get the
   "real" system_low. */

	pnte_v2.public.person_authorization (1) = ""b;	/* system_low */
	pnte_v2.public.person_authorization (2) = pnte_v0_auto.public.person_authorization;
	return;

/* format: off */
%page; %include pnt_entry;
%page; %include line_types;
/* format: on */

     end convert_v2_pnt_;




		    pnt_db_interface_.pl1           03/14/85  0842.5rew 03/13/85  1028.5       99288



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

/* PNT_DB_INTERFACE_: This is one of two programs that are the target
   of PNT-related gates.  This program is primarily the gate-level
   interface to pnt_db_util_ which does the actual work of database
   related manipulations of PNTs.  Pnt_fs_interface_ is the gate-level
   interface to pnt_fs_util_ which does the actual work of file system
   related manipulations of the PNT.  

   This program, and pnt_fs_interface_, being the target of ring-1 gates,
   copy arguments, manipulate the validation level, and call supporting
   routines. 

   The only caller of these entrypoints through pnt_db_gate_ are
   callers of pnt_manager_ who manipulate only THE PNT (>sc1>PNT.pnt).
   Therefore, to spare them the agony and time of opening and closing
   the pnt, and maintaining and passing a pointer to it for each call,
   this program maintains a static pointer which it passes on each
   call to pnt_db_util_.  */

pnt_db_interface_:
     procedure ();

	return;					/* Not a valid entrypoint */

/* Written 1984-08-09 by E. Swenson.
   Modified 1985-01-25 by E. Swenson for auditing. 
*/

/* Parameters */

	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_num_entries	 fixed bin (35) parameter;
	dcl     P_password		 char (*) parameter;
	dcl     P_person_id		 char (*) parameter;
	dcl     P_pnt_entry_ptr	 ptr parameter;
	dcl     P_pnt_info_ptr	 ptr parameter;
	dcl     P_record_no		 fixed bin (35) parameter;
	dcl     P_set_network_password bit (1) parameter;
	dcl     P_set_password	 bit (1) parameter;
	dcl     P_short_password	 bit (1) parameter;

/* Automatic */

	dcl     code		 fixed bin (35);	/* status code */
	dcl     num_entries		 fixed bin (35);	/* for $table_data entrypoint */
	dcl     person_id		 char (32);
	dcl     password		 char (32);
	dcl     pnt_entry_ptr	 ptr;
	dcl     pnt_info_ptr	 ptr;
	dcl     record_no		 fixed bin (35);
	dcl     saved_level		 fixed bin (3);	/* saved validation level */
	dcl     set_network_password	 bit (1);
	dcl     set_password	 bit (1);
	dcl     short_password	 bit (1);

	dcl     1 pnt_entry_copy	 aligned like pnt_entry automatic;
	dcl     1 pnt_info_copy	 aligned like ms_table_info automatic;
						/* External Entries */

	dcl     get_ring_		 entry () returns (fixed bin (3));
	dcl     hcs_$level_get	 entry (fixed bin (3));
	dcl     hcs_$level_set	 entry (fixed bin (3));
	dcl     pnt_db_util_$add_entry entry (ptr, bit (1) aligned, char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$admin_get_entry
				 entry (ptr, bit (1) aligned, char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$close	 entry (ptr, bit (1) aligned, fixed bin (35));
	dcl     pnt_db_util_$get_abs_entry
				 entry (ptr, bit (1) aligned, fixed bin (35), ptr, fixed bin (35));
	dcl     pnt_db_util_$get_network_password
				 entry (ptr, bit (1) aligned, char (*), char (*), bit (1), fixed bin (35));
	dcl     pnt_db_util_$login_get_entry
				 entry (ptr, bit (1) aligned, char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$network_get_entry
				 entry (ptr, bit (1) aligned, char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$open	 entry (char (*), char (*), bit (1) aligned, ptr, fixed bin (35));
	dcl     pnt_db_util_$priv_get_abs_entry
				 entry (ptr, bit (1) aligned, fixed bin (35), ptr, fixed bin (35));
	dcl     pnt_db_util_$priv_get_entry
				 entry (ptr, bit (1) aligned, char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$remove_entry
				 entry (ptr, bit (1) aligned, char (*), fixed bin (35));
	dcl     pnt_db_util_$table_data
				 entry (ptr, bit (1) aligned, ptr, fixed bin (35), fixed bin (35));
	dcl     pnt_db_util_$update_entry
				 entry (ptr, bit (1) aligned, ptr, bit (1), bit (1), fixed bin (35));
	dcl     pnt_db_util_$validate_entry
				 entry (ptr, bit (1) aligned, char (*), fixed bin (35));


/* Static */

	dcl     initialized		 bit (1) internal static initial ("0"b);
	dcl     pnt_ptr		 ptr internal static initial (null ());

/* Constant */

	dcl     DO_AUDIT		 bit (1) aligned initial ("1"b) internal static options (constant);
	dcl     PNT_DIRNAME		 char (168) internal static options (constant) initial (">system_control_1");
	dcl     PNT_ENTRYNAME	 char (32) internal static options (constant) initial ("PNT.pnt");

/* Conditions */

	declare cleanup		 condition;
%page;
get_abs_entry:
     entry (P_record_no, P_pnt_entry_ptr, P_code);

	record_no = P_record_no;
	pnt_entry_ptr = P_pnt_entry_ptr;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$get_abs_entry (pnt_ptr, DO_AUDIT, record_no, addr (pnt_entry_copy), code);

	pnt_entry_ptr -> pnt_entry = pnt_entry_copy;
	goto RETURN_TO_CALLER;
%page;
priv_get_abs_entry:
     entry (P_record_no, P_pnt_entry_ptr, P_code);

	record_no = P_record_no;
	pnt_entry_ptr = P_pnt_entry_ptr;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$priv_get_abs_entry (pnt_ptr, DO_AUDIT, record_no, addr (pnt_entry_copy), code);

	pnt_entry_ptr -> pnt_entry = pnt_entry_copy;
	goto RETURN_TO_CALLER;
%page;
admin_get_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	person_id = P_person_id;
	pnt_entry_ptr = P_pnt_entry_ptr;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$admin_get_entry (pnt_ptr, DO_AUDIT, person_id, addr (pnt_entry_copy), code);

	pnt_entry_ptr -> pnt_entry = pnt_entry_copy;
	goto RETURN_TO_CALLER;
%page;
login_get_entry:
     entry (P_person_id, P_password, P_pnt_entry_ptr, P_code);

	person_id = P_person_id;
	password = P_password;
	pnt_entry_ptr = P_pnt_entry_ptr;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$login_get_entry (pnt_ptr, DO_AUDIT, person_id, password, addr (pnt_entry_copy), code);

	pnt_entry_ptr -> pnt_entry = pnt_entry_copy;
	goto RETURN_TO_CALLER;
%page;
network_get_entry:
     entry (P_person_id, P_password, P_pnt_entry_ptr, P_code);

	person_id = P_person_id;
	password = P_password;
	pnt_entry_ptr = P_pnt_entry_ptr;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$network_get_entry (pnt_ptr, DO_AUDIT, person_id, password, addr (pnt_entry_copy), code);

	pnt_entry_ptr -> pnt_entry = pnt_entry_copy;
	goto RETURN_TO_CALLER;
%page;
priv_get_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	person_id = P_person_id;
	pnt_entry_ptr = P_pnt_entry_ptr;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$priv_get_entry (pnt_ptr, DO_AUDIT, person_id, addr (pnt_entry_copy), code);

	pnt_entry_ptr -> pnt_entry = pnt_entry_copy;
	goto RETURN_TO_CALLER;
%page;
get_network_password:
     entry (P_person_id, P_password, P_short_password, P_code);

	person_id = P_person_id;

	password = "";
	short_password = "0"b;
	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$get_network_password (pnt_ptr, DO_AUDIT, person_id, password, short_password, code);

	P_password = password;
	P_short_password = short_password;
	goto RETURN_TO_CALLER;
%page;
update_entry:
     entry (P_pnt_entry_ptr, P_set_password, P_set_network_password, P_code);

	pnt_entry_ptr = P_pnt_entry_ptr;
	set_password = P_set_password;
	set_network_password = P_set_network_password;

	pnt_entry_copy = pnt_entry_ptr -> pnt_entry;	/* Copy whole structure */

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$update_entry (pnt_ptr, DO_AUDIT, addr (pnt_entry_copy), set_password, set_network_password,
	     code);

	goto RETURN_TO_CALLER;
%page;
add_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	person_id = P_person_id;
	pnt_entry_ptr = P_pnt_entry_ptr;		/* Copy the pointer */

	pnt_entry_copy = pnt_entry_ptr -> pnt_entry;	/* And the entire structure */

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$add_entry (pnt_ptr, DO_AUDIT, person_id, addr (pnt_entry_copy), code);

	goto RETURN_TO_CALLER;
%page;
remove_entry:
     entry (P_person_id, P_code);

	person_id = P_person_id;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$remove_entry (pnt_ptr, DO_AUDIT, person_id, code);

	goto RETURN_TO_CALLER;
%page;
table_data:
     entry (P_pnt_info_ptr, P_num_entries, P_code);

	pnt_info_ptr = P_pnt_info_ptr;
	num_entries = 0;
	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level;

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$table_data (pnt_ptr, DO_AUDIT, addr (pnt_info_copy), num_entries, code);
	pnt_info_ptr -> ms_table_info = pnt_info_copy;
	P_num_entries = num_entries;

	goto RETURN_TO_CALLER;
%page;
validate_entry:
     entry (P_person_id, P_code);

	person_id = P_person_id;

	code = 0;

	saved_level = -1;
	on condition (cleanup) call reset_level ();
	call set_level ();

	if ^initialized
	then call INITIALIZE ();

	call pnt_db_util_$validate_entry (pnt_ptr, DO_AUDIT, person_id, code);
	goto RETURN_TO_CALLER;
%page;
/* Global return point */

RETURN_TO_CALLER:
	call reset_level ();
	P_code = code;
	return;
%page;
/* Internal Procedures */
INITIALIZE:
     procedure ();

	code = 0;
	call pnt_db_util_$open (PNT_DIRNAME, PNT_ENTRYNAME, DO_AUDIT, pnt_ptr, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	initialized = "1"b;
	return;
     end INITIALIZE;
%page;
reset_level:
     procedure ();

/* This procedure resets the validation level, it it was previously
   set by calling entry. */

	if saved_level ^= -1
	then do;
		call hcs_$level_set (saved_level);
		saved_level = -1;
	     end;
	return;
     end reset_level;
%page;
set_level:
     procedure ();

/* This procedure gets the current validation level and saves it away in
   saved_level.  It then sets the validation level to the PNT level (1). */

	call hcs_$level_get (saved_level);
	call hcs_$level_set (get_ring_ ());
	return;
     end set_level;

/* format: off */
%page;%include ms_table_info;
%page;%include pnt_entry;
/* format: on */

     end pnt_db_interface_;




		    pnt_db_util_.pl1                05/09/85  1154.7rew 05/07/85  1549.7      279495



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

/* PNT_DB_UTIL_: This program supports the database interfaces to PNTs.
   It assumes its caller is in the inner ring and trusts the PNT ptr
   (not really a pointer to the PNT, but to the descriptor for the PNT).
   It does no parameter copying or validation level manipulations (this
   is the responsibility of pnt_db_interface_.  It makes no assumptions
   about THE PNT (>sc1>PNT.pnt) and accepts pathnames to open and close
   the PNT and PNT ptrs to perform other manipulations on PNTs. */

pnt_db_util_:
     procedure ();

	return;

/* Written 1984-08-09 by E. Swenson
   Modification history:
   1985-01-25 by E. Swenson to add auditing of PNT changes.
*/

/* Parameters */

	dcl     P_audit_flag	 bit (1) aligned parameter;
						/* whether to audit or not */
	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_pnt_info_ptr	 ptr parameter;
	dcl     P_dirname		 char (*) parameter;
	dcl     P_entryname		 char (*) parameter;
	dcl     P_num_entries	 fixed bin (35) parameter;
	dcl     P_password		 char (*) parameter;
	dcl     P_person_id		 char (*) parameter;
	dcl     P_pnt_entry_ptr	 ptr parameter;
	dcl     P_pnt_ptr		 ptr parameter;
	dcl     P_record_no		 fixed bin (35) parameter;
	dcl     P_set_password	 bit (1) aligned parameter;
	dcl     P_set_network_password bit (1) aligned parameter;
	dcl     P_short_password	 bit (1) aligned parameter;

/* Automatic */

	dcl     audit_flag		 bit (1) aligned;	/* whether to audit or not */
	dcl     brief_description	 char (256) varying;/* brief description of modifications */
	dcl     code		 fixed bin (35);
	dcl     1 event_flags	 aligned like audit_event_flags automatic;
	dcl     key		 char (32);	/* Key used by ms_table_mgr_ for hashing */
	dcl     notify_as		 bit (1) aligned;	/* whether to notify A.S. of PNT change */
	dcl     operation_code	 bit (36) aligned;	/* access_operations_ code */
	dcl     1 PAR		 aligned like pnt_audit_record automatic;
	dcl     pnt_entry_ptr	 ptr;		/* Copy of caller-supplied pnt entry ptr */
	dcl     pnt_ptr		 ptr;		/* Copy of caller supplied pnt tag. */
	dcl     tcode		 fixed bin (35);	/* Temporary status code for alias processing */

	dcl     1 local_pnt_entry	 aligned like pnt_entry automatic;

/* Based */

	dcl     1 new_pnt_entry	 aligned like pnt_entry based (pnt_entry_ptr);

/* External Entries */

	dcl     access_audit_r1_$check_general
				 entry (bit (36) aligned, bit (36) aligned) returns (bit (1) aligned);
	dcl     access_audit_r1_$log_general
				 entry options (variable);
	dcl     hcs_$level_get	 entry (fixed bin (3));
	dcl     ms_table_mgr_$abs_entry
				 entry (ptr, fixed bin (35), char (*), bit (1) aligned, ptr, fixed bin (35),
				 fixed bin (35));
	dcl     ms_table_mgr_$close	 entry (ptr, fixed bin (35));
	dcl     ms_table_mgr_$delete_entry
				 entry (ptr, char (*), fixed bin (35));
	dcl     ms_table_mgr_$delete_entry_ignore_mylock
				 entry (ptr, char (*), fixed bin (35));
	dcl     ms_table_mgr_$find_entry
				 entry (ptr, char (*), ptr, bit (1) aligned, fixed bin (35), fixed bin (35));
	dcl     ms_table_mgr_$get_change_clock
				 entry (ptr, fixed bin (35), fixed bin (35));
	dcl     ms_table_mgr_$new_entry
				 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     ms_table_mgr_$new_entry_ignore_mylock
				 entry (ptr, char (*), ptr, fixed bin (35));
	dcl     ms_table_mgr_$open	 entry (char (*), char (*), char (*) aligned, ptr, ptr, fixed bin (35));
	dcl     ms_table_mgr_$table_data
				 entry (ptr, ptr, ptr, fixed bin (35), fixed bin (35));
	dcl     ms_table_mgr_$unlock	 entry (ptr, fixed bin (35));
	dcl     ms_table_mgr_$update_entry
				 entry (ptr, ptr, fixed bin (35));
	dcl     ms_table_mgr_$update_entry_dont_unlock
				 entry (ptr, ptr, fixed bin (35));
	dcl     pnt_notify_as_	 entry (char (*), fixed bin (35));

/* External Static */

	dcl     access_operations_$pnt_entry_add
				 bit (36) aligned external;
	dcl     access_operations_$pnt_entry_admin_read
				 bit (36) aligned external;
	dcl     access_operations_$pnt_entry_delete
				 bit (36) aligned external;
	dcl     access_operations_$pnt_entry_login_read
				 bit (36) aligned external;
	dcl     access_operations_$pnt_entry_modify
				 bit (36) aligned external;
	dcl     access_operations_$pnt_entry_network_read
				 bit (36) aligned external;
	dcl     access_operations_$pnt_entry_priv_read
				 bit (36) aligned external;
	dcl     error_table_$bad_arg	 fixed bin (35) external static;
	dcl     error_table_$bad_password
				 fixed bin (35) external static;
	dcl     error_table_$checksum_failure
				 fixed bin (35) external static;
	dcl     error_table_$no_record fixed bin (35) external static;
	dcl     error_table_$unimplemented_version
				 fixed bin (35) external static;

/* Constant */

	dcl     ME		 char (32) initial ("pnt_db_util_") internal static options (constant);

	dcl     RING_1		 fixed bin (3) initial (1) internal static options (constant);

	dcl     (
	        ADD		 initial (1),
	        DELETE		 initial (2),
	        MODIFY		 initial (3),
	        ADMIN_READ		 initial (4),
	        PRIV_READ		 initial (5),
	        NETWORK_READ	 initial (6),
	        LOGIN_READ		 initial (7)
	        )			 fixed bin (17) internal static options (constant);

/* Builtin */

	dcl     addr		 builtin;
	dcl     null		 builtin;
	dcl     size		 builtin;
	dcl     string		 builtin;
	dcl     substr		 builtin;
	dcl     unspec		 builtin;
%page;
/* Program */
/* * * * * * * * * * OPEN * * * * * * * * * * * * * */
open:
     entry (P_dirname, P_entryname, P_audit_flag, P_pnt_ptr, P_code);

/**** This entry opens the specified PNT.  At present, we do no 
      auditing for PNT opens and closes and rely on the actual
      retrieve/updtate entries for auditing.  The audit flag for this
      entry is ignored, but available for future use.
****/

	audit_flag = P_audit_flag;
	P_code = 0;
	call ms_table_mgr_$open (P_dirname, P_entryname, "PNT", P_pnt_ptr, (null ()), code);
	goto RETURN_TO_CALLER;
%page;
/* * * * * * * * * * CLOSE * * * * * * * * * */
close:
     entry (P_pnt_ptr, P_audit_flag, P_code);

/**** This entry closes the specified PNT.  At present we do no auditing
      of PNT opens and closes, but rely on the retrieve/update entries to
      perform auditing.  The ignored audit_flag is for possible future use
      if required. */

	audit_flag = P_audit_flag;
	P_code = 0;
	call ms_table_mgr_$close (P_pnt_ptr, code);
	goto RETURN_TO_CALLER;
%page;
/* * * * * * * * * * GET_ABS_ENTRY * * * * * * * * * */

/**** This entrypoint returns an arbitrary entry in the PNT,
      identified by record number. It does not return passwords.
      On a checksum failure, it returns the error code, since
      none of the data is very trustworthy.
      */

get_abs_entry:
     entry (P_pnt_ptr, P_audit_flag, P_record_no, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call get_local_entry (P_record_no, key, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

/**** Don't return alias entries */

	if local_pnt_entry.user_id ^= key
	then do;					/* alias */
		code = error_table_$no_record;
		goto RETURN_TO_CALLER;
	     end;

	local_pnt_entry.password, local_pnt_entry.network_password = "";
	local_pnt_entry.short_pw, local_pnt_entry.short_network_pw = "0"b;
	P_pnt_entry_ptr -> pnt_entry = local_pnt_entry;
	call AUDIT_READ (ADMIN_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * PRIV_GET_ABS_ENTRY * * * * * * * * */

/**** This entrypoint returns an arbitrary entry, including passwords.
      It treats checksum failures like get_abs_entry. */

priv_get_abs_entry:
     entry (P_pnt_ptr, P_audit_flag, P_record_no, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call get_local_entry (P_record_no, key, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

/**** Don't return alias entries */

	if local_pnt_entry.user_id ^= key
	then do;					/* alias */
		code = error_table_$no_record;
		goto RETURN_TO_CALLER;
	     end;

	P_pnt_entry_ptr -> pnt_entry = local_pnt_entry;
	call AUDIT_READ (PRIV_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * ADMIN_GET_ENTRY * * * * * * * * * */

/**** This entrypoint takes a user name and returns the entry.
      It will return data in spite of a checksum failure,
      but it returns the error code as well. It returns
      no passwords. If the checksum is on the alias, though, 
      we have to give up (and return no-entry). */

admin_get_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call find_local_entry (P_person_id, code);
	if code ^= 0 & code ^= error_table_$checksum_failure
	then go to RETURN_TO_CALLER;

	local_pnt_entry.password, local_pnt_entry.network_password = "";
	local_pnt_entry.short_pw, local_pnt_entry.short_network_pw = "0"b;

	P_pnt_entry_ptr -> pnt_entry = local_pnt_entry;
	call AUDIT_READ (ADMIN_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * LOGIN_GET_ENTRY * * * * * * * * * */

/**** This entrypoint takes a user name and a password,
and returns the entry (with passwords blanked).
The incoming password must be scrambled, to encourage early scrambling.
This entrypoint will return entry checksum errors
to the user, and NOT return the entry. 

Note that we have to return the entry even on bad password,
so that the answering service can continue to maintain all
the last bad password garbage. This should be changed. */

login_get_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_password, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call find_local_entry (P_person_id, code);
	if code ^= 0
	then go to RETURN_TO_CALLER;			/* checksum errors and all */

/**** Note that we return the error code error_table_$bad_password if
      either there is no password for this entry, or if the password
      was incorrectly specified.  We return the entry anyway since the
      answering service must be able to update the bad password info. */

	if ^pnt_entry.flags.has_password
	then code = error_table_$bad_password;
	else if (local_pnt_entry.short_pw & (substr (P_password, 1, 8) ^= substr (local_pnt_entry.password, 1, 8)))
	     | (^local_pnt_entry.short_pw & (P_password ^= pnt_entry.password))
	then code = error_table_$bad_password;

	local_pnt_entry.password, local_pnt_entry.network_password = "";
	local_pnt_entry.short_pw, local_pnt_entry.short_network_pw = "0"b;
	P_pnt_entry_ptr -> pnt_entry = local_pnt_entry;
	call AUDIT_READ (LOGIN_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * NETWORK_GET_ENTRY * * * * * * * * * */

/**** This entry is just like the one above, save that it
      works with the network password. */

network_get_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_password, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call find_local_entry (P_person_id, code);	/* does alias processing */
	if code ^= 0
	then go to RETURN_TO_CALLER;			/* checksum errors and all */

	if ^local_pnt_entry.flags.has_network_password
	then do;
		code = error_table_$bad_password;	/* no_password? */
		go to RETURN_TO_CALLER;
	     end;

	if (local_pnt_entry.short_network_pw
	     & (substr (P_password, 1, 8) ^= substr (local_pnt_entry.network_password, 1, 8)))
	     | (^local_pnt_entry.short_network_pw & (P_password ^= local_pnt_entry.network_password))
	then do;
		code = error_table_$bad_password;
		go to RETURN_TO_CALLER;
	     end;

	local_pnt_entry.password, local_pnt_entry.network_password = "";
	local_pnt_entry.short_pw, local_pnt_entry.short_network_pw = "0"b;
	P_pnt_entry_ptr -> pnt_entry = local_pnt_entry;
	call AUDIT_READ (NETWORK_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * PRIV_GET_ENTRY * * * * * * * * * */

/**** This entrypoint returns the entire text of the entry, including
      the passwords! */

priv_get_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call find_local_entry (P_person_id, code);
	if code ^= 0 & code ^= error_table_$checksum_failure
	then go to RETURN_TO_CALLER;

	P_pnt_entry_ptr -> pnt_entry = local_pnt_entry;
	call AUDIT_READ (PRIV_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * GET_NETWORK_PASSWORD * * * * * * * * * */

/**** This entrypoint returns the network password (encrypted)
      for a specified user. Why do we have this? Because there
      are applications that have to transmit the network password
      out over networks. Obviously, access to this entrypoint must 
      be handed out very sparingly (though not as sparingly as 
      priv_get_entry).  This entry returns error_table_$bad_password
      if there is no network password associated with the supplied
      person_id. */

get_network_password:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_password, P_short_password, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call find_local_entry (P_person_id, code);
	if code ^= 0
	then go to RETURN_TO_CALLER;

	if local_pnt_entry.public.flags.has_network_password
	then do;
		P_password = local_pnt_entry.network_password;
		P_short_password = local_pnt_entry.short_network_pw;
	     end;
	else do;
		P_password = "";
		P_short_password = "0"b;
		code = error_table_$bad_password;
	     end;
	call AUDIT_READ (NETWORK_READ);
	go to RETURN_TO_CALLER;
%page;
/* * * * * * * * * * UPDATE_ENTRY * * * * * * * * * */

/**** This entry replaces an entry with a new copy. All 
      data is copied, but passwords are handled specially as per
      parameters. However, the has_X_password flags overrule 
      the P_set_password parameters. */

update_entry:
     entry (P_pnt_ptr, P_audit_flag, P_pnt_entry_ptr, P_set_password, P_set_network_password, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	pnt_entry_ptr = P_pnt_entry_ptr;
	P_code = 0;
	if new_pnt_entry.version ^= PNT_ENTRY_VERSION_2
	then do;
		code = error_table_$unimplemented_version;
		go to RETURN_TO_CALLER;
	     end;

	if new_pnt_entry.alias ^= "" & new_pnt_entry.alias = new_pnt_entry.user_id
	then do;
		code = error_table_$bad_arg;
		goto RETURN_TO_CALLER;
	     end;

	call find_update_entry ((new_pnt_entry.user_id), code);
	if code = error_table_$checksum_failure
	then code = 0;

	if code ^= 0
	then go to RETURN_TO_CALLER;

	if audit_flag
	then do;
		call AUDIT_CHECK (MODIFY, audit_flag);
		if audit_flag
		then call AUDIT_SETUP (MODIFY);
		else ;
	     end;
	else ;

	notify_as = CHECK_FOR_AS_NOTIFICATION ();

	if pnt_entry.alias ^= new_pnt_entry.alias
	then do;
		if new_pnt_entry.alias ^= ""
		then do;
			call add_alias (addr (new_pnt_entry), tcode);
			if tcode ^= 0
			then do;			/* put it back */
				call replace_entry (code);
				if code = 0
				then code = tcode;
				goto RETURN_TO_CALLER;
			     end;
		     end;
		if pnt_entry.alias ^= ""
		then call delete_alias (pnt_entry.alias, (0));
	     end;

	pnt_entry.public = new_pnt_entry.public;
	if P_set_password & new_pnt_entry.has_password
	then do;
		pnt_entry.password = new_pnt_entry.password;
		pnt_entry.short_pw = new_pnt_entry.short_pw;
	     end;
	if P_set_network_password & new_pnt_entry.has_network_password
	then do;
		pnt_entry.network_password = new_pnt_entry.network_password;
		pnt_entry.short_network_pw = new_pnt_entry.short_network_pw;
	     end;
	if P_set_password & ^new_pnt_entry.has_password
	then pnt_entry.password = "";
	if P_set_network_password & ^new_pnt_entry.has_network_password
	then pnt_entry.network_password = "";

	call replace_entry (code);
	if code = 0
	then do;
		if audit_flag
		then call AUDIT (MODIFY);
		if notify_as
		then call pnt_notify_as_ ((new_pnt_entry.user_id), (0));
	     end;

	goto RETURN_TO_CALLER;
%page;
/* * * * * * * * * * ADD_ENTRY * * * * * * * * * */

/**** Adds a brand-new entry to our table. */

add_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_pnt_entry_ptr, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	local_pnt_entry = P_pnt_entry_ptr -> pnt_entry;

	if local_pnt_entry.version ^= PNT_ENTRY_VERSION_2
	then do;
		code = error_table_$unimplemented_version;
		go to RETURN_TO_CALLER;
	     end;

	call ms_table_mgr_$new_entry (P_pnt_ptr, P_person_id, pntep, code);
	if code ^= 0
	then goto RETURN_TO_CALLER;

	if audit_flag
	then do;
		call AUDIT_CHECK (ADD, audit_flag);
		if audit_flag
		then call AUDIT_SETUP (ADD);
		else ;
	     end;
	else ;

	pnt_entry = local_pnt_entry;			/* the whole wazzo */
	call ms_table_mgr_$update_entry_dont_unlock (pnt_ptr, pntep, P_code);
	if P_code ^= 0
	then do;
		call ms_table_mgr_$unlock (pnt_ptr, (0));
		go to RETURN_TO_CALLER;
	     end;

	if local_pnt_entry.alias ^= ""
	then do;
		call add_alias (addr (local_pnt_entry), code);
		if code ^= 0
		then do;
			call ms_table_mgr_$delete_entry (P_pnt_ptr, (local_pnt_entry.user_id), (0));
						/* make it go away */
			goto RETURN_TO_CALLER;
		     end;
	     end;
	else call ms_table_mgr_$unlock (pnt_ptr, (0));

	if audit_flag
	then call AUDIT (ADD);

	goto RETURN_TO_CALLER;
%page;
/* * * * * * * * * * REMOVE_ENTRY * * * * * * * * * */

/**** Remove a user from the PNT */

remove_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;
	call find_local_entry (P_person_id, code);	/* no need to write-lock yet */
	if code = error_table_$checksum_failure
	then code = 0;

	if code ^= 0
	then go to RETURN_TO_CALLER;

	if audit_flag
	then do;
		call AUDIT_CHECK (DELETE, audit_flag);
		if audit_flag
		then call AUDIT_SETUP (DELETE);
		else ;
	     end;
	else ;

	if pnt_entry.alias ^= ""
	then call delete_alias (pnt_entry.alias, (0));	/* failure will log */
	call ms_table_mgr_$delete_entry (P_pnt_ptr, P_person_id, code);

	if code = 0
	then do;
		if audit_flag
		then call AUDIT (DELETE);
		call pnt_notify_as_ (P_person_id, (0));
	     end;

	goto RETURN_TO_CALLER;
%page;
table_data:
     entry (P_pnt_ptr, P_audit_flag, P_pnt_info_ptr, P_num_entries, P_code);

	audit_flag = P_audit_flag;
	call ms_table_mgr_$table_data (P_pnt_ptr, P_pnt_info_ptr, (null ()), P_num_entries, P_code);
	return;
%page;
/* * * * * * * * * * VALIDATE_ENTRY * * * * * * * * * */

/**** This entrypoint, given a user_id validates that the entry exists.
      No password checking is done.  This entrypoint is used by IMFT
      to validate the a user is registered on the system. */

validate_entry:
     entry (P_pnt_ptr, P_audit_flag, P_person_id, P_code);

	pnt_ptr = P_pnt_ptr;
	audit_flag = P_audit_flag;
	P_code = 0;

	call find_local_entry (P_person_id, code);
	if code = error_table_$checksum_failure
	then code = 0;
	go to RETURN_TO_CALLER;
%page;
/* Global return point */

RETURN_TO_CALLER:
	P_code = code;
	return;
%page;
/* Internal Procedures */

find_local_entry:
     procedure (P_name, P_code);

	declare P_name		 char (*) parameter;
	declare P_code		 fixed bin (35) parameter;
	declare name		 char (32);
	declare change_clock	 fixed bin (35);
	declare new_change_clock	 fixed bin (35);

	P_code = 0;
	name = P_name;

find_again:
	call ms_table_mgr_$find_entry (pnt_ptr, name, pntep, "0"b, change_clock, P_code);
	if pntep = null ()
	then return;

	local_pnt_entry = pnt_entry;
	call ms_table_mgr_$get_change_clock (pnt_ptr, new_change_clock, P_code);
	if P_code ^= 0
	then return;

	if change_clock ^= new_change_clock
	then go to find_again;

	if name ^= pnt_entry.user_id
	then do;					/* aliasing */
		name = pnt_entry.user_id;
		goto find_again;
	     end;

     end find_local_entry;
%page;
find_update_entry:
     procedure (P_name, P_code);

	dcl     P_name		 char (*) parameter;
	declare name		 char (32);
	declare P_code		 fixed bin (35) parameter;
	declare change_clock	 fixed bin (35);
	declare new_change_clock	 fixed bin (35);

	P_code = 0;
	name = P_name;

find_again:
	call ms_table_mgr_$find_entry (pnt_ptr, name, pntep, "0"b, change_clock, P_code);
	if pntep = null ()
	then return;

	local_pnt_entry = pnt_entry;

	call ms_table_mgr_$get_change_clock (pnt_ptr, new_change_clock, P_code);
	if P_code ^= 0
	then return;

	if change_clock ^= new_change_clock
	then go to find_again;

	if name ^= pnt_entry.user_id
	then do;					/* aliasing */
		name = pnt_entry.user_id;
		goto find_again;
	     end;

	/*** now we have the right name */
	call ms_table_mgr_$find_entry (pnt_ptr, name, pntep, "1"b, (0), P_code);
						/* so get it under the lock */
	return;
     end find_update_entry;
%page;
add_alias:
     procedure (P_entry_ptr, P_code);

	dcl     P_entry_ptr		 ptr parameter;
	dcl     P_code		 fixed bin (35) parameter;

	dcl     pep		 pointer;

	call ms_table_mgr_$new_entry_ignore_mylock (pnt_ptr, (P_entry_ptr -> pnt_entry.alias), pep, P_code);
	if P_code ^= 0
	then return;

	pep -> pnt_entry = P_entry_ptr -> pnt_entry;
	call ms_table_mgr_$update_entry (pnt_ptr, pep, P_code);
	return;
     end add_alias;
%page;
delete_alias:
     procedure (P_alias, P_code);

	dcl     P_alias		 char (8) aligned parameter;
	dcl     P_code		 fixed bin (35) parameter;

	call ms_table_mgr_$delete_entry_ignore_mylock (pnt_ptr, (P_alias), P_code);
     end delete_alias;
%page;
replace_entry:
     procedure (P_code);

	declare P_code		 fixed bin (35);

	call ms_table_mgr_$update_entry (pnt_ptr, pntep, P_code);
	if P_code ^= 0
	then call ms_table_mgr_$unlock (pnt_ptr, (0));
	return;
     end replace_entry;
%page;
get_local_entry:
     procedure (P_record, P_name, P_code);

	dcl     P_record		 fixed bin (35) parameter;
	dcl     P_name		 char (*) parameter;
	dcl     P_code		 fixed bin (35) parameter;

	dcl     (change_clock, new_change_clock)
				 fixed bin (35);

get_again:
	call ms_table_mgr_$abs_entry (pnt_ptr, P_record, P_name, "0"b, pntep, change_clock, P_code);
	if P_code ^= 0 & P_code ^= error_table_$checksum_failure
	then return;

	local_pnt_entry = pnt_entry;
	call ms_table_mgr_$get_change_clock (pnt_ptr, new_change_clock, P_code);
	if P_code ^= 0
	then return;

	if change_clock ^= new_change_clock
	then go to get_again;

	return;
     end get_local_entry;
%page;
AUDIT_CHECK:
     procedure (P_operation, P_audit_flag);

/**** This entry decides whether we are to audit at all.  It calls
      access_audit_r1_ to make this decision, based on the operation */

	dcl     P_operation		 fixed bin (17) parameter;
						/* kind of operation */
	dcl     P_audit_flag	 bit (1) aligned parameter;
						/* whether to audit */
	dcl     validation_level	 fixed bin (3) automatic;
						/* user's level */

	call hcs_$level_get (validation_level);
	if validation_level ^= RING_1
	then do;
		P_audit_flag = "0"b;		/* turn auditing off */
		return;				/* can't call access_audit_r1_ except in ring 1 */
	     end;

	operation_code = ""b;			/* initialize, so we can check later */

	if P_operation = ADD
	then operation_code = access_operations_$pnt_entry_add;
	else if P_operation = DELETE
	then operation_code = access_operations_$pnt_entry_delete;
	else if P_operation = MODIFY
	then operation_code = access_operations_$pnt_entry_modify;
	else if P_operation = ADMIN_READ
	then operation_code = access_operations_$pnt_entry_admin_read;
	else if P_operation = PRIV_READ
	then operation_code = access_operations_$pnt_entry_priv_read;
	else if P_operation = NETWORK_READ
	then operation_code = access_operations_$pnt_entry_network_read;
	else if P_operation = LOGIN_READ
	then operation_code = access_operations_$pnt_entry_login_read;

	if operation_code ^= ""b			/* have we set it? */
	then do;

		unspec (event_flags) = ""b;
		event_flags.grant = "1"b;
		event_flags.admin_op = "1"b;

		P_audit_flag = access_audit_r1_$check_general (unspec (event_flags), operation_code);
	     end;
	else P_audit_flag = "0"b;			/* no auditing */
	return;
     end AUDIT_CHECK;
%page;
AUDIT_SETUP:
     procedure (P_operation);

	dcl     P_operation		 fixed bin (17) parameter;
						/* what kind of operation */

	PAR.type = AAB_pnt_entry;
	PAR.version = PNT_AUDIT_RECORD_VERSION_1;
	PAR.pad1 = ""b;
	string (PAR.flags) = ""b;

	if P_operation = ADD
	then do;
		PAR.flags.add = "1"b;
		PAR.user_id = P_person_id;
		call FILL_PNT_AUDIT_ENTRY (addr (PAR.pnt_entry_1), addr (local_pnt_entry));
	     end;
	else if P_operation = DELETE
	then do;
		PAR.flags.delete = "1"b;
		PAR.user_id = pnt_entry.user_id;
		call FILL_PNT_AUDIT_ENTRY (addr (PAR.pnt_entry_1), addr (local_pnt_entry));
	     end;
	else if P_operation = MODIFY
	then do;
		PAR.flags.modify = "1"b;
		PAR.user_id = new_pnt_entry.user_id;
		call FILL_PNT_AUDIT_ENTRY (addr (PAR.pnt_entry_1), addr (local_pnt_entry));
		call FILL_PNT_AUDIT_ENTRY (addr (PAR.pnt_entry_2), addr (new_pnt_entry));
		if (pnt_entry.password ^= new_pnt_entry.password) & P_set_password
		then PAR.flags.password_changed = "1"b;
		if (pnt_entry.network_password ^= new_pnt_entry.network_password) & P_set_network_password
		then PAR.flags.network_password_changed = "1"b;
		call SETUP_BRIEF_DESCRIPTION ();

	     end;
	else audit_flag = "0"b;			/* can't audit if we don't know op */

	return;
     end AUDIT_SETUP;
%page;
FILL_PNT_AUDIT_ENTRY:
     procedure (P_paep, P_pntep);

/**** This procedure fills in the security-relevant information into the
      audit record from the specified pnt entry. */

	dcl     P_paep		 ptr parameter;	/* pointer to audit record pnt info */
	dcl     P_pntep		 ptr parameter;	/* pointer to PNT entry */

	P_paep -> pnt_audit_entry.flags = P_pntep -> pnt_entry.public.flags;
	P_paep -> pnt_audit_entry.alias = P_pntep -> pnt_entry.alias;
	P_paep -> pnt_audit_entry.authorization_range = P_pntep -> pnt_entry.person_authorization;
	P_paep -> pnt_audit_entry.password_timelock = P_pntep -> pnt_entry.password_timelock;
	P_paep -> pnt_audit_entry.audit_flags = P_pntep -> pnt_entry.audit;
	return;
     end FILL_PNT_AUDIT_ENTRY;
%page;
AUDIT:
     procedure (P_operation);

	dcl     P_operation		 fixed bin (17) parameter;
						/* type of operation */
	dcl     object_name		 char (50) automatic;
						/* name of object for access_audit_ */
	dcl     binary_info_size	 fixed bin (21) automatic;
						/* size of binary info */

	object_name = "PNT entry " || PAR.user_id;
	if P_operation = ADD | P_operation = DELETE
	then binary_info_size = size (PAR) - size (pnt_audit_entry) - 1;
	else binary_info_size = size (PAR);

	call access_audit_r1_$log_general (ME, RING_1, unspec (event_flags), operation_code, object_name, 0, addr (PAR),
	     binary_info_size, "^[Changed:^a^]", (P_operation = MODIFY), brief_description);

	return;
     end AUDIT;
%page;
CHECK_FOR_AS_NOTIFICATION:
     procedure () returns (bit (1) aligned);

/**** This internal procedure is used to check to see if the A.S. needs
      to be nofified of this PNT change.  For modifications of PNT entries,
      we notify the A.S. if the authorization range is made more restrictive
      of if the "lock" flags is set in a PNT entry.  For deletes of PNT
      entries, we always notify the answering service. */

	if ^local_pnt_entry.flags.lock & new_pnt_entry.flags.lock
	then return ("1"b);
	else if new_pnt_entry.person_authorization (2) < local_pnt_entry.person_authorization (2)
	then return ("1"b);
	else if new_pnt_entry.person_authorization (1) > local_pnt_entry.person_authorization (1)
	then return ("1"b);
	else ;
	return ("0"b);				/* no need to notify the answering service */

     end CHECK_FOR_AS_NOTIFICATION;
%page;
SETUP_BRIEF_DESCRIPTION:
     procedure ();

/**** This procedure is used to set up the additional information in the text 
      portion of a PNT audit record for PNT entry modifications.  This is
      a human readable summary of the changes to the PNT entry. */

	brief_description = "";
	if PAR.flags.password_changed
	then call ADD_STRING ("password");
	if PAR.flags.network_password_changed
	then call ADD_STRING ("network password");
	if unspec (PAR.pnt_entry_1.flags) ^= unspec (PAR.pnt_entry_2.flags)
	then call ADD_STRING ("flags");
	if PAR.pnt_entry_1.alias ^= PAR.pnt_entry_2.alias
	then call ADD_STRING ("alias");
	if PAR.pnt_entry_1.authorization_range (1) ^= PAR.pnt_entry_2.authorization_range (1)
	then call ADD_STRING ("min auth");
	if PAR.pnt_entry_1.authorization_range (2) ^= PAR.pnt_entry_2.authorization_range (2)
	then call ADD_STRING ("max auth");
	if PAR.pnt_entry_1.audit_flags ^= PAR.pnt_entry_2.audit_flags
	then call ADD_STRING ("audit flags");
	if PAR.pnt_entry_1.password_timelock ^= PAR.pnt_entry_2.password_timelock
	then call ADD_STRING ("password timelock");
	if brief_description = ""
	then brief_description = "nothing";
	return;


ADD_STRING:
     procedure (P_str_to_add);

	dcl     P_str_to_add	 char (*) parameter;/* an item that changed */

	if brief_description = ""
	then brief_description = P_str_to_add;
	else brief_description = brief_description || "," || P_str_to_add;

	return;
     end ADD_STRING;
     end SETUP_BRIEF_DESCRIPTION;			/* format: off */
%page;
AUDIT_READ:
     procedure (P_operation);

/**** This procedure is responsible for auditing PNT reads. */

dcl     P_operation		 fixed bin (17) parameter; /* what kind of operation */
dcl object_name char (50) automatic;

     call AUDIT_CHECK (P_operation, audit_flag);
     if audit_flag then do;
	object_name = "PNT entry " || local_pnt_entry.user_id;
	call access_audit_r1_$log_general (ME, RING_1, unspec (event_flags), operation_code, object_name, 0, null (), 0);   
	end;
     return;				      

end AUDIT_READ;
%page; %include access_audit_binary_def;
%page; %include access_audit_eventflags;
%page; %include pnt_audit_record;
%page; %include pnt_entry;
%page; %include pnt_header;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   AUDIT (pnt_db_util_): GRANTED addition of pnt entry (Admin_op) for PERSON.PROJECT.TAG (AUTH) Level=1 to PNT entry USERID (no access class).

   S:	$access_audit

   T:	$run

   M:	The user, PERSON.PROJECT.TAG, added a new PNT entry for USERID

   A:	$ignore


   Message:
   AUDIT (pnt_db_util_): GRANTED modification of pnt entry (Admin_op) for PERSON.PROJECT.TAG (AUTH) Level=1 to PNT entry USERID: CHANGES (no access class).

   S:	$access_audit

   T:	$run

   M:	The user PERSON.PROJECT.TAG modified the PNT entry for USERID. 
   CHANGES describes in brief format what security relevant changes were
   made.  See the binary information in the audit message for further
   details.
   
   A:	$ignore

   Message:
   AUDIT (pnt_db_util_): GRANTED deletion of pnt entry (Admin_op) for PERSON.PROJECT.TAG (AUTH) Level=1 to PNT entry USERID (no access class).

   S:	$access_audit

   T:	$run

   M:	The user PERSON.PROJECT.TAG deleted the PNT entry for USERID.
   
   A:	$ignore

   END MESSAGE DOCUMENTATION */

     end pnt_db_util_;




		    pnt_fs_interface_.pl1           12/05/84  1355.3rew 12/05/84  0925.9       72576



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

/* PNT_FS_INTERFACE_: This is one of two programs that are the target
   of PNT-related gates.  This program is primarily the gate-level
   interface to pnt_fs_util_ which does the actual work of file system
   related manipulations of PNTs.  Pnt_db_interface_ is the gate-level
   interface to pnt_db_util_ which does the actual work of database
   related manipulations of the PNT.  

   This program, and pnt_db_interface_, being the target of ring-1 gates,
   copy arguments, manipulate the validation level, and call supporting
   routines. */

pnt_fs_interface_:
     procedure ();

	return;					/* Not a valid entrypoint */

/**** Written 1984-07-18 by BIM */
/**** Rewritten 1984-07-25 by E. Swenson */

/* Parameters */

	dcl     P_acl_ptr		 ptr parameter;
	dcl     P_area_ptr		 ptr parameter;
	dcl     P_dirname		 char (*) parameter;
	dcl     P_desired_version	 char (*) parameter;
	dcl     P_entryname		 char (*) parameter;
	dcl     P_size		 fixed bin (35) parameter;
	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_old_entryname	 char (*) parameter;
	dcl     P_new_entryname	 char (*) parameter;
	dcl     P_no_sysdaemon	 bit (1) parameter;
	dcl     P_target_dirname	 char (*) parameter;
	dcl     P_target_entryname	 char (*) parameter;
	dcl     P_error_on_target	 bit (1) aligned parameter;

/* Automatic */

	dcl     acl_ptr		 ptr;		/* Pointer to the acl structures */
	dcl     area_ptr		 ptr;		/* Area in which to allocate the acl structures */
	dcl     code		 fixed bin (35);	/* status code */
	dcl     desired_version	 char (8);	/* Version passed to acl routines */
	dcl     dirname		 char (168);	/* PNT directory */
	dcl     entryname		 char (32);	/* PNT entryname */
	dcl     new_entryname	 char (32);	/* new name for chname */
	dcl     no_sysdaemon	 bit (1);		/* Whether or not to delete *.SysDaemon.* ACLs */
	dcl     old_entryname	 char (32);	/* old name for chname */
	dcl     size		 fixed bin (35);	/* PNT size */
	dcl     saved_level		 fixed bin (3);	/* saved validation level */
	dcl     target_dirname	 char (168);	/* For copy entrypoint */
	dcl     target_entryname	 char (32);	/* For copy entrypoint */
	dcl     error_on_target	 bit (1) aligned;	/* For copy; whether error is on target or not */

/* External Entries */

	dcl     get_ring_		 entry () returns (fixed bin (3));
	dcl     hcs_$level_get	 entry (fixed bin (3));
	dcl     hcs_$level_set	 entry (fixed bin (3));
	dcl     pnt_fs_util_$add_acl_entries
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_fs_util_$create	 entry (char (*), char (*), fixed bin (35), fixed bin (35));
	dcl     pnt_fs_util_$delete	 entry (char (*), char (*), fixed bin (35));
	dcl     pnt_fs_util_$delete_acl_entries
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_fs_util_$copy	 entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35));
	dcl     pnt_fs_util_$list_acl	 entry (char (*), char (*), char (*), ptr, ptr, fixed bin (35));
	dcl     pnt_fs_util_$replace_acl
				 entry (char (*), char (*), ptr, bit (1), fixed bin (35));
	declare pnt_fs_util_$chname_file
				 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     pnt_fs_util_$validate	 entry (char (*), char (*), fixed bin (35));

/* Conditions */

	declare cleanup		 condition;
%page;
create:
     entry (P_dirname, P_entryname, P_size, P_code);

/* This entry creates a PNT */

	code = 0;
	dirname = P_dirname;
	entryname = P_entryname;
	size = P_size;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$create (dirname, entryname, size, code);

	P_code = code;
	call reset_level;
	return;
%page;
delete:
     entry (P_dirname, P_entryname, P_code);

/* This entry deletes a PNT */

	code = 0;
	dirname = P_dirname;
	entryname = P_entryname;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$delete (dirname, entryname, code);

	P_code = code;
	call reset_level;
	return;
%page;
chname_file:
     entry (P_dirname, P_entryname, P_old_entryname, P_new_entryname, P_code);

/* This entry renames a PNT */

	code = 0;
	dirname = P_dirname;
	entryname = P_entryname;
	old_entryname = P_old_entryname;
	new_entryname = P_new_entryname;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$chname_file (dirname, entryname, old_entryname, new_entryname, code);

	P_code = code;
	call reset_level;
	return;
%page;
copy:
     entry (P_dirname, P_entryname, P_target_dirname, P_target_entryname, P_error_on_target, P_code);

	dirname = P_dirname;
	entryname = P_entryname;
	target_dirname = P_target_dirname;
	target_entryname = P_target_entryname;

	code = 0;
	error_on_target = "0"b;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$copy (dirname, entryname, target_dirname, target_entryname, error_on_target, code);

	P_error_on_target = error_on_target;
	P_code = code;
	call reset_level;
	return;
%page;
list_acl:
     entry (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);

	dirname = P_dirname;
	entryname = P_entryname;
	desired_version = P_desired_version;
	area_ptr = P_area_ptr;
	acl_ptr = P_acl_ptr;			/* can be input or output variable */

	code = 0;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$list_acl (dirname, entryname, desired_version, area_ptr, acl_ptr, code);

/**** Don't need to copy output structure here, since it was allocated
      in the user supplied area. */

	P_acl_ptr = acl_ptr;
	P_code = code;
	call reset_level;
	return;
%page;
add_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	dirname = P_dirname;
	entryname = P_entryname;
	acl_ptr = P_acl_ptr;

	code = 0;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$add_acl_entries (dirname, entryname, acl_ptr, code);

	P_code = code;
	call reset_level;
	return;
%page;
delete_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	dirname = P_dirname;
	entryname = P_entryname;
	acl_ptr = P_acl_ptr;

	code = 0;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$delete_acl_entries (dirname, entryname, acl_ptr, code);

	P_acl_ptr = acl_ptr;
	P_code = code;
	call reset_level;
	return;
%page;
replace_acl:
     entry (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);

	dirname = P_dirname;
	entryname = P_entryname;
	acl_ptr = P_acl_ptr;
	no_sysdaemon = P_no_sysdaemon;

	code = 0;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$replace_acl (dirname, entryname, acl_ptr, no_sysdaemon, code);

	P_acl_ptr = acl_ptr;
	P_code = code;
	call reset_level;
	return;
%page;
validate:
     entry (P_dirname, P_entryname, P_code);

/* This entry supports the extended object software in validating that
   the caller supplied pathname is in fact, a PNT. */

	code = 0;
	dirname = P_dirname;
	entryname = P_entryname;

	saved_level = -1;
	on cleanup call reset_level;
	call set_level;

	call pnt_fs_util_$validate (dirname, entryname, code);

	P_code = code;
	call reset_level;
	return;
%page;
reset_level:
     procedure ();

/* This procedure resets the validation level, it it was previously
   set by calling entry. */

	if saved_level ^= -1
	then do;
		call hcs_$level_set (saved_level);
		saved_level = -1;
	     end;
	return;
     end reset_level;
%page;
set_level:
     procedure ();

/* This procedure gets the current validation level and saves it away in
   saved_level.  It then sets the validation level to the PNT level (1). */

	call hcs_$level_get (saved_level);
	call hcs_$level_set (get_ring_ ());
	return;
     end set_level;

     end pnt_fs_interface_;




		    pnt_fs_util_.pl1                12/12/91  1510.6r w 12/12/91  1506.5       95274



/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1991   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1984 *
        *                                                         *
        *********************************************************** */



/****^  HISTORY COMMENTS:
  1) change(91-01-07,Vu), approve(91-01-07,MCR8233), audit(91-12-06,Zimmerman),
     install(91-12-12,MR12.5-1006):
     Correct error code returned for PNT extended object type.
                                                   END HISTORY COMMENTS */



/* format: style2 */

/* PNT_FS_UTIL_: This program supports the file-system interfaces for
   PNTs.  It assumes that its caller is in the inner ring, and consequently
   does no parameter copying or validation level manipulations (this is 
   the responsibility of pnt_fs_interface_).  It makes no assumptions about
   THE PNT (>sc1>PNT.pnt) and accepts pathnames to specify the PNT. */

pnt_fs_util_:
     procedure ();

	return;					/* Not a valid entry point */

/**** Written 1984-07-18 by BIM */
/**** Rewritten 1984-07-25 by E. Swenson */
/**** Modified 1985-01-31 by E. Swenson to reject bad suffixes on targets */

/* Parameters */

	dcl     P_acl_ptr		 ptr parameter;
	dcl     P_area_ptr		 ptr parameter;
	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_desired_version	 char (*) parameter;
	dcl     P_dirname		 char (*) parameter;
	dcl     P_entryname		 char (*) parameter;
	dcl     P_error_on_target	 bit (1) aligned parameter;
	dcl     P_new_entryname	 char (*) parameter;
	dcl     P_no_sysdaemon	 bit (1) parameter;
	dcl     P_old_entryname	 char (*) parameter;
	dcl     P_size		 fixed bin (35) parameter;
	dcl     P_target_dirname	 char (*) parameter;
	dcl     P_target_entryname	 char (*) parameter;

/* Automatic */

	dcl     dirname		 char (168);
	dcl     entryname		 char (32);
	dcl     new_entryname	 char (32);
	dcl     old_entryname	 char (32);
	dcl     pnt_ring		 fixed bin (3);
	dcl     ring_brackets	 (3) fixed bin (3);
	dcl     service_routine	 entry variable options (variable);

	dcl     1 local_copy_options	 aligned like copy_options;
	dcl     1 mti		 aligned like ms_table_info;

/* External Entries */

	dcl     copy_		 entry (ptr);
	dcl     get_ring_		 entry () returns (fixed bin (3));
	dcl     fs_util_$make_entry_for_type
				 entry (char (*), char (*), entry, fixed bin (35));
	dcl     hcs_$chname_file	 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     ms_table_mgr_$create	 entry (character (*), character (*), pointer, fixed binary (35));
	dcl     ms_table_mgr_$delete	 entry (character (*), character (*), fixed binary (35));

/* External Static */

          dcl     error_table_$bad_file_name
                                         fixed bin (35) external static;
	dcl     error_table_$not_seg_type
				 external static fixed bin (35);

/* Constant */

	dcl     PNT_TYPE		 char (3) aligned internal static options (constant) initial ("PNT");

/* Conditions */
	dcl     sub_error_		 condition;	/* Structures */

/* Builtin */

	dcl     addr		 builtin;
	dcl     length		 builtin;
	dcl     max		 builtin;
	dcl     null		 builtin;
          dcl     rtrim		 builtin;
	dcl     size		 builtin;
	dcl     string		 builtin;
	dcl     substr		 builtin;
%page;
create:
     entry (P_dirname, P_entryname, P_size, P_code);

	dirname = P_dirname;
	entryname = P_entryname;

	call CHECK_SUFFIX (entryname, P_code);
	if P_code = 0
	then call CREATE_PNT ();
	return;
%page;
delete:
     entry (P_dirname, P_entryname, P_code);

	dirname = P_dirname;
	entryname = P_entryname;

	call CHECK_SUFFIX (entryname, P_code);
	if P_code ^= 0
	then return;

	call PNT_VALIDATE (P_code);
	if P_code = 0
	then call ms_table_mgr_$delete (dirname, entryname, P_code);
	return;
%page;
chname_file:
     entry (P_dirname, P_entryname, P_old_entryname, P_new_entryname, P_code);

/* This entry has the same function as hcs_$chname_file for normal segments.
   In fact, it calls hcs_$chname_file. */

	dirname = P_dirname;
	entryname = P_entryname;
	old_entryname = P_old_entryname;
	new_entryname = P_new_entryname;

	call CHECK_SUFFIX (entryname, P_code);
	if P_code ^= 0
	then return;

	call PNT_VALIDATE (P_code);
	if P_code ^= 0
	then return;

	if old_entryname ^= ""
	then do;
		call CHECK_SUFFIX (old_entryname, P_code);
		if P_code ^= 0
		then return;
	     end;

	if new_entryname ^= ""
	then do;
		call CHECK_SUFFIX_DONT_ADD (new_entryname, P_code);
		if P_code ^= 0
		then return;
	     end;

	call hcs_$chname_file (dirname, entryname, old_entryname, new_entryname, P_code);
	return;
%page;
copy:
     entry (P_dirname, P_entryname, P_target_dirname, P_target_entryname, P_error_on_target, P_code);

/* This entry copies a PNT from one place in the hierarchy to another.
   It attempts to make identical copies (i.e. does no sanitizing or
   restructuring. */

	copy_options_ptr = addr (local_copy_options);
	copy_options.version = COPY_OPTIONS_VERSION_1;
	copy_options.caller_name = "pnt_util_$copy";
	copy_options.source_dir = P_dirname;
	copy_options.source_name = P_entryname;
	copy_options.target_dir = P_target_dirname;
	copy_options.target_name = P_target_entryname;

	call CHECK_SUFFIX (copy_options.source_name, P_code);
	if P_code ^= 0
	then return;

	call CHECK_SUFFIX_DONT_ADD (copy_options.target_name, P_code);
	if P_code ^= 0
	then do;
	     P_error_on_target = "1"b;
	     return;
	     end;

	string (copy_options.flags) = ""b;
	copy_options.flags.raw = "1"b;		/* Don't recurse with xobj stuff */
	copy_options.flags.no_name_dup = "1"b;		/* We don't want this in the inner ring */
	string (copy_options.copy_items) = ""b;

	on sub_error_ call SUB_ERR_HANDLER ();		/* copy_ reports erors with sub_err_ */
	call copy_ (copy_options_ptr);
	revert sub_error_;
COPY_LOST:
	P_error_on_target = copy_options.target_err_switch;
	return;
%page;
list_acl:
     entry (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);

	call fs_util_$make_entry_for_type (FS_OBJECT_TYPE_MSF, FS_LIST_ACL, service_routine, P_code);

	if P_code = 0
	then call service_routine (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);
	return;
%page;
add_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	call fs_util_$make_entry_for_type (FS_OBJECT_TYPE_MSF, FS_ADD_ACL_ENTRIES, service_routine, P_code);

	if P_code = 0
	then call service_routine (P_dirname, P_entryname, P_acl_ptr, P_code);
	return;
%page;
delete_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	call fs_util_$make_entry_for_type (FS_OBJECT_TYPE_MSF, FS_DELETE_ACL_ENTRIES, service_routine, P_code);

	if P_code = 0
	then call service_routine (P_dirname, P_entryname, P_acl_ptr, P_code);
	return;
%page;
replace_acl:
     entry (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);

	call fs_util_$make_entry_for_type (FS_OBJECT_TYPE_MSF, FS_REPLACE_ACL, service_routine, P_code);

	if P_code = 0
	then call service_routine (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);
	return;
%page;
validate:
     entry (P_dirname, P_entryname, P_code);

/* This entry supports the extended object suffix_pnt_$validate entry.
   It is called in ring 1 to verify the object in question is indeed
   a PNT. */

	dirname = P_dirname;
	entryname = P_entryname;

	call CHECK_SUFFIX (entryname, P_code);
	if P_code ^= 0
	then return;

	call PNT_VALIDATE (P_code);
	return;
%page;
PNT_VALIDATE:
     procedure (code);

/**** This internal procedure is used to support the extended object
      validate entrypoint.  It can be called by users with no access
      on the PNT components, so cannot attempt to open the MSF. */

	dcl     code		 fixed bin (35) parameter;

	call fs_util_$make_entry_for_type (FS_OBJECT_TYPE_MSF, FS_GET_RING_BRACKETS, service_routine, code);
	if code ^= 0
	then return;

	call service_routine (dirname, entryname, ring_brackets, code);
	if code ^= 0
	then return;

	pnt_ring = get_ring_ ();
	if ring_brackets (1) ^= pnt_ring | ring_brackets (2) ^= pnt_ring
	then code = error_table_$not_seg_type;

	return;
     end PNT_VALIDATE;
%page;
CHECK_SUFFIX:
     procedure (en, code);

/* This procedure checks the user-supplied entryname for the "pnt" suffix
   and adds it if necessary */

	dcl     code		 fixed bin (35) parameter;
	dcl     en		 char (*) parameter;
	dcl     nen		 char (32);
	dcl     suffixed_name_$make	 entry (char (*), char (*), char (32), fixed bin (35));

	call suffixed_name_$make (en, "pnt", nen, code);
	en = nen;
	return;
     end CHECK_SUFFIX;
%page;
CHECK_SUFFIX_DONT_ADD:
     procedure (en, code);

/* This procedure checks the user-supplied entryname for the "pnt" suffix.
   It returns an error if it is not supplied. */

	dcl     code		 fixed bin (35) parameter;
	dcl     en		 char (*) parameter;

	if substr (en, length (rtrim (en)) - 3, 4) ^= ".pnt"
	then code = error_table_$bad_file_name;		/* Illegal entry name */

	return;
     end CHECK_SUFFIX_DONT_ADD;
%page;
SUB_ERR_HANDLER:
     procedure ();

/* This procedure handles the sub_err_ condition signaled by copy_. */

	dcl     continue_to_signal_	 entry (fixed bin (35));
	dcl     find_condition_info_	 entry (ptr, ptr, fixed bin (35));
	dcl     1 ci		 aligned like condition_info;

	ci.version = condition_info_version_1;
	call find_condition_info_ (null (), addr (ci), (0));
	sub_error_info_ptr = ci.info_ptr;

	if sub_error_info.name ^= "copy_" | copy_error_info.copy_options_ptr ^= copy_options_ptr
	then do;
		call continue_to_signal_ ((0));
		goto END_HANDLER;
	     end;

	P_code = sub_error_info.status_code;

	goto COPY_LOST;
END_HANDLER:
	return;

     end SUB_ERR_HANDLER;
%page;
CREATE_PNT:
     procedure ();

	mti.version = MS_TABLE_INFO_VERSION_3;
	mti.type = PNT_TYPE;
	mti.header_size = 16;
	mti.entry_size = size (pnt_entry);
	mti.max_entries = max (100, P_size);
	mti.max_size = 65536;
	mti.keep_meters = "1"b;

	call ms_table_mgr_$create (dirname, entryname, addr (mti), P_code);
	return;
     end CREATE_PNT;

/* format: off */
%page; %include condition_info;
%page; %include condition_info_header;
%page; %include copy_error_info;
%page; %include copy_flags;
%page; %include copy_options;
%page; %include file_system_operations;
%page; %include ms_table_info;
%page; %include pnt_entry;
%page; %include suffix_info;
%page; %include sub_error_info;
/* format: on */

     end pnt_fs_util_;




		    pnt_manager_.alm                12/05/84  1355.3r w 12/05/84  0926.0       13374



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1984 *
" *                                                         *
" ***********************************************************
	name	pnt_manager_


	macro	tv
	segdef	&1
&1:	getlp
	call6  	&2	" this is necessary since we are calling a gate
	&end


	tv add_acl_entries,pnt_fs_gate_$add_acl_entries
	tv add_entry,pnt_admin_gate_$add_entry
	tv admin_get_entry,pnt_admin_gate_$admin_get_entry
	tv chname_file,pnt_fs_gate_$chname_file
	tv copy,pnt_admin_gate_$copy
	tv create,pnt_admin_gate_$create
	tv delete,pnt_admin_gate_$delete
	tv delete_acl_entries,pnt_fs_gate_$delete_acl_entries
	tv get_abs_entry,pnt_admin_gate_$get_abs_entry
	tv get_entry,pnt_admin_gate_$admin_get_entry
	tv get_network_password,pnt_network_gate_$get_network_password
	tv list_acl,pnt_fs_gate_$list_acl
	tv login_get_entry,pnt_login_gate_$login_get_entry
	tv network_get_entry,pnt_network_gate_$network_get_entry
	tv priv_get_abs_entry,pnt_priv_gate_$priv_get_abs_entry
	tv priv_get_entry,pnt_priv_gate_$priv_get_entry
	tv remove_entry,pnt_admin_gate_$remove_entry
	tv replace_acl,pnt_fs_gate_$replace_acl
	tv table_data,pnt_admin_gate_$table_data
	tv test,test_pnt_manager_$test_pnt_manager_
	tv update_entry,pnt_admin_gate_$update_entry
	tv validate,pnt_fs_gate_$validate
	tv validate_entry,pnt_network_gate_$validate_entry
	end




		    pnt_notify_as_.pl1              10/29/86  1038.9r w 10/28/86  1024.8       15795



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1985 *
   *                                                         *
   *********************************************************** */
/* format: style5 */

pnt_notify_as_:
        procedure (P_person_id, P_code);

/**** This entry is called by the Ring-1 PNT software when it wishes to
      inform the answering service of a PNT change.  It's only arguments
      are a user_id and a status code. */

/* Parameters */

        dcl     P_code		fixed bin (35) parameter;
					      /* status code */
        dcl     P_person_id		char (*) parameter;
					      /* person_id whose PNT entry changed */

/* Automatic */

        dcl     code		fixed bin (35) automatic;
					      /* status code */
        dcl     1 NPCI		structure aligned
				like asr_note_pnt_change_info;
					      /* info structure */

/* Entries */

        dcl     send_as_request_$no_block
				entry (pointer, fixed binary,
				bit (72) aligned, fixed binary (35));

/* Builtin */

        dcl     addr		builtin;
        dcl     size		builtin;
%page;
/* Program */

        code = 0;

        NPCI.header.version = as_request_version_1;
        NPCI.header.type = ASR_NOTE_PNT_CHANGE;
        NPCI.header.reply_channel = 0;		      /* we don't care about a reply */
        NPCI.version = ASR_NPC_INFO_VERSION_1;
        NPCI.person_id = P_person_id;

        call send_as_request_$no_block (addr (NPCI), size (NPCI), (""b), code);

        P_code = code;
        return;

/* format: off */
%page; %include as_request_header;
%page; %include as_requests;
/* format: on */

        end pnt_notify_as_;




		    suffix_pnt_.pl1                 03/05/85  1708.6r w 03/05/85  1054.2       43884



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

/* SUFFIX_PNT_: This program provides the extended object interface to the 
   PNT software.  It allows the extended object commands, copy, rename, etc.
   to manipulate PNTs as extended objects.  All PNTs have the suffix "pnt". */

suffix_pnt_:
     procedure ();

	return;					/* Not a valid entry point */

/* Written 1984-07-25 by E. Swenson */
/* Modified 1984-09-18 by E. Swenson to make pnt_fs_gate_ the unprivileged
   interface to the Ring-1 PNT. */
/* Modified 1985-01-31 by E. Swenson to not reject invalid copy options */

/* Parameters */

	dcl     P_acl_ptr		 ptr parameter;
	dcl     P_area_ptr		 ptr parameter;
	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_copy_options_ptr	 ptr parameter;
	dcl     P_desired_version	 char (*) parameter;
	dcl     P_dirname		 char (*) parameter;
	dcl     P_entryname		 char (*) parameter;
	dcl     P_new_entryname	 char (*) parameter;
	dcl     P_no_sysdaemon	 bit (1) parameter;
	dcl     P_old_entryname	 char (*) parameter;
	dcl     P_suffix_info_ptr	 ptr parameter;

/* Automatic */

	dcl     error_switch	 bit (1) aligned;

/* External Entries */

	dcl     pnt_manager_$add_acl_entries
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_manager_$chname_file
				 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     pnt_manager_$copy	 entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35));
	dcl     pnt_manager_$delete	 entry (char (*), char (*), fixed bin (35));
	dcl     pnt_manager_$delete_acl_entries
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_manager_$list_acl	 entry (char (*), char (*), char (*), ptr, ptr, fixed bin (35));
	dcl     pnt_manager_$replace_acl
				 entry (char (*), char (*), ptr, bit (1), fixed bin (35));
	dcl     pnt_manager_$validate	 entry (char (*), char (*), fixed bin (35));

/* External Static */

	dcl     error_table_$unsupported_operation
				 fixed bin (35) external static;
%page;
delentry_file:
     entry (P_dirname, P_entryname, P_code);

/* This entry deletes a PNT */

	call pnt_manager_$delete (P_dirname, P_entryname, P_code);
	return;
%page;
chname_file:
     entry (P_dirname, P_entryname, P_old_entryname, P_new_entryname, P_code);

/* Changes the names on a PNT */

	call pnt_manager_$chname_file (P_dirname, P_entryname, P_old_entryname, P_new_entryname, P_code);
	return;
%page;
copy:
     entry (P_copy_options_ptr, P_code);

	copy_options_ptr = P_copy_options_ptr;

	if copy_options.extend | copy_options.update
	then do;
		P_code = error_table_$unsupported_operation;
		return;
	     end;

	call pnt_manager_$copy (copy_options.source_dir, copy_options.source_name, copy_options.target_dir,
	     copy_options.target_name, error_switch, P_code);

	copy_options.target_err_switch = error_switch;
	return;
%page;
validate:
     entry (P_dirname, P_entryname, P_code);

/* Used to validate that the specified object is a PNT.  This is used
   by the extended object software. */

	call pnt_manager_$validate (P_dirname, P_entryname, P_code);
	return;
%page;
suffix_info:
     entry (P_suffix_info_ptr);

	suffix_info_ptr = P_suffix_info_ptr;

	suffix_info.version = SUFFIX_INFO_VERSION_1;
	suffix_info.type = "pnt";
	suffix_info.type_name = "PNT";
	suffix_info.plural_name = "PNTs";
	string (suffix_info.flags) = ""b;
	suffix_info.extended_acl = "0"b;
	suffix_info.has_switches = "0"b;
	suffix_info.modes = "r w";
	suffix_info.max_mode_len = 3;
	suffix_info.num_ring_brackets = 0;
	string (suffix_info.copy_flags) = ""b;
	suffix_info.copy_flags.names = "1"b;
	suffix_info.copy_flags.acl = "1"b;
	suffix_info.info_pathname = "";

	return;
%page;
list_acl:
     entry (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);

	call pnt_manager_$list_acl (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);
	return;
%page;
add_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	call pnt_manager_$add_acl_entries (P_dirname, P_entryname, P_acl_ptr, P_code);
	return;
%page;
delete_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	call pnt_manager_$delete_acl_entries (P_dirname, P_entryname, P_acl_ptr, P_code);
	return;
%page;
replace_acl:
     entry (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);

	call pnt_manager_$replace_acl (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);
	return;

/* format: off */
%page; %include copy_flags;
%page; %include copy_options;
%page; %include suffix_info;
/* format: on */

     end suffix_pnt_;



		    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
