├── .gitignore ├── Makefile ├── README.md ├── UNLICENSE ├── json-rpc-tests.el └── json-rpc.el /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | BATCH := $(EMACS) -batch -Q -L . 3 | 4 | PACKAGE := json-rpc 5 | 6 | EL = json-rpc.el 7 | ELC = $(EL:.el=.elc) 8 | 9 | .PHONY : all binary compile package test clean distclean 10 | 11 | all : test 12 | 13 | compile: $(ELC) 14 | 15 | test: compile $(TEST_ELC) 16 | $(BATCH) -l $(PACKAGE)-tests.el -f ert-run-tests-batch 17 | 18 | clean : 19 | $(RM) *.elc 20 | 21 | %.elc : %.el 22 | $(BATCH) -f batch-byte-compile $< 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Emacs Lisp JSON-RPC Library 2 | 3 | This is a [JSON-RPC](http://json-rpc.org/) 1.0 and 2.0 library for 4 | Emacs Lisp. It uses the HTTP transport method. 5 | 6 | Three functions are provided: `json-rpc-connect`, `json-rpc-close`, 7 | and `json-rpc`. 8 | 9 | ## Usage 10 | 11 | ```el 12 | ;; Establish a connection to bitcoind: 13 | (setf bitcoind (json-rpc-connect "localhost" 8332 "bitcoinrpc" "mypassword")) 14 | 15 | (json-rpc bitcoind "getblockcount") 16 | ;; => 285031 17 | 18 | (json-rpc bitcoind "setgenerate" t 3) 19 | ;; => nil 20 | 21 | (json-rpc bitcoind "bogusmethod") 22 | ;; signals (json-rpc-error :message "Method not found" :code -32601) 23 | ``` 24 | 25 | The `json-rpc-1.0` and `json-rpc-2.0` functions allow for finer 26 | control over requests, such as endpoint selection and named parameters 27 | (JSON-RPC 2.0). 28 | -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /json-rpc-tests.el: -------------------------------------------------------------------------------- 1 | ;;; json-rpc-tests.el --- tests for json-rpc.el 2 | 3 | ;;; Commentary: 4 | 5 | ;; Runs tests against the bitcoind JSON-RPC daemon, since that's 6 | ;; ultimately the reason I wrote this library. 7 | 8 | ;;; Code: 9 | 10 | (require 'ert) 11 | (require 'json-rpc) 12 | 13 | (defvar json-rpc-password "password" 14 | "Password for accessing the bitcoind daemon JSON-API for testing.") 15 | 16 | (when (condition-case nil 17 | (prog1 t 18 | (delete-process (make-network-process :name "test-port" 19 | :host 'local 20 | :service 8332 21 | :noquery t 22 | :buffer nil 23 | :stop t))) 24 | (file-error nil)) 25 | (ert-deftest json-rpc-bitcoind () 26 | (json-rpc-with-connection 27 | (bitcoind "localhost" 8332 "bitcoinrpc" json-rpc-password) 28 | (should (> (json-rpc bitcoind "getblockcount") 285030)) 29 | (should (>= (json-rpc bitcoind "getbalance") 0.0)) 30 | (should-error (json-rpc "bogusmethod" 1 2 3))))) 31 | 32 | (ert-deftest json-rpc-incomplete-response () 33 | (insert "HTTP/1.1 200 OK\r\n" 34 | "Content-Length: 10\r\n") 35 | (should-not (json-rpc--content-finished-p))) 36 | 37 | (ert-deftest json-rpc-wait () 38 | (cl-letf (((symbol-function 'json-rpc-live-p) 39 | (lambda (&rest _args) t)) 40 | ((symbol-function 'process-buffer) 41 | (lambda (&rest _args) (current-buffer)))) 42 | (let ((json-rpc-poll-max-seconds 1) 43 | (json-rpc-poll-seconds 0.2)) 44 | (should-error (json-rpc-wait (json-rpc--create :process nil)) 45 | :type 'json-rpc-error)))) 46 | 47 | (provide 'json-rpc-tests) 48 | 49 | ;;; json-rpc-tests.el ends here 50 | -------------------------------------------------------------------------------- /json-rpc.el: -------------------------------------------------------------------------------- 1 | ;;; json-rpc.el --- JSON-RPC library -*- lexical-binding: t; -*- 2 | 3 | ;; This is free and unencumbered software released into the public domain. 4 | 5 | ;; Author: Christopher Wellons 6 | ;; URL: https://github.com/skeeto/elisp-json-rpc 7 | ;; Version: 0.0.1 8 | ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) 9 | 10 | ;;; Commentary: 11 | 12 | ;; The two important functions are `json-rpc-connect' and `json-rpc'. 13 | ;; The first one returns a connection object and the second one makes 14 | ;; synchronous requests on the connection, returning the result or 15 | ;; signaling an error. 16 | 17 | ;; Here's an example using the bitcoind JSON-RPC API: 18 | 19 | ;; (setf rpc (json-rpc-connect "localhost" 8332 "bitcoinrpc" "mypassword")) 20 | ;; (json-rpc rpc "getblockcount") ; => 285031 21 | ;; (json-rpc rpc "setgenerate" t 3) 22 | 23 | ;; TODO: 24 | ;; * asynchronous requests 25 | ;; * response timeout 26 | ;; * detect auth rejection 27 | 28 | ;;; Code: 29 | 30 | (require 'url) 31 | (require 'json) 32 | (require 'cl-lib) 33 | 34 | (defcustom json-rpc-poll-seconds 0.5 35 | "Seconds ()integer or float) to between `accept-process-output' polls." 36 | :type 'number 37 | :group 'json-rpc) 38 | 39 | (defcustom json-rpc-poll-max-seconds 60 40 | "Number of seconds as integer to wait for `json-rpc-wait'." 41 | :type 'number 42 | :group 'json-rpc) 43 | 44 | (cl-defstruct (json-rpc (:constructor json-rpc--create)) 45 | "A connection to a remote JSON-RPC server." 46 | process host port auth id-counter) 47 | 48 | ;; Set up error condition. 49 | (setf (get 'json-rpc-error 'error-conditions) '(json-rpc-error error) 50 | (get 'json-rpc-error 'error-message) "JSON-RPC error condition") 51 | 52 | (defun json-rpc-connect (host port &optional username password) 53 | "Create a JSON-RPC HTTP connection to HOST:PORT." 54 | (let ((auth (when (and username password) 55 | (base64-encode-string (format "%s:%s" username password) t))) 56 | (port-num (if (stringp port) (read port) port))) 57 | (json-rpc-ensure 58 | (json-rpc--create :host host :port port-num :auth auth :id-counter 0)))) 59 | 60 | (defun json-rpc-close (connection) 61 | "Close TCP connection in CONNECTION." 62 | (let ((process (json-rpc-process connection))) 63 | (when (and process (process-live-p process)) 64 | (process-send-eof process)))) 65 | 66 | (defun json-rpc-ensure (connection) 67 | "Re-establish connection to CONNECTION if needed, returning CONNECTION." 68 | (let ((old-process (json-rpc-process connection))) 69 | (if (and old-process (process-live-p old-process)) 70 | connection 71 | (let* ((buffer (generate-new-buffer " *json-rpc*")) 72 | (host (json-rpc-host connection)) 73 | (process (make-network-process :name (format "json-rpc-%s" host) 74 | :buffer buffer 75 | :host host 76 | :service (json-rpc-port connection) 77 | :coding '(utf-8 . utf-8)))) 78 | (setf (process-sentinel process) 79 | (lambda (proc _) 80 | (run-at-time 0 nil #'kill-buffer (process-buffer proc)))) 81 | (prog1 connection 82 | (setf (json-rpc-process connection) process)))))) 83 | 84 | (defun json-rpc-live-p (connection) 85 | "Return non-nil if CONNECTION is still connected." 86 | (process-live-p (json-rpc-process connection))) 87 | 88 | (defun json-rpc--request (connection version endpoint method params) 89 | (let* ((id (cl-incf (json-rpc-id-counter connection))) 90 | (request `(:method ,method :params ,params :id ,id)) 91 | (auth (json-rpc-auth connection)) 92 | (process (json-rpc-process (json-rpc-ensure connection))) 93 | (encoded (if version 94 | (json-encode (nconc (list :jsonrpc version) request)) 95 | (json-encode request)))) 96 | (with-current-buffer (process-buffer (json-rpc-process connection)) 97 | (erase-buffer)) 98 | (with-temp-buffer 99 | (insert (format "POST %s HTTP/1.1\r\n" (url-encode-url endpoint))) 100 | (when auth (insert "Authorization: Basic " auth "\r\n")) 101 | (insert "Content-Type: application/json\r\n") 102 | (insert (format "Content-Length: %d\r\n\r\n" (string-bytes encoded)) 103 | encoded) 104 | (process-send-region process (point-min) (point-max))) 105 | (json-rpc-wait connection))) 106 | 107 | (defun json-rpc-1.0 (connection endpoint method &rest params) 108 | "Via JSON-RPC 1.0, call METHOD with PARAMS to CONNECTION at ENDPOINT. 109 | Returns the result or signals the error." 110 | (json-rpc--request connection nil endpoint method (vconcat params))) 111 | 112 | (defun json-rpc-2.0 (connection endpoint method &optional params) 113 | "Via JSON-RPC 2.0, call METHOD with PARAMS to CONNECTION at ENDPOINT. 114 | Returns the result or signals the error. PARAMS is passed 115 | directly to `json-encode' and will be interpreted by the server 116 | as either a JSON array of positional arguments or a JSON object 117 | of named arguments." 118 | (unless (or (vectorp params) 119 | (listp params)) 120 | (signal 'wrong-type-argument params)) 121 | (json-rpc--request connection "2.0" endpoint method (or params []))) 122 | 123 | (defun json-rpc (connection method &rest params) 124 | "Via JSON-RPC 2.0, call METHOD with PARAMS to CONNECTION at endpoint /. 125 | Returns the result or signals the error." 126 | (json-rpc--request connection "2.0" "/" method (vconcat params))) 127 | 128 | (defun json-rpc--move-to-content () 129 | "Move the point to after the headers." 130 | (setf (point) (point-min)) 131 | (search-forward-regexp "\r?\n\r?\n" nil t)) 132 | 133 | (defun json-rpc--content-finished-p () 134 | "Return non-nil if all of the content has arrived." 135 | (setf (point) (point-min)) 136 | (when (search-forward "Content-Length: " nil t) 137 | (let ((length (read (current-buffer)))) 138 | (and (json-rpc--move-to-content) 139 | (<= length (- (position-bytes (point-max)) 140 | (position-bytes (point)))))))) 141 | 142 | (defun json-rpc-wait (connection) 143 | "Wait for the response from CONNECTION and return it, or signal the error." 144 | (with-current-buffer (process-buffer (json-rpc-process connection)) 145 | (unless (cl-loop repeat (max 1 (truncate (/ json-rpc-poll-max-seconds 146 | json-rpc-poll-seconds))) 147 | until (or (json-rpc--content-finished-p) 148 | (not (json-rpc-live-p connection))) 149 | do (accept-process-output nil json-rpc-poll-seconds) 150 | finally return (or (json-rpc--content-finished-p) 151 | (not (json-rpc-live-p connection)))) 152 | (signal 'json-rpc-error "Timeout")) 153 | (json-rpc--move-to-content) 154 | (let* ((json-object-type 'plist) 155 | (json-key-type 'keyword) 156 | (result (json-read))) 157 | (if (plist-get result :error) 158 | (signal 'json-rpc-error (plist-get result :error)) 159 | (plist-get result :result))))) 160 | 161 | (defmacro json-rpc-with-connection (var-and-spec &rest body) 162 | "Open a temporary RPC connection, evaluate BODY, and close the connection. 163 | The connection will close even if evaluation results in an error. 164 | 165 | (json-rpc-with-connection (btc \"localhost\" 8332 \"bitcoinrpc\" \"pw\") 166 | (message \"bitcoind status: %d blocks, %f BTC\" 167 | (json-rpc btc \"getblockcount\") 168 | (json-rpc btc \"getbalance\")))" 169 | (declare (indent 1)) 170 | (cl-destructuring-bind (var . spec) var-and-spec 171 | `(let ((,var (json-rpc-connect ,@spec))) 172 | (unwind-protect 173 | (progn ,@body) 174 | (json-rpc-close ,var))))) 175 | 176 | (provide 'json-rpc) 177 | 178 | ;;; json-rpc.el ends here 179 | --------------------------------------------------------------------------------