perm filename RSSER.MID[S,NET]3 blob
sn#811229 filedate 1986-02-24 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 X TERMID CORBEG TERSTR ARGSTR LUSER FNDLSP ARGEND ERSTRP AUXIOP AUXOOP INLNKP LNKTTY PDL COREND
C00005 00003 RSSER CPYHST 1DIGTP NOTTIP
C00007 00004 RSEXEC RSEXC1 CMDCHR CMDREE ARGCHR STOCHR
C00009 00005 XCTCMD CMDTAB NUMCOM CMDSER
C00010 00006 ERSTR CMDONE NOOP BREAK PTCL QUIT USINF USINF0
C00013 00007 SSINF USINFR SSINF0 SSINF7 SSINF1
C00015 00008 SSINF3 SSINF4 SSINF2 SSINF6 SSINF5 SSNXTJ
C00017 00009 AUXS AUXSDE AUXSSE AUXS1
C00019 00010 CONN BADHDL GOTHDL GETSKT GOTSKT SNDCON HOMOSK
C00021 00011 LINK NOTTYN CHKFOK
C00024 00012 LNKTPL LNKZZZ LNKLUP LNKLP0 LNKLP1
C00025 00013 OCTOUT NETMSG NEGACK NEGAK1 POSACK ...LIT SVRRTS DATRTS ERRTNS ERRHAN ERRINS HSTTAB HSTSIX
C00027 ENDMK
C⊗;
;X TERMID CORBEG TERSTR ARGSTR LUSER FNDLSP ARGEND ERSTRP AUXIOP AUXOOP INLNKP LNKTTY PDL COREND
TITLE RSSER
SUBTTL Definitions
; Mark Crispin, SU-AI, July 1979
; Assembly switches
IFNDEF SVRSKT,SVRSKT==365 ; default listen socket
IFNDEF PDLLEN,PDLLEN==50 ; stack length
; AC definitions. 0→3 are used by NETWRK
X=4 ? A=5 ? B=6 ? C==7 ? P=17
TERMID: 'TERMID ; for spies to see where we are
CORBEG==. ; start of initialized core storage
TERSTR: BLOCK 40 ; console location string
ARGSTR: BLOCK 20. ; argument string
LUSER: BLOCK 1 ; user name for USINF
FNDLSP: BLOCK 1 ; -1 → found a loser
ARGEND==.-1
ERSTRP: BLOCK 1 ; -1 → full error messages
AUXIOP: BLOCK 1 ; -1 → aux input opened
AUXOOP: BLOCK 1 ; -1 → aux output opened
INLNKP: BLOCK 1 ; -1 → in a link
LNKTTY: BLOCK 1 ; link TTY number
PDL: BLOCK PDLLEN ; stack
COREND==.-1 ; end of initialized storage
;RSSER CPYHST 1DIGTP NOTTIP
SUBTTL Initialize the world
RSSER: CAI
RESET
MOVE [SIXBIT/RSSER/]
SETNAM
SETZM CORBEG
MOVE [CORBEG,,CORBEG+1]
BLT COREND
MOVE P,[PDL(-PDLLEN)]
MOVSI 377777
SETPR2 ; map the system in
JRST 4,.-1
OUTSTR [ASCIZ/RSSER started
/]
; Listen for a connection on our socket
MOVEI SVRSKT
MOVEM LSNSKT
PUSHJ P,LISTEN
; Set up terminal id for interested spies
MOVEI TERMID
MOVEM JOBVER
; Log the 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
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 job name
PUSHJ P,UNMHST ; map out the host table
OUTSTR TERSTR
OUTSTR [ASCIZ/
/]
JRST RSEXC1 ; skip prompt first time around
;RSEXEC RSEXC1 CMDCHR CMDREE ARGCHR STOCHR
SUBTTL RS EXEC top level
RSEXEC: MOVEI ↑M
PUSHJ P,NETOCH
MOVEI ↑J
PUSHJ P,NETOCH
MOVEI "@ ; command prompt
PUSHJ P,NETOCH
PUSHJ P,NETSND
SKIPE INLNKP
JRST LNKTPL
RSEXC1: MOVE X,[440700,,A]
SETZB A,ARGSTR ; clear command
MOVE [ARGSTR,,ARGSTR+1]
BLT ARGEND
CMDCHR: PUSHJ P,NETICW
CMDREE: CAIN ↑M ; end of command?
JRST XCTCMD
CAIE <" > ; start of arguments?
JRST STOCHR
MOVE X,[440700,,ARGSTR]
ARGCHR: PUSHJ P,NETICW
CAIN ↑M
JRST XCTCMD
CAIL "a
CAILE "z
TRNA
SUBI "a-"A
IDPB X
JRST ARGCHR
STOCHR: TRNN A,376 ; command too long?
JRST [ CAIL "a ; no, convert case
CAILE "z
TRNA
SUBI "a-"A
IDPB X ; and stuff it in
JRST CMDCHR]
MOVEI X,[ASCIZ/110 Command too long/]
PUSHJ P,NETICW
CAIE ↑M
JRST .-2
PUSHJ P,NETICW ; eat LF
JRST NEGACK
;XCTCMD CMDTAB NUMCOM CMDSER
SUBTTL Command decoder
XCTCMD: PUSHJ P,NETICW ; eat LF
JUMPE A,CMDONE ; null command is always valid
MOVSI B,-NUMCOM
CAMN A,CMDTAB(B)
JRST @CMDSER(B)
AOBJN B,.-2
MOVEI X,[ASCIZ/100 No comprende dat/]
JRST NEGACK
; Command tables
DEFINE CMDS
CMD ERSTR
CMD SSINF
CMD USINF
CMD AUXS
CMD CONN
CMD LINK
CMD BREAK
CMD NOOP
CMD PTCL
CMD QUIT
TERMIN
DEFINE CMD FOO
IFG .LENGTH/FOO/-5,.ERR FOO bites the bag
ASCII/FOO/
TERMIN
CMDTAB: CMDS
NUMCOM==.-CMDTAB
DEFINE CMD FOO
FOO
TERMIN
CMDSER: CMDS
;ERSTR CMDONE NOOP BREAK PTCL QUIT USINF USINF0
SUBTTL Command service routines
; ERSTR - Toggle error message verbosity
ERSTR: SETCMM ERSTRP
CMDONE: PUSHJ P,POSACK
JRST RSEXEC
; NOOP - Just returns NOOP as a reply
NOOP: PUSHJ P,POSACK
JSP C,NETMSG
ASCIZ/NOOP/
JRST CMDONE
; BREAK - Break links
BREAK: SKIPN A,LNKTTY
JRST CMDONE
MOVEI B,↑C
PTWR1W A
PTRD1S A ; slurp up every last goddam character!!
CAIA
JRST .-2
PTYREL LNKTTY
SETZM LNKTTY
SETZM INLNKP
JRST CMDONE
; PTCL - change protocol
PTCL: SKIPN X,ARGSTR
JRST [ MOVEI X,[ASCIZ/120 What protocol?/]
JRST NEGACK]
CAMN X,[ASCII/GENRL/]
JRST CMDONE
CAMN X,[ASCIZ/TENEX/]
SKIPA X,[[ASCIZ/120 Boy if you expect Tenex protocol out of me are you ever gonna lose/]]
MOVEI X,[ASCIZ/120 That protocol isn't implemented/]
JRST NEGACK
; QUIT - terminate interaction and die
QUIT: RESET
EXIT
; USINF - status on a single user
USINF: SKIPN ARGSTR ; any argument?
JRST [ MOVEI X,[ASCIZ/110 Who do ya want?/]
JRST NEGACK]
MOVE A,[440700,,ARGSTR]
SETZ
USINF0: ILDB B,A
JUMPE B,[ MOVEM LUSER
PUSHJ P,POSACK
JRST USINFR]
CAIL B,"a
CAILE B,"z
TRNA
SUBI B,"a-"A
LSH 6
ADDI -" (B) ; sixbitify and add in
TLNN 77 ; overflow?
JRST USINF0
MOVEI X,[ASCIZ/110 User name too long/]
JRST NEGACK
;SSINF USINFR SSINF0 SSINF7 SSINF1
SUBTTL SSINF command
SSINF: PUSHJ P,POSACK
JSP C,NETMSG
ASCIZ/
Job User TTY Subsys/
USINFR: MOVEI ↑M
PUSHJ P,NETOCH
MOVEI ↑J
PUSHJ P,NETOCH
MOVEI X,1 ; start at job 1
SSINF0: MOVE A,400210 ; JBTSTS
ADDI A,400000(X)
MOVE A,(A)
TLNN A,10000 ; JLOG set?
JRST SSNXTJ ; no job or a phantom, ignore it
MOVE A,400211 ; PRJPRG
ADDI A,400000(X)
SKIPE A,(A)
CAMN A,[SIXBIT/*SEG*/]
JRST SSNXTJ
SKIPN LUSER
JRST SSINF7
HRRZ A,A
CAME A,LUSER
JRST SSNXTJ
SSINF7: SETOM FNDLSP
MOVEI <" >
PUSHJ P,NETOCH
MOVEI A,(X)
IDIVI A,10.
SKIPN A
MOVEI A," -"0
MOVEI "0(A)
PUSHJ P,NETOCH
MOVEI "0(B)
PUSHJ P,NETOCH
MOVEI <" >
PUSHJ P,NETOCH
PUSHJ P,NETOCH
MOVE A,400211 ; PRJPRG
ADDI A,400000(X)
MOVE A,(A)
MOVEI C,6
SSINF1: SETZ B,
ROTC A,6
MOVEI " (B)
PUSHJ P,NETOCH
CAIN C,4
JRST [ MOVEI ",
PUSHJ P,NETOCH
SOJA C,SSINF1]
SOJG C,SSINF1
MOVEI <" >
; (continued on next page)
;SSINF3 SSINF4 SSINF2 SSINF6 SSINF5 SSNXTJ
; SSINF TTY line, program name
PUSHJ P,NETOCH
MOVE A,400236 ; JBTLIN
ADDI A,400000(X)
HRRZ A,(A)
CAIN A,-1 ; detached?
JRST [ JSP C,NETMSG
ASCIZ/Det/
JRST SSINF2]
IDIVI A,100
IDIVI B,10
JUMPE A,[ MOVEI <" >
PUSHJ P,NETOCH
JUMPN B,SSINF3
PUSHJ P,NETOCH
JRST SSINF4]
MOVEI "0(A)
PUSHJ P,NETOCH
SSINF3: MOVEI "0(B)
PUSHJ P,NETOCH
SSINF4: MOVEI "0(C)
PUSHJ P,NETOCH
SSINF2: MOVEI <" >
PUSHJ P,NETOCH
MOVE A,400225 ; JOBNAM
ADDI A,400000(X)
SKIPN A,(A)
JRST SSINF5
SSINF6: SETZ B,
ROTC A,6
MOVEI " (B)
PUSHJ P,NETOCH
JUMPN A,SSINF6
SSINF5: MOVEI ↑M
PUSHJ P,NETOCH
MOVEI ↑J
PUSHJ P,NETOCH
SSNXTJ: CAME X,400222 ; hit last job?
AOJA X,SSINF0
SKIPE LUSER ; not for SSINF
SKIPE FNDLSP
JRST CMDONE
JSP C,NETMSG
ASCIZ/
User not logged in/
JRST CMDONE
;AUXS AUXSDE AUXSSE AUXS1
SUBTTL AUXS Command
AUXS: SKIPN ARGSTR
JRST [ MOVEI X,[ASCIZ/110 What type and size?/]
JRST NEGACK]
LDB [260700,,ARGSTR]
CAIE <" > ; direction must be a single character
JRST AUXSDE
LDB [350700,,ARGSTR] ; get direction
CAIN "R ; receive socket
JRST [ MOVEI A,4
MOVEI C,1
JRST AUXS1]
CAIN "S ; send socket
JRST [ MOVEI A,5
MOVEI C,2
JRST AUXS1]
AUXSDE: SKIPA X,[[ASCIZ/220 Bad direction specification/]]
AUXSSE: MOVEI X,[ASCIZ/221 Bad size specification/]
JRST NEGACK
AUXS1: LDB [100700,,ARGSTR] ; must be a single character
JUMPN AUXSSE
LDB [170700,,ARGSTR]
CAIE "8
JRST AUXSSE
PUSHJ P,POSACK
ADD A,LSOCKT
PUSHJ P,OCTOUT
MOVEI <" >
PUSHJ P,NETOCH
MOVEI "0(C)
PUSHJ P,NETOCH
JRST CMDONE
;CONN BADHDL GOTHDL GETSKT GOTSKT SNDCON HOMOSK
SUBTTL CONN Command
CONN: SKIPN ARGSTR
JRST [ MOVEI X,[ASCIZ/110 What handle and socket?/]
JRST NEGACK]
MOVE X,[440700,,ARGSTR]
ILDB C,X ; get handle
CAIE C,"1
CAIN C,"2
JRST GOTHDL ; got a handle on the situation
BADHDL: MOVEI X,[ASCIZ/260 Bad handle/]
JRST NEGACK
GOTHDL: ILDB X
JUMPE [ MOVEI X,[ASCIZ/110 What socket?/]
JRST NEGACK]
CAIE <" >
JRST BADHDL ; wanted a space here
SETZ A,
GETSKT: ILDB B,X
CAIL B,"0
CAILE B,"7
JRST GOTSKT
LSH A,3
ADDI A,-"0(B)
JRST GETSKT
GOTSKT: CAIE C,"1 ; receive connection?
JRST SNDCON
TRNN A,1
JRST HOMOSK
SUBI A,3 ; fake out DATI's smarts
MOVEM A,FSOCKT
PUSHJ P,DATI ; open connection
SETOM AUXIOP
JRST CMDONE
SNDCON: TRNE A,1
JRST HOMOSK
SUBI A,2 ; fake out DATO's smarts
MOVEM A,FSOCKT
MOVEI 8.
PUSHJ P,DATO
SETOM AUXOOP
JRST CMDONE
HOMOSK: MOVEI X,[ASCIZ/270 Homosocketual connections are illegal by California law/]
JRST NEGACK ; the Anita Bryant feature
;LINK NOTTYN CHKFOK
SUBTTL LINK Command
LINK: SKIPN X,ARGSTR
JRST [ MOVEI X,[ASCIZ/110 With what to whom?/]
JRST NEGACK]
ANDCMI X,377
CAME X,[ASCII/1 2 /]
CAMN X,[ASCII/2 1 /]
TRNA
JRST [ MOVEI X,[ASCIZ/110 Bad handle/]
JRST NEGACK]
SKIPE AUXIOP
SKIPN AUXOOP
JRST [MOVEI X,[ASCIZ/801 Connection not open/]
JRST NEGACK]
MOVEI X,377
AND X,ARGSTR
JUMPE X,[ MOVEI X,[ASCIZ/110 To whom?/]
JRST NEGACK]
PTYGET A
JRST [ MOVEI X,[ASCIZ/620 Can't get a PTY/]
JRST NEGACK]
HRRM A,LNKTTY
MOVE B,A
TLO B,10034
PTSETL A
MOVSI B,034400 ; set IMPBIT
TLO B,(A)
HRROI B
TTYSET
MOVSI B,025400 ; clear NO-CONVERT bit
TLO B,(A)
TTYSET
MOVEI B,[ASCIZ/TALK /]
PTWRS7 A
LDB B,[010700,,ARGSTR]
CAIL B,"0
CAILE B,"7
JRST NOTTYN
MOVEI B,[ASCIZ/TTY/]
PTWRS7 A
NOTTYN: SKIPA X,[100700,,ARGSTR]
PTWR1W A
ILDB B,X
JUMPN B,.-2
MOVEI B,↑M
PTWR1W A
MOVEI B,↑J
PTWR1W A
PTRD1W A
CAIN B,"U
JRST [ MOVEI X,[ASCIZ/605 User not logged in/]
SETZM LNKTTY
PTYREL A
JRST NEGACK]
CAIE B,"T
JRST CHKFOK
PTRD1W A ; thank you BH for making the fucking
CAIE B,<" > ; messages so goddamned similar!
JRST .-2
PTRD1W A ; thank you again BH!
PTRD1W A ; thank you again BH!
CAIE B,"T
JRST CHKFOK ; see if won now
MOVEI X,[ASCIZ/601 User logged in more than once/]
SETZM LNKTTY
PTYREL A
JRST NEGACK
CHKFOK: CAIN B,"b
JRST [ MOVEI X,[ASCIZ/603 Refused by user/]
SETZM LNKTTY
PTYREL A
JRST NEGACK]
CAIE B,"O
JRST [ MOVEI X,[ASCIZ/604 Can't complete link for unknown reason/]
SETZM LNKTTY
PTYREL A
JRST NEGACK]
PTRD1W A
CAIE B,<" >
JRST .-2
MOVEI [ MOVE JOBCNI
TLNE 20
JRST [ DEBREAK
RESET
EXIT]
DISMIS]
MOVEM JOBAPR
MOVSI 1030 ; INTPTO+INTIMS+INTINP
INTENB
CLKINT 2*60.
SETOM INLNKP
JRST CMDONE
;LNKTPL LNKZZZ LNKLUP LNKLP0 LNKLP1
; Link top level
LNKTPL: PUSHJ P,NETICH ; get a command character
JRST LNKZZZ
SETZB A,ARGSTR ; clear command
MOVE X,[ARGSTR,,ARGSTR+1]
BLT X,ARGEND
MOVE X,[440700,,A]
JRST CMDREE ; reenter command mode
LNKZZZ: MOVE A,LNKTTY
PTGETL A
TLNN B,1
JRST QUIT ; link was broken
IWAIT
LNKLUP: PTRD1S A
JRST LNKLP1
LNKLP0: MOVEI (B)
PUSHJ P,DATOCH
PTRD1S A
TRNA
JRST LNKLP0
PUSHJ P,DATSND
LNKLP1: PUSHJ P,DATICH
JRST LNKTPL
ANDI 177
CAIE ↑C
CAIN 177
JRST LNKLP1 ; we don't need rubouts
MOVE B,
PTWR1W A
JRST LNKLP1
;OCTOUT NETMSG NEGACK NEGAK1 POSACK ...LIT SVRRTS DATRTS ERRTNS ERRHAN ERRINS HSTTAB HSTSIX
SUBTTL Random routines
; Network octal output
OCTOUT: IDIVI A,8.
PUSH P,B
SKIPE A
PUSHJ P,OCTOUT
POP P,B
MOVEI "0(B)
JRST NETOCH
; Network text message
NETMSG: HRLI C,440700 ; called with JSP C,NETMSG
ILDB C
JUMPE 1(C)
PUSHJ P,NETOCH
JRST NETMSG+1
; Negative acknowledgement
NEGACK: MOVEI "-
PUSHJ P,NETOCH
HRLI X,440700
NEGAK1: ILDB X
SKIPN ERSTRP ; verbosity mode on?
CAIE <" > ; no, is it a space?
TRNA
JRST RSEXEC ; space with ERSTR mode off
JUMPE RSEXEC
PUSHJ P,NETOCH
JRST NEGAK1
; Positive acknowledgement
POSACK: MOVEI "+
JRST NETOCH
...LIT: CONSTANTS
; Wonderful network routines
SVRRTS==-1 ; include server routines
DATRTS==-1 ; include data channel routines
ERRTNS==-1 ; include error routines
ERRHAN==-1 ; include automagic error handling
ERRINS==<JRST QUIT> ; error instruction
HSTTAB==-1 ; include host table magic
HSTSIX==-1 ; and alias name kludge
.INSRT NETWRK
END RSSER