cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-01-20 03:08:54 +01:00
Code Issues

- [9p] added 'open-path' and 'slurp-file'.

Browse Source
This commit is contained in:
cage 2021-07-10 18:59:23 +02:00
parent ccc4241efe
commit 96d8721845
1 changed files with 76 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
src/9p-client/client.lisp
View File

@ -14,21 +14,23 @@
(define-constant +nofid+ #xffffffff :test #'=)
(define-constant +create-for-read+ #x0 :test #'=)
(define-constant +create-for-read+ #x0 :test #'=)
(define-constant +create-for-write+ #x1 :test #'=)
(define-constant +create-for-write+ #x1 :test #'=)
(define-constant +create-for-read-write+ #x2 :test #'=)
(define-constant +create-for-read-write+ #x2 :test #'=)
(define-constant +create-for-exec+ #x3 :test #'=)
(define-constant +create-for-exec+ #x3 :test #'=)
(define-constant +create-dir+ #x80000000 :test #'=)
(define-constant +create-dir+ #x80000000 :test #'=)
(define-constant +open-truncate+ #x10 :test #'=)
(define-constant +open-truncate+ #x10 :test #'=)
(define-constant +open-remove-on-clunk+ #x40 :test #'=)
(define-constant +open-remove-on-clunk+ #x40 :test #'=)
(define-constant +standard-socket-port+ 564 :test #'=)
(define-constant +standard-socket-port+ 564 :test #'=)
(define-constant +nwname-clone+ 0 :test #'=)
(defparameter *buffer-size* 252)
@ -428,10 +430,10 @@
(defun decode-read-reply (data &optional (as-string nil))
(let ((count (bytes->int (subseq data 0 4)))
(raw-data (subseq data 4)))
(values count
(if as-string
(values (if as-string
(babel:octets-to-string raw-data :errorp nil)
raw-data))))
raw-data)
count)))
(defun encoded-string-offset (decoded-string)
(+ (length decoded-string)
@ -518,3 +520,66 @@
(let* ((root-fid (9p-attach socket root-path)))
(read-all-pending-message socket)
(values socket root-fid version))))
(defun open-path (socket root-fid path
&key
(walk-callback #'dummy-callback)
(open-callback #'dummy-callback)
(mode +create-for-read+))
(let ((fs:*directory-sep-regexp* "\\/")
(path-elements (fs:split-path-elements path)))
(labels ((walk-dirs (path-elements parent-fid)
(with-new-fid (fid)
(if path-elements
(progn
(9p-walk socket
parent-fid
fid
(first path-elements)
:callback walk-callback)
(read-all-pending-message socket)
(walk-dirs (rest path-elements) fid))
parent-fid))))
(let ((fid (walk-dirs path-elements root-fid)))
(9p-open socket fid :callback open-callback :mode mode)
(read-all-pending-message socket)
fid))))
(defun slurp-file (socket root-fid path &key (buffer-size *buffer-size*))
(let ((res (make-array 0 :element-type +byte-type+ :adjustable nil))
(fid (open-path socket root-fid path)))
(labels ((slurp (offset)
(9p-read socket
fid
offset
buffer-size
:callback (lambda (x reply)
(declare (ignore x))
(multiple-value-bind (data count)
(decode-read-reply reply nil)
(setf res (concatenate '(vector (unsigned-byte 8)) res data))
(when (or (= count buffer-size)
(= count *buffer-size*))
(slurp (+ offset count))))))))
(slurp 0)
(read-all-pending-message socket)
res)))
(defun example (path &optional (root (os-utils:getenv "HOME")) (host "localhost") (port 10564))
(multiple-value-bind (socket root-fid)
(mount host root port)
(with-new-fid (saved-root-fid)
(9p-walk socket root-fid saved-root-fid +nwname-clone+)
(let ((fid (open-path socket root-fid path)))
(9p-read socket fid 0 10
:callback (lambda (x data)
(declare (ignore x))
(format t "read: ~a~%" (decode-read-reply data t))))
(read-all-pending-message socket)))))
(defun example-slurp (path
&optional (root (os-utils:getenv "HOME")) (host "localhost") (port 10564))
(let ((*buffer-size* 10))
(multiple-value-bind (socket root-fid)
(mount host root port)
(babel:octets-to-string (slurp-file socket root-fid path :buffer-size 3) :errorp nil))))