(FILECREATED "10-Aug-85 15:25:23" {ERIS}<LISPCORE>LIBRARY>TCPCHAT.;11 10367
changes to: (FNS TCPCHAT.OPEN TCPCHAT.TELNET.SERVER)
(VARS TCPCHATCOMS)
previous date: "23-Jun-85 19:52:00" {ERIS}<LISPCORE>LIBRARY>TCPCHAT.;8)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPCHATCOMS)
(RPAQQ TCPCHATCOMS ((FNS TCPCHAT.BIN TCPCHAT.HOST.FILTER TCPCHAT.NEGOTIATE TCPCHAT.OPEN
TCPCHAT.OPTION.COMMAND TCPCHAT.OPTION.INPUT TCPCHAT.OPTION.OUTPUT
TCPCHAT.OPTION.TRACE TCPCHAT.TELNET.SERVER TCPCHAT.TERMINAL.TYPE)
(COMS (CONSTANTS * TELNET.COMMANDS)
(CONSTANTS * TELNET.MARKS))
(VARS TCPCHAT.TELNET.TTY.TYPES TELNET.OPTIONS)
(GLOBALVARS TCPCHAT.TELNET.TTY.TYPES TELNET.OPTIONS TELNET.MARKS)
(ADDVARS (CHAT.PROTOCOLTYPES (TCP . TCPCHAT.HOST.FILTER)))
(P (COND ((BOUNDP (QUOTE CHAT.PROTCOLS))
(ADDTOVAR CHAT.PROTOCOLS TCPCHAT.HOST.FILTER))))
(INITVARS (TCPCHAT.TRACEFLG)
(TCPCHAT.TRACEFILE))
(RECORDS TELNET.OPTION)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCP CHAT)))
(DEFINEQ
(TCPCHAT.BIN
(LAMBDA (STREAM) (* ejs: "22-Apr-85 16:31")
(bind CHAR while (EQ (SETQ CHAR (\BUFFERED.BIN STREAM))
TELNET.IAC)
do (TCPCHAT.NEGOTIATE STREAM) finally (RETURN CHAR))))
(TCPCHAT.HOST.FILTER
(LAMBDA (HOST) (* ejs: "22-Apr-85 15:08")
(COND
((DODIP.HOSTP HOST)
(LIST (\CANONICAL.HOSTNAME HOST)
(FUNCTION TCPCHAT.OPEN))))))
(TCPCHAT.NEGOTIATE
(LAMBDA (STREAM) (* ejs: "22-Apr-85 15:55")
(TCPCHAT.OPTION.INPUT (TCP.OTHER.STREAM STREAM)
(\BUFFERED.BIN STREAM)
(\BUFFERED.BIN STREAM))))
(TCPCHAT.OPEN
(LAMBDA (HOST) (* ejs: "10-Aug-85 15:23")
(PROG ((STREAM (TCP.OPEN (DODIP.HOSTP HOST)
\TCP.TELNET.PORT NIL (QUOTE ACTIVE)
(QUOTE INPUT)))
(OSTYPE (OR (GETHOSTINFO (QUOTE HOST)
(QUOTE OSTYPE))
(fetch (HOSTS.TXT.ENTRY HTE.OS.TYPE) of (GETHASH HOST \IP.HOSTNAMES))))
OUTPUTSTREAM)
(COND
(STREAM (replace (STREAM BINABLE) of STREAM with NIL)
(* Can't run microcoded)
(replace (STREAM STRMBINFN) of STREAM with (FUNCTION TCPCHAT.BIN))
(STREAMPROP STREAM (QUOTE SETDISPLAYTYPE)
(FUNCTION NILL))
(COND
((EQ OSTYPE (QUOTE INTERLISP))
(RETURN (CONS STREAM (TCP.OTHER.STREAM STREAM)))))
(* (STREAMPROP STREAM (QUOTE SETDISPLAYTYPE)
(FUNCTION TCPCHAT.TERMINAL.TYPE)))
(SETQ OUTPUTSTREAM (TCP.OTHER.STREAM STREAM))
(TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.DO TELNET.ECHO)
(TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.DO TELNET.SUPPRESS.GOAHEAD)
(TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.WILL TELNET.SUPPRESS.GOAHEAD)
(COND
((NEQ OSTYPE (QUOTE UNIX))
(TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.DO TELNET.BINARY)
(TCPCHAT.OPTION.COMMAND OUTPUTSTREAM TELNET.WILL TELNET.BINARY)))
(RETURN (CONS STREAM OUTPUTSTREAM)))))))
(TCPCHAT.OPTION.COMMAND
(LAMBDA (OUTPUTSTREAM COMMAND OPTION) (* ejs: "22-Apr-85 16:43")
(BOUT OUTPUTSTREAM TELNET.IAC)
(BOUT OUTPUTSTREAM COMMAND)
(BOUT OUTPUTSTREAM OPTION)
(FORCEOUTPUT OUTPUTSTREAM)
(TCPCHAT.OPTION.TRACE COMMAND OPTION (QUOTE SEND))))
(TCPCHAT.OPTION.INPUT
(LAMBDA (OUTPUTSTREAM COMMAND OPTION) (* ejs: "22-Apr-85 17:06")
(LET ((OPTIONRECORD (FASSOC OPTION TELNET.OPTIONS)))
(COND
(OPTIONRECORD (SELECTC COMMAND
(TELNET.DO (TCPCHAT.OPTION.TRACE (QUOTE DO)
OPTION
(QUOTE RECV))
(TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION
ON.DO)
of OPTIONRECORD)
OPTION))
(TELNET.DONT (TCPCHAT.OPTION.TRACE (QUOTE DONT)
OPTION
(QUOTE RECV))
(TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION
ON.DONT)
of OPTIONRECORD)
OPTION))
(TELNET.WILL (TCPCHAT.OPTION.TRACE (QUOTE WILL)
OPTION
(QUOTE RECV))
(TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION
ON.WILL)
of OPTIONRECORD)
OPTION))
(TELNET.WONT (TCPCHAT.OPTION.TRACE (QUOTE WONT)
OPTION
(QUOTE RECV))
(TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (fetch (TELNET.OPTION
ON.WONT)
of OPTIONRECORD)
OPTION))
COMMAND))
(T (TCPCHAT.OPTION.TRACE COMMAND OPTION)
(TCPCHAT.OPTION.OUTPUT OUTPUTSTREAM (QUOTE WONT)
OPTION))))))
(TCPCHAT.OPTION.OUTPUT
(LAMBDA (OUTPUTSTREAM COMMAND OPTION) (* ejs: "27-Apr-85 19:07")
(COND
((NULL COMMAND))
((FMEMB COMMAND (QUOTE (WILL WONT DO DONT)))
(BOUT OUTPUTSTREAM TELNET.IAC)
(SELECTQ COMMAND
(DO (BOUT OUTPUTSTREAM TELNET.DO)
(BOUT OUTPUTSTREAM OPTION))
(DONT (BOUT OUTPUTSTREAM TELNET.DONT)
(BOUT OUTPUTSTREAM OPTION))
(WILL (BOUT OUTPUTSTREAM TELNET.WILL)
(BOUT OUTPUTSTREAM OPTION))
(WONT (BOUT OUTPUTSTREAM TELNET.WONT)
(BOUT OUTPUTSTREAM OPTION))
(SHOULDNT))
(FORCEOUTPUT OUTPUTSTREAM)
(TCPCHAT.OPTION.TRACE COMMAND OPTION (QUOTE SENDBACK)))
(T (APPLY* COMMAND (TCP.OTHER.STREAM OUTPUTSTREAM))))))
(TCPCHAT.OPTION.TRACE
(LAMBDA (COMMAND OPTION PREFIX) (* ejs: "22-Apr-85 16:41")
(DECLARE (GLOBALVARS TCPCHAT.TRACEFLG TCPCHAT.TRACEFILE))
(COND
(TCPCHAT.TRACEFLG (COND
((SMALLP COMMAND)
(SETQ COMMAND (SELECTC COMMAND
(TELNET.DO (QUOTE DO))
(TELNET.DONT (QUOTE DONT))
(TELNET.WILL (QUOTE WILL))
(TELNET.WONT (QUOTE WONT))
COMMAND))))
(printout TCPCHAT.TRACEFILE PREFIX ": " COMMAND " ")
(PRINTCONSTANT OPTION TELNET.MARKS TCPCHAT.TRACEFILE)
(TERPRI TCPCHAT.TRACEFILE)))))
(TCPCHAT.TELNET.SERVER
(LAMBDA (SOCKET) (* ejs: "10-Aug-85 14:05")
(* * A Telnet server for Interlisp-D)
(LET (INSTREAM OUTSTREAM)
(SETQ INSTREAM (TCP.OPEN NIL NIL (OR SOCKET \TCP.TELNET.PORT)
(QUOTE PASSIVE)
(QUOTE INPUT)
T))
(COND
(INSTREAM (SETQ OUTSTREAM (TCP.OTHER.STREAM INSTREAM))
(ADD.PROCESS (LIST (FUNCTION TCPCHAT.TELNET.SERVER)
SOCKET))
(MAKEREMOTE INSTREAM OUTSTREAM)
(EVALQT))))))
(TCPCHAT.TERMINAL.TYPE
(LAMBDA (INPUTSTREAM) (* ejs: "27-Apr-85 19:07")
(LET* ((OUTPUTSTREAM (TCP.OTHER.STREAM INPUTSTREAM))
(DISPLAYTYPE (OR (CDR (FASSOC (fetch (CHATDISPLAYTYPE DPYNAME) of (STREAMPROP INPUTSTREAM
(QUOTE
DISPLAYTYPE)))
TCPCHAT.TELNET.TTY.TYPES))
(CDR (FASSOC (fetch (CHATDISPLAYTYPE DPYNAME) of (STREAMPROP OUTPUTSTREAM
(QUOTE
DISPLAYTYPE)))
TCPCHAT.TELNET.TTY.TYPES)))))
(BOUT OUTPUTSTREAM TELNET.IAC)
(BOUT OUTPUTSTREAM TELNET.SB)
(BOUT OUTPUTSTREAM TELNET.TERMINAL.TYPE)
(BOUT OUTPUTSTREAM 0)
(PRIN1 DISPLAYTYPE OUTPUTSTREAM)
(BOUT OUTPUTSTREAM TELNET.IAC)
(BOUT OUTPUTSTREAM TELNET.SE)
(FORCEOUTPUT OUTPUTSTREAM)
(COND
(TCPCHAT.TRACEFLG (printout TCPCHAT.TRACEFILE "SEND(BACK) IAC SB TERMINAL-TYPE IS "
DISPLAYTYPE " IAC SE" T))))))
)
(RPAQQ TELNET.COMMANDS ((TELNET.SE 240)
(TELNET.SB 250)
(TELNET.WILL 251)
(TELNET.WONT 252)
(TELNET.DO 253)
(TELNET.DONT 254)
(TELNET.IAC 255)))
(DECLARE: EVAL@COMPILE
(RPAQQ TELNET.SE 240)
(RPAQQ TELNET.SB 250)
(RPAQQ TELNET.WILL 251)
(RPAQQ TELNET.WONT 252)
(RPAQQ TELNET.DO 253)
(RPAQQ TELNET.DONT 254)
(RPAQQ TELNET.IAC 255)
(CONSTANTS (TELNET.SE 240)
(TELNET.SB 250)
(TELNET.WILL 251)
(TELNET.WONT 252)
(TELNET.DO 253)
(TELNET.DONT 254)
(TELNET.IAC 255))
)
(RPAQQ TELNET.MARKS ((TELNET.BINARY 0)
(TELNET.ECHO 1)
(TELNET.SUPPRESS.GOAHEAD 3)
(TELNET.STATUS 5)
(TELNET.TIMING.MARK 6)
(TELNET.TERMINAL.TYPE 24)))
(DECLARE: EVAL@COMPILE
(RPAQQ TELNET.BINARY 0)
(RPAQQ TELNET.ECHO 1)
(RPAQQ TELNET.SUPPRESS.GOAHEAD 3)
(RPAQQ TELNET.STATUS 5)
(RPAQQ TELNET.TIMING.MARK 6)
(RPAQQ TELNET.TERMINAL.TYPE 24)
(CONSTANTS (TELNET.BINARY 0)
(TELNET.ECHO 1)
(TELNET.SUPPRESS.GOAHEAD 3)
(TELNET.STATUS 5)
(TELNET.TIMING.MARK 6)
(TELNET.TERMINAL.TYPE 24))
)
(RPAQQ TCPCHAT.TELNET.TTY.TYPES ((DM2500 . DATAMEDIA-2500)
(VT100 . DEC-VT100)))
(RPAQQ TELNET.OPTIONS ((0 WILL WONT NIL DONT)
(1 WONT WONT DO DO)
(3 WILL WILL NIL NIL)
(5 WONT WONT DONT DONT)
(6 WILL NIL NIL NIL)
(24 TCPCHAT.TERMINAL.TYPE NIL DONT NIL)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TCPCHAT.TELNET.TTY.TYPES TELNET.OPTIONS TELNET.MARKS)
)
(ADDTOVAR CHAT.PROTOCOLTYPES (TCP . TCPCHAT.HOST.FILTER))
(COND ((BOUNDP (QUOTE CHAT.PROTCOLS))
(ADDTOVAR CHAT.PROTOCOLS TCPCHAT.HOST.FILTER)))
(RPAQ? TCPCHAT.TRACEFLG )
(RPAQ? TCPCHAT.TRACEFILE )
[DECLARE: EVAL@COMPILE
(RECORD TELNET.OPTION (OPTION ON.DO ON.DONT ON.WILL ON.WONT))
]
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
TCP CHAT)
(PUTPROPS TCPCHAT COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1121 8368 (TCPCHAT.BIN 1131 . 1413) (TCPCHAT.HOST.FILTER 1415 . 1657) (
TCPCHAT.NEGOTIATE 1659 . 1900) (TCPCHAT.OPEN 1902 . 3534) (TCPCHAT.OPTION.COMMAND 3536 . 3865) (
TCPCHAT.OPTION.INPUT 3867 . 5276) (TCPCHAT.OPTION.OUTPUT 5278 . 6078) (TCPCHAT.OPTION.TRACE 6080 .
6724) (TCPCHAT.TELNET.SERVER 6726 . 7311) (TCPCHAT.TERMINAL.TYPE 7313 . 8366)))))
STOP