;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.88
;;; Reason:
;;;  Changes to User FTP, Server FTP, and FTP-ACCESS:
;;;    - the latest spec lists several commands that we previously knew as Berkeley Unix
;;;      extension: XMKD --> MKD, XRMD --> RMD, XPWD --> PWD, XCUP --> CDUP.
;;;      Our server now provides each command under both names, and our user
;;;      tries the official name first, and the old extension if that fails.
;;;    - The ABOR command is supposed to abort the data connection (if present)
;;;      and send a 4xx reply -- and then always send a 2xx reply to acknowledge
;;;      the ABOR command.  It now does so.
;;;    - When we reset a host-unit and log-out the control connection, reset the
;;;      save working directory.
;;; Written 31-Oct-87 14:11:01 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.87, 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#75 at 31-Oct-87 14:11:11
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "


(defparameter ftp-cmdlist '(user pass acct cwd  cdup smnt quit
				 rein port pasv type stru mode
				 retr stor stou appe allo rest
			    rnfr rnto abor dele rmd  mkd  pwd
			    list nlst site syst stat help noop
			    xlst xmkd xrmd xpwd xcup xpng xund
			    mlfl mail msnd msom msam srsq mrcp 
			    ))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:27
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(setf (get 'cdup 'ftp-help) "")

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:34
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(setf (get 'mkd 'ftp-help) " <pathname>")

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:36
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(setf (get 'pwd 'ftp-help) "")

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:46
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "


(defparameter ftp-unimplemented-cmdlist '(acct smnt stou rest rmd site syst stat
					  mlfl mail msnd msom msam srsq mrcp xrmd))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:48
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defparameter ftp-logged-in-cmdlist '(cwd  cdup port pasv retr stor appe allo rnfr rnto abor
				      dele rmd  mkd  pwd  list nlst
				      xlst xmkd xrmd xpwd xcup xpng xund))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:49
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defparameter ftp-require-arg-cmdlist '(user port type stru mode retr stor appe rnfr rnto
					dele mkd  xmkd xund))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:50
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defparameter ftp-allow-spaces-in-arg-cmdlist '(pass retr stor appe rnfr rnto dele cwd
						list nlst mkd  xlst xmkd xpng xund))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:52
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "


(defun (:property mkd ftp-server-handle) (state arg cmdline) cmdline
  (ftp-makedir state arg))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:54
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "


(defun (:property pwd ftp-server-handle) (state arg cmdline) arg cmdline
  (ftp-xpwd state))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:11:55
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "


(defun (:property cdup ftp-server-handle) (state arg cmdline) arg cmdline
  (ftp-xcup state))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#75 at 31-Oct-87 14:12:38
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-help (state cmdstring &aux cmd)
  (cond (cmdstring
	 (setq cmd (ftp-cmd-from-string cmdstring))
	 (if (symbolp cmd)
	     (if (member cmd ftp-unimplemented-cmdlist :test #'eq)
		 (ftp-reply state 214 "~A unimplemented." cmd)
	       (ftp-reply state 214 "Syntax: ~A~A." cmd (get cmd 'ftp-help)))
	   (ftp-reply state 504 "Unknown command ~A." cmd)))
	(t
	 (ftp-reply state nil 
		    "214-The following commands are recognized (* =>'s unimplemented).")
	 
	 (zl:loop for l on ftp-cmdlist by #'(lambda (l) (nthcdr 6 l))
		  while l
		  do (ftp-reply state nil
				(apply #'string-append
				       "    "
				       (zl:loop for x in l
						for count from 1 to 6
						collect (format nil "~A~4A" 
								(if (member x ftp-unimplemented-cmdlist
									      :test #'eq)
								    " *"
								  "  ")
								x))))
		  finally (ftp-reply state 214 "Direct comments to ~A."
				     (or (global:get-site-option :ftp-server-administrator)
					 *ftp-server-administrator*))))))

))

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

(defun (:property abor ftp-server-handle) (state arg cmdline) arg cmdline
  (if (ftpstate-data-transfer-in-progress state)
      (ftp-reply state 426 "Connection closed, transfer aborted."))
  (ftp-reply state 226 "Abort command complete.")
  (ftp-cleanup-data-connection state t))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP.LISP#37 at 31-Oct-87 14:30:54
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP  "

	    
(defcmd cmd-pwd () t
  "print working directory on remote machine"
  (unless (commandp (sym complete) "PWD")
    (commandp (sym complete) "XPWD")))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP.LISP#37 at 31-Oct-87 14:30:55
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP  "


(defcmd cmd-mkdir (remote-directory) t
   "make a directory on remote machine"
   (unless (commandp (sym complete) "MKD ~A" remote-directory)
     (commandp (sym complete) "XMKD ~A" remote-directory)))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP.LISP#37 at 31-Oct-87 14:30:56
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP  "


(defcmd cmd-rmdir (remote-directory) t
  "remove a directory on remote machine"
  (unless (commandp (sym complete) "RMD ~A" remote-directory)
    (commandp (sym complete) "XRMD ~A" remote-directory)))

))