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:
cage
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
|
||||
;; Copyright (C) 2022 cage
|
||||
;; 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
|
||||
|
|
@ -19,10 +19,6 @@
|
|||
|
||||
(defparameter *stop-server* nil)
|
||||
|
||||
(defparameter *server-process* nil)
|
||||
|
||||
(defparameter *server-stream* nil)
|
||||
|
||||
(defparameter *server-output-stream* *standard-output*)
|
||||
|
||||
(defparameter *server-input-stream* *standard-input*)
|
||||
|
|
@ -77,101 +73,3 @@
|
|||
(setf *stop-server* t))))
|
||||
(send-to-client "Bye!")
|
||||
(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
|
||||
:pathname "gui/client"
|
||||
:components ((:file "client-configuration")
|
||||
(:file "program-events")))
|
||||
(:file "program-events")
|
||||
(:file "json-rpc-communication")))
|
||||
(:file "main")
|
||||
(:module tests
|
||||
:components ((:file "package")
|
||||
|
|
|
|||
Loading…
Reference in New Issue