(FILECREATED "10-Aug-85 00:23:32" {ERIS}<LISPCORE>LIBRARY>NSCHAT.;8 18140  

      changes to:  (FNS NSCHAT.OPEN)

      previous date: " 2-Jul-85 13:46:47" {ERIS}<LISPCORE>LIBRARY>NSCHAT.;7)


(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT NSCHATCOMS)

(RPAQQ NSCHATCOMS ((COURIERPROGRAMS GAP)
		   (FNS NSCHAT.ATTENTIONFN NSCHAT.DIALOUT NSCHAT.ERRORHANDLER NSCHAT.HOST.FILTER 
			NSCHAT.OPEN NSCHAT.SERVICES SPP.INPUT.EVENT)
		   (CONSTANTS (\NS.WKS.Courier 5))
		   (ADDVARS (CHAT.PROTOCOLTYPES (NS . NSCHAT.HOST.FILTER)))
		   (INITVARS (NSCHAT.OPTIONS.MENU))
		   (GLOBALVARS NSCHAT.OPTIONS.MENU)))

(COURIERPROGRAM GAP (3 3)
    TYPES
      ((WaitTime CARDINAL)
       (CharLength (ENUMERATION (five 0)
				(six 1)
				(seven 2)
				(eight 3)))
       (Parity (ENUMERATION (none 0)
			    (odd 1)
			    (even 2)
			    (one 3)
			    (zero 4)))
       (StopBits (ENUMERATION (one 0)
			      (two 1)))
       (FlowControl (RECORD (type (ENUMERATION (none 0)
					       (xOnXOff 1)))
			    (xOn UNSPECIFIED)
			    (xOff UNSPECIFIED)))
       (SessionHandle (ARRAY 2 UNSPECIFIED))
       (SessionParameterObject (CHOICE (xerox800 0 NIL)
				       (xerox850 1 UNSPECIFIED)
				       (xerox860 2 UNSPECIFIED)
				       (system6 3 (RECORD (sendBlockSize CARDINAL)
							  (receiveBlockSize CARDINAL)))
				       (cmcll 4 (RECORD (sendBlockSize CARDINAL)
							(receiveBlockSize CARDINAL)))
				       (ibm2770 5 (RECORD (sendBlockSize CARDINAL)
							  (receiveBlockSize CARDINAL)))
				       (ibm2770Host 6 (RECORD (sendBlockSize CARDINAL)
							      (receiveBlockSize CARDINAL)))
				       (ibm6670 7 (RECORD (sendBlockSize CARDINAL)
							  (receiveBlockSize CARDINAL)))
				       (ibm6670Host 8 (RECORD (sendBlockSize CARDINAL)
							      (receiveBlockSize CARDINAL)))
				       (ibm3270 9 NIL)
				       (ibm3270Host 10 NIL)
				       (OldTtyHost 11 (RECORD (charLength CharLength)
							      (parity Parity)
							      (stopBits StopBits)
							      (frameTimeout CARDINAL)))
				       (OldTty 12 (RECORD (charLength CharLength)
							  (parity Parity)
							  (stopBits StopBits)
							  (frameTimeout CARDINAL)))
				       (other 13 NIL)
				       (unknown 14 NIL)
				       (ibm2780 15 (RECORD (sendBlockSize CARDINAL)
							   (receiveBlockSize CARDINAL)))
				       (ibm2780Host 16 (RECORD (sendBlockSize CARDINAL)
							       (receiveBlockSize CARDINAL)))
				       (ibm3780 17 (RECORD (sendBlockSize CARDINAL)
							   (receiveBlockSize CARDINAL)))
				       (ibm3780Host 18 (RECORD (sendBlockSize CARDINAL)
							       (receiveBlockSize CARDINAL)))
				       (siemens9750 19 NIL)
				       (siemens9750Host 20 NIL)
				       (ttyHost 21 (RECORD (charLength CharLength)
							   (parity Parity)
							   (stopBits StopBits)
							   (frameTimeout CARDINAL)
							   (flowControl FlowControl)))
				       (tty 22 (RECORD (charLength CharLength)
						       (parity Parity)
						       (stopBits StopBits)
						       (frameTimeout CARDINAL)
						       (flowControl FlowControl)))))
       (TransportObject (CHOICE (rs232c 0 (RECORD (CommParams CommParamObject)
						  (preemptOthers ReserveType)
						  (preemptMe ReserveType)
						  (phoneNumber STRING)
						  (line (CHOICE (alreadyReserved 0
										 (RECORD
										   (resource Resource)
										   ))
								(reserveNeeded 1 (RECORD
										 (lineNumber CARDINAL)
										 ))))))
				(bsc 1 (RECORD (localTerminalID STRING)
					       (localSecurityID STRING)
					       (lineControl LineControl)
					       (authenticateProc UNSPECIFIED)))
				(teletype 2 NIL)
				(polledBSCController 3 (RECORD (hostControllerName STRING)
							       (controllerAddress ControllerAddress)
							       (portsOnController CARDINAL)))
				(sdlcController 4 (RECORD (hostControllerName STRING)
							  (controllerAddress ControllerAddress)
							  (portsOnController CARDINAL)))
				(polledBSCTerminal 5 (RECORD (hostControllerName STRING)
							     (terminalAddress TerminalAddress)))
				(sdlcTerminal 6 (RECORD (hostControllerName STRING)
							(terminalAddress TerminalAddress)))
				(service 7 (RECORD (id LONGCARDINAL)))
				(unused 8 NIL)
				(polledBSCPrinter 9 (RECORD (hostControllerName STRING)
							    (printerAddress TerminalAddress)))
				(sdlcPrinter 10 (RECORD (hostControllerName STRING)
							(printerAddress TerminalAddress)))))
       (Sequence.TransportObject (SEQUENCE TransportObject))
       (BidReply (ENUMERATION (wack 0)
			      (nack 1)
			      (default 2)))
       (ExtendedBoolean (ENUMERATION (true 0)
				     (false 1)
				     (default 2)))
       (DeviceType (ENUMERATION (undefined 0)
				(terminal 1)
				(printer 2)))
       (AccessDetail (CHOICE (directConn 0 (RECORD (duplex (ENUMERATION (full 0)
									(half 1)))
						   (lineType LineType)
						   (lineSpeed LineSpeed)))
			     (dialConn 1 (RECORD (duplex (ENUMERATION (full 0)
								      (half 1)))
						 (lineType LineType)
						 (lineSpeed LineSpeed)
						 (dialMode (ENUMERATION (manual 0)
									(auto 1)))
						 (dialerNumber CARDINAL)
						 (retryCount CARDINAL)))))
       (CommParamObject (RECORD (accessDetail AccessDetail)))
       (LineType (ENUMERATION (bitSynchronous 0)
			      (byteSynchronous 1)
			      (asynchronous 2)
			      (autoRecognition 3)))
       (LineSpeed (ENUMERATION (bps50 0)
			       (bps75 1)
			       (bps110 2)
			       (bps135p5 3)
			       (bps150 4)
			       (bps300 5)
			       (bps600 6)
			       (bps1200 7)
			       (bps2400 8)
			       (bps3600 9)
			       (bps4800 10)
			       (bps7200 11)
			       (bps9600 12)
			       (bps19200 13)
			       (bps28800 14)
			       (bps38400 15)
			       (bps48000 16)
			       (bps56000 17)
			       (bps57600 18)))
       (LineControl (ENUMERATION (primary 0)
				 (secondary 1)))
       (ControllerAddress CARDINAL)
       (TerminalAddress CARDINAL)
       (credentials (AUTHENTICATION . CREDENTIALS))
       (verifier (AUTHENTICATION . VERIFIER))
       (Duplexity (ENUMERATION (full 0)
			       (half 1)))
       (PortClientType (ENUMERATION (unassigned 0)
				    (outOfService 1)
				    (its 2)
				    (irs 3)
				    (gws 4)
				    (ibm3270Host 5)
				    (ttyEmulation 6)
				    (rbs 7)
				    (fax 8)
				    (mailGateway 9)
				    (phototypesetter 10)))
       (PortDialerType (ENUMERATION (none 0)
				    (vadic 1)
				    (hayes 2)
				    (ventel 3)
				    (rs366 4)))
       (PortEchoingLocation (ENUMERATION (application 0)
					 (ciu 1)
					 (terminal 2)))
       (ReserveType (ENUMERATION (preemptNever 0)
				 (preemptAlways 1)
				 (preemptInactive 2)))
       (RS232CData (RECORD (cIUPort BOOLEAN)
			   (owningClientType PortClientType)
			   (preemptionAllowed BOOLEAN)
			   (lineNumber CARDINAL)
			   (dialerNumber CARDINAL)
			   (duplexity Duplexity)
			   (dialingHardware PortDialerType)
			   (charLength CharLength)
			   (echoing PortEchoingLocation)
			   (flowControl FlowControl)
			   (lineSpeed LineSpeed)
			   (parity Parity)
			   (stopBits StopBits)
			   (portActsAsDCE BOOLEAN)
			   (accessControl NSNAME)
			   (validLineSpeeds (SEQUENCE LineSpeed)))))
    PROCEDURES
      ((Reset 0)
       (Create 2 (SessionParameterObject Sequence.TransportObject WaitTime credentials verifier)
	       RETURNS
	       (SessionHandle)
	       REPORTS
	       (badAddressFormat controllerAlreadyExists controllerDoesNotExist 
				 dialingHardwareProblem illegalTransport inconsistentParams 
				 mediumConnectFailed noCommunicationHardware noDialingHardware 
				 terminalAddressInUse terminalAddressInvalid tooManyGateStreams 
				 transmissionMediumUnavailable serviceTooBusy userNotAuthenticated 
				 userNotAuthorized serviceNotFound)))
    ERRORS
      ((unimplemented 0)
       (noCommunicationHardware 1)
       (illegalTransport 2)
       (mediumConnectFailed 3)
       (badAddressFormat 4)
       (noDialingHardware 5)
       (dialingHardwareProblem 6)
       (transmissionMediumUnavailable 7)
       (inconsistentParams 8)
       (tooManyGateStreams 9)
       (bugInGAPCode 10)
       (gapNotExported 11)
       (gapCommunicationError 12)
       (controllerAlreadyExists 13)
       (controllerDoesNotExist 14)
       (terminalAddressInUse 15)
       (terminalAddressInvalid 16)))
(DEFINEQ

(NSCHAT.ATTENTIONFN
  (LAMBDA (STREAM ATTNBYTE)                                  (* bvm: "11-Mar-85 13:00")
    (SELECTQ ATTNBYTE
	     (208 -1)
	     (209 (NOTIFY.EVENT (STREAMPROP STREAM (QUOTE MediumUpEvent))))
	     (COND
	       ((OR XIPTRACEFLG NSWIZARDFLG)
		 (printout PROMPTWINDOW T "Attention byte: " .I1.8 ATTNBYTE))))
    T))

(NSCHAT.DIALOUT
  (LAMBDA (STREAM HOST)                                      (* ejs: "12-Jun-85 18:50")
    (DECLARE (GLOBALVARS CHAT.PHONE.NUMBERS))
    (LET ((RS232CDATA (CADR (CH.RETRIEVE.ITEM HOST (QUOTE RS232CDATA)
					      (QUOTE (GAP . RS232CData)))))
       PHONENUMBER)
      (COND
	((NULL RS232CDATA)
	  (printout PROMPTWINDOW T HOST " does not appear support dialout service" T)
	  (CLOSEF STREAM)
	  (ERROR!))
	(T (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (CSTREAM)
					      (AND RESETSTATE (CLOSEF CSTREAM))))
					  STREAM))
		     (SETQ PHONENUMBER (CHAT.CHOOSE.PHONE.NUMBER))
		     (COND
		       (PHONENUMBER (COURIER.CALL STREAM (QUOTE GAP)
						  (QUOTE Create)
						  (BQUOTE (tty , (LIST (PROGN (COURIER.FETCH
										(GAP . RS232CData)
										charLength of 
										RS232CDATA)
									      (QUOTE seven))
								       (PROGN (COURIER.FETCH
										(GAP . RS232CData)
										parity of RS232CDATA)
									      (QUOTE even))
								       (COURIER.FETCH (GAP . 
										       RS232CData)
										      stopBits of 
										      RS232CDATA)
								       100
								       (COURIER.FETCH (GAP . 
										       RS232CData)
										      flowControl of 
										      RS232CDATA))))
						  (BQUOTE
						    ((rs232c (((dialConn (full asynchronous ,
									       (COURIER.FETCH
										 (GAP . RS232CData)
										 lineSpeed of 
										 RS232CDATA)
									       auto ,
									       (COURIER.FETCH
										 (GAP . RS232CData)
										 dialerNumber of 
										 RS232CDATA)
									       1)))
							      preemptInactive preemptInactive , 
							      PHONENUMBER
							      (reserveNeeded
								(, (COURIER.FETCH (GAP . RS232CData)
										  lineNumber of 
										  RS232CDATA)))))
						     (teletype)))
						  15000
						  (CAR (CH.GETAUTHENTICATOR T))
						  (CADR (CH.GETAUTHENTICATOR T))
						  (QUOTE RETURNERRORS)))
		       (T (ERROR!)))))))))

(NSCHAT.ERRORHANDLER
  (LAMBDA (STREAM ERRCODE)                                   (* ejs: "18-Dec-84 20:43")
    (SELECTQ ERRCODE
	     (EOM (SPP.CLEAREOM STREAM))
	     (ATTENTION (SPP.CLEARATTENTION STREAM)
			(NSCHAT.ATTENTIONFN STREAM (BIN STREAM)))
	     (END (ADD.CHAT.MESSAGE STREAM "[Connection closed by remote host]")
		  -1)
	     (COND
	       ((SPP.OPENP STREAM)                           (* non-fatal error?)
		 (ADD.CHAT.MESSAGE STREAM (CONCAT "[SPP error " ERRCODE "]"))
		 (BIN STREAM))
	       (T (\EOF.ACTION STREAM))))))

(NSCHAT.HOST.FILTER
  (LAMBDA (NAME)                                             (* lmm "15-Jan-85 22:19")

          (* * Return NSCHAT.OPEN if NAME is an NS host with a telnet server.)


    (AND \NSFLG (STRPOS ":" NAME)
	 (SETQ NAME (CH.LOOKUP.OBJECT NAME))
	 (LIST (MKATOM NAME)
	       (FUNCTION NSCHAT.OPEN)))))

(NSCHAT.OPEN
  (LAMBDA (HOST)                                             (* ejs: " 2-Jul-85 13:44")

          (* * Return a pair of SPP streams for a chat connection, or NIL. Add CHAT specific operations to the STREAM via 
	  STREAMPROP.)


    (PROG ((MediumUpEvent (CREATE.EVENT))
	   SERVICE.OPTIONS PORT SERVICE OUTSTREAM STREAM HANDLE FAILURE)
      LP  (SETQ SERVICE.OPTIONS (NSCHAT.SERVICES HOST SERVICE))
          (COND
	    ((NOT (SETQ SERVICE (COND
		      ((EQLENGTH SERVICE.OPTIONS 1)
			(printout PROMPTWINDOW T "Connecting to " (CAAR SERVICE.OPTIONS)
				  " on " HOST T)
			(EVAL (CADAR SERVICE.OPTIONS)))
		      (T (MENU (create MENU
				       ITEMS ← SERVICE.OPTIONS
				       TITLE ← "Specific NS Service?"))))))
	      (COND
		(STREAM (CLOSEF? STREAM)))
	      (RETURN))
	    ((NULL (SETQ PORT (LET ((PORT (LOOKUP.NS.SERVER HOST)))
			           (COND
				     (PORT (replace (NSADDRESS NSSOCKET) of PORT with \NS.WKS.Courier)
					   PORT)))))
	      (SETQ FAILURE "Name not found"))
	    ((NULL (SETQ STREAM (COURIER.OPEN PORT NIL T (QUOTE NSCHAT)
					      NIL
					      (QUOTE (EOM.ON.FORCEOUT T ERRORHANDLER 
								      NSCHAT.ERRORHANDLER ATTENTIONFN 
								      NSCHAT.ATTENTIONFN)))))
                                                             (* No response)
	      )
	    (T (STREAMPROP STREAM (QUOTE MediumUpEvent)
			   MediumUpEvent)
	       (STREAMPROP STREAM (QUOTE EOFPFN)
			   (FUNCTION NSCHAT.EOFPFN))
	       (SPP.DSTYPE STREAM 300)
	       (COND
		 ((NLISTP (SETQ HANDLE (COND
			      ((EQ SERVICE (QUOTE DIALOUT))
				(NSCHAT.DIALOUT STREAM HOST))
			      (T (COURIER.CALL STREAM (QUOTE GAP)
					       (QUOTE Create)
					       (QUOTE (ttyHost (seven even two 100 (none 0 0))))
					       (BQUOTE ((service (, SERVICE))
							(teletype)))
					       15000
					       (CAR (CH.GETAUTHENTICATOR))
					       (CADR (CH.GETAUTHENTICATOR))
					       (QUOTE RETURNERRORS)))))))
		 ((EQ (CAR HANDLE)
		      (QUOTE ERROR))
		   (SETQ FAILURE (SELECTQ (CADR HANDLE)
					  ((REJECT 20)       (* We ought to figure out exactly what error 20 is.
							     Incomplete program declaration)
					    (PRINTOUT PROMPTWINDOW T "Service not supported" T)
					    (GO LP))
					  (SUBSTRING (CDR HANDLE)
						     2 -2))))
		 (T (STREAMPROP STREAM (QUOTE SETDISPLAYTYPE)
				(FUNCTION NILL))
		    (STREAMPROP STREAM (QUOTE LOGINFO)
				(FUNCTION NILL))
		    (STREAMPROP STREAM (QUOTE FLUSH&WAIT)
				(FUNCTION NILL))
		    (STREAMPROP STREAM (QUOTE SENDSCREENPARAMS)
				(FUNCTION NILL))
		    (STREAMPROP STREAM (QUOTE READPEVENT)
				(SPP.INPUT.EVENT STREAM))
		    (SETQ OUTSTREAM (SPPOUTPUTSTREAM STREAM))
		    (AWAIT.EVENT MediumUpEvent 15000)
		    (SPP.SENDATTENTION OUTSTREAM 209)
		    (RETURN (CONS STREAM OUTSTREAM))))))
          (CLOSEF? STREAM)
          (printout PROMPTWINDOW T "Could not chat to " HOST " because: " (OR FAILURE "No Response")))
    ))

(NSCHAT.SERVICES
  (LAMBDA (HOST ALLFLG)                                      (* ejs: "28-Jun-85 23:42")
    (LET* ((PROPERTIES (CADR (CH.LIST.PROPERTIES HOST)))
       (SERVICES (AND (NOT ALLFLG)
		      (APPEND (COND
				((for SERVICE in (CONSTANT (LIST (CH.PROPERTY (QUOTE FILE.SERVICE))
								 (CH.PROPERTY (QUOTE PRINT.SERVICE))
								 (CH.PROPERTY (QUOTE 
									    CLEARINGHOUSE.SERVICE))
								 (CH.PROPERTY (QUOTE 
								   EXTERNAL.COMMUNICATION.SERVICE))
								 (CH.PROPERTY (QUOTE GATEWAY.SERVICE))
								 (CH.PROPERTY (QUOTE 
									 INTERNET.ROUTING.SERVICE))
								 (CH.PROPERTY (QUOTE MAIL.SERVICE))
								 (CH.PROPERTY (QUOTE 
									     REMOTE.BATCH.SERVICE))
								 10024))
				    thereis (FMEMB SERVICE PROPERTIES))
				  (QUOTE (("Remote System Administration" 1 
								  "Connect to a server executive")))))
			      (COND
				((FMEMB (CONSTANT (CH.PROPERTY (QUOTE WORKSTATION)))
					PROPERTIES)
				  (QUOTE (("Remote System Executive" 2 
						"Connect to a remote exec on another workstation")))))
			      (COND
				((FMEMB (CONSTANT (CH.PROPERTY (QUOTE INTERACTIVE.TERMINAL.SERVICE)))
					PROPERTIES)
				  (QUOTE (("Interactive Terminal Service" 3 
							"Connect to a terminal-based mail reader")))))
			      (COND
				((FMEMB (CONSTANT (CH.PROPERTY (QUOTE RS232CDATA)))
					PROPERTIES)
				  (QUOTE (("External Communication Services" (QUOTE DIALOUT)
									     
								  "Connect to a dialout facility")))))
			      ))))
      (COND
	(SERVICES)
	(T (printout PROMPTWINDOW T HOST " does not have any registered NSCHAT services." T 
		     "Please choose a service from the menu."
		     T)
	   (QUOTE (("Remote System Administration" 1 "Connect to a server executive")
		    ("Remote System Executive" 2 "Connect to a remote exec on another workstation")
		    ("Interactive Terminal Service" 3 "Connect to a terminal-based mail reader")
		    ("External Communication Services" (QUOTE DIALOUT)
						       "Connect to a dialout facility"))))))))

(SPP.INPUT.EVENT
  (LAMBDA (STREAM)                                           (* ejs: " 2-Jul-85 13:38")

          (* * Returns the SPPINPUTEVENT of the associated connection for STREAM, if STREAM is open for INPUT)


    (COND
      ((EQ (fetch (STREAM ACCESS) of STREAM)
	   (QUOTE INPUT))
	(fetch (SPPCON SPPINPUTEVENT) of (fetch (SPPSTREAM SPP.CONNECTION) of STREAM)))
      (T (ERROR "FILE NOT OPEN" STREAM)))))
)
(DECLARE: EVAL@COMPILE 

(RPAQQ \NS.WKS.Courier 5)

(CONSTANTS (\NS.WKS.Courier 5))
)

(ADDTOVAR CHAT.PROTOCOLTYPES (NS . NSCHAT.HOST.FILTER))

(RPAQ? NSCHAT.OPTIONS.MENU )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS NSCHAT.OPTIONS.MENU)
)
(PUTPROPS NSCHAT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (8354 17803 (NSCHAT.ATTENTIONFN 8364 . 8733) (NSCHAT.DIALOUT 8735 . 10842) (
NSCHAT.ERRORHANDLER 10844 . 11444) (NSCHAT.HOST.FILTER 11446 . 11803) (NSCHAT.OPEN 11805 . 15100) (
NSCHAT.SERVICES 15102 . 17330) (SPP.INPUT.EVENT 17332 . 17801)))))
STOP