2022-12-23 13:23:08 +01:00
|
|
|
(in-package :json-rpc-communication)
|
|
|
|
|
2022-12-24 14:39:53 +01:00
|
|
|
(defparameter *stop-server* nil)
|
|
|
|
|
|
|
|
(defparameter *server-process* nil)
|
|
|
|
|
|
|
|
(defparameter *server-stream* nil)
|
2022-12-23 13:23:08 +01:00
|
|
|
|
|
|
|
(defparameter *server-output-stream* *standard-output*)
|
|
|
|
|
2022-12-24 14:39:53 +01:00
|
|
|
(defparameter *server-input-stream* *standard-input*)
|
|
|
|
|
|
|
|
(defparameter *server-error-stream* *error-output*)
|
|
|
|
|
|
|
|
(defparameter *excess-data-from-client* #())
|
|
|
|
|
|
|
|
(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)))
|
2022-12-23 13:23:08 +01:00
|
|
|
|
2022-12-24 14:39:53 +01:00
|
|
|
(defmethod send-to-server ((object integer))
|
|
|
|
(write-byte (logand object #xff) *server-stream*)
|
|
|
|
(finish-output *server-stream*))
|
2022-12-23 13:23:08 +01:00
|
|
|
|
2022-12-24 14:39:53 +01:00
|
|
|
(defun close-server ()
|
|
|
|
(send-to-server +command-delimiter+))
|
2022-12-23 13:23:08 +01:00
|
|
|
|
2022-12-24 14:39:53 +01:00
|
|
|
(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"))))))
|