1 ;; test suite for kami
2 ;; Copyright (C) 2021  cage
3 
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.
8 
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.
13 
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/]].
17 
18 (in-package :kami-tests)
19 
20 (defparameter *remote-test-file*   "test-file") ; note: missing "/" is intentional
21 
22 (defparameter *remote-test-path*   "/test-file")
23 
24 (defparameter *remote-test-path-write*   "/dir/subdir/test-file-write")
25 
26 (defparameter *remote-test-path-huge*    "/test-file-huge")
27 
28 (defparameter *remote-test-path-contents* (format nil "qwertyuiopasdfghjklòàù è~%"))
29 
30 (alexandria:define-constant +remote-test-path-ovewrwrite-data+ "12" :test #'string=)
31 
32 (defsuite kami-suite (all-suite))
33 
34 (defun start-non-tls-socket (host port)
35   (usocket:socket-connect host
36                           port
37                           :protocol     :stream
38                           :element-type +byte-type+))
39 
40 (defun example-mount (&optional (root  "/"))
41   (with-open-ssl-stream (stream
42                          socket
43                          *host*
44                          *port*
45                          *client-certificate*
46                          *certificate-key*)
47     (let ((*messages-sent* '())
48           (root-fid (mount stream root)))
49       (9p-clunk stream root-fid)
50       (read-all-pending-messages stream)
51       (9p-attach stream root)
52       (read-all-pending-messages stream)
53       t)))
54 
55 (deftest test-mount (kami-suite)
56   (assert-true (ignore-errors (example-mount))))
57 
58 (defun example-walk (path &optional (root "/"))
59   (with-open-ssl-stream (stream
60                          socket
61                          *host*
62                          *port*
63                          *client-certificate*
64                          *certificate-key*)
65 
66     (let ((*messages-sent* '())
67           (root-fid (mount stream root)))
68       (with-new-fid (path-fid)
69         (9p-walk stream root-fid path-fid path)
70         (read-all-pending-messages stream)
71         t))))
72 
73 (deftest test-walk (kami-suite)
74   (assert-true (ignore-errors (example-walk *remote-test-file*))))
75 
76 (defun example-open-path (path &optional (root "/"))
77   (with-open-ssl-stream (stream
78                          socket
79                          *host*
80                          *port*
81                          *client-certificate*
82                          *certificate-key*)
83     (let ((*messages-sent* '())
84           (root-fid (mount stream root)))
85       (with-new-fid (saved-root-fid)
86         (9p-walk stream root-fid saved-root-fid +nwname-clone+)
87         (open-path stream root-fid path)
88         (read-all-pending-messages stream)
89         t))))
90 
91 (deftest test-open-path (kami-suite)
92   (assert-true (ignore-errors (example-open-path *remote-test-path*))))
93 
94 (defun example-read (path &optional (root "/"))
95   (with-open-ssl-stream (stream
96                          socket
97                          *host*
98                          *port*
99                          *client-certificate*
100                          *certificate-key*)
101     (let ((*messages-sent* ())
102           (*buffer-size*   256)
103           (root-fid        (mount stream root)))
104       (with-new-fid (path-fid)
105         (9p-walk stream root-fid path-fid path)
106         (9p-open stream path-fid)
107         (9p-read stream path-fid 0 10)
108         (read-all-pending-messages stream)
109         t))))
110 
111 (deftest test-read ((kami-suite) (test-walk))
112   (assert-true (ignore-errors (example-open-path *remote-test-file*))))
113 
114 (defun example-slurp (path &optional (root "/"))
115   (with-open-ssl-stream (stream
116                          socket
117                          *host*
118                          *port*
119                          *client-certificate*
120                          *certificate-key*)
121     (let ((*messages-sent* ())
122           (*buffer-size*   256)
123           (root-fid        (mount stream root)))
124       (babel:octets-to-string (slurp-file stream
125                                           root-fid path
126                                           :buffer-size 3)
127                               :errorp nil))))
128 
129 (deftest test-slurp-file ((kami-suite) (test-read))
130   (assert-equality #'string=
131       *remote-test-path-contents*
132       (example-slurp *remote-test-path*)))
133 
134 (defun example-write-data (path data &optional (root "/"))
135   (with-open-ssl-stream (stream
136                          socket
137                          *host*
138                          *port*
139                          *client-certificate*
140                          *certificate-key*)
141     (let* ((*messages-sent* ())
142            (*buffer-size*   256)
143            (root-fid        (mount stream root))
144            (fid             (open-path stream root-fid path :mode +create-for-read-write+)))
145       (9p-write stream fid 0 data)
146       (read-all-pending-messages stream)
147       t)))
148 
149 (defun example-write (path &optional (root "/"))
150   (example-write-data path *remote-test-path-contents* root))
151 
152 (deftest test-write ((kami-suite) (test-open-path test-read))
153   (assert-true (ignore-errors (example-write *remote-test-path-write*)))
154   (assert-true (ignore-errors (example-write-data *remote-test-path-write* #()))))
155 
156 (defun example-write-2-3 (path &optional (root "/"))
157   (with-open-ssl-stream (stream
158                          socket
159                          *host*
160                          *port*
161                          *client-certificate*
162                          *certificate-key*)
163     (let* ((*messages-sent* ())
164            (*buffer-size*   256)
165            (root-fid        (mount stream root)))
166       (with-new-fid (saved-root-fid)
167         (9p-walk stream root-fid saved-root-fid +nwname-clone+)
168         (let ((fid (open-path stream root-fid path :mode +create-for-read-write+)))
169           (9p-write stream fid 2 +remote-test-path-ovewrwrite-data+)
170           (read-all-pending-messages stream)
171           (babel:octets-to-string (slurp-file stream saved-root-fid path)))))))
172 
173 (defun read-entire-file-as-string (path  &optional (root "/"))
174   (with-open-ssl-stream (stream
175                          socket
176                          *host*
177                          *port*
178                          *client-certificate*
179                          *certificate-key*)
180     (let* ((*messages-sent* ())
181            (*buffer-size*   256)
182            (root-fid        (mount stream root)))
183       (babel:octets-to-string (slurp-file stream root-fid path)))))
184 
185 (deftest test-example-write-2-3 ((kami-suite) (test-write))
186   (example-write-2-3 *remote-test-path-write*)
187   (let* ((expected-sequence (copy-seq *remote-test-path-contents*))
188          (file-sequence     (read-entire-file-as-string *remote-test-path-write*)))
189     (setf (subseq expected-sequence 2 4) +remote-test-path-ovewrwrite-data+)
190     (assert-equality #'string= file-sequence expected-sequence)))
191 
192 (defun example-write-fails (path &optional (root "/"))
193   (with-open-ssl-stream (stream
194                          socket
195                          *host*
196                          *port*
197                          *client-certificate*
198                          *certificate-key*)
199     (let* ((*messages-sent* ())
200            (*buffer-size*   256)
201            (root-fid        (mount stream root))
202            (fid             (open-path stream root-fid path :mode +create-for-read-write+)))
203       (9p-write stream fid 0 *remote-test-path-contents*)
204       (read-all-pending-messages stream))))
205 
206 (deftest test-write-on-directory-fails ((kami-suite) (test-write))
207   (assert-condition 9p-error (example-write-fails "/")))
208 
209 (defun example-stat (path &optional (root "/"))
210   (with-open-ssl-stream (stream
211                          socket
212                          *host*
213                          *port*
214                          *client-certificate*
215                          *certificate-key*)
216     (let* ((*messages-sent* ())
217            (*buffer-size*   256)
218            (root-fid        (mount stream root))
219            (fid             (open-path stream root-fid path :mode +create-for-read+))
220            (results         nil))
221       (9p-stat stream fid
222                :callback (lambda (x data)
223                            (declare (ignore x))
224                            (setf results (decode-rstat data))))
225       (read-all-pending-messages stream)
226       results)))
227 
228 (deftest test-stat (kami-suite)
229   (assert-true (ignore-errors (example-stat "/")))
230   (assert-true (ignore-errors (example-stat *remote-test-path*)))
231   (assert-eq   :directory
232       (stat-entry-type (example-stat "/")))
233   (assert-eq   :file
234       (stat-entry-type (example-stat *remote-test-path*)))
235   (assert-equality #'= 0 (stat-size (example-stat "/"))))
236 
237 (defun example-path-exists (path &optional (root "/"))
238   (with-open-ssl-stream (stream
239                          socket
240                          *host*
241                          *port*
242                          *client-certificate*
243                          *certificate-key*)
244     (let* ((*messages-sent* ())
245            (root-fid        (mount stream root)))
246       (path-exists-p stream root-fid path))))
247 
248 (defun example-path-exists-many-times (path &optional (root "/"))
249   (with-open-ssl-stream (stream
250                          socket
251                          *host*
252                          *port*
253                          *client-certificate*
254                          *certificate-key*)
255     (let* ((*messages-sent* ())
256            (root-fid        (mount stream root)))
257       (loop repeat 10000 do
258         (path-exists-p stream root-fid path))
259         (path-exists-p stream root-fid path))))
260 
261 (deftest test-path-exists ((kami-suite) (test-stat))
262   (assert-true  (example-path-exists *remote-test-path*))
263   (assert-false (example-path-exists (concatenate 'string *remote-test-path* ".$$$"))))
264 
265 (deftest test-path-exists-many-times ((kami-suite) (test-path-exists))
266   (assert-true  (example-path-exists-many-times *remote-test-path*)))
267 
268 (defun example-create-file (path &optional (root "/"))
269   (with-open-ssl-stream (stream
270                                        socket
271                                        *host*
272                                        *port*
273                                        *client-certificate*
274                                        *certificate-key*)
275     (let* ((*messages-sent* ())
276            (root-fid        (mount stream root)))
277       (with-new-fid (saved-root-fid)
278         (9p-walk stream root-fid saved-root-fid +nwname-clone+)
279         (9p-create stream root-fid path)
280         (read-all-pending-messages stream)
281         (9p-clunk stream root-fid)
282         (open-path stream saved-root-fid path)
283         (read-all-pending-messages stream)
284         t))))
285 
286 (alexandria:define-constant +create-file+ "test-file-create" :test #'string=)
287 
288 (defun example-create-directory (path &optional (root "/"))
289   (with-open-ssl-stream (stream
290                          socket
291                          *host*
292                          *port*
293                          *client-certificate*
294                          *certificate-key*)
295     (let* ((*messages-sent* ())
296            (root-fid        (mount stream root)))
297       (create-directory stream root-fid path)
298       t)))
299 
300 (alexandria:define-constant +create-directory+ "test-dir-create" :test #'string=)
301 
302 (defun example-create-path-read-write (path &optional (root "/"))
303   (with-open-ssl-stream (stream
304                          socket
305                          *host*
306                          *port*
307                          *client-certificate*
308                          *certificate-key*)
309     (let* ((*messages-sent* ())
310            (root-fid        (mount stream root))
311            (saved-root-fid  (clone-fid stream root-fid))
312            (new-path-fid    (create-path stream root-fid path)))
313       (9p-write stream new-path-fid 0 *remote-test-path-contents*)
314       (read-all-pending-messages stream)
315       (9p-clunk stream new-path-fid)
316       (read-all-pending-messages stream)
317       (babel:octets-to-string (slurp-file stream saved-root-fid path)))))
318 
319 (defun example-create-path (path &optional (root "/"))
320   (with-open-ssl-stream (stream
321                          socket
322                          *host*
323                          *port*
324                          *client-certificate*
325                          *certificate-key*)
326     (let* ((*messages-sent* ())
327            (root-fid        (mount stream root)))
328       (create-path stream root-fid path))))
329 
330 (alexandria:define-constant +create-path-read-write+ "/a/totaly/new/path/new-file" :test #'string=)
331 
332 (alexandria:define-constant +create-path-dir+ "/this/" :test #'string=)
333 
334 (alexandria:define-constant +create-path-file+ "/this-file" :test #'string=)
335 
336 (deftest test-create ((kami-suite) (test-open-path))
337   (assert-true (ignore-errors (example-create-file +create-file+)))
338   (assert-true (ignore-errors (example-create-directory +create-directory+)))
339   (assert-true (ignore-errors (example-create-path +create-path-dir+)))
340   (assert-true (ignore-errors (example-create-path +create-path-file+)))
341   (assert-equality #'string=
342       *remote-test-path-contents*
343       (ignore-errors (example-create-path-read-write +create-path-read-write+))))
344 
345 (deftest test-create-existing-path ((kami-suite) (test-create))
346   (assert-true (ignore-errors (example-create-path +create-path-read-write+))))
347 
348 (defun close-parent-fid (&optional (root "/"))
349   (with-open-ssl-stream (stream
350                          socket
351                          *host*
352                          *port*
353                          *client-certificate*
354                          *certificate-key*)
355     (let* ((*messages-sent* ())
356            (root-fid        (mount stream root)))
357       (with-new-fid (dir-fid)
358         (9p-walk stream root-fid dir-fid "dir")
359         (read-all-pending-messages stream)
360         (9p-clunk stream root-fid)
361         (read-all-pending-messages stream)
362         (with-new-fid (subdir-fid)
363           (9p-walk stream dir-fid subdir-fid "subdir")
364           (read-all-pending-messages stream)
365           (9p-clunk stream dir-fid)
366           (read-all-pending-messages stream)
367           (with-new-fid (file-fid)
368             (9p-walk stream subdir-fid file-fid "test-file-write")
369             (read-all-pending-messages stream)
370             (9p-clunk stream subdir-fid)
371             (read-all-pending-messages stream)
372             (9p-open stream file-fid)
373             (read-all-pending-messages stream)
374             t))))))
375 
376 (deftest test-close-parent-fid ((kami-suite) (test-walk))
377   (assert-true (ignore-errors (close-parent-fid))))
378 
379 (defun %remove-path (path &optional (root "/"))
380   (with-open-ssl-stream (stream
381                          socket
382                          *host*
383                          *port*
384                          *client-certificate*
385                          *certificate-key*)
386 
387     (let* ((*messages-sent* ())
388            (root-fid        (mount stream root)))
389       (remove-path stream root-fid path)
390       t)))
391 
392 (deftest test-remove-file ((kami-suite) (test-create-existing-path))
393   (assert-true (ignore-errors (%remove-path +create-path-read-write+))))
394 
395 (defun parent-dir-path (path)
396   (let ((position-backslash (position #\/ path :from-end t :test #'char=)))
397     (subseq path 0 position-backslash)))
398 
399 (deftest test-remove-directory ((kami-suite) (test-remove-file))
400   (assert-true
401       (ignore-errors (%remove-path (parent-dir-path +create-path-read-write+)))))
402 
403 (defun read-dir-same-offset (dir-path &optional (root "/"))
404   (with-open-ssl-stream (stream
405                          socket
406                          *host*
407                          *port*
408                          *client-certificate*
409                          *certificate-key*)
410     (let* ((*messages-sent* ())
411            (root-fid        (mount stream root))
412            (root-fid-cloned (clone-fid stream root-fid))
413            (dir-fid         (open-path stream root-fid-cloned dir-path))
414            (res-read-1      nil)
415            (res-read-2      nil))
416       (9p-read stream
417                dir-fid
418                0  10
419                :callback (lambda (x data)
420                            (declare (ignore x))
421                            (setf res-read-1 data)))
422       (9p-read stream
423                dir-fid
424                0  10
425                :callback (lambda (x data)
426                            (declare (ignore x))
427                            (setf res-read-2 data)))
428       (read-all-pending-messages stream)
429       (not (mismatch res-read-1 res-read-2)))))
430 
431 (defun example-directory-children (path &optional (root "/"))
432   (with-open-ssl-stream (stream
433                          socket
434                          *host*
435                          *port*
436                          *client-certificate*
437                          *certificate-key*)
438     (let* ((*messages-sent* ())
439            (root-fid        (mount stream root)))
440       (collect-directory-children stream root-fid path))))
441 
442 (deftest test-collect-dir-root-children ((kami-suite) (test-read))
443   (assert-true (example-directory-children "/")))
444 
445 (defun make-huge-data ()
446   (let* ((*random-state* (make-random-state nil)))
447     (make-array 1000000
448                 :element-type '(unsigned-byte 8)
449                 :initial-contents (loop repeat 1000000
450                                         collect
451                                         (random 256)))))
452 
453 (defun write-huge-file (path &optional (root "/"))
454   (with-open-ssl-stream (stream
455                          socket
456                          *host*
457                          *port*
458                          *client-certificate*
459                          *certificate-key*)
460     (let* ((*messages-sent* ())
461            (*buffer-size*   256)
462            (root-fid        (mount stream root))
463            (saved-root-fid  (clone-fid stream root-fid))
464            (fid             (create-path stream root-fid path))
465            (data            (make-huge-data)))
466       (9p-write stream fid 0 data)
467       (9p-clunk stream fid)
468       (read-all-pending-messages stream)
469       (path-info stream saved-root-fid path))))
470 
471 (deftest test-write-huge-file ((kami-suite) (test-collect-dir-root-children))
472   (let* ((size-file  (stat-size (write-huge-file *remote-test-path-huge*))))
473     (assert-equality #'= (length (make-huge-data)) size-file)))
474 
475 (defun read-huge-file (path &optional (root "/"))
476   (with-open-ssl-stream (stream
477                          socket
478                          *host*
479                          *port*
480                          *client-certificate*
481                          *certificate-key*)
482     (let ((*messages-sent* ())
483           (*buffer-size*   4096)
484           (root-fid        (mount stream root)))
485       (slurp-file stream
486                   root-fid path
487                   :buffer-size 3000))))
488 
489 (deftest test-read-huge-data ((kami-suite) (test-write-huge-file))
490   (assert-equality #'=
491       (length (make-huge-data))
492       (length (read-huge-file *remote-test-path-huge*))))
493 
494 (defun read-a-tiny-amount-of-data (path amount &optional (root "/"))
495   (with-open-ssl-stream (stream
496                          socket
497                          *host*
498                          *port*
499                          *client-certificate*
500                          *certificate-key*)
501     (let* ((*messages-sent* ())
502            (*buffer-size*   4096)
503            (root-fid        (mount stream root))
504            (path-fid        (open-path stream root-fid path))
505            (results         nil))
506       (9p-read stream
507                path-fid
508                0
509                amount
510                :callback (lambda (x reply)
511                            (declare (ignore x))
512                            (let ((data (decode-read-reply reply nil)))
513                              (setf results data))))
514       (read-all-pending-messages stream)
515       results)))
516 
517 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
518   (let ((amount 3))
519     (assert-equality #'=
520         amount
521         (length (read-a-tiny-amount-of-data *remote-test-path-huge* amount)))))
522 
523 (defun read-data-exceeding-msize (path buffer-size &optional (root "/"))
524   (with-open-ssl-stream (stream
525                          socket
526                          *host*
527                          *port*
528                          *client-certificate*
529                          *certificate-key*)
530     (let* ((*messages-sent* ())
531            (*buffer-size*   buffer-size)
532            (root-fid        (mount stream root))
533            (path-fid        (open-path stream root-fid path))
534            (results         nil))
535       (9p-read stream
536                path-fid
537                0
538                (* 2 buffer-size)
539                :callback (lambda (x reply)
540                            (declare (ignore x))
541                            (let ((data (decode-read-reply reply nil)))
542                              (setf results data))))
543       (read-all-pending-messages stream)
544       results)))
545 
546 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
547   (let ((buffer-size 256))
548     (assert-condition 9p-error
549         (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
550 
551 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
552   (let ((buffer-size 256))
553     (assert-condition 9p-error
554         (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
555 
556 (defun example-copy-file (from to &optional (root "/"))
557   (with-open-ssl-stream (stream
558                          socket
559                          *host*
560                          *port*
561                          *client-certificate*
562                          *certificate-key*)
563     (let* ((*messages-sent* ())
564            (root-fid        (mount stream root)))
565       (copy-file stream root-fid from to)
566       (slurp-file stream root-fid to))))
567 
568 (deftest test-copy-file ((kami-suite) (test-write-huge-file))
569   (assert-equality #'equalp
570       (make-huge-data)
571       (example-copy-file *remote-test-path-huge*
572                          (concatenate 'string
573                                       *remote-test-path-huge*
574                                       "-copy"))))
575 
576 (defun example-move-file (from to &optional (root "/"))
577   (with-open-ssl-stream (stream
578                          socket
579                          *host*
580                          *port*
581                          *client-certificate*
582                          *certificate-key*)
583     (let* ((*messages-sent* ())
584            (root-fid        (mount stream root)))
585       (move-file stream root-fid from to)
586       (path-exists-p stream root-fid from))))
587 
588 (defun renamed-filename ()
589   (concatenate 'string *remote-test-path-huge* "-renamed"))
590 
591 (deftest test-move-file ((kami-suite) (test-copy-file))
592   (assert-false (example-move-file *remote-test-path-huge* (renamed-filename))))
593 
594 (alexandria:define-constant +truncate-size+ 128 :test #'=)
595 
596 (defun example-truncate-file (path &optional (root "/"))
597   (with-open-ssl-stream (stream
598                          socket
599                          *host*
600                          *port*
601                          *client-certificate*
602                          *certificate-key*)
603     (let* ((*messages-sent* ())
604            (root-fid        (mount stream root)))
605       (truncate-file stream root-fid path :new-size +truncate-size+)
606       (stat-size (path-info stream root-fid path)))))
607 
608 (deftest test-truncate-file ((kami-suite) (test-move-file))
609   (assert-equality #'=
610       +truncate-size+
611       (example-truncate-file (renamed-filename))))
612 
613 (alexandria:define-constant +new-atime+   (encode-universal-time 0 0 10 22 10 1990) :test #'=)
614 
615 (alexandria:define-constant +new-atime-2+ (encode-universal-time 0 0 10 22 10 1999) :test #'=)
616 
617 (alexandria:define-constant +new-mtime+   (encode-universal-time 0 0 11 23 11 1991) :test #'=)
618 
619 (alexandria:define-constant +new-mtime-2+ (encode-universal-time 0 0 11 23 11 2001) :test #'=)
620 
621 (defun example-change-access-time-file (path time &optional (root "/"))
622   (with-open-ssl-stream (stream
623                          socket
624                          *host*
625                          *port*
626                          *client-certificate*
627                          *certificate-key*)
628     (let* ((*messages-sent* ())
629            (root-fid        (mount stream root)))
630       (change-access-time stream root-fid path time)
631       (let ((info (path-info stream root-fid path)))
632         (stat-atime info)))))
633 
634 (defun example-change-modify-time-file (path time &optional (root "/"))
635   (with-open-ssl-stream (stream
636                          socket
637                          *host*
638                          *port*
639                          *client-certificate*
640                          *certificate-key*)
641     (let* ((*messages-sent* ())
642            (root-fid        (mount stream root)))
643       (change-modify-time stream root-fid path time)
644       (let ((info (path-info stream root-fid path)))
645         (stat-mtime info)))))
646 
647 (defun example-change-times-file (path atime mtime &optional (root "/"))
648   (with-open-ssl-stream (stream
649                          socket
650                          *host*
651                          *port*
652                          *client-certificate*
653                          *certificate-key*)
654     (let* ((*messages-sent* ())
655            (root-fid        (mount stream root)))
656       (change-time-values stream root-fid path atime mtime)
657       (let ((info (path-info stream root-fid path)))
658         (values (stat-atime info)
659                 (stat-mtime info))))))
660 
661 (deftest test-change-access-time ((kami-suite) (test-move-file))
662   (assert-equality #'=
663       +new-atime+
664       (example-change-access-time-file (renamed-filename) +new-atime+))
665   (assert-equality #'=
666       +new-mtime+
667       (example-change-modify-time-file (renamed-filename) +new-mtime+))
668   (let ((expected-times (list +new-atime-2+ +new-mtime-2+)))
669     (assert-equalp expected-times
670         (multiple-value-list (example-change-times-file (renamed-filename)
671                                                         +new-atime-2+
672                                                         +new-mtime-2+)))))
673 
674 (alexandria::define-constant +many-files-number+ 10000               :test #'=)
675 
676 (alexandria::define-constant +many-files-path+   "/many/open/files/" :test #'string=)
677 
678 (alexandria::define-constant +many-files-format+ "~a/~a.dummy"       :test #'string=)
679 
680 (defun example-create-many-files (path &optional (root "/"))
681   (with-open-ssl-stream (stream
682                          socket
683                          *host*
684                          *port*
685                          *client-certificate*
686                          *certificate-key*)
687     (let* ((*messages-sent* ())
688            (root-fid        (mount stream root)))
689       (length (loop for i from 0 below +many-files-number+
690                     collect
691                     (let* ((cloned-fid  (clone-fid stream root-fid))
692                            (created-fid (create-path stream
693                                                      cloned-fid
694                                                      (format nil
695                                                              +many-files-format+
696                                                              path
697                                                              i))))
698                       (9p-clunk stream created-fid)
699                       cloned-fid))))))
700 
701 (deftest test-create-many-files ((kami-suite) (test-move-file))
702   (assert-equality #'=
703       +many-files-number+
704       (ignore-errors (example-create-many-files +many-files-path+))))
705 
706 (defun example-open-many-files (path &optional (root "/"))
707   (with-open-ssl-stream (stream
708                          socket
709                          *host*
710                          *port*
711                          *client-certificate*
712                          *certificate-key*)
713     (let* ((*messages-sent* ())
714            (root-fid        (mount stream root)))
715       (loop for i from 0 below 509 do
716         (9p-clunk stream (open-path stream
717                                     root-fid
718                                     (format nil
719                                             +many-files-format+
720                                             path
721                                             i))))
722       t)))
723 
724 (deftest test-open-many-files ((kami-suite) (test-create-many-files))
725   (assert-true (ignore-errors (example-open-many-files +many-files-path+))))