;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.76
;;; Reason:
;;;  Enhancements to (ftp:ftp)
;;;    - "ls" command's argument is now optional
;;;    - "lcd" command now does something useful -- sets local pathname defaults
;;;      so you don't need to specify host and directory when you "get" and "put"
;;;    - set transfer mode to ASCII before "ls", if not that already
;;;    - when you use the "16bit" command before a "get" or a "put", open the local
;;;      file in that mode and make sure that proper 8-to-16 or 16-to-8 bit
;;;      translation is done betwwen file and network.
;;;    - (change to server) default version is :wild for directory list and
;;;      :newest for file transfer -- "ls" now lists all versions, not just newest
;;; Written 27-Oct-87 15:59:58 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.75, 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#67 at 27-Oct-87 16:19:22
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defmethod (8b-to-16b-translating-output-stream :after :close) (&optional mode)
  (send output :close mode))

))

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

(defflavor 16b-to-8b-translating-output-stream
	 ((output nil)
	  (bytes 0))
	 (si:buffered-output-stream)
  (:initable-instance-variables output))

))

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

(defmethod (16b-to-8b-translating-output-stream :send-output-buffer) (array end)
  (let ((byte-count (* end 2)))
    (incf bytes byte-count)
    (send output
	  :string-out
	  (make-array byte-count :element-type 'string-char :displaced-to array)
	  0
	  byte-count))
  (global:deallocate-resource 'fs:simple-art-16b-buffer array))

))

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

(defmethod (16b-to-8b-translating-output-stream :after :close) (&optional mode)
  (send output :close mode))

))

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

(defmethod (16b-to-8b-translating-output-stream :bytes) ()
  bytes)

))

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

(defun sendrequest (cmd local remote)
  (prog (read_reply start stop bytes dout)
	(setq bytes 0)
	(unwind-protect
	    (progn (if (initconn :output) (go bad))
		   (setq read_reply t)
		   (unless (= (command "~A ~A" cmd remote) (sym prelim))
		     (setq read_reply nil)
		     (go bad))
		   (setq dout (dataconn :output))
		   (if (null dout) (go bad))
		   (when (eq *type* '16bit)
		     (setq dout (make-16b-to-8b-translating-output-stream dout)))
		   (with-open-stream (fin (if (eq *type* '16bit)
					      (open local :byte-size 16 :characters nil)
					    (open local)))
		     (setq start (time:time))
		     (global:stream-copy-until-eof fin dout)
		     (send dout :force-output)
		     (setq stop (time:time))
		     (setq bytes (send dout :bytes))))
	  (unless stop
	    (setq stop (time:time))
	    (when *data*
	      (close *data*)
	      (setq *data* nil))
	    (if dout (setq bytes (send dout :bytes)))))
	(close dout)
	(getreply nil)
     done
	(if (and (> bytes 0) *verbose*)
	    (ptransfer "sent" bytes start stop))
	(return nil)
     bad
	(if read_reply (getreply nil))
	(go done)))

))

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

(defcmd cmd-lcd (&optional local-directory)
  "change local working directory"
  (let* ((defaults (fs:make-pathname-defaults))
	 (colon (string-search-char #\: local-directory))
	 (host (if colon (si:parse-host (substring local-directory 0 colon) t) si:local-host))
	 (pathname (fs:parse-pathname local-directory host defaults (if colon (1+ colon) 0))))
    (fs:set-default-pathname pathname)
    (format t "~&Local pathname default now ~A.~%" pathname)
    pathname))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#67 at 27-Oct-87 17:39:23
#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
					      (send (ftpstate-homedir-pn state) :host))))))
	(fs:merge-pathname-components parsed
				      (ftpstate-pn-defaults state)
				      :default-name :wild
				      :default-type :wild
				      :default-version (if directory-p :wild :newest)))
    (error sig)))

))

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

(defun ftp-retrieve (state name directory-p)
  "Get a file from the local TCP host (modulo chaosnet file servers)
   and send it to the ftp user.  This is also used for getting directory listings."
  (if (not name) 
      (if directory-p
	  (setq name (fs:default-pathname (ftpstate-pn-defaults state)))
	(error "FTP-RETRIEVE called with NULL filename.~%")))
  (unless (and (not (pathnamep name))
	       (ftp-pathname-error-reply state (setq name (ftp-parse-pathname state name directory-p))))
    (ftp-file-error-reply state (ftp-file-operation state #'ftp-retrieve-1
							    state name directory-p))))

))

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

(defun recvrequest (cmd local remote)
  "local is a string describing the local place to put the
requested data. remote is a remote description."
  (prog (read_reply start stop bytes din fout)
	(setq bytes 0)
	(unwind-protect
	    (progn (if (initconn :input) (go bad))
		   (setq read_reply t)
		   (let ((x (if remote (command "~A ~A" cmd remote) (command cmd))))
		     (cond ((not (= x (sym prelim)))
			    (setq read_reply nil)
			    (go bad))))
		   (setq din (dataconn :input))
		   (if (not din) (go bad))
		   (setq fout (if local
				  (if (eq *type* '16bit)
				      (make-8b-to-16b-translating-output-stream
					(open local :direction :output :byte-size 16 :characters nil))
				    (open local :direction :output))
				*standard-output*))
		   (setq start (time:time))
		   (global:stream-copy-until-eof din fout)
		   (setq stop (time:time))
		   (setq bytes (send din :bytes)))
	  (unless stop
	    (setq stop (time:time))
	    (when *data*
	      (close *data*)
	      (setq *data* nil))
	    (if din (setq bytes (send din :bytes))))
	  (when fout
	    (unless (eq fout *standard-output*)
	      (close fout))))
	(getreply nil)
     done
	(if (and (> bytes 0) *verbose*)
	    (ptransfer "received" bytes start stop))
	(return nil)
     bad
	(if read_reply (getreply nil))
	(go done)))

))

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

(defcmd (cmd-ls cmd-dir) (&optional remote-directory local-file)
  "list contents of remote directory"
  (unless (eq *type* 'ascii)
    (cmd-ascii))
  (recvrequest "LIST" local-file remote-directory))

))