;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.23
;;; Reason:
;;;  Change file-system type and default device properties at site-option time,
;;;   not FS:GET-PATHNAME-HOST time.
;;; Written 6-Feb-87 18:29:18 by RpK (Robert P. Krajewski) at site LMI Cambridge
;;; while running on Cthulhu from band 3
;;; with Experimental System 121.22, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, Experimental Site Data Editor 5.0, Experimental K Bridge Support 1.0, microcode 1733, SDU Boot Tape 3.12, SDU ROM 102, the old ones.



; From modified file DJ: L.IO.FILE; PATHNM.LISP#571 at 6-Feb-87 18:29:19
#8R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; PATHNM  "

(DEFUN GET-PATHNAME-HOST (HOST-NAME &OPTIONAL NO-ERROR-P
			  (UNKNOWN-OK (VARIABLE-BOUNDP CHAOS:MY-ADDRESS)))
  "Parse a host for use in a pathname.
HOST-NAME can be a host object or a host name.
If NO-ERROR-P is non-NIL, we return NIL if given an undefined host name."
  (FLET ((GET-HOST-FROM-LIST (LIST)
	   (IF (MEMQ HOST-NAME LIST)
	       HOST-NAME
	     (LET ((HOST NIL))
	       (DOLIST (X LIST HOST)
		 ;; We prefer an exact match: This is a hack for LMFILE to share LM27 (FC/FS)
		 (WHEN (SEND X :PATHNAME-HOST-NAMEP HOST-NAME)
		   (IF (STRING-EQUAL HOST-NAME (SEND X :NAME-AS-FILE-COMPUTER))
		       (RETURN X)
		     (SETQ HOST X)))))))) ; Non-exact match
    ;; And said MLY unto the Lusers ``Let logical hosts shadow physical hosts.''
    (COND ((GET-HOST-FROM-LIST *LOGICAL-PATHNAME-HOST-LIST*))
	  ((GET-HOST-FROM-LIST *PATHNAME-HOST-LIST*))
	  ;; Don't let SI:PARSE-HOST check for an unknown host here when making SYS.
	  ((LET ((HOST (SI:PARSE-HOST HOST-NAME T UNKNOWN-OK)))
	     (WHEN (AND HOST (SEND HOST :SEND-IF-HANDLES :FILE-HOST-P))
	       (PUSHNEW HOST *PATHNAME-HOST-LIST* :TEST 'EQ)
	       HOST)))
	  (NO-ERROR-P NIL)
	  (T (FERROR 'UNKNOWN-PATHNAME-HOST
		     "~S is not the name of a known file host" HOST-NAME)))))

))

; From modified file DJ: L.NETWORK; HOST.LISP#155 at 6-Feb-87 18:29:47
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; HOST  "

(defmethod (host-tops20-mixin :reset-primary-device) ()
  (setq primary-device "PS"))

))

; From modified file DJ: L.NETWORK; HOST.LISP#155 at 6-Feb-87 18:29:56
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; HOST  "

(defmethod (host-vms-mixin :reset-primary-device) ()
  (remf si:property-list :primary-device))

))

; From modified file DJ: L.IO.FILE; ACCESS.LISP#34 at 6-Feb-87 18:30:26
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; ACCESS  "

(defmethod (file-host-mixin :file-system-type) ()
  (getf si:property-list 'file-system-type (send self :system-type)))

(defmethod (file-host-mixin :set-file-system-type) (type)
  (let ((otype (send self :file-system-type)))
    (setf (getf si:property-list 'file-system-type) type)
    (unless (eq type otype)
      (send-if-handles self :reset-sample-pathname))))

(defmethod (file-host-mixin :reset-file-system-type) ()
  (let ((otype (send self :file-system-type)))
    (remf si:property-list 'file-system-type)
    (unless (eq (send self :system-type) otype)
      (send-if-handles self :reset-sample-pathname))))

))

; From modified file DJ: L.IO.FILE; ACCESS.LISP#34 at 6-Feb-87 18:30:40
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; FILE; ACCESS  "

(defun site-pathname-initialize ()
  ;; Flush all old hosts
  (setq *pathname-host-list* (del-if #'(lambda (x)
					 (send x :send-if-handles :file-host-p))
				     *pathname-host-list*))
  ;;; Handle special frobs:
  ;; Adjust the file system type, maybe.  Usually LispMs to :LMFS
  (let ((fs-frobbed-hosts '())
	(pd-frobbed-hosts '()))
    (dolist (elt (get-site-option :special-file-hosts))
      (let ((fstype (car elt)))
	(dolist (hname (cdr elt))
	  (let ((host (si:parse-host hname t nil)))
	    (when (and host (operation-handled-p host :set-file-system-type))
	      (send host :set-file-system-type fstype)
	      (push host fs-frobbed-hosts))))))
    (dolist (elt (get-site-option :host-default-device-alist))
      (when (cdr elt)
	(let ((host (si:parse-host (car elt) t nil)))
	  (when (and host (operation-handled-p host :set-primary-device))
	    (send host :set-primary-device (cdr elt))
	    (push host pd-frobbed-hosts)))))
    ;; Don't forget to remove the frobbed properties from hosts that
    ;; don't have one anymore.
    (si::do-all-hosts (h)
      (unless (memq h fs-frobbed-hosts)
	(send-if-handles h :reset-file-system-type))
      (unless (memq h pd-frobbed-hosts)
	(send-if-handles h :reset-primary-device))))
  ;; Add LMFILE hosts.
  (add-lmfile-hosts))

(DEFUN ADD-FILE-COMPUTER (HOST)
  "Add HOST to the list of hosts that can act as file servers.
HOST can be either a host name or a list (<host-name> <file-system-type>)."
  (LET ((H (FS:GET-PATHNAME-HOST (IF (CONSP HOST) (CAR HOST) HOST))))
    (IF (CONSP HOST)
	(send-if-handles h :set-file-system-type (CADR HOST))
      ;; needed because this may depend on :special-file-hosts which may change.
      (SEND H :SEND-IF-HANDLES :RESET-SAMPLE-PATHNAME)
      H)))

))