commit - 5b4636cd1721d8606502faafe3c12549804218d2
commit + 7a89af2b85e5db320ff2be364cb6c0cc0473663d
blob - ea8ff58b10055c676a249c542390c00a1f30e6ae
blob + 3694302a78c07ac89a56bc281f3674da48acc231
--- regress/lisp/9p-test/client.lisp
+++ regress/lisp/9p-test/client.lisp
(path-fid (open-path stream saved-root-fid path)))
(9p-remove stream path-fid)
(read-all-pending-message stream)))
+
+
+(defun open-directory (stream root-fid path)
+ (let* ((root-fid-cloned (clone-fid stream root-fid))
+ (path-fid (open-path stream root-fid-cloned path)))
+ path-fid))
+
+(defun read-directory (stream dir-fid &optional (offset 0))
+ (let* ((stat-size nil)
+ (stat-size-bytes nil)
+ (rstat nil))
+ (9p-read stream
+ dir-fid
+ offset 2
+ :callback (lambda (x data)
+ (declare (ignore x))
+ (setf stat-size-bytes (subseq data 4))
+ (setf stat-size (9p-client::bytes->int stat-size-bytes))))
+ (read-all-pending-message stream)
+ (when (> stat-size 0)
+ (9p-read stream
+ dir-fid
+ (+ offset 2) stat-size
+ :callback (lambda (x data)
+ (declare (ignore x))
+ (setf rstat (decode-rstat (concatenate '(vector (unsigned-byte 8))
+ stat-size-bytes
+ (subseq data 4))))))
+ (read-all-pending-message stream)
+ (values dir-fid rstat (+ offset 2 stat-size)))))
+
+(defun sort-dir-stats (data &optional (fn (lambda (a b) (string< (stat-name a) (stat-name b)))))
+ (sort data fn))
+
+(defun collect-directory-children (stream root-fid path)
+ (let* ((dir-fid (open-directory stream root-fid path))
+ (dir-stats '()))
+ (loop named collecting-loop
+ with stat-size = 0
+ do
+ (multiple-value-bind (next-dir-fid stat next-stat-size)
+ (read-directory stream dir-fid stat-size)
+ (if next-dir-fid
+ (progn
+ (push stat dir-stats)
+ (setf stat-size next-stat-size))
+ (return-from collecting-loop t))))
+ (sort-dir-stats dir-stats)))
blob - 9ff536f59932fba86a87b0efc5477834bc74f66d
blob + e093d2591e9e2646b980e5c57f1738978d10ace4
--- regress/lisp/9p-test/package.lisp
+++ regress/lisp/9p-test/package.lisp
:mount
:open-path
:slurp-file
- :remove-path))
+ :remove-path
+ :open-directory
+ :read-directory
+ :sort-dir-stats
+ :collect-directory-children))
blob - 1190851db44539763d41766fae2de01050c58914
blob + 1aa043ca7cf17ea54c056ec6e78bae762a5754d5
--- regress/lisp/9p-test/tests/kami-tests.lisp
+++ regress/lisp/9p-test/tests/kami-tests.lisp
(deftest test-remove-directory ((kami-suite) (test-remove-file))
(assert-true
(ignore-errors (%remove-path (filesystem-utils:parent-dir-path +create-path+)))))
+
+(defun read-dir-same-offset (dir-path &optional (root "/"))
+ (with-open-ssl-stream (stream
+ socket
+ *host*
+ *port*
+ *client-certificate*
+ *certificate-key*)
+ (let* ((*messages-sent* ())
+ (root-fid (mount stream root))
+ (root-fid-cloned (clone-fid stream root-fid))
+ (dir-fid (open-path stream root-fid-cloned dir-path))
+ (res-read-1 nil)
+ (res-read-2 nil))
+ (9p-read stream
+ dir-fid
+ 0 10
+ :callback (lambda (x data)
+ (declare (ignore x))
+ (setf res-read-1 data)))
+ (9p-read stream
+ dir-fid
+ 0 10
+ :callback (lambda (x data)
+ (declare (ignore x))
+ (setf res-read-2 data)))
+ (read-all-pending-message stream)
+ (not (mismatch res-read-1 res-read-2)))))
+
+(defun example-directory-children (path &optional (root "/"))
+ (with-open-ssl-stream (stream
+ socket
+ *host*
+ *port*
+ *client-certificate*
+ *certificate-key*)
+ (let* ((*messages-sent* ())
+ (root-fid (mount stream root)))
+ (collect-directory-children stream root-fid path))))
+
+(deftest collect-dir-root-children ((kami-suite) (test-read))
+ (assert-true (example-directory-children "/")))
