;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.35
;;; Reason:
;;;  After a FTP host unit is logged into remote host, forget the user name and password.
;;;  We don't want them easily visible from Peek...
;;; Written 7-Oct-87 12:01:35 by pld (Peter L. DeWolf) at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.34, 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#11 at 7-Oct-87 15:11:12
#10R FILE-SYSTEM#: #!:ZL
(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
	     (when (get host :extra-reply-after-failed-login)
	       ;; the 4.2BSD server host we have sends an extra reply
	       ;; here. The Unix User FTP attempts to flush such extra input
	       ;; received after a getreply, but even that fails because
	       ;; of timing screws, doing a :LISTEN and sleeping
	       ;; to see if some losing server is going to send extra
	       ;; garbage just doesnt make sense.
	       (sleep 1 "unix wait")
	       (when (send ftp:*cin* :listen)
		 (send ftp:*cin* :tyi)
		 (send ftp:*cin* :clear-input)))
	     (unless catch-login-problems-p
	       (send self :ftp-error "trying to login" nil))))
	  ((send self :open-control-connection-p)
	   (ftp:cmd-close)))))

))