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
C00005 00003	 CORBEG INBUFH OUTBFH GOTINT FLSCHP TTYLIN PTIBUF COREND LPDL PDL LSNBLK LSNSTS LSNFSK HOST SMRBLK RMRBLK INPBLK ECHOFF TYSBLK IMPSET LINCON LINCOF GAGOFF NTYSTS TERMID TERSTR CLKTIM IDLECT WORKED MAXIDL DOQUIT
C00008 00004	INTRPT CHTSER
C00011 00005	FOO1 FOO2 FOO3 FOO4
C00015 00006	LOOPCL TIMEIN LOOP0 PUPLP0 PUPLP1 PUPIC0
C00019 00007	PUPICH PTILP0 PTILP2 PTILUP PUPSND TIMOUT CLOSED GOAWAY GOAWA2 GOAWA3
C00025 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.
; NOTE: This is eventually to be replaced by regular version of TELSER
printx /Save as PUP001.DMP[NET,SYS] for normal use.
/

; AC definitions.  0→7 are used by NETWRK

X=10 ? A=11 ? B=12 ? C=13 ? D=14 ? P=17

; 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

IODERR==200000			; Some kind of error
IODTER==100000			; Host dead
IOBKTL==040000			; Mark seen
IODEND==020000			; End seen
TMO==	000200			; Timeout
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 LPDL PDL LSNBLK LSNSTS LSNFSK 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

LPDL==40
PDL:	BLOCK LPDL		;stack

LSNBLK:	1			;Opcode = LISTEN
LSNSTS:	0			;Status
	1			;Local socket (GENSYM)
	-1			;Wait for connection
	8			;Bytesize (checked, but not used by PUP)
LSNFSK:	-1			;Foreign socket
HOST:	0			;Host number

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

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

INPBLK:	10			; 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
	MOVE ['CHTSER]
	SETNAM
	MOVE P,[-LPDL,,PDL-]
	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
	MOVE LSNSTS			; check for MTAPE error
	STATO 467600
	TRNE 77
	 FATAL Listen failed
	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

; Log this connection

	OUTSTR [ASCIZ/Connected to /]
	IOPUSH 0,			; preserve our one and only IO channel
	 JRST 4,.			; IO stack overflow!
	PUSHJ P,MAPHST			; map in host table
	MOVE HOST
	HRLI 0,(NW%SU)			; set network field in host number
	PUSHJ P,HSTNUM			; get HDB
	 CAI				; sorry about errors
	MOVEI A,(1)			; host name
	MOVE X,[440700,,TERSTR]
	LDB 2,[000600,,LSNFSK]	;Get low-order bits of foreign socket
	PUSHJ P,TTYSTR		;Try to get TTY location string
	 JRST CPYNET		;Failed
	MOVE A,1		;TTYSTR returns a byte ptr
	JRST CPYHST

CPYNET:	HRLI A,440700
	PUSH P,A		;Save byte ptr to host name
	SKIPA A,[440700,,[ASCIZ/Ethernet /]]
	IDPB B,X
	ILDB B,A
	JUMPN B,.-2
	POP P,A			;Now copy host name
	CAIA
	IDPB B,X
CPYHST:	ILDB B,A
	JUMPN B,.-2
repeat 0,[	 ;no TACs on Ethernet
	HLRZ A,1			; pointer to system name
	MOVE B,(A)			; get system name
	MOVE A,FSOCKT			; and ICP socket
	CAME B,[ASCIZ/TAC/]		; TACs are llke TIPs
	CAMN B,[ASCII/TIP/]		; on a TIP?
	 TRNE A,177774			; just paranoia; make sure a TIP port
	  JRST NOTTIP
	MOVEI B,"#
	IDPB B,X
	LSH A,-16.
	IDIVI A,8.			; ports are octal
	JUMPE A,1DIGTP
	ADDI A,"0 ? IDPB A,X
1DIGTP:	ADDI B,"0 ? IDPB B,X
];repeat 0
NOTTIP:	MOVEI B,0
	IDPB B,X
	PUSHJ P,SETANM			; set our alias name
	PUSHJ P,UNMHST			; map out the host table
	OUTSTR TERSTR
	OUTSTR [ASCIZ/
/]
	IOPOP 0,			; restore IO channel
	 JRST 4,.			; no such channel!
repeat 0,[
	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
];repeat 0
	JRST LOOP0
;LOOPCL TIMEIN LOOP0 PUPLP0 PUPLP1 PUPIC0

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 PUPIC0
	GETSTS A
	TRNE A,IODEND\IODTER\IODERR\TMO	; End or error seen?
	 JRST CLOSED
	TRZN A,IOBKTL		; Mark seen?
	 JRST 4,.-1
;;	SETSTS (A)		; clear status [no longer needed]
	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

PUPIC0:	MOVE A,INBUFH		;Get address of buffer
	ADD A,1(A)		;Address last word in buffer
;	LDB A,[POINT 4,1(A),35]	;Get padding information
	LDB A,[	000400+A,,1]
	SKIPG A,[0?-1?2?-2?4?5?6?-3?10?11?12?13?14?15?16?17](A)
				;Should NEVER skip
	  ADDB A,INBUFH+2	;Update byte count
	JRST PUPICH
;PUPICH PTILP0 PTILP2 PTILUP PUPSND TIMOUT CLOSED GOAWAY GOAWA2 GOAWA3

PUPICH:	MOVE C,TTYLIN
	ILDB 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 0,1
	SLEEP 0,		; 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			; full, no need to mess with padding
	  CAIA
	   JRST CLOSED
	IDPB OUTBFH+1
	ILDB B
	JUMPN PTILUP
PUPSND:	MOVE A,OUTBFH+2
	ANDI A,3
	MOVE A,[0
		1
		3
		7](A)
	SKIPLE OUTBFH		; set fill bits only if buffers are setup properly
	DPB A,[	000420,,OUTBFH+1]
;		POINT 4,@OUTBFH+1,35	; Sigh... This can't be in a literal???
	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

; Wonderful network routines

SVRRTS==0				; no server routines
ERRTNS==0				; no error routines
ERRHAN==0				; no automagic error handling
;ERRINS==<JRST ERRDIE>			; no error instruction
HSTTAB==-1				; include host table magic
HSTSIX==-1				; and alias name kludge
TTYSTS==-1			;and TTY location string code

.INSRT NETWRK

END CHTSER