;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.104
;;; Reason:
;;;  Changes to EASY interface:
;;;    - :string-for-printing always prints in decimal
;;;    - Make "tcphost:name.domain.remote-port#local-port" work properly
;;; Written 6-Nov-87 15:30:56 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.103, Experimental Local-File 73.0, Experimental FILE-Server 22.0, 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; EASY.LISP#23 at 6-Nov-87 15:32:33
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; EASY  "

(defmethod (tcp-host-pathname :string-for-printing) ()
  (format nil "~A: ~D remote ~D local ~D"
	  (send (send self :host) :name)
	  (send self :name)
	  (send self :type)
	  (send self :version)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; EASY.LISP#23 at 6-Nov-87 15:33:36
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; EASY  "

(defmethod (udp-host-pathname :string-for-printing) ()
  (format nil "~A: ~D remote ~D local ~D"
	  (send (send self :host) :name)
	  (send self :name)
	  (send self :type)
	  (send self :version)))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; EASY.LISP#23 at 6-Nov-87 17:43:42
#10R TCP-APPLICATION#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; EASY  "

(defun tcp-host-parse-namestring (namestring &optional (start 0) (end (length namestring)))
  (flet ((skip-dotted-fields (string count test start end &aux (dot start) last-dot)
	   (loop
	     (when (null dot) (return nil))
	     (and count (zerop count) (return dot))
	     (unless (funcall test (char string (1+ dot)))
	       (return dot))
	     (when count (decf count))
	     (setq last-dot dot)
	     (setq dot (string-search "." string (1+ dot) end))
	     (and (null dot) (null count) (return last-dot)))))
    (let ((remote-address :wild)
	  (remote-port nil)
	  (local-port nil)
	  (remote-port-start nil)
	  (local-port-start nil)
	  temp)
      (unless (= start end)
	(let ((first (char namestring start))
	      (dot (string-search "." namestring start end))
	      (pound (string-search "#" namestring start end))
	      (name-end nil)
	      (remote-port-end nil)
	      (local-port-end nil))
	  (when (and dot (alphanumericp first))
	    (if (digit-char-p first)		;skip dotted decimal address
		(setq dot (skip-dotted-fields namestring 3 #'digit-char-p dot (or pound end)))
	      (setq dot (skip-dotted-fields namestring nil #'alpha-char-p dot (or pound end)))))
	  (setq name-end (or dot pound end))
	  (setq remote-address (substring namestring start name-end))
	  (when (and pound dot)
	    (setq local-port-start (1+ pound))
	    (setq local-port-end end)
	    (setq local-port (substring namestring local-port-start local-port-end)))
	  (setq remote-port-start (cond (dot (1+ dot))
					(pound (1+ pound))))
	  (when remote-port-start
	    (setq remote-port-end (if local-port-start pound end))
	    (setq remote-port (substring namestring remote-port-start remote-port-end)))))
      (cond ((null remote-port))
	    ((setq temp (global:parse-number remote-port))
	     (setq remote-port temp))
	    ((and (setq temp (global:intern-soft (string-append "IPPORT-" (string-upcase remote-port))
						 "TCP-APPLICATION"))
		  (sym-boundp temp))
	     (setq remote-port (sym-value temp)))
	    (t
	     (global:ferror :parse-pathname-error
			    "Bad REMOTE-PORT specification \"~A\" in: ~S"
			    remote-port
			    namestring)))
      (cond ((null local-port))
	    ((setq temp (global:parse-number local-port))
	     (setq local-port temp))
	    ((and (setq temp (global:intern-soft (string-append "IPPORT-" (string-upcase local-port))
						 "TCP-APPLICATION"))
		  (sym-boundp temp))
	     (setq local-port (sym-value temp)))
	    (t
	     (global:ferror :parse-pathname-error
			    "Bad LOCAL-PORT specification \"~A\" in: ~S"
			    local-port
			    namestring)))
      (values :unspecific
	      :unspecific
	      (or remote-address :wild)		;name == remote address
	      (or remote-port :wild)		;type == remote port
	      (or local-port :wild)))))		;version == local port

))