.TITLE 	WHO	FIND OUT WHO IS USING THE SYSTEM
	.IDENT	/01.00/
; D. ELDERKIN  27-APR-78
;
;
; MODIFIED BY:
;
;	D. ELDERKIN 23-OCT-78
;	REMOVE DIRECT REFERENCES TO I/O DATABASE (NOW USER NO-ACCESS) AND
;	DO $GETDEV INSTEAD.
;
;	J. THOMPSON  INTERMETRICS  30-APR-79
;	FIND ACTUAL USER NAME FROM UIC VS NAME INFO IN FORTRAN ROUTINE USER.
;
; LOCAL MACROS
;
 
	.MACRO	TEXT ABC,?A,?B
	.WORD	B-A
	.WORD	0
	.LONG	A
A:
	.ASCII	%ABC%
B:
	.ENDM
 
	.MACRO	STATUS	ERRNUM,?A
	BLBS	R0,A
	PUSHL	#ERRNUM			;PUSH THE ERROR NUMBER
	BSBW	ERROR
A:
	.ENDM
 
	.MACRO	DEFINE_ERROR	ERROR_NAME,MESSAGE
ERROR_NAME=ERRNUM
ERRNUM=ERRNUM+1
	.WORD	ERROR_NAME'_MSG
	.PSECT	TEXT
ERROR_NAME'_MSG:
	.ASCIC	&MESSAGE&
	.PSECT	DATA,QUAD
	.ENDM
;
; EXTERNAL SYMBOLS
;
 
	$DIBDEF				;DEFINE DEVICE INFORMATION OFFSETS
	$JPIDEF				;DEFINE JPI CONSTANTS
 
;
; LOCAL DATA
;
	.PSECT	DATA,QUAD
DATA::
OUT_FAB:				;FAB FOR TERMINAL OUTPUT
	$FAB	FAC=PUT,FNA=OUT_NAM,-
		FNS=OUT_SIZE,ORG=SEQ,-
		RFM=FIX,MRS=80,RAT=CR
OUT_RAB:				;RAB FOR TERMINAL OUTPUT
	$RAB	RAC=SEQ,RSZ=80,-
		FAB=OUT_FAB,RBF=OUT_BUF,-
		RSZ=MSG_LEN
OUT_NAM:				;NAME OF OUTPUT DEVICE
	.ASCII	/SYS$OUTPUT/
OUT_SIZE=.-OUT_NAM
OUT_BUFD:
	.WORD	80
	.WORD	0
	.LONG	OUT_BUF
DIB_BUFF_DESC:				;DESCRIPTOR OF DIB BUFFER
	.WORD	DIB$K_LENGTH
	.WORD	0
	.LONG	DIB_BUFF
OUT_BUF:				;BUFFER FOR OUTPUT LINE
	.ASCII	<13><10>/ Term	  PID		Process Name	   UIC          User Name/<13><10>
MSG_LEN=.-OUT_BUF
	.BLKB	80-MSG_LEN		;FILL OUT REMAINDER OF BUFFER
	.ALIGN	QUAD
DIB_BUFF:				;BUFFER FOR $GETDEV
	.BLKB	DIB$K_LENGTH		;ALLOCATE ENOUGH ROOM
JPILIST:				;LIST OF INFORMATION FOR GETJPI
	.WORD	15,JPI$_PRCNAM		;NAME OF PROCESS
	.LONG	PRCNAM_BUF		;ADDRESS OF BUFFER FOR NAME
	.LONG	PRCNAM_BUF_LEN		;ADDRESS OF LENGTH OF BUFFER
	.WORD	4,JPI$_UIC		;UIC OF PROCESS
	.LONG	UIC_BUF
	.LONG	UIC_BUF_LEN
	.LONG	0			;END OF LIST
PIDADR:					;SPACE TO STORE PID
	.BLKL	1
UIC_BUF_LEN:				;LENGTH OF UIC BUFFER
	.BLKW	1
PRCNAM_BUF_LEN:				;LENGTH OF PROCESS NAME BUFFER
PRCNAM_DESC:				;THIS IS ALSO A DESCRIPTOR
	.BLKW	1
	.WORD	0
	.LONG	PRCNAM_BUF		;COMPLETE THE DESCRIPTOR
PRCNAM_BUF:				;BUFFER FOR NAME OF PROCESS
	.BLKB	16
UIC_BUF:				;BUFFER FOR UIC OF PROCESS
	.BLKL	1
DEV_NAM_DESC:				;DESCRIPTOR FOR DEVICE NAME
	.WORD	4
	.WORD	0
	.LONG	DEV_NAM
DEV_NAM:				;DEVICE NAME STRING
	.ASCII	/OPA0/			;START WITH OPERATOR'S TERMINAL
USENAM_DESC:				;USER NAME DESCRIPTOR
	.WORD	12
	.WORD	0
	.LONG USENAM_BUF
USENAM_BUF:
	.BLKB	12
;
; FAO INFORMATION
;
FAO_DESC:
	TEXT	<** !AC ** AT PC= !XL>
FAO1:					;CONTROL STRING FOR MAIN MESSAGE
	TEXT	<_!AS!_!XL!_!15<!AS!>!_[!OB,!OB]!_!12<!AS!>>
;
; ERROR MESSAGES
;
ERRNUM=0				;START COUNTING ERRORS AT 0
ERROR_TABLE:				;START OF ERROR TABLE
	DEFINE_ERROR	BADERROR,<ERROR FROM RMS>
	DEFINE_ERROR 	PUTERROR,<Error writing to SYS$OUTPUT>
	DEFINE_ERROR	JPIERROR,<Error during GETJPI, check privledges>
	DEFINE_ERROR	DEVERROR,<Error during GETDEV, check privledges>
;+
; WHO - ROUTINE TO DETERMINE WHO IS ON WHAT TERMINALS
;
; FUNCTIONAL DESCRIPTION:
;
;	THIS ROUTINE SCANS THE STARLET I/O DATABASE TO FIND ALL TERMINALS
; WHICH ARE OWNED.  WHENEVER SUCH A TERMINAL IS ENCOUNTERED (AS DETERMINED
; BY A NONZERO VALUE OF UCB$L_PID), THE ROUTINE DOES A GETJPI USING THE PID
; FROM THE UCB.  THIS YIELDS THE PROCESS NAME AND UIC FOR THE TARGET PROCESS.
; THESE VALUES ALONG WITH THE TERMINAL NAME ARE FORMATTED AND OUTPUT ON
; SYS$OUTPUT USING RMS.
;
; INPUTS:
;
;	NONE
;
; IMPLICIT INPUTS:
;
;	I/O DATABASE AS DESCRIBED BY IOC$GL_DEVLIST.
;
; OUTPUTS:
;
;	A LIST OF OWNED TERMINALS (AND THEIR OWNERS) IS SENT TO SYS$OUTPUT
;-
	.PSECT	CODE,QUAD
	.ENABL	LSB
START::
	.WORD	0
	$OPEN	FAB=W^OUT_FAB		;OPEN SYS$OUTPUT
	STATUS	BADERROR		;CHECK STATUS
	MOVAL	W^OUT_RAB,R11		;POINT TO THE OUTPUT RAB
	$CONNECT (R11)			;CONNECT TO THE FAB
	STATUS	BADERROR
	$PUT	(R11)			;PUT OUT THE HEADING MESSAGE
	STATUS	PUTERROR		;CHECK FOR SUCCESS
;
; NOW BEGIN SEARCHING THE DATA BASE FOR TERMINALS
;
	MOVAB	W^DEV_NAM_DESC,R10	;POINT TO ASCII DEVICE NAME
	MOVAQ	W^DIB_BUFF_DESC,R9	;POINT TO DIB DESCRIPTOR
10$:
	$GETDEV_S DEVNAM=(R10),-	;GET DEVICE INFORMATION ON
		PRIBUF=(R9)		;INDIVIDUAL TERMINALS
	CMPL	R0,#SS$_NOSUCHDEV	;DOES THE DEVICE EXISTS
	BNEQ	20$			;IF YES, CONTINUE
	BRW	END			;ELSE FINISH UP
20$:
	STATUS	DEVERROR		;CHECK FOR SUCCESS
	MOVL	4(R9),R2		;POINT TO DIB BUFFER
	TSTL	DIB$L_PID(R2)		;ANY PID?
	BEQL	25$			;IF EQL NO, CONTINUE WITH NEXT DEVICE
;
; WE HAVE NOW FOUND A UCB WHICH IS OWNED BY SOMEONE
; FIND OUT WHO OWNS IT.
;
	$GETJPI_S PIDADR=DIB$L_PID(R2),- ;GET INFORMATION ABOUT THIS PROCESS
		ITMLST=W^JPILIST
	STATUS	JPIERROR		;CHECK FOR SUCCESS
;
; OBTAIN THE ACTUAL USER NAME
;
	PUSHAQ	W^USENAM_DESC		;PUSH USER NAME DESCRIPTOR ADDRESS
	PUSHAW	W^UIC_BUF		;PUSH MEMBER NUMBER ADDRESS
	PUSHAW	W^UIC_BUF+2		;PUSH GROUP NUMBER ADDRESS
	CALLS	#3,USER			;CALL FORTRAN SUBROUTINE USER
;
; FORMAT THE INFORMATION TO BE PUT OUT
;
	PUSHAQ	W^USENAM_DESC		;PUSH USER NAME ADDRESS DESCRIPTOR
	MOVZWL	W^UIC_BUF,-(SP)		;PUSH MEMBER NUMBER
	MOVZWL	W^UIC_BUF+2,-(SP)	;PUSH GROUP NUMBER
	PUSHAQ	W^PRCNAM_DESC		;PUSH ADDRESS OF PROCESS NAME DESCRIPT
	PUSHL	DIB$L_PID(R2)		;PUSH THE PID
	PUSHL	R10			;PUSH THE DEV NAME DESCRIPTOR ADDRESS
	PUSHAQ	W^OUT_BUFD		;PUSH ADDRESS OF OUTPUT BUFFER
	PUSHAW	RAB$W_RSZ(R11)		;PUSH ADDRESS OF OUTPUT LENGTH
	PUSHAQ	W^FAO1			;PUSH ADDRESS OF CONTROL STRING
	CALLS	#9,@#SYS$FAO		;PERFORM THE SYSTEM SERVICE
	$PUT	(R11)			;AND PUT OUT THE LINE
	STATUS	PUTERROR		;CHECK FOR SUCCESS
25$:
	MOVL	4(R10),R0		;GET ADDRESS OF DEVICE NAME STRING
	CMPW	(R0),#^A/OP/		;IS THIS THE OPERATOR'S TERMINAL?
	BNEQ	30$			;IF NEQ NO, MAKE NEXT CHECK
	MOVW	#^A/TT/,(R0)		;MOVE ON TO TTA0
	BRB	50$
30$:
	CMPB	3(R0),#^A/7/		;TIME TO WRAP TERMINAL NUMBER?
	BNEQ	40$			;IF NEQ NO, MAKE NEXT CHECK
	INCB	2(R0)			;CHANGE UNIT NUMBER (CRUDELY!)
	MOVB	#^A/0/,3(R0)		;RESET THE UNIT NUMBER
	BRB	50$			;MOVE ON
40$:
	INCB	3(R0)			;BUMP UP UNIT NUMBER
50$:
	BRW	10$			;CONTINUE ON TO NEXT UCB
END:
	$CLOSE	FAB=W^OUT_FAB		;CLOSE THE OUTPUT STREAM
	$EXIT_S				;AND EXIT
 
 
;+
; ERROR - ERROR MESSAGE PROCESSING
;
; INPUTS:
;
;	(SP) = PC AT WHICH ERROR WAS DETECTED
;	4(SP)= ERROR CODE
;	R11  = ADDRESS OF SYS$OUTPUT RAB
;
; IMPLICIT INPUTS:
;
;	ERROR_TABLE IS A TABLE OF ERROR MESSAGE DESCRIPTORS INDEXED BY ERROR NUM
;
; OUTPUTS:
;
;	THE ERROR MESSAGE IS SENT TO SYS$OUTPUT (IF POSSIBLE) AND THE PROGRAM 
; EXITS.
;-
	.DSABL	LSB
ERROR:
	SUBL3	#6,(SP)+,R9		;FETCH ERRANT PC
	MOVL	(SP)+,R10		;AND ERROR NUMBER
	BEQL	10$			;IF EQL, BAD ERROR, NO MESSAGE
	PUSHL	R0			;SAVE THE FAILING STATUS
					;R9 = ERROR PC
					;R10= ERROR MESSAGE NUMBER
	MOVZWL	W^ERROR_TABLE[R10],R10	;GET THE ADDRESS OF THE MESSAGE
	$FAO_S	CTRSTR=W^FAO_DESC,-	;FORMAT THE MESSAGE
		OUTLEN=RAB$W_RSZ(R11),- ;PUT THE LENGTH IN THE RAB
		OUTBUF=W^OUT_BUFD,-	;PUT THE MESSAGE IN THE BUFFER
		P1=R10,P2=R9		;THESE ARE THE PARAMETERS
	$PUT	(R11)			;PUT THE MESSAGE
	POPL	R0			;RESTORE R0
10$:
	$EXIT_S R0			;AND CALL IT A DAY
	.END	START