MODULE AUDSRV_LISTENER (
			LANGUAGE (BLISS32),
			IDENT = 'X-1',
			MAIN = LISTENER_MAIN,
			ADDRESSING_MODE (EXTERNAL = GENERAL)
			) =
BEGIN

!++
! FACILITY:
!
!	Privileged, user mode, hack utilities.
!
! ABSTRACT:
!
!	This program utilizes the listener mailbox feature of the audit
!	server.  This is coupled to a DECtalk unit to vocalize what is
!	actually happening on the node.
!
!--------------------------------------------------------------------------------
!
!	To use this program, it is first necessary to build it.  This is
!	done by using the following commands:
!
!		$ BLISS/LIST/OBJECT AUDSRV_LISTENER
!		$ LINK/MAP AUDSRV_LISTENER
!
!	This program must be run prior to enabling the audit server listener
!	device.  This is because the device must exist and it must be a
!	mailbox.  It is also necessary to define the terminal line which
!	will be used to send the messages to the DECtalk unit.
!
!	The easiest way to accomplish this is to do the following
!
!		$ DEFINE DECTALK_TERMINAL terminal-with-DECtalk-device:
!		$ RUN AUDSRV_LISTENER
!
!	and then from another terminal, enable the listener device (using the
!	logical name) using the command:
!
!		$ SET AUDIT/LISTENER_DEVICE=LISTENER_MAILBOX
!
!					NOTE
!
!	Because this program creates a permanent mailbox with a system logical
!	name and must use the specified terminal line for DECtalk, the user must
!	have PRMMBX, SYSNAM, and SYSPRV (or an ACL on the terminal) prior to
!	running AUDSRV_LISTENER.
!
!--------------------------------------------------------------------------------
!
! AUTHOR:	A. Programmer,		CREATION DATE:	20-Feb-1989
!
! MODIFIED BY:
!
!--

LIBRARY	'SYS$LIBRARY:LIB';

GLOBAL ROUTINE LISTENER_MAIN =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine creates a mailbox (or assigns a channel to an existing
!	mailbox as necessary) which the audit server will use to send security
!	event messages in real-time.  These are then parsed, and the appropriate
!	message built for DECtalk.
!
! CALLING SEQUENCE:
!	LISTENER_MAIN ()
!
! INPUT PARAMETERS:
!	NONE
!
! IMPLICIT INPUTS:
!	NONE
!
! OUTPUT PARAMETERS:
!	NONE
!
! IMPLICIT OUTPUTS:
!	NONE
!
! ROUTINE VALUE:
!	Various RTL library status values.
!
! SIDE EFFECTS:
!	A permanent mailbox may be created.
!
!--

BEGIN

MACRO
	SIGNAL (ERROR) = 
		BEGIN
		EXTERNAL ROUTINE LIB$SIGNAL;
		LIB$SIGNAL (ERROR %IF %LENGTH-1 GTR 0 %THEN, %REMAINING %FI);
		END %,

	SIGNAL_RETURN (ERROR) =
		BEGIN
		EXTERNAL ROUTINE LIB$SIGNAL;
		LIB$SIGNAL (ERROR %IF %LENGTH-1 GTR 0 %THEN, %REMAINING %FI);
		RETURN ERROR OR STS$M_INHIB_MSG;
		END %;

EXTERNAL ROUTINE
	DTK$INITIALIZE,
	DTK$SET_VOICE,
	DTK$SPEAK_TEXT,

	LIB$PUT_OUTPUT;

LITERAL
	MESSAGE_SIZE	= 3072,				! Maximum mailbox message size.
	PACKET_INFO_SIZE	= NAM$C_MAXRSS,		! Size of packet info table entry

	DEF_USER_IDX	= 1,				! Local default account name (for proxy)
	DEVICE_NAM_IDX	= 2,				! Device name packet index
	FINAL_STS_IDX	= 3,				! Final status packet index
	ID_NAME_IDX	= 4,				! Identifier name packet index
	IMAGE_NAM_IDX	= 5,				! Image name packet index
	INSTALL_PRV_IDX	= 6,				! Installed privs packet index
	LOCAL_USER_IDX	= 7,				! Local account name (for proxy)
	OBJECT_NAM_IDX	= 9,				! Object name packet index
	OBJECT_TYP_IDX	= 10,				! Object type packet index
	PROCESS_NAM_IDX	= 11,				! Process name packet index
	REMOTE_NODE_IDX	= 12,				! Remote node name packet index
	REMOTE_USER_IDX	= 13,				! Remote user name packet index
	TERMINAL_IDX	= 14,				! Terminal name packet index
	UAF_SOURCE_IDX	= 15,				! UAF source name packet
	USERNAME_IDX	= 16,				! User name packet index
	VOLUME_NAM_IDX	= 17,				! Volume name packet index

	LAST_IDX	= 18;				! Last index used + 1

LITERAL
	LGI$_CMDINPUT	= %X'00D38064',
	LGI$_DISUSER	= %X'00D3810C',
	LGI$_INVPWD	= %X'00D380FC',
	LGI$_NOSUCHUSER	= %X'00D380F4';

LOCAL
	CURRENT_PACKET	: REF $BBLOCK,			! Current packet in the list
	IO_STATUS	: VECTOR [4, WORD],		! I/O status block
	LAST_BROWSER	: VECTOR [UAF$S_USERNAME, BYTE],	! Last user to browse
	LINE_BUF	: VECTOR [1024, BYTE],		! Speech line buffer
	LINE_DESC	: $BBLOCK [DSC$C_S_BLN],	! Speech line descriptor
	MAILBOX_CHANNEL	: WORD,				! Channel assigned to listener mailbox
	MESSAGE		: $BBLOCK [MESSAGE_SIZE],	! Storage for message
	PACKET_COUNT,					! Number of packets in the message
	PACKET_INFO	: BLOCKVECTOR [LAST_IDX, PACKET_INFO_SIZE, BYTE],	! Packet information
	PACKET_TABLE	: BLOCKVECTOR [LAST_IDX, DSC$C_S_BLN, BYTE],	! Packet present descr table
	POINTER1	: REF $BBLOCK,			! Temp pointer
	POINTER2	: REF $BBLOCK,			! Temp pointer
	POINTER3	: REF $BBLOCK,			! Temp pointer
	POINTER4	: REF $BBLOCK,			! Temp pointer
	STATUS,						! Routine exit status
	TABLE_INDEX,					! Index into packet table
	TEMP_DESC	: VECTOR [2],			! Temporaty descriptor
	VOICE_ID;					! DECtalk voice-id

BIND
	ACCESS_TITLE_1	= $DESCRIPTOR ('!AS is backing up files') : $BBLOCK,
	ACCESS_TITLE_2	= $DESCRIPTOR ('!AS is copying files') : $BBLOCK,
	ACCESS_TITLE_3	= $DESCRIPTOR ('!AS is browsing through a directory') : $BBLOCK,
	ACCESS_TITLE_4	= $DESCRIPTOR ('!AS is browsing through a file') : $BBLOCK,
	AUDIT_TITLE_1	= $DESCRIPTOR ('!AS has changed the auditable events') : $BBLOCK,
	AUDIT_TITLE_2	= $DESCRIPTOR ('!AS has disabled some event auditing') : $BBLOCK,
	AUDIT_TITLE_3	= $DESCRIPTOR ('!AS has enabled some event auditing') : $BBLOCK,
	AUDIT_TITLE_4	= $DESCRIPTOR ('!AS has generated an auditing event') : $BBLOCK,
	BREAKIN_TITLE_1	= $DESCRIPTOR ('A break in by !AS !AS !AS is in progress') : $BBLOCK,
	BREAKIN_TITLE_2	= $DESCRIPTOR ('A break in by !AS is in progress from !AS') : $BBLOCK,
	INSTALL_TITLE_1	= $DESCRIPTOR ('!AS has just installed !AS !AS') : $BBLOCK,
	INSTALL_TITLE_2	= $DESCRIPTOR ('!AS has just removed !AS') : $BBLOCK,
	LOGFAIL_TITLE_1	= $DESCRIPTOR ('The user on !AS !AS') : $BBLOCK,
	LOGFAIL_TITLE_2	= $DESCRIPTOR ('has blown his password') : $BBLOCK,
	LOGFAIL_TITLE_3	= $DESCRIPTOR ('has aborted the login') : $BBLOCK,
	LOGFAIL_TITLE_4	= $DESCRIPTOR ('failed logging in') : $BBLOCK,
	LOGFAIL_TITLE_5	= $DESCRIPTOR ('is attempting to use a disabled account') : $BBLOCK,
	LOGFAIL_TITLE_6	= $DESCRIPTOR ('is attempting to use a nonexistant account') : $BBLOCK,
	LOGIN_TITLE_1	= $DESCRIPTOR ('!AS has !AS !AS') : $BBLOCK,
	LOGOUT_TITLE_1	= $DESCRIPTOR ('!AS !AS has logged out !AS !AS') : $BBLOCK,
	MOUNT_TITLE_1	= $DESCRIPTOR ('!AS has mounted volume !AS on !AS') : $BBLOCK,
	MOUNT_TITLE_2	= $DESCRIPTOR ('!AS has dismounted volume !AS from !AS') : $BBLOCK,
	NETUAF_TITLE_1	= $DESCRIPTOR ('!AS has !AS a proxy to account !AS from user !AS on node !AS') : $BBLOCK,
	RIGHTS_TITLE_1	= $DESCRIPTOR ('!AS has created a new rights database') : $BBLOCK,
	RIGHTS_TITLE_2	= $DESCRIPTOR ('!AS has !AS the identifier !AS') : $BBLOCK,
	SYSUAF_TITLE_1	= $DESCRIPTOR ('!AS has !AS the authorization record for !AS') : $BBLOCK,

	MAILBOX_LOGICAL	= $DESCRIPTOR ('LISTENER_MAILBOX') : $BBLOCK,
	NULL_STRING	= $DESCRIPTOR ('') : $BBLOCK,
	UNKNOWN_USER	= $DESCRIPTOR ('someone') : $BBLOCK;

! Initialize needed storage.

CH$FILL (0, %ALLOCATION (IO_STATUS), IO_STATUS);
CH$FILL (0, %ALLOCATION (LAST_BROWSER), LAST_BROWSER);
CH$FILL (0, %ALLOCATION (LINE_DESC), LINE_DESC);
CH$FILL (0, %ALLOCATION (PACKET_INFO), PACKET_INFO);
CH$FILL (0, %ALLOCATION (PACKET_TABLE), PACKET_TABLE);

LINE_DESC[DSC$A_POINTER] = LINE_BUF;

INCR J FROM 1 TO LAST_IDX
DO PACKET_TABLE[.J, DSC$A_POINTER] = PACKET_INFO [.J, 0,0,0,0];

! Create the necessary mailbox.

STATUS = $CREMBX (PRMFLG = 1,
		  CHAN = MAILBOX_CHANNEL,
		  MAXMSG = MESSAGE_SIZE,
		  BUFQUO = MESSAGE_SIZE * 32,
		  PROMSK = %X'FF00',
		  LOGNAM = MAILBOX_LOGICAL);
IF NOT .STATUS THEN SIGNAL_RETURN (.STATUS);

! Initialize the DECtalk unit.

STATUS = DTK$INITIALIZE (VOICE_ID, $DESCRIPTOR ('DECTALK_TERMINAL'));
IF NOT .STATUS THEN SIGNAL_RETURN (.STATUS);
STATUS = DTK$SET_VOICE (VOICE_ID, %REF (DTK$K_VOICE_FEMALE));
IF NOT .STATUS THEN SIGNAL_RETURN (.STATUS);

! Sit in a loop looking for messages from the audit server.

WHILE 1
DO
    BEGIN
    STATUS = $QIOW (CHAN = .MAILBOX_CHANNEL,
		    FUNC = IO$_READVBLK,
		    IOSB = IO_STATUS,
		    P1 = MESSAGE,
		    P2 = MESSAGE_SIZE);
    IF .STATUS THEN STATUS = .IO_STATUS[0];
    IF NOT .STATUS THEN EXITLOOP;

! Reset all the various pointers.

    INCR J FROM 1 TO LAST_IDX
    DO PACKET_TABLE[.J, DSC$W_LENGTH] = 0;

! Scan the message looking for specific packets.

    CURRENT_PACKET = MESSAGE[NSA$R_PACKET_LIST];
    PACKET_COUNT = .MESSAGE[NSA$W_PACKET_COUNT];
    INCR J FROM 1 TO .PACKET_COUNT
    DO
	BEGIN

! Exit out if I trip off the end of the message.

	IF .CURRENT_PACKET GEQA MESSAGE + .MESSAGE[NSA$W_REC_SIZE]
	THEN EXITLOOP;

! See if the packet is worth noting.

	TABLE_INDEX = 0;
	SELECTONE .CURRENT_PACKET[NSA$W_PACKET_TYPE] OF
	SET
	    [NSA$C_PKT_DEFAULT_USERNAME]:	TABLE_INDEX = DEF_USER_IDX;
	    [NSA$C_PKT_DEVICE_NAME]:		TABLE_INDEX = DEVICE_NAM_IDX;
	    [NSA$C_PKT_FINAL_STATUS]:		TABLE_INDEX = FINAL_STS_IDX;
	    [NSA$C_PKT_ID_NAME]:		TABLE_INDEX = ID_NAME_IDX;
	    [NSA$C_PKT_IMAGE_NAME]:		TABLE_INDEX = IMAGE_NAM_IDX;
	    [NSA$C_PKT_INSTALL_PRIVS]:		TABLE_INDEX = INSTALL_PRV_IDX;
	    [NSA$C_PKT_LOCAL_USERNAME]:		TABLE_INDEX = LOCAL_USER_IDX;
	    [NSA$C_PKT_OBJECT_NAME]:		TABLE_INDEX = OBJECT_NAM_IDX;
	    [NSA$C_PKT_OBJECT_TYPE]:		TABLE_INDEX = OBJECT_TYP_IDX;
	    [NSA$C_PKT_PROCESS_NAME]:		TABLE_INDEX = PROCESS_NAM_IDX;
	    [NSA$C_PKT_REMOTE_NODENAME]:	TABLE_INDEX = REMOTE_NODE_IDX;
	    [NSA$C_PKT_REMOTE_USERNAME]:	TABLE_INDEX = REMOTE_USER_IDX;
	    [NSA$C_PKT_TERMINAL]:		TABLE_INDEX = TERMINAL_IDX;
	    [NSA$C_PKT_UAF_ADD]:		TABLE_INDEX = UAF_SOURCE_IDX;
	    [NSA$C_PKT_UAF_COPY]:		TABLE_INDEX = UAF_SOURCE_IDX;
	    [NSA$C_PKT_UAF_DELETE]:		TABLE_INDEX = UAF_SOURCE_IDX;
	    [NSA$C_PKT_UAF_MODIFY]:		TABLE_INDEX = UAF_SOURCE_IDX;
	    [NSA$C_PKT_UAF_RENAME]:		TABLE_INDEX = UAF_SOURCE_IDX;
	    [NSA$C_PKT_USERNAME]:		TABLE_INDEX = USERNAME_IDX;
	    [NSA$C_PKT_VOLUME_NAME]:		TABLE_INDEX = VOLUME_NAM_IDX;
	TES;

! If a useful packet has been seen, copy the data from the packet, and build the
! descriptor for the data in the packet table.

	IF .TABLE_INDEX GTR 0
	THEN
	    BEGIN
	    PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH] = .CURRENT_PACKET[NSA$W_PACKET_SIZE] -
							NSA$C_PKT_HDR_LENGTH;

! If the packet can not have a device name, simply copy the information.
! Otherwise, remove the initial underscore and trailing colon if present.

	    IF .TABLE_INDEX EQL TERMINAL_IDX
	    OR .TABLE_INDEX EQL DEVICE_NAM_IDX
	    OR .TABLE_INDEX EQL OBJECT_NAM_IDX
	    THEN
		BEGIN
		POINTER1 = CURRENT_PACKET[NSA$R_PACKET_DATA];
		IF .(CURRENT_PACKET[NSA$R_PACKET_DATA])<0,8> EQL %C'_'
		THEN
		    BEGIN
		    PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH] = .PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH] - 1;
		    POINTER1 = .POINTER1 + 1;
		    END;
		IF .(.CURRENT_PACKET + .CURRENT_PACKET[NSA$W_PACKET_SIZE] - 1)<0,8> EQL %C':'
		THEN PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH] = .PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH] - 1;
		CH$MOVE (.PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH],
			 .POINTER1, PACKET_INFO[.TABLE_INDEX, 0,0,0,0]);
		END
	    ELSE
		BEGIN
		CH$MOVE (.PACKET_TABLE[.TABLE_INDEX, DSC$W_LENGTH],
			 CURRENT_PACKET[NSA$R_PACKET_DATA],
			 PACKET_INFO[.TABLE_INDEX, 0,0,0,0]);
		END;
	    END;

! Next packet please.

	CURRENT_PACKET = .CURRENT_PACKET + .CURRENT_PACKET[NSA$W_PACKET_SIZE];
	END;

! Make sure there is always a username (of sorts).

    IF .PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH] EQL 0
    THEN
	BEGIN
	CH$MOVE (.UNKNOWN_USER[DSC$W_LENGTH],
		 .UNKNOWN_USER[DSC$A_POINTER],
		 .PACKET_TABLE[USERNAME_IDX, DSC$A_POINTER]);
	PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH] = .UNKNOWN_USER[DSC$W_LENGTH];
	END;

! Now let the user know what is going on.

    SELECTONE .MESSAGE[NSA$W_RECORD_TYPE] OF
    SET

! Object access.  Let's see if it is interesting.

	[NSA$C_MSG_ACCESS]:
	    BEGIN

! This is only really interesting if the object is a file.

	    IF .PACKET_TABLE[OBJECT_TYP_IDX, DSC$W_LENGTH] GTR 0
	    THEN
		IF .PACKET_INFO[OBJECT_TYP_IDX, 0, 0, 8, 0] EQL ACL$C_FILE
		THEN
		    BEGIN

! See if this access audit is the result of some interesting image.

		    POINTER1 = 0;

! BACKUP.EXE, something is being copied.

		    IF CH$FIND_SUB (.PACKET_TABLE[IMAGE_NAM_IDX, DSC$W_LENGTH],
				    .PACKET_TABLE[IMAGE_NAM_IDX, DSC$A_POINTER],
				    %CHARCOUNT (']BACKUP.EXE'), UPLIT (']BACKUP.EXE'))
		       NEQ 0
		    THEN POINTER1 = ACCESS_TITLE_1;

! COPY.EXE, something is being copied.

		    IF CH$FIND_SUB (.PACKET_TABLE[IMAGE_NAM_IDX, DSC$W_LENGTH],
				    .PACKET_TABLE[IMAGE_NAM_IDX, DSC$A_POINTER],
				    %CHARCOUNT (']COPY.EXE'), UPLIT (']COPY.EXE'))
		       NEQ 0
		    THEN POINTER1 = ACCESS_TITLE_2;

! DIRECTORY.EXE, someone is looking around.

		    IF CH$FIND_SUB (.PACKET_TABLE[IMAGE_NAM_IDX, DSC$W_LENGTH],
				    .PACKET_TABLE[IMAGE_NAM_IDX, DSC$A_POINTER],
				    %CHARCOUNT (']DIRECTORY.EXE'), UPLIT (']DIRECTORY.EXE'))
		       NEQ 0
		    THEN POINTER1 = ACCESS_TITLE_3;

! TYPE.EXE, someone is browsing.

		    IF CH$FIND_SUB (.PACKET_TABLE[IMAGE_NAM_IDX, DSC$W_LENGTH],
				    .PACKET_TABLE[IMAGE_NAM_IDX, DSC$A_POINTER],
				    %CHARCOUNT (']TYPE.EXE'), UPLIT (']TYPE.EXE'))
		       NEQ 0
		    THEN POINTER1 = ACCESS_TITLE_4;

		    IF .POINTER1 NEQA 0
		    THEN
			BEGIN
			LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
			$FAO (.POINTER1,
			      LINE_DESC,
			      LINE_DESC,
			      PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH]);
			STATUS = LIB$PUT_OUTPUT (LINE_DESC);
			STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
			IF NOT .STATUS THEN SIGNAL (.STATUS);
			END;
		    END;
	    END;

! Some auditing state change.

	[NSA$C_MSG_AUDIT]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    IF (.MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_AUDIT_ENABLED)
	    AND (.MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_AUDIT_DISABLED)
	    THEN POINTER1 = AUDIT_TITLE_1
	    ELSE
		BEGIN
		POINTER1 = AUDIT_TITLE_4;
		IF .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_AUDIT_DISABLED
		THEN POINTER1 = AUDIT_TITLE_2;
		IF .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_AUDIT_ENABLED
		THEN POINTER1 = AUDIT_TITLE_3;
		END;
	    $FAO (.POINTER1,
		  LINE_DESC,
		  LINE_DESC,
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH]);
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Breakin detection is starting up.

	[NSA$C_MSG_BREAKIN]:
	    BEGIN
	    IF .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_REMOTE
	    THEN
		BEGIN
		LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
		$FAO (BREAKIN_TITLE_1,
		      LINE_DESC,
		      LINE_DESC,
		      (IF .PACKET_TABLE[REMOTE_USER_IDX, DSC$W_LENGTH] GTR 0
		       THEN PACKET_TABLE[REMOTE_USER_IDX, DSC$W_LENGTH]
		       ELSE UNKNOWN_USER),
		      (IF .PACKET_TABLE[REMOTE_NODE_IDX, DSC$W_LENGTH] GTR 0
		       THEN $DESCRIPTOR ('from')
		       ELSE NULL_STRING),
		      (IF .PACKET_TABLE[REMOTE_NODE_IDX, DSC$W_LENGTH] GTR 0
		       THEN PACKET_TABLE[REMOTE_NODE_IDX, DSC$W_LENGTH]
		       ELSE NULL_STRING));
		STATUS = LIB$PUT_OUTPUT (LINE_DESC);
		STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
		IF NOT .STATUS THEN SIGNAL (.STATUS);
		END;
	    IF .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_DIALUP
	    OR .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_LOCAL
	    THEN
		IF .PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH] GTR 0
		THEN
		    BEGIN
		    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
		    $FAO (BREAKIN_TITLE_2,
			  LINE_DESC,
			  LINE_DESC,
			  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
			  PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH]);
		    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
		    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
		    IF NOT .STATUS THEN SIGNAL (.STATUS);
		    END;
	    END;

! Installed file addition or removal.

	[NSA$C_MSG_INSTALL]:
	    BEGIN
	    TEMP_DESC[1] = CH$FIND_CH (.PACKET_TABLE[OBJECT_NAM_IDX, DSC$W_LENGTH],
				       .PACKET_TABLE[OBJECT_NAM_IDX, DSC$A_POINTER], %C']') + 1;
	    TEMP_DESC[0] = .PACKET_TABLE[OBJECT_NAM_IDX, DSC$W_LENGTH] +
			   .PACKET_TABLE[OBJECT_NAM_IDX, DSC$A_POINTER] -
			   .TEMP_DESC[1];
	    TEMP_DESC[0] = CH$FIND_CH (.TEMP_DESC[0], .TEMP_DESC[1], %C'.') - .TEMP_DESC[1];

	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    $FAO ((SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		   SET
			[NSA$C_INSTALL_ADD]:	INSTALL_TITLE_1;
			[NSA$C_INSTALL_REMOVE]:	INSTALL_TITLE_2;
			[OTHERWISE]:		NULL_STRING;
		   TES),
		  LINE_DESC,
		  LINE_DESC,
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		  TEMP_DESC,
		  (IF .PACKET_TABLE[INSTALL_PRV_IDX, DSC$W_LENGTH] GTR 0
		  THEN $DESCRIPTOR ('with privileges')
		  ELSE NULL_STRING));
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Login failure.

	[NSA$C_MSG_LOGFAIL]:
	    BEGIN
	    IF .PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH] GTR 0
	    THEN
		BEGIN
		IF .PACKET_TABLE[FINAL_STS_IDX, DSC$W_LENGTH] GTR 0
		THEN POINTER1 = (SELECTONE .(.PACKET_TABLE[FINAL_STS_IDX, DSC$A_POINTER])<0,32> OF
				 SET
				    [LGI$_INVPWD]:	LOGFAIL_TITLE_2;
				    [LGI$_CMDINPUT]:	LOGFAIL_TITLE_3;
				    [LGI$_DISUSER]:	LOGFAIL_TITLE_5;
				    [LGI$_NOSUCHUSER]:	LOGFAIL_TITLE_6;
				 TES)
		ELSE POINTER1 = LOGFAIL_TITLE_4;

		LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
		$FAO (LOGFAIL_TITLE_1,
		      LINE_DESC,
		      LINE_DESC,
		      PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH],
		      .POINTER1);
		STATUS = LIB$PUT_OUTPUT (LINE_DESC);
		STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
		IF NOT .STATUS THEN SIGNAL (.STATUS);
		END;
	    END;

! Successful login.

	[NSA$C_MSG_LOGIN]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    $FAO (LOGIN_TITLE_1,
		  LINE_DESC,
		  LINE_DESC,
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		  (SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		   SET
			[NSA$C_BATCH]:		$DESCRIPTOR ('created a batch job');
			[NSA$C_SUBPROCESS]:	$DESCRIPTOR ('created a sub process');
			[NSA$C_NETWORK]:	$DESCRIPTOR ('created a network process');
			[OTHERWISE]:		$DESCRIPTOR ('logged in on');
		   TES),
		  (IF .PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH] GTR 0
		   THEN PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH]
		   ELSE NULL_STRING));
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Successful logout.

	[NSA$C_MSG_LOGOUT]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    $FAO (LOGOUT_TITLE_1,
		  LINE_DESC,
		  LINE_DESC,
		  (SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		   SET
			[NSA$C_BATCH]:		$DESCRIPTOR ('A batch job for');
			[NSA$C_SUBPROCESS]:	$DESCRIPTOR ('A sub process for');
			[OTHERWISE]:		NULL_STRING;
		   TES),
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		  (IF (.MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_LOCAL OR
		       .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_DIALUP)
		   THEN $DESCRIPTOR ('on')
		   ELSE NULL_STRING),
		  (IF (.MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_LOCAL OR
		       .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_DIALUP)
		   THEN PACKET_TABLE[TERMINAL_IDX, DSC$W_LENGTH]
		   ELSE NULL_STRING));
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Volume mount or dismount.

	[NSA$C_MSG_MOUNT]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    $FAO ((SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		   SET
			[NSA$C_VOL_MOUNT]:	MOUNT_TITLE_1;
			[NSA$C_VOL_DISMOUNT]:	MOUNT_TITLE_2;
			[OTHERWISE]:		NULL_STRING;
		   TES),
		  LINE_DESC,
		  LINE_DESC,
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		  PACKET_TABLE[VOLUME_NAM_IDX, DSC$W_LENGTH],
		  PACKET_TABLE[OBJECT_NAM_IDX, DSC$W_LENGTH]);
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Network proxy change.

	[NSA$C_MSG_NETUAF]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    $FAO (NETUAF_TITLE_1,
		  LINE_DESC,
		  LINE_DESC,
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		  (SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		   SET
			[NSA$C_NETUAF_ADD]:	$DESCRIPTOR ('added');
			[NSA$C_NETUAF_DELETE]:	$DESCRIPTOR ('deleted');
			[NSA$C_NETUAF_MODIFY]:	$DESCRIPTOR ('modified');
			[OTHERWISE]:		$DESCRIPTOR ('changed');
		   TES),
		  (IF .PACKET_TABLE[DEF_USER_IDX, DSC$W_LENGTH] GTR 0
		   THEN PACKET_TABLE[DEF_USER_IDX, DSC$W_LENGTH]
		   ELSE IF .PACKET_TABLE[LOCAL_USER_IDX, DSC$W_LENGTH] GTR 0
			THEN PACKET_TABLE[LOCAL_USER_IDX, DSC$W_LENGTH]
			ELSE $DESCRIPTOR ('unknown')),
		  (IF .PACKET_TABLE[REMOTE_USER_IDX, DSC$W_LENGTH] GTR 0
		   THEN PACKET_TABLE[REMOTE_USER_IDX, DSC$W_LENGTH]
		   ELSE $DESCRIPTOR ('unknown')),
		  (IF .PACKET_TABLE[REMOTE_NODE_IDX, DSC$W_LENGTH] GTR 0
		   THEN PACKET_TABLE[REMOTE_NODE_IDX, DSC$W_LENGTH]
		   ELSE $DESCRIPTOR ('unknown')));
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Rights database change.

	[NSA$C_MSG_RIGHTSDB]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    IF .MESSAGE[NSA$W_RECORD_SUBTYPE] EQL NSA$C_RDB_CREATE
	    THEN
		BEGIN
		$FAO (RIGHTS_TITLE_1,
		      LINE_DESC,
		      LINE_DESC,
		      PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH]);
		END
	    ELSE
		BEGIN
		$FAO (RIGHTS_TITLE_2,
		      LINE_DESC,
		      LINE_DESC,
		      PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		      (SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		       SET
			   [NSA$C_RDB_ADD_ID]:	$DESCRIPTOR ('added');
			   [NSA$C_RDB_REM_ID]:	$DESCRIPTOR ('removed');
			   [NSA$C_RDB_MOD_ID]:	$DESCRIPTOR ('modified');
			   [OTHERWISE]:		$DESCRIPTOR ('changed');
		       TES),
		      (IF .PACKET_TABLE[ID_NAME_IDX, DSC$W_LENGTH] GTR 0
		       THEN PACKET_TABLE[ID_NAME_IDX, DSC$W_LENGTH]
		       ELSE $DESCRIPTOR ('unknown')));
		END;
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;

! Authorization file change.

	[NSA$C_MSG_SYSUAF]:
	    BEGIN
	    LINE_DESC[DSC$W_LENGTH] = %ALLOCATION (LINE_BUF);
	    $FAO (SYSUAF_TITLE_1,
		  LINE_DESC,
		  LINE_DESC,
		  PACKET_TABLE[USERNAME_IDX, DSC$W_LENGTH],
		  (SELECTONE .MESSAGE[NSA$W_RECORD_SUBTYPE] OF
		   SET
			[NSA$C_SYSUAF_ADD]:	$DESCRIPTOR ('added');
			[NSA$C_SYSUAF_COPY]:	$DESCRIPTOR ('copied');
			[NSA$C_SYSUAF_DELETE]:	$DESCRIPTOR ('deleted');
			[NSA$C_SYSUAF_MODIFY]:	$DESCRIPTOR ('modified');
			[NSA$C_SYSUAF_RENAME]:	$DESCRIPTOR ('renamed');
			[OTHERWISE]:		$DESCRIPTOR ('changed');
		   TES),
		  PACKET_TABLE[UAF_SOURCE_IDX, DSC$W_LENGTH]);
	    STATUS = LIB$PUT_OUTPUT (LINE_DESC);
	    STATUS = DTK$SPEAK_TEXT (VOICE_ID, LINE_DESC, %REF (DTK$K_WAIT));
	    IF NOT .STATUS THEN SIGNAL (.STATUS);
	    END;
    TES;
    END;

! Return any error status.

RETURN .STATUS;

END;						! End of routine LISTENER_MAIN

END
ELUDOM