1 34719c28 2021-12-31 cage ;; test suite for kami
  2 34719c28 2021-12-31 cage ;; Copyright (C) 2021  cage
  3 34719c28 2021-12-31 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.
  8 34719c28 2021-12-31 cage 
  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.
 13 34719c28 2021-12-31 cage 
 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/]].
 17 34719c28 2021-12-31 cage 
 18 34719c28 2021-12-31 cage (in-package :kami-tests)
 19 34719c28 2021-12-31 cage 
 20 34719c28 2021-12-31 cage (defparameter *remote-test-file*   "test-file") ; note: missing "/" is intentional
 21 34719c28 2021-12-31 cage 
 22 34719c28 2021-12-31 cage (defparameter *remote-test-path*   "/test-file")
 23 34719c28 2021-12-31 cage 
 24 34719c28 2021-12-31 cage (defparameter *remote-test-path-write*   "/dir/subdir/test-file-write")
 25 34719c28 2021-12-31 cage 
 26 f7920b3b 2022-01-02 cage (defparameter *remote-test-path-huge*    "/test-file-huge")
 27 f7920b3b 2022-01-02 cage 
 28 34719c28 2021-12-31 cage (defparameter *remote-test-path-contents* (format nil "qwertyuiopasdfghjklòàù è~%"))
 29 34719c28 2021-12-31 cage 
 30 34719c28 2021-12-31 cage (alexandria:define-constant +remote-test-path-ovewrwrite-data+ "12" :test #'string=)
 31 34719c28 2021-12-31 cage 
 32 34719c28 2021-12-31 cage (defsuite kami-suite (all-suite))
 33 34719c28 2021-12-31 cage 
 34 34719c28 2021-12-31 cage (defun start-non-tls-socket (host port)
 35 34719c28 2021-12-31 cage   (usocket:socket-connect host
 36 34719c28 2021-12-31 cage                           port
 37 34719c28 2021-12-31 cage                           :protocol     :stream
 38 34719c28 2021-12-31 cage                           :element-type +byte-type+))
 39 34719c28 2021-12-31 cage 
 40 34719c28 2021-12-31 cage (defun example-mount (&optional (root  "/"))
 41 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
 42 34719c28 2021-12-31 cage                          socket
 43 34719c28 2021-12-31 cage                          *host*
 44 34719c28 2021-12-31 cage                          *port*
 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)
 53 34719c28 2021-12-31 cage       t)))
 54 34719c28 2021-12-31 cage 
 55 34719c28 2021-12-31 cage (deftest test-mount (kami-suite)
 56 34719c28 2021-12-31 cage   (assert-true (ignore-errors (example-mount))))
 57 34719c28 2021-12-31 cage 
 58 34719c28 2021-12-31 cage (defun example-walk (path &optional (root "/"))
 59 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
 60 34719c28 2021-12-31 cage                          socket
 61 34719c28 2021-12-31 cage                          *host*
 62 34719c28 2021-12-31 cage                          *port*
 63 34719c28 2021-12-31 cage                          *client-certificate*
 64 34719c28 2021-12-31 cage                          *certificate-key*)
 65 34719c28 2021-12-31 cage 
 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)
 71 34719c28 2021-12-31 cage         t))))
 72 34719c28 2021-12-31 cage 
 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*))))
 75 34719c28 2021-12-31 cage 
 76 34719c28 2021-12-31 cage (defun example-open-path (path &optional (root "/"))
 77 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
 78 34719c28 2021-12-31 cage                          socket
 79 34719c28 2021-12-31 cage                          *host*
 80 34719c28 2021-12-31 cage                          *port*
 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)
 89 34719c28 2021-12-31 cage         t))))
 90 34719c28 2021-12-31 cage 
 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*))))
 93 34719c28 2021-12-31 cage 
 94 34719c28 2021-12-31 cage (defun example-read (path &optional (root "/"))
 95 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
 96 34719c28 2021-12-31 cage                          socket
 97 34719c28 2021-12-31 cage                          *host*
 98 34719c28 2021-12-31 cage                          *port*
 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)
109 34719c28 2021-12-31 cage         t))))
110 34719c28 2021-12-31 cage 
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*))))
113 34719c28 2021-12-31 cage 
114 34719c28 2021-12-31 cage (defun example-slurp (path &optional (root "/"))
115 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
116 34719c28 2021-12-31 cage                          socket
117 34719c28 2021-12-31 cage                          *host*
118 34719c28 2021-12-31 cage                          *port*
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))))
128 34719c28 2021-12-31 cage 
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*)))
133 34719c28 2021-12-31 cage 
134 34719c28 2021-12-31 cage (defun example-write (path &optional (root "/"))
135 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
136 34719c28 2021-12-31 cage                          socket
137 34719c28 2021-12-31 cage                          *host*
138 34719c28 2021-12-31 cage                          *port*
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)
147 34719c28 2021-12-31 cage       t)))
148 34719c28 2021-12-31 cage 
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*))))
151 34719c28 2021-12-31 cage 
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
154 34719c28 2021-12-31 cage                          socket
155 34719c28 2021-12-31 cage                          *host*
156 34719c28 2021-12-31 cage                          *port*
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)))))))
168 34719c28 2021-12-31 cage 
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
171 34719c28 2021-12-31 cage                          socket
172 34719c28 2021-12-31 cage                          *host*
173 34719c28 2021-12-31 cage                          *port*
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)))))
180 34719c28 2021-12-31 cage 
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)))
187 34719c28 2021-12-31 cage 
188 34719c28 2021-12-31 cage (defun example-write-fails (path &optional (root "/"))
189 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
190 34719c28 2021-12-31 cage                          socket
191 34719c28 2021-12-31 cage                          *host*
192 34719c28 2021-12-31 cage                          *port*
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))))
201 34719c28 2021-12-31 cage 
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 "/")))
204 34719c28 2021-12-31 cage 
205 34719c28 2021-12-31 cage (defun example-stat (path &optional (root "/"))
206 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
207 34719c28 2021-12-31 cage                          socket
208 34719c28 2021-12-31 cage                          *host*
209 34719c28 2021-12-31 cage                          *port*
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)
222 34719c28 2021-12-31 cage       results)))
223 34719c28 2021-12-31 cage 
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 34719c28 2021-12-31 cage       (stat-entry-type (example-stat *remote-test-path*))))
231 34719c28 2021-12-31 cage 
232 1b3f8c35 2021-12-31 cage (defun example-path-exists (path &optional (root "/"))
233 1b3f8c35 2021-12-31 cage   (with-open-ssl-stream (stream
234 1b3f8c35 2021-12-31 cage                          socket
235 1b3f8c35 2021-12-31 cage                          *host*
236 1b3f8c35 2021-12-31 cage                          *port*
237 1b3f8c35 2021-12-31 cage                          *client-certificate*
238 1b3f8c35 2021-12-31 cage                          *certificate-key*)
239 1b3f8c35 2021-12-31 cage     (let* ((*messages-sent* ())
240 1b3f8c35 2021-12-31 cage            (root-fid        (mount stream root)))
241 1b3f8c35 2021-12-31 cage       (path-exists-p stream root-fid path)
242 1b3f8c35 2021-12-31 cage       (path-exists-p stream root-fid path))))
243 1b3f8c35 2021-12-31 cage 
244 1b3f8c35 2021-12-31 cage (deftest test-path-exists ((kami-suite) (test-stat))
245 1b3f8c35 2021-12-31 cage   (assert-true  (example-path-exists *remote-test-path*))
246 1b3f8c35 2021-12-31 cage   (assert-false (example-path-exists (concatenate 'string *remote-test-path* ".$$$"))))
247 1b3f8c35 2021-12-31 cage 
248 34719c28 2021-12-31 cage (defun example-create-file (path &optional (root "/"))
249 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
250 34719c28 2021-12-31 cage                                        socket
251 34719c28 2021-12-31 cage                                        *host*
252 34719c28 2021-12-31 cage                                        *port*
253 34719c28 2021-12-31 cage                                        *client-certificate*
254 34719c28 2021-12-31 cage                                        *certificate-key*)
255 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
256 34719c28 2021-12-31 cage            (root-fid        (mount stream root)))
257 34719c28 2021-12-31 cage       (with-new-fid (saved-root-fid)
258 34719c28 2021-12-31 cage         (9p-walk stream root-fid saved-root-fid +nwname-clone+)
259 34719c28 2021-12-31 cage         (9p-create stream root-fid path)
260 34719c28 2021-12-31 cage         (read-all-pending-message stream)
261 34719c28 2021-12-31 cage         (9p-clunk stream root-fid)
262 34719c28 2021-12-31 cage         (open-path stream saved-root-fid path)
263 34719c28 2021-12-31 cage         (read-all-pending-message stream)
264 34719c28 2021-12-31 cage         t))))
265 34719c28 2021-12-31 cage 
266 34719c28 2021-12-31 cage (alexandria:define-constant +create-file+ "test-file-create" :test #'string=)
267 34719c28 2021-12-31 cage 
268 34719c28 2021-12-31 cage (defun example-create-directory (path &optional (root "/"))
269 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
270 34719c28 2021-12-31 cage                          socket
271 34719c28 2021-12-31 cage                          *host*
272 34719c28 2021-12-31 cage                          *port*
273 34719c28 2021-12-31 cage                          *client-certificate*
274 34719c28 2021-12-31 cage                          *certificate-key*)
275 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
276 34719c28 2021-12-31 cage            (root-fid        (mount stream root)))
277 34719c28 2021-12-31 cage       (create-directory stream root-fid path)
278 34719c28 2021-12-31 cage       t)))
279 34719c28 2021-12-31 cage 
280 34719c28 2021-12-31 cage (alexandria:define-constant +create-directory+ "test-dir-create" :test #'string=)
281 34719c28 2021-12-31 cage 
282 1b3f8c35 2021-12-31 cage (defun example-create-path-read-write (path &optional (root "/"))
283 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
284 34719c28 2021-12-31 cage                          socket
285 34719c28 2021-12-31 cage                          *host*
286 34719c28 2021-12-31 cage                          *port*
287 34719c28 2021-12-31 cage                          *client-certificate*
288 34719c28 2021-12-31 cage                          *certificate-key*)
289 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
290 34719c28 2021-12-31 cage            (root-fid        (mount stream root))
291 34719c28 2021-12-31 cage            (saved-root-fid  (clone-fid stream root-fid))
292 1b3f8c35 2021-12-31 cage            (new-path-fid    (create-path stream root-fid path)))
293 34719c28 2021-12-31 cage       (9p-write stream new-path-fid 0 *remote-test-path-contents*)
294 34719c28 2021-12-31 cage       (read-all-pending-message stream)
295 34719c28 2021-12-31 cage       (9p-clunk stream new-path-fid)
296 34719c28 2021-12-31 cage       (read-all-pending-message stream)
297 34719c28 2021-12-31 cage       (babel:octets-to-string (slurp-file stream saved-root-fid path)))))
298 34719c28 2021-12-31 cage 
299 1b3f8c35 2021-12-31 cage (defun example-create-path (path &optional (root "/"))
300 1b3f8c35 2021-12-31 cage   (with-open-ssl-stream (stream
301 1b3f8c35 2021-12-31 cage                          socket
302 1b3f8c35 2021-12-31 cage                          *host*
303 1b3f8c35 2021-12-31 cage                          *port*
304 1b3f8c35 2021-12-31 cage                          *client-certificate*
305 1b3f8c35 2021-12-31 cage                          *certificate-key*)
306 1b3f8c35 2021-12-31 cage     (let* ((*messages-sent* ())
307 1b3f8c35 2021-12-31 cage            (root-fid        (mount stream root)))
308 1b3f8c35 2021-12-31 cage       (create-path stream root-fid path))))
309 34719c28 2021-12-31 cage 
310 1b3f8c35 2021-12-31 cage (alexandria:define-constant +create-path-read-write+ "/a/totaly/new/path/new-file" :test #'string=)
311 1b3f8c35 2021-12-31 cage 
312 1b3f8c35 2021-12-31 cage (alexandria:define-constant +create-path-dir+ "/this/" :test #'string=)
313 1b3f8c35 2021-12-31 cage 
314 1b3f8c35 2021-12-31 cage (alexandria:define-constant +create-path-file+ "/this-file" :test #'string=)
315 1b3f8c35 2021-12-31 cage 
316 34719c28 2021-12-31 cage (deftest test-create ((kami-suite) (test-open-path))
317 34719c28 2021-12-31 cage   (assert-true (ignore-errors (example-create-file +create-file+)))
318 34719c28 2021-12-31 cage   (assert-true (ignore-errors (example-create-directory +create-directory+)))
319 1b3f8c35 2021-12-31 cage   (assert-true (ignore-errors (example-create-path +create-path-dir+)))
320 1b3f8c35 2021-12-31 cage   (assert-true (ignore-errors (example-create-path +create-path-file+)))
321 34719c28 2021-12-31 cage   (assert-equality #'string=
322 34719c28 2021-12-31 cage       *remote-test-path-contents*
323 1b3f8c35 2021-12-31 cage       (ignore-errors (example-create-path-read-write +create-path-read-write+))))
324 34719c28 2021-12-31 cage 
325 1b3f8c35 2021-12-31 cage (deftest test-create-existing-path ((kami-suite) (test-create))
326 1b3f8c35 2021-12-31 cage   (assert-true (ignore-errors (example-create-path +create-path-read-write+))))
327 1b3f8c35 2021-12-31 cage 
328 34719c28 2021-12-31 cage (defun close-parent-fid (&optional (root "/"))
329 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
330 34719c28 2021-12-31 cage                          socket
331 34719c28 2021-12-31 cage                          *host*
332 34719c28 2021-12-31 cage                          *port*
333 34719c28 2021-12-31 cage                          *client-certificate*
334 34719c28 2021-12-31 cage                          *certificate-key*)
335 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
336 34719c28 2021-12-31 cage            (root-fid        (mount stream root)))
337 34719c28 2021-12-31 cage       (with-new-fid (dir-fid)
338 34719c28 2021-12-31 cage         (9p-walk stream root-fid dir-fid "dir")
339 34719c28 2021-12-31 cage         (read-all-pending-message stream)
340 34719c28 2021-12-31 cage         (9p-clunk stream root-fid)
341 34719c28 2021-12-31 cage         (read-all-pending-message stream)
342 34719c28 2021-12-31 cage         (with-new-fid (subdir-fid)
343 34719c28 2021-12-31 cage           (9p-walk stream dir-fid subdir-fid "subdir")
344 34719c28 2021-12-31 cage           (read-all-pending-message stream)
345 34719c28 2021-12-31 cage           (9p-clunk stream dir-fid)
346 34719c28 2021-12-31 cage           (read-all-pending-message stream)
347 34719c28 2021-12-31 cage           (with-new-fid (file-fid)
348 34719c28 2021-12-31 cage             (9p-walk stream subdir-fid file-fid "test-file-write")
349 34719c28 2021-12-31 cage             (read-all-pending-message stream)
350 34719c28 2021-12-31 cage             (9p-clunk stream subdir-fid)
351 34719c28 2021-12-31 cage             (read-all-pending-message stream)
352 34719c28 2021-12-31 cage             (9p-open stream file-fid)
353 34719c28 2021-12-31 cage             (read-all-pending-message stream)
354 34719c28 2021-12-31 cage             t))))))
355 34719c28 2021-12-31 cage 
356 34719c28 2021-12-31 cage (deftest test-close-parent-fid ((kami-suite) (test-walk))
357 34719c28 2021-12-31 cage   (assert-true (ignore-errors (close-parent-fid))))
358 34719c28 2021-12-31 cage 
359 34719c28 2021-12-31 cage (defun %remove-path (path &optional (root "/"))
360 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
361 34719c28 2021-12-31 cage                          socket
362 34719c28 2021-12-31 cage                          *host*
363 34719c28 2021-12-31 cage                          *port*
364 34719c28 2021-12-31 cage                          *client-certificate*
365 34719c28 2021-12-31 cage                          *certificate-key*)
366 34719c28 2021-12-31 cage 
367 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
368 34719c28 2021-12-31 cage            (root-fid        (mount stream root)))
369 34719c28 2021-12-31 cage       (remove-path stream root-fid path)
370 34719c28 2021-12-31 cage       t)))
371 34719c28 2021-12-31 cage 
372 1b3f8c35 2021-12-31 cage (deftest test-remove-file ((kami-suite) (test-create-existing-path))
373 1b3f8c35 2021-12-31 cage   (assert-true (ignore-errors (%remove-path +create-path-read-write+))))
374 34719c28 2021-12-31 cage 
375 34719c28 2021-12-31 cage (defun parent-dir-path (path)
376 34719c28 2021-12-31 cage   (let ((position-backslash (position #\/ path :from-end t :test #'char=)))
377 34719c28 2021-12-31 cage     (subseq path 0 position-backslash)))
378 34719c28 2021-12-31 cage 
379 34719c28 2021-12-31 cage (deftest test-remove-directory ((kami-suite) (test-remove-file))
380 34719c28 2021-12-31 cage   (assert-true
381 1b3f8c35 2021-12-31 cage       (ignore-errors (%remove-path (parent-dir-path +create-path-read-write+)))))
382 34719c28 2021-12-31 cage 
383 34719c28 2021-12-31 cage (defun read-dir-same-offset (dir-path &optional (root "/"))
384 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
385 34719c28 2021-12-31 cage                          socket
386 34719c28 2021-12-31 cage                          *host*
387 34719c28 2021-12-31 cage                          *port*
388 34719c28 2021-12-31 cage                          *client-certificate*
389 34719c28 2021-12-31 cage                          *certificate-key*)
390 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
391 34719c28 2021-12-31 cage            (root-fid        (mount stream root))
392 34719c28 2021-12-31 cage            (root-fid-cloned (clone-fid stream root-fid))
393 34719c28 2021-12-31 cage            (dir-fid         (open-path stream root-fid-cloned dir-path))
394 34719c28 2021-12-31 cage            (res-read-1      nil)
395 34719c28 2021-12-31 cage            (res-read-2      nil))
396 34719c28 2021-12-31 cage       (9p-read stream
397 34719c28 2021-12-31 cage                dir-fid
398 34719c28 2021-12-31 cage                0  10
399 34719c28 2021-12-31 cage                :callback (lambda (x data)
400 34719c28 2021-12-31 cage                            (declare (ignore x))
401 34719c28 2021-12-31 cage                            (setf res-read-1 data)))
402 34719c28 2021-12-31 cage       (9p-read stream
403 34719c28 2021-12-31 cage                dir-fid
404 34719c28 2021-12-31 cage                0  10
405 34719c28 2021-12-31 cage                :callback (lambda (x data)
406 34719c28 2021-12-31 cage                            (declare (ignore x))
407 34719c28 2021-12-31 cage                            (setf res-read-2 data)))
408 34719c28 2021-12-31 cage       (read-all-pending-message stream)
409 34719c28 2021-12-31 cage       (not (mismatch res-read-1 res-read-2)))))
410 34719c28 2021-12-31 cage 
411 34719c28 2021-12-31 cage (defun example-directory-children (path &optional (root "/"))
412 34719c28 2021-12-31 cage   (with-open-ssl-stream (stream
413 34719c28 2021-12-31 cage                          socket
414 34719c28 2021-12-31 cage                          *host*
415 34719c28 2021-12-31 cage                          *port*
416 34719c28 2021-12-31 cage                          *client-certificate*
417 34719c28 2021-12-31 cage                          *certificate-key*)
418 34719c28 2021-12-31 cage     (let* ((*messages-sent* ())
419 34719c28 2021-12-31 cage            (root-fid        (mount stream root)))
420 34719c28 2021-12-31 cage       (collect-directory-children stream root-fid path))))
421 34719c28 2021-12-31 cage 
422 f7920b3b 2022-01-02 cage (deftest test-collect-dir-root-children ((kami-suite) (test-read))
423 34719c28 2021-12-31 cage   (assert-true (example-directory-children "/")))
424 f7920b3b 2022-01-02 cage 
425 f7920b3b 2022-01-02 cage (defun make-huge-data ()
426 7ea59669 2022-01-07 cage   (let* ((*random-state* (make-random-state nil)))
427 f7920b3b 2022-01-02 cage     (make-array 1000000
428 f7920b3b 2022-01-02 cage                 :element-type '(unsigned-byte 8)
429 f7920b3b 2022-01-02 cage                 :initial-contents (loop repeat 1000000
430 f7920b3b 2022-01-02 cage                                         collect
431 f7920b3b 2022-01-02 cage                                         (random 256)))))
432 f7920b3b 2022-01-02 cage 
433 f7920b3b 2022-01-02 cage (defun write-huge-file (path &optional (root "/"))
434 f7920b3b 2022-01-02 cage   (with-open-ssl-stream (stream
435 f7920b3b 2022-01-02 cage                          socket
436 f7920b3b 2022-01-02 cage                          *host*
437 f7920b3b 2022-01-02 cage                          *port*
438 f7920b3b 2022-01-02 cage                          *client-certificate*
439 f7920b3b 2022-01-02 cage                          *certificate-key*)
440 f7920b3b 2022-01-02 cage     (let* ((*messages-sent* ())
441 f7920b3b 2022-01-02 cage            (*buffer-size*   256)
442 f7920b3b 2022-01-02 cage            (root-fid        (mount stream root))
443 f7920b3b 2022-01-02 cage            (saved-root-fid  (clone-fid stream root-fid))
444 f7920b3b 2022-01-02 cage            (fid             (create-path stream root-fid path))
445 f7920b3b 2022-01-02 cage            (data            (make-huge-data)))
446 f7920b3b 2022-01-02 cage       (9p-write stream fid 0 data)
447 f7920b3b 2022-01-02 cage       (9p-clunk stream fid)
448 f7920b3b 2022-01-02 cage       (read-all-pending-message stream)
449 f7920b3b 2022-01-02 cage       (path-info stream saved-root-fid path))))
450 f7920b3b 2022-01-02 cage 
451 f7920b3b 2022-01-02 cage (deftest test-write-huge-file ((kami-suite) (test-collect-dir-root-children))
452 f7920b3b 2022-01-02 cage   (let* ((size-file  (stat-size (write-huge-file *remote-test-path-huge*))))
453 f7920b3b 2022-01-02 cage     (assert-equality #'= (length (make-huge-data)) size-file)))
454 f7920b3b 2022-01-02 cage 
455 f7920b3b 2022-01-02 cage (defun read-huge-file (path &optional (root "/"))
456 f7920b3b 2022-01-02 cage   (with-open-ssl-stream (stream
457 f7920b3b 2022-01-02 cage                          socket
458 f7920b3b 2022-01-02 cage                          *host*
459 f7920b3b 2022-01-02 cage                          *port*
460 f7920b3b 2022-01-02 cage                          *client-certificate*
461 f7920b3b 2022-01-02 cage                          *certificate-key*)
462 f7920b3b 2022-01-02 cage     (let ((*messages-sent* ())
463 f7920b3b 2022-01-02 cage           (*buffer-size*   4096)
464 f7920b3b 2022-01-02 cage           (root-fid        (mount stream root)))
465 f7920b3b 2022-01-02 cage       (slurp-file stream
466 f7920b3b 2022-01-02 cage                   root-fid path
467 f7920b3b 2022-01-02 cage                   :buffer-size 3000))))
468 f7920b3b 2022-01-02 cage 
469 f7920b3b 2022-01-02 cage (deftest test-read-huge-data ((kami-suite) (test-write-huge-file))
470 f7920b3b 2022-01-02 cage   (assert-equality #'=
471 f7920b3b 2022-01-02 cage       (length (make-huge-data))
472 f7920b3b 2022-01-02 cage       (length (read-huge-file *remote-test-path-huge*))))
473 86df5ff4 2022-01-02 cage 
474 86df5ff4 2022-01-02 cage (defun read-a-tiny-amount-of-data (path amount &optional (root "/"))
475 86df5ff4 2022-01-02 cage   (with-open-ssl-stream (stream
476 86df5ff4 2022-01-02 cage                          socket
477 86df5ff4 2022-01-02 cage                          *host*
478 86df5ff4 2022-01-02 cage                          *port*
479 86df5ff4 2022-01-02 cage                          *client-certificate*
480 86df5ff4 2022-01-02 cage                          *certificate-key*)
481 86df5ff4 2022-01-02 cage     (let* ((*messages-sent* ())
482 86df5ff4 2022-01-02 cage            (*buffer-size*   4096)
483 86df5ff4 2022-01-02 cage            (root-fid        (mount stream root))
484 86df5ff4 2022-01-02 cage            (path-fid        (open-path stream root-fid path))
485 86df5ff4 2022-01-02 cage            (results         nil))
486 86df5ff4 2022-01-02 cage       (9p-read stream
487 86df5ff4 2022-01-02 cage                path-fid
488 86df5ff4 2022-01-02 cage                0
489 86df5ff4 2022-01-02 cage                amount
490 86df5ff4 2022-01-02 cage                :callback (lambda (x reply)
491 86df5ff4 2022-01-02 cage                            (declare (ignore x))
492 86df5ff4 2022-01-02 cage                            (let ((data (decode-read-reply reply nil)))
493 86df5ff4 2022-01-02 cage                              (setf results data))))
494 86df5ff4 2022-01-02 cage       (read-all-pending-message stream)
495 86df5ff4 2022-01-02 cage       results)))
496 86df5ff4 2022-01-02 cage 
497 86df5ff4 2022-01-02 cage (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
498 86df5ff4 2022-01-02 cage   (let ((amount 3))
499 86df5ff4 2022-01-02 cage     (assert-equality #'=
500 86df5ff4 2022-01-02 cage         amount
501 86df5ff4 2022-01-02 cage         (length (read-a-tiny-amount-of-data *remote-test-path-huge* amount)))))
502 001dad0e 2022-01-02 cage 
503 001dad0e 2022-01-02 cage (defun read-data-exceeding-msize (path buffer-size &optional (root "/"))
504 001dad0e 2022-01-02 cage   (with-open-ssl-stream (stream
505 001dad0e 2022-01-02 cage                          socket
506 001dad0e 2022-01-02 cage                          *host*
507 001dad0e 2022-01-02 cage                          *port*
508 001dad0e 2022-01-02 cage                          *client-certificate*
509 001dad0e 2022-01-02 cage                          *certificate-key*)
510 001dad0e 2022-01-02 cage     (let* ((*messages-sent* ())
511 001dad0e 2022-01-02 cage            (*buffer-size*   buffer-size)
512 001dad0e 2022-01-02 cage            (root-fid        (mount stream root))
513 001dad0e 2022-01-02 cage            (path-fid        (open-path stream root-fid path))
514 001dad0e 2022-01-02 cage            (results         nil))
515 001dad0e 2022-01-02 cage       (9p-read stream
516 001dad0e 2022-01-02 cage                path-fid
517 001dad0e 2022-01-02 cage                0
518 001dad0e 2022-01-02 cage                (* 2 buffer-size)
519 001dad0e 2022-01-02 cage                :callback (lambda (x reply)
520 001dad0e 2022-01-02 cage                            (declare (ignore x))
521 001dad0e 2022-01-02 cage                            (let ((data (decode-read-reply reply nil)))
522 001dad0e 2022-01-02 cage                              (setf results data))))
523 001dad0e 2022-01-02 cage       (read-all-pending-message stream)
524 001dad0e 2022-01-02 cage       results)))
525 001dad0e 2022-01-02 cage 
526 001dad0e 2022-01-02 cage (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
527 001dad0e 2022-01-02 cage   (let ((buffer-size 256))
528 0e3b3672 2022-01-02 cage     (assert-condition 9p-error
529 0e3b3672 2022-01-02 cage         (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
530 7ea59669 2022-01-07 cage 
531 7ea59669 2022-01-07 cage (deftest test-read-a-tiny-amount-of-data ((kami-suite) (test-write-huge-file))
532 7ea59669 2022-01-07 cage   (let ((buffer-size 256))
533 7ea59669 2022-01-07 cage     (assert-condition 9p-error
534 7ea59669 2022-01-07 cage         (read-data-exceeding-msize *remote-test-path-huge* buffer-size))))
535 7ea59669 2022-01-07 cage 
536 7ea59669 2022-01-07 cage (defun example-copy-file (from to &optional (root "/"))
537 7ea59669 2022-01-07 cage   (with-open-ssl-stream (stream
538 7ea59669 2022-01-07 cage                          socket
539 7ea59669 2022-01-07 cage                          *host*
540 7ea59669 2022-01-07 cage                          *port*
541 7ea59669 2022-01-07 cage                          *client-certificate*
542 7ea59669 2022-01-07 cage                          *certificate-key*)
543 7ea59669 2022-01-07 cage     (let* ((*messages-sent* ())
544 7ea59669 2022-01-07 cage            (root-fid        (mount stream root)))
545 7ea59669 2022-01-07 cage       (copy-file stream root-fid from to)
546 7ea59669 2022-01-07 cage       (slurp-file stream root-fid to))))
547 7ea59669 2022-01-07 cage 
548 7ea59669 2022-01-07 cage (deftest test-copy-file ((kami-suite) (test-write-huge-file))
549 7ea59669 2022-01-07 cage   (assert-equality #'equalp
550 7ea59669 2022-01-07 cage       (make-huge-data)
551 7ea59669 2022-01-07 cage       (example-copy-file *remote-test-path-huge*
552 7ea59669 2022-01-07 cage                          (concatenate 'string
553 7ea59669 2022-01-07 cage                                       *remote-test-path-huge*
554 7ea59669 2022-01-07 cage                                       "-copy"))))
555 7ea59669 2022-01-07 cage 
556 7ea59669 2022-01-07 cage (defun example-move-file (from to &optional (root "/"))
557 7ea59669 2022-01-07 cage   (with-open-ssl-stream (stream
558 7ea59669 2022-01-07 cage                          socket
559 7ea59669 2022-01-07 cage                          *host*
560 7ea59669 2022-01-07 cage                          *port*
561 7ea59669 2022-01-07 cage                          *client-certificate*
562 7ea59669 2022-01-07 cage                          *certificate-key*)
563 7ea59669 2022-01-07 cage     (let* ((*messages-sent* ())
564 7ea59669 2022-01-07 cage            (root-fid        (mount stream root)))
565 7ea59669 2022-01-07 cage       (move-file stream root-fid from to)
566 7ea59669 2022-01-07 cage       (path-exists-p stream root-fid from))))
567 7ea59669 2022-01-07 cage 
568 7ea59669 2022-01-07 cage (deftest test-move-file ((kami-suite) (test-copy-file))
569 7ea59669 2022-01-07 cage   (assert-false (example-move-file *remote-test-path-huge*
570 7ea59669 2022-01-07 cage                                    (concatenate 'string
571 7ea59669 2022-01-07 cage                                                 *remote-test-path-huge*
572 7ea59669 2022-01-07 cage                                                 "-renamed"))))