;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.93
;;; Reason:
;;;  Now that Ftp User reads and ignores bogus extra replies from the server,
;;;  ftp:command-1 needs to allow for the case of the server having closed
;;;  the connection.
;;; Written 4-Nov-87 12:56:11 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.91, 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.USER; FTP.LISP#38 at 4-Nov-87 12:56:14
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP  "

(defun command-1 (command-string)
  (catch 'lostpeer
    (do ()
	((not (send *control* :listen)))
      ;;Server has a bug -- shouldn't be extra replies here!
      (let ((string (make-array 75 :element-type 'string-char :fill-pointer 0 :adjustable t)))
	(copy-array-contents "BUG: " string)
	(setf (fill-pointer string) 5)
	(do ((c nil))
	    ((eq c #\return))
	  (setq c (send *control* :tyi))
	  (when (null c) (lostpeer))
	  (unless (eq c (sym cr))
	    (when (eq c (sym lf))
	      (setq c #\return))
	    (vector-push c string)))
	(when *verbose*
	  (format t "~&~A" string))
	(unless (eq *history* :dont-record)
	  (push string *history*))))
    
    (if *debug* (format t "~&---> ~A~%" command-string))
    (unless *control*
      (and *debug* (format *error-output* "~&No control connection for command~%"))
      (return-from command-1 0))
    (unless (eq *history* :dont-record)
      (push (string-append "" command-string) *history*))
    (send *control* :string-out command-string)
    (send *control* :tyo (sym cr))
    (send *control* :tyo (sym lf))
    (send *control* :force-output)
    (getreply (if (string-equal command-string "QUIT")
		  (if *ignore-reply-from-quit*
		      (return-from command-1 nil)
		    t)))
    ))

))