	PROGRAM SETTERM
C  run by SYSLOGIN.COM to find out VAX port number
C  sets symbol TERM_CHAR
C	for use by SYSLOGIN.COM
C  9-OCT-1985  Belonis updated to use Huu Le data file formats
c  7-JUN-1986  Belonis updated to handle Micom
c  TERMLIST.SRC format: a5, a40, a30, a30
C
c  general flow:     (exits at various points when no longer applicable)
c     ask VAX for VAX port via $TRNLOG    ?? should use LIB$TRNLNM ?
c     get Micom called channel from VAXPORT.DAT indexed by VAX port
c     talk to Micom to get Micom calling channel with SHOW CH called chan
c     get Chem switch port number from MICOMLIST.DAT accessed by calling chan
c     talk to Chem switch to get Chem switch terminal number with SHOW P_S port
c     get Chem switch terminal characteristics from SWITCHTERM.DAT accessed 
c                                      by chem switch terminal
c
	IMPLICIT INTEGER (A-Z)

	INCLUDE '($IODEF)'
	INCLUDE '($SSDEF)'

	PARAMETER MAXSWITCHPORT=31
	PARAMETER ( PRMFLG = 1 )

	CHARACTER*80 COMMAND
	CHARACTER*10 USER_TERMINAL
	CHARACTER*80 PID_MBX_BUF
	CHARACTER MBX_NAME*15, PID_MBX*14
	CHARACTER*1 BELL
	CHARACTER*4 USER_VAX
	CHARACTER*5 MICOM_CHAN, CALLING_CHAN, DUMMY
	CHARACTER*40 CHARACTERISTICS
        CHARACTER*30 USER_CIRC, USER_LOC
	logical question   ! flag indicating syntax error message from Micom
	integer try	! number of current try talking to Micom
	INTEGER*2 IOSB(4)
	DIMENSION TIMEOUTVAL(2)

	COMMON /CHANS/ MICOM_MBX_CHAN, PID_MBX_CHAN, SWITCH_MBX_CHAN

	EXTERNAL  TIMEOUT_AST

	DATA TIMEOUTVAL(1), TIMEOUTVAL(2)/-50000000, -1/

	BELL=CHAR(7)
C
C GET AN EVENT FLAG
	CALL LIB$GET_EF(EF1)
C
C GET THE TERMINAL DEVICE NAME
	STATUS= SYS$TRNLOG('TT', RSLLEN, USER_TERMINAL,,,)
C IF THE STATUS IS BAD WE ARE PROBABLY A BATCH JOB
	IF (.NOT. STATUS) CALL EXIT(STATUS)
C
C LOCATE THE CONTROLLER AND UNIT FIELDS
	IF( INDEX(USER_TERMINAL,'OP') .NE. 0 ) CALL EXIT  ! Operator console
	IF( INDEX(USER_TERMINAL,'RT') .NE. 0 ) CALL EXIT  ! remote terminal
							! via DECNet
	TTLOC= INDEX(USER_TERMINAL, 'TT')
	if( ttloc.eq.0 ) call exit	! DECNET .COM filename ?
	USER_TERMINAL = USER_TERMINAL(TTLOC:)
	CONTROLLER= ICHAR(USER_TERMINAL(3:3)) - '41'X  ! A=0
	if( CONTROLLER.NE.2 .AND.
	1  (CONTROLLER.LT.6 .OR. CONTROLLER.GT.10) ) CALL EXIT ! not a switch


C  is TTC or TTG-TTK

C OPEN THE FILE FOR VAX PORTS (FROM TTA0 - TTM7:)
	OPEN(UNIT=5, FILE='SWITCH$DIR:VAXPORT.DAT',
	1	ACCESS='KEYED', STATUS='OLD', RECORDTYPE='FIXED',
	1       ORGANIZATION='INDEXED',FORM='UNFORMATTED',
	2	KEY=(1:4:CHARACTER),READONLY, SHARED)
d	print *,'just opened VAXPORT.DAT'
	GOTO 30
 25	WRITE(6,*) 'FAILED TO OPEN VAXPORT.DAT'
	GOTO 500
C
C READ THE Micom switch called channel FOR THIS vax port
30	READ(5,KEYID=0,KEY=USER_TERMINAL(1:4),ERR=35)
	1	                  USER_VAX, USER_CIRC, USER_LOC          
	close(5)
D  	WRITE(6,*) USER_VAX, USER_CIRC, USER_LOC
	mrloc = INDEX(USER_CIRC,'mr:')
	IF( mrloc.NE. 0 ) THEN	! on chem switch
d		 print*,'mrloc=',mrloc
d	         print *, user_circ(mrloc+3:mrloc+7)
	         MICOM_CHAN = USER_CIRC(mrloc+3:mrloc+7)
d	         print *,'micom_chan=',micom_chan
	ELSE	! not on Micom switch
		CALL EXIT
	END IF
	GOTO 50

35	WRITE (6,*) 
	1  ' %SETTERM-F-NORECORD  ',
	1  'Failed to read VAXPORT.DAT record for ',USER_TERMINAL
	WRITE (6,*) '                      Please tell System Manager'
	GOTO 500

c the following talks to Micom switch  BUILT FROM CHEM SWITCH THAT FOLLOWS
C    melded with Peabody's MICOM.FOR
C 
C OPEN A CHANNEL TO THE Micom SWITCH CONTROL MBX
50	CONTINUE

	STATUS= SYS$ASSIGN('MICOM_MBX', MICOM_MBX_CHAN,,)
d	write(6,*) ' micom mailbox chan=',MICOM_MBX_CHAN
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- NO MICOM CONTROL MBX'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF

C DISABLE CTRL-Y'S	?????  why   ????
	CALL LIB$DISABLE_CTRL('02000000'X, OLDMASK)

C Create the return mailbox name from the PID
	WRITE( PID_MBX, '(6HMICOM_,Z8.8)' ) PID()
C Create the return mailbox
	STATUS = SYS$CREMBX(%VAL(PRMFLG), PID_MBX_CHAN,,,,, PID_MBX )
d	write(6,*) ' return mailbox & chan =', PID_MBX, PID_MBX_CHAN
	IF( STATUS.NE.SS$_NORMAL ) THEN
		WRITE(6,*) 'ERR- FAILED TO CREATE MICOM REPLY MBX'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF

C
C SEND A SHOW CH COMMAND TO MICOM_CONTROL TO LEARN OUR shelf/channel
C NUMBER ON THE Micom
C  format request into string COMMAND
	WRITE(COMMAND, 1050) MICOM_CHAN
1050	FORMAT('SHOW CH ',A)
d	WRITE(6,*) COMMAND

60	continue	! comes here to try talking to Micom again
	question = .false.

	STATUS= SYS$QIOW(, %VAL(MICOM_MBX_CHAN), %VAL(IO$_WRITEVBLK),
	1		IOSB,,, %REF(COMMAND), %VAL(16),,,,)
	IF (.NOT. STATUS .OR. .NOT. IOSB(1)) THEN
		WRITE(6,*) 'ERR- QIOW WRITE TO MICOM_CONTROL FAILED'
		CALL PUTMSG(STATUS)
		CALL PUTMSG(IOSB(1))
		GOTO 500
	ENDIF
d	write(6,*) 'finished with write to MICOM_MBX_CHAN'

C Read MICOM reply from PID mailbox

	DO WHILE (.TRUE.)
	   ISTAT = SYS$QIOW(,%VAL(PID_MBX_CHAN),
	1     %VAL(IO$_READVBLK.OR.IO$M_TIMED),
	1     IOSB,,,%REF(PID_MBX_BUF),%VAL(80),%VAL(10),,,) ! 10 sec
	   IF (ISTAT .NE. SS$_NORMAL) then
		write(6,*) 'ERR- cant read from MICOM reply MBX'
		CALL PUTMSG(STATUS)
		CALL PUTMSG(IOSB(1))
		goto 500
	   ENDIF

C Look for end of file (end of message)
	   IF( IOSB(1) .EQ. SS$_ENDOFFILE ) then
		if(try.gt.3) goto 70
	        if(question) goto 60
		GOTO 70	! finished with reply
	   ENDIF
D	   WRITE(6,'(11H IOSB(2) = ,I2)')IOSB(2)
C Write to user's terminal
d	   IF( IOSB(2) .GT. 0 ) THEN
d 	      WRITE(6,'(A)') PID_MBX_BUF(1:IOSB(2))
d	   ELSE
d	      WRITE(6,'(A)')	! blank line
d	   ENDIF

	if(question) goto 65	! ignore lines after question
	if(  index( pid_mbx_buf( 1:iosb(2) ), '?' )  ) then
d		print *,' question mark in reply', pid_mbx_buf(1:iosb(2))
		question = .true.
		try = try + 1
		goto 65		! ignore question line
	endif
C EXTRACT THE CALLING CHANNEL FROM THE REPLY in string PID_MBX_BUF
	callingloc=index(PID_MBX_BUF,' CALLED BY ') + 12 ! note: strip leading 0
	if(callingloc.le.12) then
d	   WRITE(6,*) 'FAILED TO FIND MICOM CALLING CHANNEL IN REPLY= ', PID_MBX_BUF
	else	! the non-blank reply
	   CALLING_CHAN = PID_MBX_BUF(callingloc:callingloc+4)
D	   write(6,*) 'CALLING_CHAN=',CALLING_CHAN
	endif

65	CONTINUE
	ENDDO	!  note: semi-indented DO ??????
70	continue
c  clean up after talking to Micom
	STATUS= SYS$DELMBX(%VAL(PID_MBX_CHAN))
	if(.not.status) then
		write(6,*) 'ERR- cant delete Micom reply MBX'
		goto 500
	endif

	if(callingloc.le.11) then
		WRITE(6,*) 'ERR- CANT FIND CALLING CHAN FROM MICOM'
		goto 500
	endif
c  look up in MICOMLIST.DAT
c  do some tests to see if connected to chem switch
c  if not, then shortcut to define symbol
	OPEN(7,FILE='SWITCH$DIR:MICOMLIST.DAT',
	1	ACCESS='KEYED', STATUS='OLD', RECORDTYPE='FIXED',
	1       ORGANIZATION='INDEXED',FORM='UNFORMATTED',
	2	KEY=(1:5:CHARACTER),READONLY, SHARED)
d	print *,'just opened MICOMLIST.DAT'

	READ(7, KEYID=0, KEY=CALLING_CHAN, ERR=45 )
	1	   DUMMY, CHARACTERISTICS, USER_CIRC, USER_LOC
	close(7)
	goto 47

45	WRITE (6,*) 
	1  ' %SETTERM-F-NORECORD  ',
	1  'Failed to read MICOMLIST.DAT record for ',CALLING_CHAN
	WRITE (6,*) '                      Please tell System Manager'
	GOTO 500

47	continue
d	write(6,*) CHARACTERISTICS, USER_CIRC, USER_LOC
	swloc = index( USER_CIRC, 'sw:' )
	if( swloc.le.0 ) goto 400  ! not on chem switch, have characteristics

c  on Chem switch too
c  tens hex should always be a digit since ports only up to 1F
c	print*,'swloc=',swloc
	dig10 = ichar(user_circ(swloc+3:swloc+3)) - 48
	dig1  = ichar(user_circ(swloc+4:swloc+4))
	if( dig1.ge.65) then  ! its a letter
		dig1 = dig1-55	! A hex=10 decimal
	else	! digit
		dig1 = dig1-48
	end if
d	print *, user_circ(swloc+3:swloc+4)
	SWITCH_PORT = dig10*16 + dig1
d	print *,'port=',SWITCH_PORT

C OPEN A CHANNEL TO THE chem SWITCH CONTROL MBX
	STATUS= SYS$ASSIGN('SWITCH_CONTROL_MBX', SWITCH_MBX_CHAN,,)
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- NO SWITCH CONTROL MBX'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF
C
C DISABLE CTRL-Y'S	?????  why   ????
	CALL LIB$DISABLE_CTRL('02000000'X, OLDMASK)
C
C CREATE A MBX FOR RECEIVING MESSAGES FROM THE SWITCH ???? why permanent ???
	WRITE(MBX_NAME, 1000) PID()
	STATUS= SYS$CREMBX(%VAL(1), PID_MBX_CHAN,,,,, MBX_NAME)
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- FAILED TO CREATE REPLY MBX'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF
C
C QUEUE A TIMER AST REQUEST IN CASE WE GET HUNG UP WAITING FOR
C SWITCH_CONTROL
	STATUS= SYS$SETIMR(%VAL(EF1), TIMEOUTVAL, TIMEOUT_AST, %VAL(1))
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- FAILED TO QUEUE TIMER AST REQUEST'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF
C
C SEND A SHOW P_STATUS COMMAND TO SWITCH_CONTROL TO LEARN OUR TERMINAL
C NUMBER ON THE SWITCH
C  format request into array COMMAND
	WRITE(COMMAND, 1010) SWITCH_PORT
d	write(6,*) ' COMMAND=',COMMAND
	STATUS= SYS$QIOW(, %VAL(SWITCH_MBX_CHAN), %VAL(IO$_WRITEVBLK),
	1			IOSB,,, %REF(COMMAND), %VAL(16),,,,)
	IF (.NOT. STATUS .OR. .NOT. IOSB(1)) THEN
		WRITE(6,*) 'ERR- QIOW WRITE TO SWITCH_CONTROL FAILED'
		CALL PUTMSG(STATUS)
		CALL PUTMSG(IOSB(1))
		GOTO 500
	ENDIF
C
C WAIT FOR THE REPLY into array COMMAND
	STATUS= SYS$QIOW(, %VAL(PID_MBX_CHAN), %VAL(IO$_READVBLK),
	1			IOSB,,,	%REF(COMMAND), %VAL(40),,,,)
	IF (.NOT. STATUS .OR. .NOT. IOSB(1)) THEN
		WRITE(6,*) 'QIOW READ FROM SWITCH_CONTROL FAILED'
		CALL PUTMSG(STATUS)
		CALL PUTMSG(IOSB(1))
		GOTO 500
	ENDIF
C
C EXTRACT THE PORT STATUS FROM THE REPLY  in array COMMAND
	READ(COMMAND, 1020, ERR=100 ) PORT_STATUS
C ASSIGN A DCL SYMBOL TO SHOW SWITCH TERMINAL to last only during current
C command file
D	CALL LIB$SET_SYMBOL('SWITCH_TERM', COMMAND(17:18), 1)
	GOTO 200
C
100	WRITE(6,*) 'FAILED TO FIND PORT STATUS IN REPLY= ', COMMAND
	GOTO 500
C
200	IF (PORT_STATUS .GT. '7E'X) THEN	! bad PORT_STATUS
		WRITE(6,1030) PORT_STATUS
		GOTO 500
	ENDIF
C
	WRITE(6,*) BELL,'** THIS TERMINAL IS ON THE Chem SWITCH.',
	1		' PLEASE TURN IT OFF WHEN YOU LOG OUT. **'

C OPEN THE FILE OF chem switch TERMINAL CHARACTERISTICS
	OPEN(3, FILE= 'SWITCH$DIR:SWITCHTERM.DAT',
	1	ACCESS='DIRECT', STATUS= 'OLD', RECORDTYPE= 'FIXED', 
	2	READONLY, SHARED, ERR= 250)
	GOTO 300

250	WRITE(6,*) 'FAILED TO OPEN TERMLIST.DAT'
	GOTO 500
C
C READ THE CHARACTERISTIC FOR THIS TERMINAL (first 40 characters of record)
300	READ(3'PORT_STATUS+1, ERR=350) CHARACTERISTICS
	GOTO 400		
350	WRITE (6,*) 'ERR- FAILED TO READ CHARACTERISTICS RECORD FOR ',
	1 'THIS TERMINAL'
	GOTO 500
C
C SUCCESS return
C CREATE A DCL LOCAL SYMBOL WITH A VALUE EQUAL TO OUR TERMINAL CHARACTERISTICS
C to last during current command file only
400	continue
	endstring=index(CHARACTERISTICS,' ')-1
	STATUS = LIB$SET_SYMBOL('TERM_CHAR', CHARACTERISTICS(1:endstring), 1)
	IF(.NOT.STATUS) CALL EXIT(STATUS)
C
450	CONTINUE
C  clean up
	STATUS = SYS$DELMBX(%VAL(PID_MBX_CHAN))
	CALL SYS$CANTIM(%VAL(1))
	CALL LIB$ENABLE_CTRL(OLDMASK)
C
	CALL EXIT
C
C comes here if error
500	CONTINUE
	WRITE(6,*) '%SETTERM-F-SWITCHERR Switch software error.'
	WRITE(6,*) '%    Call MANAGER or log out and try again.'
	goto 450
C
1000	FORMAT('SWITCH_', Z8.8)
1010	FORMAT('SHOW P_STATUS ', Z2.2)
1020	FORMAT(16X, Z2)
1030	FORMAT(' ERR- INVALID PORT STATUS ', Z2.2)
	END
C
C
C FUNCTION SUBROUTINE TO DETERMINE PROCESS PID
	INTEGER FUNCTION PID
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 IOSB(4), ITMLST(8)
	EQUIVALENCE (ITMLST(3), BUFADR), (ITMLST(5), RLADR),
	1 (ITMLST(7), LSTEND)
	EXTERNAL JPI$_PID
	ITMLST(1)= 4
	ITMLST(2)= %LOC(JPI$_PID)
	BUFADR= %LOC(PIDBUF)
	RLADR= 0
	LSTEND= 0
	CALL LIB$GET_EF(EF)
	STATUS= SYS$GETJPI(%VAL(EF),,, ITMLST, IOSB,,)
	IF (.NOT. STATUS) CALL EXIT(STATUS)
	CALL SYS$WAITFR(%VAL(EF))
	IF (.NOT. IOSB(1)) CALL EXIT(IOSB(1))
	PID= PIDBUF
	CALL LIB$FREE_EF(EF)
	RETURN
	END
C
C
C TIMER AST ROUTINE
	SUBROUTINE TIMEOUT_AST
	IMPLICIT INTEGER (A-Z)
	COMMON /CHANS/ MICOM_MBX_CHAN, PID_MBX_CHAN, SWITCH_MBX_CHAN
	CALL SYS$CANCEL(%VAL(MICOM_MBX_CHAN))
	CALL SYS$CANCEL(%VAL(PID_MBX_CHAN))
	CALL SYS$CANCEL(%VAL(SWITCH_MBX_CHAN))
	RETURN
	END
