perm filename TELSER.OLD[S,NET]1 blob
sn#666885 filedate 1982-07-01 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 X LOGC INTTTC INTFOP INTMAI INTPTO INTCLK INTQUIT DMLIN ECHARR FCS TBXPND FULTWX XON TLKRNG WRTPRV
C00006 00003 ECHOFF ECHON TYSBLK IMPSET LINCHR XONOFF GAGOFF NTYSTS TERMID CORBEG TERSTR PTINTP NTINTP NTOINP DOQUIT NETCMP RCBINP TRBINP ECHOP SUPGAP WANTBP NODETP NEWLNP LFFLSP TTCHGP MAILP SPYON TTYLIN TPCSAV IDLTIM PTIBUF WHOBUF PDL DPYNAM MAIBOX LOGO COREND
C00010 00004 TPLTAB TPLMIN WDOTAB WDOMAX EXOPL
C00013 00005 INTSER INTSR1 CLKSER
C00016 00006 TELSER CPYHST 1DIGTP NOTTIP
C00019 00007 NOFLAK MAINL MAINL0
C00022 00008 TTCSER STOPBN WANTBN
C00023 00009 NTISER NTISR2 NTISR1 PTYSND
C00026 00010 PTISER PTISR0
C00028 00011 IACSER PRSTAB
C00030 00012 HALTJB ORESET WHOLIN DELCHR DELLIN
C00031 00013 DOSR DONTSR
C00034 00014 WILLSR WONTSR
C00035 00015 LOGM LOGNAM MAISER MAISE0 MAISE2 MAISE3 LOGSIX LOGSI2 LOGCH LOGCH1
C00038 00016 OPTMSG RNDMSG SNDMSG MSGLUP SUIQUI ERRDIE SUICID DIEDIE ...LIT SVRRTS ERRTNS ERRHAN ERRINS HSTTAB HSTSIX
C00042 ENDMK
C⊗;
;X LOGC INTTTC INTFOP INTMAI INTPTO INTCLK INTQUIT DMLIN ECHARR FCS TBXPND FULTWX XON TLKRNG WRTPRV
TITLE TELSER
SUBTTL Definitions
; Mark Crispin, SU-AI, July 1980
; Assembly switches
IFNDEF SVRSKT,SVRSKT==27 ; default listen socket
IFNDEF LOKTMO,LOKTMO==5 ; # of 15-second frobs of lock timeout
IFNDEF PDLLEN,PDLLEN==50 ; stack length
; AC definitions. 0→3 are used by NETWRK
X=4 ? A=5 ? B=6 ? P=17
; I/O channels
;NETWRK package uses 0,1,2 (potentially)
LOGC==4 ;for terminal I/O record
; Macro to send a TELNET command
DEFINE TELCMD CMDLST
OUTSTR [ASCIZ/⊗!CMDLST!*
/]
IRPS CMD,,CMDLST
MOVEI CMD
PUSHJ P,NETOCH
TERMIN
PUSHJ P,NETSND
TERMIN
; SAIL system bit definitions
INTTTC==100000,, ; terminal change
INTFOP==040000,, ; PTY clear output buffer
INTMAI==004000,, ; interrupt for MAIL from LOGIN
INTPTO==001000,, ; PTY interrupt
INTCLK==000200,, ; clock interrupt
INTQUIT==002000 ; (right half) interrupt on QUIT cmd
DMLIN== 040000,, ; terminal is a Datamedia
ECHARR==010000,, ; echo controls with uparrow
FCS== 000020,, ; full character set mode
TBXPND==000010,, ; expand tabs to spaces
FULTWX==000004,, ; no echo
XON== 000002,, ; paper tape mode
TLKRNG==000001,, ; TALKing
WRTPRV==020000 ; enables writing log
;ECHOFF ECHON TYSBLK IMPSET LINCHR XONOFF GAGOFF NTYSTS TERMID CORBEG TERSTR PTINTP NTINTP NTOINP DOQUIT NETCMP RCBINP TRBINP ECHOP SUPGAP WANTBP NODETP NEWLNP LFFLSP TTCHGP MAILP SPYON TTYLIN TPCSAV IDLTIM PTIBUF WHOBUF PDL DPYNAM MAIBOX LOGO COREND
SUBTTL Data area
; TTYSET command words
ECHOFF: 001400,,(FULTWX) ; echo off
ECHON: 002400,,(FULTWX) ; echo on
TYSBLK==. ; initial commands to do
IMPSET: 034400,, ; IMP TTY
LINCHR: 001400,,(ECHARR\FCS\TBXPND\FULTWX); default line characteristics
XONOFF: 002400,,(XON) ; generate LF after CR
GAGOFF: 024400,, ; gag off
NTYSTS==.-TYSBLK
; Terminal location string
TERMID: 'TERMID
CORBEG==. ; start of initialized core storage
TERSTR: BLOCK 10. ; console location string
; Interrupt flags
PTINTP: BLOCK 1 ; -1 → PTI interrupt
NTINTP: BLOCK 1 ; -1 → NTI interrupt
NTOINP: BLOCK 1 ; -1 → INS interrupt
DOQUIT: BLOCK 1 ; -1 → QUIT interrupt
; Protocol flags
NETCMP: BLOCK 1 ; -1 → IAC in progress
IRPS OPT,,WILL WONT DO DONT
OPT!P: BLOCK 1 ; -1 → option in effect
TERMIN
RCBINP: BLOCK 1 ; -1 → receiving binary
TRBINP: BLOCK 1 ; -1 → transmitting binary
ECHOP: BLOCK 1 ; -1 → remote echoing
SUPGAP: BLOCK 1 ; -1 → suppressing GA
; Other flags
WANTBP: BLOCK 1 ; -1 → want to be in binary mode
NODETP: BLOCK 1 ; -1 → don't detach this guy
NEWLNP: BLOCK 1 ; -1 → starting newline
LFFLSP: BLOCK 1 ; -1 → PTISER's LF flush kludge
TTCHGP: BLOCK 1 ; -1 → changing terminal type
MAILP: BLOCK 1 ; -1 → MAIL arrived (from LOGIN)
SPYON: BLOCK 1 ; -1 → log text
; Other storage
TTYLIN: BLOCK 1 ; line number of PTY
TPCSAV: BLOCK 1 ; save of JOBTPC
IDLTIM: BLOCK 1 ; idle time in 15-second units
PTIBUF: BLOCK 30. ; PTY input buffer
WHOBUF: BLOCK 22 ; wholine buffer
PDL: BLOCK PDLLEN ; stack
DPYNAM: BLOCK 20 ; return block for TTYSET
MAIBOX: BLOCK 40 ; MAIL box
LOGO: BLOCK 3 ; log output buffer header
COREND==.-1 ; end of initialized storage
;TPLTAB TPLMIN WDOTAB WDOMAX EXOPL
SUBTTL TELNET protocol codes
DEFINE TPC CODE
CODE
IRPS NAME,,CODE
[ASCIZ/NAME/]
.ISTOP
TERMIN
TERMIN
; Protocol codes
TPLTAB:
TPC SE==360 ; subnegotiation end
TPC NOP==361 ; no-op
TPC DM==362 ; data mark
TPC BRK==363 ; break key
TPC IP==364 ; interrupt process
TPC AO==365 ; abort output
TPC AYT==366 ; are you there?
TPC EC==367 ; erase character
TPC EL==370 ; erase line
TPC GA==371 ; go ahead
TPC SB==372 ; subnegotiation
TPC WILL==373 ; sender will do
TPC WONT==374 ; sender won't do
TPC DO==375 ; receiver asked to do
TPC DONT==376 ; receiver must not do
TPC IAC==377 ; interpret as command
TPLMIN==400-<.-TPLTAB>
; WILL/WONT/DO/DONT codes
WDOTAB:
TPC TRNBIN==0 ; transmit binary
TPC ECHO==1 ; echo
TPC RCP==2 ; reconnect
TPC SUPRGA==3 ; suppress GA
TPC NAMS==4 ; negotiate approx. message size
TPC STATUS==5 ; status option
TPC TIMMRK==6 ; timing mark
TPC RCTE==7 ; remote controlled trans/echo
TPC NAOL==10 ; negotiate output line width
TPC NAOP==11 ; negotiate page size
TPC NAOCRD==12 ; negotiate output CR
TPC NAOHTS==13 ; negotiate output horizontal tab stops
TPC NAOHTD==14 ; negotiate output HT
TPC NAOFFD==15 ; negotiate output FF
TPC NAOVTS==16 ; negotiate output vertical tab stops
TPC NAOVTD==17 ; negotiate output VT
TPC NAOLFD==20 ; negotiate output LF
TPC EXTASC==21 ; Tovar's cretinous idea of extended ASCII
TPC LOGOUT==22 ; logout option
TPC BM==23 ; byte macro
TPC DET==24 ; data entry terminal option
TPC SUPDUP==25 ; SUPDUP (not TELNET) protocol
TPC SDOTPT==26 ; SUPDUP output option
WDOMAX==.-WDOTAB-1
EXOPL==377 ; extended options (great idea Postel)
;INTSER INTSR1 CLKSER
SUBTTL Interrupt server
; Interrupts only set flags which the main program (normally in INTW⊗
; state) looks at.
INTSER: SKIPN X,JOBCNI ; get interrupt status
JRST 4,.-1
TLNE X,(INTTTC) ; terminal type change
SETOM TTCHGP
TLNE X,(INTPTO) ; PTY int
SETOM PTINTP
TRNE X,INTQUIT ; QUIT int?
SETOM DOQUIT
TLNE X,(INTFOP) ; output reset?
JRST [ MOVE JOBTPC
MOVEM TPCSAV
INTMSK [0]
UWAIT
PUSH P,TPCSAV
INTMSK [-1]
DEBREAK
PUSHJ P,NETINS
TELCMD [IAC DM]
POPJ P,]
TLNE X,(INTCLK) ; CLK int
JRST CLKSER
TLNE X,(INTINP) ; NTI int
SETOM NTINTP
TLNE X,(INTIMS) ; status change
JRST [ INTMSK [0]
DEBREAK
JRST SUICID]
TLNE X,(INTMAI) ; MAIL
SETOM MAILP
TLNE X,(INTINR)
OUTSTR [ASCIZ/*INR*
/]
TLNN X,(INTINS) ; IMP INS int
JRST INTSR1
SOS NTOINP
OUTSTR [ASCIZ/*INS*
/]
INTSR1: MOVSI 1,-1 ; requeue into TQ from any queue
DISMIS 1,
; Service clock interrupt
CLKSER: AOSGE IDLTIM ; bump idle time
JRST INTSR1
UNLOCK ; idle timeout; unlock
MOVE TTYLIN
PTGETL
TLNE 1,(TLKRNG) ; TALKing?
JRST INTSR1 ; don't kill him if so!
TTYJOB
JUMPN INTSR1
INTMSK [0] ; no more interrupts
DEBREAK ; out of interrupt level
SETOM NODETP ; forget about detaching
TLNN 1,(DMLIN)
JRST CLKSR1 ; not a DM, just die
MOVEI ↑X ; cancel modes
PUSHJ P,NETOCH
MOVEI ↑] ; scroll on
PUSHJ P,NETOCH
CLKSR1: MOVEI X,[ASCIZ/Autologout
/]
PUSHJ P,SNDMSG
JRST SUICID
;TELSER CPYHST 1DIGTP NOTTIP
SUBTTL Start of program
TELSER: CAI
RESET
MOVEI 0,0
SETPRV 0, ;turn off any priv, so JOBRD will work
MOVE ['TELSER]
SETNAM
SETZM CORBEG
MOVE [CORBEG,,CORBEG+1]
BLT COREND
MOVE P,[PDL(-PDLLEN)]
MOVEI [DEBREAK ? EXIT]
MOVEM JOBAPR
CLKINT 5.*60.*60. ; must die if around too long
OUTSTR [ASCIZ/TELSER started
/]
; Listen for a connection on our socket
SETOM NODETP ; don't try to detach
MOVEI SVRSKT
MOVEM LSNSKT
PUSHJ P,LISTEN
; Set up interrupts
MOVEI INTSER
MOVEM JOBAPR ; set up server location
CLKINT 60.*15. ; start slow ticking clock
MOVE [INTTTC\INTFOP\INTPTO\INTCLK\INTINR\INTINS\INTIMS\INTINP\INTQUIT\INTMAI]
INTENB ; turn on interrupts
; Set up terminal id for interested spies
MOVEI TERMID
MOVEM JOBVER
; Log this connection
OUTSTR [ASCIZ/Connected to /]
PUSHJ P,MAPHST ; map in host table
MOVE HOST
PUSHJ P,HSTNUM ; get HDB
CAI ; sorry about errors
MOVEI A,(1) ; host name
HRLI A,440700
SKIPA X,[440700,,TERSTR]
CPYHST: IDPB B,X
ILDB B,A
JUMPN B,CPYHST
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
NOTTIP: PUSHJ P,SETANM ; set our alias name
PUSHJ P,UNMHST ; map out the host table
OUTSTR TERSTR
OUTSTR [ASCIZ/
/]
;NOFLAK MAINL MAINL0
SUBTTL Initialize the connection
TELCMD [IAC WILL ECHO IAC WILL SUPRGA]
SETOM ECHOP ? SETOM SUPGAP
MOVEI X,256 ; LASTDISASTERTIME
PEEK X,
PEEK X,
JUMPE X,NOFLAK
ACCTIM A,
SUB A,X
TLZE A,1 ; forgive one day
ADDI A,24.*60.*60.
CAILE A,15.*60. ; lost within 15 minutes?
JRST NOFLAK
MOVEI X,[ASCIZ/System is flakey--watch out!
/]
PUSHJ P,SNDMSG
; Get a PTY, keep its number in A
NOFLAK: PTYGET A
JRST [ MOVEI 254 ; MAINTMODE
PEEK
PEEK
SKIPE
SKIPA X,[[ASCIZ/SU-AI - System being debugged, users not allowed on.
/]]
MOVEI X,[ASCIZ/SU-AI - All network ports in use.
/]
PUSHJ P,SNDMSG
INTMSK [0]
PUSHJ P,CLOSER
JRST SUICID]
HRRZM A,TTYLIN ; dumb interrupts
MOVSI (A)
IRPS FOO,,ECHON ECHOFF XONOFF LINCHR GAGOFF IMPSET
IORM FOO
TERMIN
HRROI ECHOFF
TTYSET
MOVEI B,[ASCIZ/Hello
/]
PTWRS7 A
MOVE [-NTYSTS,,TYSBLK]
TTYSET ; turn GAG bit off
; Final initialization
MOVNI LOKTMO
MOVEM IDLTIM ; initialize lock timeout
LOCK ; keep response good
SETZM NODETP ; okay to detach jobs now
JRST NTISER ; check network input
; Main program loop
MAINL: IWAIT ; wait for an interrupt
MAINL0: MOVEI 2 ; check connection status
MTAPE NET,
TLNN 1,(CLSS\CLSR) ; send side gronked?
TLNE 2,(CLSS\CLSR) ; receive side?
JRST SUICID
AOSG TTCHGP ; changing type?
JRST TTCSER
AOSG NTINTP ; net input?
JRST NTISER
AOSG PTINTP ; PTY input?
JRST PTISER
AOSG DOQUIT ; QUIT seen?
JRST SUIQUI
AOSG MAILP ; MAIL arrived?
JRST MAISER
JRST MAINL ; back to sleep for us
;TTCSER STOPBN WANTBN
SUBTTL Terminal change interrupt
TTCSER: PTGETL A
TLNE B,(DMLIN)
JRST WANTBN ; want to be in binary mode
MOVE B,[013400,,B]
DPB A,[220700,,B]
HRROI B
TTYSET
ANDI B,17
CAIE B,10 ; image mode wants binary too
CAIN B,11
JRST WANTBN
SETZM WANTBP
SKIPN RCBINP ; in binary now?
JRST MAINL0
SETZM RCBINP
TELCMD [IAC DONT TRNBIN]; want out of it
JRST MAINL0
; Want into binary mode
WANTBN: SETOM WANTBP
SKIPE RCBINP ; in binary?
JRST MAINL0
SETOM RCBINP
TELCMD [IAC DO TRNBIN]
JRST MAINL0
;NTISER NTISR2 NTISR1 PTYSND
SUBTTL Network input interrupt
NTISER: PUSHJ P,NETICH ; get character from the network
JRST MAINL0 ; network input buffer empty
SKIPL IDLTIM
LOCK
MOVNI 1,LOKTMO
MOVEM 1,IDLTIM ; reset idle time
AOSG NETCMP ; IAC in progress?
JRST IACSER
IRPS OPT,,WILL WONT DO DONT
AOSG OPT!P
JRST OPT!SR
TERMIN
CAIN IAC ; network command?
JRST [ SETOM NETCMP ; remember that one is coming
JRST NTISER]
AOSE NEWLNP ; flush second half of NL?
JRST NTISR2
JUMPE NTISER ; yah, flush nulls or
CAIN ↑J ; LFs
JRST NTISER
NTISR2: CAIE ↑M ; CR?
JRST NTISR1
SKIPN ECHOP ; if in local mode
SETOM LFFLSP ; kludge to prevent system echo of LF's
SKIPN RCBINP ; if not in binary mode,
SETOM NEWLNP ; maybe flush an LF
NTISR1: SKIPGE NTOINP ; still in flushify mode?
JRST NTISER ; too bad
MOVE B,
SKIPN WANTBP ; if not Datamedia or image, flush 200 bit
ANDI B,177
PTYSND: PTWR1S A ; send character to PTY
JRST [ PUSHJ 17,NETINS ; buffer full, send INS
TELCMD [IAC AO IAC DM] ; tell user to flush output
MOVEI ↑G ; bell
PUSHJ 17,NETOCH
PUSHJ 17,NETSND ; output it
JRST NTISER]
SKIPE SPYON
PUSHJ P,LOGCH ; record char in 0
JRST NTISER ; try for more user characters
;PTISER PTISR0
SUBTTL PTY input interrupt
PTISER: MOVE B,[441140,,PTIBUF]
PTRDS A ; read buffer from PTY
ILDB B
JUMPE [ PUSHJ P,NETSND ; buffer empty, force output out
JRST MAINL0]
SKIPL IDLTIM
LOCK
PTISR0: MOVNI 1,LOKTMO
MOVEM 1,IDLTIM ; reset idle time
ANDI 377 ; flush funny 400 bit
SKIPE SPYON
PUSHJ P,LOGCH ; record char in 0
CAIN ↑J ; LF? (someday remove this kludge)
AOSE LFFLSP ; yes, second part of NL?
PUSHJ P,NETOCH ; send character to net
CAIN IAC ; IAC needs quoting
PUSHJ P,NETOCH
ILDB B
JUMPN PTISR0 ; more in this buffer
JRST PTISER ; maybe more buffers to come
;IACSER PRSTAB
SUBTTL IAC server
IACSER: OUTSTR [ASCIZ/*IAC /]
CAIGE TPLMIN ; big enough?
JRST [ PUSHJ P,RNDMSG ; unknown, flush
JRST NTISER]
MOVE 1,
OUTSTR @TPLTAB-TPLMIN(1)
CAIE IAC
CAIGE WILL
OUTSTR [ASCIZ/*
/]
XCT PRSTAB-TPLMIN(1)
JRST NTISER
DEFINE NC CODE,SERVER
IFN .+TPLMIN-PRSTAB-CODE,.ERR Lossage at CODE
SERVER
TERMIN
PRSTAB: ; Protocol command server table
NC SE,[JRST NTISER]
NC NOP,[JRST NTISER]
NC DM,[AOS NTOINP]
NC BRK,[JRST HALTJB]
NC IP,[JRST HALTJB]
NC AO,[JRST ORESET]
NC AYT,[JRST WHOLIN]
NC EC,[JRST DELCHR]
NC EL,[JRST DELLIN]
NC GA,[JRST NTISER]
NC SB,[JRST NTISER]
NC WILL,[SETOM WILLP]
NC WONT,[SETOM WONTP]
NC DO,[SETOM DOP]
NC DONT,[SETOM DONTP]
NC IAC,[JRST NTISR1]
;HALTJB ORESET WHOLIN DELCHR DELLIN
SUBTTL Protocol command routines
; IAC IP/IAC BRK
HALTJB: MOVEI B,[.BYTE 9 ? 600 ? 600 ? 0]; CALL
PTWRS9 A
JRST NTISER
; IAC AO
ORESET: MOVEI B,↑O
PTWR1W A
OUTSTR [ASCIZ/⊗INS*
/]
PUSHJ P,NETINS ; send SYNCH
TELCMD [IAC DM]
JRST NTISER
; IAC AYT
WHOLIN: MOVEI B,↑←
PTWR1W A
MOVEI B,"W
JRST PTYSND
; IAC EC/IAC EL
DELCHR: SKIPA B,[177] ; rubout
DELLIN: MOVEI B,↑U ; control-U
JRST PTYSND
;DOSR DONTSR
; IAC DO/DONT
DOSR: PUSHJ P,OPTMSG
CAIN TRNBIN ; binary from host
JRST [ SKIPE TRBINP ; catch protocol loops
JRST NTISER
SETOM TRBINP
TELCMD [IAC WILL TRNBIN]
JRST NTISER]
CAIN ECHO ; remote echo (what a win!)
JRST [ HRROI ECHON
TTYSET
SKIPE ECHOP ; catch protocol loops
JRST NTISER
SETOM ECHOP
TELCMD [IAC WILL ECHO]
JRST NTISER] ; command, we always accept it
CAIN SUPRGA ; suppress GA?
JRST [ SKIPE SUPGAP ; command or reply?
JRST NTISER
SETOM SUPGAP
TELCMD [IAC WILL SUPRGA]
JRST NTISER]
CAIN LOGOUT ; hairy MRC LOGOUT option?
JRST [ SETOM NODETP
TELCMD [IAC WILL LOGOUT]; we may be the only place that has it!
MOVEI X,[ASCIZ/Bye
/]
PUSHJ P,SNDMSG
INTMSK [0]
JRST SUICID]
; Not an option we like, refuse it
PUSH P,
OUTSTR [ASCIZ/⊗IAC WONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI WONT
PUSHJ P,NETOCH
POP P,
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NTISER
DONTSR: PUSHJ P,OPTMSG
CAIN TRNBIN
JRST [ SKIPN TRBINP
JRST NTISER
SETZM TRBINP
TELCMD [IAC WONT TRNBIN]
JRST NTISER]
CAIN ECHO
JRST [ HRROI ECHOFF
TTYSET
SKIPN ECHOP
JRST NTISER
SETZM ECHOP ; back to lossage
TELCMD [IAC WONT ECHO]
JRST NTISER]
CAIN SUPRGA
SKIPL SUPGAP
JRST NTISER ; protocol violator
SETZM SUPGAP
TELCMD [IAC WONT SUPRGA]
JRST NTISER ; loser
;WILLSR WONTSR
; IAC WILL/WONT
WILLSR: PUSHJ P,OPTMSG
CAIN TRNBIN ; binary to host
JRST [ SKIPE RCBINP ; catch protocol loops
JRST NTISER
SKIPN WANTBP
JRST .+1 ; I don't wanna
SETOM RCBINP
TELCMD [IAC DO TRNBIN]
JRST NTISER]
; Not an option we like, refuse it
PUSH P,
OUTSTR [ASCIZ/⊗IAC DONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI DONT
PUSHJ P,NETOCH
POP P,
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NTISER
WONTSR: PUSHJ P,OPTMSG
CAIN TRNBIN
SKIPN RCBINP
JRST NTISER
SETZM RCBINP
TELCMD [IAC DONT TRNBIN]
JRST NTISER
;LOGM LOGNAM MAISER MAISE0 MAISE2 MAISE3 LOGSIX LOGSI2 LOGCH LOGCH1
LOGM: 200
SIXBIT /DSK/
LOGO,,0
LOGNAM: 'LATEST
0
777000,,0
'PSYS
MAISER: SRCV MAIBOX ;receive any letter sent to us
JRST MAINL ;none there, forget it
MOVE B,MAIBOX
CAME B,['SPYNOW]
JRST MAINL ;junk mail, forget it
SKIPN SPYON ;maybe already loggin'
OPEN LOGC,LOGM
JRST MAINL ;don't bother
MOVSI B,WRTPRV ;enable writing the file
SETPRV B,
MOVE B+3,[LOGNAM,,B] ;get filename
BLT B+3,B+3
TIMER B+1, ;random extension
MOVSI B+1,(B+1)
ENTER LOGC,B ;open file
JRST MAINL ;hmmm, oh well
MOVE B,TTYLIN
TTYJOB B, ;get subjob's number
JUMPE B,MAISE0 ;jump if no subjob
MOVEI 0,211
PEEK 0,
ADD B,0
PEEK B,
MAISE0: PUSHJ P,LOGSIX ;tell who it is
MOVEI B,0
PUSHJ P,LOGSIX ;some spaces
MOVEI B,0
SETPRV B, ;turn off the priv, so JOBRD will work
SETOM SPYON ;now loggin'
MOVE B,[440700,,TERSTR] ;get ptr to location descriptor
MAISE2: ILDB 0,B
JUMPE 0,MAISE3
PUSHJ P,LOGCH
JRST MAISE2
MAISE3: MOVEI 0,15 ;end location string with crlf
PUSHJ P,LOGCH
MOVEI 0,12
PUSHJ P,LOGCH
JRST MAINL
LOGSIX: MOVE B+1,[440600,,B]
LOGSI2: ILDB 0,B+1
ADDI 0,40 ;make into ascii
PUSHJ P,LOGCH
TLNE B+1,770000 ;end of word?
JRST LOGSI2 ;no
POPJ P, ;yes
LOGCH: SOSG LOGO+2 ;usual buffered output: any bytes left
OUT LOGC, ;next buffer
JRST LOGCH1
RELEAS LOGC, ;some error, close file
SETZM SPYON ;remember file is closed
POPJ P,
LOGCH1: IDPB 0,LOGO+1 ;put char in buffer
POPJ P,
;OPTMSG RNDMSG SNDMSG MSGLUP SUIQUI ERRDIE SUICID DIEDIE ...LIT SVRRTS ERRTNS ERRHAN ERRINS HSTTAB HSTSIX
SUBTTL Subroutines
; WILL/WONT/DO/DONT option message
OPTMSG: CAIN EXOPL
JRST [ OUTSTR [ASCIZ/ EXOPL*
/]
POPJ P,]
OUTCHR [" ]
CAILE WDOMAX
JRST RNDMSG
MOVE 1,
OUTSTR @WDOTAB(1)
OUTSTR [ASCIZ/*
/]
POPJ P,
RNDMSG: IDIVI 100 ; output the octal for an unknown message
ADDI "0
OUTCHR
IDIVI 10
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
OUTSTR [ASCIZ/*
/]
POPJ P,
; Send a message, b.p. in X
SNDMSG: TLOA X,440700 ; set up b.p.
MSGLUP: PUSHJ P,NETOCH
ILDB X
JUMPN MSGLUP ; continue until a null hit
JRST NETSND
; Here to quit on QUIT command. Check for binary mode and end it first.
SUIQUI: SKIPN RCBINP ; in binary mode?
JRST SUICID ; nope, just go away
TELCMD [IAC DONT TRNBIN] ; yes, get out of it
MOVE B,[63400,,DPYNAM] ; get display type's name
MOVE A,TTYLIN ; to see if this is a real DM
DPB A,[221000,,B] ; insert tty number in ttyset cmd
HRROI A,B
TTYSET A, ; get display type info
LDB A,[301400,,DPYNAM] ; get first two chars of display type name
CAIE A,' DM ; skip if in DM class
JRST SUICID ; go away
TELCMD [30 35] ; clear modes, turn on roll mode
JRST SUICID ; go away
; Here to suicide on network errors or idle timeout
ERRDIE: INTMSK [0]
SUICID: OUTSTR [ASCIZ/Connection closed.
/]
SKIPE NODETP
JRST DIEDIE ; logout the guy
MOVE TTYLIN
TTYJOB
JUMPE DIEDIE
MOVE A,TTYLIN
MOVEI B,7
PTJOBX A ; clear PTY's input buffer
MOVEI 2
MOVEI B,10 ; DETACH
PTJOBX A
JRST [ SLEEP ? JRST .-1]
SLEEP
PTRD1S A ; slurp up stuff in buffer
CAIA
JRST .-2
DIEDIE: RELEAS LOGC, ; close log
RESET ? EXIT
...LIT: CONSTANTS
; Wonderful network routines
SVRRTS==-1 ; include server routines
ERRTNS==-1 ; include error routines
ERRHAN==-1 ; include automagic error handling
ERRINS==<JRST ERRDIE> ; error instruction
HSTTAB==-1 ; include host table magic
HSTSIX==-1 ; and alias name kludge
.INSRT NETWRK[NET,MRC]
END TELSER