COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	A INTPTO INTPTI INTCLK INTIMS INTINP IODTER IOBKTL IODEND ECHARR FCS TBXPND FULTWX XON TLKRNG INTBTS
C00004 00003	CORBEG INBUFH OUTBFH GOTINT FLSCHP TTYLIN PTIBUF COREND LSNBLK HOST SMRBLK RMRBLK INPBLK ECHOFF TYSBLK IMPSET LINCON LINCOF GAGOFF NTYSTS TERMID TERSTR CLKTIM IDLECT WORKED MAXIDL DOQUIT
C00007 00004	INTRPT CHTSER
C00009 00005	FOO1 FOO2 FOO3 FOO4
C00011 00006	LOOPCL TIMEIN LOOP0 PUPLP0 PUPLP1
C00014 00007	PUPICH PUPIC1 PTILP0 PTILP2 PTILUP PUPSND TIMOUT CLOSED GOAWAY GOAWA2 GOAWA3
C00020 ENDMK
C⊗;
;A INTPTO INTPTI INTCLK INTIMS INTINP IODTER IOBKTL IODEND ECHARR FCS TBXPND FULTWX XON TLKRNG INTBTS

TITLE CHTSER
SUBTTL Definitions

; Mark Crispin, SU-AI, February '81

; Ethernet TELNET server -- save as PUP001.DMP[NET,SYS] for normal use.

; AC definitions

A=1 ? B=2 ? C=3 ? D=4


; System definitions

INTPTO==001000,,		; PTY output interrupt
INTPTI==010000,,		; PTY-needs-input interrupt
INTCLK==000200,,		; clock interrupts
INTIMS==000020,,		; closed interrupt
INTINP==000010,,		; input interrupt
INTQUIT==002000			; (right half) interrupt on monitor QUIT cmd
INTBTS==INTPTO\INTCLK\INTINP\INTIMS\INTQUIT

JOBCNI=126			; loc containing interrupt bits upon interrupt

IODTER==100000			; Time out
IOBKTL==040000			; Mark seen
IODEND==020000			; End seen
ECHARR==010000,,		; echo controls with uparrow
FCS==   000020,,		; full character set
TBXPND==000010,,		; software tabs
FULTWX==000004,,		; no echo
XON==   000002,,		; paper tape mode
TLKRNG==000001,,		; in talk ring

; Macros

DEFINE FATAL TEXT
 JRST [	OUTSTR [ASCIZ\!TEXT
\]
	EXIT 1,
	JRST .-1]
TERMIN
;CORBEG INBUFH OUTBFH GOTINT FLSCHP TTYLIN PTIBUF COREND LSNBLK HOST SMRBLK RMRBLK INPBLK ECHOFF TYSBLK IMPSET LINCON LINCOF GAGOFF NTYSTS TERMID TERSTR CLKTIM IDLECT WORKED MAXIDL DOQUIT

SUBTTL Data area

CORBEG==.			; first loc zeroed at init time

INBUFH:	BLOCK 3			; input buffer header
OUTBFH:	BLOCK 3			; output buffer header

GOTINT:	BLOCK 1			; -1 → got an interrupt
FLSCHP:	BLOCK 1			; -1 → ignore following character
TTYLIN:	BLOCK 1			; remember PTY line number here
PTIBUF:	BLOCK 30.		; PTY input buffer

COREND==.-1

LSNBLK:	1			; listen for connection
	0			; status word
	1			; socket number
HOST:	0			; host number returned here

SMRBLK:	2			; send Mark
	0			; status word
	6			; Timing Mark Reply

RMRBLK:	3			; read last Mark
	0			; status word
	0			; Mark type returned here

INPBLK:	4			; skip if input available
	0			; status word

ECHOFF:	001400,,(FULTWX)	; echo off

TYSBLK==.			; TTYSET command block
IMPSET:	034400,,		; IMP TTY
LINCON:	001400,,(ECHARR\FCS\TBXPND) ; default line chars
LINCOF:	002400,,(XON\FULTWX)
GAGOFF:	024400,,		; gag off
NTYSTS==.-TYSBLK

TERMID:	'TERMID			; terminal ID for FINGER
TERSTR:	BLOCK 10.

CLKTIM==15.*60.			; time between clock ints (some seconds)
IDLECT:	0			; count of times through main loop while idle
WORKED:	-1			; nonzero if did work this time around main loop
MAXIDL==3			; idle count at which we go away if no job

DOQUIT:	0			; nonzero if seen QUIT cmd on PTY
;INTRPT CHTSER

SUBTTL Start of program

;Interrupt routine
INTRPT:	SETOM GOTINT
	MOVE A,JOBCNI		; get cause of interrupt
	TRNE A,INTQUIT		; is this a QUIT interrupt?
	SETOM DOQUIT		; yes, tell main routine to go away
	DISMIS

;Main program
CHTSER:	CAI
	RESET			; flush all I/O
	PTYGET A		; snarf a PTY
	 FATAL Unable to get any PTY
	HRRZM A,TTYLIN
	SETZM DOQUIT		; haven't seen QUIT cmd yet
	SETZM IDLECT		; haven't been idle yet
	INIT
	 SIXBIT/PUP/
	 OUTBFH,,INBUFH
	 JRST 4,.-1
	MOVEI 8.		; change byte size in buffer header
	DPB [300600,,INBUFH+1]
	DPB [300600,,OUTBFH+1]
	INBUF
	OUTPUT			; for some reason OUTBUF loses
	SETSTS			; kill IOIMPM bit
	MTAPE LSNBLK		; accept the connection
	 FATAL Listen failed
	MOVE ['CHTSER]
	SETNAM
	MOVS TTYLIN		; set up TTYSET command words
	IRPS FOO,,ECHOFF IMPSET LINCON LINCOF GAGOFF
	 IORM FOO
	TERMIN
	HRROI ECHOFF
	TTYSET
	MOVE A,TTYLIN		; get TTY line number back
	MOVEI B,[ASCIZ/Hello
/]
	PTWRS7 A
	MOVE [-NTYSTS,,TYSBLK]	; set up initial TTY status
	TTYSET
	LOCK
	MOVEI INTRPT
	MOVEM JOBAPR		; set up interrupt server address
	CLKINT CLKTIM		; set up keep alive time (also used for idle check)
	MOVE [INTBTS]
	INTENB			; enable interrupts
;FOO1 FOO2 FOO3 FOO4

	MOVEI TERMID
	MOVEM JOBVER
	MOVE A,[440700,,TERSTR]
	SKIPA B,[440700,,[ASCIZ/Ethernet host /]]
	 IDPB A
	ILDB B
	JUMPN .-2
	LDB B,[101000,,HOST]	; get network number
	IDIVI B,100		; split into separate parts
	IDIVI C,10
	JUMPE B,[JUMPE C,FOO2
		 JRST FOO1]
	ADDI B,"0
	IDPB B,A
FOO1:	ADDI C,"0
	IDPB C,A
FOO2:	ADDI D,"0
	IDPB D,A
	MOVEI "#		; network/host delimiter
	IDPB A
	LDB B,[001000,,HOST]	; get host number
	IDIVI B,100		; split into separate parts
	IDIVI C,10
	JUMPE B,[JUMPE C,FOO4
		 JRST FOO3]
	ADDI B,"0
	IDPB B,A
FOO3:	ADDI C,"0
	IDPB C,A
FOO4:	ADDI D,"0
	IDPB D,A
	SETZ			; tie off line
	IDPB A
	JRST LOOP0
;LOOPCL TIMEIN LOOP0 PUPLP0 PUPLP1

SUBTTL Main program

LOOPCL:	AOS A,IDLECT		; increment idle count
	SKIPE WORKED		; were we really idle?
TIMEIN:	SETZB A,IDLECT		; no, restart count
	SKIPE DOQUIT		; QUIT cmd seen?
	JRST GOAWAY		; yes, close up shop
	CAIL A,MAXIDL		; idle too long?
	JRST TIMOUT		; yes, see if any job on our pty
comment $
outchr [60
	61
	62
	63
	64](A)
skipe gotint
outchr [56] ;"."	$
	SKIPN GOTINT		; got an interrupt?
	 IMSTW [INTBTS]		; no, wait for an interrupt to happen
LOOP0:	INTMSK [0]		; mask off all interrupts
	SETZM GOTINT		; flag no interrupts here
	SETZM WORKED		; haven't found any useful work to do yet
PUPLP0:	SOSLE INBUFH+2		; any data in buffer?
	 JRST PUPICH		; yes, go read a char
	HRRZ A,INBUFH		; no, look for more buffers
	HRRZ A,(A)
	SKIPGE (A)		; anything in further buffers?
	 JRST PUPLP1		; yes, get it
	MTAPE INPBLK		; no, anything in system?
	 JRST PTILP0		; no, look for some output from pty
PUPLP1:	SETOM WORKED		; supposedly we'll find something to do
; outchr [156] ;n
	IN			; get the buffer
	 JRST PUPICH
	GETSTS A
	TRZE A,IODEND\IODTER	; End seen?
	 JRST CLOSED
	TRZN A,IOBKTL		; Mark seen?
	 JRST 4,.-1
	SETSTS (A)		; clear status
	MTAPE RMRBLK		; read the mark
	 JRST CLOSED
	MOVE RMRBLK+2		; get Mark type
;; Until implemented
;;	CAIN 1			; Data Mark?
;;	 AOS NTOINP
	CAIN 5			; Timing Mark?
	 JRST [	MTAPE SMRBLK	; yes, send Timing Mark Reply
		 JRST CLOSED
		JRST PUPLP0]
	CAIL 2			; between Line Width
	 CAILE 4		; and Terminal Type?
	  JRST PUPLP0		; no, ignore
	SETOM FLSCHP		; yes, ignore one byte
	JRST PUPLP0
;PUPICH PUPIC1 PTILP0 PTILP2 PTILUP PUPSND TIMOUT CLOSED GOAWAY GOAWA2 GOAWA3

PUPICH:	IBP INBUFH+1		; point byte pointer at proper word
	MOVEI A,3		; padding bytes in this word?
	AND A,@INBUFH+1		; get count of padding bytes
	JUMPE A,PUPIC1		; no padding, charge on
	MOVE @INBUFH+1		; right justify the data in the word
	ANDCM A			; turn off the padding bytes
	XCT (A)[LSH -24.	; one significant byte
		LSH -16.	; two significant bytes
		LSH -8.]-1	; three significant bytes
	MOVEM @INBUFH+1
	XCT (A)[MOVEI 041000
		MOVEI 141000
		MOVEI 241000]-1
	HRLM INBUFH+1		; update the buffer header byte pointer
	SUBI A,4		; compute negative number of padding bytes
	ADDM A,INBUFH+2		; discount padding bytes from buffer header
PUPIC1:	MOVE C,TTYLIN
	LDB D,INBUFH+1
	AOSN FLSCHP		; send character to PTY unless need to ignore
	JRST PUPLP0
	PTWR1S C
	 AOSA INBUFH+2		; failed, backup the byte count, input buffer full
	JRST PUPLP0
	MOVSI A,100000
	ADDM A,INBUFH+1		; backup the byte pointer
	STATZ IODEND		; connection closed?
	 JRST CLOSED		; yes, go away
	MOVE A,TTYLIN		; read buffer from PTY
	MOVE B,[441140,,PTIBUF]
	PTRDS A			; read without waiting
	ILDB B
	JUMPN PTILP2		; jump if read anything from PTY
	MOVEI A,1
	SLEEP A,		; sleep a second, maybe PTY will read some input
	MOVE B,[441140,,PTIBUF]
	PTRDS A			; read without waiting
	ILDB B
	JUMPN PTILP2		; jump if read anything from PTY
	ILDB D,INBUFH+1		; get back the char
	SOS INBUFH+2		; decrement the count again
	PTWR1S C		; one last attempt to send char to PTY
	 TDZA B,B		; lost, echo bell, set up empty byte ptr
	JRST PUPLP0		; won at last
	MOVEI ↑G		; a bell to warn of input buffer full
	JRST PTILP2		; send the bell back

PTILP0:	STATZ IODEND		; connection closed?
	 JRST CLOSED		; yes, go away
	MOVE A,TTYLIN		; read buffer from PTY
	MOVE B,[441140,,PTIBUF]
	PTRDS A			; read without waiting
	ILDB B
	JUMPE LOOPCL		; jump if didn't read anything from PTY
PTILP2:	SETOM WORKED		; we found something, so haven't been idle
; outchr [120] ;P
PTILUP:	ANDI 377
	SOSG OUTBFH+2
	 OUT
	  CAIA
	   JRST CLOSED
	IDPB OUTBFH+1
	ILDB B
	JUMPN PTILUP
PUPSND:	OUTPUT			; send the buffer
	JRST PUPLP0		; Go look for more output, after checking
				; first checking for pending input.

TIMOUT:	HRRZ A,TTYLIN		; number of our pty
	TTYJOB A,		; see if any job on the pty
	JUMPN A,TIMEIN		; jump if job logged in, or pty INITed/ASSIGNed
	HRRZ A,TTYLIN		; pty number
	PTGETL A		; get line characteristics
	TLNE B,(TLKRNG)		; is pty in a talk ring?
	JRST TIMEIN		; pty in talk ring, stick around longer
; close
	OUTSTR [ASCIZ/Idle too long, no job logged in, quitting/]
; movei 63	;hang around a little to allow debugging
; sleep
; sleep
	EXIT

CLOSED:	OUTSTR [ASCIZ/Connection closed/]
	JRST GOAWA3

GOAWAY:	OUTSTR [ASCIZ/QUIT cmd seen; closing connection./]
	JRST GOAWA3

GOAWA2:	MOVEI A,1
	SLEEP A,		; wait for chance to place forced command
GOAWA3:	HRRZ A,TTYLIN		; number of our pty
	MOVEI B,10		; detach command
	PTJOBX A		; detach any job still here
	 JRST GOAWA2		; try again in a moment
	MOVEI A,1
	SLEEP A,		; wait for detach to happen before flushing PTY
	EXIT

END CHTSER