2 ;; Copyright (C) 2021 cage
4 ;; This program is free software: you can redistribute it and/or modify
5 ;; it under the terms of the GNU General Public License as published by
6 ;; the Free Software Foundation, either version 3 of the License, or
7 ;; (at your option) any later version.
9 ;; This program is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;; GNU General Public License for more details.
14 ;; You should have received a copy of the GNU General Public License
15 ;; along with this program.
16 ;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
18 (in-package :kami-tests)
20 (defparameter *remote-test-file* "test-file") ; note: missing "/" is intentional
22 (defparameter *remote-test-path* "/test-file")
24 (defparameter *remote-test-path-write* "/dir/subdir/test-file-write")
26 (defparameter *remote-test-path-huge* "/test-file-huge")
28 (defparameter *remote-test-path-big-buffer* "/test-file-big-buffer")
30 (defparameter *remote-test-path-contents* (format nil "qwertyuiopasdfghjklòàù è~%"))
32 (alexandria:define-constant +remote-test-path-ovewrwrite-data+ "12" :test #'string=)
34 (defsuite kami-suite (all-suite))
36 (defun start-non-tls-socket (host port)
37 (usocket:socket-connect host
40 :element-type +byte-type+))
42 (defun example-mount (&optional (root "/"))
43 (with-open-ssl-stream (stream
49 (let ((*messages-sent* '())
50 (root-fid (mount stream root)))
51 (9p-clunk stream root-fid)
52 (read-all-pending-messages stream)
53 (9p-attach stream root)
54 (read-all-pending-messages stream)
57 (deftest test-mount (kami-suite)
58 (assert-true (ignore-errors (example-mount))))
60 (defun example-walk (path &optional (root "/"))
61 (with-open-ssl-stream (stream
68 (let ((*messages-sent* '())
69 (root-fid (mount stream root)))
70 (with-new-fid (path-fid)
71 (9p-walk stream root-fid path-fid path)
72 (read-all-pending-messages stream)
75 (deftest test-walk (kami-suite)
76 (assert-true (ignore-errors (example-walk *remote-test-file*))))
78 (defun example-open-path (path &optional (root "/"))
79 (with-open-ssl-stream (stream
85 (let ((*messages-sent* '())
86 (root-fid (mount stream root)))
87 (with-new-fid (saved-root-fid)
88 (9p-walk stream root-fid saved-root-fid +nwname-clone+)
89 (open-path stream root-fid path)
90 (read-all-pending-messages stream)
93 (deftest test-open-path (kami-suite)
94 (assert-true (ignore-errors (example-open-path *remote-test-path*))))
96 (defun example-read (path &optional (root "/"))
97 (with-open-ssl-stream (stream
103 (let ((*messages-sent* ())
105 (root-fid (mount stream root)))
106 (with-new-fid (path-fid)
107 (9p-walk stream root-fid path-fid path)
108 (9p-open stream path-fid)
109 (9p-read stream path-fid 0 10)
110 (read-all-pending-messages stream)
113 (deftest test-read ((kami-suite) (test-walk))
114 (assert-true (ignore-errors (example-open-path *remote-test-file*))))
116 (defun example-slurp (path &optional (root "/"))
117 (with-open-ssl-stream (stream
123 (let ((*messages-sent* ())
125 (root-fid (mount stream root)))
126 (babel:octets-to-string (slurp-file stream
131 (deftest test-slurp-file ((kami-suite) (test-read))
132 (assert-equality #'string=
133 *remote-test-path-contents*
134 (example-slurp *remote-test-path*)))
136 (defun example-write-data (path data &optional (root "/"))
137 (with-open-ssl-stream (stream
143 (let* ((*messages-sent* ())
145 (root-fid (mount stream root))
146 (fid (open-path stream root-fid path :mode +create-for-read-write+)))
147 (9p-write stream fid 0 data)
148 (read-all-pending-messages stream)
151 (defun example-write (path &optional (root "/"))
152 (example-write-data path *remote-test-path-contents* root))
154 (deftest test-write ((kami-suite) (test-open-path test-read))
155 (assert-true (ignore-errors (example-write *remote-test-path-write*)))
156 (assert-true (ignore-errors (example-write-data *remote-test-path-write* #()))))
158 (defun example-write-2-3 (path &optional (root "/"))
159 (with-open-ssl-stream (stream
165 (let* ((*messages-sent* ())
167 (root-fid (mount stream root)))
168 (with-new-fid (saved-root-fid)
169 (9p-walk stream root-fid saved-root-fid +nwname-clone+)
170 (let ((fid (open-path stream root-fid path :mode +create-for-read-write+)))
171 (9p-write stream fid 2 +remote-test-path-ovewrwrite-data+)
172 (read-all-pending-messages stream)
173 (babel:octets-to-string (slurp-file stream saved-root-fid path)))))))
175 (defun read-entire-file-as-string (path &optional (root "/"))
176 (with-open-ssl-stream (stream
182 (let* ((*messages-sent* ())
184 (root-fid (mount stream root)))
185 (babel:octets-to-string (slurp-file stream root-fid path)))))
187 (deftest test-example-write-2-3 ((kami-suite) (test-write))
188 (example-write-2-3 *remote-test-path-write*)
189 (let* ((expected-sequence (copy-seq *remote-test-path-contents*))
190 (file-sequence (read-entire-file-as-string *remote-test-path-write*)))
191 (setf (subseq expected-sequence 2 4) +remote-test-path-ovewrwrite-data+)
192 (assert-equality #'string= file-sequence expected-sequence)))
194 (defun example-write-fails (path &optional (root "/"))
195 (with-open-ssl-stream (stream
201 (let* ((*messages-sent* ())
203 (root-fid (mount stream root))
204 (fid (open-path stream root-fid path :mode +create-for-read-write+)))
205 (9p-write stream fid 0 *remote-test-path-contents*)
206 (read-all-pending-messages stream))))
208 (deftest test-write-on-directory-fails ((kami-suite) (test-write))
209 (assert-condition 9p-error (example-write-fails "/")))
211 (defun example-stat (path &optional (root "/"))
212 (with-open-ssl-stream (stream
218 (let* ((*messages-sent* ())
220 (root-fid (mount stream root))
221 (fid (open-path stream root-fid path :mode +create-for-read+))
224 :callback (lambda (x data)
226 (setf results (decode-rstat data))))
227 (read-all-pending-messages stream)
230 (deftest test-stat (kami-suite)
231 (assert-true (ignore-errors (example-stat "/")))
232 (assert-true (ignore-errors (example-stat *remote-test-path*)))
233 (assert-eq :directory
234 (stat-entry-type (example-stat "/")))
236 (stat-entry-type (example-stat *remote-test-path*)))
237 (assert-equality #'= 0 (stat-size (example-stat "/"))))
239 (defun example-path-exists (path &optional (root "/"))
240 (with-open-ssl-stream (stream
246 (let* ((*messages-sent* ())
247 (root-fid (mount stream root)))
248 (path-exists-p stream root-fid path))))
250 (defun example-path-exists-many-times (path &optional (root "/"))
251 (with-open-ssl-stream (stream
257 (let* ((*messages-sent* ())
258 (root-fid (mount stream root)))
259 (loop repeat 10000 do
260 (path-exists-p stream root-fid path))
261 (path-exists-p stream root-fid path))))
263 (deftest test-path-exists ((kami-suite) (test-stat))
264 (assert-true (example-path-exists *remote-test-path*))
265 (assert-false (example-path-exists (concatenate 'string *remote-test-path* ".$$$"))))
267 (deftest test-path-exists-many-times ((kami-suite) (test-path-exists))
268 (assert-true (example-path-exists-many-times *remote-test-path*)))
270 (defun example-create-file (path &optional (root "/"))
271 (with-open-ssl-stream (stream
277 (let* ((*messages-sent* ())
278 (root-fid (mount stream root)))
279 (with-new-fid (saved-root-fid)
280 (9p-walk stream root-fid saved-root-fid +nwname-clone+)
281 (9p-create stream root-fid path)
282 (read-all-pending-messages stream)
283 (9p-clunk stream root-fid)
284 (open-path stream saved-root-fid path)
285 (read-all-pending-messages stream)
288 (alexandria:define-constant +create-file+ "test-file-create" :test #'string=)
290 (defun example-create-directory (path &optional (root "/"))
291 (with-open-ssl-stream (stream
297 (let* ((*messages-sent* ())
298 (root-fid (mount stream root)))
299 (create-directory stream root-fid path)
302 (alexandria:define-constant +create-directory+ "test-dir-create" :test #'string=)
304 (defun example-create-path-read-write (path &optional (root "/"))
305 (with-open-ssl-stream (stream
311 (let* ((*messages-sent* ())
312 (root-fid (mount stream root))
313 (saved-root-fid (clone-fid stream root-fid))
314 (new-path-fid (create-path stream root-fid path)))
315 (9p-write stream new-path-fid 0 *remote-test-path-contents*)
316 (read-all-pending-messages stream)
317 (9p-clunk stream new-path-fid)
318 (read-all-pending-messages stream)
319 (babel:octets-to-string (slurp-file stream saved-root-fid path)))))
321 (defun example-create-path (path &optional (root "/"))
322 (with-open-ssl-stream (stream
328 (let* ((*messages-sent* ())
329 (root-fid (mount stream root)))
330 (create-path stream root-fid path))))
332 (alexandria:define-constant +create-path-read-write+ "/a/totaly/new/path/new-file" :test #'string=)
334 (alexandria:define-constant +create-path-dir+ "/this/" :test #'string=)
336 (alexandria:define-constant +create-path-file+ "/this-file" :test #'string=)
338 (deftest test-create ((kami-suite) (test-open-path))
339 (assert-true (ignore-errors (example-create-file +create-file+)))
340 (assert-true (ignore-errors (example-create-directory +create-directory+)))
341 (assert-true (ignore-errors (example-create-path +create-path-dir+)))
342 (assert-true (ignore-errors (example-create-path +create-path-file+)))
343 (assert-equality #'string=
344 *remote-test-path-contents*
345 (ignore-errors (example-create-path-read-write +create-path-read-write+))))
347 (deftest test-create-existing-path ((kami-suite) (test-create))
348 (assert-true (ignore-errors (example-create-path +create-path-read-write+))))
350 (defun close-parent-fid (&optional (root "/"))
351 (with-open-ssl-stream (stream
357 (let* ((*messages-sent* ())
358 (root-fid (mount stream root)))
359 (with-new-fid (dir-fid)
360 (9p-walk stream root-fid dir-fid "dir")
361 (read-all-pending-messages stream)
362 (9p-clunk stream root-fid)
363 (read-all-pending-messages stream)
364 (with-new-fid (subdir-fid)
365 (9p-walk stream dir-fid subdir-fid "subdir")
366 (read-all-pending-messages stream)
367 (9p-clunk stream dir-fid)
368 (read-all-pending-messages stream)
369 (with-new-fid (file-fid)
370 (9p-walk stream subdir-fid file-fid "test-file-write")
371 (read-all-pending-messages stream)
372 (9p-clunk stream subdir-fid)
373 (read-all-pending-messages stream)
374 (9p-open stream file-fid)
375 (read-all-pending-messages stream)
378 (deftest test-close-parent-fid ((kami-suite) (test-walk))
379 (assert-true (ignore-errors (close-parent-fid))))
381 (defun %remove-path (path &optional (root "/"))
382 (with-open-ssl-stream (stream
389 (let* ((*messages-sent* ())
390 (root-fid (mount stream root)))
391 (remove-path stream root-fid path)
394 (deftest test-remove-file ((kami-suite) (test-create-existing-path))
395 (assert-true (ignore-errors (%remove-path +create-path-read-write+))))
397 (defun parent-dir-path (path)
398 (let ((position-backslash (position #\/ path :from-end t :test #'char=)))
399 (subseq path 0 position-backslash)))
401 (deftest test-remove-directory ((kami-suite) (test-remove-file))
403 (ignore-errors (%remove-path (parent-dir-path +create-path-read-write+)))))
405 (defun read-dir-same-offset (dir-path &optional (root "/"))
406 (with-open-ssl-stream (stream
412 (let* ((*messages-sent* ())
413 (root-fid (mount stream root))
414 (root-fid-cloned (clone-fid stream root-fid))
415 (dir-fid (open-path stream root-fid-cloned dir-path))
421 :callback (lambda (x data)
423 (setf res-read-1 data)))
427 :callback (lambda (x data)
429 (setf res-read-2 data)))
430 (read-all-pending-messages stream)
431 (not (mismatch res-read-1 res-read-2)))))
433 (defun example-directory-children (path &optional (root "/"))
434 (with-open-ssl-stream (stream
440 (let* ((*messages-sent* ())
441 (root-fid (mount stream root)))
442 (collect-directory-children stream root-fid path))))
444 (deftest test-collect-dir-root-children ((kami-suite) (test-read))
445 (assert-true (example-directory-children "/")))
447 (defun make-huge-data ()
448 (let* ((*random-state* (make-random-state nil)))
450 :element-type '(unsigned-byte 8)
451 :initial-contents (loop repeat 1000000
455 (defun write-huge-file (path &optional (root "/"))
456 (with-open-ssl-stream (stream
462 (let* ((*messages-sent* ())
464 (root-fid (mount stream root))
465 (saved-root-fid (clone-fid stream root-fid))
466 (fid (create-path stream root-fid path))
467 (data (make-huge-data)))
468 (9p-write stream fid 0 data)
469 (9p-clunk stream fid)
470 (read-all-pending-messages stream)
471 (path-info stream saved-root-fid path))))
473 (deftest test-write-huge-file ((kami-suite) (test-collect-dir-root-children))
474 (let* ((size-file (stat-size (write-huge-file *remote-test-path-huge*))))
475 (assert-equality #'= (length (make-huge-data)) size-file)))
477 (defun write-big-buffer (path &optional (root "/"))
478 (with-open-ssl-stream (stream
484 (let* ((*messages-sent* ())
485 (*buffer-size* 4292608)
486 (root-fid (mount stream root))
487 (saved-root-fid (clone-fid stream root-fid))
488 (fid (create-path stream root-fid path))
489 (data (make-huge-data)))
490 (9p-write stream fid 0 data)
491 (9p-clunk stream fid)
492 (read-all-pending-messages stream)
493 (path-info stream saved-root-fid path))))
495 (deftest test-write-big-buffer ((kami-suite) (test-collect-dir-root-children))
496 (let* ((size-file (stat-size (write-huge-file *remote-test-path-big-buffer*))))
497 (assert-equality #'= (length (make-huge-data)) size-file)))
499 (defun read-huge-file (path &optional (root "/"))
500 (with-open-ssl-stream (stream
506 (let ((*messages-sent* ())
508 (root-fid (mount stream root)))
511 :buffer-size 3000))))
513 (deftest test-read-huge-data ((kami-suite) (test-write-huge-file))
515 (length (make-huge-data))
516 (length (read-huge-file *remote-test-path-huge*))))
518 (defun read-a-tiny-amount-of-data (path amount &optional (root "/"))
519 (with-open-ssl-stream (stream
525 (let* ((*messages-sent* ())
527 (root-fid (mount stream root))
528 (path-fid (open-path stream root-fid path))
534 :callback (lambda (x reply)
536 (let ((data (decode-read-reply reply nil)))
537 (setf results data))))
538 (read-all-pending-messages stream)
541 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
545 (length (read-a-tiny-amount-of-data *remote-test-path-huge* amount)))))
547 (defun read-data-exceeding-msize (path buffer-size &optional (root "/"))
548 (with-open-ssl-stream (stream
554 (let* ((*messages-sent* ())
555 (*buffer-size* buffer-size)
556 (root-fid (mount stream root))
557 (path-fid (open-path stream root-fid path))
563 :callback (lambda (x reply)
565 (let ((data (decode-read-reply reply nil)))
566 (setf results data))))
567 (read-all-pending-messages stream)
570 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
571 (let ((buffer-size 256))
572 (assert-condition 9p-error
573 (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
575 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
576 (let ((buffer-size 256))
577 (assert-condition 9p-error
578 (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
580 (defun example-copy-file (from to &optional (root "/"))
581 (with-open-ssl-stream (stream
587 (let* ((*messages-sent* ())
588 (root-fid (mount stream root)))
589 (copy-file stream root-fid from to)
590 (slurp-file stream root-fid to))))
592 (deftest test-copy-file ((kami-suite) (test-write-huge-file))
593 (assert-equality #'equalp
595 (example-copy-file *remote-test-path-huge*
597 *remote-test-path-huge*
600 (defun example-move-file (from to &optional (root "/"))
601 (with-open-ssl-stream (stream
607 (let* ((*messages-sent* ())
608 (root-fid (mount stream root)))
609 (move-file stream root-fid from to)
610 (path-exists-p stream root-fid from))))
612 (defun renamed-filename ()
613 (concatenate 'string *remote-test-path-huge* "-renamed"))
615 (deftest test-move-file ((kami-suite) (test-copy-file))
616 (assert-false (example-move-file *remote-test-path-huge* (renamed-filename))))
618 (alexandria:define-constant +truncate-size+ 128 :test #'=)
620 (defun example-truncate-file (path &optional (root "/"))
621 (with-open-ssl-stream (stream
627 (let* ((*messages-sent* ())
628 (root-fid (mount stream root)))
629 (truncate-file stream root-fid path :new-size +truncate-size+)
630 (stat-size (path-info stream root-fid path)))))
632 (deftest test-truncate-file ((kami-suite) (test-move-file))
635 (example-truncate-file (renamed-filename))))
637 (alexandria:define-constant +new-atime+ (encode-universal-time 0 0 10 22 10 1990) :test #'=)
639 (alexandria:define-constant +new-atime-2+ (encode-universal-time 0 0 10 22 10 1999) :test #'=)
641 (alexandria:define-constant +new-mtime+ (encode-universal-time 0 0 11 23 11 1991) :test #'=)
643 (alexandria:define-constant +new-mtime-2+ (encode-universal-time 0 0 11 23 11 2001) :test #'=)
645 (defun example-change-access-time-file (path time &optional (root "/"))
646 (with-open-ssl-stream (stream
652 (let* ((*messages-sent* ())
653 (root-fid (mount stream root)))
654 (change-access-time stream root-fid path time)
655 (let ((info (path-info stream root-fid path)))
656 (stat-atime info)))))
658 (defun example-change-modify-time-file (path time &optional (root "/"))
659 (with-open-ssl-stream (stream
665 (let* ((*messages-sent* ())
666 (root-fid (mount stream root)))
667 (change-modify-time stream root-fid path time)
668 (let ((info (path-info stream root-fid path)))
669 (stat-mtime info)))))
671 (defun example-change-times-file (path atime mtime &optional (root "/"))
672 (with-open-ssl-stream (stream
678 (let* ((*messages-sent* ())
679 (root-fid (mount stream root)))
680 (change-time-values stream root-fid path atime mtime)
681 (let ((info (path-info stream root-fid path)))
682 (values (stat-atime info)
683 (stat-mtime info))))))
685 (deftest test-change-access-time ((kami-suite) (test-move-file))
688 (example-change-access-time-file (renamed-filename) +new-atime+))
691 (example-change-modify-time-file (renamed-filename) +new-mtime+))
692 (let ((expected-times (list +new-atime-2+ +new-mtime-2+)))
693 (assert-equalp expected-times
694 (multiple-value-list (example-change-times-file (renamed-filename)
698 (alexandria::define-constant +many-files-number+ 10000 :test #'=)
700 (alexandria::define-constant +many-files-path+ "/many/open/files/" :test #'string=)
702 (alexandria::define-constant +many-files-format+ "~a/~a.dummy" :test #'string=)
704 (defun example-create-many-files (path &optional (root "/"))
705 (with-open-ssl-stream (stream
711 (let* ((*messages-sent* ())
712 (root-fid (mount stream root)))
713 (length (loop for i from 0 below +many-files-number+
715 (let* ((cloned-fid (clone-fid stream root-fid))
716 (created-fid (create-path stream
722 (9p-clunk stream created-fid)
725 (deftest test-create-many-files ((kami-suite) (test-move-file))
728 (ignore-errors (example-create-many-files +many-files-path+))))
730 (defun example-open-many-files (path &optional (root "/"))
731 (with-open-ssl-stream (stream
737 (let* ((*messages-sent* ())
738 (root-fid (mount stream root)))
739 (loop for i from 0 below 509 do
740 (9p-clunk stream (open-path stream
748 (deftest test-open-many-files ((kami-suite) (test-create-many-files))
749 (assert-true (ignore-errors (example-open-many-files +many-files-path+))))