;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.85
;;; Reason:
;;;  Server FTP sends a "150 Opening data connection" before it tries to open the
;;;  connection.  It shouldn't -- if the open fails it needs to send an error
;;;  "425 Can't open data connection" instead.
;;; Written 29-Oct-87 12:47:28 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.84, 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#72 at 29-Oct-87 12:54:32
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-retrieve-1 (state pn directory-p &aux os is)
  (setq is (cond (directory-p
		  (or (send pn :name) (setq pn (send pn :new-name :wild)))
		  (setq pn (fs:merge-pathname-components
			     pn
			     (ftpstate-pn-defaults state)
			     :default-type :wild
			     :default-version :wild))
		  (cond ((member directory-p '(:name-list :directory-list) :test #'eq)
			 (fs:directory-list-stream pn))
			(t (zwei:directory-input-stream pn :deleted))))
		 (t (open pn
			  :characters (eq (ftpstate-transfer-type state) :ascii)
			  :byte-size (ftpstate-byte-size state)))))
  (setq os (get-ftp-data-connection state
				    (send is :send-if-handles :truename)
				    (send is :send-if-handles :length)
				    :output))
  (when (streamp os)
    (ftp-send-data state is os directory-p)))

))

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

(defun ftp-store-1 (state pn mode &aux os is)
  "Write a file to the local TCP host (modulo chaosnet file servers)
    Mode can be any keyword acceptable for the :IF-EXISTS option to OPEN."
  (setq os (open pn
		 :characters (eq (ftpstate-transfer-type state) :ascii)
		 :byte-size (ftpstate-byte-size state)
		 :if-exists mode
		 
;;; not used, so commented out for release 3.0, should implement this
;;; in our local file system then use it.
;;;	:ESTIMATED-LENGTH (PROG1 (FTPSTATE-ESTIMATED-LENGTH STATE)  
;;;			      (SETF (FTPSTATE-ESTIMATED-LENGTH STATE) NIL))
		 
		 :direction :output))
  (setq is (get-ftp-data-connection state
				    (send os :send-if-handles :truename)
				    nil
				    :input))
  (when (streamp is)
    (ftp-receive-data state is os)))

))

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

(defun make-ftp-data-connection (state name size mode)
  mode
  (global:condition-case-if ftp-catch-errors (sig)
      (progn
	(setf (ftpstate-data-my-address state) (send (ftpstate-ctrl-stream state) :local-address))
	(setf (ftpstate-data-my-port state) (sym tcp-application:ipport-ftp-data))
	(setf (ftpstate-data-stream state) (tcpa:open-easy-tcp-stream (ftpstate-data-his-address state)
								      (ftpstate-data-his-port state)
								      (ftpstate-data-my-port state)
								      :keyword "FTP Data Connection"))
	(ftp-reply state 150
		   "Opening data connection ~A(~A,~D)~A"
		   (if name (format nil "for ~A " name) "")
		   (canonical-ip (ftpstate-data-his-address state))
		   (ftpstate-data-his-port state)
		   (if size (format nil " (~D bytes)" size) ""))
	t)
    (error
      (let ((string (send sig :report-string)))
	(tv:notify nil "FTP SERVER DATA CONNECTION ERROR on ~S ~D: ~A"
		   (canonical-ip (ftpstate-data-his-address state))
		   (ftpstate-data-his-port state)
		   string)
	(ftp-reply state 425 "Can't open data connection: ~A" string))
      nil)))
))