commit 9e1be03da77f81d449ddbd78f818a9ab214a63e9 from: cage date: Sun Dec 19 19:13:21 2021 UTC - [regress-extra] added testing for Tstat. commit - c4a3d6dd04db41c514076813c8ff8950d3996fff commit + 9e1be03da77f81d449ddbd78f818a9ab214a63e9 blob - da745b2ac762597812a4b5d4d3ac22311ed8e111 blob + 540db5d7a21ca5a23ec67093317dcfacdd2a3f7e --- regress/lisp/9p-test/client.lisp +++ regress/lisp/9p-test/client.lisp @@ -44,23 +44,44 @@ (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") @@ -486,22 +507,37 @@ (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 @@ -514,21 +550,20 @@ (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 @@ -80,6 +80,20 @@ :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 @@ -1,4 +1,4 @@ -;; test stuite for kami +;; test suite for kami ;; Copyright (C) 2021 cage ;; This program is free software: you can redistribute it and/or modify @@ -12,12 +12,31 @@ ;; 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 . +;; 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 @@ -95,7 +114,7 @@ (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 "/")) @@ -113,7 +132,7 @@ :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*))) @@ -169,3 +188,31 @@ (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*))))