branch: externals/crdt
commit a4a07fb3aa935e7771d560adac0c5ae0fd58eebd
Author: Qiantan Hong <qh...@mit.edu>
Commit: Qiantan Hong <qh...@mit.edu>
Improve error handling
- add error recovery to protocol
- server side error handling (by sending the client an error message)
- fix a stupid typo for the crdt--buffer-sync-callback to relocate cursor
---
HACKING.org | 12 +++++++-
crdt.el | 95 +++++++++++++++++++++++++++++++++++++------------------------
2 files changed, 69 insertions(+), 38 deletions(-)
diff --git a/HACKING.org b/HACKING.org
index eab1b13..e066ddb 100644
--- a/HACKING.org
+++ b/HACKING.org
@@ -69,7 +69,7 @@ and second last two bytes represent site ID.
- Initial Synchronization
+ sync ::
This message is sent from server to client to get it sync to the state
on the server.
- Might be used for error recovery or other optimization in the future.
+ Might be used for other optimization in the future.
One optimization I have in mind is let server try to merge all CRDT item
into a single
one and try to synchronize this state to clients at best effort.
body takes the form =(buffer-name . crdt-id-list)=
@@ -83,6 +83,16 @@ and second last two bytes represent site ID.
The client should now try to enable =major-mode-symbol= in the
synchronized buffer.
+ - Error Recovery
+ Note: when a client side error happens, it just sends a =get= message and
+ follow initial synchronization procedure to reinitialize the buffer.
+
+ + error ::
+ body takes the form =(buffer-name error-symbol . error-datum)=.
+ This message is sent from server to client to notice that some messages
from the
+ client is not processed due to error =(error-symbol . error-datum)=.
+ Normally client should follow initial synchronization procedure to
reinitialize the buffer.
+
- Buffer Service
+ add ::
Indicates that the server has started sharing some buffers.
diff --git a/crdt.el b/crdt.el
index 42d09e7..d4da1f9 100644
--- a/crdt.el
+++ b/crdt.el
@@ -344,6 +344,9 @@ Each element is of the form (CURSOR-OVERLAY .
REGION-OVERLAY).")
(defvar crdt--session-menu-buffer nil)
+(defvar crdt--process nil
+ "Temporarily bound to the current network process when processing messages
inside CRDT--NETWORK-FILTER.")
+
;;; crdt-mode
(defvar crdt--hooks-alist
@@ -465,9 +468,7 @@ If such buffer doesn't exist yet, do nothing."
(widen)
(condition-case err
,(cons 'progn body)
- (error (if (crdt--server-p)
- (signal (car err) (cdr err)) ; didn't implement server
side recovery yet
- (crdt--client-recover)))))))))
+ (error (crdt--recover err))))))))
(defmacro crdt--with-buffer-name-pull (name &rest body)
"Find CRDT shared buffer associated with NAME and evaluate BODY in it.
@@ -1138,14 +1139,25 @@ Verify that CRDT IDs in a document follows ascending
order."
;;; Recovery
-(defun crdt--client-recover ()
- "Try to recover from a synchronization failure from a client.
+(defun crdt--recover (&optional err)
+ "Try to recover from a synchronization failure.
Current buffer is assmuned to be the one with synchronization error."
- (ding)
- (read-only-mode)
- (message "Synchronization error detected, try recovering...")
- (crdt--broadcast-maybe
- (crdt--format-message `(get ,crdt--buffer-network-name))))
+ (if (crdt--server-p)
+ (progn
+ (let ((message (crdt--format-message `(error
,crdt--buffer-network-name ,@err))))
+ (condition-case nil
+ (read-from-string message)
+ (invalid-read-syntax
+ ;; (cdr err) must be unprintable, omit it for now
+ ;; maybe handle some objects in the future
+ ;; (e.g. represent buffer object with its name)
+ (setq message (crdt--format-message `(error
,crdt--buffer-network-name ,(car err))))))
+ (process-send-string crdt--process message)))
+ (ding)
+ (read-only-mode)
+ (message "Synchronization error detected, try recovering...")
+ (crdt--broadcast-maybe
+ (crdt--format-message `(get ,crdt--buffer-network-name)))))
;;; Network protocol
@@ -1302,7 +1314,8 @@ The network process for the client connection is PROCESS."
(cl-defmethod crdt-process-message (message process)
(message "Unrecognized message %S from %s:%s."
- message (process-contact process :host) (process-contact process
:service)))
+ message (process-contact process :host) (process-contact process
:service))
+ (signal 'crdt-unrecognized-message nil))
(cl-defmethod crdt-process-message ((message (head insert)) process)
(cl-destructuring-bind (buffer-name crdt-id position-hint content) (cdr
message)
@@ -1349,7 +1362,7 @@ The network process for the client connection is PROCESS."
(lambda ()
(goto-char
(max (min pos (point-max))
- (point-max)))))))
+ (point-min)))))))
(erase-buffer)
(crdt--load-ids ids))))
(crdt--refresh-buffers-maybe)))
@@ -1367,6 +1380,13 @@ The network process for the client connection is
PROCESS."
(funcall crdt--buffer-sync-callback)
(setq crdt--buffer-sync-callback nil))))))
+(cl-defmethod crdt-process-message ((message (head error)) _process)
+ (unless (crdt--server-p)
+ (cl-destructuring-bind (buffer-name &rest err) (cdr message)
+ (crdt--with-buffer-name buffer-name
+ (message "Server side error %s." err)
+ (crdt--recover)))))
+
(cl-defmethod crdt-process-message ((message (head add)) _process)
(dolist (buffer-name (cdr message))
(unless (gethash buffer-name (crdt--session-buffer-table crdt--session))
@@ -1439,6 +1459,8 @@ The network process for the client connection is PROCESS."
(crdt--refresh-users-maybe))
(crdt--broadcast-maybe (crdt--format-message message) (process-get process
'client-id)))
+(define-error 'crdt-unrecognized-message "Unhandled
crdt-unrecognized-message.")
+
(defun crdt--network-filter (process string)
"Network filter function for CRDT network processes.
Handle received STRING from PROCESS."
@@ -1459,31 +1481,30 @@ Handle received STRING from PROCESS."
(while (setq message (ignore-errors (read (current-buffer))))
(when crdt--log-network-traffic
(print message))
- (cl-macrolet ((body ()
- '(if (or (not (crdt--server-p)) (process-get process
'authenticated))
- (let ((crdt--inhibit-update t))
- (crdt-process-message message process))
- (cl-block nil
- (when (eq (car message) 'hello)
- (cl-destructuring-bind (name &optional
response) (cdr message)
- (when (or (not (process-get process
'password)) ; server password is empty
- (and response (string-equal
response (process-get process 'challenge))))
- (process-put process 'authenticated t)
- (process-put process 'client-name name)
- (crdt--greet-client process)
- (cl-return))))
- (let ((challenge (crdt--generate-challenge)))
- (process-put process 'challenge
- (gnutls-hash-mac 'SHA1 (substring
(process-get process 'password)) challenge))
- (process-send-string process
(crdt--format-message `(challenge ,challenge))))))))
- (if debug-on-error (body)
- (condition-case err (body)
- (error (message "%s error when processing message from %s:%s,
disconnecting." err
- (process-contact process :host)
(process-contact process :service))
- (if (crdt--server-p)
- (progn
- (delete-process process))
- (crdt--stop-session crdt--session))))))
+ (condition-case err
+ (if (or (not (crdt--server-p)) (process-get process
'authenticated))
+ (let ((crdt--inhibit-update t)
+ (crdt--process process))
+ (crdt-process-message message process))
+ (cl-block nil
+ (when (eq (car message) 'hello)
+ (cl-destructuring-bind (name &optional response) (cdr
message)
+ (when (or (not (process-get process 'password)) ; server
password is empty
+ (and response (string-equal response
(process-get process 'challenge))))
+ (process-put process 'authenticated t)
+ (process-put process 'client-name name)
+ (crdt--greet-client process)
+ (cl-return))))
+ (let ((challenge (crdt--generate-challenge)))
+ (process-put process 'challenge
+ (gnutls-hash-mac 'SHA1 (substring
(process-get process 'password)) challenge))
+ (process-send-string process (crdt--format-message
`(challenge ,challenge))))))
+ (error
+ (message "%s error when processing message from %s:%s,
disconnecting." err
+ (process-contact process :host) (process-contact process
:service))
+ (if (crdt--server-p)
+ (delete-process process)
+ (crdt--stop-session crdt--session))))
(delete-region (point-min) (point))
(goto-char (point-min)))))))
