;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 123.67
;;; Reason:
;;;  Release 3.0 FTP doesn't seem to return creation date/time and author in directory
;;;  listing.  This was screwing up fs:lmi-lispm-directory-line-parser.  It should now
;;;  coexist with either release 3.0 or 4.0 -- you just don't get the additional
;;;  properties when talking to 3.0 hosts.
;;; Written 22-Oct-87 14:58:27 by pld at site LMI Cambridge
;;; while running on Jack Flanders from band 2
;;; with Experimental System 123.66, 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#27 at 22-Oct-87 14:58:28
#10R FILE-SYSTEM#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "FILE-SYSTEM")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; FTP-ACCESS  "

(defun lmi-lispm-directory-line-parser (line host pathname &aux start end endn p temp pn)
  (cond ((string-equal "Free=" line :end2 5)
	 (list nil :disk-space-description line))
	((or (< (string-length line) 40)
	     (not (or (memq (aref line 0) '(#\space #\tab))
		      (when (and (= (aref line 0) #/D)
				 (memq (aref line 1) '(#\space #\tab)))
			(setq line (substring line 1))
			(setf (getf p :deleted) t)
			t))))
	 nil)
	('else
;;      A.TEXT         #5   6   5475(8)  !   03/15/85 19:52:04 possibleauthor
	 (setq start 0)
	 (do ((j 0 (1+ j))
	      (n (length line))
	      (slashp nil)
	      (after#p nil))
	     ((= j n) (return-from lmi-lispm-directory-line-parser nil))
	   (cond (after#p
		  (cond ((digit-char-p (aref line j)))
			('else
			 (return (setq end j)))))
		 (slashp
		  (setq slashp nil))
		 ((= (aref line j) #//)
		  (setq slashp t))
		 ((= (aref line j) #\#)
		  (setq after#p t))))
	 (setq pn (send (parse-pathname line host pathname start end)
			:new-directory (send pathname :directory)))
	 (multiple-value (start end) (string-find-token line end))
	 (setf (getf p :length-in-blocks) (parse-integer line :start start :end end))
	 (multiple-value (start end) (string-find-token line end))
	 (cond ((digit-char-p (aref line start))
		(multiple-value (temp endn) (parse-integer line :start start :end end :junk-allowed t))
		(setf (getf p :length-in-bytes) temp)
		(setq start (1+ endn))
		(multiple-value (temp endn) (parse-integer line :start start :end end :junk-allowed t))
		(setf (getf p :byte-size) temp))
	       ((string-equal "DIRECTORY" line :start2 start :end2 end)
		(setf (getf p :directory) t)))
	 (when (setq temp (string-search-set "0123456789" line end))
	   ;;Release 3.0 Lambda's don't give you the creation date or author
	   (multiple-value (start end) (string-find-token line temp))
	   (multiple-value (temp end) (string-find-token line end))
	   (setf (getf p :creation-date) (time:parse-universal-time line start end))
	   (unless (when ( end (length line))
		     ;; the author field wont show up if it is the same as the userid.
		     (multiple-value (start end) (string-find-token line end))
		     (when start
		       (setf (getf p :author) (substring line start end))))
	     (and (setq temp (send host :access))
		  (setq temp (send temp :host-units))
		  (setq temp (delq nil (mapcar #'(lambda (x)
						   (and (typep x 'ftp-host-unit)
							(symeval-in-instance
							  x 'ftp:*user*)))
					       temp)))
		  (setf (getf p :author) (car temp)))))
	 (setf (getf p :characters)
	       (cond ((getf p :directory)
		      nil)
		     ((not (= (getf p :byte-size) 8))
		      nil)
		     ('else
		      (kludge-ftp-characterp pn nil))))
	 (cons pn p))))

))
