;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.61
;;; Reason:
;;;  User and Server FTP had code to Expunge Directories -- but FTP-ACCESS didn't use it.
;;;  Also soup up the preexisting code to return the number of blocks freed.
;;; Written 20-Oct-87 16:57:58 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Don't-dump-a-band! Inconsistent (unreleased patches loaded) System 123.60, 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#22 at 20-Oct-87 16:58:06
#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 :expunge) (pathname error)
  (command-using-unit (unit error)
    (ftp-access-operation pathname unit :expunge (send pathname :string-for-host))))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#22 at 20-Oct-87 16:58: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-host-unit :expunge) (x)
  (ftp:cmd-expunge x))

))

; From modified file DJ: L.NETWORK.IP-TCP.SERVER; FTP.LISP#65 at 20-Oct-87 17:21:14
#10R FTP#: #!:CL
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; SERVER; FTP  "

(defun ftp-expungedir (state &optional (name (fs:default-pathname (ftpstate-pn-defaults state))) &aux result)
  (unless (ftp-pathname-error-reply state (setq name (ftp-parse-pathname state name)))
    (unless (ftp-file-error-reply state (setq result (ftp-file-operation state #'fs:expunge-directory name)))
      (ftp-reply state 200 "~A blocks freed" result))))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP.LISP#26 at 20-Oct-87 17:27:11
#10R FTP#: #!:CL
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "FTP")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP  "


(defcmd cmd-expunge (remote-directory)
  "expunge the contents of a directory"
  (let ((success (commandp (sym complete) "XPNG ~A" remote-directory)))
    (when success
      (let* ((reply (last-reply))
	     (start (and reply (string-search-char #\space reply)))
	     (blocks-freed (and start (parse-integer reply :start start :junk-allowed t))))
	(or blocks-freed 0)))))

))