;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.127
;;; Reason:
;;;  In user FTP, the argument for the "cd" command is now optional (if omitted, the server
;;;  changes to home directory).  In server FTP, fix bug in CWD command that caused
;;;  (fs:merge-and-set-pathname-defaults) to be called twice.  Fix bug in (ftp-parse-pathname)
;;;  that caused your local host to be merged in even if you've specified another one with
;;;  a CD command.
;;; Written 30-Nov-87 10:08:59 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.126, Experimental Local-File 73.3, Experimental FILE-Server 22.1, 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.LISP#41 at 30-Nov-87 10:09:30
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP  "

(defcmd cmd-cd (&optional remote-directory) t
  "change remote working directory"
  (commandp (sym complete) "CWD~@[ ~A~]" remote-directory))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#77 at 30-Nov-87 10:09:51
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-cwd (state name)
  (if (not name) (setq name (ftpstate-homedir-pn state)))
  (unless (and (not (pathnamep name))
	       (ftp-pathname-error-reply state (setq name (ftp-parse-pathname state name))))
    (unless (ftp-file-error-reply state (ftp-file-operation state 
							    #'fs:merge-and-set-pathname-defaults
							    name
							    (ftpstate-pn-defaults state)))
      (ftp-ack state))))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#77 at 30-Nov-87 10:09:57
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-parse-pathname (state name &optional directory-p)
  (global:condition-case-if ftp-catch-errors (sig)
      (let ((fs:*defaults-are-per-host* nil)
	    (fs:*always-merge-type-and-version* nil)
	    (fs:*name-specified-default-type* :lisp)
	    (parsed (fs:parse-pathname name
				       (cond ((global:get-site-option :ftp-disallow-nonlocal-access)
					      si:local-host)
					     ((string-search ":" name)
					      nil)
					     (t
					      (caar (ftpstate-pn-defaults state)))))))
	(fs:merge-pathname-components parsed
				      (ftpstate-pn-defaults state)
				      :default-name :wild
				      :default-type :wild
				      :default-version (if directory-p :wild :newest)))
    (error sig)))

))