mirror of https://codeberg.org/cage/tinmop/
186 lines
8.4 KiB
Common Lisp
186 lines
8.4 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 *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*))
|
|
|
|
(defparameter *request-lock* (bt:make-lock))
|
|
|
|
(defgeneric make-request (method id &rest args))
|
|
|
|
(defmethod make-request ((method symbol) id &rest args)
|
|
(misc:with-lock (*request-lock*)
|
|
(apply #'make-request (string-downcase (symbol-name method)) id args)))
|
|
|
|
(define-condition rpc-error-response (conditions:text-error)
|
|
((data
|
|
:initform nil
|
|
:initarg :data
|
|
:reader data)
|
|
(code
|
|
:initform nil
|
|
:initarg :code
|
|
:reader code)
|
|
(id
|
|
:initform nil
|
|
:initarg :id
|
|
:reader id))
|
|
(:report (lambda (condition stream)
|
|
(format stream
|
|
"id: ~a (~a) ~a data ~a"
|
|
(id condition)
|
|
(code condition)
|
|
(conditions:text condition)
|
|
(data condition))))
|
|
(:documentation "Error failed rpc request"))
|
|
|
|
(defmethod make-request ((method string) id &rest args)
|
|
(let ((request (rpc:encode-to-string (apply #'rpc:make-request method id args))))
|
|
(send-to-server request)
|
|
(let ((raw-response (read-from-server)))
|
|
(if (rpc:error-response-p raw-response)
|
|
(multiple-value-bind (id message code data)
|
|
(rpc:extract-error raw-response)
|
|
(error 'rpc-error-response
|
|
:id id
|
|
:code code
|
|
:data data
|
|
:text message))
|
|
(values (rpc:extract-results raw-response)
|
|
raw-response)))))
|
|
|
|
(defun close-server ()
|
|
(make-request :quit-program 1))
|
|
|
|
(defun start-client ()
|
|
(with-output-to-string (stream)
|
|
(let ((process (os-utils:run-external-program +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))
|
|
(error (_ "Unable to create server process"))))))
|
|
|
|
(defun start-client* ()
|
|
(with-output-to-string (stream)
|
|
(let* ((test-iri "gemini://omg.pebcak.club/")
|
|
(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 ((status-request (make-request "gemini-stream-completed-p" 1 test-iri)))
|
|
(format t "returned ~s~%" status-request))
|
|
(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"))))))
|