From b2e7f8fd62aad778d4a14ade76011bfa0a2dc7d2 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 24 Dec 2022 14:39:53 +0100 Subject: [PATCH] - added a minimal client-server interation system (using pipe). - renamed 'main:init' to 'main-croatoan-init'. --- src/command-line.lisp | 16 ++++ src/gui/json-rpc-communication.lisp | 111 ++++++++++++++++++++++++++-- src/main.lisp | 8 +- src/misc-utils.lisp | 45 ++++++----- src/os-utils.lisp | 26 +++++-- src/package.lisp | 19 +++-- src/tests/misc-tests.lisp | 33 +++++++++ 7 files changed, 221 insertions(+), 37 deletions(-) diff --git a/src/command-line.lisp b/src/command-line.lisp index 49489ba..cd12c88 100644 --- a/src/command-line.lisp +++ b/src/command-line.lisp @@ -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*) diff --git a/src/gui/json-rpc-communication.lisp b/src/gui/json-rpc-communication.lisp index 6a6cac4..ddc5e89 100644 --- a/src/gui/json-rpc-communication.lisp +++ b/src/gui/json-rpc-communication.lisp @@ -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")))))) diff --git a/src/main.lisp b/src/main.lisp index fb598cd..5086f26 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -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)))))) diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp index d49b732..08324cc 100644 --- a/src/misc-utils.lisp +++ b/src/misc-utils.lisp @@ -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 diff --git a/src/os-utils.lisp b/src/os-utils.lisp index 3fd6535..f8c2e17 100644 --- a/src/os-utils.lisp +++ b/src/os-utils.lisp @@ -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)) diff --git a/src/package.lisp b/src/package.lisp index 9e84dce..d177cc0 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/tests/misc-tests.lisp b/src/tests/misc-tests.lisp index 4d9c61a..65b2b87 100644 --- a/src/tests/misc-tests.lisp +++ b/src/tests/misc-tests.lisp @@ -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)))