cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [kami] removed setf' of global variables.

This commit is contained in:
cage 2022-04-22 10:08:00 +02:00
parent 8d3ed466ee
commit 8e5c2bb91a
2 changed files with 180 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

332
src/kami/client.lisp
View File

@ -10,6 +10,11 @@
(defparameter *root-fid* nil) (defparameter *root-fid* nil)
(defstruct 9p-parameters
(message-sent)
(fid)
(tag))
(defmacro with-open-ssl-stream ((ssl-stream socket host port (defmacro with-open-ssl-stream ((ssl-stream socket host port
client-certificate client-certificate
certificate-key) certificate-key)
@ -37,182 +42,203 @@
(when ,clunk-cloned-fid (when ,clunk-cloned-fid
(9p:9p-clunk ,stream ,cloned-fid))))) (9p:9p-clunk ,stream ,cloned-fid)))))
(defun expand-node (stream root-fid) (defmacro with-9p-params ((params) &body body)
(lambda (node) `(let* ((9p:*tag* (9p-parameters-tag ,params))
(let* ((*stream* stream) (9p:*fid* (9p-parameters-fid ,params))
(*root-fid* root-fid) (9p:*messages-sent* (9p-parameters-message-sent ,params)))
(path (tree-path (data node)))) (unwind-protect
(with-cloned-root-fid (*stream* cloned-root-fid) (progn ,@body)
(let* ((entries (9p:collect-directory-children *stream* cloned-root-fid path)) (setf (9p-parameters-tag ,params) 9p:*tag*)
(files (remove-if-not (lambda (a) (or (eq (9p:stat-entry-type a) (setf (9p-parameters-fid ,params) 9p:*fid*)
:file) (setf (9p-parameters-message-sent ,params) 9p:*messages-sent*))))
(eq (9p:stat-entry-type a)
:executable)))
entries))
(directories (remove-if-not (lambda (a) (eq (9p:stat-entry-type a)
:directory))
entries)))
(remove-all-children node)
(loop for directory in directories do
(let ((absolute-path (text-utils:strcat path (9p:stat-name directory))))
(add-child node
(make-instance 'm-tree
:data (make-node-data absolute-path t)))))
(loop for file in files do
(let ((absolute-path (text-utils:strcat path (9p:stat-name file))))
(add-child node
(make-instance 'm-tree
:data (make-node-data absolute-path nil))))))))
node))
(defun rename-node (stream root-fid) (defun expand-node (stream root-fid params)
(lambda (node)
(with-9p-params (params)
(let* ((*stream* stream)
(*root-fid* root-fid)
(path (tree-path (data node))))
(with-cloned-root-fid (*stream* cloned-root-fid)
(let* ((entries (9p:collect-directory-children *stream* cloned-root-fid path))
(files (remove-if-not (lambda (a) (or (eq (9p:stat-entry-type a)
:file)
(eq (9p:stat-entry-type a)
:executable)))
entries))
(directories (remove-if-not (lambda (a) (eq (9p:stat-entry-type a)
:directory))
entries)))
(remove-all-children node)
(loop for directory in directories do
(let ((absolute-path (text-utils:strcat path (9p:stat-name directory))))
(add-child node
(make-instance 'm-tree
:data (make-node-data absolute-path t)))))
(loop for file in files do
(let ((absolute-path (text-utils:strcat path (9p:stat-name file))))
(add-child node
(make-instance 'm-tree
:data (make-node-data absolute-path nil))))))
node)))))
(defun rename-node (stream root-fid params)
(lambda (node new-path) (lambda (node new-path)
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid) (let* ((*stream* stream)
(path (tree-path (data node)))) (*root-fid* root-fid)
(assert path) (path (tree-path (data node))))
(with-cloned-root-fid (*stream* cloned-root-fid) (assert path)
(9p:move-file *stream* cloned-root-fid path new-path))))) (with-cloned-root-fid (*stream* cloned-root-fid)
(9p:move-file *stream* cloned-root-fid path new-path))))))
(defun delete-node (stream root-fid) (defun delete-node (stream root-fid params)
(lambda (node) (lambda (node)
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid) (let* ((*stream* stream)
(path (tree-path (data node)))) (*root-fid* root-fid)
(assert path) (path (tree-path (data node))))
(with-cloned-root-fid (*stream* cloned-root-fid) (assert path)
(9p:remove-path *stream* cloned-root-fid path))))) (with-cloned-root-fid (*stream* cloned-root-fid)
(9p:remove-path *stream* cloned-root-fid path))))))
(defun create-node (stream root-fid) (defun create-node (stream root-fid params)
(lambda (path dirp) (lambda (path dirp)
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid)) (let* ((*stream* stream)
(assert path) (*root-fid* root-fid))
(with-cloned-root-fid (*stream* cloned-root-fid :clunk-cloned-fid nil) (assert path)
(let ((created-fid nil)) (with-cloned-root-fid (*stream* cloned-root-fid :clunk-cloned-fid nil)
(if dirp (let ((created-fid nil))
(setf created-fid (if dirp
(9p:create-path *stream* (setf created-fid
cloned-root-fid (9p:create-path *stream*
(if (fs:path-referencing-dir-p path) cloned-root-fid
path (if (fs:path-referencing-dir-p path)
(text-utils:strcat path "/")))) path
(setf created-fid (text-utils:strcat path "/"))))
(9p:create-path *stream* cloned-root-fid path))) (setf created-fid
(9p:9p-clunk *stream* created-fid)))))) (9p:create-path *stream* cloned-root-fid path)))
(9p:9p-clunk *stream* created-fid)))))))
(defun download-node (stream root-fid) (defun download-node (stream root-fid params)
(lambda (node (lambda (node
&optional &optional
(destination-file (destination-file
(make-temporary-file-from-node node))) (make-temporary-file-from-node node)))
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid) (let* ((*stream* stream)
(path (tree-path (data node)))) (*root-fid* root-fid)
(with-open-file (output-stream destination-file (path (tree-path (data node))))
:direction :output (with-open-file (output-stream destination-file
:if-exists :supersede :direction :output
:if-does-not-exist :create :if-exists :supersede
:element-type +octect-type+) :if-does-not-exist :create
:element-type +octect-type+)
(with-cloned-root-fid (*stream* cloned-root-fid)
(9p:read-entire-file-apply-function stream
cloned-root-fid
path
(lambda (data offset count)
(declare (ignore offset count))
(write-sequence data output-stream)))))
(with-cloned-root-fid (*stream* cloned-root-fid) (with-cloned-root-fid (*stream* cloned-root-fid)
(9p:read-entire-file-apply-function stream (let* ((info-source-node (9p:path-info *stream* cloned-root-fid path))
cloned-root-fid (permissions (9p:permissions-original-value (9p:stat-mode info-source-node)))
path (destination-file-mode (logand permissions #x7ff)))
(lambda (data offset count) (fs:change-path-permissions destination-file destination-file-mode)))
(declare (ignore offset count)) destination-file))))
(write-sequence data output-stream)))))
(with-cloned-root-fid (*stream* cloned-root-fid)
(let* ((info-source-node (9p:path-info *stream* cloned-root-fid path))
(permissions (9p:permissions-original-value (9p:stat-mode info-source-node)))
(destination-file-mode (logand permissions #x7ff)))
(fs:change-path-permissions destination-file destination-file-mode)))
destination-file)))
(defun upload-node (stream root-fid) (defun upload-node (stream root-fid params)
(lambda (source-path destination-path) (lambda (source-path destination-path)
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid)) (let* ((*stream* stream)
(let ((source-permissions (fs:get-stat-mode source-path))) (*root-fid* root-fid))
(with-open-file (input-stream source-path (let ((source-permissions (fs:get-stat-mode source-path)))
:direction :input (with-open-file (input-stream source-path
:element-type +octect-type+) :direction :input
(with-cloned-root-fid (*stream* cloned-root-fid) :element-type +octect-type+)
(9p:remove-path *stream* cloned-root-fid destination-path)) (with-cloned-root-fid (*stream* cloned-root-fid)
(with-cloned-root-fid (*stream* cloned-root-fid :clunk-cloned-fid nil) (9p:remove-path *stream* cloned-root-fid destination-path))
(let* ((buffer (misc:make-array-frame +download-buffer+ 0 +octect-type+ t)) (with-cloned-root-fid (*stream* cloned-root-fid :clunk-cloned-fid nil)
(fid (9p:create-path *stream* cloned-root-fid destination-path))) (let* ((buffer (misc:make-array-frame +download-buffer+ 0 +octect-type+ t))
(loop named write-loop (fid (9p:create-path *stream* cloned-root-fid destination-path)))
for read-so-far = (read-sequence buffer input-stream) (loop named write-loop
then (read-sequence buffer input-stream) for read-so-far = (read-sequence buffer input-stream)
for offset = 0 then (+ offset read-so-far) then (read-sequence buffer input-stream)
do for offset = 0 then (+ offset read-so-far)
(9p:9p-write *stream* fid offset (subseq buffer 0 read-so-far)) do
(when (< read-so-far +download-buffer+) (9p:9p-write *stream* fid offset (subseq buffer 0 read-so-far))
(return-from write-loop t))) (when (< read-so-far +download-buffer+)
(9p:9p-clunk *stream* fid))) (return-from write-loop t)))
(with-cloned-root-fid (*stream* cloned-root-fid) (9p:9p-clunk *stream* fid)))
(9p:change-mode *stream* (with-cloned-root-fid (*stream* cloned-root-fid)
cloned-root-fid (9p:change-mode *stream*
destination-path source-permissions) cloned-root-fid
(9p:read-all-pending-messages stream))))))) destination-path source-permissions)
(9p:read-all-pending-messages stream))))))))
(defun query-path (stream root-fid) (defun query-path (stream root-fid params)
(lambda (path what) (lambda (path what)
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid)) (let* ((*stream* stream)
(with-cloned-root-fid (*stream* cloned-root-fid) (*root-fid* root-fid))
(a:when-let ((stat-entry (9p:path-info *stream* cloned-root-fid path))) (with-cloned-root-fid (*stream* cloned-root-fid)
(ecase what (a:when-let ((stat-entry (9p:path-info *stream* cloned-root-fid path)))
(:type (ecase what
(9p:stat-entry-type stat-entry)) (:type
(:size (9p:stat-entry-type stat-entry))
(9p:stat-entry-type stat-entry)) (:size
(:size-string (9p:stat-entry-type stat-entry))
(fs:octects->units-string (9p:stat-size stat-entry))) (:size-string
(:permissions-string (fs:octects->units-string (9p:stat-size stat-entry)))
(let ((mode (9p:stat-mode stat-entry))) (:permissions-string
(format nil (let ((mode (9p:stat-mode stat-entry)))
(_ "User: ~a Group: ~a Others ~a") (format nil
(9p:permissions-user-string mode) (_ "User: ~a Group: ~a Others ~a")
(9p:permissions-group-string mode) (9p:permissions-user-string mode)
(9p:permissions-others-string mode)))))))))) (9p:permissions-group-string mode)
(9p:permissions-others-string mode)))))))))))
(defun collect-tree (stream root-fid) (defun collect-tree (stream root-fid params)
(lambda (path) (lambda (path)
(let* ((*stream* stream) (with-9p-params (params)
(*root-fid* root-fid) (let* ((*stream* stream)
(all-files nil) (*root-fid* root-fid)
(all-dirs nil)) (all-files nil)
(with-cloned-root-fid (*stream* cloned-root-fid :clunk-cloned-fid t) (all-dirs nil))
(multiple-value-bind (files directories) (with-cloned-root-fid (*stream* cloned-root-fid :clunk-cloned-fid t)
(9p:collect-tree *stream* cloned-root-fid path) (multiple-value-bind (files directories)
(setf all-files files) (9p:collect-tree *stream* cloned-root-fid path)
(setf all-dirs directories))) (setf all-files files)
(values all-files all-dirs)))) (setf all-dirs directories)))
(values all-files all-dirs)))))
(defun generate-filesystem-window-handlers (path host port (defun generate-filesystem-window-handlers (path host port
query fragment query fragment
client-certificate client-key) client-certificate client-key)
(setf 9p:*tag* 8)
(setf 9p:*fid* 1)
(setf 9p:*messages-sent* '())
(with-open-ssl-stream (stream socket host port client-certificate client-key) (with-open-ssl-stream (stream socket host port client-certificate client-key)
(let* ((*stream* stream) (let* ((9p:*tag* 10)
(*root-fid* (9p:mount *stream* "/"))) (9p:*fid* 1)
(list :query query (9p:*messages-sent* '())
:fragment fragment (*stream* stream)
:socket socket (*root-fid* (9p:mount *stream* "/"))
:path path (parameters (make-9p-parameters :message-sent 9p:*messages-sent*
:filesystem-expand-function (expand-node *stream* *root-fid*) :fid 9p:*fid*
:filesystem-rename-function (rename-node *stream* *root-fid*) :tag 9p:*tag*)))
:filesystem-delete-function (delete-node *stream* *root-fid*) (list :query query
:filesystem-create-function (create-node *stream* *root-fid*) :fragment fragment
:filesystem-download-function (download-node *stream* *root-fid*) :socket socket
:filesystem-upload-function (upload-node *stream* *root-fid*) :path path
:filesystem-query-path-function (query-path *stream* *root-fid*) :filesystem-expand-function (expand-node *stream* *root-fid* parameters)
:filesystem-collect-tree (collect-tree *stream* *root-fid*) :filesystem-rename-function (rename-node *stream* *root-fid* parameters)
:filesystem-close-connection-function (lambda () :filesystem-delete-function (delete-node *stream* *root-fid* parameters)
(9p:close-client socket)))))) :filesystem-create-function (create-node *stream* *root-fid* parameters)
:filesystem-download-function (download-node *stream* *root-fid* parameters)
:filesystem-upload-function (upload-node *stream* *root-fid* parameters)
:filesystem-query-path-function (query-path *stream* *root-fid* parameters)
:filesystem-collect-tree (collect-tree *stream* *root-fid* parameters)
:filesystem-close-connection-function (lambda ()
(9p:close-client socket))))))
(defun iri->filesystem-window-handlers (kami-iri) (defun iri->filesystem-window-handlers (kami-iri)
(a:when-let ((parsed-iri (iri:iri-parse kami-iri :null-on-error t))) (a:when-let ((parsed-iri (iri:iri-parse kami-iri :null-on-error t)))

2
src/misc-utils.lisp
View File

@ -118,7 +118,7 @@
(defun function-name (data) (defun function-name (data)
"Implementation dependent" "Implementation dependent"
(assert (functionp data)) (assert (functionp data))
(conditions:with-default-on-error ((_ "Anonymous function")) (conditions:with-default-on-error ((config:_ "Anonymous function"))
(multiple-value-bind (x y name) (multiple-value-bind (x y name)
(function-lambda-expression data) (function-lambda-expression data)
(declare (ignore x y)) (declare (ignore x y))