;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.75
;;; Reason:
;;;  si:set-sys-host now allows you to specify an Internet address as a string, rather than
;;;  assuming the address is a Chaos address.  si:new-host-validation-function is no
;;;  longer a variable to funcall, but has properties :chaos and :internet which are functions.
;;; Written 26-Oct-87 15:31:57 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.74, 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; IP.LISP#270 at 26-Oct-87 15:31:58
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(defun new-host-validation-function (host system-type address)
  (let ((parsed-address (parse-internet-address address)))
    (cond ((stringp host)
	   ;;Try an ICMP Echo 6 times -- allow for ARP failures, lost packets, etc...
	   (do ((tries 0 (1+ tries)))
	       ((= tries 6)
		(error "No response from address ~A" (canonical-ip parsed-address)))
	     (when (icmp:ping parsed-address)
	       (return)))
	   (si:define-host host :host-names `(,host)
				:system-type system-type
				:internet `(,parsed-address))
	   (setq host (si:parse-host host))
	   (when (member parsed-address (ip-addresses *ip-stream*))
	     (setq si:local-host host))
	   host)
	  (t
	   (when address
	     (unless (member parsed-address (send host :internet-addresses))
	       (error "~A is not a valid Internet address for ~A" address host)))
	   host))))

))

; From modified file DJ: L.NETWORK.IP-TCP.KERNEL; IP.LISP#270 at 26-Oct-87 15:33:14
#10R INTERNET#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "INTERNET")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; KERNEL; IP  "

(setf (get 'si:new-host-validation-function :internet) 'ip:new-host-validation-function)

))

; From modified file DJ: L.NETWORK.CHAOS; CHUSE.LISP#32 at 26-Oct-87 15:34:44
#10R CHAOS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "CHAOS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; CHAOS; CHUSE  "

(setf (get 'si:new-host-validation-function :chaos) 'chaos:new-host-validation-function)

))

(makunbound 'si:new-host-validation-function)
; From modified file DJ: L.SYS; QMISC.LISP#729 at 26-Oct-87 16:03:54
#8R SYSTEM-INTERNALS#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QMISC  "

(DEFUN SET-SYS-HOST (HOST-NAME &OPTIONAL OPERATING-SYSTEM-TYPE HOST-ADDRESS SITE-FILE-DIRECTORY
		     &AUX HOST-OBJECT)
  "Specify the host to read system files from.
You can specify the operating system type (a keyword), host address, and the directory
for finding the site files, in case the system does not know that host yet."
  (CHECK-TYPE HOST-NAME (OR STRING HOST) "a host name")
  ;; DWIM the operating system type for those who insist...
  (when (and operating-system-type
	     (typep operating-system-type '(or string (and symbol (not keyword)))))
    (setq operating-system-type
	  (intern (string-upcase (string-trim " " (string operating-system-type)))
		  'keyword)))
  (CHECK-ARG OPERATING-SYSTEM-TYPE (OR (NULL OPERATING-SYSTEM-TYPE)
				       (GET OPERATING-SYSTEM-TYPE 'SYSTEM-TYPE-FLAVOR))
	     "an operating system type")
  (AND (SETQ HOST-OBJECT (OR (FS:GET-PATHNAME-HOST HOST-NAME T NIL)
			     (si:PARSE-HOST HOST-NAME T NIL)))
       OPERATING-SYSTEM-TYPE
       (NEQ OPERATING-SYSTEM-TYPE (SEND HOST-OBJECT :SYSTEM-TYPE))
       (FERROR "~A is ~A, not ~A." HOST-OBJECT
	       (SEND HOST-OBJECT :SYSTEM-TYPE) OPERATING-SYSTEM-TYPE))
  (cond ((null host-address)
	 (unless host-object
	   (error "No address specified, but unknown host")))
	((stringp host-address)
	 (setq host-object (funcall (get 'si:new-host-validation-function :internet)
				    (or host-object host-name) operating-system-type host-address)))
	((numberp host-address)
	 (setq host-object (funcall (get 'si:new-host-validation-function :chaos)
				    (or host-object host-name) operating-system-type host-address)))
	(t
	 (error "Unrecognizable address ~A" host-address)))
  ;; FS:MAKE-LOGICAL-PATHNAME-HOST property T lets this host be redefined.
  (send (fs:set-logical-pathname-host "SYS" :physical-host host-object :translations
				      (if site-file-directory
					  `(("SITE" ,site-file-directory) ("CHAOS" ,site-file-directory))
					'()))
	:set :get 'fs:make-logical-pathname-host t)
  T)

))

;;;Forget about old usage -- no longer funcalled directly
(makunbound 'si:new-host-validation-function)