;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.148
;;; Reason:
;;;  Telnet builds its open strings using decimal numbers, since that is what
;;;  open-easy-tcp-stream wants.
;;; Written 7-Dec-87 14:27:24 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.144, 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, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; PORTS.LISP#3 at 7-Dec-87 14:27:24
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; PORTS  "

(defsym ipport-supdup           95)

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#304 at 7-Dec-87 14:28:42
#8R SUPDUP#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SUPDUP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; SUPDUP  "

(defun parse-path (path contact-name &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)))
		    (unless (eq protocol :chaos)
		      (let* ((upper (string-upcase specified-contact))
			     (temp (intern-soft (string-append "IPPORT-" upper) "TCP-APPLICATION")))
			(if (tcpa:sym-boundp temp)
			    (setq specified-contact upper)	;If known TCP port, make it upper case
			  (setq protocol :chaos))))))	        ;If unknown TCP port name, force 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 contact-name)
		(not (null specified-contact))))
    (error
     (format *terminal-io* "~&Error: ~A~%" lossage)
     (signal eh:abort-object))
     nil))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#304 at 7-Dec-87 14:28:53
#8R SUPDUP#: #!:ZL
(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" :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#304 at 7-Dec-87 14:29:14
#8R SUPDUP#: #!:ZL
(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" :internet)
    (when (setq conn (send self :new-connection host protocol contact contact-p net-window))
      (unless (errorp conn)
	(telnet-echo t)
	(telnet-send-option nvt-do nvt-suppress-go-ahead)
	(setq overprint nil))
      conn)))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#304 at 7-Dec-87 14:29:45
#8R SUPDUP#: #!:ZL
(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)
		      (open (format nil "TCP-HOST:~D.~D" host contact) :keyword tv:name :optimistic nil)
		    (error error)))))
    (unless (errorp conn)
      (send self :set-label label-spec)
      (send self :set-connection conn))
      conn))

))