;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.191
;;; Reason:
;;;  Supdup/Telnet now works properly when you specify dotted decimal addresses
;;;  (e.g. 150.0.0.16) for hosts that are not in host table.
;;; Written 22-Jan-88 11:51:53 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.189, Experimental Local-File 73.3, Experimental FILE-Server 22.1, Experimental Unix-Interface 11.0, Experimental Tape 18.0, Experimental KERMIT 34.3, 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; SUPDUP.LISP#314 at 22-Jan-88 11:52:05
#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
		  (setq host (nth-value 1 (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 address)
		protocol
		(or specified-contact contact-name)
		(not (null specified-contact))))
    (error
     (format *terminal-io* "~&Error: ~A~%" lossage)
     (signal eh:abort-object))
     nil))

))