commit - c4a3d6dd04db41c514076813c8ff8950d3996fff
commit + 9e1be03da77f81d449ddbd78f818a9ab214a63e9
blob - da745b2ac762597812a4b5d4d3ac22311ed8e111
blob + 540db5d7a21ca5a23ec67093317dcfacdd2a3f7e
--- regress/lisp/9p-test/client.lisp
+++ regress/lisp/9p-test/client.lisp
(define-constant +open-remove-on-clunk+ #x40 :test #'=)
-(define-constant +stat-type-dir+ #x80000000 :test #'=
+(define-constant +stat-type-dir+ #x80 :test #'=
:documentation "mode bit for directories")
-(define-constant +stat-type-append+ #x40000000 :test #'=
+(define-constant +stat-type-append+ #x40 :test #'=
:documentation "mode bit for append only files")
-(define-constant +stat-type-excl+ #x20000000 :test #'=
+(define-constant +stat-type-excl+ #x20 :test #'=
:documentation "mode bit for exclusive use files")
-(define-constant +stat-type-mount+ #x10000000 :test #'=
+(define-constant +stat-type-mount+ #x10 :test #'=
:documentation "mode bit for mounted channel")
-(define-constant +stat-type-auth+ #x08000000 :test #'=
+(define-constant +stat-type-auth+ #x08 :test #'=
:documentation "mode bit for authentication file")
-(define-constant +stat-type-tmp+ #x04000000 :test #'=
+(define-constant +stat-type-tmp+ #x04 :test #'=
:documentation "mode bit for non-backed-up files")
+
+(define-constant +stat-type-symlink+ #x02 :test #'=
+ :documentation "mode bit for non-backed-up files")
+
+(define-constant +stat-type-file+ #x00 :test #'=
+ :documentation "mode bit for non-backed-up files")
+
+(define-constant +file-types+ (list (cons +stat-type-dir+ :directory)
+ (cons +stat-type-append+ :append-only)
+ (cons +stat-type-excl+ :executable)
+ (cons +stat-type-mount+ :mount)
+ (cons +stat-type-auth+ :auth )
+ (cons +stat-type-tmp+ :tmp)
+ (cons +stat-type-symlink+ :symlink)
+ (cons +stat-type-file+ :file))
+ :test #'equalp)
+
+(defun file-type-number->symbol (key)
+ (cdr (assoc key +file-types+)))
+
+;; modes
(define-constant +stat-type-read+ #x4 :test #'=
:documentation "mode bit for read permission")
(defun encoded-string-offset (decoded-string)
(+ (length decoded-string)
+message-string-length-size+))
+
+(defstruct stat
+ (entry-size)
+ (ktype)
+ (kdev)
+ (entry-type)
+ (version)
+ (path)
+ (mode)
+ (atime)
+ (mtime)
+ (size)
+ (name)
+ (user-id)
+ (group-id)
+ (last-modified-from-id))
(defun decode-rstat (data)
(flet ((->int (start end)
(bytes->int (subseq data start end))))
- (let* ((entry-size1 (->int 0 2))
- (entry-size2 (->int 2 4))
- (ktype (->int 4 6))
- (kdev (->int 6 10))
- (entry-type (->int 10 11))
- (version (->int 11 15))
- (path (->int 15 23))
- (mode (->int 23 27))
- (atime (->int 27 31))
- (mtime (->int 31 35))
- (size (->int 35 43))
- (strings-start 43)
+ (let* ((entry-size (->int 0 2))
+ (ktype (->int 2 4))
+ (kdev (->int 4 8))
+ (entry-type (->int 8 9))
+ (version (->int 9 13))
+ (path (->int 13 21))
+ (mode (->int 21 25))
+ (atime (->int 25 29))
+ (mtime (->int 29 33))
+ (size (->int 33 41))
+ (strings-start 41)
(name (decode-string (subseq data strings-start)))
(name-offset (encoded-string-offset name))
(user-id (decode-string (subseq data
(group-id-offset (+ user-id-offset
(encoded-string-offset group-id)))
(last-modified-from-id (decode-string (subseq data group-id-offset))))
- (values entry-size1
- entry-size2
- ktype
- kdev
- entry-type
- version
- path
- mode
- atime
- mtime
- size
- name
- user-id
- group-id
- last-modified-from-id))))
+ (make-stat :entry-size entry-size
+ :ktype ktype
+ :kdev kdev
+ :entry-type (file-type-number->symbol entry-type)
+ :version version
+ :path path
+ :mode mode
+ :atime atime
+ :mtime mtime
+ :size size
+ :name name
+ :user-id user-id
+ :group-id group-id
+ :last-modified-from-id last-modified-from-id))))
;;; high level routines
blob - ade03a9c22ae86586fea6b6f4f2fa005635e7845
blob + 7c17fa9db0589c218a404ab86cfb118d788028a2
--- regress/lisp/9p-test/package.lisp
+++ regress/lisp/9p-test/package.lisp
:9p-read
:9p-walk
:decode-read-reply
+ :stat-entry-size
+ :stat-ktype
+ :stat-kdev
+ :stat-entry-type
+ :stat-version
+ :stat-path
+ :stat-mode
+ :stat-atime
+ :stat-mtime
+ :stat-size
+ :stat-name
+ :stat-user-id
+ :stat-group-id
+ :stat-last-modified-from-id
:decode-rstat
:read-all-pending-messages-ignoring-errors
:create-directory
blob - d7b4cf5b0675fe5df18c40ef67c5ab9f8ec4e76b
blob + 7259fcc8b226ea4eb15145aaad920a5444e3a429
--- regress/lisp/9p-test/tests/kami-tests.lisp
+++ regress/lisp/9p-test/tests/kami-tests.lisp
-;; test stuite for kami
+;; test suite for kami
;; Copyright (C) 2021 cage
;; This program is free software: you can redistribute it and/or modify
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program.
+;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :kami-tests)
(defsuite kami-suite (all-suite))
+(defparameter *client-certificate* "/home/cage/lisp/tinmop/kamid.cert")
+
+(defparameter *certificate-key* "/home/cage/lisp/tinmop/kamid.key")
+
+(defparameter *host* "localhost")
+
+(defparameter *port* 10564)
+
+(defparameter *remote-test-file* "kami-test")
+
+(defparameter *remote-test-path* "/kamid/regress/root/dir/subdir/file")
+
+(defparameter *remote-test-path-write* "/kamid/regress/root/dir/subdir/test-file-write")
+
+(defparameter *remote-test-path-contents* (format nil "qwertyuiopasdfghjklòàù è~%"))
+
+(alexandria:define-constant +remote-test-path-ovewrwrite-data+ "12" :test #'string=)
+
(defun start-non-tls-socket (host port)
(usocket:socket-connect host
port
(read-all-pending-message stream)
t))))
-(deftest test-read (kami-suite)
+(deftest test-read ((kami-suite) (test-walk))
(assert-true (ignore-errors (example-open-path *remote-test-file*))))
(defun example-slurp (path &optional (root "/"))
:buffer-size 3)
:errorp nil))))
-(deftest test-slurp-file (kami-suite)
+(deftest test-slurp-file ((kami-suite) (test-read))
(assert-equality #'string=
*remote-test-path-contents*
(example-slurp *remote-test-path*)))
(file-sequence (read-entire-file-as-string *remote-test-path-write*)))
(setf (subseq expected-sequence 2 4) +remote-test-path-ovewrwrite-data+)
(assert-equality #'string= file-sequence expected-sequence)))
+
+(defun example-stat (path &optional (root "/"))
+ (with-open-ssl-stream (stream
+ socket
+ *host*
+ *port*
+ *client-certificate*
+ *certificate-key*)
+ (let* ((*messages-sent* ())
+ (*buffer-size* 256)
+ (root-fid (mount stream root))
+ (fid (open-path stream root-fid path :mode +create-for-read+))
+ (results nil))
+ (9p-stat stream fid
+ :callback (lambda (x data)
+ (declare (ignore x))
+ (setf results (decode-rstat data))))
+ (read-all-pending-message stream)
+ results)))
+
+(deftest test-stat (kami-suite)
+ (example-write-2-3 *remote-test-path-write*)
+ (assert-true (ignore-errors (example-stat "/")))
+ (assert-true (ignore-errors (example-stat *remote-test-path*)))
+ (assert-eq :directory
+ (stat-entry-type (example-stat "/")))
+ (assert-eq :file
+ (stat-entry-type (example-stat *remote-test-path*))))
