diff --git a/src/gui/server/json-rpc-communication.lisp b/src/gui/server/json-rpc-communication.lisp index ec5fcfb..ab2b115 100644 --- a/src/gui/server/json-rpc-communication.lisp +++ b/src/gui/server/json-rpc-communication.lisp @@ -103,7 +103,7 @@ (finish-output *server-stream*)) (defun close-server () - (send-to-server +command-delimiter+)) + (send-to-server (rpc:encode-to-string (rpc:make-request "quit-program" 1)))) (defun start-client () (with-output-to-string (stream) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index f3990b1..ae438e7 100644 --- a/src/gui/server/public-api.lisp +++ b/src/gui/server/public-api.lisp @@ -360,6 +360,12 @@ (defun clear-tour () (clear-tour-link *gemini-window*)) +(defun quit-program () + (fs:clean-temporary-directories) + (fs:clean-temporary-files) + (db-utils:close-db) + (os-utils:exit-program)) + (defmacro prepare-rpc (&body body) `(let ((rpc:*function-db* '())) (gen-rpc "add" @@ -401,5 +407,6 @@ (gen-rpc "tour-delete-link" 'tour-delete-link "url" 0) - (gen-rpc "clear-tour" 'clear-tour) + (gen-rpc "clear-tour" 'clear-tour) + (gen-rpc "quit-program" 'quit-program) ,@body)) diff --git a/src/json-rpc2.lisp b/src/json-rpc2.lisp index 3caf176..8bf3d44 100644 --- a/src/json-rpc2.lisp +++ b/src/json-rpc2.lisp @@ -122,6 +122,11 @@ (format stream "~a" (text condition)))) (:documentation "Error for all jsonrpc related problems")) +(defmacro make-json-rpc-error (code message) + `(progn + (assert (< -32000 code -32099)) + (error 'json-rpc-error :text ,message :code ,code))) + (defparameter *function-db* '()) (defun make-fun-params (name position) @@ -409,10 +414,11 @@ (misc:dbg m)) (defun elaborate-single-request (request) - (flet ((make-rpc-error (e) + (flet ((make-rpc-error (e id) (maybe-log-message (format nil "jsonrpc request failed: ~a" e)) (make-response nil - (transaction-id e) + (or (transaction-id e) + id) :error-object (make-response-error (or (code e) (response-error-code +error-invalid-request+)) (text e)))) @@ -433,18 +439,21 @@ (handler-case (let* ((request (apply #'make-request method id params)) (elaborated (call-function request))) - (maybe-log-message (format nil "jsonrpc request ~s results ~s" request elaborated)) + (maybe-log-message (format nil + "jsonrpc request ~s results ~s" + request + elaborated)) (when id ;; if id is null is a notification (i.e. the client ;; does not care about an answer) (make-response elaborated id :error-object nil))) (json-rpc-error (e) - (make-rpc-error e)) + (make-rpc-error e id)) (error (e) (maybe-log-message (format nil "jsonrpc request failed: ~a" e)) (make-failed-function-error e id nil)))) (json-rpc-error (e) - (make-rpc-error e)) + (make-rpc-error e nil)) (error (e) (maybe-log-message (format nil "jsonrpc request failed with internal error!: ~a" e)) (make-internal-error e))))) diff --git a/src/package.lisp b/src/package.lisp index 4712ede..4fac355 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3158,6 +3158,7 @@ :make-response :encode-to-string :json-rpc-error + :make-rpc-error :elaborate-request :transaction-id :code