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.

View in manual

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)
                       (sr-alist -sync-request-alist))
              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 sr-alist (not (eq id (caar sr-alist)))))
              (jsonrpc--event
               conn 'internal
               :log-text
               (format "anxious continuation to %s can't run, held up by %s"
                       id
                       (mapcar #'car sr-alist)))
              (push (cons cont (list result error))
                    (cdr (car sr-alist))))
             (;; A remote response that can continue now
              response-p
              (jsonrpc--continue conn 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
                      (condition-case-unless-debug _ignore
                          (condition-case oops
                              `(:result ,(funcall rdispatcher conn (intern method)
                                                  params))
                            (jsonrpc-error
                             `(:error
                               (:code
                                ,(or (alist-get 'jsonrpc-error-code (cdr oops))
                                     -32603)
                                :message ,(or (alist-get 'jsonrpc-error-message
                                                         (cdr oops))
                                              "Internal error")))))
                        (error
                         '(:error (:code -32603 :message "Internal error"))))))
                (apply #'jsonrpc--reply conn id method reply)))
             (;; A remote notification
              method
              (funcall ndispatcher conn (intern method) params))
             (t
              (jsonrpc--event conn 'internal
                              :log-text "Malformed message" )))))
      (jsonrpc--call-deferred conn))))