;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.200
;;; Reason:
;;;  When Supdup or Telnet tries to open a connection with TCP or Chaos
;;;  and the connection attempt fails, it tries again with the other
;;;  protocol.  If that also fails, the window would not print an error
;;;  message, but would simply reprompt.  It now prints the error returned
;;;  by the first connection attempt (e.g. "Host xxx not responding" or
;;;  "Remote Host xxx is unreachable")
;;; Written 11-Feb-88 12:01:28 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.199, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 21.1, microcode 1754, SDU Boot Tape 3.12, SDU ROM 8.



; From modified file DJ: L.NETWORK; SUPDUP.LISP#315 at 11-Feb-88 12:01:47
#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
    (do ((save-conn nil))
	(nil)
      (setq conn (condition-case (error)
		     (ecase protocol
		       (:chaos
			(chaos:connect host contact window))
		       (:internet
			(open (format nil "TCP-HOST:~D.~D" host contact) :keyword tv:name :optimistic nil)))
		   (error error)))
      (cond ((not (errorp conn))
	     (send self :set-label label-spec)
	     (send self :set-connection conn)
	     (return conn))
	    ((null save-conn)
	     (setq save-conn conn)
	     (setq protocol (if (eq protocol :chaos) :internet :chaos)))
	    (t
	     (return save-conn))))))

))

; From modified file DJ: L.NETWORK; SUPDUP.LISP#315 at 11-Feb-88 12:16:29
#8R SUPDUP#: 
(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 (address 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
		  (multiple-value-setq (address host)
		    (funcall (ecase protocol
			       (:chaos 'chaos:address-parse)
			       (:internet 'ip:parse-internet-address))
			     path)))
		 ((multiple-value-setq (address host) (ip:parse-internet-address path))
		  (setq protocol :internet))
		 ((multiple-value-setq (address host) (chaos:address-parse path))
		  (setq protocol :chaos))
		 (t
		  (setq host nil))))
	  (si:host
	   (setq host path))
	  (t
	   (error "Invalid host specification")))
	(values (or host			;Known host...
		    (when (eq protocol :internet) path)	;Unknown Internet host specified as dotted decimal...
		    address)			;Chaos address
		protocol
		(or specified-contact contact-name)
		(not (null specified-contact))))
    (error
     (format *terminal-io* "~&Error: ~A~%" lossage)
     (signal eh:abort-object))
     nil))

))