diff --git a/src/gui/client/json-rpc-communication.lisp b/src/gui/client/json-rpc-communication.lisp new file mode 100644 index 0000000..36f55fe --- /dev/null +++ b/src/gui/client/json-rpc-communication.lisp @@ -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")))))) diff --git a/src/gui/client/program-events.lisp b/src/gui/client/program-events.lisp new file mode 100644 index 0000000..9a0dfd0 --- /dev/null +++ b/src/gui/client/program-events.lisp @@ -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)))))) diff --git a/src/gui/server/json-rpc-communication.lisp b/src/gui/server/json-rpc-communication.lisp index e4deb23..23e6f3a 100644 --- a/src/gui/server/json-rpc-communication.lisp +++ b/src/gui/server/json-rpc-communication.lisp @@ -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")))))) diff --git a/tinmop.asd b/tinmop.asd index cecb78b..bcbc2fc 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -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")