;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.100 ;;; Reason: ;;; Changes to FTP-ACCESS: ;;; - Always forget working directory when you :close-control-connection ;;; - Back to running with fs:*ftp-probe-before-open-p* set to NIL: ;;; - Even though it uses two host-units (one to open file, one to probe), ;;; when you load a series of files, all the QFASL's come on one, all ;;; the probes go on the other, and we don't constantly send "TYPE A" ;;; and "TYPE L 16" commands to switch transfer types. ;;; - looks better on wholine ;;; Change to Server FTP: ;;; - Don't time out the Control connection if there is a data transfer in ;;; progress (the recipient could have been sitting in error handler for ;;; an hour, say. Don't close up the connection on him.) ;;; Written 4-Nov-87 21:18:51 by pld at site LMI Cambridge ;;; while running on Jack Flanders from band 2 ;;; with Experimental System 123.99, 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-ACCESS.LISP#37 at 4-Nov-87 21:20:03 #10R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  " (defmethod (ftp-host-unit :real-login) (login-p uname-host) (lock-host-unit (self) (cond (login-p (do ((need-password? nil t)) (nil) (multiple-value-bind (username password) (fs:determine-user-id-and-password uname-host host need-password?) (when (ftp:cmd-user username password) (setq ftp:*user* nil) ;Don't leave these visible in host unit (setq ftp:*pass* nil) (setq ftp:*acct* nil) (return)) (when need-password? ;; The password we used must have been wrong, so forget ;; it and force the system to prompt for a new one. (forget-password username host))) ;; Since this password is wrong, flush it (unless catch-login-problems-p (send self :ftp-error "trying to login" nil)))) ((send self :open-control-connection-p) (send self :close-control-connection))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#37 at 4-Nov-87 21:20:08 #10R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  " (defmethod (ftp-host-unit :close-control-connection) () ;; Close connection, for logging out (ftp:cmd-close) (setq working-directory nil) (setq ftp:*history* nil)) )) ; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#37 at 4-Nov-87 21:20:43 #10R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  " (defmethod (ftp-host-unit :reset) (&optional dont-unlock-lock-p) ;; Close all data streams in abort mode, close control connection dont-unlock-lock-p ;; we think we can ignore this. (when file-stream (send file-stream :close :abort)) (send self :close-control-connection) (send self :free)) )) ; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#37 at 4-Nov-87 21:24:29 #10R FILE-SYSTEM#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  " (defvar *ftp-probe-before-open-p* nil "If T then probe-stream before opening") )) ; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#76 at 4-Nov-87 21:34:24 #10R FTP#: #!:CL (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  " (defun ftp-readline (state) (flet ((getc (&aux (telnet-stream (ftpstate-ctrl-stream state))) (loop (when (process-wait-with-timeout "FTP command" (and *ftp-server-timeout* (* 60. *ftp-server-timeout*)) #'(lambda (s) (send s :listen)) telnet-stream) ;;:listen returned non-NIL -- return what :tyi returns (return (send telnet-stream :tyi))) (unless (ftpstate-data-transfer-in-progress state) ;;:listen returned NIL -- timeout. If control connection idle, return NIL (return nil))))) (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))))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#76 at 4-Nov-87 21:34:54 #10R FTP#: #!:CL (COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP"))) (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  " (defun ftp-cmdparse (state) (let ((cmdline (ftp-readline state)) cmd arg) (cond ((not cmdline) (ftp-reply state 221 "You could at least say goodbye.") nil) (t (push cmdline (ftpstate-cmd-reply-history state)) (setq cmd (ftp-cmd-from-string cmdline)) (if (and (ftpstate-data-transfer-in-progress state) (not (eq cmd 'abor))) (process-wait "wait for data transfer" #'(lambda nil (not (ftpstate-data-transfer-in-progress state))))) (setf (ftpstate-current-cmd state) cmd) (setq arg (ftp-first-cmd-arg cmdline (member cmd ftp-allow-spaces-in-arg-cmdlist :test #'eq))) (cond ((and (ftpstate-next-cmd state) (not (eq cmd 'rein)) (not (eq cmd 'quit)) (not (eq cmd (ftpstate-next-cmd state)))) (ftp-reply state 503 "Bad sequence of commands.") (setf (ftpstate-next-cmd state) nil)) ((stringp cmd) (ftp-reply state 500 "~A command unrecognized" cmd)) ((member cmd ftp-unimplemented-cmdlist :test #'eq) (ftp-not-implemented state cmd)) ((and (not (ftpstate-logged-in-p state)) (member cmd ftp-logged-in-cmdlist :test #'eq)) (ftp-reply state 530 "Not logged in.")) ((and (or (not arg) (zerop (length arg))) (member cmd ftp-require-arg-cmdlist :test #'eq)) (ftp-reply state 501 "Syntax error: missing argument.")) (t (funcall (get cmd 'ftp-server-handle) state arg cmdline))) (not (eq cmd 'quit)))))) ))