;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.134
;;; Reason:
;;;  Supdup and Telnet windows now work with Chaos or TCP.  Telnet favors TCP, SUPDUP favors Chaos.
;;;  You can connect to (tcp or chaos) "host", (tcp) "host/port", (chaos) "host/contact-name".
;;; Written 2-Dec-87 16:03:42 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.132, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.0, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Site Data Editor 8.4, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:06:58
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-nvt :connected-p) ()
  (and connection
       (etypecase connection
	 (chaos:conn
	  (eq (chaos:state connection) 'chaos:open-state))
	 (tcp:tcp-buffered-stream
	  (not (null (send connection :remote-address)))))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:01
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-nvt :new-connection) (host protocol contact contact-p window
					&aux label-spec conn)
  (multiple-value-setq (host contact label-spec)
    (expand-path tv:name host contact contact-p))
  (when host
    (ecase protocol
      (:chaos
       (setq conn (chaos:connect host contact window)))
      (:internet
       (setq conn (condition-case (error)
		      (tcpa:open-easy-tcp-stream host contact nil :keyword tv:name :optimistic nil)
		    (error error)))))
    (unless (errorp conn)
      (send self :set-label label-spec)
      (send self :set-connection conn))
      conn))

;;; Path may be any of these:
;;; NIL: Use associated machine.
;;; a fixnum: Use the host whose Chaos address is that number.
;;; host-name: Use that host.
;;; host-name/contact-string: Use that chaos host and that contact string.
;;; internet-host-name/number: Use that Internet host and that socket.
;;;  The ARPA-SOCKET and CONNECT-NAME arguments are overriden by the above.
;;;  Socket numbers are in octal.
;;; If this returns NIL, that means an error occured while parsing the path

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:03
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(defun parse-path (path contact-name tcp-port &optional (protocol :chaos))
  (declare (values host protocol contact contact-specified-p))
  (and path
       (symbolp path)
       (setq path (symbol-name path)))
  (condition-case (lossage)
      (let (host specified-contact slash-p number)
	(typecase path
	  (null
	   (setq host si:associated-machine))
	  (integer
	   (or (setq host (si:get-host-from-address path :chaos))
	       (setq host path)))
	  (string
	   (when (setq slash-p (string-search-char #// path))
	     (cond ((setq number (parse-number path (1+ slash-p) nil 10. t))
		    ;; Format is "internet-host-name/number".
		    (setq specified-contact number)
		    (setq protocol :internet))
		   (t
		    ;; Format is "host-name/contact-string".
		    (setq specified-contact (substring path (1+ slash-p)))
		    (setq protocol :chaos)))
	     (setq path (substring path 0 slash-p)))
	   (cond ((setq host (si:parse-host path t nil))	;Known host
		  (unless (send host :network-typep protocol)	;Unknown protocol for this host
		    (if specified-contact	                ;Can't switch protocols...
			(setq host nil)
		      (setq protocol (ecase protocol	        ;Otherwise, check other protocol
				       (:chaos :internet)
				       (:internet :chaos)))
		      (unless (send host :network-typep protocol)
			(setq host nil)))))
		 (specified-contact
		  ;;If contact name or number specified, must find particular format of address
		  (setq host (nth-value 1 (funcall (ecase protocol
						     (:chaos 'chaos:address-parse)
						     (:internet 'ip:parse-internet-address))
						   path))))
		 ((setq host (nth-value 1 (ip:parse-internet-address path)))
		  (setq protocol :internet))
		 ((setq host (nth-value 1 (chaos:address-parse path)))
		  (setq protocol :chaos))
		 (t
		  (setq host nil))))
	  (si:host
	   (setq host path))
	  (t
	   (error "Invalid host specification")))
	(values host
		protocol
		(or specified-contact
		    (ecase protocol
		      (:chaos contact-name)
		      (:internet tcp-port)))
		(not (null specified-contact))))
    (error
     (format *terminal-io* "~&Error: ~A~%" lossage)
     (signal eh:abort-object))
     nil))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:06
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(DEFUN EXPAND-PATH (PROGNAME HOST CONTACT CONTACT-P)
  (DECLARE (VALUES HOST CONTACT LABEL))
  (VALUES HOST
	  CONTACT
	  (FORMAT NIL "~A -- ~A~:[ (~D)~]" PROGNAME HOST (NOT CONTACT-P) CONTACT)))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:07
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-nvt :set-connection) (new-connection)
  (send typein-process :reset)
  (send typeout-process :reset)
  (setq stream (etypecase new-connection
		 (chaos:conn
		  (chaos:make-stream new-connection))
		 (tcp:tcp-buffered-stream
		  new-connection)))
  (send self :gobble-greeting)
;; Typeout process initially waits to see CONNECTION non-NIL.
  (setq connection new-connection)
  (setq black-on-white nil))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:13
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(DEFMETHOD (BASIC-NVT :DISCONNECT) ()
  (SEND TYPEIN-PROCESS ':FLUSH)
  (SEND TYPEOUT-PROCESS ':FLUSH)
  (WHEN CONNECTION
    (when (typep connection 'chaos:conn)
      (CHAOS:CLOSE-CONN CONNECTION)
      (CHAOS:REMOVE-CONN CONNECTION))
    (SETQ CONNECTION NIL)
    (close stream))
  (SEND TYPEIN-PROCESS ':RESET)
  (SEND TYPEOUT-PROCESS ':RESET))

;;;This is the typein process

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:15
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(DEFMETHOD (BASIC-NVT :TYPEIN-TOP-LEVEL) (&OPTIONAL (TOP-LEVEL-P T) &AUX (TERMINAL-IO SELF))
  (DO ((STR NIL NIL)) (NIL)
    (SETQ RETURN-TO-CALLER NIL)
    (SETQ STR ':ABORT)
    (CATCH-ERROR-RESTART-IF TOP-LEVEL-P
			    ((SYS:ABORT ERROR) "Return to command level; optionally disconnect.")
      (SETQ STR
	    (CATCH 'NVT-DONE
	      (COND (CONNECTION
		     (SEND SELF :SET-SUPER-IMAGE-MODE T)
		     (CONDITION-BIND ((SYS:REMOTE-NETWORK-ERROR 'NET-ERROR))
		       (DO ((CH)) (NIL)
			 (OR (SEND SELF :LISTEN)
			     (LOCK-OUTPUT
			       (SEND STREAM :FORCE-OUTPUT)))
			 (SETQ CH (SEND SELF :ANY-TYI))
			 (IF (CONSP CH)
			     (CASE (CAR CH)
			       (:ERROR (THROW 'NVT-DONE (CADR CH)))
			       (:MORE (SEND SELF ':MORE-TYI))
			       (OTHERWISE
				(SEND SELF :NET-OUTPUT-TRANSLATED CH)))
			   (etypecase connection
			     (chaos:conn
			      (SELECTQ (CHAOS:STATE CONNECTION)
				(CHAOS:OPEN-STATE)
				(CHAOS:HOST-DOWN-STATE
				 (THROW 'NVT-DONE "Foreign Host died"))
				(CHAOS:CLS-RECEIVED-STATE
				 (THROW 'NVT-DONE "Closed by foreign host"))
				(CHAOS:LOS-RECEIVED-STATE
				 (THROW 'NVT-DONE "Connection closed due to lossage:"))
				(OTHERWISE
				 (THROW 'NVT-DONE
					(FORMAT NIL "Connection in unknown state:~S"
						(CHAOS:STATE CONNECTION))))))
			     (tcp:tcp-buffered-stream
			      (unless (send stream :remote-address)
				(throw 'nvt-done "Connection closed"))))
			   (IF (= (CHAR-UPCASE CH) ESCAPE-CHAR)
			       ;;Handle the escape character,
			       (SEND SELF ':HANDLE-ESCAPE)
			     ;; otherwise just send through what user typed.
			     (SEND SELF ':NET-OUTPUT-TRANSLATED CH))))))
		    (CONNECT-TO
		     (SEND SELF :CLEAR-WINDOW)
		     (CONDITION-CASE (ERROR)
			 (SEND SELF :CONNECT (PROG1 CONNECT-TO
						    (SETQ CONNECT-TO NIL)))
		       (SYS:REMOTE-NETWORK-ERROR ERROR)))
		    (T (SEND SELF :SET-SUPER-IMAGE-MODE NIL)
		       (LETF (((TV:IO-BUFFER-OUTPUT-FUNCTION TV:IO-BUFFER)
			       'SUPDUP-IO-BUFFER-OUTPUT-FUNCTION))
			 (DO () (())
			   ;; Loop until loser types in something non-blank.
			   (FORMAT T "~&~A.  Type the HELP key for help.~@
				      Connect to host: " PROGRAM-NAME)
			   (LET ((HOST-NAME (STRING-TRIM  '(#/SPACE #/TAB) (READLINE))))
			     (WHEN (PLUSP (STRING-LENGTH HOST-NAME))
			       (RETURN
				 (CONDITION-CASE (ERROR)
				     (SEND SELF :CONNECT HOST-NAME)
				   (SYS:REMOTE-NETWORK-ERROR ERROR))))))))))))
    (COND ((ERRORP STR)
	   (SETQ STR (SEND STR :REPORT-STRING)))
	  ((EQ STR ':ABORT)
	   (SETQ STR (IF (AND CONNECTION (Y-OR-N-P "Disconnect the ~A connection? " program-name))
			 "Connection aborted" NIL))))
    (WHEN (STRINGP STR)
      (SEND SELF :DISCONNECT)
      (FORMAT SELF "~%~A~%" STR)
      (AND RETURN-TO-CALLER (RETURN T)))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:17
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(DEFMETHOD (BASIC-NVT :HELP-MESSAGE)
	   (&AUX (FORMAT-ARGS
		   (LIST "~
~&You are using the ~A remote-login program.
To connect to any Chaosnet or Internet host, just type the target host name.
If you want to connect to an Internet host and specify a particular gateway
host, type the gateway host name, an altmode, and the target host name.
If you want to connect to a specific socket on an Internet host, follow
the name of the Internet host by a slash and the socket number in octal.
If you want to connect to a specific connect-name on a Chaosnet host,
follow the name of the Chaosnet host by a slash and the connect name.

Summary:
  host      (for either network)
  chaos-host//connect-name
  internet-host//socket-number (octal)

At any time you can type the [Network] key to give any of a number of useful
commands.  For descriptions of the available commands, type [Network] [Help].

Connect to host: "
			 PROGRAM-NAME)))
  (COND ((NULL CONNECTION)
	 (SEND *STANDARD-OUTPUT* :CLEAR-WINDOW)
	 (APPLY #'FORMAT T FORMAT-ARGS))
	(T
	 (SI:WITH-HELP-STREAM (HELP-STREAM :LABEL "Keyboard system commands")
	   (APPLY #'FORMAT HELP-STREAM FORMAT-ARGS)))))

;;;Condition handler for typein side.

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:22
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(DEFMETHOD (BASIC-SUPDUP :CONNECT) (&OPTIONAL PATH (NET-WINDOW 3))
  (MULTIPLE-VALUE-BIND (HOST protocol CONTACT CONTACT-P)
      (PARSE-PATH PATH "SUPDUP" 95. :chaos)
    ;; If the host runs the WAITS operating system, it will require char i/d.
    (LET ((SUPDUP-%TOCID (COND ((TYPEP HOST 'SI:HOST) (MEMQ (SEND HOST ':SYSTEM-TYPE)
							    '(:MULTICS :WAITS)))
			       ((STRINGP HOST) 		;No host name server.  flush this when
				(MEM 'EQUALP HOST '("SAIL" "S1-A")))  ;above thing wins.
			       (T SUPDUP-%TOCID))))
      (SEND SELF :NEW-CONNECTION HOST protocol CONTACT CONTACT-P NET-WINDOW))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:24
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(DEFMETHOD (BASIC-TELNET :CONNECT) (&OPTIONAL PATH (NET-WINDOW 3) &AUX CONN)
  (MULTIPLE-VALUE-BIND (HOST protocol CONTACT CONTACT-P)
      (PARSE-PATH PATH "TELNET" 23. :internet)
    (SETQ CONN (SEND SELF :NEW-CONNECTION HOST protocol CONTACT CONTACT-P NET-WINDOW)))
  (IF (ERRORP CONN)
      ;; Lose, return "error code".
      CONN
      ;; Win, request remote echoing.
      (TELNET-ECHO T)))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#295 at 2-Dec-87 16:07:25
#8R SUPDUP#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "


(defmethod (basic-telnet :send-ip) ()
  ;; Send a New Telnet "Interrupt Process".
  (lock-output
    (send stream :force-output)
    (send stream :set-urgent-output t)
    (send stream :tyo nvt-iac)
    (send stream :tyo nvt-ip)
    (send stream :tyo nvt-iac)
    (send stream :tyo nvt-dm)
    (send stream :force-output)
    (send stream :set-urgent-output nil)))

))


;;;Must reset windows as the toplevel-function has changed
(dolist (x supdup:telnet-windows)
  (send (symeval-in-instance x 'supdup:typein-process) :reset))

(dolist (x supdup:supdup-windows)
  (send (symeval-in-instance x 'supdup:typein-process) :reset))