mirror of https://codeberg.org/cage/tinmop/
178 lines
7.6 KiB
Common Lisp
178 lines
7.6 KiB
Common Lisp
;; tinmop: an humble gemini and pleroma client
|
|
;; Copyright (C) 2022 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-process* nil)
|
|
|
|
(defparameter *server-stream* 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 quit-server ()
|
|
(os-utils:exit-program))
|
|
|
|
(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!")
|
|
(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 +command-delimiter+))
|
|
|
|
(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))))
|
|
(loop repeat 2 do
|
|
(let ((request (rpc:encode-to-string (rpc:make-request "gemini-request"
|
|
1
|
|
(strcat test-iri "/~cage/")
|
|
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)))
|
|
(close-server))
|
|
(error (_ "Unable to create server process"))))))
|