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-message stream)
51       (9p-attach stream root)
52       (read-all-pending-message 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-message 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-message 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-message 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 (path &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 *remote-test-path-contents*)
146       (read-all-pending-message stream)
147       t)))
148 
149 (deftest test-write ((kami-suite) (test-open-path test-read))
150   (assert-true (ignore-errors (example-write *remote-test-path-write*))))
151 
152 (defun example-write-2-3 (path &optional (root "/"))
153   (with-open-ssl-stream (stream
154                          socket
155                          *host*
156                          *port*
157                          *client-certificate*
158                          *certificate-key*)
159     (let* ((*messages-sent* ())
160            (*buffer-size*   256)
161            (root-fid        (mount stream root)))
162       (with-new-fid (saved-root-fid)
163         (9p-walk stream root-fid saved-root-fid +nwname-clone+)
164         (let ((fid (open-path stream root-fid path :mode +create-for-read-write+)))
165           (9p-write stream fid 2 +remote-test-path-ovewrwrite-data+)
166           (read-all-pending-message stream)
167           (babel:octets-to-string (slurp-file stream saved-root-fid path)))))))
168 
169 (defun read-entire-file-as-string (path  &optional (root "/"))
170   (with-open-ssl-stream (stream
171                          socket
172                          *host*
173                          *port*
174                          *client-certificate*
175                          *certificate-key*)
176     (let* ((*messages-sent* ())
177            (*buffer-size*   256)
178            (root-fid        (mount stream root)))
179       (babel:octets-to-string (slurp-file stream root-fid path)))))
180 
181 (deftest test-example-write-2-3 ((kami-suite) (test-write))
182   (example-write-2-3 *remote-test-path-write*)
183   (let* ((expected-sequence (copy-seq *remote-test-path-contents*))
184          (file-sequence     (read-entire-file-as-string *remote-test-path-write*)))
185     (setf (subseq expected-sequence 2 4) +remote-test-path-ovewrwrite-data+)
186     (assert-equality #'string= file-sequence expected-sequence)))
187 
188 (defun example-write-fails (path &optional (root "/"))
189   (with-open-ssl-stream (stream
190                          socket
191                          *host*
192                          *port*
193                          *client-certificate*
194                          *certificate-key*)
195     (let* ((*messages-sent* ())
196            (*buffer-size*   256)
197            (root-fid        (mount stream root))
198            (fid             (open-path stream root-fid path :mode +create-for-read-write+)))
199       (9p-write stream fid 0 *remote-test-path-contents*)
200       (read-all-pending-message stream))))
201 
202 (deftest test-write-on-directory-fails ((kami-suite) (test-write))
203   (assert-condition 9p-error (example-write-fails "/")))
204 
205 (defun example-stat (path &optional (root "/"))
206   (with-open-ssl-stream (stream
207                          socket
208                          *host*
209                          *port*
210                          *client-certificate*
211                          *certificate-key*)
212     (let* ((*messages-sent* ())
213            (*buffer-size*   256)
214            (root-fid        (mount stream root))
215            (fid             (open-path stream root-fid path :mode +create-for-read+))
216            (results         nil))
217       (9p-stat stream fid
218                :callback (lambda (x data)
219                            (declare (ignore x))
220                            (setf results (decode-rstat data))))
221       (read-all-pending-message stream)
222       results)))
223 
224 (deftest test-stat (kami-suite)
225   (assert-true (ignore-errors (example-stat "/")))
226   (assert-true (ignore-errors (example-stat *remote-test-path*)))
227   (assert-eq   :directory
228       (stat-entry-type (example-stat "/")))
229   (assert-eq   :file
230       (stat-entry-type (example-stat *remote-test-path*)))
231   (assert-equality #'= 0 (stat-size (example-stat "/"))))
232 
233 (defun example-path-exists (path &optional (root "/"))
234   (with-open-ssl-stream (stream
235                          socket
236                          *host*
237                          *port*
238                          *client-certificate*
239                          *certificate-key*)
240     (let* ((*messages-sent* ())
241            (root-fid        (mount stream root)))
242       (path-exists-p stream root-fid path)
243       (path-exists-p stream root-fid path))))
244 
245 (deftest test-path-exists ((kami-suite) (test-stat))
246   (assert-true  (example-path-exists *remote-test-path*))
247   (assert-false (example-path-exists (concatenate 'string *remote-test-path* ".$$$"))))
248 
249 (defun example-create-file (path &optional (root "/"))
250   (with-open-ssl-stream (stream
251                                        socket
252                                        *host*
253                                        *port*
254                                        *client-certificate*
255                                        *certificate-key*)
256     (let* ((*messages-sent* ())
257            (root-fid        (mount stream root)))
258       (with-new-fid (saved-root-fid)
259         (9p-walk stream root-fid saved-root-fid +nwname-clone+)
260         (9p-create stream root-fid path)
261         (read-all-pending-message stream)
262         (9p-clunk stream root-fid)
263         (open-path stream saved-root-fid path)
264         (read-all-pending-message stream)
265         t))))
266 
267 (alexandria:define-constant +create-file+ "test-file-create" :test #'string=)
268 
269 (defun example-create-directory (path &optional (root "/"))
270   (with-open-ssl-stream (stream
271                          socket
272                          *host*
273                          *port*
274                          *client-certificate*
275                          *certificate-key*)
276     (let* ((*messages-sent* ())
277            (root-fid        (mount stream root)))
278       (create-directory stream root-fid path)
279       t)))
280 
281 (alexandria:define-constant +create-directory+ "test-dir-create" :test #'string=)
282 
283 (defun example-create-path-read-write (path &optional (root "/"))
284   (with-open-ssl-stream (stream
285                          socket
286                          *host*
287                          *port*
288                          *client-certificate*
289                          *certificate-key*)
290     (let* ((*messages-sent* ())
291            (root-fid        (mount stream root))
292            (saved-root-fid  (clone-fid stream root-fid))
293            (new-path-fid    (create-path stream root-fid path)))
294       (9p-write stream new-path-fid 0 *remote-test-path-contents*)
295       (read-all-pending-message stream)
296       (9p-clunk stream new-path-fid)
297       (read-all-pending-message stream)
298       (babel:octets-to-string (slurp-file stream saved-root-fid path)))))
299 
300 (defun example-create-path (path &optional (root "/"))
301   (with-open-ssl-stream (stream
302                          socket
303                          *host*
304                          *port*
305                          *client-certificate*
306                          *certificate-key*)
307     (let* ((*messages-sent* ())
308            (root-fid        (mount stream root)))
309       (create-path stream root-fid path))))
310 
311 (alexandria:define-constant +create-path-read-write+ "/a/totaly/new/path/new-file" :test #'string=)
312 
313 (alexandria:define-constant +create-path-dir+ "/this/" :test #'string=)
314 
315 (alexandria:define-constant +create-path-file+ "/this-file" :test #'string=)
316 
317 (deftest test-create ((kami-suite) (test-open-path))
318   (assert-true (ignore-errors (example-create-file +create-file+)))
319   (assert-true (ignore-errors (example-create-directory +create-directory+)))
320   (assert-true (ignore-errors (example-create-path +create-path-dir+)))
321   (assert-true (ignore-errors (example-create-path +create-path-file+)))
322   (assert-equality #'string=
323       *remote-test-path-contents*
324       (ignore-errors (example-create-path-read-write +create-path-read-write+))))
325 
326 (deftest test-create-existing-path ((kami-suite) (test-create))
327   (assert-true (ignore-errors (example-create-path +create-path-read-write+))))
328 
329 (defun close-parent-fid (&optional (root "/"))
330   (with-open-ssl-stream (stream
331                          socket
332                          *host*
333                          *port*
334                          *client-certificate*
335                          *certificate-key*)
336     (let* ((*messages-sent* ())
337            (root-fid        (mount stream root)))
338       (with-new-fid (dir-fid)
339         (9p-walk stream root-fid dir-fid "dir")
340         (read-all-pending-message stream)
341         (9p-clunk stream root-fid)
342         (read-all-pending-message stream)
343         (with-new-fid (subdir-fid)
344           (9p-walk stream dir-fid subdir-fid "subdir")
345           (read-all-pending-message stream)
346           (9p-clunk stream dir-fid)
347           (read-all-pending-message stream)
348           (with-new-fid (file-fid)
349             (9p-walk stream subdir-fid file-fid "test-file-write")
350             (read-all-pending-message stream)
351             (9p-clunk stream subdir-fid)
352             (read-all-pending-message stream)
353             (9p-open stream file-fid)
354             (read-all-pending-message stream)
355             t))))))
356 
357 (deftest test-close-parent-fid ((kami-suite) (test-walk))
358   (assert-true (ignore-errors (close-parent-fid))))
359 
360 (defun %remove-path (path &optional (root "/"))
361   (with-open-ssl-stream (stream
362                          socket
363                          *host*
364                          *port*
365                          *client-certificate*
366                          *certificate-key*)
367 
368     (let* ((*messages-sent* ())
369            (root-fid        (mount stream root)))
370       (remove-path stream root-fid path)
371       t)))
372 
373 (deftest test-remove-file ((kami-suite) (test-create-existing-path))
374   (assert-true (ignore-errors (%remove-path +create-path-read-write+))))
375 
376 (defun parent-dir-path (path)
377   (let ((position-backslash (position #\/ path :from-end t :test #'char=)))
378     (subseq path 0 position-backslash)))
379 
380 (deftest test-remove-directory ((kami-suite) (test-remove-file))
381   (assert-true
382       (ignore-errors (%remove-path (parent-dir-path +create-path-read-write+)))))
383 
384 (defun read-dir-same-offset (dir-path &optional (root "/"))
385   (with-open-ssl-stream (stream
386                          socket
387                          *host*
388                          *port*
389                          *client-certificate*
390                          *certificate-key*)
391     (let* ((*messages-sent* ())
392            (root-fid        (mount stream root))
393            (root-fid-cloned (clone-fid stream root-fid))
394            (dir-fid         (open-path stream root-fid-cloned dir-path))
395            (res-read-1      nil)
396            (res-read-2      nil))
397       (9p-read stream
398                dir-fid
399                0  10
400                :callback (lambda (x data)
401                            (declare (ignore x))
402                            (setf res-read-1 data)))
403       (9p-read stream
404                dir-fid
405                0  10
406                :callback (lambda (x data)
407                            (declare (ignore x))
408                            (setf res-read-2 data)))
409       (read-all-pending-message stream)
410       (not (mismatch res-read-1 res-read-2)))))
411 
412 (defun example-directory-children (path &optional (root "/"))
413   (with-open-ssl-stream (stream
414                          socket
415                          *host*
416                          *port*
417                          *client-certificate*
418                          *certificate-key*)
419     (let* ((*messages-sent* ())
420            (root-fid        (mount stream root)))
421       (collect-directory-children stream root-fid path))))
422 
423 (deftest test-collect-dir-root-children ((kami-suite) (test-read))
424   (assert-true (example-directory-children "/")))
425 
426 (defun make-huge-data ()
427   (let* ((*random-state* (make-random-state nil)))
428     (make-array 1000000
429                 :element-type '(unsigned-byte 8)
430                 :initial-contents (loop repeat 1000000
431                                         collect
432                                         (random 256)))))
433 
434 (defun write-huge-file (path &optional (root "/"))
435   (with-open-ssl-stream (stream
436                          socket
437                          *host*
438                          *port*
439                          *client-certificate*
440                          *certificate-key*)
441     (let* ((*messages-sent* ())
442            (*buffer-size*   256)
443            (root-fid        (mount stream root))
444            (saved-root-fid  (clone-fid stream root-fid))
445            (fid             (create-path stream root-fid path))
446            (data            (make-huge-data)))
447       (9p-write stream fid 0 data)
448       (9p-clunk stream fid)
449       (read-all-pending-message stream)
450       (path-info stream saved-root-fid path))))
451 
452 (deftest test-write-huge-file ((kami-suite) (test-collect-dir-root-children))
453   (let* ((size-file  (stat-size (write-huge-file *remote-test-path-huge*))))
454     (assert-equality #'= (length (make-huge-data)) size-file)))
455 
456 (defun read-huge-file (path &optional (root "/"))
457   (with-open-ssl-stream (stream
458                          socket
459                          *host*
460                          *port*
461                          *client-certificate*
462                          *certificate-key*)
463     (let ((*messages-sent* ())
464           (*buffer-size*   4096)
465           (root-fid        (mount stream root)))
466       (slurp-file stream
467                   root-fid path
468                   :buffer-size 3000))))
469 
470 (deftest test-read-huge-data ((kami-suite) (test-write-huge-file))
471   (assert-equality #'=
472       (length (make-huge-data))
473       (length (read-huge-file *remote-test-path-huge*))))
474 
475 (defun read-a-tiny-amount-of-data (path amount &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            (path-fid        (open-path stream root-fid path))
486            (results         nil))
487       (9p-read stream
488                path-fid
489                0
490                amount
491                :callback (lambda (x reply)
492                            (declare (ignore x))
493                            (let ((data (decode-read-reply reply nil)))
494                              (setf results data))))
495       (read-all-pending-message stream)
496       results)))
497 
498 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
499   (let ((amount 3))
500     (assert-equality #'=
501         amount
502         (length (read-a-tiny-amount-of-data *remote-test-path-huge* amount)))))
503 
504 (defun read-data-exceeding-msize (path buffer-size &optional (root "/"))
505   (with-open-ssl-stream (stream
506                          socket
507                          *host*
508                          *port*
509                          *client-certificate*
510                          *certificate-key*)
511     (let* ((*messages-sent* ())
512            (*buffer-size*   buffer-size)
513            (root-fid        (mount stream root))
514            (path-fid        (open-path stream root-fid path))
515            (results         nil))
516       (9p-read stream
517                path-fid
518                0
519                (* 2 buffer-size)
520                :callback (lambda (x reply)
521                            (declare (ignore x))
522                            (let ((data (decode-read-reply reply nil)))
523                              (setf results data))))
524       (read-all-pending-message stream)
525       results)))
526 
527 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
528   (let ((buffer-size 256))
529     (assert-condition 9p-error
530         (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
531 
532 (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
533   (let ((buffer-size 256))
534     (assert-condition 9p-error
535         (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
536 
537 (defun example-copy-file (from to &optional (root "/"))
538   (with-open-ssl-stream (stream
539                          socket
540                          *host*
541                          *port*
542                          *client-certificate*
543                          *certificate-key*)
544     (let* ((*messages-sent* ())
545            (root-fid        (mount stream root)))
546       (copy-file stream root-fid from to)
547       (slurp-file stream root-fid to))))
548 
549 (deftest test-copy-file ((kami-suite) (test-write-huge-file))
550   (assert-equality #'equalp
551       (make-huge-data)
552       (example-copy-file *remote-test-path-huge*
553                          (concatenate 'string
554                                       *remote-test-path-huge*
555                                       "-copy"))))
556 
557 (defun example-move-file (from to &optional (root "/"))
558   (with-open-ssl-stream (stream
559                          socket
560                          *host*
561                          *port*
562                          *client-certificate*
563                          *certificate-key*)
564     (let* ((*messages-sent* ())
565            (root-fid        (mount stream root)))
566       (move-file stream root-fid from to)
567       (path-exists-p stream root-fid from))))
568 
569 (deftest test-move-file ((kami-suite) (test-copy-file))
570   (assert-false (example-move-file *remote-test-path-huge*
571                                    (concatenate 'string
572                                                 *remote-test-path-huge*
573                                                 "-renamed"))))