;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.87
;;; Reason:
;;;  Berkeley Unix 4.2 has a bug in its FTP Server:  If you try to log in as an
;;;  unknown user, it sends two replies: a preliminary "2xx Password required"
;;;  followed by a "5xx User <foo> unknown".  Our FTP User can get around this
;;;  by skipping any replies waiting on the control connection before sending
;;;  out each command.
;;; Written 30-Oct-87 17:42:17 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.86, 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#36 at 30-Oct-87 17:45:45
#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)
  (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))
	(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)))
  )

))