Function: jsonrpc-connection-receive
jsonrpc-connection-receive is a byte-compiled function defined in
jsonrpc.el.gz.
Signature
(jsonrpc-connection-receive CONN FOREIGN-MESSAGE)
Documentation
Process FOREIGN-MESSAGE just received from CONN.
This function will destructure MESSAGE and call the appropriate dispatcher in CONN.
Source Code
;; Defined in /usr/src/emacs/lisp/jsonrpc.el.gz
(defun jsonrpc-connection-receive (conn foreign-message)
"Process FOREIGN-MESSAGE just received from CONN.
This function will destructure MESSAGE and call the appropriate
dispatcher in CONN."
(cl-destructuring-bind (&rest whole &key method id error params result _jsonrpc)
(jsonrpc-convert-from-endpoint conn foreign-message)
(unwind-protect
(let* ((log-plist (list :json (plist-get foreign-message :jsonrpc-json)
:kind (cond ((and method id) 'request)
(method 'notification)
(id 'reply))
:message whole
:foreign-message foreign-message))
(response-p (and (null method) id))
(cont (and response-p (jsonrpc--remove conn id))))
(cl-remf foreign-message :jsonrpc-json)
;; Do this pre-processing of the response so we can always
;; log richer information _before_ any non-local calls
;; further ahead. Putting the `jsonrpc--event' as
;; an unwind-form would make us log after the fact.
(when cont
(pcase-let ((`(,_ ,method ,_ ,_ ,_) cont))
(if (keywordp method)
(setq method (substring (symbol-name method) 1)))
;; TODO: also set the depth
(setq whole (plist-put whole :method method))))
;; Do the logging
(apply #'jsonrpc--event conn 'server log-plist)
(with-slots (last-error
(rdispatcher -request-dispatcher)
(ndispatcher -notification-dispatcher)
(scontrol -scontrol))
conn
(setf last-error error)
(cond
(;; A remote response whose request has been canceled
;; (i.e. timeout or C-g)
;;
(and response-p (null cont))
(jsonrpc--event
conn 'internal
:log-text
(format "Response to request %s which has been canceled"
id)
:id id)
;; TODO: food for thought: this seems to be also where
;; notifying the server of the cancellation would come
;; in.
)
(;; A remote response that can't run yet (bug#67945)
(and response-p
(and scontrol (not (equal `(:local ,id) (caar scontrol)))))
(jsonrpc--event
conn 'internal
:log-text
(format "anxious continuation to %s can't run, held up by %s"
id
(mapcar #'car scontrol)))
(push (cons cont (list result error))
(cdr (car scontrol))))
(;; A remote response that can continue now
response-p
(jsonrpc--continue conn `(:local ,id) cont result error))
(;; A remote request
(and method id)
(let* ((debug-on-error (and debug-on-error
(not jsonrpc-inhibit-debug-on-error)))
reply)
;; While the rdispatcher runs, any arriving response to
;; a previous sync request must not fire its
;; continuation immediately: the resulting `throw' would
;; unwind through the dispatcher and trigger a spurious
;; -32603 instead of a reply. Use `jsonrpc--scontrol'
;; mechanism to defer such continuations until the end
;; of the cleanup below.
(push `((:remote ,id)) (jsonrpc--scontrol conn))
(unwind-protect
(setq
reply
(condition-case oops
`(:result
,(funcall rdispatcher conn (intern method) params))
(jsonrpc-error
(let* ((data (cdr oops))
(code (alist-get 'jsonrpc-error-code data))
(msg (alist-get 'jsonrpc-error-message
(cdr oops))))
(if (eq code 32000) ;; This means 'no error'
(when-let* ((d (alist-get 'jsonrpc-error-data
data)))
`(:result ,d))
`(:error
(:code ,(or code -32603)
:message ,(or msg "Internal error"))))))))
(unless reply
(setq reply
`(:error (:code -32603 :message "Internal error"))))
(apply #'jsonrpc--reply conn id method reply)
(jsonrpc--continue conn `(:remote ,id)))))
(;; A remote notification
method
(funcall ndispatcher conn (intern method) params))
(t
(jsonrpc--event conn 'internal
:log-text "Malformed message" )))))
(jsonrpc--call-deferred conn))))