;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.53
;;; Reason:
;;;  Whenever FTP Server includes a pathname in a reply (login and xpwd),
;;;  put it in quotes so user can parse it easily.
;;; Written 16-Oct-87 13:19:13 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.SERVER; FTP.LISP#64 at 16-Oct-87 13:19:15
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-xpwd (state)
  (let ((fs:*defaults-are-per-host* nil))
    (ftp-reply state 251 "\"~A\" is the current default pathname." 
	       (fs:default-pathname (ftpstate-pn-defaults state)))))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#64 at 16-Oct-87 13:20:45
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-login (state user host-object password homedir)
  (cond ((not (ftp-valid-lm-password-p user password host-object))
	 (ftp-reply state 530 "Login incorrect.")
	 nil)
	(t
	 (ftp-reply state 230 "User ~A~A logged in (default pathname = \"~A\")."
		    user
		    (cond ((eq host-object si:local-host) "")
			  (t (format nil "@~A" (send host-object :name)) ""))
		    homedir)
	 (fs:set-default-pathname (setf (ftpstate-homedir-pn state) homedir)
				  (setf (ftpstate-pn-defaults state) (fs:make-pathname-defaults)))
	 (setf (ftpstate-logged-in-p state) t)
	 t)))

))