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