1 34719c28 2021-12-31 cage ;; test suite for kami
2 34719c28 2021-12-31 cage ;; Copyright (C) 2021 cage
4 34719c28 2021-12-31 cage ;; This program is free software: you can redistribute it and/or modify
5 34719c28 2021-12-31 cage ;; it under the terms of the GNU General Public License as published by
6 34719c28 2021-12-31 cage ;; the Free Software Foundation, either version 3 of the License, or
7 34719c28 2021-12-31 cage ;; (at your option) any later version.
9 34719c28 2021-12-31 cage ;; This program is distributed in the hope that it will be useful,
10 34719c28 2021-12-31 cage ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 34719c28 2021-12-31 cage ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 34719c28 2021-12-31 cage ;; GNU General Public License for more details.
14 34719c28 2021-12-31 cage ;; You should have received a copy of the GNU General Public License
15 34719c28 2021-12-31 cage ;; along with this program.
16 34719c28 2021-12-31 cage ;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
18 34719c28 2021-12-31 cage (in-package :kami-tests)
20 34719c28 2021-12-31 cage (defparameter *remote-test-file* "test-file") ; note: missing "/" is intentional
22 34719c28 2021-12-31 cage (defparameter *remote-test-path* "/test-file")
24 34719c28 2021-12-31 cage (defparameter *remote-test-path-write* "/dir/subdir/test-file-write")
26 f7920b3b 2022-01-02 cage (defparameter *remote-test-path-huge* "/test-file-huge")
28 34719c28 2021-12-31 cage (defparameter *remote-test-path-contents* (format nil "qwertyuiopasdfghjklòàù è~%"))
30 34719c28 2021-12-31 cage (alexandria:define-constant +remote-test-path-ovewrwrite-data+ "12" :test #'string=)
32 34719c28 2021-12-31 cage (defsuite kami-suite (all-suite))
34 34719c28 2021-12-31 cage (defun start-non-tls-socket (host port)
35 34719c28 2021-12-31 cage (usocket:socket-connect host
37 34719c28 2021-12-31 cage :protocol :stream
38 34719c28 2021-12-31 cage :element-type +byte-type+))
40 34719c28 2021-12-31 cage (defun example-mount (&optional (root "/"))
41 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
45 34719c28 2021-12-31 cage *client-certificate*
46 34719c28 2021-12-31 cage *certificate-key*)
47 34719c28 2021-12-31 cage (let ((*messages-sent* '())
48 34719c28 2021-12-31 cage (root-fid (mount stream root)))
49 34719c28 2021-12-31 cage (9p-clunk stream root-fid)
50 34719c28 2021-12-31 cage (read-all-pending-message stream)
51 34719c28 2021-12-31 cage (9p-attach stream root)
52 34719c28 2021-12-31 cage (read-all-pending-message stream)
55 34719c28 2021-12-31 cage (deftest test-mount (kami-suite)
56 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-mount))))
58 34719c28 2021-12-31 cage (defun example-walk (path &optional (root "/"))
59 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
63 34719c28 2021-12-31 cage *client-certificate*
64 34719c28 2021-12-31 cage *certificate-key*)
66 34719c28 2021-12-31 cage (let ((*messages-sent* '())
67 34719c28 2021-12-31 cage (root-fid (mount stream root)))
68 34719c28 2021-12-31 cage (with-new-fid (path-fid)
69 34719c28 2021-12-31 cage (9p-walk stream root-fid path-fid path)
70 34719c28 2021-12-31 cage (read-all-pending-message stream)
73 34719c28 2021-12-31 cage (deftest test-walk (kami-suite)
74 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-walk *remote-test-file*))))
76 34719c28 2021-12-31 cage (defun example-open-path (path &optional (root "/"))
77 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
81 34719c28 2021-12-31 cage *client-certificate*
82 34719c28 2021-12-31 cage *certificate-key*)
83 34719c28 2021-12-31 cage (let ((*messages-sent* '())
84 34719c28 2021-12-31 cage (root-fid (mount stream root)))
85 34719c28 2021-12-31 cage (with-new-fid (saved-root-fid)
86 34719c28 2021-12-31 cage (9p-walk stream root-fid saved-root-fid +nwname-clone+)
87 34719c28 2021-12-31 cage (open-path stream root-fid path)
88 34719c28 2021-12-31 cage (read-all-pending-message stream)
91 34719c28 2021-12-31 cage (deftest test-open-path (kami-suite)
92 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-open-path *remote-test-path*))))
94 34719c28 2021-12-31 cage (defun example-read (path &optional (root "/"))
95 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
99 34719c28 2021-12-31 cage *client-certificate*
100 34719c28 2021-12-31 cage *certificate-key*)
101 34719c28 2021-12-31 cage (let ((*messages-sent* ())
102 34719c28 2021-12-31 cage (*buffer-size* 256)
103 34719c28 2021-12-31 cage (root-fid (mount stream root)))
104 34719c28 2021-12-31 cage (with-new-fid (path-fid)
105 34719c28 2021-12-31 cage (9p-walk stream root-fid path-fid path)
106 34719c28 2021-12-31 cage (9p-open stream path-fid)
107 34719c28 2021-12-31 cage (9p-read stream path-fid 0 10)
108 34719c28 2021-12-31 cage (read-all-pending-message stream)
111 34719c28 2021-12-31 cage (deftest test-read ((kami-suite) (test-walk))
112 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-open-path *remote-test-file*))))
114 34719c28 2021-12-31 cage (defun example-slurp (path &optional (root "/"))
115 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
119 34719c28 2021-12-31 cage *client-certificate*
120 34719c28 2021-12-31 cage *certificate-key*)
121 34719c28 2021-12-31 cage (let ((*messages-sent* ())
122 34719c28 2021-12-31 cage (*buffer-size* 256)
123 34719c28 2021-12-31 cage (root-fid (mount stream root)))
124 34719c28 2021-12-31 cage (babel:octets-to-string (slurp-file stream
125 34719c28 2021-12-31 cage root-fid path
126 34719c28 2021-12-31 cage :buffer-size 3)
127 34719c28 2021-12-31 cage :errorp nil))))
129 34719c28 2021-12-31 cage (deftest test-slurp-file ((kami-suite) (test-read))
130 34719c28 2021-12-31 cage (assert-equality #'string=
131 34719c28 2021-12-31 cage *remote-test-path-contents*
132 34719c28 2021-12-31 cage (example-slurp *remote-test-path*)))
134 34719c28 2021-12-31 cage (defun example-write (path &optional (root "/"))
135 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
139 34719c28 2021-12-31 cage *client-certificate*
140 34719c28 2021-12-31 cage *certificate-key*)
141 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
142 34719c28 2021-12-31 cage (*buffer-size* 256)
143 34719c28 2021-12-31 cage (root-fid (mount stream root))
144 34719c28 2021-12-31 cage (fid (open-path stream root-fid path :mode +create-for-read-write+)))
145 34719c28 2021-12-31 cage (9p-write stream fid 0 *remote-test-path-contents*)
146 34719c28 2021-12-31 cage (read-all-pending-message stream)
149 34719c28 2021-12-31 cage (deftest test-write ((kami-suite) (test-open-path test-read))
150 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-write *remote-test-path-write*))))
152 34719c28 2021-12-31 cage (defun example-write-2-3 (path &optional (root "/"))
153 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
157 34719c28 2021-12-31 cage *client-certificate*
158 34719c28 2021-12-31 cage *certificate-key*)
159 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
160 34719c28 2021-12-31 cage (*buffer-size* 256)
161 34719c28 2021-12-31 cage (root-fid (mount stream root)))
162 34719c28 2021-12-31 cage (with-new-fid (saved-root-fid)
163 34719c28 2021-12-31 cage (9p-walk stream root-fid saved-root-fid +nwname-clone+)
164 34719c28 2021-12-31 cage (let ((fid (open-path stream root-fid path :mode +create-for-read-write+)))
165 34719c28 2021-12-31 cage (9p-write stream fid 2 +remote-test-path-ovewrwrite-data+)
166 34719c28 2021-12-31 cage (read-all-pending-message stream)
167 34719c28 2021-12-31 cage (babel:octets-to-string (slurp-file stream saved-root-fid path)))))))
169 34719c28 2021-12-31 cage (defun read-entire-file-as-string (path &optional (root "/"))
170 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
174 34719c28 2021-12-31 cage *client-certificate*
175 34719c28 2021-12-31 cage *certificate-key*)
176 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
177 34719c28 2021-12-31 cage (*buffer-size* 256)
178 34719c28 2021-12-31 cage (root-fid (mount stream root)))
179 34719c28 2021-12-31 cage (babel:octets-to-string (slurp-file stream root-fid path)))))
181 34719c28 2021-12-31 cage (deftest test-example-write-2-3 ((kami-suite) (test-write))
182 34719c28 2021-12-31 cage (example-write-2-3 *remote-test-path-write*)
183 34719c28 2021-12-31 cage (let* ((expected-sequence (copy-seq *remote-test-path-contents*))
184 34719c28 2021-12-31 cage (file-sequence (read-entire-file-as-string *remote-test-path-write*)))
185 34719c28 2021-12-31 cage (setf (subseq expected-sequence 2 4) +remote-test-path-ovewrwrite-data+)
186 34719c28 2021-12-31 cage (assert-equality #'string= file-sequence expected-sequence)))
188 34719c28 2021-12-31 cage (defun example-write-fails (path &optional (root "/"))
189 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
193 34719c28 2021-12-31 cage *client-certificate*
194 34719c28 2021-12-31 cage *certificate-key*)
195 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
196 34719c28 2021-12-31 cage (*buffer-size* 256)
197 34719c28 2021-12-31 cage (root-fid (mount stream root))
198 34719c28 2021-12-31 cage (fid (open-path stream root-fid path :mode +create-for-read-write+)))
199 34719c28 2021-12-31 cage (9p-write stream fid 0 *remote-test-path-contents*)
200 34719c28 2021-12-31 cage (read-all-pending-message stream))))
202 34719c28 2021-12-31 cage (deftest test-write-on-directory-fails ((kami-suite) (test-write))
203 34719c28 2021-12-31 cage (assert-condition 9p-error (example-write-fails "/")))
205 34719c28 2021-12-31 cage (defun example-stat (path &optional (root "/"))
206 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
210 34719c28 2021-12-31 cage *client-certificate*
211 34719c28 2021-12-31 cage *certificate-key*)
212 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
213 34719c28 2021-12-31 cage (*buffer-size* 256)
214 34719c28 2021-12-31 cage (root-fid (mount stream root))
215 34719c28 2021-12-31 cage (fid (open-path stream root-fid path :mode +create-for-read+))
216 34719c28 2021-12-31 cage (results nil))
217 34719c28 2021-12-31 cage (9p-stat stream fid
218 34719c28 2021-12-31 cage :callback (lambda (x data)
219 34719c28 2021-12-31 cage (declare (ignore x))
220 34719c28 2021-12-31 cage (setf results (decode-rstat data))))
221 34719c28 2021-12-31 cage (read-all-pending-message stream)
224 34719c28 2021-12-31 cage (deftest test-stat (kami-suite)
225 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-stat "/")))
226 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-stat *remote-test-path*)))
227 34719c28 2021-12-31 cage (assert-eq :directory
228 34719c28 2021-12-31 cage (stat-entry-type (example-stat "/")))
229 34719c28 2021-12-31 cage (assert-eq :file
230 6bb3ac35 2022-01-16 cage (stat-entry-type (example-stat *remote-test-path*)))
231 6bb3ac35 2022-01-16 cage (assert-equality #'= 0 (stat-size (example-stat "/"))))
233 1b3f8c35 2021-12-31 cage (defun example-path-exists (path &optional (root "/"))
234 1b3f8c35 2021-12-31 cage (with-open-ssl-stream (stream
238 1b3f8c35 2021-12-31 cage *client-certificate*
239 1b3f8c35 2021-12-31 cage *certificate-key*)
240 1b3f8c35 2021-12-31 cage (let* ((*messages-sent* ())
241 1b3f8c35 2021-12-31 cage (root-fid (mount stream root)))
242 1b3f8c35 2021-12-31 cage (path-exists-p stream root-fid path)
243 1b3f8c35 2021-12-31 cage (path-exists-p stream root-fid path))))
245 1b3f8c35 2021-12-31 cage (deftest test-path-exists ((kami-suite) (test-stat))
246 1b3f8c35 2021-12-31 cage (assert-true (example-path-exists *remote-test-path*))
247 1b3f8c35 2021-12-31 cage (assert-false (example-path-exists (concatenate 'string *remote-test-path* ".$$$"))))
249 34719c28 2021-12-31 cage (defun example-create-file (path &optional (root "/"))
250 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
254 34719c28 2021-12-31 cage *client-certificate*
255 34719c28 2021-12-31 cage *certificate-key*)
256 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
257 34719c28 2021-12-31 cage (root-fid (mount stream root)))
258 34719c28 2021-12-31 cage (with-new-fid (saved-root-fid)
259 34719c28 2021-12-31 cage (9p-walk stream root-fid saved-root-fid +nwname-clone+)
260 34719c28 2021-12-31 cage (9p-create stream root-fid path)
261 34719c28 2021-12-31 cage (read-all-pending-message stream)
262 34719c28 2021-12-31 cage (9p-clunk stream root-fid)
263 34719c28 2021-12-31 cage (open-path stream saved-root-fid path)
264 34719c28 2021-12-31 cage (read-all-pending-message stream)
267 34719c28 2021-12-31 cage (alexandria:define-constant +create-file+ "test-file-create" :test #'string=)
269 34719c28 2021-12-31 cage (defun example-create-directory (path &optional (root "/"))
270 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
274 34719c28 2021-12-31 cage *client-certificate*
275 34719c28 2021-12-31 cage *certificate-key*)
276 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
277 34719c28 2021-12-31 cage (root-fid (mount stream root)))
278 34719c28 2021-12-31 cage (create-directory stream root-fid path)
281 34719c28 2021-12-31 cage (alexandria:define-constant +create-directory+ "test-dir-create" :test #'string=)
283 1b3f8c35 2021-12-31 cage (defun example-create-path-read-write (path &optional (root "/"))
284 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
288 34719c28 2021-12-31 cage *client-certificate*
289 34719c28 2021-12-31 cage *certificate-key*)
290 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
291 34719c28 2021-12-31 cage (root-fid (mount stream root))
292 34719c28 2021-12-31 cage (saved-root-fid (clone-fid stream root-fid))
293 1b3f8c35 2021-12-31 cage (new-path-fid (create-path stream root-fid path)))
294 34719c28 2021-12-31 cage (9p-write stream new-path-fid 0 *remote-test-path-contents*)
295 34719c28 2021-12-31 cage (read-all-pending-message stream)
296 34719c28 2021-12-31 cage (9p-clunk stream new-path-fid)
297 34719c28 2021-12-31 cage (read-all-pending-message stream)
298 34719c28 2021-12-31 cage (babel:octets-to-string (slurp-file stream saved-root-fid path)))))
300 1b3f8c35 2021-12-31 cage (defun example-create-path (path &optional (root "/"))
301 1b3f8c35 2021-12-31 cage (with-open-ssl-stream (stream
305 1b3f8c35 2021-12-31 cage *client-certificate*
306 1b3f8c35 2021-12-31 cage *certificate-key*)
307 1b3f8c35 2021-12-31 cage (let* ((*messages-sent* ())
308 1b3f8c35 2021-12-31 cage (root-fid (mount stream root)))
309 1b3f8c35 2021-12-31 cage (create-path stream root-fid path))))
311 1b3f8c35 2021-12-31 cage (alexandria:define-constant +create-path-read-write+ "/a/totaly/new/path/new-file" :test #'string=)
313 1b3f8c35 2021-12-31 cage (alexandria:define-constant +create-path-dir+ "/this/" :test #'string=)
315 1b3f8c35 2021-12-31 cage (alexandria:define-constant +create-path-file+ "/this-file" :test #'string=)
317 34719c28 2021-12-31 cage (deftest test-create ((kami-suite) (test-open-path))
318 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-create-file +create-file+)))
319 34719c28 2021-12-31 cage (assert-true (ignore-errors (example-create-directory +create-directory+)))
320 1b3f8c35 2021-12-31 cage (assert-true (ignore-errors (example-create-path +create-path-dir+)))
321 1b3f8c35 2021-12-31 cage (assert-true (ignore-errors (example-create-path +create-path-file+)))
322 34719c28 2021-12-31 cage (assert-equality #'string=
323 34719c28 2021-12-31 cage *remote-test-path-contents*
324 1b3f8c35 2021-12-31 cage (ignore-errors (example-create-path-read-write +create-path-read-write+))))
326 1b3f8c35 2021-12-31 cage (deftest test-create-existing-path ((kami-suite) (test-create))
327 1b3f8c35 2021-12-31 cage (assert-true (ignore-errors (example-create-path +create-path-read-write+))))
329 34719c28 2021-12-31 cage (defun close-parent-fid (&optional (root "/"))
330 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
334 34719c28 2021-12-31 cage *client-certificate*
335 34719c28 2021-12-31 cage *certificate-key*)
336 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
337 34719c28 2021-12-31 cage (root-fid (mount stream root)))
338 34719c28 2021-12-31 cage (with-new-fid (dir-fid)
339 34719c28 2021-12-31 cage (9p-walk stream root-fid dir-fid "dir")
340 34719c28 2021-12-31 cage (read-all-pending-message stream)
341 34719c28 2021-12-31 cage (9p-clunk stream root-fid)
342 34719c28 2021-12-31 cage (read-all-pending-message stream)
343 34719c28 2021-12-31 cage (with-new-fid (subdir-fid)
344 34719c28 2021-12-31 cage (9p-walk stream dir-fid subdir-fid "subdir")
345 34719c28 2021-12-31 cage (read-all-pending-message stream)
346 34719c28 2021-12-31 cage (9p-clunk stream dir-fid)
347 34719c28 2021-12-31 cage (read-all-pending-message stream)
348 34719c28 2021-12-31 cage (with-new-fid (file-fid)
349 34719c28 2021-12-31 cage (9p-walk stream subdir-fid file-fid "test-file-write")
350 34719c28 2021-12-31 cage (read-all-pending-message stream)
351 34719c28 2021-12-31 cage (9p-clunk stream subdir-fid)
352 34719c28 2021-12-31 cage (read-all-pending-message stream)
353 34719c28 2021-12-31 cage (9p-open stream file-fid)
354 34719c28 2021-12-31 cage (read-all-pending-message stream)
357 34719c28 2021-12-31 cage (deftest test-close-parent-fid ((kami-suite) (test-walk))
358 34719c28 2021-12-31 cage (assert-true (ignore-errors (close-parent-fid))))
360 34719c28 2021-12-31 cage (defun %remove-path (path &optional (root "/"))
361 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
365 34719c28 2021-12-31 cage *client-certificate*
366 34719c28 2021-12-31 cage *certificate-key*)
368 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
369 34719c28 2021-12-31 cage (root-fid (mount stream root)))
370 34719c28 2021-12-31 cage (remove-path stream root-fid path)
373 1b3f8c35 2021-12-31 cage (deftest test-remove-file ((kami-suite) (test-create-existing-path))
374 1b3f8c35 2021-12-31 cage (assert-true (ignore-errors (%remove-path +create-path-read-write+))))
376 34719c28 2021-12-31 cage (defun parent-dir-path (path)
377 34719c28 2021-12-31 cage (let ((position-backslash (position #\/ path :from-end t :test #'char=)))
378 34719c28 2021-12-31 cage (subseq path 0 position-backslash)))
380 34719c28 2021-12-31 cage (deftest test-remove-directory ((kami-suite) (test-remove-file))
381 34719c28 2021-12-31 cage (assert-true
382 1b3f8c35 2021-12-31 cage (ignore-errors (%remove-path (parent-dir-path +create-path-read-write+)))))
384 34719c28 2021-12-31 cage (defun read-dir-same-offset (dir-path &optional (root "/"))
385 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
389 34719c28 2021-12-31 cage *client-certificate*
390 34719c28 2021-12-31 cage *certificate-key*)
391 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
392 34719c28 2021-12-31 cage (root-fid (mount stream root))
393 34719c28 2021-12-31 cage (root-fid-cloned (clone-fid stream root-fid))
394 34719c28 2021-12-31 cage (dir-fid (open-path stream root-fid-cloned dir-path))
395 34719c28 2021-12-31 cage (res-read-1 nil)
396 34719c28 2021-12-31 cage (res-read-2 nil))
397 34719c28 2021-12-31 cage (9p-read stream
400 34719c28 2021-12-31 cage :callback (lambda (x data)
401 34719c28 2021-12-31 cage (declare (ignore x))
402 34719c28 2021-12-31 cage (setf res-read-1 data)))
403 34719c28 2021-12-31 cage (9p-read stream
406 34719c28 2021-12-31 cage :callback (lambda (x data)
407 34719c28 2021-12-31 cage (declare (ignore x))
408 34719c28 2021-12-31 cage (setf res-read-2 data)))
409 34719c28 2021-12-31 cage (read-all-pending-message stream)
410 34719c28 2021-12-31 cage (not (mismatch res-read-1 res-read-2)))))
412 34719c28 2021-12-31 cage (defun example-directory-children (path &optional (root "/"))
413 34719c28 2021-12-31 cage (with-open-ssl-stream (stream
417 34719c28 2021-12-31 cage *client-certificate*
418 34719c28 2021-12-31 cage *certificate-key*)
419 34719c28 2021-12-31 cage (let* ((*messages-sent* ())
420 34719c28 2021-12-31 cage (root-fid (mount stream root)))
421 34719c28 2021-12-31 cage (collect-directory-children stream root-fid path))))
423 f7920b3b 2022-01-02 cage (deftest test-collect-dir-root-children ((kami-suite) (test-read))
424 34719c28 2021-12-31 cage (assert-true (example-directory-children "/")))
426 f7920b3b 2022-01-02 cage (defun make-huge-data ()
427 7ea59669 2022-01-07 cage (let* ((*random-state* (make-random-state nil)))
428 f7920b3b 2022-01-02 cage (make-array 1000000
429 f7920b3b 2022-01-02 cage :element-type '(unsigned-byte 8)
430 f7920b3b 2022-01-02 cage :initial-contents (loop repeat 1000000
432 f7920b3b 2022-01-02 cage (random 256)))))
434 f7920b3b 2022-01-02 cage (defun write-huge-file (path &optional (root "/"))
435 f7920b3b 2022-01-02 cage (with-open-ssl-stream (stream
439 f7920b3b 2022-01-02 cage *client-certificate*
440 f7920b3b 2022-01-02 cage *certificate-key*)
441 f7920b3b 2022-01-02 cage (let* ((*messages-sent* ())
442 f7920b3b 2022-01-02 cage (*buffer-size* 256)
443 f7920b3b 2022-01-02 cage (root-fid (mount stream root))
444 f7920b3b 2022-01-02 cage (saved-root-fid (clone-fid stream root-fid))
445 f7920b3b 2022-01-02 cage (fid (create-path stream root-fid path))
446 f7920b3b 2022-01-02 cage (data (make-huge-data)))
447 f7920b3b 2022-01-02 cage (9p-write stream fid 0 data)
448 f7920b3b 2022-01-02 cage (9p-clunk stream fid)
449 f7920b3b 2022-01-02 cage (read-all-pending-message stream)
450 f7920b3b 2022-01-02 cage (path-info stream saved-root-fid path))))
452 f7920b3b 2022-01-02 cage (deftest test-write-huge-file ((kami-suite) (test-collect-dir-root-children))
453 f7920b3b 2022-01-02 cage (let* ((size-file (stat-size (write-huge-file *remote-test-path-huge*))))
454 f7920b3b 2022-01-02 cage (assert-equality #'= (length (make-huge-data)) size-file)))
456 f7920b3b 2022-01-02 cage (defun read-huge-file (path &optional (root "/"))
457 f7920b3b 2022-01-02 cage (with-open-ssl-stream (stream
461 f7920b3b 2022-01-02 cage *client-certificate*
462 f7920b3b 2022-01-02 cage *certificate-key*)
463 f7920b3b 2022-01-02 cage (let ((*messages-sent* ())
464 f7920b3b 2022-01-02 cage (*buffer-size* 4096)
465 f7920b3b 2022-01-02 cage (root-fid (mount stream root)))
466 f7920b3b 2022-01-02 cage (slurp-file stream
467 f7920b3b 2022-01-02 cage root-fid path
468 f7920b3b 2022-01-02 cage :buffer-size 3000))))
470 f7920b3b 2022-01-02 cage (deftest test-read-huge-data ((kami-suite) (test-write-huge-file))
471 f7920b3b 2022-01-02 cage (assert-equality #'=
472 f7920b3b 2022-01-02 cage (length (make-huge-data))
473 f7920b3b 2022-01-02 cage (length (read-huge-file *remote-test-path-huge*))))
475 86df5ff4 2022-01-02 cage (defun read-a-tiny-amount-of-data (path amount &optional (root "/"))
476 86df5ff4 2022-01-02 cage (with-open-ssl-stream (stream
480 86df5ff4 2022-01-02 cage *client-certificate*
481 86df5ff4 2022-01-02 cage *certificate-key*)
482 86df5ff4 2022-01-02 cage (let* ((*messages-sent* ())
483 86df5ff4 2022-01-02 cage (*buffer-size* 4096)
484 86df5ff4 2022-01-02 cage (root-fid (mount stream root))
485 86df5ff4 2022-01-02 cage (path-fid (open-path stream root-fid path))
486 86df5ff4 2022-01-02 cage (results nil))
487 86df5ff4 2022-01-02 cage (9p-read stream
491 86df5ff4 2022-01-02 cage :callback (lambda (x reply)
492 86df5ff4 2022-01-02 cage (declare (ignore x))
493 86df5ff4 2022-01-02 cage (let ((data (decode-read-reply reply nil)))
494 86df5ff4 2022-01-02 cage (setf results data))))
495 86df5ff4 2022-01-02 cage (read-all-pending-message stream)
498 86df5ff4 2022-01-02 cage (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
499 86df5ff4 2022-01-02 cage (let ((amount 3))
500 86df5ff4 2022-01-02 cage (assert-equality #'=
502 86df5ff4 2022-01-02 cage (length (read-a-tiny-amount-of-data *remote-test-path-huge* amount)))))
504 001dad0e 2022-01-02 cage (defun read-data-exceeding-msize (path buffer-size &optional (root "/"))
505 001dad0e 2022-01-02 cage (with-open-ssl-stream (stream
509 001dad0e 2022-01-02 cage *client-certificate*
510 001dad0e 2022-01-02 cage *certificate-key*)
511 001dad0e 2022-01-02 cage (let* ((*messages-sent* ())
512 001dad0e 2022-01-02 cage (*buffer-size* buffer-size)
513 001dad0e 2022-01-02 cage (root-fid (mount stream root))
514 001dad0e 2022-01-02 cage (path-fid (open-path stream root-fid path))
515 001dad0e 2022-01-02 cage (results nil))
516 001dad0e 2022-01-02 cage (9p-read stream
519 001dad0e 2022-01-02 cage (* 2 buffer-size)
520 001dad0e 2022-01-02 cage :callback (lambda (x reply)
521 001dad0e 2022-01-02 cage (declare (ignore x))
522 001dad0e 2022-01-02 cage (let ((data (decode-read-reply reply nil)))
523 001dad0e 2022-01-02 cage (setf results data))))
524 001dad0e 2022-01-02 cage (read-all-pending-message stream)
527 001dad0e 2022-01-02 cage (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
528 001dad0e 2022-01-02 cage (let ((buffer-size 256))
529 0e3b3672 2022-01-02 cage (assert-condition 9p-error
530 0e3b3672 2022-01-02 cage (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
532 7ea59669 2022-01-07 cage (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
533 7ea59669 2022-01-07 cage (let ((buffer-size 256))
534 7ea59669 2022-01-07 cage (assert-condition 9p-error
535 7ea59669 2022-01-07 cage (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
537 7ea59669 2022-01-07 cage (defun example-copy-file (from to &optional (root "/"))
538 7ea59669 2022-01-07 cage (with-open-ssl-stream (stream
542 7ea59669 2022-01-07 cage *client-certificate*
543 7ea59669 2022-01-07 cage *certificate-key*)
544 7ea59669 2022-01-07 cage (let* ((*messages-sent* ())
545 7ea59669 2022-01-07 cage (root-fid (mount stream root)))
546 7ea59669 2022-01-07 cage (copy-file stream root-fid from to)
547 7ea59669 2022-01-07 cage (slurp-file stream root-fid to))))
549 7ea59669 2022-01-07 cage (deftest test-copy-file ((kami-suite) (test-write-huge-file))
550 7ea59669 2022-01-07 cage (assert-equality #'equalp
551 7ea59669 2022-01-07 cage (make-huge-data)
552 7ea59669 2022-01-07 cage (example-copy-file *remote-test-path-huge*
553 7ea59669 2022-01-07 cage (concatenate 'string
554 7ea59669 2022-01-07 cage *remote-test-path-huge*
555 7ea59669 2022-01-07 cage "-copy"))))
557 7ea59669 2022-01-07 cage (defun example-move-file (from to &optional (root "/"))
558 7ea59669 2022-01-07 cage (with-open-ssl-stream (stream
562 7ea59669 2022-01-07 cage *client-certificate*
563 7ea59669 2022-01-07 cage *certificate-key*)
564 7ea59669 2022-01-07 cage (let* ((*messages-sent* ())
565 7ea59669 2022-01-07 cage (root-fid (mount stream root)))
566 7ea59669 2022-01-07 cage (move-file stream root-fid from to)
567 7ea59669 2022-01-07 cage (path-exists-p stream root-fid from))))
569 7ea59669 2022-01-07 cage (deftest test-move-file ((kami-suite) (test-copy-file))
570 7ea59669 2022-01-07 cage (assert-false (example-move-file *remote-test-path-huge*
571 7ea59669 2022-01-07 cage (concatenate 'string
572 7ea59669 2022-01-07 cage *remote-test-path-huge*
573 7ea59669 2022-01-07 cage "-renamed"))))
575 0e1e2f45 2022-01-19 cage (defun example-truncate-file (path &optional (root "/"))
576 0e1e2f45 2022-01-19 cage (with-open-ssl-stream (stream
580 0e1e2f45 2022-01-19 cage *client-certificate*
581 0e1e2f45 2022-01-19 cage *certificate-key*)
582 0e1e2f45 2022-01-19 cage (let* ((*messages-sent* ())
583 0e1e2f45 2022-01-19 cage (root-fid (mount stream root)))
584 0e1e2f45 2022-01-19 cage (truncate-file stream root-fid path :new-size 128)
585 0e1e2f45 2022-01-19 cage (stat-size (path-info stream root-fid path)))))
587 0e1e2f45 2022-01-19 cage (deftest test-truncate-file ((kami-suite) (test-move-file))
588 0e1e2f45 2022-01-19 cage (assert-equality #'=
590 0e1e2f45 2022-01-19 cage (example-truncate-file (concatenate 'string
591 0e1e2f45 2022-01-19 cage *remote-test-path-huge*
592 0e1e2f45 2022-01-19 cage "-renamed"))))