diff --git a/src/gui/json-rpc-communication.lisp b/src/gui/json-rpc-communication.lisp index b2835d2..b08261c 100644 --- a/src/gui/json-rpc-communication.lisp +++ b/src/gui/json-rpc-communication.lisp @@ -1,3 +1,20 @@ +;; 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) @@ -16,11 +33,6 @@ (a:define-constant +command-delimiter+ 0 :test #'=) -(defmacro prepare-rpc (&body body) - `(let ((rpc:*function-db* '())) - (rpc:register-function "add" '+ (list (cons "a" 0) (cons "b" 1))) - ,@body)) - (defun read-json (stream) (to-s (read-delimited-into-array-unbuffered stream :delimiter +command-delimiter+))) @@ -106,7 +118,7 @@ (os-utils:process-input process)))) (setf *server-stream* process-stream *server-process* process) - (let ((request (rpc:jsonify (rpc:make-request "add" 1 10 20)))) + (let ((request (rpc:jsonify (rpc:make-request "complete-net-address" 1 "foo")))) (format t "sending ~a~%" request) (send-to-server request) (format t "returned ~s~%" (read-from-server)) diff --git a/src/json-rpc2.lisp b/src/json-rpc2.lisp index 1dc3302..1745dcf 100644 --- a/src/json-rpc2.lisp +++ b/src/json-rpc2.lisp @@ -1,5 +1,5 @@ -;; fulci: a program to organize your movies collection -;; Copyright (C) 2019 cage +;; 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 @@ -12,7 +12,8 @@ ;; 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 . +;; along with this program. +;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. (in-package :json-rpc2) @@ -71,11 +72,12 @@ (define-error-code invalid-params -32602 "Invalid params") -(define-error-code internal-error -32603 "Internal error") - (define-error-code unsupported-protocol -32098 "Only protocol version 2.0 is supported" :customp t) +(defun make-internal-error-message (msg) + (make-response-error -32603 (format nil "Internal error: ~a" msg))) + (defclass function-param () ((name :initarg :name @@ -171,7 +173,7 @@ (cond ((not (symbolp fun-symbol)) (error 'json-rpc-error - :text (format nil "function symbol of a function be a symbol not ~a" + :text (format nil "function symbol of a function must be a symbol not ~a" fun-symbol))) ((not (find-function fun-symbol)) (error 'json-rpc-error @@ -404,8 +406,10 @@ (make-response-error (or (code e) (response-error-code +error-invalid-request+)) (text e)))) - (error () - (make-response nil nil :error-object +error-internal-error+)))) + (error (e) + (make-response nil + nil + :error-object (make-internal-error-message (format nil "~a" e)))))) (defun likely-not-batch-p (request) (and (every (lambda (a) (and (consp a) diff --git a/src/main.lisp b/src/main.lisp index cf22146..44a7528 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -110,8 +110,9 @@ etc.) happened" (defun reset-timeline-pagination () (ui:reset-timeline-pagination)) -(defun load-configuration-files () - (when (not command-line:*script-file*) +(defun load-configuration-files (&key (verbose t)) + (when (and verbose + (not command-line:*script-file*)) (format t (_ "Loading configuration file ~a~%") swconf:+shared-conf-filename+)) @@ -132,11 +133,24 @@ etc.) happened" (invoke-restart 'res:create-empty-in-home)))) (swconf:load-config-file swconf:+conf-filename+))) -(defun shared-init () +(defun shared-init (&key (verbose t)) (num:lcg-set-seed) - (load-configuration-files) + (load-configuration-files :verbose verbose) (init-db)) +(defun rpc-server-init () + "Initialize the program" + (shared-init :verbose nil) + (db-utils:with-ready-database (:connect nil) + (when command-line:*module-file* + (handler-case + (modules:load-module command-line:*module-file*) + (error () + (ui:notify (format nil + (_ "Unable to load module ~a") + command-line:*module-file*) + :as-error t)))))) + (defun tui-init () "Initialize the program" (shared-init) @@ -230,7 +244,9 @@ etc.) happened" (command-line:manage-opts) (cond (command-line:*rpc-server-mode* - (json-rpc-communication:start-server)) + (db-utils:with-ready-database (:connect nil) + (rpc-server-init) + (json-rpc-communication:start-server))) (command-line:*rpc-client-mode* (json-rpc-communication:start-client)) (command-line:*print-lisp-dependencies* @@ -239,8 +255,8 @@ etc.) happened" (load-script-file)) (t (let ((croatoan::*debugger-hook* #'(lambda (c h) - (declare (ignore h)) - (c:end-screen) - (print c)))) + (declare (ignore h)) + (c:end-screen) + (print c)))) (tui-init) (run first-time-starting)))))) diff --git a/src/tests/jsonrpc2-tests.lisp b/src/tests/jsonrpc2-tests.lisp index d9d97e4..9aaf6b8 100644 --- a/src/tests/jsonrpc2-tests.lisp +++ b/src/tests/jsonrpc2-tests.lisp @@ -27,13 +27,13 @@ (register-function "subtract" '- (list (cons "subtrahend" 1) (cons "minuend" 0))) (register-function "update" 'dummy-update (list (cons "values0" 0) - (cons "values1" 1) - (cons "values2" 2) - (cons "values3" 3) - (cons "values4" 4))) + (cons "values1" 1) + (cons "values2" 2) + (cons "values3" 3) + (cons "values4" 4))) (register-function "notify_sum" '+ (list (cons "values0" 0) - (cons "values1" 1) - (cons "values2" 2))) + (cons "values1" 1) + (cons "values2" 2))) (register-function "notify_hello" '+ (list (cons "values0" 0))) ,@body)) diff --git a/tinmop.asd b/tinmop.asd index f8d1908..fa02592 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -147,24 +147,25 @@ (:file "modules") (:file "json-rpc2") (:module gui - :components ((:file "json-rpc-communication"))) + :components ((:file "public-api") + (:file "json-rpc-communication"))) (:file "main") (:module tests - :components ((:file "package") - (:file "all-tests") - (:file "misc-tests") - (:file "box-tests") - (:file "uri-tests") - (:file "iri-tests") - (:file "numeric-tests") - (:file "text-utils-tests") - (:file "mtree-tests") - (:file "thread-window-tests") - (:file "gemini-parser-tests") - (:file "program-events-tests") - (:file "x509-tests") - (:file "idn-tests") - (:file "jsonrpc2-tests"))))) + :components ((:file "package") + (:file "all-tests") + (:file "misc-tests") + (:file "box-tests") + (:file "uri-tests") + (:file "iri-tests") + (:file "numeric-tests") + (:file "text-utils-tests") + (:file "mtree-tests") + (:file "thread-window-tests") + (:file "gemini-parser-tests") + (:file "program-events-tests") + (:file "x509-tests") + (:file "idn-tests") + (:file "jsonrpc2-tests"))))) ;;(push :debug-mode *features*) ;;(push :debug-gemini-request *features*)