;; 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* (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"))))))