;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.79
;;; Reason:
;;;  Really implement *ftp-server-timeout* -- the number of seconds an idle FTP server
;;;  will stick around.
;;; Written 28-Oct-87 00:47:02 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.78, 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#68 at 28-Oct-87 00:47:11
#10R FTP#: 
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defvar *ftp-server-timeout* (* 60. 60.)
  "The time interval in seconds after which an idle FTP connection will time out.  
If NIL, then the connection never times out.")

))

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

(defun ftp-readline (telnet-stream)
  (flet ((getc ()
	   (when (process-wait-with-timeout "FTP command"
					    (and *ftp-server-timeout* (* 60. *ftp-server-timeout*))
					    #'(lambda (s)
						(send s :listen))
					    telnet-stream)
	     (send telnet-stream :tyi))))
    (catch 'eof-tag
      (with-output-to-string (s)
	(do ((c (getc) (getc))
	     (oldc 0))
	    ((eq c #o12))
	  (cond ((null c) (throw 'eof-tag nil)))
	  (cond ((or (= c telnet-iac) (= oldc telnet-iac) (= c #o15)))
		(t (send s :tyo c)))
	  (if (and (= c telnet-iac) (= oldc telnet-iac))
	      (setq oldc 0)
	    (setq oldc c)))))))

))