;;; -*- Mode: LISP; Package: FILE-SYSTEM -*-
;;;  ** (c) Copyright 1980 Massachusetts Institute of Technology
;;;     Enhancements (c) Copyright 1981 Symbolics, Inc.
;;;     The Massachusetts Institute of Technology has acquired the rights from
;;;     Symbolics to include the Enhancements covered by the foregoing notice
;;;     of copyright with its licenses of the Lisp Machine System. **

;;; Some remaining crocks:
;;; Why not just get an error in DATA-CONNECTION rather than having to know number foreign
;;; host supports?

(DEFCONST %FILE-CHARACTER-OPCODE CHAOS:DAT-OP)
(DEFCONST %FILE-BINARY-OPCODE (LOGIOR CHAOS:DAT-OP 100))
(DEFCONST %FILE-COMMAND-OPCODE CHAOS:DAT-OP)
(DEFCONST %FILE-SYNCHRONOUS-MARK-OPCODE (1+ CHAOS:DAT-OP))
(DEFCONST %FILE-ASYNCHRONOUS-MARK-OPCODE (+ CHAOS:DAT-OP 2))
(DEFCONST %FILE-NOTIFICATION-OPCODE (+ CHAOS:DAT-OP 3))
(DEFCONST %FILE-EOF-OPCODE CHAOS:EOF-OP)

;;; A file server host.  In the HOST slot of a pathname.
(DEFFLAVOR FILE-HOST-MIXIN
	((HOST-UNITS NIL))			;List of active HOST-UNIT's
	()
  (:REQUIRED-METHODS :MAX-DATA-CONNECTIONS :HSNAME-INFORMATION)
  (:GETTABLE-INSTANCE-VARIABLES HOST-UNITS)
  (:INCLUDED-FLAVORS CHAOS:HOST-CHAOS-MIXIN))

;;; One HOST-UNIT is associated with each control connection
(DEFFLAVOR HOST-UNIT
	(HOST					;Host object
	 (CONTROL-CONNECTION NIL)		;Control connection for this host
	 (DATA-CONNECTIONS NIL)			;List of DATA-CONNECTION's
	 MAX-DATA-CONNECTIONS			;Maximum number of data connections
	 (LOCK NIL)				;Lock to insure no timing screws
	 )
	()
  :ORDERED-INSTANCE-VARIABLES
  :OUTSIDE-ACCESSIBLE-INSTANCE-VARIABLES
  (:INITABLE-INSTANCE-VARIABLES HOST))

;;; A DATA-CONNECTION is associated with each data connection.
;;; The two directions in the connection itself are used independently.
(DEFSTRUCT (DATA-CONNECTION :LIST*
			    (:CONC-NAME DATA-)
			    (:CONSTRUCTOR MAKE-DATA-CONNECTION
					  (CONNECTION INPUT-HANDLE OUTPUT-HANDLE)))
  CONNECTION					;The chaos connection
  INPUT-HANDLE
  OUTPUT-HANDLE
  (STREAM-LIST (LIST ':INPUT NIL ':OUTPUT NIL))
  )

(DEFSUBST DATA-HANDLE (DATA-CONNECTION DIRECTION)
  (SELECTQ DIRECTION
    (:INPUT (DATA-INPUT-HANDLE DATA-CONNECTION))
    (:OUTPUT (DATA-OUTPUT-HANDLE DATA-CONNECTION))))

(DEFSUBST DATA-STREAM (DATA-CONNECTION DIRECTION)
  (CADR (MEMQ DIRECTION (DATA-STREAM-LIST DATA-CONNECTION))))

(DEFMETHOD (HOST-UNIT :INIT) (IGNORE)
  (SETQ MAX-DATA-CONNECTIONS (FUNCALL HOST ':MAX-DATA-CONNECTIONS)))

;;; Lock a host unit around BODY
(DEFMACRO LOCK-HOST-UNIT ((HOST-UNIT) &BODY BODY)
  (LET ((LOCK (GENSYM)) (LOCKED-P (GENSYM)))
    `(LET ((,LOCK (LOCF (HOST-UNIT-LOCK ,HOST-UNIT)))
	   (,LOCKED-P NIL))
       (UNWIND-PROTECT
	 (PROGN
	   (COND ((NEQ (CAR ,LOCK) CURRENT-PROCESS)
		  (PROCESS-LOCK ,LOCK)
		  (SETQ ,LOCKED-P T)))
	   . ,BODY)
	 (AND ,LOCKED-P (PROCESS-UNLOCK ,LOCK))))))

;;; Sent when booting, forget all active connections, reset all HOST-UNIT's.
(DEFMETHOD (FILE-HOST-MIXIN :RESET) ()
  (DOLIST (UNIT HOST-UNITS)
    (FUNCALL UNIT ':RESET)))

(DEFMETHOD (HOST-UNIT :RESET) (&OPTIONAL DONT-UNLOCK-LOCK-P)
  (COND (CONTROL-CONNECTION
	 (CHAOS:REMOVE-CONN CONTROL-CONNECTION)
	 (SETQ CONTROL-CONNECTION NIL)))
  (DO ((DATA-CONNS DATA-CONNECTIONS (CDR DATA-CONNS))
       (DATA-CONN))
      ((NULL DATA-CONNS)
       (SETQ DATA-CONNECTIONS NIL))
    (SETQ DATA-CONN (CAR DATA-CONNS))
    (DO ((LIST (DATA-STREAM-LIST DATA-CONN) (CDDR LIST))
	 (STREAM))
	((NULL LIST))
      (AND (NOT (SYMBOLP (SETQ STREAM (CADR LIST))))
	   (FUNCALL STREAM ':SET-STATUS ':CLOSED)))
    (CHAOS:REMOVE-CONN (DATA-CONNECTION DATA-CONN)))
  (OR DONT-UNLOCK-LOCK-P (SETQ LOCK NIL)))

;;; This also frees up any slots marked as open
(DEFMETHOD (FILE-HOST-MIXIN :CLOSE-ALL-FILES) (&AUX THINGS-CLOSED)
  (DOLIST (UNIT HOST-UNITS) 
    (DOLIST (DATA-CONN (HOST-UNIT-DATA-CONNECTIONS UNIT))
      (DO LIST (DATA-STREAM-LIST DATA-CONN) (CDDR LIST) (NULL LIST)
	(LET ((STREAM (CADR LIST)))
	  (COND ((NULL STREAM))
		((EQ STREAM T)
		 (SETF (CADR LIST) NIL))
		(T
		 (FORMAT ERROR-OUTPUT "~%Closing ~S" STREAM)
		 (PUSH STREAM THINGS-CLOSED)
		 (FUNCALL STREAM ':CLOSE ':ABORT)))))))
  THINGS-CLOSED)

(DEFMETHOD (FILE-HOST-MIXIN :OPEN-STREAMS) (&AUX STREAMS)
  (DOLIST (UNIT HOST-UNITS) 
    (DOLIST (DATA-CONN (HOST-UNIT-DATA-CONNECTIONS UNIT))
      (DO LIST (DATA-STREAM-LIST DATA-CONN) (CDDR LIST) (NULL LIST)
	(LET ((STREAM (CADR LIST)))
	  (OR (SYMBOLP STREAM)
	      (PUSH STREAM STREAMS))))))
  STREAMS)

;;; Number is the protocol version number
(DEFCONST *FILE-CONTACT-NAME* "FILE 1")
(DEFCONST *FILE-CONTROL-WINDOW-SIZE* 5)

;;; Check that connection hasn't gone away, making a new one if necessary
(DEFMETHOD (HOST-UNIT :VALIDATE-CONTROL-CONNECTION) (&OPTIONAL NO-ERROR-P)
  (LOCK-HOST-UNIT (SELF)
    (COND ((AND CONTROL-CONNECTION
		(EQ (CHAOS:STATE CONTROL-CONNECTION) 'CHAOS:OPEN-STATE)
		(LOOP FOR DATA-CONN IN DATA-CONNECTIONS
		      ALWAYS (EQ (CHAOS:STATE (DATA-CONNECTION DATA-CONN))
				 'CHAOS:OPEN-STATE)))
	   T)
	  (T
	   (FUNCALL-SELF ':RESET T)	;Arg of T means don't unlock lock
	   (LET ((CONN (CHAOS:CONNECT HOST *FILE-CONTACT-NAME* *FILE-CONTROL-WINDOW-SIZE*)))
	     (COND ((NOT (STRINGP CONN))
		    (SETF (CHAOS:INTERRUPT-FUNCTION CONN) (LET-CLOSED ((HOST-UNIT SELF))
							    'HOST-CHAOS-INTERRUPT-FUNCTION))
		    (SETQ CONTROL-CONNECTION CONN)
		    (FUNCALL HOST ':LOGIN-UNIT SELF T)
		    T)
		   (T
		    (OR NO-ERROR-P (FERROR NIL "Cannot connect to ~A: ~A" HOST CONN))
		    NIL)))))))
;;; Transaction management
(DEFSTRUCT (FILE-TRANSACTION-ID :LIST :CONC-NAME
				(:CONSTRUCTOR MAKE-FILE-TRANSACTION-ID-INTERNAL
					      (ID SIMPLE-P)))
  ID
  SIMPLE-P
  (PKT NIL))

(DEFVAR *FILE-UNIQUE-NUMBER* 259.)
(DEFVAR *FILE-PENDING-TRANSACTIONS* NIL)

(DEFUN FILE-GENSYM (LEADER)
  (WITHOUT-INTERRUPTS
    (FORMAT NIL "~A~4,'0D" LEADER (SETQ *FILE-UNIQUE-NUMBER*
					(\ (1+ *FILE-UNIQUE-NUMBER*) 10000.)))))

(DEFUN FILE-MAKE-TRANSACTION-ID (&OPTIONAL (SIMPLE-P NIL) &AUX ID)
  (WITHOUT-INTERRUPTS
    (SETQ ID (FILE-GENSYM "T"))
    (PUSH (MAKE-FILE-TRANSACTION-ID-INTERNAL ID SIMPLE-P) *FILE-PENDING-TRANSACTIONS*))
  ID)

;;; Wait for a transaction to complete.  Should not be called if the transaction is simple.
(DEFUN FILE-WAIT-FOR-TRANSACTION (TID &OPTIONAL CONN (WHOSTATE "File Transaction") &AUX ID)
  (IF (NULL (SETQ ID (ASSOC TID *FILE-PENDING-TRANSACTIONS*)))
      (FERROR NIL "Transaction ID ~A not found on pending list" TID)
      (PROCESS-WAIT WHOSTATE #'(LAMBDA (ID CONN)
				 (OR (FILE-TRANSACTION-ID-PKT ID)
				     (NEQ (CHAOS:STATE CONN) 'CHAOS:OPEN-STATE)))
		    ID CONN)
      (COND ((NEQ (CHAOS:STATE CONN) 'CHAOS:OPEN-STATE)
	     (FERROR NIL
		     "Connection ~S went into illegal state while waiting for a transaction"
		     CONN))
	    (T
	     (WITHOUT-INTERRUPTS
	       (SETQ *FILE-PENDING-TRANSACTIONS* (DELQ ID *FILE-PENDING-TRANSACTIONS*))
	       (FILE-TRANSACTION-ID-PKT ID))))))

(DEFUN HOST-CHAOS-INTERRUPT-FUNCTION (REASON CONN &REST IGNORE)
  (DECLARE (SPECIAL HOST-UNIT))
  (SELECTQ REASON
    (:INPUT
     (DO ((PKT (CHAOS:GET-NEXT-PKT CONN T)
	       (CHAOS:GET-NEXT-PKT CONN T))
	  (STRING) (TEM))
	 ((NULL PKT))
       (SETQ STRING (CHAOS:PKT-STRING PKT))
       (SELECT (CHAOS:PKT-OPCODE PKT)
	 (%FILE-ASYNCHRONOUS-MARK-OPCODE
	  (SETQ STRING (NSUBSTRING STRING
				   (1+ (STRING-SEARCH-CHAR #\SP (CHAOS:PKT-STRING PKT)))))
	  (DO ((DATA-CONNS (HOST-UNIT-DATA-CONNECTIONS HOST-UNIT) (CDR DATA-CONNS))
	       (HANDLE-LEN (OR (STRING-SEARCH-CHAR #\SP STRING)
			       (STRING-LENGTH STRING)))
	       (STREAM))
	      ((NULL DATA-CONNS) (CHAOS:RETURN-PKT PKT))
	    (COND ((STRING-EQUAL STRING (DATA-HANDLE (CAR DATA-CONNS) ':OUTPUT) 0 0
				 HANDLE-LEN)
		   (SETQ STREAM (DATA-STREAM (CAR DATA-CONNS) ':OUTPUT))
		   (FUNCALL STREAM ':ASYNC-MARK PKT)
		   (RETURN NIL)))))
	 (%FILE-COMMAND-OPCODE
	  (SETQ STRING (SUBSTRING STRING 0 (STRING-SEARCH-CHAR #\SP STRING)))
	  (SETQ TEM (ASSOC STRING *FILE-PENDING-TRANSACTIONS*))
	  (RETURN-ARRAY (PROG1 STRING (SETQ STRING NIL)))	;Don't cons
	  (COND ((NULL TEM)
		 (PROCESS-RUN-FUNCTION
		   "File system fucked"
		   #'(LAMBDA (PKT)
		       (UNWIND-PROTECT
			 (FERROR NIL "File system fucked, unknown transaction id in ~S"
				 (CHAOS:PKT-STRING PKT))
			 (CHAOS:RETURN-PKT PKT)))
		   PKT))
		((FILE-TRANSACTION-ID-SIMPLE-P TEM)
		 ;;If simple transaction, make sure no error
		 (LET ((STRING (NSUBSTRING (CHAOS:PKT-STRING PKT)
					   (1+ (STRING-SEARCH-CHAR #\SP
								   (CHAOS:PKT-STRING PKT)))))
		       (FROM))
		   (SETQ FROM (1+ (STRING-SEARCH-SET '(#\SP #\CR) STRING)))
		   ;; If simple transaction fails, barf in another process
		   (OR (NOT (STRING-EQUAL "ERROR" STRING 0 FROM 5
					  (STRING-SEARCH-SET '(#\SP #\CR) STRING FROM)))
		       (PROCESS-RUN-FUNCTION "File System Barf"
					     #'FILE-PROCESS-ERROR
					     (PROG1 (STRING-APPEND STRING)
						    (CHAOS:RETURN-PKT PKT))
					     NIL NIL)))
		 (SETQ *FILE-PENDING-TRANSACTIONS* (DELQ TEM *FILE-PENDING-TRANSACTIONS*)))
		(T (SETF (FILE-TRANSACTION-ID-PKT TEM) PKT))))
	 (%FILE-NOTIFICATION-OPCODE
	  (TV:NOTIFY NIL "File server ~A: ~A" (HOST-UNIT-HOST HOST-UNIT) STRING)
	  (CHAOS:RETURN-PKT PKT))
	 (OTHERWISE (CHAOS:RETURN-PKT PKT)))))))

(DEFMETHOD (FILE-HOST-MIXIN :NEW-HOST-UNIT) (&AUX UNIT)
  (SETQ UNIT (MAKE-INSTANCE 'HOST-UNIT ':HOST SELF))
  (SETQ HOST-UNITS (NCONC HOST-UNITS (NCONS UNIT)))
  (FUNCALL UNIT ':VALIDATE-CONTROL-CONNECTION)
  UNIT)

;;; Return a valid host unit.  If no units, make one.  If any unit is still open, use it.
;;; Errors if fails to connect.
(DEFMETHOD (FILE-HOST-MIXIN :GET-HOST-UNIT) ()
  (COND ((NULL HOST-UNITS)
	 (FUNCALL-SELF ':NEW-HOST-UNIT))
	((LOOP FOR UNIT IN HOST-UNITS
	       WHEN (FUNCALL UNIT ':VALIDATE-CONTROL-CONNECTION T)
	       RETURN UNIT))
	(T
	 (LET ((UNIT (CAR HOST-UNITS)))
	   (FUNCALL UNIT ':VALIDATE-CONTROL-CONNECTION)
	   UNIT))))

;;; Get a DATA-CONNECTION for use in DIRECTION.
;;; Make two passes over existing units, first trying open ones.
(DEFMETHOD (FILE-HOST-MIXIN :GET-DATA-CONNECTION) (DIRECTION)
  (DO-NAMED TOP ((ERROR-P NIL T)) (NIL)
    (DO ((UNITS HOST-UNITS (CDR UNITS))
	 (UNIT) (DATA-CONN))
	((NULL UNITS))
      (SETQ UNIT (CAR UNITS))
      (AND (FUNCALL UNIT ':VALIDATE-CONTROL-CONNECTION (NOT ERROR-P))
	   (SETQ DATA-CONN (FUNCALL UNIT ':GET-DATA-CONNECTION DIRECTION))
	   (RETURN-FROM TOP DATA-CONN UNIT)))
    (AND ERROR-P
	 (LET* ((UNIT (FUNCALL-SELF ':NEW-HOST-UNIT))
		(DATA-CONN (FUNCALL UNIT ':GET-DATA-CONNECTION DIRECTION)))
	   (OR DATA-CONN (FERROR NIL "New unit failed to allocate data connection"))
	   (RETURN-FROM TOP DATA-CONN UNIT)))))

;;; Get a data connection for this unit.  Makes a new one if there is room in within the
;;; maximum number.  We are assumed to have recently been checked for validity.
(DEFMETHOD (HOST-UNIT :GET-DATA-CONNECTION) (DIRECTION)
  (LOCK-HOST-UNIT (SELF)
    (DO ((DATA-CONNS DATA-CONNECTIONS (CDR DATA-CONNS))
	 (DATA-CONN))
	(NIL)
      (SETQ DATA-CONN (COND (DATA-CONNS (CAR DATA-CONNS))
			    ((= (LENGTH DATA-CONNECTIONS) MAX-DATA-CONNECTIONS)
			     (RETURN NIL))
			    (T (FUNCALL-SELF ':NEW-DATA-CONNECTION))))
      (COND ((NULL (DATA-STREAM DATA-CONN DIRECTION))
	     (SETF (DATA-STREAM DATA-CONN DIRECTION) T)	;Mark as allocated
	     (RETURN DATA-CONN))))))

;;; Called when done with a DATA-CONNECTION for DIRECTION.
(DEFMETHOD (HOST-UNIT :FREE-DATA-CONNECTION) (DATA-CONNECTION DIRECTION)
  (SETF (DATA-STREAM DATA-CONNECTION DIRECTION) NIL)
  (LOCK-HOST-UNIT (SELF)
    (COND ((AND (NULL (DATA-STREAM DATA-CONNECTION ':INPUT))
		(NULL (DATA-STREAM DATA-CONNECTION ':OUTPUT))
		( (LENGTH DATA-CONNECTIONS) 1))
	   (FUNCALL-SELF ':COMMAND NIL (DATA-HANDLE DATA-CONNECTION ':INPUT) NIL
			 "UNDATA-CONNECTION")
	   (LET ((CONN (DATA-CONNECTION DATA-CONNECTION)))
	     (CHAOS:CLOSE CONN "Done")
	     (CHAOS:REMOVE-CONN CONN))
	   (SETQ DATA-CONNECTIONS (DELQ DATA-CONNECTION DATA-CONNECTIONS))))))

(DEFVAR *FILE-DATA-WINDOW-SIZE* 15)

;;; Allocate a new data connection
(DEFMETHOD (HOST-UNIT :NEW-DATA-CONNECTION) ()
  (LET ((INPUT-HANDLE (FILE-GENSYM "I"))
	(OUTPUT-HANDLE (FILE-GENSYM "O"))
	(PKT (CHAOS:GET-PKT))
	(ID (FILE-MAKE-TRANSACTION-ID))
	(DATA-CONN)
	(CONNECTION))
    (CHAOS:SET-PKT-STRING PKT ID "  DATA-CONNECTION " INPUT-HANDLE " " OUTPUT-HANDLE)
    (CHAOS:SEND-PKT CONTROL-CONNECTION PKT)
    (SETQ CONNECTION
	  (CHAOS:LISTEN OUTPUT-HANDLE *FILE-DATA-WINDOW-SIZE* NIL))
    (OR (CHAOS:WAIT CONNECTION 'CHAOS:LISTENING-STATE (* 60. 30.))
	;; Attempt to establish connection timed out -- give reasonable error
	(FERROR NIL "Attempt to establish chaos connection timed out."))
    (CHAOS:ACCEPT CONNECTION)
    (SETQ PKT (FILE-WAIT-FOR-TRANSACTION ID CONTROL-CONNECTION "New Data Conn"))
    (UNWIND-PROTECT
      (LET ((STRING (CHAOS:PKT-STRING PKT)))
	(SETQ STRING (NSUBSTRING STRING (1+ (STRING-SEARCH-CHAR #\SP STRING))))
	(COND ((FILE-CHECK-COMMAND "DATA-CONNECTION" STRING T)
	       (SETQ DATA-CONN (MAKE-DATA-CONNECTION CONNECTION INPUT-HANDLE OUTPUT-HANDLE))
	       (PUSH DATA-CONN DATA-CONNECTIONS))
	      (T (FILE-PROCESS-ERROR STRING NIL NIL))))	;not proceedable
      (CHAOS:RETURN-PKT PKT))
    DATA-CONN))

;;; Send a command over the control connection.
;;; MARK-P means writing or reading (expecting) a synchronous mark.
;;; STREAM-OR-HANDLE is a stream whose file handle should be used, or the handle itself.
;;;  if MARK-P, this had better really be a stream.
;;; SIMPLE-P means do not wait for a response, get an asynchronous error if any.
(DEFMETHOD (HOST-UNIT :COMMAND) (MARK-P STREAM-OR-HANDLE SIMPLE-P &REST COMMANDS
								  &AUX HANDLE STREAM)
  (DECLARE (RETURN-LIST PKT SUCCESS STRING))
  (COND ((STRINGP STREAM-OR-HANDLE)
	 (SETQ HANDLE STREAM-OR-HANDLE))
	(STREAM-OR-HANDLE
	 (SETQ STREAM STREAM-OR-HANDLE
	       HANDLE (FUNCALL STREAM ':FILE-HANDLE))
	 (AND MARK-P (SETQ MARK-P (FUNCALL STREAM ':DIRECTION)))))
  (LET ((PKT (CHAOS:GET-PKT))
	(TRANSACTION-ID (FILE-MAKE-TRANSACTION-ID SIMPLE-P))
	SUCCESS WHOSTATE STRING)
    ;; Make up a packet containing the command to be sent over
    (LEXPR-FUNCALL #'CHAOS:SET-PKT-STRING PKT TRANSACTION-ID " " (OR HANDLE "") " " COMMANDS)
    (LET ((STRING (CHAOS:PKT-STRING PKT))
	  (FROM 0))
      (SETQ FROM (STRING-SEARCH-CHAR #\SP STRING (1+ (STRING-SEARCH-CHAR #\SP STRING))))
      (SETQ WHOSTATE (SUBSTRING STRING (1+ FROM)
				(STRING-SEARCH-SET '(#\SP #\CR) STRING (1+ FROM)))))
    (CHAOS:SEND-PKT CONTROL-CONNECTION PKT %FILE-COMMAND-OPCODE)
    (AND (EQ MARK-P ':OUTPUT)
	 (FUNCALL STREAM ':WRITE-SYNCHRONOUS-MARK))
    ;; Get the portion of the response after the transaction ID.
    (COND (SIMPLE-P
	   (AND (EQ MARK-P ':INPUT)
		(FUNCALL STREAM ':READ-UNTIL-SYNCHRONOUS-MARK))
	   (VALUES NIL T ""))
	  (T
	   (SETQ PKT (FILE-WAIT-FOR-TRANSACTION TRANSACTION-ID CONTROL-CONNECTION WHOSTATE))
	   (SETQ STRING (NSUBSTRING (CHAOS:PKT-STRING PKT)
				    (1+ (STRING-SEARCH-CHAR #\SP (CHAOS:PKT-STRING PKT)))))
	   (SETQ SUCCESS (LET ((FROM (IF HANDLE (FILE-CHECK-HANDLE HANDLE STRING)
					 (1+ (STRING-SEARCH-SET '(#\SP #\CR) STRING)))))
			   (NOT (STRING-EQUAL "ERROR" STRING 0 FROM 5
					      (STRING-SEARCH-SET '(#\SP #\CR) STRING FROM)))))
	   (AND SUCCESS (EQ MARK-P ':INPUT)
		(FUNCALL STREAM ':READ-UNTIL-SYNCHRONOUS-MARK))
	   (VALUES PKT SUCCESS STRING)))))

;;; Insure response over control connection is for correct file-handle.  If not, bomb out
;;; right here as the protocol has been violated.  If returning, return the string-index
;;; of the first non-file-handle byte.
(DEFUN FILE-CHECK-HANDLE (HANDLE STRING)
  (LET ((HANDLE-END (STRING-SEARCH-SET '(#\SP #\CR) STRING)))
    (AND (NULL HANDLE-END)
	 (FERROR NIL "Response over control connection was incorrectly formatted"))
    (OR (STRING-EQUAL STRING HANDLE 0 0 HANDLE-END)
	(FERROR NIL "Response over control connection was for wrong file handle"))
    (1+ HANDLE-END)))

(DEFMETHOD (FILE-HOST-MIXIN :LOGIN-UNIT) (UNIT LOGIN-P)
  (LOGIN-HOST-UNIT UNIT LOGIN-P SELF))

(DEFUN LOGIN-HOST-UNIT (UNIT LOGIN-P UNAME-HOST &AUX HOST CONN)
  (SETQ HOST (HOST-UNIT-HOST UNIT)
	CONN (HOST-UNIT-CONTROL-CONNECTION UNIT))
  (AND CONN (EQ (CHAOS:STATE CONN) 'CHAOS:OPEN-STATE)
       (DO ((PKT (CHAOS:GET-PKT))
	    (ID (FILE-MAKE-TRANSACTION-ID))
	    (PASSWORD "")
	    (ACCOUNT "")
	    (NEED-PASSWORD NIL)
	    (SUCCESS NIL)
	    NEW-USER-ID)
	   (SUCCESS)
	 (SETQ PKT (CHAOS:GET-PKT)
	       ID (FILE-MAKE-TRANSACTION-ID))
	 (COND ((AND LOGIN-P			;If really login
		     (OR NEED-PASSWORD
			 (NULL (SETQ NEW-USER-ID (CDR (ASSQ UNAME-HOST USER-UNAMES))))))
		(COND ((EQ UNAME-HOST 'ITS)
		       ;; We don't know about USER-ID for this host, so must ask
		       (FORMAT QUERY-IO "~&ITS uname (default ~A): " USER-ID)
		       (LET ((NID (READLINE QUERY-IO)))
			 (SETQ NEW-USER-ID (IF (EQUAL NID "") USER-ID NID))))
		      (T
		       (MULTIPLE-VALUE (NEW-USER-ID PASSWORD)
			 (FILE-GET-PASSWORD USER-ID UNAME-HOST))))
		(FILE-HOST-USER-ID NEW-USER-ID HOST)))
	 (CHAOS:SET-PKT-STRING PKT ID "  LOGIN " (IF NEW-USER-ID
						     (STRING-UPCASE NEW-USER-ID)
						     "")
			       " " PASSWORD " " ACCOUNT)
	 (CHAOS:SEND-PKT CONN PKT)
	 (SETQ PKT (FILE-WAIT-FOR-TRANSACTION ID CONN "Login"))
	 (IF LOGIN-P
	     (LET ((STR (CHAOS:PKT-STRING PKT))
		   IDX HSNAME-PATHNAME ITEM)
	       (SETQ STR (NSUBSTRING STR (1+ (STRING-SEARCH-CHAR #\SP STR))))
	       (SETQ IDX (FILE-CHECK-COMMAND "LOGIN" STR T))
	       (COND (IDX
		      (OR (STRING-EQUAL NEW-USER-ID STR 0 IDX NIL
					(SETQ IDX (STRING-SEARCH-CHAR #\SP STR IDX)))
			  (FERROR NIL "File job claims to have logged in as someone else."))
		      (MULTIPLE-VALUE (HSNAME-PATHNAME USER-PERSONAL-NAME
				       USER-GROUP-AFFILIATION
				       USER-PERSONAL-NAME-FIRST-NAME-FIRST)
			(FUNCALL HOST ':HSNAME-INFORMATION UNIT STR IDX))
		      (IF (SETQ ITEM (ASSQ HOST USER-HOMEDIRS))
			  (RPLACD ITEM HSNAME-PATHNAME)
			  (PUSH (CONS HOST HSNAME-PATHNAME) USER-HOMEDIRS))
		      (SETQ SUCCESS T))
		     ;; If user or password is invalid, force getting it (again).
		     ((MEMBER (FILE-PROCESS-ERROR STR NIL T T) '("IP?" "PI?" "UNK"))
		      (SETQ NEED-PASSWORD T))
		     (T
		      (CHAOS:CLOSE CONN "Login failed")
		      (FILE-PROCESS-ERROR STR NIL T)
		      (FUNCALL HOST ':VALIDATE-CONTROL-CONNECTION UNIT))))
	     (SETQ SUCCESS T))
	 (CHAOS:RETURN-PKT PKT)))
  T)

;;; Functions to be called by pathname interface.
;;; Commands without associated streams.
(DEFUN DELETE-CHAOS (HOST PATHNAME ERROR-P &AUX HOST-UNIT PKT SUCCESS STRING)
  (SETQ HOST-UNIT (FUNCALL HOST ':GET-HOST-UNIT))
  (MULTIPLE-VALUE (PKT SUCCESS STRING)
    (FUNCALL HOST-UNIT ':COMMAND NIL NIL NIL
	     "DELETE" #\CR (FUNCALL PATHNAME ':STRING-FOR-HOST) #\CR))
  (COND (SUCCESS
	 (CHAOS:RETURN-PKT PKT)
	 T)
	((NOT ERROR-P)
	 (PROG1 (STRING-APPEND STRING) (CHAOS:RETURN-PKT PKT)))
	(T
	 (UNWIND-PROTECT
	   (FILE-PROCESS-ERROR STRING PATHNAME T)
	   (CHAOS:RETURN-PKT PKT))
	 ;; Retry if continued.
	 (DELETE-CHAOS HOST PATHNAME ERROR-P))))

(DEFUN RENAME-CHAOS (HOST OLD-PATHNAME NEW-PATHNAME ERROR-P &AUX HOST-UNIT PKT SUCCESS STRING)
  (SETQ HOST-UNIT (FUNCALL HOST ':GET-HOST-UNIT))
  (MULTIPLE-VALUE (PKT SUCCESS STRING)
    (FUNCALL HOST-UNIT ':COMMAND NIL NIL NIL
	     "RENAME" #\CR (FUNCALL OLD-PATHNAME ':STRING-FOR-HOST) #\CR
			   (FUNCALL NEW-PATHNAME ':STRING-FOR-HOST) #\CR))
  (COND (SUCCESS
	 (CHAOS:RETURN-PKT PKT)
	 T)
	((NOT ERROR-P)
	 (PROG1 (STRING-APPEND STRING) (CHAOS:RETURN-PKT PKT)))
	(T
	 (UNWIND-PROTECT
	   (FILE-PROCESS-ERROR STRING OLD-PATHNAME T)
	   (CHAOS:RETURN-PKT PKT))
	 ;; Retry if continued.
	 (RENAME-CHAOS HOST OLD-PATHNAME NEW-PATHNAME ERROR-P))))

(DEFUN COMPLETE-CHAOS (HOST PATHNAME STRING OPTIONS
		       &AUX HOST-UNIT PKT FILE-STRING SUCCESS
			    DELETED-P WRITE-P NEW-OK STRING-ORIGIN)
  (DOLIST (KEY OPTIONS)
    (SELECTQ KEY
      (:DELETED
       (SETQ DELETED-P T))
      ((:READ :IN)
       (SETQ WRITE-P NIL))
      ((:PRINT :OUT :WRITE)
       (SETQ WRITE-P T))
      (:OLD
       (SETQ NEW-OK NIL))
      (:NEW-OK
       (SETQ NEW-OK T))
      (OTHERWISE
       (FERROR NIL "~S is not a recognized option" KEY))))
  (SETQ HOST-UNIT (FUNCALL HOST ':GET-HOST-UNIT))
  (MULTIPLE-VALUE (PKT SUCCESS FILE-STRING)
    (FUNCALL HOST-UNIT ':COMMAND NIL NIL NIL
	     (FORMAT NIL "COMPLETE~:[ DELETED~]~:[ WRITE~]~:[ NEW-OK~]~%~A~%~A~%"
		     (NOT DELETED-P) (NOT WRITE-P) (NOT NEW-OK)
		     (FUNCALL PATHNAME ':STRING-FOR-HOST) STRING)))
  (COND (SUCCESS
	 (OR (SETQ STRING-ORIGIN (STRING-SEARCH-CHAR #\CR FILE-STRING))
	     (FERROR NIL "Illegally formatted string ~S" FILE-STRING))
	 (SETQ SUCCESS (PKG-BIND ""
			 (READ-FROM-STRING FILE-STRING NIL
					   (FILE-CHECK-COMMAND "COMPLETE" FILE-STRING))))
	 (SETQ STRING (SUBSTRING FILE-STRING
				 (SETQ STRING-ORIGIN (1+ STRING-ORIGIN))
				 (STRING-SEARCH-CHAR #\CR FILE-STRING STRING-ORIGIN)))))
  (CHAOS:RETURN-PKT PKT)
  (VALUES STRING SUCCESS))

(DEFUN CHANGE-PROPERTIES-CHAOS (HOST PATHNAME ERROR-P PROPERTIES
				&AUX STRING HOST-UNIT PKT SUCCESS)
  (SETQ HOST-UNIT (FUNCALL HOST ':GET-HOST-UNIT))
  (SETQ STRING (WITH-OUTPUT-TO-STRING (STREAM)
		 (FORMAT STREAM "CHANGE-PROPERTIES~%~A~%"
			 (FUNCALL PATHNAME ':STRING-FOR-HOST))
		 (TV:DOPLIST (PROPERTIES PROP IND)
		   (FORMAT STREAM "~A " IND)
		   (FUNCALL (DO ((L *KNOWN-DIRECTORY-PROPERTIES* (CDR L)))
				((NULL L) 'PRINC)
			      (AND (MEMQ IND (CDAR L))
				   (RETURN (CADAAR L))))
			    PROP STREAM)
		   (FUNCALL STREAM ':TYO #\CR))))
  (MULTIPLE-VALUE (PKT SUCCESS STRING)
    (FUNCALL HOST-UNIT ':COMMAND NIL NIL NIL STRING))
  (COND (SUCCESS
	 (CHAOS:RETURN-PKT PKT)
	 T)
	((NOT ERROR-P)
	 (PROG1 (STRING-APPEND STRING) (CHAOS:RETURN-PKT PKT)))
	(T
	 (UNWIND-PROTECT
	   (FILE-PROCESS-ERROR STRING PATHNAME T)
	   (CHAOS:RETURN-PKT PKT))
	 (CHANGE-PROPERTIES-CHAOS HOST PATHNAME ERROR-P PROPERTIES))))

(DEFUN HOMEDIR-CHAOS (HOST)
  (FUNCALL HOST ':GET-HOST-UNIT)		;This will make sure someone is logged in
  (CDR (ASSQ HOST USER-HOMEDIRS)))

(DEFUN EXPUNGE-CHAOS (HOST PATHNAME OPTIONS &AUX HOST-UNIT PKT SUCCESS FILE-STRING
						 (ERROR-P T))
  (LOOP FOR (KEY VAL) ON OPTIONS BY 'CDDR
	DO (SELECTQ KEY
	     (:ERROR (SETQ ERROR-P VAL))
	     (OTHERWISE (FERROR NIL "~S is not a recognized option" KEY))))
  (SETQ HOST-UNIT (FUNCALL HOST ':GET-HOST-UNIT))
  (MULTIPLE-VALUE (PKT SUCCESS FILE-STRING)
    (FUNCALL HOST-UNIT ':COMMAND NIL NIL NIL
	     "EXPUNGE" #\CR (FUNCALL PATHNAME ':STRING-FOR-HOST) #\CR))
  (UNWIND-PROTECT
    (COND (SUCCESS
	   (LET ((START (FILE-CHECK-COMMAND "EXPUNGE" FILE-STRING)))
	     (PARSE-NUMBER FILE-STRING START)))
	  ((NOT ERROR-P)
	   (STRING-APPEND FILE-STRING))
	  (T
	   (FILE-PROCESS-ERROR FILE-STRING PATHNAME NIL)))
    (CHAOS:RETURN-PKT PKT)))

;;; Stream generating versions
(DEFUN OPEN-CHAOS (HOST PATHNAME OPTIONS
		   &AUX (MODE ':READ) (TYPE ':CHARACTER) (NOERROR-P NIL)
			(TEMPORARY-P NIL) (DELETED-P NIL) (RAW-P NIL) (SUPER-IMAGE-P NIL)
			(BYTE-SIZE NIL) (PRESERVE-DATES-P NIL)
			HOST-UNIT DATA-CONN PKT SUCCESS STRING DIRECTION)
  (PROG OPEN-CHAOS ()			;So can return from whole function
    (*CATCH 'OPEN-CHAOS-RETRY		;Throw to this catch if PATHNAME changed for retry
      (LOOP FOR (KEY VAL) ON OPTIONS BY 'CDDR
	    DO (SELECTQ KEY
		 (:DIRECTION (SETQ MODE (SELECTQ VAL
					  ((:IN :INPUT) ':READ)
					  ((:OUT :OUTPUT) ':WRITE)
					  ((NIL) ':PROBE))))
		 (:CHARACTERS (SETQ TYPE (SELECTQ VAL
					   ((T) ':CHARACTER)
					   ((NIL) ':BINARY)
					   (:DEFAULT ':DEFAULT))))
		 (:ERROR (SETQ NOERROR-P (NOT VAL)))
		 (:BYTE-SIZE (SETQ BYTE-SIZE VAL))
		 (:RAW (SETQ RAW-P VAL))
		 (:SUPER-IMAGE (SETQ SUPER-IMAGE-P VAL))
		 (:PRESERVE-DATES (SETQ PRESERVE-DATES-P VAL))
		 ;; These two are for TOPS-20
		 (:DELETED (SETQ DELETED-P VAL))
		 (:TEMPORARY (SETQ TEMPORARY-P VAL))
		 (:IGNORE)
		 (OTHERWISE (FERROR NIL "~S is not a known OPEN option" KEY))))
      (AND (EQ BYTE-SIZE NIL)
	   (SETQ BYTE-SIZE ':DEFAULT))
      (SETQ DIRECTION (SELECTQ MODE
			(:READ ':INPUT)
			(:WRITE ':OUTPUT)))
      (IF (EQ MODE ':PROBE)
	  ;;PROBE mode implies no need for data connection
	  (SETQ HOST-UNIT (FUNCALL HOST ':GET-HOST-UNIT))
	  (MULTIPLE-VALUE (DATA-CONN HOST-UNIT)
	    (FUNCALL HOST ':GET-DATA-CONNECTION DIRECTION)))
      (MULTIPLE-VALUE (PKT SUCCESS STRING)
	(FUNCALL HOST-UNIT ':COMMAND NIL
		 (SELECTQ MODE
		   (:PROBE NIL)
		   (:READ (DATA-INPUT-HANDLE DATA-CONN))
		   (:WRITE (DATA-OUTPUT-HANDLE DATA-CONN)))
		 NIL
		 "OPEN " MODE " " TYPE
		 (FORMAT NIL "~:[ BYTE-SIZE ~D~;~*~]~:[~; TEMPORARY~]~:[~; DELETED~]~
			      ~:[~; RAW~]~:[~; SUPER~]~:[~; PRESERVE-DATES~]~%~A~%"
			 (EQ BYTE-SIZE ':DEFAULT) BYTE-SIZE
			 TEMPORARY-P DELETED-P RAW-P SUPER-IMAGE-P PRESERVE-DATES-P
			 (FUNCALL PATHNAME ':STRING-FOR-HOST))))
      (COND ((NOT SUCCESS)
	     (SETQ STRING (STRING-APPEND STRING))
	     (CHAOS:RETURN-PKT PKT)
	     (OR (EQ MODE ':PROBE) (SETF (DATA-STREAM DATA-CONN DIRECTION) NIL))
	     (COND (NOERROR-P
		    (RETURN-FROM OPEN-CHAOS STRING))
		   (T
		    (SETQ PATHNAME (FILE-PROCESS-ERROR STRING PATHNAME T NIL PATHNAME))
		    (*THROW 'OPEN-CHAOS-RETRY NIL))))
	    (T
	     (LET ((PROPERTIES (READ-FILE-PROPERTY-LIST-STRING STRING "OPEN" PATHNAME)))
	       (CHAOS:RETURN-PKT PKT)
	       (AND (EQ TYPE ':DEFAULT)
		    (SETQ TYPE (IF (GET (LOCF PROPERTIES) ':CHARACTERS)
				   ':CHARACTER ':BINARY)))
	       (RETURN-FROM OPEN-CHAOS (MAKE-INSTANCE (SELECTQ MODE
							(:PROBE 'FILE-PROBE-STREAM)
							(:READ
							 (SELECTQ TYPE
							   (:CHARACTER
							    'FILE-INPUT-CHARACTER-STREAM)
							   (:BINARY
							    'FILE-INPUT-BINARY-STREAM)))
							(:WRITE
							 (SELECTQ TYPE
							   (:CHARACTER
							    'FILE-OUTPUT-CHARACTER-STREAM)
							   (:BINARY
							    'FILE-OUTPUT-BINARY-STREAM))))
						      ':HOST-UNIT HOST-UNIT
						      ':DATA-CONNECTION DATA-CONN
						      ':PROPERTY-LIST PROPERTIES
						      ':PATHNAME PATHNAME))))))
    ;; Here to retry with new file name.  May not be same host.
    (RETURN-FROM OPEN-CHAOS (LEXPR-FUNCALL #'OPEN PATHNAME OPTIONS))))

;;; PATHNAME is only used as a source of a host with respect to which to parse
(DEFUN READ-FILE-PROPERTY-LIST-STRING (STRING OPERATION PATHNAME
				       &AUX PATHNAME-ORIGIN PROPERTY-LIST)
  (OR (SETQ PATHNAME-ORIGIN (STRING-SEARCH-CHAR #\CR STRING))
      (FERROR 'FILE-CONNECTION-TROUBLE "Illegally formatted string ~S" STRING))
  (DO ((I (FILE-CHECK-COMMAND OPERATION STRING)
	  (STRING-SEARCH-CHAR #\SP STRING (1+ I)))
       (PROP '((:CREATION-DATE) (:CREATION-TIME)
	       (:LENGTH . T) (:QFASLP . T) (:CHARACTERS . T))
	     (CDR PROP))
       (IBASE 10.)
       (TYPE) (DATE-START))
      ((OR (NULL I) (> I PATHNAME-ORIGIN) (NULL PROP)))
    (SETQ TYPE (CAAR PROP))
    (SELECTQ TYPE
      (:CREATION-DATE (SETQ DATE-START I))
      (:LENGTH (PUSH (IF (NOT (FBOUNDP 'TIME:PARSE-UNIVERSAL-TIME))
			 ;;When bootstrapping, dates are recorded as strings.
			 (SUBSTRING STRING DATE-START I)
			 (PARSE-DIRECTORY-DATE-PROPERTY STRING DATE-START I))
		     PROPERTY-LIST)
	       (PUSH ':CREATION-DATE PROPERTY-LIST)))
    (COND ((CDAR PROP)
	   (PUSH (READ-FROM-STRING STRING NIL I) PROPERTY-LIST)
	   (PUSH TYPE PROPERTY-LIST))))
  (PUSH (FUNCALL PATHNAME ':PARSE-TRUENAME
		 (SUBSTRING STRING (SETQ PATHNAME-ORIGIN (1+ PATHNAME-ORIGIN))
				   (STRING-SEARCH-CHAR #\CR STRING PATHNAME-ORIGIN)))
	PROPERTY-LIST)
  (PUSH ':TRUENAME PROPERTY-LIST)
  PROPERTY-LIST)

(DEFUN MULTIPLE-PLISTS-CHAOS (HOST PATHNAMES OPTIONS &AUX FILE-LIST CONNECTION
							  (CHARACTERS T))
  (LOOP FOR (IND OPT) ON OPTIONS BY 'CDDR
	DO (SELECTQ IND
	     (:CHARACTERS (SETQ CHARACTERS OPT))
	     (OTHERWISE (FERROR NIL "~S is not a known MULTIPLE-FILE-PLISTS option" IND))))
  (SETQ CONNECTION (HOST-UNIT-CONTROL-CONNECTION (FUNCALL HOST ':GET-HOST-UNIT)))
  (SETQ FILE-LIST (LOOP FOR PATHNAME IN PATHNAMES
			COLLECT (LIST PATHNAME NIL)))
  (DO ((LIST-TO-DO FILE-LIST (CDR LIST-TO-DO))
       (PENDING-LIST (COPYLIST FILE-LIST))
       (ELEM-TO-DO))
      ((NULL PENDING-LIST))
    (SETQ ELEM-TO-DO (CAR LIST-TO-DO))
    (DO ((P-L PENDING-LIST (CDR P-L))
	 (ELEM))
	((OR (NULL P-L)
	     (AND ELEM-TO-DO
		  (NOT (CHAOS:DATA-AVAILABLE CONNECTION))
		  (CHAOS:MAY-TRANSMIT CONNECTION))))
      (SETQ ELEM (CAR P-L))
      (LET ((TRANSACTION-ID (SECOND ELEM)))
	(AND TRANSACTION-ID
	     (LET* ((PKT (FILE-WAIT-FOR-TRANSACTION TRANSACTION-ID CONNECTION "PROBE"))
		    (PKT-STRING (CHAOS:PKT-STRING PKT))
		    (STRING (NSUBSTRING PKT-STRING (1+ (STRING-SEARCH-CHAR #\SP PKT-STRING))))
		    (FROM (1+ (STRING-SEARCH-SET '(#\SP #\CR) STRING)))
		    (SUCCESS (NOT (STRING-EQUAL "ERROR" STRING 0 FROM 5
						(STRING-SEARCH-SET '(#\SP #\CR)
								   STRING FROM))))
		    (PROPERTY-LIST NIL))
	       (AND SUCCESS (SETQ PROPERTY-LIST (READ-FILE-PROPERTY-LIST-STRING
						  STRING "OPEN" (FIRST ELEM))))
	       (CHAOS:RETURN-PKT PKT)
	       (SETF (CDR ELEM) PROPERTY-LIST)
	       (SETQ PENDING-LIST (DELQ ELEM PENDING-LIST))))))
    (AND ELEM-TO-DO
	 (LET ((MODE (IF CHARACTERS ':CHARACTER ':BINARY))
	       (PKT (CHAOS:GET-PKT))
	       (TRANSACTION-ID (FILE-MAKE-TRANSACTION-ID NIL)))
	   (CHAOS:SET-PKT-STRING PKT TRANSACTION-ID
				     "  OPEN PROBE " MODE #\CR
				     (FUNCALL (FIRST ELEM-TO-DO) ':STRING-FOR-HOST) #\CR)
	   (CHAOS:SEND-PKT CONNECTION PKT %FILE-COMMAND-OPCODE)
	   (SETF (SECOND ELEM-TO-DO) TRANSACTION-ID))))
  FILE-LIST)

(DEFUN DIRECTORY-CHAOS (HOST PATHNAME OPTIONS
			&AUX (NOERROR-P NIL) (DELETED-P NIL) (FAST-P NIL) (DIRS-ONLY-P NIL)
			     (NO-EXTRA-INFO NIL)
			     DATA-CONN HOST-UNIT PKT SUCCESS STRING)
  (PROG DIRECTORY-CHAOS ()
    (*CATCH 'DIRECTORY-CHAOS-RETRY
      (DO ((L OPTIONS (CDR L)))
	  ((NULL L))
	(SELECTQ (CAR L)
	    (:NOERROR (SETQ NOERROR-P T))
	    (:FAST (SETQ FAST-P T))
	    (:NO-EXTRA-INFO (SETQ NO-EXTRA-INFO T))
	    ;; This is for the :ALL-DIRECTORIES message
	    (:DIRECTORIES-ONLY (SETQ DIRS-ONLY-P T))
	    ;; This is for TOPS-20
	    (:DELETED (SETQ DELETED-P T))
	    ;; This is handled at a higher level.
	    (:SORTED)
	    (OTHERWISE (FERROR NIL "~S is not a known DIRECTORY option" (CAR L)))))
      (MULTIPLE-VALUE (DATA-CONN HOST-UNIT)
	(FUNCALL HOST ':GET-DATA-CONNECTION ':INPUT))
      (MULTIPLE-VALUE (PKT SUCCESS STRING)
	(FUNCALL HOST-UNIT ':COMMAND
		 NIL (DATA-INPUT-HANDLE DATA-CONN) NIL
		 "DIRECTORY"
		 (FORMAT NIL "~:[~; DELETED~]~:[~; FAST~]~:[~; DIRECTORIES-ONLY~]~
			      ~:[~; NO-EXTRA-INFO~]"
			 DELETED-P FAST-P DIRS-ONLY-P NO-EXTRA-INFO)
		 #\CR (FUNCALL PATHNAME ':STRING-FOR-HOST) #\CR))
      (COND ((NOT SUCCESS)
	     (SETQ STRING (STRING-APPEND STRING))
	     (CHAOS:RETURN-PKT PKT)
	     (SETF (DATA-STREAM DATA-CONN ':INPUT) NIL)
	     (COND (NOERROR-P
		    (RETURN-FROM DIRECTORY-CHAOS STRING))
		   (T
		    (SETQ PATHNAME (FILE-PROCESS-ERROR STRING PATHNAME T NIL PATHNAME))
		    (*THROW 'DIRECTORY-CHAOS-RETRY NIL))))
	    (T
	     (FILE-CHECK-COMMAND "DIRECTORY" STRING)
	     (CHAOS:RETURN-PKT PKT)
	     (RETURN-FROM DIRECTORY-CHAOS (MAKE-INSTANCE 'FILE-DIRECTORY-STREAM
							 ':HOST-UNIT HOST-UNIT
							 ':DATA-CONNECTION DATA-CONN
							 ':PATHNAME PATHNAME)))))
    ;; Here to retry with new file name.  May not be same host.
    (RETURN-FROM DIRECTORY-CHAOS (FUNCALL PATHNAME ':DIRECTORY-STREAM OPTIONS))))

(DEFFLAVOR FILE-STREAM-MIXIN
	(HOST-UNIT
	 STATUS)
	(SI:PROPERTY-LIST-MIXIN SI:FILE-STREAM-MIXIN)
  (:INITABLE-INSTANCE-VARIABLES HOST-UNIT))

(DEFMETHOD (FILE-STREAM-MIXIN :QFASLP) ()
  (GET (LOCF SI:PROPERTY-LIST) ':QFASLP))

(DEFMETHOD (FILE-STREAM-MIXIN :TRUENAME) ()
  (GET (LOCF SI:PROPERTY-LIST) ':TRUENAME))

(DEFMETHOD (FILE-STREAM-MIXIN :LENGTH) ()
  (GET (LOCF SI:PROPERTY-LIST) ':LENGTH))

;;; Flavors that really have an open connection
;;; STATUS is one of
;;;  :OPEN - a file is currently open on this channel
;;;  :CLOSED - no file is open, but the channel exists
;;;  :EOF - a file is open, but is at its end (no more data available).
;;;  :SYNC-MARKED - a mark that was requested has been received
;;;  :ASYNC-MARKED - an asynchronous (error) mark has been received
(DEFFLAVOR FILE-DATA-STREAM-MIXIN
	((STATUS ':OPEN)
	 DATA-CONNECTION
	 FILE-HANDLE
	 CHAOS:CONNECTION)
	(FILE-STREAM-MIXIN)
  (:INCLUDED-FLAVORS SI:FILE-DATA-STREAM-MIXIN)
  (:SETTABLE-INSTANCE-VARIABLES STATUS)
  (:GETTABLE-INSTANCE-VARIABLES FILE-HANDLE)
  (:INITABLE-INSTANCE-VARIABLES DATA-CONNECTION))

(DEFFLAVOR FILE-INPUT-STREAM-MIXIN
	(CHAOS:INPUT-PACKET)
	(FILE-DATA-STREAM-MIXIN)
  (:INCLUDED-FLAVORS SI:INPUT-FILE-STREAM-MIXIN))

(DEFFLAVOR FILE-OUTPUT-STREAM-MIXIN
	()
	(FILE-DATA-STREAM-MIXIN)
  (:REQUIRED-METHODS :SEND-PKT-BUFFER)
  (:INCLUDED-FLAVORS SI:OUTPUT-FILE-STREAM-MIXIN))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :BEFORE :INIT) (IGNORE)
  (LET ((DIRECTION (FUNCALL-SELF ':DIRECTION)))
    (SETF (DATA-STREAM DATA-CONNECTION DIRECTION) SELF)
    (SETQ FILE-HANDLE (DATA-HANDLE DATA-CONNECTION DIRECTION)
	  CHAOS:CONNECTION (DATA-CONNECTION DATA-CONNECTION))))

;;; Stream version of host unit :COMMAND, supplies file handle itself.
;;; MARK-P is just T or NIL.
(DEFMETHOD (FILE-DATA-STREAM-MIXIN :COMMAND) (MARK-P COM &REST STRINGS
							 &AUX PKT SUCCESS STRING)
  (DECLARE (RETURN-LIST STRING SUCCESS))
  (MULTIPLE-VALUE (PKT SUCCESS STRING)
    (LEXPR-FUNCALL HOST-UNIT ':COMMAND MARK-P SELF NIL COM STRINGS))
  (SETQ STRING (STRING-APPEND STRING))
  (CHAOS:RETURN-PKT PKT)
  (VALUES STRING SUCCESS))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :CLOSE) (&OPTIONAL ABORTP)
  (COND ((EQ STATUS ':CLOSED) NIL)
	((NEQ (CHAOS:STATE (HOST-UNIT-CONTROL-CONNECTION HOST-UNIT)) 'CHAOS:OPEN-STATE)
	 (SETQ STATUS ':CLOSED)
	 T)
        (T
	 (FUNCALL-SELF ':REAL-CLOSE ABORTP))))

(DEFMETHOD (FILE-INPUT-STREAM-MIXIN :REAL-CLOSE) (ABORTP &AUX SUCCESS STRING)
  ABORTP
  (IF (NEQ STATUS ':EOF)
      (MULTIPLE-VALUE (STRING SUCCESS)
	(FUNCALL-SELF ':COMMAND T "CLOSE"))
      (FUNCALL HOST-UNIT ':COMMAND T SELF T "CLOSE")
      (SETQ SUCCESS T))
  (FUNCALL HOST-UNIT ':FREE-DATA-CONNECTION DATA-CONNECTION ':INPUT)
  (SETQ STATUS ':CLOSED)
  (IF SUCCESS
      T
      (FILE-PROCESS-ERROR STRING SELF T)))

(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :SEND-OUTPUT-BUFFER) (&REST ARGS)
  (LOOP DOING
    (SELECTQ STATUS
      ((:OPEN :EOF)
       (PROCESS-WAIT "File NETO"
		     #'(LAMBDA (STAT CONNECTION)
			 (OR (EQ (CAR STAT)':ASYNC-MARKED)
			     (CHAOS:MAY-TRANSMIT CONNECTION)
			     (NEQ (CHAOS:STATE CONNECTION) 'CHAOS:OPEN-STATE)))
		     (LOCATE-IN-INSTANCE SELF 'STATUS) CHAOS:CONNECTION)
       (AND (NEQ (CHAOS:STATE CHAOS:CONNECTION) 'CHAOS:OPEN-STATE)
	    (FERROR NIL "Connection ~S went into illegal state while waiting for room"
		    CHAOS:CONNECTION))
       (AND (NEQ STATUS ':ASYNC-MARKED)
	    (RETURN (LEXPR-FUNCALL-SELF ':SEND-PKT-BUFFER ARGS))))
      (:ASYNC-MARKED
       (FILE-PROCESS-OUTPUT-ASYNC-MARK))
      (OTHERWISE
       (FERROR NIL "Attempt to write to ~S, which is in illegal state ~S" SELF STATUS)))))

;;; Sent from inside the interrupt function, change our status and remember error message.
(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :ASYNC-MARK) (PKT)
  (PUTPROP (LOCF SI:PROPERTY-LIST) PKT 'ASYNC-MARK-PKT)
  (SETQ STATUS ':ASYNC-MARKED))

(DEFMETHOD (FILE-INPUT-STREAM-MIXIN :READ-UNTIL-SYNCHRONOUS-MARK) ()
  (LOOP UNTIL (EQ STATUS ':SYNC-MARKED)
	AS PKT = (FILE-NEXT-READ-PKT NIL T)
	WHEN PKT DO (CHAOS:RETURN-PKT PKT)
	FINALLY (SETQ STATUS ':OPEN)))

(DEFMETHOD (FILE-INPUT-STREAM-MIXIN :GET-NEXT-INPUT-PKT) (&OPTIONAL NO-HANG-P)
  (LOOP WHEN (EQ STATUS ':EOF) RETURN NIL
	THEREIS (SETQ CHAOS:INPUT-PACKET (FILE-NEXT-READ-PKT NO-HANG-P NIL))))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (FILE-INPUT-STREAM-MIXIN)
(DEFUN FILE-NEXT-READ-PKT (NO-HANG-P FOR-SYNC-MARK-P)
  (SELECTQ (IF FOR-SYNC-MARK-P ':EOF STATUS)
    ((:OPEN :EOF)
     (LET ((PKT (CHAOS:GET-NEXT-PKT CHAOS:CONNECTION NO-HANG-P)))
       (COND (PKT
	      (SELECT (CHAOS:PKT-OPCODE PKT)
		;; Received some sort of data, return it
		((%FILE-BINARY-OPCODE %FILE-CHARACTER-OPCODE)
		 PKT)

		;; No data, but a synchronous mark
		(%FILE-SYNCHRONOUS-MARK-OPCODE
		 (SETQ STATUS ':SYNC-MARKED)
		 (CHAOS:RETURN-PKT PKT)
		 NIL)

		;; Received an asynchronous mark, meaning some sort of error condition
		(%FILE-ASYNCHRONOUS-MARK-OPCODE
		 (SETQ STATUS ':ASYNC-MARKED)
		 (OR FOR-SYNC-MARK-P (FILE-PROCESS-ASYNC-MARK PKT))
		 (CHAOS:RETURN-PKT PKT)
		 NIL)

		;; EOF received, change channel state and return
		(%FILE-EOF-OPCODE
		 (SETQ STATUS ':EOF)
		 (CHAOS:RETURN-PKT PKT)
		 NIL)

		;; Connection closed or broken with message
		((CHAOS:CLS-OP CHAOS:LOS-OP)
		 (FERROR NIL
			 "Network connection ~:[broken~;closed~], reason given as /"~A/""
			 (= (CHAOS:PKT-OPCODE PKT) CHAOS:CLS-OP) (CHAOS:PKT-STRING PKT)))

		;; Not a recognized opcode, huh?
		(OTHERWISE
		 (FERROR NIL "Receieved data packet (~S) with illegal opcode for ~S"
			 PKT SELF)))))))
    (:CLOSED
     (FERROR NIL "Attempt to read from ~S, which is closed" SELF))
    ((:ASYNC-MARKED :SYNC-MARKED)
     (FERROR NIL "Attempt to read from ~S, which is in a marked state" SELF))
    (OTHERWISE
     (FERROR NIL "Attempt to read from ~S, which is in illegal state ~S" SELF STATUS)))))

(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :WRITE-SYNCHRONOUS-MARK) ()
  (LET ((STATUS ':EOF))				;In case :ASYNC-MARK now
    (FUNCALL-SELF ':FORCE-OUTPUT))		;Send any partial buffer
  (CHAOS:SEND-PKT CHAOS:CONNECTION (CHAOS:GET-PKT) %FILE-SYNCHRONOUS-MARK-OPCODE))

(DECLARE-FLAVOR-INSTANCE-VARIABLES (FILE-OUTPUT-STREAM-MIXIN)
(DEFUN FILE-PROCESS-OUTPUT-ASYNC-MARK ()
  (LET ((PKT (CAR (REMPROP (LOCF SI:PROPERTY-LIST) 'ASYNC-MARK-PKT))))
    (OR PKT (FERROR NIL "Output stream ~S in ASYNC-MARKED state, but no async mark pkt" SELF))
    (UNWIND-PROTECT
      (FILE-PROCESS-ASYNC-MARK PKT)
      (CHAOS:RETURN-PKT PKT)))))

(DEFUN FILE-PROCESS-ASYNC-MARK (PKT)
    (LET ((STRING (NSUBSTRING (CHAOS:PKT-STRING PKT)
			      (1+ (STRING-SEARCH-CHAR #\SP (CHAOS:PKT-STRING PKT))))))
      (FILE-PROCESS-ERROR STRING SELF T))	;Process error allowing proceeding
    ;; If user says to continue, attempt to do so.
    (FUNCALL-SELF ':CONTINUE))

(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :REAL-CLOSE) (ABORTP &AUX SUCCESS STRING)
  ;; Closing an open output channel.  Finish sending the data.
  (AND (EQ STATUS ':OPEN) (FUNCALL-SELF ':EOF))
  ;; If aborting out of a file-writing operation before normal :CLOSE,
  ;; delete the incomplete file.  Don't worry if it gets an error.
  (AND (EQ ABORTP ':ABORT)
       (FUNCALL-SELF ':COMMAND NIL "DELETE"))
  (MULTIPLE-VALUE (STRING SUCCESS)
    (FUNCALL-SELF ':COMMAND T "CLOSE"))
  (FUNCALL HOST-UNIT ':FREE-DATA-CONNECTION DATA-CONNECTION ':OUTPUT)
  (SETQ STATUS ':CLOSED)
  (COND (SUCCESS
	 (SETQ SI:PROPERTY-LIST
	       (NCONC (READ-FILE-PROPERTY-LIST-STRING STRING "CLOSE" SI:PATHNAME)
		      SI:PROPERTY-LIST))
	 T)
	(T
	 (FILE-PROCESS-ERROR STRING SELF T))))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :DELETE) (&OPTIONAL (ERROR-P T) &AUX SUCCESS STRING)
  (SELECTQ STATUS
    ((:OPEN :EOF :SYNC-MARKED :ASYNC-MARKED)
     (MULTIPLE-VALUE (STRING SUCCESS)
       (FUNCALL-SELF ':COMMAND NIL "DELETE"))
     (OR SUCCESS
	 (AND (NULL ERROR-P) STRING)
	 (FILE-PROCESS-ERROR STRING SELF NIL)))
    (OTHERWISE (FERROR NIL "~S in illegal state for delete" SELF))))

(DEFMETHOD (FILE-DATA-STREAM-MIXIN :RENAME) (NEW-NAME &OPTIONAL (ERROR-P T)
						      &AUX SUCCESS STRING)
  (SELECTQ STATUS
    ((:OPEN :EOF :SYNC-MARKED :ASYNC-MARKED)
     (MULTIPLE-VALUE (STRING SUCCESS)
       (FUNCALL-SELF ':COMMAND NIL "RENAME" #\CR (FUNCALL NEW-NAME ':STRING-FOR-HOST)))
     (COND (SUCCESS
	    (SETQ SI:PATHNAME NEW-NAME)
	    (FUNCALL TV:WHO-LINE-FILE-STATE-SHEET ':CLOBBERED)
	    T)
	   ((NOT ERROR-P) STRING)
	   (T (FILE-PROCESS-ERROR STRING SELF NIL))))
    (OTHERWISE (FERROR NIL "~S in illegal state for rename" SELF))))

(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :CONTINUE) (&AUX SUCCESS STRING)
  (COND ((EQ STATUS ':ASYNC-MARKED)
	 (SETF STATUS ':OPEN)
	 (MULTIPLE-VALUE (STRING SUCCESS)
	   (FUNCALL-SELF ':COMMAND NIL "CONTINUE"))
	 (COND ((NULL SUCCESS)
		(SETQ STATUS ':ASYNC-MARKED)
		(FILE-PROCESS-ERROR STRING SELF NIL))))))	;not proceedable

(DEFMETHOD (FILE-INPUT-STREAM-MIXIN :SET-BUFFER-POINTER) (NEW-POINTER &AUX STRING SUCCESS)
  (SELECTQ STATUS
    ((:OPEN :EOF)
     (AND (EQ STATUS ':EOF) (SETQ STATUS ':OPEN))
     (MULTIPLE-VALUE (STRING SUCCESS)
       (FUNCALL-SELF ':COMMAND T "FILEPOS " (FORMAT NIL "~D" NEW-POINTER)))
     (OR SUCCESS (FILE-PROCESS-ERROR STRING SELF NIL))	;Cannot proceed
     NEW-POINTER)
    (OTHERWISE
     (FERROR NIL ":SET-POINTER attempted on ~S which is in state ~S" SELF STATUS))))

(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :FINISH) ()
  (DO () ((CHAOS:FINISHED-P CHAOS:CONNECTION))
    (PROCESS-WAIT "File Finish"
		  #'(LAMBDA (CONN STAT)
		      (OR (CHAOS:FINISHED-P CONN)
			  (EQ (CAR STAT) ':ASYNC-MARKED)))
		  CHAOS:CONNECTION (LOCATE-IN-INSTANCE SELF 'STATUS))
    (AND (EQ STATUS ':ASYNC-MARKED) (FILE-PROCESS-OUTPUT-ASYNC-MARK))))

(DEFMETHOD (FILE-OUTPUT-STREAM-MIXIN :EOF) ()
  (FUNCALL-SELF ':FORCE-OUTPUT)
  (CHAOS:SEND-PKT CHAOS:CONNECTION (CHAOS:GET-PKT) CHAOS:EOF-OP)
  (SETQ STATUS ':EOF)
  (FUNCALL-SELF ':FINISH))

(DEFFLAVOR FILE-CHARACTER-STREAM-MIXIN () (FILE-DATA-STREAM-MIXIN))

(DEFFLAVOR FILE-BINARY-STREAM-MIXIN () (FILE-DATA-STREAM-MIXIN))

(DEFMETHOD (FILE-BINARY-STREAM-MIXIN :SET-BYTE-SIZE) (NEW-BYTE-SIZE)
  (CHECK-ARG NEW-BYTE-SIZE (AND (NUMBERP NEW-BYTE-SIZE)
				(> NEW-BYTE-SIZE 0) ( NEW-BYTE-SIZE 16.))
	     "A positive number less than or equal to 16.")
  (FUNCALL-SELF ':COMMAND T "SET-BYTE-SIZE "
		(FORMAT NIL "~D ~D" NEW-BYTE-SIZE (FUNCALL-SELF ':READ-POINTER)))
  NEW-BYTE-SIZE)

(DEFFLAVOR FILE-INPUT-CHARACTER-STREAM-MIXIN ()
	   (FILE-INPUT-STREAM-MIXIN FILE-CHARACTER-STREAM-MIXIN))

(DEFFLAVOR FILE-INPUT-BINARY-STREAM-MIXIN ()
	   (FILE-INPUT-STREAM-MIXIN FILE-BINARY-STREAM-MIXIN))

(DEFFLAVOR FILE-OUTPUT-CHARACTER-STREAM-MIXIN ()
	   (FILE-OUTPUT-STREAM-MIXIN FILE-CHARACTER-STREAM-MIXIN))

(DEFFLAVOR FILE-OUTPUT-BINARY-STREAM-MIXIN ()
	   (FILE-OUTPUT-STREAM-MIXIN FILE-BINARY-STREAM-MIXIN))

(DEFMETHOD (FILE-OUTPUT-CHARACTER-STREAM-MIXIN :SEND-PKT-BUFFER) CHAOS:SEND-CHARACTER-PKT)

(DEFMETHOD (FILE-OUTPUT-BINARY-STREAM-MIXIN :SEND-PKT-BUFFER) CHAOS:SEND-BINARY-PKT)

(DEFFLAVOR FILE-INPUT-CHARACTER-STREAM
	()
	(FILE-INPUT-CHARACTER-STREAM-MIXIN SI:INPUT-FILE-STREAM-MIXIN
	 CHAOS:CHARACTER-INPUT-STREAM-MIXIN SI:BUFFERED-INPUT-CHARACTER-STREAM))

(DEFFLAVOR FILE-OUTPUT-CHARACTER-STREAM
	()
	(FILE-OUTPUT-CHARACTER-STREAM-MIXIN SI:OUTPUT-FILE-STREAM-MIXIN
	 CHAOS:CHARACTER-OUTPUT-STREAM-MIXIN SI:BUFFERED-OUTPUT-CHARACTER-STREAM))

(DEFFLAVOR FILE-INPUT-BINARY-STREAM
	()
	(FILE-INPUT-BINARY-STREAM-MIXIN SI:INPUT-FILE-STREAM-MIXIN
	 CHAOS:BINARY-INPUT-STREAM-MIXIN SI:BUFFERED-INPUT-STREAM))

(DEFFLAVOR FILE-OUTPUT-BINARY-STREAM
	()
	(FILE-OUTPUT-BINARY-STREAM-MIXIN SI:OUTPUT-FILE-STREAM-MIXIN
	 CHAOS:BINARY-OUTPUT-STREAM-MIXIN SI:BUFFERED-OUTPUT-STREAM))

(DEFFLAVOR FILE-PROBE-STREAM
	((STATUS ':CLOSED))
	(FILE-STREAM-MIXIN SI:STREAM)
  (:GETTABLE-INSTANCE-VARIABLES STATUS)
  (:INIT-KEYWORDS :DATA-CONNECTION))		;Will be NIL, but makes life easier

(DEFFLAVOR FILE-DIRECTORY-STREAM () (FILE-INPUT-CHARACTER-STREAM))

(COMPILE-FLAVOR-METHODS FILE-INPUT-CHARACTER-STREAM FILE-INPUT-BINARY-STREAM
			FILE-OUTPUT-CHARACTER-STREAM FILE-OUTPUT-BINARY-STREAM
			FILE-PROBE-STREAM FILE-DIRECTORY-STREAM)

;;; Operating system particular host flavors
(DEFFLAVOR FILE-HOST-ITS-MIXIN () (FILE-HOST-MIXIN))

(DEFMETHOD (FILE-HOST-ITS-MIXIN :PATHNAME-FLAVOR) ()
  'ITS-PATHNAME)

(DEFMETHOD (FILE-HOST-ITS-MIXIN :MAX-DATA-CONNECTIONS) () 3)

(DEFMETHOD (FILE-HOST-ITS-MIXIN :LOGIN-UNIT) (UNIT LOGIN-P)
  (LOGIN-HOST-UNIT UNIT LOGIN-P 'ITS))

(DEFMETHOD (FILE-HOST-ITS-MIXIN :HSNAME-INFORMATION) (UNIT STR IDX)
  (LET* ((HOST (HOST-UNIT-HOST UNIT))
	 (HSNAME (SUBSTRING STR (SETQ IDX (1+ IDX))
			    (SETQ IDX (STRING-SEARCH-CHAR #\CR STR IDX))))
	 (HSNAME-PATHNAME (MAKE-PATHNAME ':HOST HOST ':DEVICE "DSK" ':DIRECTORY HSNAME))
	 (PERSONAL-NAME (SUBSTRING STR (SETQ IDX (1+ IDX))
				   (SETQ IDX (STRING-SEARCH-CHAR #\CR STR IDX))))
	 (GROUP-AFFILIATION (AREF STR (1+ IDX))))
    (SETQ IDX (STRING-SEARCH ", " PERSONAL-NAME)
	  STR (NSUBSTRING PERSONAL-NAME 0 IDX))
    (AND IDX (SETQ STR (STRING-APPEND (NSUBSTRING PERSONAL-NAME (+ IDX 2)) #\SP STR)))
    (VALUES HSNAME-PATHNAME PERSONAL-NAME GROUP-AFFILIATION STR)))

(DEFFLAVOR FILE-HOST-TOPS20-MIXIN () (FILE-HOST-MIXIN))

(DEFMETHOD (FILE-HOST-TOPS20-MIXIN :PATHNAME-FLAVOR) ()
  'TOPS20-PATHNAME)

(DEFMETHOD (FILE-HOST-TOPS20-MIXIN :LOGIN-UNIT)
	   (UNIT LOGIN-P &AUX (CONN (HOST-UNIT-CONTROL-CONNECTION UNIT)))
  ;; Connection is used up when logging out
  (AND CONN (EQ (CHAOS:STATE CONN) 'CHAOS:OPEN-STATE)
       (IF LOGIN-P
	   (LOGIN-HOST-UNIT UNIT LOGIN-P SELF)
	   (SETF (HOST-UNIT-CONTROL-CONNECTION UNIT) NIL)
	   (CHAOS:CLOSE CONN "Logging out")))
  T)

(DEFMETHOD (FILE-HOST-TOPS20-MIXIN :HSNAME-INFORMATION) (UNIT STR IDX)
  (LET* ((HSNAME (SUBSTRING STR (SETQ IDX (1+ IDX))
			    (SETQ IDX (STRING-SEARCH-CHAR #\CR STR IDX))))
	 (HSNAME-PATHNAME (FUNCALL-SELF ':HSNAME-PATHNAME HSNAME (HOST-UNIT-HOST UNIT)))
	 (PERSONAL-NAME (SUBSTRING STR (SETQ IDX (1+ IDX))
				   (SETQ IDX (STRING-SEARCH-CHAR #\CR STR IDX))))
	 (GROUP-AFFILIATION #\SP))
    (SETQ IDX (STRING-SEARCH ", " PERSONAL-NAME)
	  STR (NSUBSTRING PERSONAL-NAME 0 IDX))
    (AND IDX (SETQ STR (STRING-APPEND (NSUBSTRING PERSONAL-NAME (+ IDX 2)) #\SP STR)))
    (VALUES HSNAME-PATHNAME PERSONAL-NAME GROUP-AFFILIATION STR)))

(DEFMETHOD (FILE-HOST-TOPS20-MIXIN :HSNAME-PATHNAME) (STRING HOST)
  (PARSE-PATHNAME STRING HOST))

(DEFMETHOD (FILE-HOST-TOPS20-MIXIN :MAX-DATA-CONNECTIONS) () 8)

(DEFFLAVOR FILE-HOST-TENEX-MIXIN () (FILE-HOST-TOPS20-MIXIN))

(DEFMETHOD (FILE-HOST-TENEX-MIXIN :PATHNAME-FLAVOR) ()
  'TENEX-PATHNAME)

(DEFMETHOD (FILE-HOST-TENEX-MIXIN :HSNAME-PATHNAME) (STRING HOST)
  (MAKE-PATHNAME ':HOST HOST ':DEVICE "DSK" ':DIRECTORY STRING))

(DEFFLAVOR FILE-HOST-VMS-MIXIN () (FILE-HOST-TOPS20-MIXIN))

(DEFMETHOD (FILE-HOST-VMS-MIXIN :PATHNAME-FLAVOR) ()
  'VMS-PATHNAME)

;; FOO, This could be any number at all, depending on the quota assigned.....
(DEFMETHOD (FILE-HOST-VMS-MIXIN :MAX-DATA-CONNECTIONS) () 10.)

;; like TOPS-20 is a good guess
(DEFFLAVOR FILE-HOST-UNIX-MIXIN () (FILE-HOST-TOPS20-MIXIN))

(DEFMETHOD (FILE-HOST-UNIX-MIXIN :PATHNAME-FLAVOR) ()
  'UNIX-PATHNAME)

(COMMENT
(DEFFLAVOR FILE-HOST-MULTICS-MIXIN () (FILE-HOST-TOPS20-MIXIN))

(DEFMETHOD (FILE-HOST-MULTICS-MIXIN :PATHNAME-FLAVOR) ()
  'MULTICS-PATHNAME)
)

;;; This is here to make the COMPILE-FLAVOR-METHODS below win when loading.
;;; The actual function is in PEEKFS.
(DEFMETHOD (FILE-HOST-MIXIN :PEEK-FILE-SYSTEM) FILE-HOST-PEEK-FILE-SYSTEM)

;;; Predefined host flavors
(DEFFLAVOR ITS-CHAOS-HOST
	()
	(SI:HOST-ITS-MIXIN CHAOS:HOST-CHAOS-MIXIN FILE-HOST-ITS-MIXIN SI:HOST))

(SI:SET-HOST-FLAVOR-KEYWORDS 'ITS-CHAOS-HOST '(:ITS :CHAOS))

(DEFFLAVOR TOPS20-CHAOS-HOST
	()
	(SI:HOST-TOPS20-MIXIN CHAOS:HOST-CHAOS-MIXIN FILE-HOST-TOPS20-MIXIN SI:HOST))

(SI:SET-HOST-FLAVOR-KEYWORDS 'TOPS20-CHAOS-HOST '(:TOPS-20 :CHAOS))

(DEFFLAVOR TENEX-CHAOS-HOST
	()
	(SI:HOST-TENEX-MIXIN CHAOS:HOST-CHAOS-MIXIN FILE-HOST-TENEX-MIXIN SI:HOST))

(SI:SET-HOST-FLAVOR-KEYWORDS 'TENEX-CHAOS-HOST '(:TENEX :CHAOS))

(DEFFLAVOR VMS-CHAOS-HOST
	()
	(SI:HOST-VMS-MIXIN CHAOS:HOST-CHAOS-MIXIN FILE-HOST-VMS-MIXIN SI:HOST))

(SI:SET-HOST-FLAVOR-KEYWORDS 'VMS-CHAOS-HOST '(:VMS :CHAOS))

(DEFFLAVOR UNIX-CHAOS-HOST
	()
	(SI:HOST-UNIX-MIXIN CHAOS:HOST-CHAOS-MIXIN FILE-HOST-UNIX-MIXIN SI:HOST))

(SI:SET-HOST-FLAVOR-KEYWORDS 'UNIX-CHAOS-HOST '(:UNIX :CHAOS))

(COMPILE-FLAVOR-METHODS ITS-CHAOS-HOST TOPS20-CHAOS-HOST TENEX-CHAOS-HOST VMS-CHAOS-HOST
			UNIX-CHAOS-HOST)

(COMMENT ;Someday these systems may have file jobs

(DEFFLAVOR MULTICS-CHAOS-HOST
	()
	(SI:HOST-MULTICS-MIXIN CHAOS:HOST-CHAOS-MIXIN FILE-HOST-MULTICS-MIXIN SI:HOST))

(SI:SET-HOST-FLAVOR-KEYWORDS 'MULTICS-CHAOS-HOST '(:MULTICS :CHAOS))

(COMPILE-FLAVOR-METHODS MULTICS-CHAOS-HOST)
);COMMENT

;;; Pathname interface

(DEFFLAVOR CHAOS-PATHNAME () (REMOTE-PATHNAME))

;;; PATHNAME is supplied as an argument here so that the :PATHNAME message to the stream
;;; will return a logical pathname, if that is what was OPEN'ed.
(DEFMETHOD (CHAOS-PATHNAME :OPEN) (PATHNAME &REST OPTIONS)
  (OPEN-CHAOS HOST PATHNAME OPTIONS))

(DEFMETHOD (CHAOS-PATHNAME :RENAME) (NEW-PATHNAME &OPTIONAL (ERROR-P T))
  (RENAME-CHAOS HOST SELF NEW-PATHNAME ERROR-P))

(DEFMETHOD (CHAOS-PATHNAME :DELETE) (&OPTIONAL (ERROR-P T))
  (DELETE-CHAOS HOST SELF ERROR-P))

(DEFMETHOD (CHAOS-PATHNAME :COMPLETE-STRING) (STRING OPTIONS &AUX SUCCESS)
  (MULTIPLE-VALUE (STRING SUCCESS)
    (COMPLETE-CHAOS HOST SELF STRING OPTIONS))
  (VALUES (STRING-APPEND (FUNCALL HOST ':NAME-AS-FILE-COMPUTER) ": " STRING) SUCCESS))

(DEFMETHOD (CHAOS-PATHNAME :CHANGE-PROPERTIES) (ERROR-P &REST PROPERTIES)
  (CHANGE-PROPERTIES-CHAOS HOST SELF ERROR-P PROPERTIES))

(DEFMETHOD (CHAOS-PATHNAME :DIRECTORY-STREAM) (OPTIONS)
  (DIRECTORY-CHAOS HOST SELF OPTIONS))

(DEFMETHOD (CHAOS-PATHNAME :HOMEDIR) ()
  (HOMEDIR-CHAOS HOST))

;;; Perhaps this would be a reasonable default for the way all hosts should work?
(DEFMETHOD (CHAOS-PATHNAME :ALL-DIRECTORIES) (OPTIONS)
  (LET ((DIRS (FUNCALL-SELF ':DIRECTORY-LIST (CONS ':DIRECTORIES-ONLY OPTIONS))))
    (IF (STRINGP DIRS) DIRS
	(SETQ DIRS (CDR DIRS))
	(DOLIST (X DIRS)
	  (RPLACA X (FUNCALL (CAR X) ':NEW-PATHNAME ':NAME ':UNSPECIFIC ':TYPE ':UNSPECIFIC
			     ':VERSION ':UNSPECIFIC)))
	DIRS)))

(DEFMETHOD (CHAOS-PATHNAME :MULTIPLE-FILE-PLISTS) (FILES OPTIONS)
  (MULTIPLE-PLISTS-CHAOS HOST FILES OPTIONS))

(DEFMETHOD (CHAOS-PATHNAME :EXPUNGE) (&REST OPTIONS)
  (EXPUNGE-CHAOS HOST SELF OPTIONS))

(DEFFLAVOR ITS-PATHNAME () (ITS-PATHNAME-MIXIN CHAOS-PATHNAME))

(DEFFLAVOR TOPS20-PATHNAME () (TOPS20-PATHNAME-MIXIN CHAOS-PATHNAME))

(DEFFLAVOR TENEX-PATHNAME () (TENEX-PATHNAME-MIXIN CHAOS-PATHNAME)) 

(DEFFLAVOR VMS-PATHNAME () (VMS-PATHNAME-MIXIN CHAOS-PATHNAME))

(DEFFLAVOR UNIX-PATHNAME () (UNIX-PATHNAME-MIXIN CHAOS-PATHNAME))

(COMPILE-FLAVOR-METHODS ITS-PATHNAME TOPS20-PATHNAME TENEX-PATHNAME
			VMS-PATHNAME UNIX-PATHNAME)

(COMMENT
(DEFFLAVOR MULTICS-PATHNAME () (MULTICS-PATHNAME-MIXIN CHAOS-PATHNAME)) 

(COMPILE-FLAVOR-METHODS MULTICS-PATHNAME)
);COMMENT

;;; Initializations

;;; This defines all the local chaosnet FILE protocol hosts.
(DEFVAR *CHAOS-FILE-HOSTS* NIL)

(DEFUN SITE-CHAOS-PATHNAME-INITIALIZE ()
  ;; Flush all old hosts
  (SETQ *PATHNAME-HOST-LIST* (DEL-IF #'(LAMBDA (X)
					 (MEMQ X *CHAOS-FILE-HOSTS*))
				     *PATHNAME-HOST-LIST*))
  (SETQ *CHAOS-FILE-HOSTS* NIL)
  ;; And add new ones
  (DOLIST (HOST (SI:GET-SITE-OPTION ':CHAOS-FILE-SERVER-HOSTS))
    (ADD-CHAOSNET-FILE-COMPUTER HOST)))

(DEFUN ADD-CHAOSNET-FILE-COMPUTER (HOST)
  (SETQ HOST (SI:PARSE-HOST HOST))
  (OR (MEMQ HOST *PATHNAME-HOST-LIST*)
      (PUSH HOST *PATHNAME-HOST-LIST*))
  (OR (MEMQ HOST *CHAOS-FILE-HOSTS*)
      (PUSH HOST *CHAOS-FILE-HOSTS*))
  HOST)

(ADD-INITIALIZATION "SITE-CHAOS-PATHNAME-INITIALIZE"
		    '(SITE-CHAOS-PATHNAME-INITIALIZE) '(SITE))

;;; Send a LOGIN command to all open host units.  Called every time a user logs in or out.
(DEFUN FILE-LOGIN (LOGIN-P)
  (DOLIST (HOST *CHAOS-FILE-HOSTS*)
    (DOLIST (UNIT (FUNCALL HOST ':HOST-UNITS))
      (FUNCALL HOST ':LOGIN-UNIT UNIT LOGIN-P))))

(ADD-INITIALIZATION "File Login" '(FILE-LOGIN T) '(LOGIN))
(ADD-INITIALIZATION "File Logout" '(FILE-LOGIN NIL) '(LOGOUT))

(DEFUN FILE-SYSTEM-INIT ()
  (WITHOUT-INTERRUPTS
   (DO ((L *FILE-PENDING-TRANSACTIONS* (CDR L))
	(PKT))
       ((NULL L)
	(SETQ *FILE-PENDING-TRANSACTIONS* NIL))
     (AND (SETQ PKT (FILE-TRANSACTION-ID-PKT (CAR L)))
	  (CHAOS:RETURN-PKT PKT))))
  (DOLIST (HOST *CHAOS-FILE-HOSTS*)
    (FUNCALL HOST ':RESET)))

(ADD-INITIALIZATION "FILE-SYSTEM-INIT" '(FILE-SYSTEM-INIT) '(SYSTEM))