mirror of https://codeberg.org/cage/tinmop/
178 lines
8.9 KiB
Common Lisp
178 lines
8.9 KiB
Common Lisp
;; 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))))
|
|
|
|
(defgeneric make-request (method id &rest args))
|
|
|
|
(defmethod make-request ((method symbol) id &rest args)
|
|
(apply #'make-request (string-downcase (symbol-name method)) id args))
|
|
|
|
(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)))
|
|
(values (rpc:extract-results raw-response)
|
|
raw-response))))
|
|
|
|
(defun slurp-gemini-stream (iri &key
|
|
(use-cache t)
|
|
(process-function #'identity)
|
|
(aborting-function (constantly nil)))
|
|
(make-request :gemini-request 1 iri use-cache)
|
|
(flet ((stream-exausted-p ()
|
|
(let ((status-completed (make-request :gemini-stream-completed-p 1 iri)))
|
|
status-completed)))
|
|
(loop with last-lines-fetched-count = 0
|
|
while (not (or (funcall aborting-function)
|
|
(stream-exausted-p)))
|
|
do
|
|
(a:when-let* ((last-lines-fetched (make-request :gemini-stream-parsed-line-slice
|
|
1
|
|
iri
|
|
last-lines-fetched-count
|
|
nil))
|
|
(next-start-fetching (length last-lines-fetched)))
|
|
(incf last-lines-fetched-count next-start-fetching)
|
|
(funcall process-function last-lines-fetched)))))
|
|
|
|
(defun start-client ()
|
|
(with-output-to-string (stream)
|
|
(let* ((test-iri "gemini://omg.pebcak.club/")
|
|
(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)
|
|
(slurp-gemini-stream test-iri
|
|
:process-function (lambda (lines) (format t "lines ~s~%" lines)))
|
|
(close-server))
|
|
(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"))))))
|