MODULE	OPC$SECURITY	(
			 LANGUAGE (BLISS32),
			 IDENT = 'V04-000'
			) =

!****************************************************************************
!*									    *
!*  COPYRIGHT (c) 1978, 1980, 1982, 1984 BY				    *
!*  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS.		    *
!*  ALL RIGHTS RESERVED.						    *
!* 									    *
!*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED   *
!*  ONLY IN  ACCORDANCE WITH  THE  TERMS  OF  SUCH  LICENSE  AND WITH THE   *
!*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR  ANY  OTHER   *
!*  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY   *
!*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE IS  HEREBY   *
!*  TRANSFERRED.							    *
!* 									    *
!*  THE INFORMATION IN THIS SOFTWARE IS  SUBJECT TO CHANGE WITHOUT NOTICE   *
!*  AND  SHOULD  NOT  BE  CONSTRUED AS  A COMMITMENT BY DIGITAL EQUIPMENT   *
!*  CORPORATION.							    *
!* 									    *
!*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY OF ITS   *
!*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		    *
!* 									    *
!*									    *
!****************************************************************************

!++
! FACILITY:
!
!	OPCOM
!
! ABSTRACT:
!
!	This module contains the logic to format security alarm messages.
!
! Environment:
!
!	VAX/VMS operating system.
!
! Author:
!
!	CW Hobbs, from original by Steven T. Jeffreys
!
! Creation date:
!
!	1-Jul-1983	(From OPCOMRQST.B32)
!
! MODIFIED BY:
!
!	V03-007	ACG0449		Andrew C. Goldstein,	30-Aug-1984  16:44
!		Tie off SYSUAF fields mod report, since AUTHORIZE isn't
!		reporting them. Allow zero length volume labels, and display
!		as "(None)".
!
!	V03-006	MHB0141		Mark Bramhall			 2-May-1984
!		Allow 0 length node name and password packet strings.
!		Add SYSUAFF packet to UAF additions.
!		Correct SYSUAF and NETUAF record processing.
!		Substitute "(None)" for 0 length node names.
!		Format password packets using FAO's AF filter.
!		Correct SYSUAFF packet expansion strings.
!
!	V03-005	CWH3005		CW Hobbs			12-Apr-1984
!		Use the $FAO macro to call fao, rather than direct calls
!		to SYS$FAO entry.
!
!	V03-004	RSH0127		R. Scott Hanna			21-Mar-1984
!		Modify PUT_PKT_IMGNAM to display (None) when there is no
!		image name. Modify PUT_PKT_PRIVUSED to display (None) when
!		no priviliges were needed to access the file. Modify FORMAT_VOL
!		to provide for optional volume set name. Remove PKTTYP_EPID
!		packet from detached loginout messages. Add PKTTYP_STATUS to
!		login failure messages. Remove formatting of record type ACL
!		messages.
!
!	V03-003	RSH0113		R. Scott Hanna			12-Mar-1984
!		Add the routines to format the security alarm messages.
!
!	V03-002	CWH3002		CW Hobbs			16-Sep-1983
!		Correctly display node name with message.
!
!	V03-001	CWH3001		CW Hobbs			30-Jul-1983
!		Various and sundry things to make OPCOM distributed
!		across the cluster.
!
!--

BEGIN						! Start of SECURITY

LIBRARY	'SYS$LIBRARY:LIB.L32';
LIBRARY 'LIB$:OPCOMLIB';

REQUIRE 'SHRLIB$:NMADEF.R32';

EXTERNAL ROUTINE
    CHECK_REQUEST,				! Common sanity checks
    CLUSMSG_RQCB_SEND,				! Send an RQCB to the cluster
    DEALLOCATE_RQCB	: NOVALUE,		! Dispose of an RQCB
    FIND_OCD,					! Find a given OCD
    FORMAT_MESSAGE,				! Format a non-security alarm message
    LOG_MESSAGE,				! Write a message to the logfile
    NOTIFY_LISTED_OPERATORS,			! Notify operators on an operator list
    SEND_REPLY;					! Send a reply to the requestor

EXTERNAL
    LCL_NODENAME	: $BBLOCK,		! Name of local node (DECnet or cluster)
    REQUEST_NUMBER	: LONG;			! Current request #

FORWARD ROUTINE
    SECURITY_HANDLER	: NOVALUE,		! Security operator request handler
    FORMAT_ALARM,				! Alarm formatting main routine
    VALIDATE_RECORD,				! Validate the alarm record
    FORMAT_FIL,					! Format file access alarms
    FORMAT_SYSUAF,				! Format system UAF alarms
    FORMAT_NETUAF,				! Format network UAF alarms
    FORMAT_LOGB,				! Format breakin detection alarms
    FORMAT_LOGI,				! Format login alarms
    FORMAT_LOGF,				! Format login failure alarms
    FORMAT_LOGO,				! Format logout alarms
    FORMAT_VOL,					! Format volume operation alarms
    PUT_COMMON,					! Put common header lines
    PUT_NETUAF_LINE	: NOVALUE,		! Put network UAF line
    PUT_DEVNAM_LINE	: NOVALUE,		! Put device name line
    PUT_SOURCE_LINE,				! Put network source line
    PUT_PKT_STATUS,				! Put status longword line
    PUT_PKT_PARENTPID,				! Put parent PID line
    PUT_PKT_PARENTUN	: NOVALUE,		! Put parent username line
    PUT_PKT_VOLUIC,				! Put volume UIC line
    PUT_PKT_IMGNAM	: NOVALUE,		! Put image name line
    PUT_PKT_FILNAM	: NOVALUE,		! Put file name line
    PUT_PKT_FACMOD	: NOVALUE,		! Put file access mode line
    PUT_PKT_PRIVUSED	: NOVALUE,		! Put privileges used line
    PUT_PKT_SYSUAFF	: NOVALUE,		! Put system UAF fields line
    PUT_PKT_PASSWORD,				! Put password line
    PUT_PKT_LOGNAM	: NOVALUE,		! Put logical name line
    PUT_PKT_VOLNAM	: NOVALUE,		! Put volume name line
    PUT_PKT_VOLSNAM	: NOVALUE,		! Put volume set name line
    PUT_PKT_VOLPRO	: NOVALUE,		! Put volume protection line
    PUT_PKT_MOUFLG	: NOVALUE,		! Put mount flags line
    PUT_PKT_DMOUFLG	: NOVALUE,		! Put dismount flags line
    PUT_PKT_STRING	: NOVALUE,		! Put a packet of string data
    PUT_KEYWORDS	: NOVALUE,		! Format and put a packet of keywords
    PUT_STRING		: NOVALUE,		! Put string data
    PUT_STRING_ASCIC	: NOVALUE,		! Put ASCIC string data
    PUT_STRING_ASCID	: NOVALUE,		! Put ASCID string data
    PUT_NEWLINE		: NOVALUE,		! Put a CRLF
    STRIP_BLANKS_TRAIL	: NOVALUE,		! Strip trailing blanks
    STRIP_BLANKS_STRING	: NOVALUE;		! Strip all blanks

BUILTIN
	INSQUE,					! Insert entry onto a queue
	REMQUE;					! Remove entry from a queue

LITERAL
    DATA_LINE_SIZE	= 55,			! Maximum size of data on a single line
    MAXPKTS_IN_REC	= 8;			! Maximum number of packets in a record

BIND
    COLONS_BUF	= UPLIT(BYTE(%ASCIC '::')),
    SPACES_BUF	= UPLIT(BYTE(%ASCIC '  ')),
    NONE_BUF	= UPLIT(BYTE(%ASCIC '(None)'));

STRUCTURE
    ARRAY2	[I,J; M,N,UNIT=4] =
		[M*N*UNIT]
		(ARRAY2+I*N*UNIT+J*UNIT)<0,8*UNIT>;

OWN
    !
    ! The alarm message buffer and descriptor
    !
    ALARM_BUF		: VECTOR[OPC$K_MAXMESSAGE,BYTE],

    ALARM_DESCR		: $BBLOCK[DSC$C_S_BLN]
			  PRESET([DSC$W_LENGTH] = OPC$K_MAXMESSAGE,
				 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
				 [DSC$B_CLASS]	= DSC$K_CLASS_D,
				 [DSC$A_POINTER] = ALARM_BUF),

    !
    ! The packet count table contains a count of the number of data packets,
    ! (by type), in the security alarm record
    !
    PKT_COUNT_TAB	: VECTOR [NSA$K_PKTTYPNUM,BYTE],

    !
    ! The packet index table contains the first PKT_POINTER_TAB index for
    ! each packet type in the security alarm record.
    ! 
    PKT_INDEX_TAB	: VECTOR [NSA$K_PKTTYPNUM,WORD],

    !
    ! The packet pointer table contains a list of the addresses of all the data
    ! packets in the security alarm record. The address of the first packet
    ! of a given data type is contained in the n'th entry of the table where
    ! n is obtained from the PKT_INDEX_TAB. Each additional packet of the same
    ! type is in successive entries.
    !
    PKT_POINTER_TAB	: VECTOR [MAXPKTS_IN_REC,LONG],

    !
    ! The packet size table contains the minimum and maximum data size of
    ! all data packets.
    !
    PKT_SIZE_TAB	: ARRAY2 [NSA$K_PKTTYPNUM,2,WORD]
			  INITIAL (WORD (
				   0,NSA$S_PKT_IMGNAM,   ! Image name
				   4,4,			 ! File access mode
				   4,4,		   	 ! Privilege used to access file
				   1,NSA$S_PKT_FILNAM,   ! File name
				   1,NSA$S_PKT_DEVNAM,   ! Device name
				   0,NSA$S_PKT_LOGNAM,   ! Logical name
				   0,NSA$S_PKT_VOLNAM,   ! Volume name
				   1,NSA$S_PKT_VOLSNAM,  ! Volume set name
				   0,NSA$S_PKT_NODENAM,  ! Node name
				   1,NSA$S_PKT_USERNAM,  ! User name
				   0,NSA$S_PKT_PASSWORD, ! Password
				   4,4,			 ! UIC
				   2,2,			 ! Volume protection
				   4,4,		  	 ! Mount flags
				   2,2,		   	 ! Dismount flags
				   8,8,		   	 ! Node ID
				   4,4,		   	 ! Extended PID
				   8,8,			 ! System UAF record fields
				   4,4)),		 ! Status longword

    !
    ! The following tables describe the packets that may be found in each
    ! type of security auditing record. In addition, it contains the minimum
    ! and maximum number of packets for each type.
    !
    RECID_FIL_SUCC	: VECTOR[13,BYTE]
			  INITIAL(BYTE (4,
				  NSA$K_PKTTYP_FACMOD,1,1,
				  NSA$K_PKTTYP_PRIVUSED,1,1,
				  NSA$K_PKTTYP_FILNAM,1,1,
				  NSA$K_PKTTYP_IMGNAM,1,1)),

    RECID_FIL_FAIL	: VECTOR[10,BYTE]
			  INITIAL(BYTE (3,
				  NSA$K_PKTTYP_FACMOD,1,1,
				  NSA$K_PKTTYP_FILNAM,1,1,
				  NSA$K_PKTTYP_IMGNAM,1,1)),

    RECID_SYSUAF_ADD	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_SYSUAFF,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_SYSUAF_DEL	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_SYSUAF_MOD	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_SYSUAFF,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_SYSUAF_COP	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_SYSUAFF,1,1,
				  NSA$K_PKTTYP_USERNAM,2,2)),

    RECID_SYSUAF_REN	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_SYSUAFF,1,1,
				  NSA$K_PKTTYP_USERNAM,2,2)),

    RECID_NETUAF_ADD	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,2,2)),

    RECID_NETUAF_DEL	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,2,2)),

    RECID_NETUAF_MOD	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_NODENAM,2,2,
				  NSA$K_PKTTYP_USERNAM,4,4)),

    RECID_LOGB_DIA	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_PASSWORD,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGB_LOC	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_PASSWORD,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGB_REM	: VECTOR[16,BYTE]
			  INITIAL(BYTE (5,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_PASSWORD,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGB_NET	: VECTOR[13,BYTE]
			  INITIAL(BYTE (4,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_PASSWORD,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGB_DET	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_PASSWORD,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGI_BAT	: VECTOR[1,BYTE]
			  INITIAL(BYTE (0)),

    RECID_LOGI_DIA	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGI_LOC	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGI_REM	: VECTOR[13,BYTE]
			  INITIAL(BYTE (4,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGI_NET	: VECTOR[10,BYTE]
			  INITIAL(BYTE (3,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGI_SUB	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_EPID,1,1)),

    RECID_LOGI_DET	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGF_BAT	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_STATUS,1,1)),

    RECID_LOGF_DIA	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_STATUS,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGF_LOC	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_STATUS,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGF_REM	: VECTOR[16,BYTE]
			  INITIAL(BYTE (5,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_STATUS,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGF_NET	: VECTOR[13,BYTE]
			  INITIAL(BYTE (4,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_STATUS,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGF_SUB	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_EPID,1,1,
				  NSA$K_PKTTYP_STATUS,1,1)),

    RECID_LOGF_DET	: VECTOR[7,BYTE]
			  INITIAL(BYTE (2,
				  NSA$K_PKTTYP_STATUS,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGO_BAT	: VECTOR[1,BYTE]
			  INITIAL(BYTE (0)),

    RECID_LOGO_DIA	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGO_LOC	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_DEVNAM,1,2)),

    RECID_LOGO_REM	: VECTOR[13,BYTE]
			  INITIAL(BYTE (4,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGO_NET	: VECTOR[10,BYTE]
			  INITIAL(BYTE (3,
				  NSA$K_PKTTYP_NODEID,1,1,
				  NSA$K_PKTTYP_NODENAM,1,1,
				  NSA$K_PKTTYP_USERNAM,1,1)),

    RECID_LOGO_SUB	: VECTOR[4,BYTE]
			  INITIAL(BYTE (1,
				  NSA$K_PKTTYP_EPID,1,1)),

    RECID_LOGO_DET	: VECTOR[1,BYTE]
			  INITIAL(BYTE (0)),

    RECID_VOL_MOU	: VECTOR[25,BYTE]
			  INITIAL(BYTE (8,
				  NSA$K_PKTTYP_UIC,1,1,
				  NSA$K_PKTTYP_VOLPRO,1,1,
				  NSA$K_PKTTYP_MOUFLG,1,1,
				  NSA$K_PKTTYP_IMGNAM,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,1,
				  NSA$K_PKTTYP_LOGNAM,1,1,
				  NSA$K_PKTTYP_VOLNAM,1,1,
				  NSA$K_PKTTYP_VOLSNAM,0,1)),

    RECID_VOL_DMOU	: VECTOR[19,BYTE]
			  INITIAL(BYTE (6,
				  NSA$K_PKTTYP_DMOUFLG,1,1,
				  NSA$K_PKTTYP_IMGNAM,1,1,
				  NSA$K_PKTTYP_DEVNAM,1,1,
				  NSA$K_PKTTYP_LOGNAM,1,1,
				  NSA$K_PKTTYP_VOLNAM,1,1,
				  NSA$K_PKTTYP_VOLSNAM,0,1)),

    !
    ! The following tables contain the number of subtypes of each record
    ! type and a pointer to the table which describes the record content.
    !
    RECTYP_FIL		: VECTOR [NSA$K_RECTYPNUM_FIL+1]
			  INITIAL (NSA$K_RECTYPNUM_FIL,
				   RECID_FIL_SUCC,
			  	   RECID_FIL_FAIL),

    RECTYP_SYSUAF	: VECTOR [NSA$K_RECTYPNUM_SYSUAF+1]
			  INITIAL (NSA$K_RECTYPNUM_SYSUAF,
				   RECID_SYSUAF_ADD,
			  	   RECID_SYSUAF_DEL,
			  	   RECID_SYSUAF_MOD,
				   RECID_SYSUAF_COP,
			  	   RECID_SYSUAF_REN),

    RECTYP_NETUAF	: VECTOR [NSA$K_RECTYPNUM_NETUAF+1]
			  INITIAL (NSA$K_RECTYPNUM_NETUAF,
				   RECID_NETUAF_ADD,
			  	   RECID_NETUAF_DEL,
			  	   RECID_NETUAF_MOD),

    RECTYP_LOGB		: VECTOR [NSA$K_RECTYPNUM_LOGB+1]
			  INITIAL (NSA$K_RECTYPNUM_LOGB,
				   RECID_LOGB_DIA,
			  	   RECID_LOGB_LOC,
			  	   RECID_LOGB_REM,
			  	   RECID_LOGB_NET,
			  	   RECID_LOGB_DET),

    RECTYP_LOGI		: VECTOR [NSA$K_RECTYPNUM_LOGI+1]
			  INITIAL (NSA$K_RECTYPNUM_LOGI,
				   RECID_LOGI_BAT,
			  	   RECID_LOGI_DIA,
			  	   RECID_LOGI_LOC,
			  	   RECID_LOGI_REM,
			  	   RECID_LOGI_NET,
			  	   RECID_LOGI_SUB,
			  	   RECID_LOGI_DET),

    RECTYP_LOGF		: VECTOR [NSA$K_RECTYPNUM_LOGF+1]
			  INITIAL (NSA$K_RECTYPNUM_LOGF,
				   RECID_LOGF_BAT,
			  	   RECID_LOGF_DIA,
			  	   RECID_LOGF_LOC,
			  	   RECID_LOGF_REM,
			  	   RECID_LOGF_NET,
			  	   RECID_LOGF_SUB,
			  	   RECID_LOGF_DET),

    RECTYP_LOGO		: VECTOR [NSA$K_RECTYPNUM_LOGO+1]
			  INITIAL (NSA$K_RECTYPNUM_LOGO,
				   RECID_LOGO_BAT,
			  	   RECID_LOGO_DIA,
			  	   RECID_LOGO_LOC,
			  	   RECID_LOGO_REM,
			  	   RECID_LOGO_NET,
			  	   RECID_LOGO_SUB,
			  	   RECID_LOGO_DET),

    RECTYP_VOL		: VECTOR [NSA$K_RECTYPNUM_VOL+1]
			  INITIAL (NSA$K_RECTYPNUM_VOL,
				   RECID_VOL_MOU,
			  	   RECID_VOL_DMOU),

    !
    ! The following table contains the number of record types and a pointer
    ! to the record subtype table.
    !
    RECTYP		: VECTOR [NSA$K_RECTYPNUM+1]
			  INITIAL (NSA$K_RECTYPNUM,
				   RECTYP_FIL,
				   RECTYP_SYSUAF,
				   RECTYP_NETUAF,
				   RECTYP_LOGB,
				   RECTYP_LOGI,
				   RECTYP_LOGF,
				   RECTYP_LOGO,
				   RECTYP_VOL);

GLOBAL ROUTINE SECURITY_HANDLER (BUFFER_DESC) : NOVALUE =

!++
! Functional description:
!
!	This routine is the handler for all SECURITY messages received by OPCOM.
!
!
! Input:
!
!	BUFFER_DESC : The address of a quadword buffer descriptor that
!		      describes the buffer containing the message.
!
! Implicit Input:
!
!	None.
!
! Output:
!
!	None.
!
! Implict output:
!
!	Some accounting data will be updated 
!	to reflect the receipt of the message.
!
! Side effects:
!
!	None.
!
! Routine value:
!
!	None.
!--

BEGIN						! Start of REQUEST_HANDLER

MAP
    BUFFER_DESC		: $REF_BBLOCK;

LOCAL
	MESSAGE_VECTOR	: VECTOR [7,LONG],	! Message info
	RQCB		: $REF_BBLOCK,		! RQCB data structure
	OCD		: $REF_BBLOCK,		! OCD data structure
	MSG		: $REF_BBLOCK,		! Pointer to user request
	ON_BUF		: VECTOR [64,BYTE],	! Buffer for preposition (" on " node)
	ON_DSC		: VECTOR [2,LONG]	! Desc for preposition
			  INITIAL (64,ON_BUF),
	FOUND		: LONG,			! Boolean
	SCOPE		: LONG,			! Scope of request
	SCOPE_LIMIT	: LONG,			! Loop control
	STATUS		: LONG;


!
! Make sure there is enough data in the request.
!
IF .BUFFER_DESC[DSC$W_LENGTH] LSS (OPC$K_COMHDRSIZ + OPC$K_SECURITY_MIN_SIZE)
THEN
    RETURN;					! Ignore the request
!
! Do some common sanity checks.
!
IF NOT CHECK_REQUEST (.BUFFER_DESC, RQCB)
THEN
    RETURN;
MESSAGE_VECTOR[0] = 0;				! Assume no errors
!
! See if the requestor is issuing this request on another's behalf.
! If so, and the requestor does not have the privilege to do so,
! then dismiss the request.
!
IF .RQCB[RQCB_L_SENDERUIC] NEQ .RQCB[RQCB_L_UIC]
THEN
    IF  (NOT .$BBLOCK[RQCB [RQCB_L_PRIVMASK1], PRV$V_OPER])
    THEN
	IF NOT ((.$BBLOCK[RQCB[RQCB_L_SENDERUIC], 2,0,16,0] EQL .$BBLOCK[RQCB[RQCB_L_UIC], 2,0,16,0]) AND
		(.$BBLOCK[RQCB[RQCB_L_PRIVMASK1], PRV$V_GROUP]))
	THEN
	    BEGIN
	    MESSAGE_VECTOR[0] = OPC$_ILLRQST;
	    MESSAGE_VECTOR[1] = 0;
	    END;
!
! Create a descriptor within the RQCB to point to the request text.
!
MSG = .BUFFER_DESC[DSC$A_POINTER] + OPC$K_COMHDRSIZ;
RQCB[RQCB_L_TEXT_LEN] = .MSG[OPC$W_SECURITY_LENGTH];
IF (.RQCB[RQCB_L_TEXT_LEN] GTR 0)
THEN
    BEGIN
    !
    ! Create a buffer for the request text and copy the text to the buffer.
    !
    IF NOT (STATUS = OPC$GET_VM(RQCB[RQCB_L_TEXT_LEN], RQCB[RQCB_L_TEXT_PTR]))
    THEN
	BEGIN
	DEALLOCATE_RQCB(.RQCB);
	RETURN;
	END;
    CH$MOVE(.RQCB[RQCB_L_TEXT_LEN], MSG[OPC$T_SECURITY_TEXT], .RQCB[RQCB_L_TEXT_PTR]);
    END
ELSE
    BEGIN
    !
    ! There is no request text.  Inform the requestor that this is not allowed.
    !
    MESSAGE_VECTOR[0] = OPC$_ILLRQST;
    MESSAGE_VECTOR[1] = 0;
    END;
!
! Find an OCD that can handle this request. The OCD is selected
! according to the SCOPE and UIC of the requestor.  If the SCOPE
! is unspecified, then look for operator coverage starting in the
! least privileged scope and continuing to the most privileged.
! If no OCD is found, then dismiss the request.
!
IF (.RQCB[RQCB_B_SCOPE] EQL OPC$K_UNSPEC)
THEN
    SCOPE_LIMIT = OPC$K_SYSTEM
ELSE
    SCOPE_LIMIT = .RQCB[RQCB_B_SCOPE];
FOUND = FALSE;
SCOPE = .RQCB[RQCB_B_SCOPE];
WHILE (.SCOPE GEQ .SCOPE_LIMIT) AND (NOT .FOUND) DO
    IF NOT (FOUND = FIND_OCD(.SCOPE, .RQCB[RQCB_L_UIC], OCD))
    THEN
	SCOPE = .SCOPE - 1;
IF NOT .FOUND
THEN
    BEGIN
    MESSAGE_VECTOR[0] = OPC$_NOPERATOR;		! No operator coverage
    MESSAGE_VECTOR[1] = 0;
    END;
!
! If there is an error message to output,
! do so and dismiss the request.
!
IF .MESSAGE_VECTOR[0] NEQ 0
THEN
    BEGIN
    FORMAT_MESSAGE(.RQCB, MESSAGE_VECTOR);
    SEND_REPLY(.RQCB, MESSAGE_VECTOR);
    DEALLOCATE_RQCB(.RQCB);
    RETURN;
    END;
!
! Set the scope of the request.
!
RQCB[RQCB_L_OCD] = .OCD;			! Save OCD address
RQCB[RQCB_B_SCOPE] = .OCD[OCD_B_SCOPE];		! Set request scope
!
! Get the preposition for the node name
!
IF .LCL_NODENAME[DSC$W_LENGTH] NEQ 0
THEN
    BEGIN
    IF NOT (STATUS = $GETMSG(MSGID=OPC$_ON_NODE, MSGLEN=ON_DSC, BUFADR=ON_DSC, FLAGS=1))
    THEN
	$signal_stop (.STATUS);
    END
ELSE
    ON_DSC[0] = 0;
!
! Format the alarm message
!
STATUS = FORMAT_ALARM(.RQCB[RQCB_L_TEXT_PTR], .RQCB[RQCB_L_TEXT_LEN], MESSAGE_VECTOR[5]);
!
! Format the request message.  Note that messages from users who do not
! have security privilege are marked as counterfeit.
!
MESSAGE_VECTOR[1] = 0;					! Use current time in stamp
IF .$BBLOCK[RQCB[RQCB_L_PRIVMASK1], PRV$V_SECURITY] AND .STATUS
THEN
    BEGIN
    MESSAGE_VECTOR[0] = OPC$_SECUR_ALARM;
    MESSAGE_VECTOR[2] = ON_DSC;				! The " on " field
    MESSAGE_VECTOR[3] = .LCL_NODENAME[DSC$W_LENGTH];	! Length of nodename
    MESSAGE_VECTOR[4] = .LCL_NODENAME[DSC$A_POINTER];	! Address of nodename
    END
ELSE
    BEGIN
    MESSAGE_VECTOR[0] = OPC$_COUNTERFEIT;
    MESSAGE_VECTOR[2] = .RQCB[RQCB_W_USERNAMELEN];	! Length of username
    MESSAGE_VECTOR[3] = RQCB[RQCB_T_USERNAME];		! Address of username
    MESSAGE_VECTOR[4] = ON_DSC;				! The " on " field
    MESSAGE_VECTOR[5] = .LCL_NODENAME[DSC$W_LENGTH];	! Length of nodename
    MESSAGE_VECTOR[6] = .LCL_NODENAME[DSC$A_POINTER];	! Address of nodename
    END;

FORMAT_MESSAGE(.RQCB, MESSAGE_VECTOR);			! Format the security alarm message
!
! Tell the cluster, notify operators and log the request.
!
CLUSMSG_RQCB_SEND(-1, CLM__SECURITY, .RQCB);
NOTIFY_LISTED_OPERATORS(.RQCB);
LOG_MESSAGE(.RQCB);

DEALLOCATE_RQCB(.RQCB);
	
END;						! End of SECURITY_HANDLER

GLOBAL ROUTINE FORMAT_ALARM(RECORD_PTR, RECORD_SIZ, ALARM_DESCR_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This is the main formatting routine. It validates the security alarm
!	record, and then dispatches by record type to routines which format
!	the alarm message.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!	RECORD_SIZ	: Size of the security alarm record
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	ALARM_DESCR_PTR	: The address of the security alarm message descriptor
!			  is returned in this address.
!
! IMPLICT OUTPUT:
!	NONE.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL, a $FAO system service error, or 0 indicating the record is
!	invalid.
!--

BEGIN						! Start of FORMAT_ALARM

MAP
    RECORD_PTR	: REF $BBLOCK;

LOCAL
    STATUS	: LONG;

!
! Validate the record
!
STATUS = VALIDATE_RECORD(.RECORD_PTR, .RECORD_SIZ);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Initialize the alarm descriptor
!
ALARM_DESCR[DSC$W_LENGTH] = OPC$K_MAXMESSAGE;
ALARM_DESCR[DSC$A_POINTER] = ALARM_BUF;
!
! Dispatch by record type to the routines which format the messages
!
STATUS = (CASE .RECORD_PTR[NSA$W_REC_TYPE] FROM 1 TO NSA$K_RECTYPNUM OF
    SET
    [NSA$K_RECTYP_FIL]		: FORMAT_FIL(.RECORD_PTR);
    [NSA$K_RECTYP_SYSUAF]	: FORMAT_SYSUAF(.RECORD_PTR);
    [NSA$K_RECTYP_NETUAF]	: FORMAT_NETUAF(.RECORD_PTR);
    [NSA$K_RECTYP_LOGB]		: FORMAT_LOGB(.RECORD_PTR);
    [NSA$K_RECTYP_LOGI]		: FORMAT_LOGI(.RECORD_PTR);
    [NSA$K_RECTYP_LOGF]		: FORMAT_LOGF(.RECORD_PTR);
    [NSA$K_RECTYP_LOGO]		: FORMAT_LOGO(.RECORD_PTR);
    [NSA$K_RECTYP_VOL]		: FORMAT_VOL(.RECORD_PTR);
    TES);
IF NOT .STATUS THEN RETURN .STATUS;
!
! The alarm descriptor is modified as message lines are put in the buffer so
! we must restore it before we return.
!
ALARM_DESCR[DSC$W_LENGTH] = OPC$K_MAXMESSAGE - .ALARM_DESCR[DSC$W_LENGTH];
ALARM_DESCR[DSC$A_POINTER] = ALARM_BUF;
!
! Return the message descriptor.
!
.ALARM_DESCR_PTR = ALARM_DESCR;
RETURN SS$_NORMAL;
END;						! End of FORMAT_ALARM

ROUTINE VALIDATE_RECORD(RECORD_PTR, RECORD_SIZ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine validates the security alarm record.
!
! INPUT:
!	RECORD_PTR	: Security alarm record address.
!	RECORD_SIZ	: Size of the record.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	NONE.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or 0 if the record is not valid.
!--

BEGIN						! Start of VALIDATE_RECORD

MAP
    RECORD_PTR	: REF $BBLOCK;

LOCAL
    PKT_PTR	: REF $BBLOCK,
    SUBTYPE_PTR	: REF VECTOR,
    RECID_PTR	: REF VECTOR[,BYTE],
    PKT_TYPE	: LONG,
    PKT_SIZE	: LONG,
    INDEX	: LONG INITIAL(0),
    COUNT	: LONG INITIAL(0),
    I		: LONG;

!
! Validate the record header fields.
!
IF (.RECORD_SIZ LSSU NSA$K_RECHDR_LENGTH) OR
   (.RECORD_PTR[NSA$W_REC_TYPE] EQLU 0) OR
   (.RECORD_PTR[NSA$W_REC_TYPE] GTRU .RECTYP[0]) OR
   (.RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU 0) OR
   (.RECORD_PTR[NSA$W_REC_SUBTYPE] GTRU ..RECTYP[.RECORD_PTR[NSA$W_REC_TYPE]]) OR
   (.RECORD_PTR[NSA$B_REC_SEQNUM] NEQU 1) OR
   (.RECORD_PTR[NSA$B_REC_SEQLAST] NEQU 1) OR
   (.RECORD_PTR[NSA$B_REC_FLAGS] NEQU 0) OR
   (.RECORD_PTR[NSA$W_REC_PKTOFF]-NSA$K_PKTHDR_LENGTH NEQU NSA$K_RECHDR_LENGTH) OR
   (.RECORD_PTR[NSA$W_REC_PKTHDRSIZ] NEQU NSA$K_PKTHDR_LENGTH)
THEN
    RETURN 0;
!
! Initialize the packet count table and get a pointer to the first packet.
!
CH$FILL(0, NSA$K_PKTTYPNUM, PKT_COUNT_TAB);
PKT_PTR = .RECORD_PTR + .RECORD_PTR[NSA$W_REC_PKTOFF];
!
! If the packet count is not zero, we must perform various validation checks
! and set up the packet index and packet pointer tables.
!
IF .RECORD_PTR[NSA$B_REC_PKTNUM] GTRU 0
THEN 
    BEGIN
    DECR I FROM .RECORD_PTR[NSA$B_REC_PKTNUM] TO 1 DO
	BEGIN
	!
	! Get the packet size and type.
	!
	PKT_TYPE = .PKT_PTR[NSA$W_PKT_TYPE];
	PKT_SIZE = .PKT_PTR[NSA$W_PKT_SIZE];
	!
	! Validate the packet size and type.
	!
	IF (.PKT_TYPE EQLU 0) OR
	   (.PKT_TYPE GTRU NSA$K_PKTTYPNUM) OR
	   (.PKT_SIZE - NSA$K_PKTHDR_LENGTH LSSU .PKT_SIZE_TAB[.PKT_TYPE-1, 0]) OR
	   (.PKT_SIZE - NSA$K_PKTHDR_LENGTH GTRU .PKT_SIZE_TAB[.PKT_TYPE-1, 1])
	THEN
	    RETURN 0;
	!
	! Increment the packet count, get the next packet address and
	! make sure that it does not point past the end of the record.
	!
	PKT_COUNT_TAB[.PKT_TYPE-1] = .PKT_COUNT_TAB[.PKT_TYPE-1] + 1;
	PKT_PTR = .PKT_PTR + .PKT_SIZE;
	IF (.I NEQU 1) AND
	   (.PKT_PTR - .RECORD_PTR - NSA$K_PKTHDR_LENGTH GEQU .RECORD_SIZ)
	THEN
	    RETURN 0;
	END;	
    !
    ! The packet data types and sizes have been validated. The next step
    ! is to set up the packet index and pointer tables. First we set up
    ! the packet index table.
    !
    INCR I FROM 0 TO NSA$K_PKTTYPNUM-1 DO
	BEGIN
	IF .PKT_COUNT_TAB[.I] NEQU 0
	THEN
	    BEGIN
	    PKT_INDEX_TAB[.I] = .INDEX;
	    INDEX = .INDEX + .PKT_COUNT_TAB[.I];
	    END;
	END;
    !
    ! Now we step through the packets one more time to set up the 
    ! packet pointer table. In the process we re-count the packets.
    !
    CH$FILL(0, NSA$K_PKTTYPNUM, PKT_COUNT_TAB);
    PKT_PTR = .RECORD_PTR + .RECORD_PTR[NSA$W_REC_PKTOFF];
    DECR I FROM .RECORD_PTR[NSA$B_REC_PKTNUM] TO 1 DO
	BEGIN
	!
	! Get the packet type, save the packet address in the packet
	! pointer table, increment the packet count, and get the next
	! packet pointer.
	!
	PKT_TYPE = .PKT_PTR[NSA$W_PKT_TYPE];
	PKT_POINTER_TAB[.PKT_INDEX_TAB[.PKT_TYPE-1]+.PKT_COUNT_TAB[.PKT_TYPE-1]] = .PKT_PTR;
	PKT_COUNT_TAB[.PKT_TYPE-1] = .PKT_COUNT_TAB[.PKT_TYPE-1] + 1;
	PKT_PTR = .PKT_PTR + .PKT_PTR[NSA$W_PKT_SIZE];
	END;	
    END;
!
! Now we check that the right packets are present for this type of record.
!
! First we form a pointer to the table which describes the packet types
! for this record.
!
SUBTYPE_PTR = .RECTYP[.RECORD_PTR[NSA$W_REC_TYPE]];
RECID_PTR = .SUBTYPE_PTR[.RECORD_PTR[NSA$W_REC_SUBTYPE]];
!
! Then we make sure that each packet found is allowed in this record.
!
INCR I FROM 1 TO .RECID_PTR[0]*3-2 BY 3 DO
    BEGIN
    IF (.PKT_COUNT_TAB[.RECID_PTR[.I]-1] LSSU .RECID_PTR[.I+1]) OR
       (.PKT_COUNT_TAB[.RECID_PTR[.I]-1] GTRU .RECID_PTR[.I+2])
    THEN
	RETURN 0
    ELSE
	COUNT = .COUNT + .PKT_COUNT_TAB[.RECID_PTR[.I]-1];
    END;
!
! The packet count can now be used to make sure that there were not any
! additional packet types in the record.
!
IF .COUNT NEQU .RECORD_PTR[NSA$B_REC_PKTNUM]
THEN
    RETURN 0;
!
!
! The last check is to validate the record size.
!
IF .PKT_PTR - .RECORD_PTR - NSA$K_PKTHDR_LENGTH NEQU .RECORD_SIZ
THEN
    RETURN 0;

RETURN SS$_NORMAL;
END;						! End of VALIDATE_RECORD

ROUTINE FORMAT_FIL(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for file access alarms.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_FIL

MAP
    RECORD_PTR	: REF $BBLOCK;

OWN
    FIL_VEC	: VECTOR[NSA$K_RECTYPNUM_FIL]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Successful file access')),
			  UPLIT(BYTE(%ASCIC ' / File access failure')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .FIL_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Format the image name, file name, and file access mode lines.
!
PUT_PKT_IMGNAM(.RECORD_PTR);
PUT_PKT_FILNAM(.RECORD_PTR);
PUT_PKT_FACMOD(.RECORD_PTR);
!
! If it was a successful file access, format the privileges used line.
!
IF .RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU NSA$K_RECTYP_FIL_SUCC
THEN
    PUT_PKT_PRIVUSED(.RECORD_PTR);
RETURN SS$_NORMAL;
END;						! End of FORMAT_FIL

ROUTINE FORMAT_SYSUAF(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_SYSUAF. (System user authorization file)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_SYSUAF

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    FROMNAM_BUF	= UPLIT(BYTE(%ASCIC '	From Name:	')),
    OLDNAM_BUF	= UPLIT(BYTE(%ASCIC '	Old Name:	'));

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_SYSUAF]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / System UAF record addition')),
			  UPLIT(BYTE(%ASCIC ' / System UAF record deletion')),
			  UPLIT(BYTE(%ASCIC ' / System UAF record modification')),
			  UPLIT(BYTE(%ASCIC ' / System UAF record copied')),
			  UPLIT(BYTE(%ASCIC ' / System UAF record renamed'))),
    LABEL_VEC	: VECTOR[NSA$K_RECTYPNUM_SYSUAF]
		  INITIAL(UPLIT(BYTE(%ASCIC '	Rec Add:	')),
			  UPLIT(BYTE(%ASCIC '	Rec Del:	')),
			  UPLIT(BYTE(%ASCIC '	Rec Mod:	')),
			  UPLIT(BYTE(%ASCIC '	Rec Add:	')),
			  UPLIT(BYTE(%ASCIC '	New Name:	')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Move the user name label and user name fields into the alarm buffer.
!
PUT_STRING_ASCIC(.LABEL_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_USERNAM, 1);
PUT_NEWLINE(0);
!
! If this is a UAF copied or renamed record, format the old user name.
!
IF .RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU NSA$K_RECTYP_SYSUAF_COP
OR .RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU NSA$K_RECTYP_SYSUAF_REN
THEN
    BEGIN
    PUT_STRING_ASCIC(
	IF .RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU NSA$K_RECTYP_SYSUAF_COP
	THEN FROMNAM_BUF
	ELSE OLDNAM_BUF
		    );
    PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_USERNAM, 2);
    PUT_NEWLINE(0);
    END;
!
! If this is anything but a UAF deletion record, format the modified fields.
! ***** This is temporarily tied off because AUTHORIZE is not generating
! ***** the fields modified vector.
!
IF .RECORD_PTR[NSA$W_REC_SUBTYPE] NEQU NSA$K_RECTYP_SYSUAF_DEL
THEN
    IF .(UPLIT BYTE (0)) THEN		! ***** temporary tie-off
    PUT_PKT_SYSUAFF(.RECORD_PTR);
RETURN SS$_NORMAL;
END;						! End of FORMAT_SYSUAF

ROUTINE FORMAT_NETUAF(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_NETUAF. (Network user authorization file)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_NETUAF

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    OLDREC_BUF	= UPLIT(BYTE(%ASCIC '	Old Rec:	'));

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_NETUAF]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Network UAF record addition')),
			  UPLIT(BYTE(%ASCIC ' / Network UAF record deletion')),
			  UPLIT(BYTE(%ASCIC ' / Network UAF record modification'))),
    LABEL_VEC	: VECTOR[NSA$K_RECTYPNUM_NETUAF]
		  INITIAL(UPLIT(BYTE(%ASCIC '	Rec Add:	')),
			  UPLIT(BYTE(%ASCIC '	Rec Del:	')),
			  UPLIT(BYTE(%ASCIC '	New Rec:	')));
LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Format the first network user authorization line.
!
PUT_STRING_ASCIC(.LABEL_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
PUT_NETUAF_LINE(.RECORD_PTR, 1);
!
! If this is a network UAF modified record, format the second network user
! authorization line.
!
IF .RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU NSA$K_RECTYP_NETUAF_MOD
THEN
    BEGIN
    PUT_STRING_ASCIC(OLDREC_BUF);
    PUT_NETUAF_LINE(.RECORD_PTR, 2);
    END;
RETURN SS$_NORMAL;
END;						! End of FORMAT_NETUAF

ROUTINE FORMAT_LOGB(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_LOGB. (Login breakin detection)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_LOGB

MAP
    RECORD_PTR	: REF $BBLOCK;

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_LOGB]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Dialup interactive breakin detection')),
			  UPLIT(BYTE(%ASCIC ' / Local interactive breakin detection')),
			  UPLIT(BYTE(%ASCIC ' / Remote interactive breakin detection')),
			  UPLIT(BYTE(%ASCIC ' / Network breakin detection')),
			  UPLIT(BYTE(%ASCIC ' / Detached process breakin detection')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
STATUS = PUT_PKT_PASSWORD(.RECORD_PTR);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Dispatch by record subtype to format the remainder of the message lines.
!
CASE .RECORD_PTR[NSA$W_REC_SUBTYPE] FROM 1 TO NSA$K_RECTYPNUM_LOGB OF
    SET
    [NSA$K_RECTYP_LOGB_DIA, NSA$K_RECTYP_LOGB_LOC] :
	!
	! Dialup and local interactive breakin detection.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	END;
    [NSA$K_RECTYP_LOGB_REM] :
	!
	! Remote interactive breakin detection.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGB_NET] :
	!
	! Network breakin detection.
	!
	BEGIN
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGB_DET] :
	!
	! Detached process breakin detection.
	!
	BEGIN
	PUT_PKT_PARENTUN(.RECORD_PTR);
	END;
    TES;
RETURN SS$_NORMAL;
END;						! End of FORMAT_LOGB

ROUTINE FORMAT_LOGI(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_LOGI. (Successful logins)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_LOGI

MAP
    RECORD_PTR	: REF $BBLOCK;

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_LOGI]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Batch process login')),
		  	  UPLIT(BYTE(%ASCIC ' / Dialup interactive login')),
			  UPLIT(BYTE(%ASCIC ' / Local interactive login')),
			  UPLIT(BYTE(%ASCIC ' / Remote interactive login')),
			  UPLIT(BYTE(%ASCIC ' / Network login')),
			  UPLIT(BYTE(%ASCIC ' / Subprocess login')),
			  UPLIT(BYTE(%ASCIC ' / Detached process login')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Dispatch by record subtype to format the remainder of the message lines.
!
CASE .RECORD_PTR[NSA$W_REC_SUBTYPE] FROM 1 TO NSA$K_RECTYPNUM_LOGI OF
    SET
    [NSA$K_RECTYP_LOGI_BAT] :
	!
	! Batch process login.
	!
	BEGIN
	1;
	END;
    [NSA$K_RECTYP_LOGI_DIA, NSA$K_RECTYP_LOGI_LOC] :
	!
	! Dialup and local interactive login.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	END;
    [NSA$K_RECTYP_LOGI_REM] :
	!
	! Remote interactive login.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGI_NET] :
	!
	! Network login.
	!
	BEGIN
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGI_SUB] :
	!
	! Subprocess login.
	!
	BEGIN
	STATUS = PUT_PKT_PARENTPID(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGI_DET] :
	!
	! Detached process login.
	!
	BEGIN
	PUT_PKT_PARENTUN(.RECORD_PTR);
	END;
    TES;
RETURN SS$_NORMAL;
END;						! End of FORMAT_LOGI

ROUTINE FORMAT_LOGF(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_LOGF. (Login failures)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_LOGF

MAP
    RECORD_PTR	: REF $BBLOCK;

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_LOGF]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Batch process login failure')),
		  	  UPLIT(BYTE(%ASCIC ' / Dialup interactive login failure')),
			  UPLIT(BYTE(%ASCIC ' / Local interactive login failure')),
			  UPLIT(BYTE(%ASCIC ' / Remote interactive login failure')),
			  UPLIT(BYTE(%ASCIC ' / Network login failure')),
			  UPLIT(BYTE(%ASCIC ' / Subprocess login failure')),
			  UPLIT(BYTE(%ASCIC ' / Detached process login failure')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
STATUS = PUT_PKT_STATUS(.RECORD_PTR);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Dispatch by record subtype to format the remainder of the message lines.
!
CASE .RECORD_PTR[NSA$W_REC_SUBTYPE] FROM 1 TO NSA$K_RECTYPNUM_LOGF OF
    SET
    [NSA$K_RECTYP_LOGF_BAT] :
	!
	! Batch process login failure.
	!
	BEGIN
	SS$_NORMAL;
	END;
    [NSA$K_RECTYP_LOGF_DIA, NSA$K_RECTYP_LOGF_LOC] :
	!
	! Dialup and local interactive login failure.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	END;
    [NSA$K_RECTYP_LOGF_REM] :
	!
	! Remote interactive login failure.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGF_NET] :
	!
	! Network login failure.
	!
	BEGIN
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGF_SUB] :
	!
	! Subprocess login failure.
	!
	BEGIN
	STATUS = PUT_PKT_PARENTPID(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGF_DET] :
	!
	! Detached process login failure.
	!
	BEGIN
	PUT_PKT_PARENTUN(.RECORD_PTR);
	END;
    TES;
RETURN SS$_NORMAL;
END;						! End of FORMAT_LOGF

ROUTINE FORMAT_LOGO(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_LOGO. (Logouts)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_LOGO

MAP
    RECORD_PTR	: REF $BBLOCK;

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_LOGO]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Batch process logout')),
		  	  UPLIT(BYTE(%ASCIC ' / Dialup interactive logout')),
			  UPLIT(BYTE(%ASCIC ' / Local interactive logout')),
			  UPLIT(BYTE(%ASCIC ' / Remote interactive logout')),
			  UPLIT(BYTE(%ASCIC ' / Network logout')),
			  UPLIT(BYTE(%ASCIC ' / Subprocess logout')),
			  UPLIT(BYTE(%ASCIC ' / Detached process logout')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Dispatch by record subtype to format the remainder of the message lines.
!
CASE .RECORD_PTR[NSA$W_REC_SUBTYPE] FROM 1 TO NSA$K_RECTYPNUM_LOGO OF
    SET
    [NSA$K_RECTYP_LOGO_BAT] :
	!
	! Batch process logout.
	!
	BEGIN
	SS$_NORMAL;
	END;
    [NSA$K_RECTYP_LOGO_DIA, NSA$K_RECTYP_LOGO_LOC] :
	!
	! Dialup and local interactive logout.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	END;
    [NSA$K_RECTYP_LOGO_REM] :
	!
	! Remote interactive logout.
	!
	BEGIN
	PUT_DEVNAM_LINE(.RECORD_PTR);
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGO_NET] :
	!
	! Network logout.
	!
	BEGIN
	STATUS = PUT_SOURCE_LINE(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGO_SUB] :
	!
	! Subprocess logout.
	!
	BEGIN
	STATUS = PUT_PKT_PARENTPID(.RECORD_PTR);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;
    [NSA$K_RECTYP_LOGO_DET] :
	!
	! Detached process logout.
	!
	BEGIN
	SS$_NORMAL;
	END;
    TES;
RETURN SS$_NORMAL;
END;						! End of FORMAT_LOGO

ROUTINE FORMAT_VOL(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats security alarm messages for records whose type
!	is NSA$K_RECTYP_VOL. (Volume operations)
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of FORMAT_VOL

MAP
    RECORD_PTR	: REF $BBLOCK;

OWN
    BANNER_VEC	: VECTOR[NSA$K_RECTYPNUM_VOL]
		  INITIAL(UPLIT(BYTE(%ASCIC ' / Volume mount')),
		  	  UPLIT(BYTE(%ASCIC ' / Volume dismount')));

LOCAL
    STATUS	: LONG;

!
! Format the common message lines.
!
STATUS = PUT_COMMON(.RECORD_PTR, .BANNER_VEC[.RECORD_PTR[NSA$W_REC_SUBTYPE]-1]);
IF NOT .STATUS THEN RETURN .STATUS;
!
! Format the image name, device name, logical name, volume name, and volume set
! name message lines.
!
PUT_PKT_IMGNAM(.RECORD_PTR);
PUT_DEVNAM_LINE(.RECORD_PTR);
PUT_PKT_LOGNAM(.RECORD_PTR);
PUT_PKT_VOLNAM(.RECORD_PTR);
IF .PKT_COUNT_TAB[NSA$K_PKTTYP_VOLSNAM-1] NEQ 0
THEN
    PUT_PKT_VOLSNAM(.RECORD_PTR);
IF .RECORD_PTR[NSA$W_REC_SUBTYPE] EQLU NSA$K_RECTYP_VOL_MOU
THEN
    !
    ! Record subtype is mount... format the volume UIC, volume protection, and
    ! volume mount flag message lines.
    !
    BEGIN
    STATUS = PUT_PKT_VOLUIC(.RECORD_PTR);
    IF NOT .STATUS THEN RETURN .STATUS;
    PUT_PKT_VOLPRO(.RECORD_PTR);
    PUT_PKT_MOUFLG(.RECORD_PTR);
    END
ELSE
    !
    ! Record subtype is dismount... format the dismount flag message lines.
    !
    PUT_PKT_DMOUFLG(.RECORD_PTR);
RETURN SS$_NORMAL;
END;						! End of FORMAT_VOL

ROUTINE PUT_COMMON(RECORD_PTR, ASCIC_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine moves the message identification string into the alarm
!	buffer, and formats all of the common security alarm message lines and
!	puts them in the alarm buffer. The common information consists of the
!	event time, the process ID, and the process user name. This information
!	is obtained from the security alarm record header.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!	ASCIC_PTR	: Address of the counted ASCII message identification
!			  string.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted common message lines in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of PUT_COMMON

LITERAL
    TIM_BUF_SIZ	= 23;

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    TIME_BUF	= UPLIT(BYTE(%ASCIC '	Time:		')),
    PID_BUF	= UPLIT(BYTE(%ASCIC '	PID:		')),
    NAME_BUF	= UPLIT(BYTE(%ASCIC '	User Name:	')),
    CONTROL	= %ASCID '!XL';

LOCAL
    BUFFER	: VECTOR[TIM_BUF_SIZ,BYTE],
    TIME_DESCR	: $BBLOCK[DSC$C_S_BLN]
		  PRESET([DSC$W_LENGTH] = TIM_BUF_SIZ,
			 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			 [DSC$B_CLASS]	= DSC$K_CLASS_D,
			 [DSC$A_POINTER] = BUFFER),
    LENGTH	: LONG,
    STATUS	: LONG;

!
! Move the message id string into the alarm buffer.
!
PUT_STRING_ASCIC(.ASCIC_PTR);
PUT_NEWLINE(0);
!
! Convert the event time and format the event time message line.
!
STATUS = $ASCTIM(TIMLEN = TIME_DESCR,
		 TIMBUF = TIME_DESCR,
		 TIMADR = RECORD_PTR[NSA$Q_REC_TIME]);
IF NOT .STATUS THEN RETURN .STATUS;
PUT_STRING_ASCIC(TIME_BUF);
IF .BUFFER[0] EQLU ' ' THEN BUFFER[0] = '0';
PUT_STRING_ASCID(TIME_DESCR);
PUT_NEWLINE(0);
!
! Convert the process id and format the process id message line.
!
PUT_STRING_ASCIC(PID_BUF);
STATUS = $FAO(CONTROL, LENGTH, ALARM_DESCR, .RECORD_PTR[NSA$L_REC_EPID]);
IF NOT .STATUS THEN RETURN .STATUS;
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .LENGTH<0,16,0>;
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .LENGTH<0,16,0>;
PUT_NEWLINE(0);
!
! Format the user name message line.
!
PUT_STRING_ASCIC(NAME_BUF);
PUT_STRING(NSA$S_REC_USERNAM, RECORD_PTR[NSA$T_REC_USERNAM]);
STRIP_BLANKS_TRAIL(ALARM_DESCR);
PUT_NEWLINE(0);
RETURN SS$_NORMAL;
END;						! End of PUT_COMMON

ROUTINE PUT_NETUAF_LINE(RECORD_PTR, RECNUM) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a network authorization line. A network
!	authorization line consists of the remote node and user name, and the
!	local name the user is mapped to.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!	RECNUM		: Specifies which NODENAM and USERNAM packets to use.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted network authorization line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_NETUAF_LINE

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    BLANKS = UPLIT(BYTE(%ASCII '            '));

LOCAL
    PTR		: LONG;

PTR = .ALARM_DESCR[DSC$A_POINTER] + 6;
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_NODENAM, .RECNUM);
IF .ALARM_DESCR[DSC$A_POINTER] NEQU .PTR
THEN
    PUT_STRING(.PTR - .ALARM_DESCR[DSC$A_POINTER], BLANKS);
PUT_STRING_ASCIC(COLONS_BUF);
PTR = .ALARM_DESCR[DSC$A_POINTER] + 13;
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_USERNAM, (.RECNUM-1)*2+1);
PUT_STRING(.PTR - .ALARM_DESCR[DSC$A_POINTER], BLANKS);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_USERNAM, (.RECNUM-1)*2+2);
PUT_NEWLINE(0);
END;						! End of PUT_NETUAF_LINE

ROUTINE PUT_DEVNAM_LINE(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a device name line and puts it in the security
!	alarm buffer. A device name line consists of the device name, (obtained
!	from the first DEVNAM packet), and optionally a second device name in
!	parenthesis if there is a second DEVNAM packet.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted device name line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_DEVNAM_LINE

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    DEVNAM_BUF	= UPLIT(BYTE(%ASCIC '	Dev Name:	')),
    LEFT_BUF	= UPLIT(BYTE(%ASCIC '  (')),
    RIGHT_BUF	= UPLIT(BYTE(%ASCIC ')'));

!
! Format the first part of the device name message line.
!
PUT_STRING_ASCIC(DEVNAM_BUF);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_DEVNAM, 1);
!
! If there is a second device name packet, append it within parenthesis to
! the device name message line.
!
IF .PKT_COUNT_TAB[NSA$K_PKTTYP_DEVNAM-1] EQLU 2
THEN
    BEGIN
    PUT_STRING_ASCIC(LEFT_BUF);
    PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_DEVNAM, 2);
    PUT_STRING_ASCIC(RIGHT_BUF);
    END;
PUT_NEWLINE(0);
END;						! End of PUT_DEVNAM_LINE

ROUTINE PUT_SOURCE_LINE(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a network source line. A network source line
!	consists of the remote node number, node name, and the remote username.
!	This information is obtained from the first NODEID, NODENAM, and USERNAM
!	packets in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted source line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of PUT_SOURCE_LINE

MAP
    RECORD_PTR	: REF $BBLOCK;

LITERAL
    NODE_BUF_SIZE = 9;

BIND
    SOURCE_BUF	= UPLIT(BYTE(%ASCIC '	Source:		')),
    CONTROL1	= %ASCID '!UB.!UW',
    CONTROL2	= %ASCID '!+!UW';

LOCAL
    BUFFER	: VECTOR[NODE_BUF_SIZE,BYTE],
    NODE_DESCR	: $BBLOCK[DSC$C_S_BLN]
		  PRESET([DSC$W_LENGTH] = NODE_BUF_SIZE,
			 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			 [DSC$B_CLASS]	= DSC$K_CLASS_D,
			 [DSC$A_POINTER] = BUFFER),
    PKTPTR	: REF $BBLOCK,
    CONTROL	: LONG,
    STATUS	: LONG;

!
! Move the label field into the alarm buffer and form a pointer to the node
! id packet.
!
PUT_STRING_ASCIC(SOURCE_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_NODEID-1]];
!
! Convert the node id and move it into the alarm buffer.
!
IF .PKTPTR[NMA$V_AREA] NEQU 0
THEN
    CONTROL = CONTROL1
ELSE
    CONTROL = CONTROL2;
STATUS = $FAO(.CONTROL, NODE_DESCR[DSC$W_LENGTH], NODE_DESCR, .PKTPTR[NMA$V_AREA], .PKTPTR[NMA$V_ADDR]);
IF NOT .STATUS THEN RETURN .STATUS;
STRIP_BLANKS_STRING(NODE_DESCR);
PUT_STRING_ASCID(NODE_DESCR);
!
! Add "  nodename::remoteid" to alarm buffer.
! Substitute "(None)" for a 0 length node name.
!
PUT_STRING_ASCIC(SPACES_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_NODENAM-1]];
IF (.PKTPTR[NSA$W_PKT_SIZE] - NSA$K_PKTHDR_LENGTH) GTRU 0
THEN
    PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_NODENAM, 1)
ELSE
    PUT_STRING_ASCIC(NONE_BUF);
PUT_STRING_ASCIC(COLONS_BUF);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_USERNAM, 1);
PUT_NEWLINE(0);
RETURN SS$_NORMAL;
END;						! End of PUT_SOURCE_LINE

ROUTINE PUT_PKT_STATUS(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine gets the message associated with the status longword and
!	formats a status message line.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $GETMSG system service error.
!--

BEGIN						! Start of PUT_PKT_STATUS

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    STATUS_BUF	= UPLIT(BYTE(%ASCIC '	Status:		'));

LOCAL
    PKTPTR	: REF $BBLOCK,
    BUFF	: VECTOR[256,BYTE],
    BUFF_DESCR	: $BBLOCK[DSC$C_S_BLN]
		  PRESET([DSC$W_LENGTH] = 256,
			 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			 [DSC$B_CLASS]	= DSC$K_CLASS_D,
			 [DSC$A_POINTER] = BUFF),
    STATUS	: LONG;

!
! Move the label field into the alarm buffer and form a pointer to the status
! longword packet.
!
PUT_STRING_ASCIC(STATUS_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_STATUS-1]];
!
! Get the message text and move it into the message buffer.
!
STATUS = $GETMSG(MSGID  = .PKTPTR[NSA$L_PKT_STATUS],
		    MSGLEN = BUFF_DESCR,
		    BUFADR = BUFF_DESCR,
		    FLAGS  = 15);
IF NOT .STATUS THEN RETURN .STATUS;
WHILE .BUFF_DESCR[DSC$W_LENGTH] GTRU DATA_LINE_SIZE DO
    BEGIN
    PUT_STRING(DATA_LINE_SIZE, .BUFF_DESCR[DSC$A_POINTER]);
    BUFF_DESCR[DSC$W_LENGTH] = .BUFF_DESCR[DSC$W_LENGTH] - DATA_LINE_SIZE;
    BUFF_DESCR[DSC$A_POINTER] = .BUFF_DESCR[DSC$A_POINTER] + DATA_LINE_SIZE;
    PUT_NEWLINE(1);
    END;
PUT_STRING(.BUFF_DESCR[DSC$W_LENGTH], .BUFF_DESCR[DSC$A_POINTER]);
PUT_NEWLINE(0);
RETURN SS$_NORMAL;
END;						! End of PUT_PKT_STATUS

ROUTINE PUT_PKT_PARENTPID(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first EPID packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of PUT_PKT_PARENTPID

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    PID_BUF	= UPLIT(BYTE(%ASCIC '	Parent PID:	')),
    CONTROL	= %ASCID '!XL';

LOCAL
    PKTPTR	: REF $BBLOCK,
    LENGTH	: LONG,
    STATUS	: LONG;

!
! Move the label field into the alarm buffer and form a pointer to the process
! id packet.
!
PUT_STRING_ASCIC(PID_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_EPID-1]];
!
! Convert and move the process id field into the message buffer.
!
STATUS = $FAO(CONTROL, LENGTH, ALARM_DESCR, .PKTPTR[NSA$L_PKT_EPID]);
IF NOT .STATUS THEN RETURN .STATUS;
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .LENGTH<0,16,0>;
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .LENGTH<0,16,0>;
PUT_NEWLINE(0);
RETURN SS$_NORMAL;
END;						! End of PUT_PKT_PARENTPID

ROUTINE PUT_PKT_PARENTUN(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first USERNAM packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_PARENTUN

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    NAME_BUF	= UPLIT(BYTE(%ASCIC '	Parent U.N.:	'));

PUT_STRING_ASCIC(NAME_BUF);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_USERNAM, 1);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_PARENTUN

ROUTINE PUT_PKT_VOLUIC(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first UIC packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of PUT_PKT_VOLUIC

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    VOLUIC_BUF	= UPLIT(BYTE(%ASCIC '	Vol UIC:	')),
    CONTROL	= %ASCID '!%I';

LOCAL
    PKTPTR	: REF $BBLOCK,
    STATUS	: LONG,
    LENGTH	: LONG;

!
! Move the label field into the alarm buffer and form a pointer to the
! volume uic packet.
!
PUT_STRING_ASCIC(VOLUIC_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_UIC-1]];
!
! Convert and move the volume uic field into the message buffer.
!
STATUS = $FAO(CONTROL, LENGTH, ALARM_DESCR, .PKTPTR[NSA$L_PKT_UIC]);
IF NOT .STATUS THEN RETURN .STATUS;
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .LENGTH<0,16,0>;
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .LENGTH<0,16,0>;
PUT_NEWLINE(0);
RETURN SS$_NORMAL;
END;						! End of PUT_PKT_VOLUIC

ROUTINE PUT_PKT_IMGNAM(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first IMGNAM packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_IMGNAM

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    IMGNAM_BUF	= UPLIT(BYTE(%ASCIC '	Image:		'));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(IMGNAM_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_IMGNAM-1]];
IF (.PKTPTR[NSA$W_PKT_SIZE] - NSA$K_PKTHDR_LENGTH) GTRU 0
THEN
    PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_IMGNAM, 1)
ELSE
    PUT_STRING_ASCIC(NONE_BUF);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_IMGNAM

ROUTINE PUT_PKT_FILNAM(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first FILNAM packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_FILNAM

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    FILNAM_BUF	= UPLIT(BYTE(%ASCIC '	File:		'));

PUT_STRING_ASCIC(FILNAM_BUF);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_FILNAM, 1);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_FILNAM

ROUTINE PUT_PKT_FACMOD(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first FACMOD packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_FACMOD

LITERAL
    NUM_FACMOD_BITS = 5;

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    FACMOD_BUF	= UPLIT(BYTE(%ASCIC '	Mode:		'));

OWN
    KEYWORD_VEC	: VECTOR[NUM_FACMOD_BITS]
		  INITIAL(UPLIT(BYTE(%ASCIC 'READ ')),
			  UPLIT(BYTE(%ASCIC 'WRITE ')),
			  UPLIT(BYTE(%ASCIC 'EXECUTE ')),
			  UPLIT(BYTE(%ASCIC 'DELETE ')),
			  UPLIT(BYTE(%ASCIC 'CONTROL')));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(FACMOD_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_FACMOD-1]];
PUT_KEYWORDS(NUM_FACMOD_BITS, PKTPTR[NSA$L_PKT_FACMOD], KEYWORD_VEC);
STRIP_BLANKS_TRAIL(ALARM_DESCR);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_FACMOD

ROUTINE PUT_PKT_PRIVUSED(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first PRIVUSED packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_PRIVUSED

LITERAL
    NUM_PRIVUSED_BITS = 6;

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    PRIV_BUF	= UPLIT(BYTE(%ASCIC '	Privs Used:	'));

OWN
    KEYWORD_VEC	: VECTOR[NUM_PRIVUSED_BITS]
		  INITIAL(UPLIT(BYTE(%ASCIC 'SYSPRV ')),
			  UPLIT(BYTE(%ASCIC 'BYPASS ')),
			  UPLIT(BYTE(%ASCIC 'UPGRADE ')),
			  UPLIT(BYTE(%ASCIC 'DOWNGRADE ')),
			  UPLIT(BYTE(%ASCIC 'GRPPRV ')),
			  UPLIT(BYTE(%ASCIC 'READALL')));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(PRIV_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_PRIVUSED-1]];
IF .PKTPTR[NSA$L_PKT_PRIVUSED] NEQ 0
THEN
    BEGIN
    PUT_KEYWORDS(NUM_PRIVUSED_BITS, PKTPTR[NSA$L_PKT_PRIVUSED], KEYWORD_VEC);
    STRIP_BLANKS_TRAIL(ALARM_DESCR);
    END
ELSE
    PUT_STRING_ASCIC(NONE_BUF);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_PRIVUSED

ROUTINE PUT_PKT_SYSUAFF(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first SYSUAFF packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_SYSUAFF

LITERAL
    NUM_SYSUAFF_BITS = 48;

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    SYSUAFF_BUF	= UPLIT(BYTE(%ASCIC '	Fields Mod:	'));

OWN
    KEYWORD_VEC	: VECTOR[NUM_SYSUAFF_BITS]
		  INITIAL(UPLIT(BYTE(%ASCIC 'ACCESS        ')),
			  UPLIT(BYTE(%ASCIC 'ACCOUNT       ')),
			  UPLIT(BYTE(%ASCIC 'ASTLM         ')),
			  UPLIT(BYTE(%ASCIC 'BATCH         ')),
			  UPLIT(BYTE(%ASCIC 'BIOLM         ')),
			  UPLIT(BYTE(%ASCIC 'BYTLM         ')),
			  UPLIT(BYTE(%ASCIC 'CLI           ')),
			  UPLIT(BYTE(%ASCIC 'CLITABLES     ')),
			  UPLIT(BYTE(%ASCIC 'CPUTIME       ')),
			  UPLIT(BYTE(%ASCIC 'DEFPRIVILEGES ')),
			  UPLIT(BYTE(%ASCIC 'DEVICE        ')),
			  UPLIT(BYTE(%ASCIC 'DIALUP        ')),
			  UPLIT(BYTE(%ASCIC 'DIOLM         ')),
			  UPLIT(BYTE(%ASCIC 'DIRECTORY     ')),
			  UPLIT(BYTE(%ASCIC 'ENQLM         ')),
			  UPLIT(BYTE(%ASCIC 'EXPIRATION    ')),
			  UPLIT(BYTE(%ASCIC 'FILLM         ')),
			  UPLIT(BYTE(%ASCIC 'FLAGS         ')),
			  UPLIT(BYTE(%ASCIC 'INTERACTIVE   ')),
			  UPLIT(BYTE(%ASCIC 'JTQUOTA       ')),
			  UPLIT(BYTE(%ASCIC 'LGICMD        ')),
			  UPLIT(BYTE(%ASCIC 'LOCAL         ')),
			  UPLIT(BYTE(%ASCIC 'MAXDETACH     ')),
			  UPLIT(BYTE(%ASCIC 'MAXJOBS       ')),
			  UPLIT(BYTE(%ASCIC 'MAXACCTJOBS   ')),
			  UPLIT(BYTE(%ASCIC 'NETWORK       ')),
			  UPLIT(BYTE(%ASCIC 'OWNER         ')),
			  UPLIT(BYTE(%ASCIC 'PASSWORD      ')),
			  UPLIT(BYTE(%ASCIC 'PBYTLM        ')),
			  UPLIT(BYTE(%ASCIC 'PFLAGS        ')),
			  UPLIT(BYTE(%ASCIC 'P_RESTRICT    ')),
			  UPLIT(BYTE(%ASCIC 'PGFLQUOTA     ')),
			  UPLIT(BYTE(%ASCIC 'PRCLM         ')),
			  UPLIT(BYTE(%ASCIC 'PRIMEDAYS     ')),
			  UPLIT(BYTE(%ASCIC 'PRIORITY      ')),
			  UPLIT(BYTE(%ASCIC 'PRIVILEGES    ')),
			  UPLIT(BYTE(%ASCIC 'PWDLIFETIME   ')),
			  UPLIT(BYTE(%ASCIC 'PWDMINIMUM    ')),
			  UPLIT(BYTE(%ASCIC 'QUEPRIORITY   ')),
			  UPLIT(BYTE(%ASCIC 'REMOTE        ')),
			  UPLIT(BYTE(%ASCIC 'SFLAGS        ')),
			  UPLIT(BYTE(%ASCIC 'S_RESTRICT    ')),
			  UPLIT(BYTE(%ASCIC 'SHRFILLM      ')),
			  UPLIT(BYTE(%ASCIC 'TQELM         ')),
			  UPLIT(BYTE(%ASCIC 'UIC           ')),
			  UPLIT(BYTE(%ASCIC 'WSDEFAULT     ')),
			  UPLIT(BYTE(%ASCIC 'WSEXTENT      ')),
			  UPLIT(BYTE(%ASCIC 'WSQUOTA       ')));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(SYSUAFF_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_SYSUAFF-1]];
PUT_KEYWORDS(NUM_SYSUAFF_BITS, PKTPTR[NSA$Q_PKT_SYSUAFF], KEYWORD_VEC);
STRIP_BLANKS_TRAIL(ALARM_DESCR);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_SYSUAFF

ROUTINE PUT_PKT_PASSWORD(RECORD_PTR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first PASSWORD packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	SS$_NORMAL or a $FAO system service error.
!--

BEGIN						! Start of PUT_PKT_PASSWORD

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    PASS_BUF	= UPLIT(BYTE(%ASCIC '	Password:	')),
    CONTROL	= %ASCID '!AF';

LOCAL
    PKTPTR	: REF $BBLOCK,
    STATUS	: LONG,
    LENGTH	: LONG;

PUT_STRING_ASCIC(PASS_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_PASSWORD-1]];
!
! Move password to message buffer through the FAO AF filter.
!
STATUS = $FAO(CONTROL, LENGTH, ALARM_DESCR,
    .PKTPTR[NSA$W_PKT_SIZE] - NSA$K_PKTHDR_LENGTH, PKTPTR[NSA$T_PKT_DATA]);
IF NOT .STATUS THEN RETURN .STATUS;
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .LENGTH<0,16,0>;
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .LENGTH<0,16,0>;
PUT_NEWLINE(0);
RETURN SS$_NORMAL;
END;						! End of PUT_PKT_PASSWORD

ROUTINE PUT_PKT_LOGNAM(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first LOGNAM packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_LOGNAM

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    LOGNAM_BUF	= UPLIT(BYTE(%ASCIC '	Log Name:	'));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(LOGNAM_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_LOGNAM-1]];
IF (.PKTPTR[NSA$W_PKT_SIZE] - NSA$K_PKTHDR_LENGTH) GTRU 0
THEN
    PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_LOGNAM, 1)
ELSE
    PUT_STRING_ASCIC(NONE_BUF);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_LOGNAM

ROUTINE PUT_PKT_VOLNAM(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first VOLNAM packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_VOLNAM

MAP
    RECORD_PTR	: REF $BBLOCK;

LOCAL
    PKTPTR	: REF $BBLOCK;

BIND
    VOLNAM_BUF	= UPLIT(BYTE(%ASCIC '	Vol Name:	'));

PUT_STRING_ASCIC(VOLNAM_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_VOLNAM-1]];
IF (.PKTPTR[NSA$W_PKT_SIZE] - NSA$K_PKTHDR_LENGTH) GTRU 0
THEN
    PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_VOLNAM, 1)
ELSE
    PUT_STRING_ASCIC(NONE_BUF);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_VOLNAM

ROUTINE PUT_PKT_VOLSNAM(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first VOLSNAM packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_VOLSNAM

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    VOLSNAM_BUF	= UPLIT(BYTE(%ASCIC '	Vol Set Name:	'));

PUT_STRING_ASCIC(VOLSNAM_BUF);
PUT_PKT_STRING(.RECORD_PTR, NSA$K_PKTTYP_VOLSNAM, 1);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_VOLSNAM

ROUTINE PUT_PKT_VOLPRO(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first VOLPRO packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_VOLPRO

MAP
    RECORD_PTR	: REF $BBLOCK;

LITERAL
    VOLPRO_BUF_SIZ = 27;

BIND
    VOLPRO_BUF	= UPLIT(BYTE(%ASCIC '	Vol Pro:	'));

LOCAL
    PROT_BUF	: VECTOR[VOLPRO_BUF_SIZ,BYTE]
		  INITIAL(BYTE(%ASCII 'S:RWED,O:RWED,G:RWED,W:RWED')),

    PROT_DESCR	: $BBLOCK[DSC$C_S_BLN]
		  PRESET([DSC$W_LENGTH] = VOLPRO_BUF_SIZ,
			 [DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			 [DSC$B_CLASS]	= DSC$K_CLASS_D,
			 [DSC$A_POINTER] = PROT_BUF),
    STRING	: REF VECTOR[,BYTE] INITIAL(PROT_BUF),
    BITS	: REF BITVECTOR,
    INDEX1	: LONG,
    INDEX2	: LONG,
    FLAG	: LONG;

!
! Move the label field into the message buffer and form a pointer to the
! volume protection bits.
!
PUT_STRING_ASCIC(VOLPRO_BUF);
BITS = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_VOLPRO-1]];
!
! A bit set indicates no access so for each bit set convert the access
! letter to a blank.
!
INCR INDEX1 FROM 0 TO 3 DO 
    BEGIN
    FLAG = 0;
    INCR INDEX2 FROM 0 TO 3 DO
	BEGIN
	IF .BITS[.INDEX1*4+.INDEX2]
	THEN
	    PROT_BUF[.INDEX1*7+2+.INDEX2] = ' '
	ELSE
	    FLAG = 1;
	END;
    IF NOT .FLAG THEN PROT_BUF[.INDEX1*7+1] = ' ';
    END;
!
! Compress the field by removing blanks and move it into the alarm buffer.
!
STRIP_BLANKS_STRING(PROT_DESCR);
PUT_STRING_ASCID(PROT_DESCR);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_VOLPRO

ROUTINE PUT_PKT_MOUFLG(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first MOUFLG packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_MOUFLG

LITERAL
    NUM_MOUFLG_BITS = 29;

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    MOUFLG_BUF	= UPLIT(BYTE(%ASCIC '	Mount Flgs:	'));

OWN
    KEYWORD_VEC	: VECTOR[NUM_MOUFLG_BITS]
		  INITIAL(UPLIT(BYTE(%ASCIC 'FOREIGN    ')),
			  UPLIT(BYTE(%ASCIC 'GROUP      ')),
			  UPLIT(BYTE(%ASCIC 'NOASSIST   ')),
			  UPLIT(BYTE(%ASCIC 'NODISKQ    ')),
			  UPLIT(BYTE(%ASCIC 'NOHDR3     ')),
			  UPLIT(BYTE(%ASCIC 'NOLABEL    ')),
			  UPLIT(BYTE(%ASCIC 'NOWRITE    ')),
			  UPLIT(BYTE(%ASCIC 'OVR_ACCESS ')),
			  UPLIT(BYTE(%ASCIC 'OVR_EXP    ')),
			  UPLIT(BYTE(%ASCIC 'OVR_IDENT  ')),
			  UPLIT(BYTE(%ASCIC 'OVR_SETID  ')),
			  UPLIT(BYTE(%ASCIC 'READCHECK  ')),
			  UPLIT(BYTE(%ASCIC 'SHARE      ')),
			  UPLIT(BYTE(%ASCIC 'MESSAGE    ')),
			  UPLIT(BYTE(%ASCIC 'SYSTEM     ')),
			  UPLIT(BYTE(%ASCIC 'WRITECHECK ')),
			  UPLIT(BYTE(%ASCIC 'WRITETHRU  ')),
			  UPLIT(BYTE(%ASCIC 'NOCACHE    ')),
			  UPLIT(BYTE(%ASCIC 'OVR_LOCK   ')),
			  UPLIT(BYTE(%ASCIC 'NOMNTVER   ')),
			  UPLIT(BYTE(%ASCIC 'NOUNLOAD   ')),
			  UPLIT(BYTE(%ASCIC 'NOJRNL     ')),
			  UPLIT(BYTE(%ASCIC 'NEWJRNL    ')),
			  UPLIT(BYTE(%ASCIC 'NOAUTO     ')),
			  UPLIT(BYTE(%ASCIC 'INIT_ALL   ')),
			  UPLIT(BYTE(%ASCIC 'INIT_CONT  ')),
			  UPLIT(BYTE(%ASCIC 'OVR_VOLO   ')),
			  UPLIT(BYTE(%ASCIC 'INTERCHG   ')),
			  UPLIT(BYTE(%ASCIC 'CLUSTER    ')));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(MOUFLG_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_MOUFLG-1]];
PUT_KEYWORDS(NUM_MOUFLG_BITS, PKTPTR[NSA$L_PKT_MOUFLG], KEYWORD_VEC);
STRIP_BLANKS_TRAIL(ALARM_DESCR);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_MOUFLG

ROUTINE PUT_PKT_DMOUFLG(RECORD_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine formats a security alarm message line from the
!	first DMOUFLG packet in the security auditing record.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Formatted message line in the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_DMOUFLG

LITERAL
    NUM_DMOUFLG_BITS = 4;

MAP
    RECORD_PTR	: REF $BBLOCK;

BIND
    DMOUFLG_BUF	= UPLIT(BYTE(%ASCIC '	Mount Flgs:	'));

OWN
    KEYWORD_VEC	: VECTOR[NUM_DMOUFLG_BITS]
		  INITIAL(UPLIT(BYTE(%ASCIC 'NOUNLOAD ')),
			  UPLIT(BYTE(%ASCIC 'UNIT ')),
			  UPLIT(BYTE(%ASCIC 'ABORT ')),
			  UPLIT(BYTE(%ASCIC 'CLUSTER')));

LOCAL
    PKTPTR	: REF $BBLOCK;

PUT_STRING_ASCIC(DMOUFLG_BUF);
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[NSA$K_PKTTYP_DMOUFLG-1]];
PUT_KEYWORDS(NUM_DMOUFLG_BITS, PKTPTR[NSA$W_PKT_DMOUFLG], KEYWORD_VEC);
STRIP_BLANKS_TRAIL(ALARM_DESCR);
PUT_NEWLINE(0);
END;						! End of PUT_PKT_DMOUFLG

ROUTINE PUT_PKT_STRING(RECORD_PTR, PKTTYP, PKTNUM) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine moves the string data from the Nth packet, (Specified
!	by PKTNUM), of type PKTTYP into the alarm buffer.
!
! INPUT:
!	RECORD_PTR	: The security alarm record address.
!	PKTTYP		: The packet type of the data to move.
!	PKTNUM		: Specifies which packet of type PKTTYP to use.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Packet data is moved into the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_PKT_STRING

MAP
    RECORD_PTR	: REF $BBLOCK;

LOCAL
    PKTPTR	: REF $BBLOCK,
    ADDRESS	: REF $BBLOCK,
    SIZE	: LONG;

!
! Form pointer to packet and get the size and data address.
!
PKTPTR = .PKT_POINTER_TAB[.PKT_INDEX_TAB[.PKTTYP-1]+.PKTNUM-1];
SIZE = .PKTPTR[NSA$W_PKT_SIZE] - NSA$K_PKTHDR_LENGTH;
ADDRESS = PKTPTR[NSA$T_PKT_DATA];
!
! The maximum string size that can be placed on one line is defined by
! DATA_LINE_SIZE. If the string is longer than DATA_LINE_SIZE it will be
! split accross multiple lines.
!
WHILE .SIZE GTRU DATA_LINE_SIZE DO
    BEGIN
    !
    ! While the size remaining is more than one line of data, move one line
    ! of data followed by a carriage return line feed and three tabs into
    ! the alarm buffer. Adjust the size remaining and data address.
    !
    PUT_STRING(DATA_LINE_SIZE, .ADDRESS);
    SIZE = .SIZE - DATA_LINE_SIZE;
    ADDRESS = .ADDRESS + DATA_LINE_SIZE;
    PUT_NEWLINE(1);
    END;
!
! Move the remainder of the string into the alarm buffer.
!
PUT_STRING(.SIZE, .ADDRESS);
END;						! End of PUT_PKT_STRING

ROUTINE PUT_KEYWORDS(NUM_BITS, BIT_VEC, KEYWORD_VEC) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine translates a bit vector of bits into their keyword
!	equivalents and moves them into the alarm buffer.
!
! INPUT:
!	NUM_BITS	: The number of bits to translate.
!	BIT_VEC		: Address of the vector of bits to translate.
!	KEYWORD_VEC	: Address of a vector of addresses which point to
!			  ASCIC keyword strings.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	The keyword equivalents of the bits are moved into the alarm buffer.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_KEYWORDS

MAP
    BIT_VEC	: REF BITVECTOR,
    KEYWORD_VEC	: REF VECTOR[,LONG];

LOCAL
    INDEX	: LONG,
    COUNT	: LONG INITIAL(0),
    ADDRESS	: LONG,
    SIZE	: LONG;

INCR INDEX FROM 0 TO .NUM_BITS-1 DO
    BEGIN
    !
    ! If the bit is set then move the corresponding keyword into
    ! the alarm buffer.
    !
    IF .BIT_VEC[.INDEX]
    THEN
	BEGIN
	!
	! Get the keyword size and address. Update the current line count.
	!
	SIZE = .(.KEYWORD_VEC[.INDEX])<0,8,0>;
	ADDRESS = .KEYWORD_VEC[.INDEX] + 1;
	COUNT = .COUNT + .SIZE;
	!
	! If the addition of this keyword would cause this line to exceed
	! DATA_LINE_SIZE, then move a carriage return line feed and three
	! tabs into the alarm buffer and correct the current line count.
	!
	IF .COUNT GTRU DATA_LINE_SIZE
	THEN
	    BEGIN
	    STRIP_BLANKS_TRAIL(ALARM_DESCR);
	    PUT_NEWLINE(1);
	    COUNT = .SIZE;
	    END;
	!
	! Move the keyword into the alarm buffer.
	!
	PUT_STRING(.SIZE, .ADDRESS);	
	END;
    END;
END;						! End of PUT_KEYWORDS

ROUTINE PUT_STRING(SIZE, ADDRESS) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine moves a string specified by SIZE and ADDRESS into the
!	alarm buffer.
!
! INPUT:
!	SIZE		: The size of the string to move.
!	ADDRESS		: The address of the string.
!
! IMPLICIT INPUT:
!	ALARM_DESCR	: The string descriptor of the alarm buffer.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	The string is moved into the alarm buffer and the descriptor is updated.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_STRING

MAP
    SIZE	: LONG;

CH$MOVE(.SIZE, .ADDRESS, .ALARM_DESCR[DSC$A_POINTER]);
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .SIZE;
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .SIZE;
END;						! End of PUT_STRING

ROUTINE PUT_STRING_ASCIC(ASCIC_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine moves an ASCIC string specified by ASCIC_PTR into the
!	alarm buffer.
!
! INPUT:
!	ASCIC_PTR	: The address of a counted ascii string.
!
! IMPLICIT INPUT:
!	ALARM_DESCR	: The string descriptor of the alarm buffer.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	The string is moved into the alarm buffer and the alarm
!	descriptor is updated.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_STRING_ASCIC

MAP
    ASCIC_PTR	: REF VECTOR[,BYTE];

CH$MOVE(.ASCIC_PTR[0], ASCIC_PTR[1], .ALARM_DESCR[DSC$A_POINTER]);
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .ASCIC_PTR[0];
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .ASCIC_PTR[0];
END;						! End of PUT_STRING_ASCIC

ROUTINE PUT_STRING_ASCID(DESCR_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine moves a string specified by DESCR_PTR into the
!	alarm buffer.
!
! INPUT:
!	DESCR_PTR	: Address of the string descriptor.
!
! IMPLICIT INPUT:
!	ALARM_DESCR	: The string descriptor of the alarm buffer.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	The string is moved into the alarm buffer and the alarm descriptor
!	is updated.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_STRING_ASCID

MAP
    DESCR_PTR	: REF $BBLOCK;

CH$MOVE(.DESCR_PTR[DSC$W_LENGTH], .DESCR_PTR[DSC$A_POINTER], .ALARM_DESCR[DSC$A_POINTER]);
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .DESCR_PTR[DSC$W_LENGTH];
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .DESCR_PTR[DSC$W_LENGTH];
END;						! End of PUT_STRING_ASCID

ROUTINE PUT_NEWLINE(FLAGS) : NOVALUE = 

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine moves a carriage return, line feed, and optionally 3 tabs
!	into the alarm buffer.
!
! INPUT:
!	FLAGS		: When 0 only the CRLF is put in the buffer. If 1, a
!			  CRLF and three tabs are moved into the alarm buffer.
!
! IMPLICIT INPUT:
!	ALARM_DESCR	: The string descriptor of the alarm buffer.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	The data is moved into the alarm buffer and the alarm descriptor
!	is updated.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of PUT_NEWLINE

OWN
    CRLFTABS	: VECTOR[5,BYTE] INITIAL(BYTE(13,10,9,9,9));

LOCAL
    SIZE	: LONG;

IF .FLAGS
THEN
    SIZE = 5
ELSE
    SIZE = 2;
CH$MOVE(.SIZE, CRLFTABS, .ALARM_DESCR[DSC$A_POINTER]);
ALARM_DESCR[DSC$W_LENGTH] = .ALARM_DESCR[DSC$W_LENGTH] - .SIZE;
ALARM_DESCR[DSC$A_POINTER] = .ALARM_DESCR[DSC$A_POINTER] + .SIZE;
END;						! End of PUT_NEWLINE

ROUTINE STRIP_BLANKS_TRAIL(DESCR_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine removes trailing blanks from the string described
!	by DESCR_PTR.
!
! INPUT:
!	DESCR_PTR	: The address of a string descriptor.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Trailing blanks are removed from the string described by DESCR_PTR and
!	the descriptor size field is updated.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of STRIP_BLANKS_TRAIL

MAP
    DESCR_PTR	: REF $BBLOCK;

LOCAL
    INDEX	: LONG INITIAL(0);

WHILE .(.DESCR_PTR[DSC$A_POINTER] - 1 - .INDEX)<0,8,0> EQLU  ' ' DO INDEX = .INDEX + 1;
DESCR_PTR[DSC$W_LENGTH] = .DESCR_PTR[DSC$W_LENGTH] + .INDEX;
DESCR_PTR[DSC$A_POINTER] = .DESCR_PTR[DSC$A_POINTER] - .INDEX;
END;						! End of STRIP_BLANKS_TRAIL

ROUTINE STRIP_BLANKS_STRING(DESCR_PTR) : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine removes blanks and compresses the string described
!	by DESCR_PTR.
!
! INPUT:
!	DESCR_PTR	: The address of a string descriptor.
!
! IMPLICIT INPUT:
!	NONE.
!
! OUTPUT:
!	NONE.
!
! IMPLICT OUTPUT:
!	Blanks are removed and the string is compressed. The descriptor
!	size field is updated.
!
! SIDE EFFECTS:
!	NONE.
!
! ROUTINE VALUE:
!	NONE.
!--

BEGIN						! Start of STRIP_BLANKS_STRING

MAP
    DESCR_PTR	: REF $BBLOCK;

LOCAL
    STRING	: REF VECTOR[,BYTE] INITIAL(.DESCR_PTR[DSC$A_POINTER]),
    BLANK_COUNT	: INITIAL(0),
    INDEX	: LONG;

INCR INDEX FROM 0 TO .DESCR_PTR[DSC$W_LENGTH]-1 DO
    BEGIN
    IF .STRING[.INDEX] EQLU ' '
    THEN
	BLANK_COUNT = .BLANK_COUNT + 1
    ELSE
	STRING[.INDEX-.BLANK_COUNT] = .STRING[.INDEX];
    END;
DESCR_PTR[DSC$W_LENGTH] = .DESCR_PTR[DSC$W_LENGTH] - .BLANK_COUNT;
END;						! End of STRIP_BLANKS_STRING

END						! End of SECURITY
ELUDOM
