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

- added a minimal client-server interation system (using pipe). 

- renamed 'main:init' to 'main-croatoan-init'.
This commit is contained in:
cage 2022-12-24 14:39:53 +01:00
parent db30d2b47d
commit b2e7f8fd62
7 changed files with 221 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/command-line.lisp
View File

@ -20,6 +20,8 @@
(defun print-version ()
(format t (_ "~a version ~a~%") +program-name+ +program-version+))
(define-constant +start-server-command-line+ #\S :test #'char=)
(defmacro gen-opts ()
`(opts:define-opts
(:name :help
@ -73,6 +75,14 @@
:description (_ "Start as gemini client only.")
:short #\G
:long "gemini-client-only")
(:name :gemini-gui
:description (_ "Start as gemini gui client only.")
:short #\U
:long "gemini-gui-client-only")
(:name :gemini-gui-server
:description (_ "Start as gemini gui server only.")
:short +start-server-command-line+
:long "gemini-gui-server-only")
(:name :load-module
:description (_ "Load a module")
:short #\M
@ -108,6 +118,10 @@
(defparameter *print-lisp-dependencies* nil)
(defparameter *rpc-server-mode* nil)
(defparameter *rpc-client-mode* nil)
(defun exit-on-error (e)
(format *error-output* "~a~%" e)
(os-utils:exit-program 1))
@ -132,6 +146,8 @@
(when (getf options :version)
(print-version)
(os-utils:exit-program))
(set-option-variable options :gemini-gui-server *rpc-server-mode*)
(set-option-variable options :gemini-gui *rpc-client-mode*)
(set-option-variable options :folder *start-folder*)
(set-option-variable options :open-net-address *net-address*)
(set-option-variable options :timeline *start-timeline*)

111
src/gui/json-rpc-communication.lisp
View File

@ -1,13 +1,114 @@
(in-package :json-rpc-communication)
(defparameter *server-input-stream* *standard-input*)
(defparameter *stop-server* nil)
(defparameter *server-process* nil)
(defparameter *server-stream* nil)
(defparameter *server-output-stream* *standard-output*)
(defparameter *client-input-stream* *standard-input*)
(defparameter *server-input-stream* *standard-input*)
(defparameter *client-output-stream* *standard-output*)
(defparameter *server-error-stream* *error-output*)
(defun start-server ())
(defparameter *excess-data-from-client* #())
(defun read-json ())
(a:define-constant +command-delimiter+ 0 :test #'=)
(defmacro prepare-rpc (&body body)
`(let ((rpc:*function-db* '()))
(rpc:register-function "add" '+ (list (cons "a" 0) (cons "b" 1)))
,@body))
(defun read-json (stream)
(to-s (read-delimited-into-array-unbuffered stream
:delimiter +command-delimiter+)))
(defun elaborate-json-request (data)
(rpc:jsonify (rpc:elaborate-request data)))
(defun read-from-client ()
(read-json *server-input-stream*))
(defgeneric send-to-client (object))
(defmethod send-to-client ((object string))
(send-to-client (babel:string-to-octets object)))
(defmethod send-to-client ((object vector))
(write-sequence object *server-output-stream*)
(write-byte +command-delimiter+ *server-output-stream*)
(finish-output *server-output-stream*))
(defun quit-server ()
(os-utils:exit-program))
(defun start-server ()
(prepare-rpc
(loop while (not *stop-server*) do
(handler-case
(let ((json (read-from-client)))
(if (string-empty-p json)
(setf *stop-server* t)
(let ((results (elaborate-json-request json)))
(send-to-client results))))
(rpc:json-rpc-error (e)
(send-to-client (format nil (_ "RPC Error: ~a~%") e))
(setf *stop-server* t))
(delimiter-not-found (e)
(send-to-client (format nil (_ "Read error: ~a~%") e))
(setf *stop-server* t))
(error (e)
(send-to-client (format nil (_ "Error: ~a~%") e))
(setf *stop-server* t))))
(send-to-client "Bye!")
(quit-server)))
(defun read-from-server ()
(json:parse (read-json *server-stream*)
:object-as :plist
:object-key-fn #'format-keyword))
(defgeneric send-to-server (object))
(defmethod send-to-server ((object string))
(send-to-server (babel:string-to-octets object)))
(defmethod send-to-server ((object vector))
(write-sequence object *server-stream*)
(write-byte +command-delimiter+ *server-stream*)
(finish-output *server-stream*))
(defmethod send-to-server ((object character))
(send-to-server (char-code object)))
(defmethod send-to-server ((object integer))
(write-byte (logand object #xff) *server-stream*)
(finish-output *server-stream*))
(defun close-server ()
(send-to-server +command-delimiter+))
(defun start-client ()
(with-output-to-string (stream)
(let* ((process (os-utils:run-external-program "/home/cage/lisp/tinmop/tinmop" ;+program-name+
(list (format nil
"-~a"
command-line:+start-server-command-line+))
:search t
:wait nil
:output :stream
:input :stream
:error :stream)))
(if process
(let ((process-stream (make-two-way-stream (os-utils:process-output process)
(os-utils:process-input process))))
(setf *server-stream* process-stream
*server-process* process)
(let ((request (rpc:jsonify (rpc:make-request "add" 1 10 20))))
(format t "sending ~a~%" request)
(send-to-server request)
(format t "returned ~s~%" (read-from-server))
(close-server)))
(error (_ "Unable to create server process"))))))

8
src/main.lisp
View File

@ -137,7 +137,7 @@ etc.) happened"
(load-configuration-files)
(init-db))
(defun init ()
(defun croatoan-init ()
"Initialize the program"
(shared-init)
(db-utils:with-ready-database (:connect nil)
@ -229,6 +229,10 @@ etc.) happened"
(res:init)
(command-line:manage-opts)
(cond
(command-line:*rpc-server-mode*
(json-rpc-communication:start-server))
(command-line:*rpc-client-mode*
(json-rpc-communication:start-client))
(command-line:*print-lisp-dependencies*
(misc:all-program-dependencies t))
(command-line:*script-file*
@ -238,5 +242,5 @@ etc.) happened"
(declare (ignore h))
(c:end-screen)
(print c))))
(init)
(croatoan-init)
(run first-time-starting))))))

45
src/misc-utils.lisp
View File

@ -505,24 +505,33 @@ to the array"
'(unsigned-byte 8))))
(flet ((delimiter-position ()
(position delimiter accum :test #'=)))
(let ((read-so-far (read-sequence buffer stream)))
(setf accum (concatenate 'vector accum (subseq buffer 0 read-so-far)))
(if (< read-so-far buffer-size)
(if (or (< (length accum) 1)
(not (delimiter-position)))
(error 'delimiter-not-found :delimiter delimiter)
(values (subseq accum 0 (1- (length accum)))
#()))
(if (delimiter-position)
(let* ((delimiter-position (delimiter-position))
(excess (subseq accum (1+ delimiter-position))))
(values (subseq accum 0 delimiter-position)
excess))
(read-delimited-into-array stream
:delimiter delimiter
:buffer-size buffer-size
:buffer buffer
:accum accum))))))
(if (delimiter-position)
(values (subseq accum 0 (delimiter-position))
(subseq accum (1+ (delimiter-position))))
(let ((read-so-far (read-sequence buffer stream)))
(setf accum (concatenate 'vector accum (subseq buffer 0 read-so-far)))
(if (< read-so-far buffer-size)
(if (or (< (length accum) 1)
(not (delimiter-position)))
(error 'delimiter-not-found :delimiter delimiter)
(values (subseq accum 0 (delimiter-position))
(subseq accum (1+ (delimiter-position)))))
(if (delimiter-position)
(let* ((delimiter-position (delimiter-position))
(excess (subseq accum (1+ delimiter-position))))
(values (subseq accum 0 delimiter-position)
excess))
(read-delimited-into-array stream
:delimiter delimiter
:buffer-size buffer-size
:buffer buffer
:accum accum)))))))
(defun read-delimited-into-array-unbuffered (stream &key (delimiter *read-delimiter*))
(list->array (loop for i = (read-byte stream nil nil) then (read-byte stream nil nil)
while (and i (/= i delimiter))
collect i)
'(unsigned-byte 8)))
;; sequence utils

26
src/os-utils.lisp
View File

@ -80,6 +80,7 @@
input
output
(error :output)
(external-format :default)
#+sbcl (if-output-exists :supersede)
#+sbcl (if-error-exists :supersede))
(declare (ignorable search))
@ -96,6 +97,7 @@
:input input
:output output
:error error
:external-format external-format
:if-output-exists if-output-exists
:if-error-exists if-error-exists))
@ -106,6 +108,16 @@
(defun process-exit-success-p (process)
(= (process-exit-code process) 0))
(defmacro gen-process-stream (name)
`(defun ,(misc:format-fn-symbol t "process-~a" name) (process)
(,(misc:format-fn-symbol 'sb-ext "process-~a" name) process)))
(gen-process-stream output)
(gen-process-stream input)
(gen-process-stream error)
(defun open-with-editor (file)
(multiple-value-bind (exe args)
(external-editor)
@ -207,14 +219,14 @@
(defun unzip-single-file (zip-file file-entry)
(with-output-to-string (stream)
(let* ((process (run-external-program +unzip-bin+
(list "-p" zip-file file-entry)
:search t
:wait t
:output stream
:error :output)))
(let* ((process (run-external-program +unzip-bin+
(list "-p" zip-file file-entry)
:search t
:wait t
:output stream
:error :output)))
(when (not (process-exit-success-p process))
(error (format nil "File ~s extraction from ~s failed" file-entry zip-file))))))
(error (format nil (_ "File ~s extraction from ~s failed") file-entry zip-file))))))
(defun copy-to-clipboard (text)
(trivial-clipboard:text text))

19
src/package.lisp
View File

@ -188,6 +188,7 @@
:delimiter-not-found
:*read-delimiter*
:read-delimited-into-array
:read-delimited-into-array-unbuffered
:definline
:+cache-invalid-value+
:defcached
@ -364,6 +365,9 @@
:run-external-program
:process-exit-code
:process-exit-success-p
:process-error
:process-input
:process-output
:open-with-editor
:exit-program
:user-cache-dir
@ -1381,6 +1385,7 @@
:misc-utils)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+start-server-command-line+
:*start-folder*
:*start-timeline*
:*update-timeline*
@ -1393,6 +1398,8 @@
:*update-timeline-climb-message-tree*
:*gemini-full-screen-mode*
:*print-lisp-dependencies*
:*rpc-server-mode*
:*rpc-client-mode*
:manage-opts))
(defpackage :specials
@ -3051,12 +3058,14 @@
:constants
:text-utils
:misc-utils)
(:local-nicknames (:re :cl-ppcre-unicode)
(:a :alexandria)
(:rpc :json-rpc2))
(:export))
(:local-nicknames (:re :cl-ppcre-unicode)
(:a :alexandria)
(:rpc :json-rpc2)
(:json :yason))
(:export
:start-server
:start-client))
(defpackage :main
(:use

33
src/tests/misc-tests.lisp
View File

@ -58,3 +58,36 @@
(deftest test-read-delimited-no-excess (misc-suite)
(assert-condition delimiter-not-found
(read-delimited-error)))
(defun read-delimited-excess-custom-delimiter (&optional (data `(1 2 3
4 5 6
,(char-code #\.)
7 8 9 10)))
(flexi-streams:with-input-from-sequence (stream data)
(read-delimited-into-array stream :buffer-size 4096 :delimiter (char-code #\.))))
(deftest test-read-delimited-custom-delimiter (misc-suite)
(assert-equalp (values #(1 2 3 4 5 6)
#(7 8))
(read-delimited-excess)))
(defun read-delimited-accum-contains-delimiter ()
(flexi-streams:with-input-from-sequence (stream #())
(read-delimited-into-array stream
:buffer-size 4096
:delimiter 0
:accum #(1 2 3 0 4 5 6))))
(deftest test-read-delimited-custom-delimiter (misc-suite)
(assert-equalp (values #(1 2 3)
#(4 5 6))
(read-delimited-accum-contains-delimiter)))
(defun read-delimited-unbuffered ()
(flexi-streams:with-input-from-sequence (stream #(1 2 3 0 4 5))
(read-delimited-into-array-unbuffered stream
:delimiter 0)))
(deftest test-read-delimited-unbuffered (misc-suite)
(assert-equalp #(1 2 3)
(read-delimited-unbuffered)))