[elpa] externals/crdt 3883736730 17/44: many changes

[ELPA Syncer]

branch: externals/crdt
commit 388373673060130b36f2dd47767073d4766969eb
Author: Qiantan Hong <qhong@mit.edu>
Commit: Qiantan Hong <qhong@mit.edu>

    many changes
---
 HACKING.org |  66 ++++-----
 crdt.el     | 437 ++++++++++++++++++++++++++++++++++--------------------------
 2 files changed, 279 insertions(+), 224 deletions(-)

diff --git a/HACKING.org b/HACKING.org
index 4f19ff9ed0..3bd19c85a3 100644
--- a/HACKING.org
+++ b/HACKING.org
@@ -18,19 +18,6 @@ For base IDs, last two bytes are always representing Site ID.
 Stored strings are BASE-ID:OFFSETs. So the last two bytes represent offset,
 and second last two bytes represent Site ID.
 
-* Access Control
-  
-~crdt.el~ implements a capability based access control system.
-
-Each capability is a list of the form =(type transferable-p nonce . body)=
-
-  - read :: body takes the form =(buffer-name)=
-  - write :: body takes the form =(buffer-name)=
-  - command :: body takes the form =(buffer-name command-symbol)=
-    + =buffer-name= can be =t=, which means that =command-symbol= is not 
-      bound to be invoked in any specific buffer.
-  - process :: body takes the form =(buffer-name)=
-
 * Protocol
 
 Text-based version
@@ -42,6 +29,8 @@ Site IDs are /buffer local/ and temporarily assigned to users 
with writable acce
 Every message takes the form =(type . body)=
 
   - Text Editing
+    A peer must obtain a =site-id= before performing the following operations,
+    by remote calling =crdt-get-write-access=. See [[Remote Command]].
     + insert ::
       body takes the form =(buffer-name user-id crdt-id position-hint content)=
       - =position-hint= is the buffer position where the operation happens at 
the site
@@ -50,7 +39,7 @@ Every message takes the form =(type . body)=
       - =content= is the string to be inserted
 
     + delete ::
-      body takes the form =(buffer-name position-hint . crdt-id-list)=
+      body takes the form =(buffer-name user-id position-hint . crdt-id-list)=
       - =crdt-id-list= is generated from =CRDT--DUMP-IDS= from the deleted text
 
   - Peer State
@@ -58,8 +47,8 @@ Every message takes the form =(type . body)=
       body takes the form
            =(buffer-name user-id point-position-hint point-crdt-id 
mark-position-hint mark-crdt-id)=
       =*-crdt-id= can be either a CRDT ID, or
-        - =nil=, which means clear the point/mark
-        - =""=, which means =(point-max)=
+      - =nil=, which means clear the point/mark
+      - =""=, which means =(point-max)=
 
     + contact ::
       body takes the form
@@ -113,6 +102,9 @@ Every message takes the form =(type . body)=
       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-name= can also be =nil=, which signifies that it's a session 
error.
+        The only reasonable thing to do is to disconnect in this scenario.
+        Currently, this happens when client/server protocol version doesn't 
match.
 
   - Buffer Service
     + add ::
@@ -151,26 +143,36 @@ Every message takes the form =(type . body)=
     + overlay-remove ::
       body takes the form =(buffer-name user-id logical-clock)=
 
-  - Remote Command
+  - <<Remote Command>>
+    + fcap ::
+      body takes the form =(buffer-name command-symbol nonce in-states 
out-states)=
+      This grants a "functional capability" to a peer.
+      Nonce is a random number to prevent forging capability.
+      - =buffer-name= can also be =nil=, which means this is a session-scoped 
command,
+        not bound to any specific buffer.
+      - =in-states= is a list of state symbols that the command depends on.
+        =out-states= is a list of state symbols that the command modifies and 
should be synchronized
+        to the caller.
+        See [[Allowed state symbols]].
+
     + command ::
       body takes the form
       #+BEGIN_SRC
-      (buffer-name spawn-user-id
-       user-id logical-clock state-list
-       command-symbol . args)
+      (buffer-name user-id logical-clock
+       spawn-user-id state-list nonce command-symbol . args)
       #+END_SRC
-       - =spawn-user-id= represents the site where the interactive command is 
originally invoked
-         + It can be different from =user-id= because a remote command can 
call a remote command!
-           This is especially useful when client makes a remote call, 
-           but the call on the server request some interactive input,
-           and such interactive call are remote-called back into the client.
-       - =state-list= is an alist of bindings.
-        (except that we use 1 element list for the CDRs, to save a dot in the 
serialized string)
-        (CDRs can also be 2 element list of the form =(crdt-id pos-hint)=)
-        Allowed symbols are 
-        #+BEGIN_SRC
-        buffer point mark mark-active transient-mark-mode last-command-event
-        #+END_SRC
+      - =spawn-user-id= represents the site where the interactive command is 
originally invoked
+        + It can be different from =user-id= because a remote command can call 
a remote command!
+          This is especially useful when client makes a remote call, 
+          but the call on the server request some interactive input,
+          and such interactive call are remote-called back into the client.
+      - =state-list= is an alist of bindings.
+       (except that we use 1 element list for the CDRs, to save a dot in the 
serialized string)
+       (CDRs can also be 2 element list of the form =(crdt-id pos-hint)=)
+       <<Allowed state symbols>> are 
+       #+BEGIN_SRC
+       buffer point mark mark-active transient-mark-mode last-command-event
+       #+END_SRC
 
     + return ::
       body takes the form =(user-id logical-clock state-list success-p . 
return-values)=
diff --git a/crdt.el b/crdt.el
index 556e035daf..a43bbde8a2 100644
--- a/crdt.el
+++ b/crdt.el
@@ -76,6 +76,13 @@
   "Start tuntox proxy for CRDT servers."
   :type '(choice boolean (const confirm)))
 
+(defcustom crdt-default-session-command-functions
+  '((crdt-get-write-access)
+    crdt-xref-command-function)
+  "A list that describes default policies for public session-scoped commands.
+See `crdt-new-session'.'"
+  :type '(list (or function (list function))))
+
 ;;; Pseudo cursor/region utils
 
 (defvar crdt-cursor-region-colors
@@ -290,7 +297,7 @@ Must be used inside CRDT--WITH-INSERTION-INFORMATION."
 (cl-defstruct (crdt--session (:constructor crdt--make-session))
   local-id                              ; Local user-id
   local-clock                           ; Local logical clock
-  contact-table ; A hash table that maps USER-ID to CRDT--CONTACT-METADATAs
+  (contact-table (make-hash-table)) ; A hash table that maps USER-ID to 
CRDT--CONTACT-METADATAs
   local-name
   name
   focused-buffer-name
@@ -298,10 +305,12 @@ Must be used inside CRDT--WITH-INSERTION-INFORMATION."
   buffer-menu-buffer
   network-process
   network-clients
-  next-client-id
-  buffer-table                    ; maps buffer network name to buffer
+  next-user-id
+  (buffer-table (make-hash-table :test 'equal)); maps buffer network name to 
buffer
   follow-user-id
-  user-command-functions)
+  command-functions
+  (fcap-in-table (make-hash-table :test 'eq))
+  (fcap-out-table (make-hash-table :test 'eq)))
 
 (defvar crdt--inhibit-update nil "When set, don't call CRDT--LOCAL-* on change.
 This is useful for functions that apply remote change to local buffer,
@@ -362,14 +371,20 @@ adding/removing actively tracked overlays.")
 (defvar-local crdt--enabled-text-properties nil
   "A list of text properties that are tracked and synchronized.")
 
-(defvar-local crdt-user-command-functions nil
+(defvar-local crdt-buffer-command-functions nil
   "A list that describes policies for public buffer-local commands.
 Each element should be one of
-- a symbol, which should name a command.
-  The command is be made accessible to every user.
 - a function, which should return a list of commands when
   called with a single argument USER-ID.
-  The returned list of commands is made accessible to the user with USER-ID.")
+  The returned list of commands is made accessible to the user with USER-ID.
+- a list of commands.
+  These commands are made accessible to every user.")
+
+(defvar-local crdt-buffer-fcap-in-table nil
+  "A hash table that maps local command symbol to a nonce.")
+
+(defvar-local crdt-buffer-fcap-out-table nil
+  "A hash table that maps remote command symbol to a function.")
 
 ;;; Global variables
 
@@ -378,8 +393,8 @@ Each element should be one of
 
 (defvar crdt--process nil
   "Temporarily bound to the current network process when processing messages 
inside CRDT--NETWORK-FILTER.")
-(defvar crdt--user-id nil
-  "Temporarily bound to the User ID who requests the current remote command 
call.")
+(defsubst crdt--client-id ()
+  (process-get crdt--process 'client-id))
 
 ;;; crdt-mode
 
@@ -433,10 +448,18 @@ Also set CRDT--PSEUDO-CURSOR-TABLE to NIL."
           (setq crdt--pseudo-cursor-table (make-hash-table)))
         (unless crdt--overlay-table
           (setq crdt--overlay-table (make-hash-table :test 'equal)))
+        (unless crdt-buffer-fcap-in-table
+          (setq crdt-buffer-fcap-in-table (make-hash-table)))
+        (unless crdt-buffer-fcap-out-table
+          (setq crdt-buffer-fcap-out-table (make-hash-table)))
+        (setq crdt--site-id-list (list 0 crdt--max-value))
         (crdt--install-hooks))
     (crdt--uninstall-hooks)
     (crdt--clear-pseudo-cursor-table)
-    (setq crdt--overlay-table nil)))
+    (setq crdt--overlay-table nil
+          crdt-buffer-fcap-in-table nil
+          crdt-buffer-fcap-out-table nil
+          crdt--site-id-list nil)))
 
 (defun crdt--clone-buffer-hook ()
   (crdt-mode -1))
@@ -528,6 +551,19 @@ If we are the server, ERR is the error we shall report to 
client."
 
 ;;; Shared buffer utils
 
+(defun crdt--call-with-buffer-name (name function)
+  "Find CRDT shared buffer associated with NAME and call FUNCTION in it.
+See `crdt--with-buffer-name'."
+  (let (crdt-buffer)
+    (setq crdt-buffer (gethash name (crdt--session-buffer-table 
crdt--session)))
+    (when (and crdt-buffer (buffer-live-p crdt-buffer))
+      (with-current-buffer crdt-buffer
+        (save-restriction
+          (widen)
+          (condition-case err
+              (funcall function)
+            (crdt-sync-error (crdt--recover err))))))))
+
 (defmacro crdt--with-buffer-name (name &rest body)
   "Find CRDT shared buffer associated with NAME and evaluate BODY in it.
 Any narrowing is temporarily disabled during evaluation of BODY.
@@ -535,15 +571,7 @@ Also, try to recover from synchronization error if any 
error happens in BODY.
 Must be called when CURRENT-BUFFER is a CRDT status buffer.
 If such buffer doesn't exist yet, do nothing."
   (declare (indent 1) (debug (sexp def-body)))
-  `(let (crdt-buffer)
-     (setq crdt-buffer (gethash ,name (crdt--session-buffer-table 
crdt--session)))
-     (when (and crdt-buffer (buffer-live-p crdt-buffer))
-       (with-current-buffer crdt-buffer
-         (save-restriction
-           (widen)
-           (condition-case err
-               ,(cons 'progn body)
-             (crdt-sync-error (crdt--recover err))))))))
+  `(crdt--call-with-buffer-name ,name (lambda () ,@body)))
 
 (defmacro crdt--with-buffer-name-pull (name &rest body)
   "Find CRDT shared buffer associated with NAME and evaluate BODY in it.
@@ -1112,7 +1140,7 @@ The deletion happens between BEG and END, and have 
LENGTH."
     (crdt--with-insertion-information ((length crdt--changed-string) outer-end 
crdt--changed-string nil 0 nil)
       (crdt--split-maybe))
     ;; (crdt--verify-buffer)
-    `(delete ,crdt--buffer-network-name
+    `(delete ,crdt--buffer-network-name ,(crdt--session-local-id crdt--session)
              ,beg ,@ (crdt--dump-ids 0 (length crdt--changed-string) 
crdt--changed-string t))))
 
 (defun crdt--remote-delete (position-hint id-items)
@@ -1144,12 +1172,20 @@ Start the search for those ID-ITEMs around 
POSITION-HINT."
 
 (defun crdt--before-change (beg end)
   "Before change hook used by CRDT-MODE.
-It saves the content to be changed (between BEG and END) into 
CRDT--CHANGED-STRING."
+Save the content to be changed (between BEG and END) into CRDT--CHANGED-STRING.
+Request a Site ID if we don't have it yet."
   (unless crdt--inhibit-update
     (setq crdt--changed-string (crdt--buffer-substring beg end))
     (crdt--text-property-assimilate nil beg end 0
                                     'crdt-id crdt--changed-string)
-    (setq crdt--changed-start beg)))
+    (setq crdt--changed-start beg)
+    (unless crdt--site-id
+      (condition-case nil
+          (setq crdt--site-id (crdt-remote-call 'crdt-get-write-access))
+        (crdt-access-denied
+         (read-only-mode)
+         (warn "Write access revoked in %s" crdt--buffer-network-name)
+         (signal 'quit nil))))))
 
 (defsubst crdt--crdt-id-assimilate (template beg &optional object)
   "Make the CRDT-ID property after BEG in OBJECT the same as TEMPLATE.
@@ -1273,6 +1309,7 @@ Always return a message otherwise."
 Check if focused buffer and cursor/mark position are changed.
 Send message to other peers about any changes."
   (crdt--with-should-not-error crdt--post-command
+    (add-to-list 'before-change-functions 'crdt--before-change)
     (unless (eq crdt--buffer-network-name (crdt--session-focused-buffer-name 
crdt--session))
       (crdt--broadcast-maybe
        (crdt--format-message `(focus ,(crdt--session-local-id crdt--session) 
,crdt--buffer-network-name)))
@@ -1479,7 +1516,7 @@ CRDT--PROCESS should be bound to the network process for 
the client connection."
                                           (crdt--format-message
                                            `(cursor ,crdt--buffer-network-name 
,user-id
                                                     ,point ,(crdt--get-id 
point)
-                                                    ,mark ,(crdt--get-id 
mark)))))))
+                                                    ,mark ,(when mark 
(crdt--get-id mark))))))))
                crdt--pseudo-cursor-table)
       (process-send-string crdt--process (crdt--format-message 
(crdt--local-cursor nil)))
 
@@ -1503,7 +1540,17 @@ CRDT--PROCESS should be bound to the network process for 
the client connection."
                crdt--overlay-table)
 
       (crdt--send-process-mark-maybe nil)
-      (crdt--send-variables-maybe nil))))
+      (crdt--send-variables-maybe nil)
+
+      ;; send fcaps
+      (dolist (command (crdt--compute-user-commands 
crdt-buffer-command-functions (crdt--client-id)))
+        (let ((nonce (or (gethash command crdt-buffer-fcap-in-table)
+                         (puthash command (crdt--generate-nonce) 
crdt-buffer-fcap-in-table))))
+          (process-send-string crdt--process
+                               (crdt--format-message
+                                `(fcap ,crdt--buffer-network-name ,command 
,nonce
+                                       ,(get command 'crdt-out-states)
+                                       ,(get command 'crdt-in-states)))))))))
 
 (defun crdt--greet-client ()
   "Send initial information when a client connects.
@@ -1514,14 +1561,12 @@ CRDT--PROCESS should be bound to The network process 
for the client connection."
     (cl-pushnew crdt--process (crdt--session-network-clients crdt--session))
     (let ((client-id (process-get crdt--process 'client-id)))
       (unless client-id
-        (unless (< (crdt--session-next-client-id crdt--session) 
crdt--max-value)
-          (error "Used up client IDs.  Need to implement allocation 
algorithm"))
-        (process-put crdt--process 'client-id (crdt--session-next-client-id 
crdt--session))
-        (setq client-id (crdt--session-next-client-id crdt--session))
+        (process-put crdt--process 'client-id (crdt--session-next-user-id 
crdt--session))
+        (setq client-id (crdt--session-next-user-id crdt--session))
         (process-send-string crdt--process (crdt--format-message
                                       `(login ,client-id
                                               ,(crdt--session-name 
crdt--session))))
-        (cl-incf (crdt--session-next-client-id crdt--session)))
+        (cl-incf (crdt--session-next-user-id crdt--session)))
       (process-send-string crdt--process (crdt--format-message
                                     (cons 'add (hash-table-keys 
(crdt--session-buffer-table crdt--session)))))
       ;; synchronize contact
@@ -1546,20 +1591,30 @@ CRDT--PROCESS should be bound to The network process 
for the client connection."
       (let ((contact-message `(contact ,client-id ,(process-get crdt--process 
'client-name)
                                        ,(process-contact crdt--process :host)
                                        ,(process-contact crdt--process 
:service))))
-        (crdt-process-message-1 contact-message)))))
+        (crdt-process-message-1 contact-message))
+      ;; send fcaps
+      (dolist (command (crdt--compute-user-commands 
(crdt--session-command-functions crdt--session) client-id))
+        (let ((nonce (or (gethash command (crdt--session-fcap-in-table 
crdt--session))
+                         (puthash command (crdt--generate-nonce)
+                                  (crdt--session-fcap-in-table 
crdt--session)))))
+          (process-send-string crdt--process
+                               (crdt--format-message
+                                `(fcap nil ,command ,nonce
+                                       ,(get command 'crdt-out-states)
+                                       ,(get command 'crdt-in-states)))))))))
 
 (define-crdt-message-handler insert (buffer-name user-id crdt-id position-hint 
content)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
         (crdt--remote-insert crdt-id user-id position-hint content)))
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
-(define-crdt-message-handler delete (buffer-name position-hint . id-pairs)
+(define-crdt-message-handler delete (buffer-name _user-id position-hint . 
id-pairs)
   (mapc (lambda (p) (rplaca (cdr p) (cadr p))) id-pairs)
   (crdt--with-buffer-name buffer-name
     (crdt--with-recover
         (crdt--remote-delete position-hint id-pairs)))
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
 (define-crdt-message-handler cursor
     (buffer-name user-id point-position-hint point-crdt-id mark-position-hint 
mark-crdt-id)
@@ -1567,7 +1622,7 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
     (crdt--with-recover
         (crdt--remote-cursor user-id point-position-hint point-crdt-id
                              mark-position-hint mark-crdt-id)))
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
 (define-crdt-message-handler get (buffer-name)
   (let ((buffer (gethash buffer-name (crdt--session-buffer-table 
crdt--session))))
@@ -1578,8 +1633,8 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
 (define-crdt-message-handler sync (buffer-name . ids)
   (unless (crdt--server-p)             ; server shouldn't receive this
     (crdt--with-buffer-name buffer-name
-      (read-only-mode -1)
-      (let ((crdt--inhibit-update t))
+      (let ((crdt--inhibit-update t)
+            (inhibit-read-only t))
         (unless crdt--buffer-sync-callback
           ;; try to get to the same position after sync,
           ;; if crdt--buffer-sync-callback is not set yet
@@ -1603,7 +1658,9 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
           (unless (eq major-mode mode)
             (funcall mode)              ; trust your server...
             (crdt-mode))
-        (message "Server uses %s, but not available locally." mode))
+        (warn "Server uses %s, but not available locally." mode))
+      (when (crdt-get-fcap 'crdt-get-write-access)
+        (read-only-mode -1))
       (when crdt--buffer-sync-callback
         (funcall crdt--buffer-sync-callback)
         (setq crdt--buffer-sync-callback nil)))))
@@ -1649,9 +1706,7 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
         (warn "Server stopped sharing %s."
               (mapconcat #'identity buffer-names ", "))))
    (let ((crdt--session saved-session))
-     (crdt--broadcast-maybe crdt--message-string
-                            (when crdt--process
-                              (process-get crdt--process 'client-id)))
+     (crdt--broadcast-maybe crdt--message-string (when crdt--process 
(crdt--client-id)))
      (crdt--refresh-buffers-maybe))))
 
 (define-crdt-message-handler login (id session-name)
@@ -1690,7 +1745,7 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
         (crdt-stop-follow))
       (remhash user-id (crdt--session-contact-table crdt--session))))
   (crdt--refresh-users-maybe)
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
 (define-crdt-message-handler focus (user-id buffer-name)
   (let ((existing-item (gethash user-id (crdt--session-contact-table 
crdt--session))))
@@ -1704,7 +1759,7 @@ CRDT--PROCESS should be bound to The network process for 
the client connection."
       (let ((ov-pair (gethash user-id crdt--pseudo-cursor-table)))
         (when ov-pair (goto-char (overlay-start (car ov-pair)))))))
   (crdt--refresh-users-maybe)
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
 (defun crdt--network-filter (process string)
   "Network filter function for CRDT network processes.
@@ -1788,7 +1843,26 @@ Handle received STRING from PROCESS."
 
 ;;; Capabilities
 
-(defun crdt-request-site-id ()
+(define-error 'crdt-access-denied "CRDT access denied")
+
+(defun crdt--generate-nonce ()
+  (with-temp-buffer
+    (toggle-enable-multibyte-characters 0)
+    (let ((err (call-process-shell-command "head -c 8 /dev/urandom" nil t)))
+      (unless (= err 0)
+        (error "Failed to read /dev/urandom (code %s)" err)))
+    (buffer-string)))
+
+(defun crdt--compute-user-commands (command-function user-id)
+  (cl-loop for f in command-function
+        if (functionp f)
+        append (funcall f user-id)
+        else
+        append f))
+
+(defun crdt-get-write-access ()
+  "Allocate a Site ID for current user to access current buffer.
+Current user means the user corresponding to CRDT--PROCESS."
   (let (new-site-id)
     (cl-loop
           for i in crdt--site-id-list
@@ -1806,7 +1880,7 @@ Handle received STRING from PROCESS."
         (rplacd cons nil)
         (setq new-site-id victim-id)))
     (push new-site-id crdt--site-id-use-list)
-    (puthash crdt--user-id new-site-id crdt--site-id-table)
+    (puthash (crdt--client-id) new-site-id crdt--site-id-table)
     new-site-id))
 
 ;;; UI commands
@@ -1899,16 +1973,14 @@ Handle received STRING from PROCESS."
         (setq crdt--session session)
         (puthash (buffer-name buffer) buffer (crdt--session-buffer-table 
crdt--session))
         (setq crdt--buffer-network-name (buffer-name buffer)
-              crdt--site-id 0 crdt--site-id-table (make-hash-table)
-              crdt--site-id-free-list (cl-loop for i from 1 below 
crdt--max-value collect i))
+              crdt--site-id 0 crdt--site-id-table (make-hash-table))
         (crdt-mode)
         (save-excursion
           (save-restriction
             (widen)
             (let ((crdt--inhibit-update t))
               (with-silent-modifications
-                (crdt--local-insert (point-min) (point-max))))
-            (run-hooks (crdt--session-add-buffer-hook crdt--session))))
+                (crdt--local-insert (point-min) (point-max))))))
         (crdt--refresh-buffers-maybe)
         (crdt--refresh-sessions-maybe))
     (error "Only server can add new buffer")))
@@ -1926,12 +1998,9 @@ Handle received STRING from PROCESS."
        string default)))
 
 ;;;###autoload
-(defun crdt-share-buffer (session-name &optional port)
+(defun crdt-share-buffer (session-name)
   "Share the current buffer in the CRDT session with name SESSION-NAME.
-Create a new one if such a CRDT session doesn't exist.  When PORT
-is non-NIL use when creating a new session, otherwise prompt
-from minibuffer.  If SESSION-NAME is empty, use the buffer name
-of the current buffer."
+Create a new one if such a CRDT session doesn't exist."
   (interactive
    (progn
      (when (and crdt-mode crdt--session)
@@ -1955,10 +2024,13 @@ of the current buffer."
          (apply #'crdt-new-session
                 (crdt--read-settings
                  (format "*Settings for %s*" session-name)
-                 `(("Port: " (number-to-string ,port) 
,(crdt--settings-make-ensure-type 'numberp))
+                 `(("Port: " "6530" ,(crdt--settings-make-ensure-type 
'numberp))
                    ("Session Name: " ,session-name 
,(crdt--settings-make-ensure-nonempty session-name))
                    ("Password: " "")
-                   ("Display Name: " ,crdt-default-name))))))))
+                   ("Display Name: " ,crdt-default-name)
+                   ("Command Functions: "
+                    ,(prin1-to-string crdt-default-session-command-functions)
+                    ,(crdt--settings-make-ensure-type 'listp)))))))))
 
 (cl-defun crdt-stop-share-buffer (&optional (session crdt--session)
                                  (network-name crdt--buffer-network-name))
@@ -1974,18 +2046,18 @@ of the current buffer."
     (message "Not a CRDT shared buffer.")))
 
 (defun crdt-new-session
-    (port session-name password display-name user-command-functions)
+    (port session-name password display-name command-functions)
   "Start a new CRDT session on PORT with SESSION-NAME.
 Setup up the server with PASSWORD and assign this Emacs DISPLAY-NAME.
-USER-COMMAND-FUNCTIONS is a list that describes policies
+COMMAND-FUNCTIONS is a list that describes policies
 for public session-scoped commands.
 Each element should be one of
-- a symbol, which should name a command.
-  The command is be made accessible to every user, in every buffer.
 - a function, which should return a list of commands when
-  called with two arguments USER-ID and BUFFER.
+  called with a single argument USER-ID..
   The returned list of commands is made accessible
-  to the user with USER-ID in BUFFER."
+  to the user with USER-ID in every buffer.
+- a list of commands.
+  These commands are made accessible to every user, in every buffer."
   (let* ((network-process (make-network-process
                            :name "CRDT Server"
                            :server t
@@ -1996,13 +2068,11 @@ Each element should be one of
          (new-session
           (crdt--make-session :local-id 0
                               :local-clock 0
-                              :next-client-id 1
+                              :next-user-id 1
                               :local-name display-name
-                              :contact-table (make-hash-table :test 'equal)
-                              :buffer-table (make-hash-table :test 'equal)
                               :name session-name
                               :network-process network-process
-                              :user-command-functions user-command-functions))
+                              :command-functions command-functions))
          (tuntox-p (or (eq crdt-use-tuntox t)
                        (and (eq crdt-use-tuntox 'confirm)
                             (yes-or-no-p "Start a tuntox proxy for this 
session? ")))))
@@ -2139,8 +2209,6 @@ Join with DISPLAY-NAME."
                             (new-session
                              (crdt--make-session :local-clock 0
                                                  :local-name display-name
-                                                 :contact-table 
(make-hash-table :test 'equal)
-                                                 :buffer-table 
(make-hash-table :test 'equal)
                                                  :name name-placeholder
                                                  :network-process 
network-process)))
                       (process-put network-process 'crdt-session new-session)
@@ -2257,7 +2325,7 @@ Join with DISPLAY-NAME."
           (let ((crdt--inhibit-overlay-advices t)
                 (crdt--modifying-overlay-metadata t))
             (overlay-put new-overlay 'crdt-meta meta)))))
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
 (defun crdt--move-overlay-advice (orig-fun ov beg end &rest args)
   (when crdt-mode
@@ -2315,7 +2383,7 @@ Join with DISPLAY-NAME."
             (remhash key crdt--overlay-table)
             (let ((crdt--inhibit-overlay-advices t))
               (delete-overlay ov))))))
-  (crdt--broadcast-maybe crdt--message-string (process-get crdt--process 
'client-id)))
+  (crdt--broadcast-maybe crdt--message-string (crdt--client-id)))
 
 (defun crdt--overlay-put-advice (orig-fun ov prop value)
   (unless (and (eq prop 'crdt-meta)
@@ -2397,33 +2465,57 @@ Join with DISPLAY-NAME."
                 (push (crdt--readable-decode (cadr entry)) vals))))
     (cons vars vals)))
 
-(defvar crdt--remote-call-spawn-site nil
-  "The site where current remote call (if any) is orignally called.")
+(defvar crdt--remote-call-spawn-user-id nil
+  "The User ID where current remote call (if any) is orignally called.")
+
+(define-crdt-message-handler fcap
+    (buffer-name command-symbol nonce in-states _out-states)
+  (cl-flet* ((body ()
+                   (puthash command-symbol
+                            (lambda (&rest args)
+                              (crdt--remote-call (crdt--session-local-id 
crdt--session)
+                                                 command-symbol nonce 
in-states args))
+                            (if buffer-name crdt-buffer-fcap-out-table
+                              (crdt--session-fcap-out-table crdt--session)))
+                   (cl-case command-symbol
+                     ((crdt-get-write-access)
+                      (if buffer-name
+                          (read-only-mode -1)
+                        (dolist (buffer (hash-table-values 
(crdt--session-buffer-table crdt--session)))
+                          (when buffer
+                            (with-current-buffer buffer (read-only-mode 
-1)))))))))
+    (if buffer-name (crdt--call-with-buffer-name buffer-name #'body) (funcall 
#'body))))
 
 (define-crdt-message-handler command
-    (buffer-name spawn-user-id user-id logical-clock
-                 state-list command-symbol &rest args)
-  (crdt--with-buffer-name buffer-name
-    (save-mark-and-excursion
-      (save-window-excursion
-        (let ((bindings (crdt--apply-state-list state-list)))
-          (cl-progv (car bindings) (cdr bindings)
-            (let* ((crdt--inhibit-update nil)
-                   (crdt--remote-call-spawn-site spawn-user-id)
-                   (session crdt--session)
-                   (return-message
-                    (if (get command-symbol 'crdt-allow-remote-call)
-                        (condition-case err
-                            (list t (apply command-symbol (mapcar 
#'crdt--readable-decode args)))
-                          (error (list nil (car err) (crdt--readable-encode 
(cdr err)))))
-                      (list nil 'crdt-access-denied))))
-              (setq crdt--session session) ;; workaround, somehow 
CRDT--SESSION becomes NIL after some command
-              (let ((msg (crdt--format-message
-                          `(return ,user-id ,logical-clock
-                                   ,(crdt--assemble-state-list (get 
command-symbol 'crdt-command-out-states))
-                                   ,@return-message))))
-                (crdt--log-send-network-traffic msg)
-                (process-send-string crdt--process msg)))))))))
+    (buffer-name user-id logical-clock spawn-user-id
+                 state-list nonce command-symbol &rest args)
+  (cl-flet*
+      ((check ()
+              (or (equal nonce
+                         (gethash command-symbol (crdt--session-fcap-in-table 
crdt--session)))
+                  (and buffer-name
+                       (equal nonce
+                              (gethash command-symbol 
crdt-buffer-fcap-in-table)))))
+       (body ()
+             (let ((bindings (crdt--apply-state-list state-list)))
+               (cl-progv (car bindings) (cdr bindings)
+                 (let* ((crdt--inhibit-update nil)
+                        (crdt--remote-call-spawn-user-id spawn-user-id)
+                        (return-message
+                         (if (check)
+                             (save-mark-and-excursion
+                               (save-window-excursion
+                                 (condition-case err
+                                     (list t (apply command-symbol (mapcar 
#'crdt--readable-decode args)))
+                                   (error (list nil (car err) 
(crdt--readable-encode (cdr err)))))))
+                           (list nil 'crdt-access-denied))))
+                   (let ((msg (crdt--format-message
+                               `(return ,user-id ,logical-clock
+                                        ,(crdt--assemble-state-list (get 
command-symbol 'crdt-command-out-states))
+                                        ,@return-message))))
+                     (crdt--log-send-network-traffic msg)
+                     (process-send-string crdt--process msg)))))))
+    (if buffer-name (crdt--call-with-buffer-name buffer-name #'body) (funcall 
#'body))))
 
 (defvar crdt--return-message-table (make-hash-table))
 
@@ -2432,25 +2524,23 @@ Join with DISPLAY-NAME."
     (puthash logical-clock (cl-list* state-list success-p 
(crdt--readable-decode return-values))
              crdt--return-message-table)))
 
-(defun crdt--make-remote-call (spawn-user-id function-symbol in-states args)
+(defun crdt--remote-call (spawn-user-id function-symbol nonce in-states args)
   "Send remote call request (a command type message) for FUNCTION-SYMBOL.
-SPAWN-USER-ID is the site where
-the series (if any) of remote calls originally started.
-Assemble state list for items in IN-STATES.
-Request for calling FUNCTION-SYMBOL with ARGS."
+SPAWN-USER-ID is the site where the series (if any) of remote calls originally 
started.
+NONCE should be acquired from some fcap message for fcap verification.
+Assemble state list for items in IN-STATES. Request for calling 
FUNCTION-SYMBOL with ARGS."
   (let* ((user-id (crdt--session-local-id crdt--session))
          (logical-clock (crdt--session-local-clock crdt--session))
          (msg (crdt--format-message
-               `(command ,crdt--buffer-network-name ,spawn-user-id
-                         ,user-id ,logical-clock
-                         ,(crdt--assemble-state-list in-states)
+               `(command ,crdt--buffer-network-name ,user-id
+                         ,logical-clock  ,spawn-user-id
+                         ,(crdt--assemble-state-list in-states) ,nonce
                          ,function-symbol ,@(mapcar #'crdt--readable-encode 
args)))))
     (crdt--log-send-network-traffic msg)
     (process-send-string (crdt--session-network-process crdt--session) msg)
     (cl-incf (crdt--session-local-clock crdt--session))
     (while (not (gethash logical-clock crdt--return-message-table))
-      (sleep-for 0.1)
-      (thread-yield))
+      (accept-process-output (crdt--session-network-process crdt--session)))
     (let ((return-message (gethash logical-clock crdt--return-message-table)))
       (remhash logical-clock crdt--return-message-table)
       (cl-destructuring-bind (state-list success-p &rest return-values) 
return-message
@@ -2459,72 +2549,29 @@ Request for calling FUNCTION-SYMBOL with ARGS."
             (car return-values)
           (apply #'signal return-values))))))
 
-(defun crdt--make-remote-command-advice (function-symbol in-states)
-  (lambda (orig-fun &rest args)
-    (if (and crdt--session (not (crdt--server-p)))
-        (crdt--make-remote-call (crdt--session-local-id crdt--session)
-                                function-symbol in-states args)
-      (apply orig-fun args))))
-
-(defun crdt-register-remote-command (command-symbol &optional in-states 
out-states)
-  "Register COMMAND-SYMBOL as a remote command.
-Allow remote calls to COMMAND-SYMBOL.
-Delegate calls to COMMAND-SYMBOL at client side to the server.
-Assume that COMMAND-SYMBOL, when invoked,
-make use of no more states other than those in IN-STATES.
-After executing the command on the server,
-OUT-STATES are sent back to the client."
-  (put command-symbol 'crdt-allow-remote-call t)
-  (put command-symbol 'crdt-command-out-states out-states)
-  (advice-add command-symbol :around (crdt--make-remote-command-advice 
command-symbol in-states)
-              '((name . crdt-remote-command-advice))))
-
-(defun crdt-unregister-remote-command (command-symbol)
-  "Unregister COMMAND-SYMBOL as a remote command.
-Stop allowing remote calls to COMMAND-SYMBOL."
-  (cl-remprop command-symbol 'crdt-allow-remote-call)
-  (advice-remove command-symbol 'crdt-remote-command-advice))
+(defsubst crdt-get-fcap (command-symbol)
+  "Find buffer or session fcap with name COMMAND-SYMBOL."
+  (or (gethash command-symbol crdt-buffer-fcap-out-table)
+      (gethash command-symbol (crdt--session-fcap-out-table crdt--session))))
+
+(defun crdt-remote-call (command-symbol &rest args)
+  "Remote call COMMAND-SYMBOL with ARGS.
+Find and use buffer or session fcap with name COMMAND-SYMBOL."
+  (let ((fcap (crdt-get-fcap command-symbol)))
+    (if fcap (apply fcap args)
+      (signal 'crdt-access-denied command-symbol))))
 
 (defun crdt-register-remote-commands (command-entries)
   "Register a list of remote commands according to COMMAND-ENTRIES.
 Each item in COMMAND-ENTRIES should have the form (COMMAND-SYMBOL &optional 
IN-STATES OUT-STATES)."
   (dolist (entry command-entries)
-    (apply #'crdt-register-remote-command entry)))
+    (cl-destructuring-bind (command-symbol &optional in-states out-states) 
entry
+      (put command-symbol 'crdt-in-states in-states)
+      (put command-symbol 'crdt-out-states out-states))))
 
-(defun crdt-unregister-remote-commands (command-entries)
-  "Unregister a list of remote commands according to COMMAND-ENTRIES.
-Required form of COMMAND-ENTRIES is the same as that of 
CRDT-REGISTER-REMOTE-COMMANDS."
-  (dolist (entry command-entries)
-    (crdt-unregister-remote-command (car entry))))
-
-(defun crdt--make-remote-interaction-advice (function-symbol)
-  (lambda (orig-fun &rest args)
-    (if (and crdt--process
-             (not (eq crdt--remote-call-spawn-site (crdt--session-local-id 
crdt--session))))
-        ;; Is the above condition correct?
-        ;; We must make sure we don't bind crdt--process AND call interaction 
command
-        ;; in any circumstances except inside a remote command call
-        (crdt--make-remote-call crdt--remote-call-spawn-site function-symbol 
nil args)
-      (apply orig-fun args))))
-
-(defun crdt-register-interaction-function (function-symbol &rest states)
-  "Register FUNCTION-SYMBOL as a remote interaction function.
-Allow remote calls to FUNCTION-SYMBOL.
-Delegate calls to FUNCTION-SYMBOL inside some remote command call
-back to the site where the remote command is originally invoked.
-Assume that COMMAND-SYMBOL, when invoked,
-make use of no more states other than those in STATES."
-  (put function-symbol 'crdt-allow-remote-call t)
-  (advice-add function-symbol :around (apply 
#'crdt--make-remote-interaction-advice function-symbol states)
-              '((name . crdt-remote-interaction-advice))))
-
-(defun crdt-unregister-interaction-function (function-symbol)
-  "Unregister FUNCTION-SYMBOL as a remote interaction function.
-Stop allowing remote calls to FUNCTION-SYMBOL."
-  (cl-remprop function-symbol 'crdt-allow-remote-call)
-  (advice-remove function-symbol 'crdt-remote-interaction-advice))
-
-(crdt-register-interaction-function 'read-from-minibuffer)
+(defun crdt-make-publish-command-hook (command-entries)
+  "Return a function that publish commands in COMMAND-ENTRIES for current 
buffer."
+  (push (mapcar #'car command-entries) crdt-buffer-command-functions))
 
 ;;; Buffer local variables
 
@@ -2727,8 +2774,7 @@ The result DIFF can be used in (CRDT--NAPPLY-DIFF OLD 
DIFF) to reproduce NEW."
             (if buffer-process
                 (progn (set-marker (process-mark buffer-process) (point))
                        (setq crdt--last-process-mark-id crdt-id)
-                       (crdt--broadcast-maybe crdt--message-string
-                                              (process-get crdt--process 
'client-id)))
+                       (crdt--broadcast-maybe crdt--message-string 
(crdt--client-id)))
               (unless (crdt--server-p)
                 (setq crdt--buffer-pseudo-process
                       (crdt--make-pseudo-process :buffer (current-buffer) 
:mark (point-marker)))
@@ -2848,25 +2894,27 @@ Use CRDT--UNINSTALL-PROCESS-ADVICES to disable those 
advices for the rescue."
       do (advice-add command :around #'crdt--org-overlay-advice))
 
 ;;;; xscheme
-(crdt-register-remote-commands
- '((xscheme-send-region (region))
-   (xscheme-send-definition (point))
-   (xscheme-send-previous-expression (point))
-   (xscheme-send-next-expression (point))
-   (xscheme-send-current-line (point))
-   (xscheme-send-buffer)
-   (xscheme-send-char)
-   (xscheme-delete-output)
-   (xscheme-send-breakpoint-interrupt)
-   (xscheme-send-proceed)
-   (xscheme-send-control-g-interrupt)
-   (xscheme-send-control-u-interrupt)
-   (xscheme-send-control-x-interrupt)
-   (scheme-debugger-self-insert (last-command-event))))
+(defvar crdt-xscheme-commands
+  '((xscheme-send-region (region))
+    (xscheme-send-definition (point))
+    (xscheme-send-previous-expression (point))
+    (xscheme-send-next-expression (point))
+    (xscheme-send-current-line (point))
+    (xscheme-send-buffer)
+    (xscheme-send-char)
+    (xscheme-delete-output)
+    (xscheme-send-breakpoint-interrupt)
+    (xscheme-send-proceed)
+    (xscheme-send-control-g-interrupt)
+    (xscheme-send-control-u-interrupt)
+    (xscheme-send-control-x-interrupt)
+    (scheme-debugger-self-insert (last-command-event))))
+(crdt-register-remote-commands crdt-xscheme-commands)
 ;; xscheme doesn't use standard DEFINE-*-MODE facility
 ;; and doesn't call after-change-major-mode-hook.
 ;; Therefore we have to hack.
 (advice-add 'scheme-interaction-mode-initialize :after 
'crdt--after-change-major-mode)
+(advice-add 'scheme-interaction-mode-initialize :after 
(crdt-make-publish-command-hook crdt-xscheme-commands))
 (advice-add 'scheme-debugger-mode-initialize :after
             (lambda () ;; haxxxx!!!!
               (let ((major-mode 'scheme-debugger-mode-initialize))
@@ -2882,10 +2930,12 @@ Use CRDT--UNINSTALL-PROCESS-ADVICES to disable those 
advices for the rescue."
 (defvar comint-input-ring-size)
 (defvar comint-input-ring-file-name)
 
-(crdt-register-remote-commands
- '((comint-send-input (point) (point))
-   (comint-send-region (region) (region))
-   (comint-send-eof (point))))
+(defvar crdt-comint-commands
+  '((comint-send-input (point) (point))
+    (comint-send-region (region) (region))
+    (comint-send-eof (point))))
+(crdt-register-remote-commands crdt-comint-commands)
+(add-hook 'comint-mode-hook (crdt-make-publish-command-hook 
crdt-comint-commands))
 
 (crdt-register-autoload 'shell-mode 'shell)
 (crdt-register-autoload 'inferior-scheme-mode 'cmuscheme)
@@ -2954,12 +3004,15 @@ This procedure is non-destructive."
 (add-hook 'crdt-mode-hook #'crdt--comint-mode-hook)
 
 ;;;; xref
-(crdt-register-remote-commands
- '((xref-find-definitions (point) (point))
-   (xref-find-references (point) (point))
-   (xref-show-location-at-point (point) (point))
-   (xref-pop-marker-stack () (point))
-   (xref-goto-xref (point) (point))))
+(defvar crdt-xref-commands
+  '((xref-find-definitions (point) (point))
+    (xref-find-references (point) (point))
+    (xref-show-location-at-point (point) (point))
+    (xref-pop-marker-stack () (point))
+    (xref-goto-xref (point) (point))))
+(crdt-register-remote-commands crdt-xref-commands)
+(defun crdt-xref-command-function (_user-id)
+  (mapcar #'car crdt-xref-commands))
 
 (defun crdt--xref-buffer-mode-hook ()
   (add-to-list 'crdt--enabled-text-properties 'xref-item)