;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.43
;;; Reason:
;;;  FTP directory lists were returning non-standard plists -- if passed a file like
;;;  foo.bar#>, the plist would be for file foo.bar#12.  Make-system didn't like this.
;;; Written 8-Oct-87 14:37:35 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.42, 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#13 at 8-Oct-87 14:37: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-probe-stream :after :init) (&rest ignored)
  (when (ftp-directory-line-parserp host t)
    (cond ((string-search #\return raw-data)
	   (with-input-from-string (s raw-data)
	     (do ((dplist)
		  (new))
		 ((not (setq new (readline s nil))))
	       (when (car (setq dplist
				(ftp-parse-directory-list-line new host pathname)))
		 (return (setq si:property-list (cdr dplist)
			       truename (getf dplist :truename (car dplist))))))))
	  ('else
	   (let ((dplist (ftp-parse-directory-list-line raw-data host pathname)))
	     (setq si:property-list (cdr dplist))
	     (setq truename (getf dplist :truename (car dplist))))))))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; FTP-ACCESS.LISP#13 at 8-Oct-87 14:37:52
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "

(defun ftp-parse-directory-list-line (line host pathname)
  (let ((parser (ftp-directory-line-parserp host t))
	(trimmed-line (string-right-trim '(#\return) line)))
    (if parser
	(let ((p (funcall parser trimmed-line host pathname)))
	  (if (null (car p))
	      p
	    (append `(,pathname :truename) p)))
      (let ((p (parse-pathname trimmed-line host)))
	(list p :pathname p)))))

))