mirror of https://codeberg.org/cage/tinmop/
- added missing file;
- [RPC] splitted the package json-rpc-munication in two files: one in server directory and the other in the client directory.
This commit is contained in:
parent
155cdc1117
commit
891651b6fa
|
@ -0,0 +1,120 @@
|
||||||
|
;; tinmop: an humble gemini and pleroma client
|
||||||
|
;; Copyright (C) 2023 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 *server-process* nil)
|
||||||
|
|
||||||
|
(defparameter *server-stream* nil)
|
||||||
|
|
||||||
|
(defun read-from-server ()
|
||||||
|
(let ((json (read-json *server-stream*)))
|
||||||
|
(rpc:maybe-log-message (format nil "json from server: ~a" json))
|
||||||
|
(json:parse json
|
||||||
|
:object-as :plist
|
||||||
|
:object-key-fn #'format-keyword)))
|
||||||
|
|
||||||
|
(defgeneric send-to-server (object))
|
||||||
|
|
||||||
|
(defmethod send-to-server ((object string))
|
||||||
|
(send-to-server (string->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 (rpc:encode-to-string (rpc:make-request "quit-program" 1))))
|
||||||
|
|
||||||
|
(defun start-client ()
|
||||||
|
(with-output-to-string (stream)
|
||||||
|
(let* ((test-iri "gemini://")
|
||||||
|
(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)
|
||||||
|
(loop repeat 2 do
|
||||||
|
(let ((request (rpc:encode-to-string (rpc:make-request "gemini-request"
|
||||||
|
1
|
||||||
|
test-iri
|
||||||
|
t))))
|
||||||
|
(format t "sending ~a~%" request)
|
||||||
|
(send-to-server request)
|
||||||
|
(format t "returned ~s~%" (read-from-server))))
|
||||||
|
(sleep 3)
|
||||||
|
(let ((info-request (rpc:encode-to-string (rpc:make-request "gemini-stream-info"
|
||||||
|
1
|
||||||
|
test-iri))))
|
||||||
|
(format t "sending ~a~%" info-request)
|
||||||
|
(send-to-server info-request)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(let ((line-request (rpc:encode-to-string (rpc:make-request "gemini-stream-parsed-line"
|
||||||
|
1
|
||||||
|
test-iri
|
||||||
|
2))))
|
||||||
|
(format t "sending ~a~%" line-request)
|
||||||
|
(send-to-server line-request)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(let ((lines-request (rpc:encode-to-string
|
||||||
|
(rpc:make-request "gemini-stream-parsed-line-slice"
|
||||||
|
1
|
||||||
|
test-iri
|
||||||
|
10
|
||||||
|
15))))
|
||||||
|
(format t "sending ~a~%" lines-request)
|
||||||
|
(send-to-server lines-request)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(let ((all-info-request (rpc:encode-to-string
|
||||||
|
(rpc:make-request "gemini-all-stream-info" 1))))
|
||||||
|
(format t "sending ~a~%" all-info-request)
|
||||||
|
(send-to-server all-info-request)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(let ((pop-history-request (rpc:encode-to-string
|
||||||
|
(rpc:make-request "gemini-pop-url-from-history" 1))))
|
||||||
|
(format t "sending ~a~%" pop-history-request)
|
||||||
|
(send-to-server pop-history-request)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(let ((certificates (rpc:encode-to-string
|
||||||
|
(rpc:make-request "gemini-certificates" 1))))
|
||||||
|
(format t "sending ~a~%" certificates)
|
||||||
|
(send-to-server certificates)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(let ((toc (rpc:encode-to-string
|
||||||
|
(rpc:make-request "gemini-toc" 1 test-iri))))
|
||||||
|
(format t "sending ~a~%" toc)
|
||||||
|
(send-to-server toc)
|
||||||
|
(format t "returned ~s~%" (read-from-server)))
|
||||||
|
(close-server))
|
||||||
|
(error (_ "Unable to create server process"))))))
|
|
@ -0,0 +1,21 @@
|
||||||
|
(in-package :client-events)
|
||||||
|
|
||||||
|
(defparameter *stop-events-loop* t)
|
||||||
|
|
||||||
|
(defparameter *events-loop-lock* (bt:make-lock "events-loop-lock"))
|
||||||
|
|
||||||
|
(defun events-loop-running-p ()
|
||||||
|
(misc:with-lock (*events-loop-lock*)
|
||||||
|
(not *stop-events-loop*)))
|
||||||
|
|
||||||
|
(defun stop-events-loop ()
|
||||||
|
(misc:with-lock (*events-loop-lock*)
|
||||||
|
(setf *stop-events-loop* t)))
|
||||||
|
|
||||||
|
(defun start-events-loop ()
|
||||||
|
(misc:with-lock (*events-loop-lock*)
|
||||||
|
(setf *stop-events-loop* nil))
|
||||||
|
(bt:make-thread (lambda ()
|
||||||
|
(loop while (events-loop-running-p) do
|
||||||
|
(when (not (ev:stop-event-dispatching-p))
|
||||||
|
(ev:dispatch-program-events))))))
|
|
@ -1,5 +1,5 @@
|
||||||
;; tinmop: an humble gemini and pleroma client
|
;; tinmop: an humble gemini and pleroma client
|
||||||
;; Copyright (C) 2022 cage
|
;; Copyright (C) 2023 cage
|
||||||
|
|
||||||
;; This program is free software: you can redistribute it and/or modify
|
;; 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
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
@ -19,10 +19,6 @@
|
||||||
|
|
||||||
(defparameter *stop-server* nil)
|
(defparameter *stop-server* nil)
|
||||||
|
|
||||||
(defparameter *server-process* nil)
|
|
||||||
|
|
||||||
(defparameter *server-stream* nil)
|
|
||||||
|
|
||||||
(defparameter *server-output-stream* *standard-output*)
|
(defparameter *server-output-stream* *standard-output*)
|
||||||
|
|
||||||
(defparameter *server-input-stream* *standard-input*)
|
(defparameter *server-input-stream* *standard-input*)
|
||||||
|
@ -77,101 +73,3 @@
|
||||||
(setf *stop-server* t))))
|
(setf *stop-server* t))))
|
||||||
(send-to-client "Bye!")
|
(send-to-client "Bye!")
|
||||||
(quit-server)))
|
(quit-server)))
|
||||||
|
|
||||||
(defun read-from-server ()
|
|
||||||
(let ((json (read-json *server-stream*)))
|
|
||||||
(rpc:maybe-log-message (format nil "json from server: ~a" json))
|
|
||||||
(json:parse json
|
|
||||||
:object-as :plist
|
|
||||||
:object-key-fn #'format-keyword)))
|
|
||||||
|
|
||||||
(defgeneric send-to-server (object))
|
|
||||||
|
|
||||||
(defmethod send-to-server ((object string))
|
|
||||||
(send-to-server (string->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 (rpc:encode-to-string (rpc:make-request "quit-program" 1))))
|
|
||||||
|
|
||||||
(defun start-client ()
|
|
||||||
(with-output-to-string (stream)
|
|
||||||
(let* ((test-iri "gemini://")
|
|
||||||
(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)
|
|
||||||
(loop repeat 2 do
|
|
||||||
(let ((request (rpc:encode-to-string (rpc:make-request "gemini-request"
|
|
||||||
1
|
|
||||||
test-iri
|
|
||||||
t))))
|
|
||||||
(format t "sending ~a~%" request)
|
|
||||||
(send-to-server request)
|
|
||||||
(format t "returned ~s~%" (read-from-server))))
|
|
||||||
(sleep 3)
|
|
||||||
(let ((info-request (rpc:encode-to-string (rpc:make-request "gemini-stream-info"
|
|
||||||
1
|
|
||||||
test-iri))))
|
|
||||||
(format t "sending ~a~%" info-request)
|
|
||||||
(send-to-server info-request)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(let ((line-request (rpc:encode-to-string (rpc:make-request "gemini-stream-parsed-line"
|
|
||||||
1
|
|
||||||
test-iri
|
|
||||||
2))))
|
|
||||||
(format t "sending ~a~%" line-request)
|
|
||||||
(send-to-server line-request)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(let ((lines-request (rpc:encode-to-string
|
|
||||||
(rpc:make-request "gemini-stream-parsed-line-slice"
|
|
||||||
1
|
|
||||||
test-iri
|
|
||||||
10
|
|
||||||
15))))
|
|
||||||
(format t "sending ~a~%" lines-request)
|
|
||||||
(send-to-server lines-request)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(let ((all-info-request (rpc:encode-to-string
|
|
||||||
(rpc:make-request "gemini-all-stream-info" 1))))
|
|
||||||
(format t "sending ~a~%" all-info-request)
|
|
||||||
(send-to-server all-info-request)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(let ((pop-history-request (rpc:encode-to-string
|
|
||||||
(rpc:make-request "gemini-pop-url-from-history" 1))))
|
|
||||||
(format t "sending ~a~%" pop-history-request)
|
|
||||||
(send-to-server pop-history-request)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(let ((certificates (rpc:encode-to-string
|
|
||||||
(rpc:make-request "gemini-certificates" 1))))
|
|
||||||
(format t "sending ~a~%" certificates)
|
|
||||||
(send-to-server certificates)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(let ((toc (rpc:encode-to-string
|
|
||||||
(rpc:make-request "gemini-toc" 1 test-iri))))
|
|
||||||
(format t "sending ~a~%" toc)
|
|
||||||
(send-to-server toc)
|
|
||||||
(format t "returned ~s~%" (read-from-server)))
|
|
||||||
(close-server))
|
|
||||||
(error (_ "Unable to create server process"))))))
|
|
||||||
|
|
|
@ -157,7 +157,8 @@
|
||||||
(:module gui-client
|
(:module gui-client
|
||||||
:pathname "gui/client"
|
:pathname "gui/client"
|
||||||
:components ((:file "client-configuration")
|
:components ((:file "client-configuration")
|
||||||
(:file "program-events")))
|
(:file "program-events")
|
||||||
|
(:file "json-rpc-communication")))
|
||||||
(:file "main")
|
(:file "main")
|
||||||
(:module tests
|
(:module tests
|
||||||
:components ((:file "package")
|
:components ((:file "package")
|
||||||
|
|
Loading…
Reference in New Issue