mirror of https://codeberg.org/cage/tinmop/
- removed 9p client code;
- fixed 'open-resource-with-external-program'.
This commit is contained in:
cage
parent
bc4ec1ed34
commit
97e83bf75d
|
|
@ -1,613 +0,0 @@
|
|||
(in-package :9p-client)
|
||||
|
||||
(define-constant +byte-type+ '(unsigned-byte 8) :test #'equalp)
|
||||
|
||||
(define-constant +version+ "9P2000" :test #'string=)
|
||||
|
||||
(define-constant +message-length-size+ 4 :test #'=)
|
||||
|
||||
(define-constant +message-type-size+ 1 :test #'=)
|
||||
|
||||
(define-constant +message-tag-size+ 2 :test #'=)
|
||||
|
||||
(define-constant +message-string-length-size+ 2 :test #'=)
|
||||
|
||||
(define-constant +nofid+ #xffffffff :test #'=)
|
||||
|
||||
(define-constant +create-for-read+ #x0 :test #'=)
|
||||
|
||||
(define-constant +create-for-write+ #x1 :test #'=)
|
||||
|
||||
(define-constant +create-for-read-write+ #x2 :test #'=)
|
||||
|
||||
(define-constant +create-for-exec+ #x3 :test #'=)
|
||||
|
||||
(define-constant +create-dir+ #x80000000 :test #'=)
|
||||
|
||||
(define-constant +open-truncate+ #x10 :test #'=)
|
||||
|
||||
(define-constant +open-remove-on-clunk+ #x40 :test #'=)
|
||||
|
||||
(define-constant +standard-socket-port+ 564 :test #'=)
|
||||
|
||||
(define-constant +nwname-clone+ 0 :test #'=)
|
||||
|
||||
(defparameter *buffer-size* 252)
|
||||
|
||||
(defparameter *tag* 8)
|
||||
|
||||
(defparameter *fid* #x00000001)
|
||||
|
||||
(defparameter *messages-sent* '())
|
||||
|
||||
(defun tags-exists-p-clsr (tag-looking-for)
|
||||
(lambda (a) (octects= tag-looking-for (car a))))
|
||||
|
||||
(defun fire-response (tag message-type data)
|
||||
(let ((found (find-if (tags-exists-p-clsr tag) *messages-sent*)))
|
||||
(if found
|
||||
(let ((fn (cdr found)))
|
||||
(setf *messages-sent* (remove-if (tags-exists-p-clsr tag) *messages-sent*))
|
||||
(funcall fn message-type data))
|
||||
(warn (format nil "received unknown response message tag ~a" tag)))))
|
||||
|
||||
(defun append-tag-callback (tag function)
|
||||
(setf *messages-sent* (push (cons tag function) *messages-sent*)))
|
||||
|
||||
(defun read-all-pending-message (socket)
|
||||
(when *messages-sent*
|
||||
(multiple-value-bind (message-type rtag data)
|
||||
(restart-case
|
||||
(read-message socket)
|
||||
(ignore-error (e)
|
||||
(values (message-type e)
|
||||
(tag e)
|
||||
#())))
|
||||
(fire-response rtag message-type data)
|
||||
(read-all-pending-message socket))))
|
||||
|
||||
(defun next-tag ()
|
||||
(prog1
|
||||
(make-octects *tag* 2)
|
||||
(incf *tag*)))
|
||||
|
||||
(defun next-fid ()
|
||||
(prog1
|
||||
(int32->bytes *fid*)
|
||||
(incf *fid*)))
|
||||
|
||||
(defun bytes->int (bytes)
|
||||
(let ((res #x0000000000000000)
|
||||
(ct 0))
|
||||
(map nil
|
||||
(lambda (a)
|
||||
(setf res (boole boole-ior
|
||||
(ash a ct)
|
||||
res))
|
||||
(incf ct 8))
|
||||
bytes)
|
||||
res))
|
||||
|
||||
(defmacro gen-intn->bytes (bits)
|
||||
(let ((function-name (alexandria:format-symbol t "~:@(int~a->bytes~)" bits)))
|
||||
`(defun ,function-name (val &optional (count 0) (res '()))
|
||||
(if (>= count ,(/ bits 8))
|
||||
(reverse res) ; little endian
|
||||
(,function-name (ash val -8)
|
||||
(1+ count)
|
||||
(push (boole boole-and val #x00ff)
|
||||
res))))))
|
||||
|
||||
(gen-intn->bytes 8)
|
||||
|
||||
(gen-intn->bytes 16)
|
||||
|
||||
(gen-intn->bytes 32)
|
||||
|
||||
(gen-intn->bytes 64)
|
||||
|
||||
(gen-intn->bytes 512)
|
||||
|
||||
(gen-intn->bytes 416)
|
||||
|
||||
(defun big-endian->little-endian (bytes)
|
||||
(reverse bytes))
|
||||
|
||||
(defun vcat (a b)
|
||||
(concatenate 'vector a b))
|
||||
|
||||
(defclass octects ()
|
||||
((value
|
||||
:initform 0
|
||||
:initarg :value
|
||||
:accessor value)
|
||||
(size
|
||||
:initform 0
|
||||
:initarg :size
|
||||
:accessor size)))
|
||||
|
||||
(defgeneric octects= (a b))
|
||||
|
||||
(defgeneric encode (object))
|
||||
|
||||
(defgeneric decode (object))
|
||||
|
||||
(defmethod encode ((object octects))
|
||||
(with-accessors ((value value)
|
||||
(size size)) object
|
||||
(let ((bytes (ecase size
|
||||
(1 (int8->bytes value))
|
||||
(2 (int16->bytes value))
|
||||
(4 (int32->bytes value))
|
||||
(8 (int64->bytes value))
|
||||
(13 (int416->bytes value))
|
||||
(32 (int512->bytes value))))
|
||||
(res (make-array size :element-type +byte-type+)))
|
||||
(loop for i from 0 below size do
|
||||
(setf (elt res i) (elt bytes i)))
|
||||
res)))
|
||||
|
||||
(defmethod octects= ((a octects) b)
|
||||
(= (value a) b))
|
||||
|
||||
(defmethod octects= ((a number) (b octects))
|
||||
(octects= b a))
|
||||
|
||||
(defmethod octects= ((a number) (b number))
|
||||
(= b a))
|
||||
|
||||
(defun add-size (msg)
|
||||
(let ((length (int32->bytes (+ +message-length-size+ (length msg)))))
|
||||
(vcat length msg)))
|
||||
|
||||
(defun start-client (host port)
|
||||
(usocket:socket-connect host
|
||||
port
|
||||
:protocol :stream
|
||||
:element-type +byte-type+))
|
||||
|
||||
(defun close-client (socket)
|
||||
(usocket:socket-close socket))
|
||||
|
||||
(defun send-message (socket message)
|
||||
(with-accessors ((stream usocket:socket-stream)) socket
|
||||
(write-sequence message stream)
|
||||
(finish-output stream)))
|
||||
|
||||
(defun encode-string (string)
|
||||
(let* ((bytes (babel:string-to-octets string))
|
||||
(size (int16->bytes (length bytes))))
|
||||
(vcat size bytes)))
|
||||
|
||||
(defmethod encode ((object string))
|
||||
(encode-string object))
|
||||
|
||||
(defmethod encode ((object list))
|
||||
(let ((buffer (make-message-buffer (length object))))
|
||||
(loop for i from 0 below (length object) do
|
||||
(setf (elt buffer i) (elt object i)))
|
||||
buffer))
|
||||
|
||||
(defmethod encode (object)
|
||||
object)
|
||||
|
||||
(defmethod decode-string (data)
|
||||
(let ((size (bytes->int (subseq data 0 +message-string-length-size+))))
|
||||
(babel:octets-to-string (subseq data
|
||||
+message-string-length-size+
|
||||
(+ +message-string-length-size+ size))
|
||||
:errorp nil)))
|
||||
|
||||
(defun compose-message (message-type tag &rest params)
|
||||
(let ((actual-params (reduce #'vcat (mapcar #'encode params))))
|
||||
(add-size (reduce #'vcat (list (encode message-type) (encode tag) actual-params)))))
|
||||
|
||||
(defun displace-response (response)
|
||||
(let ((message-type (subseq response 0 +message-type-size+))
|
||||
(message-tag (subseq response
|
||||
+message-type-size+
|
||||
(+ +message-type-size+
|
||||
+message-tag-size+)))
|
||||
(data (subseq response
|
||||
(+ +message-type-size+
|
||||
+message-tag-size+))))
|
||||
(values (bytes->int message-type)
|
||||
(bytes->int message-tag)
|
||||
data)))
|
||||
|
||||
(defun make-message-buffer (size)
|
||||
(make-array size :element-type +byte-type+))
|
||||
|
||||
(defun error-response-p (response)
|
||||
(multiple-value-bind (message-type x y)
|
||||
(displace-response response)
|
||||
(declare (ignore x y))
|
||||
(= message-type *rerror*)))
|
||||
|
||||
(defun read-message (socket)
|
||||
(with-accessors ((stream usocket:socket-stream)) socket
|
||||
(let ((message-length-buffer (make-message-buffer +message-length-size+)))
|
||||
(read-sequence message-length-buffer stream)
|
||||
(let* ((message-length (bytes->int message-length-buffer))
|
||||
(buffer (make-message-buffer (- message-length +message-length-size+))))
|
||||
(read-sequence buffer stream)
|
||||
(multiple-value-bind (message-type tag data)
|
||||
(displace-response buffer)
|
||||
(if (error-response-p buffer)
|
||||
(error '9p-error
|
||||
:message-type message-type
|
||||
:tag tag
|
||||
:error-value (decode-string data))
|
||||
(values message-type tag data)))))))
|
||||
|
||||
(defun make-octects (number size)
|
||||
(make-instance 'octects :value number :size size))
|
||||
|
||||
(defun send-version (socket tag)
|
||||
(let ((message (compose-message (make-octects *tversion* 1)
|
||||
tag
|
||||
(make-octects *buffer-size* 4)
|
||||
+version+)))
|
||||
(send-message socket message)
|
||||
(multiple-value-bind (message-type rtag data)
|
||||
(read-message socket)
|
||||
(assert (= message-type *rversion*))
|
||||
(if (octects= rtag tag)
|
||||
(let ((message-size (bytes->int (subseq data 0 4)))
|
||||
(protocol-version (decode-string (subseq data 4))))
|
||||
(setf *buffer-size* message-size)
|
||||
(values message-size protocol-version))
|
||||
(error '9p-initialization-error :tag tag :rtag rtag)))))
|
||||
|
||||
(defmacro with-new-tag ((tag) &body body)
|
||||
`(let ((,tag (next-tag)))
|
||||
,@body))
|
||||
|
||||
(defmacro with-new-fid ((fid) &body body)
|
||||
`(let ((,fid (next-fid)))
|
||||
,@body))
|
||||
|
||||
(defun initialize-session (host port)
|
||||
(with-new-tag (tag)
|
||||
(let* ((socket (start-client host port)))
|
||||
(multiple-value-bind (buffer-size protocol-version)
|
||||
(send-version socket tag)
|
||||
(values socket protocol-version buffer-size)))))
|
||||
|
||||
(defun decode-quid (data)
|
||||
(let ((file-type (first-elt data))
|
||||
(file-version (subseq data 1 4))
|
||||
(file-path (subseq data 1 5)))
|
||||
(values file-type
|
||||
(bytes->int file-version)
|
||||
(bytes->int file-path))))
|
||||
|
||||
(defun dummy-callback (message-type data)
|
||||
(declare (ignore message-type data)))
|
||||
|
||||
(defun dump-callback (message-type data)
|
||||
(format t "reply mtype ~a ~a~%" message-type data))
|
||||
|
||||
(defun 9p-attach (socket root
|
||||
&key
|
||||
(username "nobody")
|
||||
(callback #'dummy-callback))
|
||||
(with-new-tag (tag)
|
||||
(with-new-fid (root-fid)
|
||||
(let* ((message (compose-message (make-octects *tattach* 1)
|
||||
tag
|
||||
root-fid
|
||||
(make-octects +nofid+ 4)
|
||||
username
|
||||
root)))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message)
|
||||
root-fid))))
|
||||
|
||||
(defun 9p-create (socket parent-dir-fid path
|
||||
&key
|
||||
(callback #'dummy-callback)
|
||||
(permissions #o640)
|
||||
(mode +create-for-read-write+))
|
||||
"Note: path is relative to root, see attach,
|
||||
Also note that successfully creating a file will open it."
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *tcreate* 1)
|
||||
tag
|
||||
parent-dir-fid
|
||||
path
|
||||
(make-octects permissions 4)
|
||||
(make-octects mode 1))))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defun 9p-open (socket fid
|
||||
&key
|
||||
(callback #'dummy-callback)
|
||||
(mode +create-for-read+))
|
||||
"Note before opening you have to 'walk' the file to get the corresponding fid."
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *topen* 1)
|
||||
tag
|
||||
fid
|
||||
(make-octects mode 1))))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defgeneric 9p-write (socket fid offset data &key callback))
|
||||
|
||||
(defmethod 9p-write (socket fid offset (data vector)
|
||||
&key
|
||||
(callback #'dummy-callback))
|
||||
(let* ((data-chunk-num (floor (/ (length data) *buffer-size*)))
|
||||
(data-chunk-length (if (> (length data) *buffer-size*)
|
||||
(* data-chunk-num *buffer-size*)
|
||||
(length data)))
|
||||
(remainder (if (> (length data) *buffer-size*)
|
||||
(- (length data)
|
||||
(* data-chunk-num *buffer-size*))
|
||||
0)))
|
||||
(flet ((write-chunk (chunk chunk-offset)
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *twrite* 1)
|
||||
tag
|
||||
fid
|
||||
(make-octects chunk-offset 8)
|
||||
(make-octects (length chunk) 4)
|
||||
chunk)))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message)))))
|
||||
(loop for i from 0 below (- (length data) remainder) by data-chunk-length do
|
||||
(let ((chunk (subseq data i (+ i data-chunk-length))))
|
||||
(write-chunk chunk (+ offset i))))
|
||||
(when (> remainder 0)
|
||||
(write-chunk (subseq data (- (length data) remainder))
|
||||
(+ offset (- (length data) remainder)))))))
|
||||
|
||||
(defmethod 9p-write (socket fid offset (data string)
|
||||
&key
|
||||
(callback #'dummy-callback))
|
||||
(9p-write socket fid offset (babel:string-to-octets data) :callback callback))
|
||||
|
||||
(defun 9p-walk (socket root-fid new-fid new-name &key (callback #'dummy-callback))
|
||||
(if (and (numberp new-name)
|
||||
(= 0 new-name))
|
||||
(%9p-walk-self socket root-fid new-fid :callback callback)
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *twalk* 1)
|
||||
tag
|
||||
root-fid
|
||||
new-fid
|
||||
(make-octects 1 2)
|
||||
new-name)))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message)))))
|
||||
|
||||
(defun %9p-walk-self (socket root-fid new-fid &key (callback #'dummy-callback))
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *twalk* 1)
|
||||
tag
|
||||
root-fid
|
||||
new-fid
|
||||
(make-octects 0 2))))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defun 9p-remove (socket fid &key (callback #'dummy-callback))
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *tremove* 1)
|
||||
tag
|
||||
fid)))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defun 9p-clunk (socket fid &key (callback #'dummy-callback))
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *tclunk* 1)
|
||||
tag
|
||||
fid)))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defun 9p-stat (socket fid &key (callback #'dummy-callback))
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *tstat* 1)
|
||||
tag
|
||||
fid)))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defun 9p-read (socket fid offset chunk-length &key (callback #'dummy-callback))
|
||||
(with-new-tag (tag)
|
||||
(let* ((message (compose-message (make-octects *tread* 1)
|
||||
tag
|
||||
fid
|
||||
(make-octects offset 8)
|
||||
(make-octects chunk-length 4))))
|
||||
(append-tag-callback tag callback)
|
||||
(send-message socket message))))
|
||||
|
||||
(defun decode-read-reply (data &optional (as-string nil))
|
||||
(let ((count (bytes->int (subseq data 0 4)))
|
||||
(raw-data (subseq data 4)))
|
||||
(values (if as-string
|
||||
(babel:octets-to-string raw-data :errorp nil)
|
||||
raw-data)
|
||||
count)))
|
||||
|
||||
(defun encoded-string-offset (decoded-string)
|
||||
(+ (length decoded-string)
|
||||
+message-string-length-size+))
|
||||
|
||||
(defun decode-rstat (data)
|
||||
(flet ((->int (start end)
|
||||
(bytes->int (subseq data start end))))
|
||||
(let* ((entry-size1 (->int 0 2))
|
||||
(entry-size2 (->int 2 4))
|
||||
(ktype (->int 4 6))
|
||||
(kdev (->int 6 10))
|
||||
(entry-type (->int 10 11))
|
||||
(version (->int 11 15))
|
||||
(path (->int 15 23))
|
||||
(mode (->int 23 27))
|
||||
(atime (->int 27 31))
|
||||
(mtime (->int 31 35))
|
||||
(size (->int 35 43))
|
||||
(strings-start 43)
|
||||
(name (decode-string (subseq data strings-start)))
|
||||
(name-offset (encoded-string-offset name))
|
||||
(user-id (decode-string (subseq data
|
||||
(+ strings-start
|
||||
name-offset))))
|
||||
(user-id-offset (+ strings-start
|
||||
(encoded-string-offset user-id)
|
||||
name-offset))
|
||||
(group-id (decode-string (subseq data user-id-offset)))
|
||||
(group-id-offset (+ user-id-offset
|
||||
(encoded-string-offset group-id)))
|
||||
(last-modified-from-id (decode-string (subseq data group-id-offset))))
|
||||
(values entry-size1
|
||||
entry-size2
|
||||
ktype
|
||||
kdev
|
||||
entry-type
|
||||
version
|
||||
path
|
||||
mode
|
||||
atime
|
||||
mtime
|
||||
size
|
||||
name
|
||||
user-id
|
||||
group-id
|
||||
last-modified-from-id))))
|
||||
|
||||
;;; high level routines
|
||||
|
||||
(defun read-all-pending-messages-ignoring-errors (socket)
|
||||
(handler-bind ((9p-error
|
||||
(lambda (e)
|
||||
(invoke-restart 'ignore-error e))))
|
||||
(read-all-pending-message socket)))
|
||||
|
||||
(defun create-directory (socket parent-fid directory-name &key (permissions #o760))
|
||||
(9p-create socket
|
||||
parent-fid
|
||||
directory-name
|
||||
:permissions (logior +create-dir+ permissions)
|
||||
:mode +create-for-read+)
|
||||
(read-all-pending-messages-ignoring-errors socket))
|
||||
|
||||
(defun create-path (socket parent-fid path &key (file-permissions #o640))
|
||||
(let ((fs:*directory-sep-regexp* "\\/")
|
||||
(path-elements (fs:split-path-elements path))
|
||||
(last-is-dir-p (cl-ppcre:scan "\\/$" path)))
|
||||
(labels ((%create-dirs (path-elements)
|
||||
(when path-elements
|
||||
(create-directory socket parent-fid (first path-elements))
|
||||
(read-all-pending-messages-ignoring-errors socket)
|
||||
(%create-dirs (rest path-elements)))))
|
||||
(%create-dirs (misc:safe-all-but-last-elt path-elements))
|
||||
(if last-is-dir-p
|
||||
(create-directory socket parent-fid (last-elt path-elements))
|
||||
(9p-create socket parent-fid (last-elt path-elements)
|
||||
:permissions file-permissions))
|
||||
(read-all-pending-messages-ignoring-errors socket))))
|
||||
|
||||
(defun mount (host root-path &optional (port +standard-socket-port+))
|
||||
(multiple-value-bind (socket version)
|
||||
(initialize-session host port)
|
||||
(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 cat-reply-vector (a b)
|
||||
(concatenate '(vector (unsigned-byte 8)) a b))
|
||||
|
||||
(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 (cat-reply-vector 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))))
|
||||
|
||||
(defun example-stat (&optional (root (os-utils:getenv "HOME")) (host "localhost") (port 10564))
|
||||
(multiple-value-bind (socket root-fid)
|
||||
(mount host root port)
|
||||
(9p-stat socket root-fid
|
||||
:callback (lambda (x data)
|
||||
(declare (ignore x))
|
||||
(format t "raw ~a~%stat ~a~%" data (multiple-value-list (decode-rstat data)))))
|
||||
(read-all-pending-message socket)))
|
||||
|
||||
(defun pad-read-dir-reply (data)
|
||||
(cat-reply-vector #(0 0) data))
|
||||
|
||||
(defun read-directory (&optional (root (os-utils:getenv "HOME")) (host "localhost") (port 10564))
|
||||
(multiple-value-bind (socket root-fid)
|
||||
(mount host root port)
|
||||
(9p-open socket root-fid :mode +create-for-read+)
|
||||
(9p-read socket
|
||||
root-fid
|
||||
0 4
|
||||
:callback (lambda (x data)
|
||||
(declare (ignore x))
|
||||
(format t
|
||||
"raw ~a~%" data)))
|
||||
(read-all-pending-message socket)))
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
;; tinmop: an humble gemini and pleroma client
|
||||
;; Copyright (C) 2020 cage
|
||||
|
||||
;; This program is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(defpackage :9p-client
|
||||
(:use
|
||||
:cl
|
||||
:alexandria)
|
||||
(:export))
|
||||
|
|
@ -168,22 +168,25 @@
|
|||
|
||||
(defun open-resource-with-external-program (resource give-focus-to-message-window
|
||||
&key (open-for-edit nil))
|
||||
(let ((program (swconf:link-regex->program-to-use resource)))
|
||||
(if program
|
||||
(cond
|
||||
((swconf:use-editor-as-external-program-p program)
|
||||
(flet ((edit (file)
|
||||
(croatoan:end-screen)
|
||||
(os-utils:open-with-editor resource))
|
||||
((and (null open-for-edit)
|
||||
(swconf:use-tinmop-as-external-program-p program))
|
||||
(gemini-viewer:load-gemini-url resource
|
||||
:give-focus-to-message-window
|
||||
give-focus-to-message-window))
|
||||
(t
|
||||
(os-utils:open-link-with-program program resource :wait open-for-edit)))
|
||||
(if open-for-edit
|
||||
(error (_ "No editor program defined in config file"))
|
||||
(os-utils:xdg-open resource)))))
|
||||
(os-utils:open-with-editor file)))
|
||||
(let ((program (swconf:link-regex->program-to-use resource)))
|
||||
(if program
|
||||
(cond
|
||||
((swconf:use-editor-as-external-program-p program)
|
||||
(edit resource))
|
||||
((swconf:use-tinmop-as-external-program-p program)
|
||||
(if open-for-edit
|
||||
(edit resource)
|
||||
(gemini-viewer:load-gemini-url resource
|
||||
:give-focus-to-message-window
|
||||
give-focus-to-message-window)))
|
||||
(t
|
||||
(os-utils:open-link-with-program program resource :wait open-for-edit)))
|
||||
(if open-for-edit
|
||||
(error (_ "No program defined in configuration file to edit this kind of files."))
|
||||
(os-utils:xdg-open resource))))))
|
||||
|
||||
(defun unzip-file (zip-file destination-dir)
|
||||
(cond
|
||||
|
|
|
|||
Loading…
Reference in New Issue