Collect TALK files into lispusers/talk/ (#2147)
* Collect TALK files into lispusers/talk/ renamed with hyphen convention. Also pull over TALKGAP files that were previous obsolete, and remove them from obsolete/lispusers * Replace TALK.TEDIT--file got smashed * TALK.TEDIT now comments the current situation
This commit is contained in:
rmkaplan
GitHub
@@ -1,240 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "22-Jul-88 14:16:28" |{MCS:MCS:STANFORD}<LANE>IPTALK.;1| 12755 )
|
||||
|
||||
|
||||
(PRETTYCOMPRINT IPTALKCOMS)
|
||||
|
||||
(RPAQQ IPTALKCOMS ((* TALK (Interim)
|
||||
IP Interface)
|
||||
(LOCALVARS . T)
|
||||
(FNS TALK.IP.SERVER)
|
||||
(FNS TALK.IP.USERNAME TALK.IP.CONNECT TALK.IP.EVENT TALK.START.IP.SERVER)
|
||||
(INITVARS (TALK.UDP.PORT 517))
|
||||
(GLOBALVARS TALK.UDP.PORT TALK.IP.CONSTANTS)
|
||||
(DECLARE%: DONTCOPY (RECORDS TALK.IP.PACKET)
|
||||
(CONSTANTS * TALK.IP.CONSTANTS))
|
||||
(* etc)
|
||||
(FILES TALK TCP TCPUDP)
|
||||
(APPENDVARS (TALK.PROTOCOLTYPES (IP DODIP.HOSTP TALK.IP.USERNAME
|
||||
TALK.IP.CONNECT TALK.IP.EVENT
|
||||
TALK.START.IP.SERVER)))
|
||||
(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS TCPEXPORTS)
|
||||
)
|
||||
(P (TALK.START.IP.SERVER))))
|
||||
|
||||
|
||||
|
||||
(* TALK (Interim) IP Interface)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TALK.IP.SERVER
|
||||
[LAMBDA NIL (* ; "Edited 17-Jun-88 13:45 by cdl")
|
||||
(DECLARE (GLOBALVARS \IP.READY))
|
||||
(LET (SOCKET)
|
||||
(DECLARE (SPECVARS SOCKET))
|
||||
(RESETLST
|
||||
[RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET TALK.UDP.PORT]
|
||||
[bind PACKET RESPONSE SERVICE GAP.SERVICETYPE TALK.SERVICETYPE INPUTSTREAM
|
||||
OUTPUTSTREAM PORT USER while \IP.READY
|
||||
do (SETQ PACKET (UDP.GET SOCKET T))
|
||||
(UDP.SETUP (SETQ RESPONSE (\ALLOCATE.ETHERPACKET))
|
||||
(with IP PACKET IPSOURCEADDRESS)
|
||||
(with UDP PACKET UDPSOURCEPORT)
|
||||
0 SOCKET 'FREE)
|
||||
(UDP.APPEND.BYTE RESPONSE (with TALK.IP.PACKET PACKET TALK.SERVICE.BYTE))
|
||||
(if [OR [NULL (if (SETQ GAP.SERVICETYPE (ASSOC (with TALK.IP.PACKET
|
||||
PACKET
|
||||
TALK.SERVICE.BYTE
|
||||
)
|
||||
GAP.SERVICETYPES))
|
||||
then (SETQ SERVICE (with GAP.SERVICETYPE
|
||||
GAP.SERVICETYPE
|
||||
GAP.SERVICENAME]
|
||||
(NULL (SETQ TALK.SERVICETYPE (ASSOC SERVICE TALK.SERVICETYPES]
|
||||
then (UDP.APPEND.BYTE RESPONSE \IPTALK.NOSERVICE)
|
||||
(UDP.SEND SOCKET RESPONSE)
|
||||
elseif [OR TALK.GAG (NOT (TALK.ANSWER (SETQ USER (with TALK.IP.PACKET
|
||||
PACKET
|
||||
TALK.IP.USERNAME)
|
||||
)
|
||||
SERVICE
|
||||
'IP
|
||||
(with IP PACKET IPSOURCEADDRESS]
|
||||
then (UDP.APPEND.BYTE RESPONSE \IPTALK.NOANSWER)
|
||||
(UDP.SEND SOCKET RESPONSE)
|
||||
else (UDP.APPEND.BYTE RESPONSE \IPTALK.SUCCESS)
|
||||
(UDP.APPEND.WORD RESPONSE (SETQ PORT (\TCP.SELECT.PORT)))
|
||||
(UDP.SEND SOCKET RESPONSE)
|
||||
(if (SETQ INPUTSTREAM (TCP.OPEN (with IP PACKET IPSOURCEADDRESS
|
||||
)
|
||||
NIL PORT 'PASSIVE 'INPUT))
|
||||
then (TALK.PROCESS INPUTSTREAM (TCP.OTHER.STREAM INPUTSTREAM)
|
||||
TALK.SERVICETYPE
|
||||
'IP
|
||||
'SERVER USER T])])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TALK.IP.USERNAME
|
||||
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE MODE USER)
|
||||
(* ; "Edited 8-Jun-88 15:45 by cdl")
|
||||
(SELECTQ (with TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME)
|
||||
((TTY Sketch) (* For (backward) compatibility)
|
||||
USER)
|
||||
(LET ((NAME (USERNAME)))
|
||||
(PRINTOUT OUTPUTSTREAM (if (NOT (STREQUAL NAME (CONSTANT null)))
|
||||
then NAME)
|
||||
T)
|
||||
(FORCEOUTPUT OUTPUTSTREAM)
|
||||
(SETQ NAME (RATOM INPUTSTREAM TALK.READTABLE)) (* Eat EOL)
|
||||
(BIN INPUTSTREAM)
|
||||
(OR NAME USER])
|
||||
|
||||
(TALK.IP.CONNECT
|
||||
[LAMBDA (HOST SERVICETYPES) (* ; "Edited 13-Jun-88 17:54 by cdl")
|
||||
(DECLARE (SPECVARS HOST SERVICETYPES))
|
||||
(LET
|
||||
(SOCKET)
|
||||
(DECLARE (SPECVARS SOCKET))
|
||||
(RESETLST
|
||||
[RESETSAVE NIL `(UDP.CLOSE.SOCKET ,(SETQ SOCKET (UDP.OPEN.SOCKET]
|
||||
[PROG (NAME REQUEST RESPONSE INPUTSTREAM RESULT)
|
||||
(while (STREQUAL (SETQ NAME (USERNAME))
|
||||
(CONSTANT null)) do (LOGIN))
|
||||
(if
|
||||
[LITATOM
|
||||
(SETQ RESULT
|
||||
(for SERVICETYPE in SERVICETYPES
|
||||
thereis (PROGN (UDP.SETUP (SETQ REQUEST (\ALLOCATE.ETHERPACKET))
|
||||
HOST TALK.UDP.PORT 0 SOCKET 'FREE)
|
||||
(UDP.APPEND.BYTE
|
||||
REQUEST
|
||||
(with GAP.SERVICETYPE
|
||||
[for GAP.SERVICETYPE in GAP.SERVICETYPES
|
||||
thereis (with GAP.SERVICETYPE
|
||||
GAP.SERVICETYPE
|
||||
(with TALK.SERVICETYPE
|
||||
SERVICETYPE
|
||||
(EQ GAP.SERVICENAME
|
||||
TALK.SERVICENAME]
|
||||
GAP.UNSPECIFIED))
|
||||
(UDP.APPEND.BYTE REQUEST 0)
|
||||
(UDP.APPEND.WORD REQUEST 0)
|
||||
(UDP.APPEND.WORD REQUEST (NCHARS NAME))
|
||||
(UDP.APPEND.STRING REQUEST NAME)
|
||||
(if [SETQ RESPONSE
|
||||
(UDP.EXCHANGE SOCKET REQUEST
|
||||
(TIMES TALK.ANSWER.WAIT
|
||||
(CONSTANT (PROGN
|
||||
(* Convert to milliseconds and
|
||||
double in case they are idle)
|
||||
(TIMES 2 1000]
|
||||
then (SELECT (with TALK.IP.PACKET RESPONSE
|
||||
TALK.STATUS)
|
||||
(\IPTALK.SUCCESS T)
|
||||
(\IPTALK.NOSERVICE NIL)
|
||||
(\IPTALK.NOANSWER (RETURN 'ANSWER))
|
||||
(RETURN 'CONNECT))
|
||||
else (* Can't connect)
|
||||
(RETURN 'CONNECT]
|
||||
then (RETURN RESULT)
|
||||
else (if (STREAMP (SETQ INPUTSTREAM (TCP.OPEN HOST (with TALK.IP.PACKET
|
||||
RESPONSE
|
||||
TALK.TEDIT.PORT)
|
||||
NIL
|
||||
'ACTIVE
|
||||
'INPUT T)))
|
||||
then [RETURN (CONS RESULT (CONS INPUTSTREAM (TCP.OTHER.STREAM
|
||||
INPUTSTREAM]
|
||||
else (RETURN 'CONNECT])])
|
||||
|
||||
(TALK.IP.EVENT
|
||||
[LAMBDA (INPUTSTREAM OUTPUTSTREAM) (* cdl "18-May-87 16:29")
|
||||
(while (AND (OPENP INPUTSTREAM)
|
||||
(OPENP OUTPUTSTREAM)
|
||||
(NOT (READP INPUTSTREAM))) do (if (EOFP INPUTSTREAM)
|
||||
then (CLOSEF? INPUTSTREAM))
|
||||
(BLOCK])
|
||||
|
||||
(TALK.START.IP.SERVER
|
||||
[LAMBDA (RESTART) (* ; "Edited 17-Jun-88 12:20 by cdl")
|
||||
[LET [(DEVICE (\GETDEVICEFROMNAME 'TCP 'NOERROR 'DONTCREATE]
|
||||
(if DEVICE
|
||||
then (* (Temporary) patch to make TCP
|
||||
streams handle NS character codes)
|
||||
(with FDEV DEVICE (if (NULL READCHARCODE)
|
||||
then (SETQ READCHARCODE (FUNCTION \GENERIC.READCCODE
|
||||
]
|
||||
(bind PROCESS while (AND (SETQ PROCESS (FIND.PROCESS 'TALK.IP.SERVER))
|
||||
RESTART) do (DEL.PROCESS PROCESS)
|
||||
(BLOCK)
|
||||
yield (if PROCESS
|
||||
then PROCESS
|
||||
elseif \IP.READY
|
||||
then (ADD.PROCESS '(TALK.IP.SERVER)
|
||||
'RESTARTABLE
|
||||
'SYSTEM])
|
||||
)
|
||||
|
||||
(RPAQ? TALK.UDP.PORT 517)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS TALK.UDP.PORT TALK.IP.CONSTANTS)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS TALK.IP.PACKET [(TALK.PACKET.BASE (with UDP DATUM UDPCONTENTS))
|
||||
(TALK.IP.USERNAME (\GETBASESTRING (with UDP DATUM UDPCONTENTS)
|
||||
6
|
||||
(with TALK.IP.PACKET DATUM
|
||||
TALK.USERNAME.LENGTH]
|
||||
(BLOCKRECORD TALK.PACKET.BASE ((TALK.SERVICE.BYTE BYTE)
|
||||
(TALK.STATUS BYTE)
|
||||
(TALK.TEDIT.PORT WORD)
|
||||
(TALK.USERNAME.LENGTH WORD))))
|
||||
)
|
||||
|
||||
|
||||
(RPAQQ TALK.IP.CONSTANTS ((\IPTALK.SUCCESS 0)
|
||||
(\IPTALK.NOSERVICE 1)
|
||||
(\IPTALK.NOANSWER 2)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \IPTALK.SUCCESS 0)
|
||||
|
||||
(RPAQQ \IPTALK.NOSERVICE 1)
|
||||
|
||||
(RPAQQ \IPTALK.NOANSWER 2)
|
||||
|
||||
|
||||
(CONSTANTS (\IPTALK.SUCCESS 0)
|
||||
(\IPTALK.NOSERVICE 1)
|
||||
(\IPTALK.NOANSWER 2))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* etc)
|
||||
|
||||
|
||||
(FILESLOAD TALK TCP TCPUDP)
|
||||
|
||||
(APPENDTOVAR TALK.PROTOCOLTYPES (IP DODIP.HOSTP TALK.IP.USERNAME TALK.IP.CONNECT TALK.IP.EVENT
|
||||
TALK.START.IP.SERVER))
|
||||
(DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE
|
||||
|
||||
(FILESLOAD ETHERRECORDS TCPEXPORTS)
|
||||
)
|
||||
|
||||
(TALK.START.IP.SERVER)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1313 4720 (TALK.IP.SERVER 1323 . 4718)) (4721 11119 (TALK.IP.USERNAME 4731 . 5475) (
|
||||
TALK.IP.CONNECT 5477 . 9538) (TALK.IP.EVENT 9540 . 9963) (TALK.START.IP.SERVER 9965 . 11117)))))
|
||||
STOP
|
||||
@@ -1,319 +0,0 @@
|
||||
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
|
||||
(FILECREATED "27-Jul-88 09:09:52" |{MCS:MCS:STANFORD}<LANE>NSTALK.;3| 16112
|
||||
|
||||
changes to%: (FNS DEFINE.GAP.SERVER)
|
||||
|
||||
previous date%: "16-Jun-88 17:33:04" |{MCS:MCS:STANFORD}<LANE>NSTALK.;1|)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT NSTALKCOMS)
|
||||
|
||||
(RPAQQ NSTALKCOMS ((* TALK NS (GAP)
|
||||
Interface)
|
||||
(LOCALVARS . T)
|
||||
(FNS CH.USER.WORKSTATION TALK.NS.SERVER)
|
||||
(FNS TALK.NS.USERNAME TALK.NS.CONNECT TALK.NS.EVENT TALK.NS.CREDENTIALS)
|
||||
(* GAP Server)
|
||||
(FNS GAP.SERVER DEFINE.GAP.SERVER)
|
||||
(INITVARS GAP.SERVICETYPES [TALK.GAP.HANDLE '((0 0]
|
||||
(TALK.GAP.UNKNOWN "(Viewpoint or XDE User)"))
|
||||
(VARS TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
|
||||
(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.UNKNOWN
|
||||
TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
|
||||
(DECLARE%: DONTCOPY (RECORDS GAP.SERVICETYPE))
|
||||
(* etc)
|
||||
(FILES TALK COURIERSERVE)
|
||||
(APPENDVARS (TALK.PROTOCOLTYPES (NS COERCE-TO-NSADDRESS TALK.NS.USERNAME
|
||||
TALK.NS.CONNECT TALK.NS.EVENT
|
||||
COURIER.START.SERVER)))
|
||||
[DECLARE%: DOCOPY (COMS (DECLARE%: EVAL@LOADWHEN (NOT (HASDEF 'GAP
|
||||
'COURIERPROGRAM))
|
||||
(FILES NSTALKGAP]
|
||||
(* DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS SPPDECLS)
|
||||
(* Also need to load EXPORTS.ALL))
|
||||
(* COURIER.RESET.SOCKET used to be defined by TALK, now defined in
|
||||
COURIERSERVE module)
|
||||
(APPENDVARS (BEFORELOGOUTFORMS (COURIER.RESET.SOCKET)))
|
||||
(P (DEFINE.GAP.SERVER)
|
||||
(COURIER.START.SERVER))))
|
||||
|
||||
|
||||
|
||||
(* TALK NS (GAP) Interface)
|
||||
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(LOCALVARS . T)
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(CH.USER.WORKSTATION
|
||||
[LAMBDA (USER WORKSTATION) (* ; "Edited 3-Jun-88 09:18 by cdl")
|
||||
(if WORKSTATION
|
||||
then (LET (NSADDRESS)
|
||||
(if (SETQ NSADDRESS (COERCE-TO-NSADDRESS WORKSTATION (ZERO)))
|
||||
then (CH.DELETE.PROPERTY USER 'ADDRESS.LIST)
|
||||
(CH.ADD.ITEM.PROPERTY USER 'ADDRESS.LIST (SETQ NSADDRESS (CONS
|
||||
NSADDRESS
|
||||
))
|
||||
'(SEQUENCE NSADDRESS))
|
||||
(CONS USER NSADDRESS)
|
||||
else (ERROR WORKSTATION "Address for host not found!")))
|
||||
else (CH.DELETE.PROPERTY USER 'ADDRESS.LIST])
|
||||
|
||||
(TALK.NS.SERVER
|
||||
[LAMBDA (INPUTSTREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
|
||||
(* ; "Edited 15-Jun-88 11:10 by cdl")
|
||||
(* DECLARATIONS%: (ASSOCRECORD ALST
|
||||
(service)))
|
||||
(LET ((USER (TALK.NS.CREDENTIALS CREDENTIALS))
|
||||
(ADDRESS (create NSADDRESS
|
||||
NSSOCKET _ (ZERO) using (SPP.DESTADDRESS INPUTSTREAM)))
|
||||
SERVICETYPE)
|
||||
(with GAP.SERVICETYPE [for SERVICETYPE in GAP.SERVICETYPES
|
||||
thereis (for NUMBER
|
||||
in (CAR (with ALST TRANSPORT service))
|
||||
thereis (with GAP.SERVICETYPE
|
||||
SERVICETYPE (EQP NUMBER
|
||||
GAP.UNSPECIFIED
|
||||
]
|
||||
(if (OR TALK.GAG (NOT (TALK.ANSWER (OR USER TALK.GAP.UNKNOWN)
|
||||
GAP.SERVICENAME
|
||||
'NS ADDRESS)))
|
||||
then (if (AND (EQ GAP.SERVICENAME 'TTY)
|
||||
(NULL VERIFIER))
|
||||
then
|
||||
|
||||
(* Should be noAnswerOrBusy, but that 915's XDE/Viewpoint so use VERIFIER to
|
||||
determine if called by Lisp, can't count on this for future)
|
||||
|
||||
'(ABORT serviceNotFound)
|
||||
else '(ABORT noAnswerOrBusy))
|
||||
else (COURIER.RETURN INPUTSTREAM PROGRAM PROCEDURE TALK.GAP.HANDLE)
|
||||
(TALK.PROCESS INPUTSTREAM (SPPOUTPUTSTREAM INPUTSTREAM)
|
||||
GAP.SERVICENAME
|
||||
'NS
|
||||
'SERVER USER])
|
||||
)
|
||||
(DEFINEQ
|
||||
|
||||
(TALK.NS.USERNAME
|
||||
[LAMBDA (INPUTSTREAM OUTPUTSTREAM SERVICETYPE MODE USER)
|
||||
(* ; "Edited 9-Jun-88 12:42 by cdl")
|
||||
(LET (OBJECT NAME (SERVICE (with TALK.SERVICETYPE SERVICETYPE TALK.SERVICENAME)))
|
||||
(DECLARE (GLOBALVARS LOCAL.CLEARINGHOUSE CH.NET.HINT))
|
||||
(if (OR (EQ SERVICE 'TEdit)
|
||||
(EQ MODE 'CLIENT))
|
||||
then (if (STREQUAL (SETQ NAME (USERNAME))
|
||||
(CONSTANT null))
|
||||
then (SETQ NAME NIL)
|
||||
elseif (OR LOCAL.CLEARINGHOUSE CH.NET.HINT)
|
||||
then (if (SETQ OBJECT (CH.LOOKUP.OBJECT NAME))
|
||||
then (SETQ NAME OBJECT)))
|
||||
(PRINTOUT OUTPUTSTREAM NAME T)
|
||||
(FORCEOUTPUT OUTPUTSTREAM))
|
||||
(if (OR (EQ SERVICE 'TEdit)
|
||||
(EQ MODE 'SERVER))
|
||||
then (if (SETQ OBJECT (RATOM INPUTSTREAM TALK.READTABLE))
|
||||
then (SETQ USER OBJECT)) (* Eat EOL)
|
||||
(BIN INPUTSTREAM))
|
||||
(SELECTQ SERVICE
|
||||
(TTY (with SPPCON (with SPPSTREAM OUTPUTSTREAM SPP.CONNECTION)
|
||||
(SETQ SPPEOMONFORCEOUT T)))
|
||||
NIL)
|
||||
USER])
|
||||
|
||||
(TALK.NS.CONNECT
|
||||
[LAMBDA (HOST SERVICETYPES) (* ; "Edited 15-Jun-88 10:40 by cdl")
|
||||
(* DECLARATIONS%: (RECORD
|
||||
AUTHENTICATOR (CREDENTIALS VERIFIER)))
|
||||
(PROG (USER STREAM SERVICETYPE RESULT (CREDENTIALS (with AUTHENTICATOR (CH.GETAUTHENTICATOR
|
||||
T)
|
||||
CREDENTIALS))
|
||||
(VERIFIER (with AUTHENTICATOR (CH.GETAUTHENTICATOR)
|
||||
VERIFIER)))
|
||||
(DECLARE (GLOBALVARS SPP.USER.TIMEOUT))
|
||||
(if (SETQ STREAM (COURIER.OPEN HOST NIL T (PACK* 'TALK# HOST)))
|
||||
then
|
||||
(if
|
||||
(SETQ SERVICETYPE
|
||||
(for SERVICETYPE in SERVICETYPES
|
||||
thereis
|
||||
(SELECTQ [CAR
|
||||
(SETQ RESULT
|
||||
(COURIER.CALL
|
||||
STREAM
|
||||
'GAP
|
||||
'Create TALK.GAP.PARAMETERS
|
||||
`([service (,(with GAP.SERVICETYPE
|
||||
[for TYPE in GAP.SERVICETYPES
|
||||
thereis (with GAP.SERVICETYPE TYPE
|
||||
(with TALK.SERVICETYPE
|
||||
SERVICETYPE
|
||||
(EQ GAP.SERVICENAME
|
||||
TALK.SERVICENAME]
|
||||
GAP.UNSPECIFIED]
|
||||
,@TALK.GAP.TRANSPORT)
|
||||
SPP.USER.TIMEOUT CREDENTIALS VERIFIER 'RETURNERRORS]
|
||||
(ERROR (SELECTQ (CADR RESULT)
|
||||
(noAnswerOrBusy (* User hung up or didn't answer,
|
||||
don't try another service)
|
||||
(RETURN))
|
||||
(serviceNotFound
|
||||
|
||||
(* Old Lisp TTY service returns this when it really means noAnswerOrBusy for
|
||||
compatibility with Tajo/Viewpoint.)
|
||||
|
||||
(if (with TALK.SERVICETYPE SERVICETYPE
|
||||
(EQ TALK.SERVICENAME 'TTY))
|
||||
then
|
||||
|
||||
(* Don't try services following TTY service for NS we don't know if remote
|
||||
service wasn't there or remote user refused connection so we may annoy the
|
||||
remote user, of course we may miss a possible connection)
|
||||
|
||||
(RETURN)))
|
||||
NIL))
|
||||
RESULT)))
|
||||
then [RETURN (CONS SERVICETYPE (CONS STREAM (SPPOUTPUTSTREAM STREAM]
|
||||
else (CLOSEF? STREAM)
|
||||
(RETURN 'ANSWER))
|
||||
else (RETURN 'CONNECT])
|
||||
|
||||
(TALK.NS.EVENT
|
||||
[LAMBDA (INPUTSTREAM OUTPUTSTREAM) (* cdl "10-Jun-87 07:55")
|
||||
(if (AND (OPENP INPUTSTREAM)
|
||||
(OPENP OUTPUTSTREAM)
|
||||
(NOT (READP INPUTSTREAM)))
|
||||
then (AWAIT.EVENT (with SPPCON (with SPPSTREAM INPUTSTREAM SPP.CONNECTION)
|
||||
SPPINPUTEVENT)))
|
||||
(if (OPENP INPUTSTREAM)
|
||||
then (SELECTQ (EOFP INPUTSTREAM)
|
||||
(ATTENTION (SPP.CLEARATTENTION INPUTSTREAM)
|
||||
(BIN INPUTSTREAM))
|
||||
(EOM (SPP.CLEAREOM INPUTSTREAM))
|
||||
(T (CLOSEF INPUTSTREAM))
|
||||
NIL])
|
||||
|
||||
(TALK.NS.CREDENTIALS
|
||||
[LAMBDA (CREDENTIALS) (* cdl " 6-May-87 15:58")
|
||||
(if (AND CREDENTIALS (SETQ CREDENTIALS (CADR CREDENTIALS)))
|
||||
then (SUBATOM (COURIER.READ.REP CREDENTIALS 'CLEARINGHOUSE 'NAME)
|
||||
1 -2])
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* GAP Server)
|
||||
|
||||
(DEFINEQ
|
||||
|
||||
(GAP.SERVER
|
||||
[LAMBDA (STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS VERIFIER)
|
||||
(* ; "Edited 9-Jun-88 12:06 by cdl")
|
||||
(* DECLARATIONS%: (ASSOCRECORD ALST
|
||||
(service)))
|
||||
(LET (SERVICETYPE)
|
||||
(if [OR [for NUMBER in (CAR (with ALST TRANSPORT service))
|
||||
thereis (SETQ SERVICETYPE (for SERVICETYPE in GAP.SERVICETYPES
|
||||
thereis (with GAP.SERVICETYPE
|
||||
SERVICETYPE
|
||||
(AND (EQP NUMBER
|
||||
GAP.UNSPECIFIED
|
||||
)
|
||||
GAP.SERVERFN]
|
||||
(AND (SETQ SERVICETYPE (ASSOC T GAP.SERVICETYPES))
|
||||
(with GAP.SERVICETYPE SERVICETYPE
|
||||
(* There was a server in place
|
||||
before TALK was loaded)
|
||||
(FGETD GAP.SERVERFN]
|
||||
then (APPLY* (with GAP.SERVICETYPE SERVICETYPE GAP.SERVERFN)
|
||||
STREAM PROGRAM PROCEDURE PARAMETERS TRANSPORT WAITTIME CREDENTIALS
|
||||
VERIFIER)
|
||||
else '(ABORT serviceNotFound])
|
||||
|
||||
(DEFINE.GAP.SERVER
|
||||
[LAMBDA NIL (* ; "Edited 27-Jul-88 09:08 by cdl")
|
||||
(* DECLARATIONS%: (ASSOCRECORD
|
||||
PROCEDURES (Create))
|
||||
(PROPRECORD PROCEDURE
|
||||
(IMPLEMENTEDBY)))
|
||||
(if (HASDEF 'GAP 'COURIERPROGRAM)
|
||||
then (PROG [SERVERFN PROCEDURE (COURIERDEF (GETDEF 'GAP 'COURIERPROGRAM]
|
||||
[with COURIERPGM COURIERDEF (SETQ PROCEDURE (with PROCEDURES
|
||||
PROCEDURES Create))
|
||||
[if (SETQ SERVERFN (with PROCEDURE PROCEDURE IMPLEMENTEDBY))
|
||||
then (if (EQ SERVERFN 'GAP.SERVER)
|
||||
then (RETURN))
|
||||
(* Make the existing GAP server the
|
||||
default)
|
||||
(if GAP.SERVICETYPES
|
||||
then (PUTASSOC T `(DEFAULT ,SERVERFN)
|
||||
GAP.SERVICETYPES)
|
||||
else (push GAP.SERVICETYPES
|
||||
`(T DEFAULT ,SERVERFN]
|
||||
(with PROCEDURE PROCEDURE (SETQ IMPLEMENTEDBY 'GAP.SERVER]
|
||||
(PUTDEF 'GAP 'COURIERPROGRAM COURIERDEF)
|
||||
(UNMARKASCHANGED 'GAP 'COURIERPROGRAM))
|
||||
else (ERROR "Courier program GAP not defined!"])
|
||||
)
|
||||
|
||||
(RPAQ? GAP.SERVICETYPES NIL)
|
||||
|
||||
(RPAQ? TALK.GAP.HANDLE '((0 0)))
|
||||
|
||||
(RPAQ? TALK.GAP.UNKNOWN "(Viewpoint or XDE User)")
|
||||
|
||||
(RPAQQ TALK.GAP.PARAMETERS (ttyHost (seven even two 100 (none 0 0))))
|
||||
|
||||
(RPAQQ TALK.GAP.TRANSPORT ((teletype)))
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
(GLOBALVARS GAP.SERVICETYPES TALK.GAP.HANDLE TALK.GAP.UNKNOWN TALK.GAP.PARAMETERS TALK.GAP.TRANSPORT)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RECORD GAP.SERVICETYPE (GAP.UNSPECIFIED GAP.SERVICENAME GAP.SERVERFN))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* etc)
|
||||
|
||||
|
||||
(FILESLOAD TALK COURIERSERVE)
|
||||
|
||||
(APPENDTOVAR TALK.PROTOCOLTYPES (NS COERCE-TO-NSADDRESS TALK.NS.USERNAME TALK.NS.CONNECT
|
||||
TALK.NS.EVENT COURIER.START.SERVER))
|
||||
(DECLARE%: DOCOPY
|
||||
(DECLARE%: EVAL@LOADWHEN
|
||||
(NOT (HASDEF 'GAP 'COURIERPROGRAM))
|
||||
|
||||
(FILESLOAD NSTALKGAP)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
|
||||
(* DECLARE%: DONTCOPY DONTEVAL@LOAD EVAL@COMPILE (FILES ETHERRECORDS SPPDECLS) (* Also need to load
|
||||
EXPORTS.ALL))
|
||||
|
||||
|
||||
|
||||
|
||||
(* COURIER.RESET.SOCKET used to be defined by TALK, now defined in COURIERSERVE module)
|
||||
|
||||
|
||||
(APPENDTOVAR BEFORELOGOUTFORMS (COURIER.RESET.SOCKET))
|
||||
|
||||
(DEFINE.GAP.SERVER)
|
||||
|
||||
(COURIER.START.SERVER)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (2304 5420 (CH.USER.WORKSTATION 2314 . 3215) (TALK.NS.SERVER 3217 . 5418)) (5421 11213 (
|
||||
TALK.NS.USERNAME 5431 . 6816) (TALK.NS.CONNECT 6818 . 10218) (TALK.NS.EVENT 10220 . 10917) (
|
||||
TALK.NS.CREDENTIALS 10919 . 11211)) (11237 14919 (GAP.SERVER 11247 . 13041) (DEFINE.GAP.SERVER 13043
|
||||
. 14917)))))
|
||||
STOP
|
||||
File diff suppressed because one or more lines are too long
Reference in New Issue
Block a user