mirror of https://codeberg.org/cage/tinmop/
75 lines
2.5 KiB
Common Lisp
75 lines
2.5 KiB
Common Lisp
;; tinmop: a multiprotocol client
|
|
;; Copyright © 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/][http://www.gnu.org/licenses/]].
|
|
|
|
(in-package :json-rpc-communication)
|
|
|
|
(defparameter *stop-server* nil)
|
|
|
|
(defparameter *server-output-stream* *standard-output*)
|
|
|
|
(defparameter *server-input-stream* *standard-input*)
|
|
|
|
(defparameter *server-error-stream* *error-output*)
|
|
|
|
(defparameter *excess-data-from-client* #())
|
|
|
|
(a:define-constant +command-delimiter+ 0 :test #'=)
|
|
|
|
(defun read-json (stream)
|
|
(to-s (read-delimited-into-array-unbuffered stream
|
|
:delimiter +command-delimiter+)))
|
|
|
|
(defun elaborate-json-request (data)
|
|
(rpc:encode-to-string (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 (string->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 stop-server ()
|
|
(setf *stop-server* t))
|
|
|
|
(defun start-server ()
|
|
(init-gemini-window)
|
|
(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!")))
|