;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 124.13
;;; Reason:
;;;  Forgot a whostate in FTP-ACCESS.  Also add some protection to ensure
;;;  host units get freed if you abort while TCP connections are closing.
;;; Written 31-May-88 14:15:45 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 2
;;; with Experimental System 124.10, Experimental Local-File 74.0, Experimental File-Server 23.0, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.0, Experimental Lambda-Diag 16.0, microcode 1756, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#47 at 31-May-88 14:15:51
#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))
  (unwind-protect
      (send self :close-control-connection)
    (send self :free)))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#47 at 31-May-88 14:16: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-file-stream-mixin :after :close) (&optional abortp)
  (unless (eq status :closed)
    (unwind-protect
	(let ((tcp:*tcp-stream-whostate* "Close"))
	  (send actual :close abortp))
      (send host-unit :remove-file-stream self)
      (send host-unit :close-dataconn)
      (send host-unit :free)
      (setq status :closed))))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#47 at 31-May-88 14:24:10
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "

(defmethod (ftp-access :homedir) (user)
  (command-using-unit (unit t)
    (let ((tcp:*tcp-stream-whostate* "Home Directory"))
      (send unit :homedir user))))

))
