;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.55
;;; Reason:
;;;  FTP-HOST-UNIT now stores user home directory and simply returns stored
;;;  value on :homedir operations rather than issuing a new XPWD command
;;;  each time.  Since we never do a CWD operation, this is cool.
;;; Written 16-Oct-87 14:10:44 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.52, 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.USER; FTP-ACCESS.LISP#20 at 16-Oct-87 14:10:50
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defflavor ftp-host-unit
	   ((ftp:*auto-login* nil)
	    (ftp:*trace* *ftp-host-unit-debug*)
	    (ftp:*hash* *ftp-host-unit-debug*)
	    (ftp:*sendport* t)
	    (ftp:*verbose* *ftp-host-unit-debug*)
	    (ftp:*debug* *ftp-host-unit-debug*)
	    (ftp:*bell* nil)
	    (ftp:*glob* t)
	    (ftp:*prompt* nil)
	    ftp:(*type* 'ascii)
	    ftp:(*struct* 'file)
	    ftp:(*form* 'non-print)
	    ftp:(*mode* 'stream)
	    (ftp:*bytesize* 8.)
	    (ftp:*user* nil)
	    (ftp:*pass* nil)
	    (ftp:*acct* nil)
	    (ftp:*history* nil)
	    (ftp:*connected* nil)
	    (ftp:*remote-hostname* nil)
	    (ftp:*cin* nil)
	    (ftp:*cout* nil)
	    (ftp:*data* nil)
	    (reserve-lock (LIST NIL))
	    (file-stream nil)
	    (working-directory))
	   (basic-host-unit)
  :special-instance-variables)

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#20 at 16-Oct-87 14:11:05
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "


(defmethod (ftp-host-unit :homedir) (user)
  (setq working-directory
	(cond (working-directory)
	      ((ftp:cmd-pwd)
	       (let ((s (ftp:last-reply))
		     (start)
		     (end)
		     (homepath))
		 (cond ((and (setq start (string-search-char #/" s))
			     (setq end (string-search-char #/" s (1+ start)))
			     (setq homepath (fs:parse-pathname s
							       host
							       *default-pathname-defaults*
							       (1+ start)
							       end
							       t)))
			homepath)
		       ('else
			(send (send host :sample-pathname) :new-directory user)))))
	      ('else
	       (send (send host :sample-pathname) :new-directory user)))))



))