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-big-buffer*    "/test-file-big-buffer")
29 
30 (defparameter *remote-test-path-contents* (format nil "qwertyuiopasdfghjklòàù è~%"))
31 
32 (alexandria:define-constant +remote-test-path-ovewrwrite-data+ "12" :test #'string=)
33 
34 (defsuite kami-suite (all-suite))
35 
36 (defun start-non-tls-socket (host port)
37   (usocket:socket-connect host
38                           port
39                           :protocol     :stream
40                           :element-type +byte-type+))
41 
42 (defun example-mount (&optional (root  "/"))
43   (with-open-ssl-stream (stream
44                          socket
45                          *host*
46                          *port*
47                          *client-certificate*
48                          *certificate-key*)
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)
55       t)))
56 
57 (deftest test-mount (kami-suite)
58   (assert-true (ignore-errors (example-mount))))
59 
60 (defun example-walk (path &optional (root "/"))
61   (with-open-ssl-stream (stream
62                          socket
63                          *host*
64                          *port*
65                          *client-certificate*
66                          *certificate-key*)
67 
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)
73         t))))
74 
75 (deftest test-walk (kami-suite)
76   (assert-true (ignore-errors (example-walk *remote-test-file*))))
77 
78 (defun example-open-path (path &optional (root "/"))
79   (with-open-ssl-stream (stream
80                          socket
81                          *host*
82                          *port*
83                          *client-certificate*
84                          *certificate-key*)
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)
91         t))))
92 
93 (deftest test-open-path (kami-suite)
94   (assert-true (ignore-errors (example-open-path *remote-test-path*))))
95 
96 (defun example-read (path &optional (root "/"))
97   (with-open-ssl-stream (stream
98                          socket
99                          *host*
100                          *port*
101                          *client-certificate*
102                          *certificate-key*)
103     (let ((*messages-sent* ())
104           (*buffer-size*   256)
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)
111         t))))
112 
113 (deftest test-read ((kami-suite) (test-walk))
114   (assert-true (ignore-errors (example-open-path *remote-test-file*))))
115 
116 (defun example-slurp (path &optional (root "/"))
117   (with-open-ssl-stream (stream
118                          socket
119                          *host*
120                          *port*
121                          *client-certificate*
122                          *certificate-key*)
123     (let ((*messages-sent* ())
124           (*buffer-size*   256)
125           (root-fid        (mount stream root)))
126       (babel:octets-to-string (slurp-file stream
127                                           root-fid path
128                                           :buffer-size 3)
129                               :errorp nil))))
130 
131 (deftest test-slurp-file ((kami-suite) (test-read))
132   (assert-equality #'string=
133       *remote-test-path-contents*
134       (example-slurp *remote-test-path*)))
135 
136 (defun example-write-data (path data &optional (root "/"))
137   (with-open-ssl-stream (stream
138                          socket
139                          *host*
140                          *port*
141                          *client-certificate*
142                          *certificate-key*)
143     (let* ((*messages-sent* ())
144            (*buffer-size*   256)
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)
149       t)))
150 
151 (defun example-write (path &optional (root "/"))
152   (example-write-data path *remote-test-path-contents* root))
153 
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* #()))))
157 
158 (defun example-write-2-3 (path &optional (root "/"))
159   (with-open-ssl-stream (stream
160                          socket
161                          *host*
162                          *port*
163                          *client-certificate*
164                          *certificate-key*)
165     (let* ((*messages-sent* ())
166            (*buffer-size*   256)
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)))))))
174 
175 (defun read-entire-file-as-string (path  &optional (root "/"))
176   (with-open-ssl-stream (stream
177                          socket
178                          *host*
179                          *port*
180                          *client-certificate*
181                          *certificate-key*)
182     (let* ((*messages-sent* ())
183            (*buffer-size*   256)
184            (root-fid        (mount stream root)))
185       (babel:octets-to-string (slurp-file stream root-fid path)))))
186 
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)))
193 
194 (defun example-write-fails (path &optional (root "/"))
195   (with-open-ssl-stream (stream
196                          socket
197                          *host*
198                          *port*
199                          *client-certificate*
200                          *certificate-key*)
201     (let* ((*messages-sent* ())
202            (*buffer-size*   256)
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))))
207 
208 (deftest test-write-on-directory-fails ((kami-suite) (test-write))
209   (assert-condition 9p-error (example-write-fails "/")))
210 
211 (defun example-stat (path &optional (root "/"))
212   (with-open-ssl-stream (stream
213                          socket
214                          *host*
215                          *port*
216                          *client-certificate*
217                          *certificate-key*)
218     (let* ((*messages-sent* ())
219            (*buffer-size*   256)
220            (root-fid        (mount stream root))
221            (fid             (open-path stream root-fid path :mode +create-for-read+))
222            (results         nil))
223       (9p-stat stream fid
224                :callback (lambda (x data)
225                            (declare (ignore x))
226                            (setf results (decode-rstat data))))
227       (read-all-pending-messages stream)
228       results)))
229 
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 "/")))
235   (assert-eq   :file
236       (stat-entry-type (example-stat *remote-test-path*)))
237   (assert-equality #'= 0 (stat-size (example-stat "/"))))
238 
239 (defun example-path-exists (path &optional (root "/"))
240   (with-open-ssl-stream (stream
241                          socket
242                          *host*
243                          *port*
244                          *client-certificate*
245                          *certificate-key*)
246     (let* ((*messages-sent* ())
247            (root-fid        (mount stream root)))
248       (path-exists-p stream root-fid path))))
249 
250 (defun example-path-exists-many-times (path &optional (root "/"))
251   (with-open-ssl-stream (stream
252                          socket
253                          *host*
254                          *port*
255                          *client-certificate*
256                          *certificate-key*)
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))))
262 
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* ".$$$"))))
266 
267 (deftest test-path-exists-many-times ((kami-suite) (test-path-exists))
268   (assert-true  (example-path-exists-many-times *remote-test-path*)))
269 
270 (defun example-create-file (path &optional (root "/"))
271   (with-open-ssl-stream (stream
272                                        socket
273                                        *host*
274                                        *port*
275                                        *client-certificate*
276                                        *certificate-key*)
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)
286         t))))
287 
288 (alexandria:define-constant +create-file+ "test-file-create" :test #'string=)
289 
290 (defun example-create-directory (path &optional (root "/"))
291   (with-open-ssl-stream (stream
292                          socket
293                          *host*
294                          *port*
295                          *client-certificate*
296                          *certificate-key*)
297     (let* ((*messages-sent* ())
298            (root-fid        (mount stream root)))
299       (create-directory stream root-fid path)
300       t)))
301 
302 (alexandria:define-constant +create-directory+ "test-dir-create" :test #'string=)
303 
304 (defun example-create-path-read-write (path &optional (root "/"))
305   (with-open-ssl-stream (stream
306                          socket
307                          *host*
308                          *port*
309                          *client-certificate*
310                          *certificate-key*)
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)))))
320 
321 (defun example-create-path (path &optional (root "/"))
322   (with-open-ssl-stream (stream
323                          socket
324                          *host*
325                          *port*
326                          *client-certificate*
327                          *certificate-key*)
328     (let* ((*messages-sent* ())
329            (root-fid        (mount stream root)))
330       (create-path stream root-fid path))))
331 
332 (alexandria:define-constant +create-path-read-write+ "/a/totaly/new/path/new-file" :test #'string=)
333 
334 (alexandria:define-constant +create-path-dir+ "/this/" :test #'string=)
335 
336 (alexandria:define-constant +create-path-file+ "/this-file" :test #'string=)
337 
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+))))
346 
347 (deftest test-create-existing-path ((kami-suite) (test-create))
348   (assert-true (ignore-errors (example-create-path +create-path-read-write+))))
349 
350 (defun close-parent-fid (&optional (root "/"))
351   (with-open-ssl-stream (stream
352                          socket
353                          *host*
354                          *port*
355                          *client-certificate*
356                          *certificate-key*)
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)
376             t))))))
377 
378 (deftest test-close-parent-fid ((kami-suite) (test-walk))
379   (assert-true (ignore-errors (close-parent-fid))))
380 
381 (defun %remove-path (path &optional (root "/"))
382   (with-open-ssl-stream (stream
383                          socket
384                          *host*
385                          *port*
386                          *client-certificate*
387                          *certificate-key*)
388 
389     (let* ((*messages-sent* ())
390            (root-fid        (mount stream root)))
391       (remove-path stream root-fid path)
392       t)))
393 
394 (deftest test-remove-file ((kami-suite) (test-create-existing-path))
395   (assert-true (ignore-errors (%remove-path +create-path-read-write+))))
396 
397 (defun parent-dir-path (path)
398   (let ((position-backslash (position #\/ path :from-end t :test #'char=)))
399     (subseq path 0 position-backslash)))
400 
401 (deftest test-remove-directory ((kami-suite) (test-remove-file))
402   (assert-true
403       (ignore-errors (%remove-path (parent-dir-path +create-path-read-write+)))))
404 
405 (defun read-dir-same-offset (dir-path &optional (root "/"))
406   (with-open-ssl-stream (stream
407                          socket
408                          *host*
409                          *port*
410                          *client-certificate*
411                          *certificate-key*)
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))
416            (res-read-1      nil)
417            (res-read-2      nil))
418       (9p-read stream
419                dir-fid
420                0  10
421                :callback (lambda (x data)
422                            (declare (ignore x))
423                            (setf res-read-1 data)))
424       (9p-read stream
425                dir-fid
426                0  10
427                :callback (lambda (x data)
428                            (declare (ignore x))
429                            (setf res-read-2 data)))
430       (read-all-pending-messages stream)
431       (not (mismatch res-read-1 res-read-2)))))
432 
433 (defun example-directory-children (path &optional (root "/"))
434   (with-open-ssl-stream (stream
435                          socket
436                          *host*
437                          *port*
438                          *client-certificate*
439                          *certificate-key*)
440     (let* ((*messages-sent* ())
441            (root-fid        (mount stream root)))
442       (collect-directory-children stream root-fid path))))
443 
444 (deftest test-collect-dir-root-children ((kami-suite) (test-read))
445   (assert-true (example-directory-children "/")))
446 
447 (defun make-huge-data ()
448   (let* ((*random-state* (make-random-state nil)))
449     (make-array 1000000
450                 :element-type '(unsigned-byte 8)
451                 :initial-contents (loop repeat 1000000
452                                         collect
453                                         (random 256)))))
454 
455 (defun write-huge-file (path &optional (root "/"))
456   (with-open-ssl-stream (stream
457                          socket
458                          *host*
459                          *port*
460                          *client-certificate*
461                          *certificate-key*)
462     (let* ((*messages-sent* ())
463            (*buffer-size*   256)
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))))
472 
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)))
476 
477 (defun write-big-buffer (path &optional (root "/"))
478   (with-open-ssl-stream (stream
479                          socket
480                          *host*
481                          *port*
482                          *client-certificate*
483                          *certificate-key*)
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))))
494 
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)))
498 
499 (defun read-huge-file (path &optional (root "/"))
500   (with-open-ssl-stream (stream
501                          socket
502                          *host*
503                          *port*
504                          *client-certificate*
505                          *certificate-key*)
506     (let ((*messages-sent* ())
507           (*buffer-size*   4096)
508           (root-fid        (mount stream root)))
509       (slurp-file stream
510                   root-fid path
511                   :buffer-size 3000))))
512 
513 (deftest test-read-huge-data ((kami-suite) (test-write-huge-file))
514   (assert-equality #'=
515       (length (make-huge-data))
516       (length (read-huge-file *remote-test-path-huge*))))
517 
518 (defun read-a-tiny-amount-of-data (path amount &optional (root "/"))
519   (with-open-ssl-stream (stream
520                          socket
521                          *host*
522                          *port*
523                          *client-certificate*
524                          *certificate-key*)
525     (let* ((*messages-sent* ())
526            (*buffer-size*   4096)
527            (root-fid        (mount stream root))
528            (path-fid        (open-path stream root-fid path))
529            (results         nil))
530       (9p-read stream
531                path-fid
532                0
533                amount
534                :callback (lambda (x reply)
535                            (declare (ignore x))
536                            (let ((data (decode-read-reply reply nil)))
537                              (setf results data))))
538       (read-all-pending-messages stream)
539       results)))
540 
541 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
542   (let ((amount 3))
543     (assert-equality #'=
544         amount
545         (length (read-a-tiny-amount-of-data *remote-test-path-huge* amount)))))
546 
547 (defun read-data-exceeding-msize (path buffer-size &optional (root "/"))
548   (with-open-ssl-stream (stream
549                          socket
550                          *host*
551                          *port*
552                          *client-certificate*
553                          *certificate-key*)
554     (let* ((*messages-sent* ())
555            (*buffer-size*   buffer-size)
556            (root-fid        (mount stream root))
557            (path-fid        (open-path stream root-fid path))
558            (results         nil))
559       (9p-read stream
560                path-fid
561                0
562                (* 2 buffer-size)
563                :callback (lambda (x reply)
564                            (declare (ignore x))
565                            (let ((data (decode-read-reply reply nil)))
566                              (setf results data))))
567       (read-all-pending-messages stream)
568       results)))
569 
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))))
574 
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))))
579 
580 (defun example-copy-file (from to &optional (root "/"))
581   (with-open-ssl-stream (stream
582                          socket
583                          *host*
584                          *port*
585                          *client-certificate*
586                          *certificate-key*)
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))))
591 
592 (deftest test-copy-file ((kami-suite) (test-write-huge-file))
593   (assert-equality #'equalp
594       (make-huge-data)
595       (example-copy-file *remote-test-path-huge*
596                          (concatenate 'string
597                                       *remote-test-path-huge*
598                                       "-copy"))))
599 
600 (defun example-move-file (from to &optional (root "/"))
601   (with-open-ssl-stream (stream
602                          socket
603                          *host*
604                          *port*
605                          *client-certificate*
606                          *certificate-key*)
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))))
611 
612 (defun renamed-filename ()
613   (concatenate 'string *remote-test-path-huge* "-renamed"))
614 
615 (deftest test-move-file ((kami-suite) (test-copy-file))
616   (assert-false (example-move-file *remote-test-path-huge* (renamed-filename))))
617 
618 (alexandria:define-constant +truncate-size+ 128 :test #'=)
619 
620 (defun example-truncate-file (path &optional (root "/"))
621   (with-open-ssl-stream (stream
622                          socket
623                          *host*
624                          *port*
625                          *client-certificate*
626                          *certificate-key*)
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)))))
631 
632 (deftest test-truncate-file ((kami-suite) (test-move-file))
633   (assert-equality #'=
634       +truncate-size+
635       (example-truncate-file (renamed-filename))))
636 
637 (alexandria:define-constant +new-atime+   (encode-universal-time 0 0 10 22 10 1990) :test #'=)
638 
639 (alexandria:define-constant +new-atime-2+ (encode-universal-time 0 0 10 22 10 1999) :test #'=)
640 
641 (alexandria:define-constant +new-mtime+   (encode-universal-time 0 0 11 23 11 1991) :test #'=)
642 
643 (alexandria:define-constant +new-mtime-2+ (encode-universal-time 0 0 11 23 11 2001) :test #'=)
644 
645 (defun example-change-access-time-file (path time &optional (root "/"))
646   (with-open-ssl-stream (stream
647                          socket
648                          *host*
649                          *port*
650                          *client-certificate*
651                          *certificate-key*)
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)))))
657 
658 (defun example-change-modify-time-file (path time &optional (root "/"))
659   (with-open-ssl-stream (stream
660                          socket
661                          *host*
662                          *port*
663                          *client-certificate*
664                          *certificate-key*)
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)))))
670 
671 (defun example-change-times-file (path atime mtime &optional (root "/"))
672   (with-open-ssl-stream (stream
673                          socket
674                          *host*
675                          *port*
676                          *client-certificate*
677                          *certificate-key*)
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))))))
684 
685 (deftest test-change-access-time ((kami-suite) (test-move-file))
686   (assert-equality #'=
687       +new-atime+
688       (example-change-access-time-file (renamed-filename) +new-atime+))
689   (assert-equality #'=
690       +new-mtime+
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)
695                                                         +new-atime-2+
696                                                         +new-mtime-2+)))))
697 
698 (alexandria::define-constant +many-files-number+ 10000               :test #'=)
699 
700 (alexandria::define-constant +many-files-path+   "/many/open/files/" :test #'string=)
701 
702 (alexandria::define-constant +many-files-format+ "~a/~a.dummy"       :test #'string=)
703 
704 (defun example-create-many-files (path &optional (root "/"))
705   (with-open-ssl-stream (stream
706                          socket
707                          *host*
708                          *port*
709                          *client-certificate*
710                          *certificate-key*)
711     (let* ((*messages-sent* ())
712            (root-fid        (mount stream root)))
713       (length (loop for i from 0 below +many-files-number+
714                     collect
715                     (let* ((cloned-fid  (clone-fid stream root-fid))
716                            (created-fid (create-path stream
717                                                      cloned-fid
718                                                      (format nil
719                                                              +many-files-format+
720                                                              path
721                                                              i))))
722                       (9p-clunk stream created-fid)
723                       cloned-fid))))))
724 
725 (deftest test-create-many-files ((kami-suite) (test-move-file))
726   (assert-equality #'=
727       +many-files-number+
728       (ignore-errors (example-create-many-files +many-files-path+))))
729 
730 (defun example-open-many-files (path &optional (root "/"))
731   (with-open-ssl-stream (stream
732                          socket
733                          *host*
734                          *port*
735                          *client-certificate*
736                          *certificate-key*)
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
741                                     root-fid
742                                     (format nil
743                                             +many-files-format+
744                                             path
745                                             i))))
746       t)))
747 
748 (deftest test-open-many-files ((kami-suite) (test-create-many-files))
749   (assert-true (ignore-errors (example-open-many-files +many-files-path+))))