summaryrefslogtreecommitdiffstats
path: root/emacs.d/lisp/rudel/obby/.svn/text-base/rudel-obby-server.el.svn-base
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--emacs.d/lisp/rudel/obby/.svn/text-base/rudel-obby-server.el.svn-base798
1 files changed, 798 insertions, 0 deletions
diff --git a/emacs.d/lisp/rudel/obby/.svn/text-base/rudel-obby-server.el.svn-base b/emacs.d/lisp/rudel/obby/.svn/text-base/rudel-obby-server.el.svn-base
new file mode 100644
index 0000000..5bf1158
--- /dev/null
+++ b/emacs.d/lisp/rudel/obby/.svn/text-base/rudel-obby-server.el.svn-base
@@ -0,0 +1,798 @@
+;;; rudel-obby-server.el --- Server component of the Rudel obby backend
+;;
+;; Copyright (C) 2008, 2009 Jan Moringen
+;;
+;; Author: Jan Moringen <scymtym@users.sourceforge.net>
+;; Keywords: Rudel, obby, backend, server
+;; X-RCS: $Id:$
+;;
+;; This file is part of Rudel.
+;;
+;; Rudel is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Rudel is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Rudel. If not, see <http://www.gnu.org/licenses>.
+
+
+;;; Commentary:
+;;
+;; This file contains the server part of the obby backend for Rudel.
+;;
+;; It is implemented using one state machine (class
+;; `rudel-obby-client') for each client connection. These state
+;; machines have the following states:
+;;
+;; + new `rudel-obby-server-state-new'
+;; + encryption-negotiate `rudel-obby-server-state-encryption-negotiate'
+;; + before-join `rudel-obby-server-state-before-join'
+;; + idle `rudel-obby-server-state-idle'
+
+
+;;; History:
+;;
+;; 0.2 - State machine.
+;;
+;; 0.1 - Initial revision.
+
+
+;;; Code:
+;;
+
+(eval-when-compile
+ (require 'cl))
+
+(require 'eieio)
+
+(require 'jupiter)
+
+(require 'rudel-state-machine)
+
+(require 'rudel-obby-errors)
+(require 'rudel-obby-util)
+(require 'rudel-obby-state)
+
+
+;;; Class rudel-obby-server-state-new
+;;
+
+(defclass rudel-obby-server-state-new
+ (rudel-obby-server-connection-state)
+ ()
+ "State in which new connections start out.")
+
+(defmethod rudel-enter ((this rudel-obby-server-state-new))
+ "Sends welcome messages to the client and starts the session
+timeout timer."
+ ;; Send greeting sequence to the client.
+ (rudel-send this
+ "obby_welcome"
+ (number-to-string rudel-obby-protocol-version))
+
+ ;; Switch to encryption negotiation state.
+ 'encryption-negotiate)
+
+
+;;; Class rudel-obby-server-state-encryption-negotiate
+;;
+
+(defclass rudel-obby-server-state-encryption-negotiate
+ (rudel-obby-server-connection-state)
+ ()
+ "Encryption negotiation state.")
+
+(defmethod rudel-enter ((this rudel-obby-server-state-encryption-negotiate))
+ "Send net6 'encryption' message requesting to not enable encryption."
+ (rudel-send this "net6_encryption" "0")
+ nil)
+
+(defmethod rudel-obby/net6_encryption_ok
+ ((this rudel-obby-server-state-encryption-negotiate))
+ "Handle net6 'encryption_ok' message.
+Even if the client requests an encrypted connection, we cancel
+the negotiation."
+ (rudel-send this "net6_encryption_failed")
+ 'before-join)
+
+(defmethod rudel-obby/net6_encryption_failed
+ ((this rudel-obby-server-state-encryption-negotiate))
+ "Handle net6 'encryption_failed' message.
+No action has to be taken, since the client simply proceeds after
+failed encryption negotiation."
+ 'before-join)
+
+
+;;; Class rudel-obby-server-state-before-join
+;;
+
+(defclass rudel-obby-server-state-before-join
+ (rudel-obby-server-connection-state)
+ ()
+ "Waiting for client request joining the session.")
+
+(defmethod rudel-obby/net6_client_login
+ ((this rudel-obby-server-state-before-join) username color
+ &optional global-password user-password)
+ "Handle net6 'client_login' message."
+ (with-parsed-arguments ((color color))
+ (with-slots (server
+ (client-id :id)
+ user
+ encryption) (oref this :connection)
+ ;; Make sure USERNAME and COLOR are valid.
+ (let ((error (rudel-check-username-and-color
+ server username color)))
+ (if error
+ ;; If USERNAME or COLOR are invalid, send the error code
+ ;; to the client and stay in the current state.
+ (progn
+ (rudel-send this
+ "net6_login_failed"
+ (format "%x" error))
+ nil)
+
+ ;; Create a user object for this client and add it to the
+ ;; server.
+ (setq user (rudel-make-user
+ server
+ username client-id color encryption))
+ (rudel-add-user server user)
+
+ ;; Broadcast the join event to all clients (including the
+ ;; new one).
+ (with-slots ((name :object-name) color (user-id :user-id)) user
+ (rudel-broadcast this (list 'exclude (oref this :connection))
+ "net6_client_join"
+ (format "%x" client-id)
+ name
+ "0"
+ (format "%x" user-id)
+ (rudel-obby-format-color color)))
+
+ ;; Get the new client up to date:
+ ;; - transmit user list
+ ;; - connected users
+ ;; - disconnected users
+ ;; - transmit document list
+ (with-slots (users clients documents) server
+ ;; Send number of synchronization items: sum of numbers of
+ ;; offline users and documents.
+ (let ((number-of-items (+ (length users) (length documents))))
+ (rudel-send this
+ "obby_sync_init"
+ (format "%x" number-of-items)))
+
+ ;; Transmit list of connected users.
+ (dolist (client clients)
+ (with-slots ((client-id :id) user) client
+ (when user
+ (with-slots ((name :object-name)
+ color
+ (user-id :user-id)) user
+ (rudel-send this
+ "net6_client_join"
+ (format "%x" client-id)
+ name
+ "0"
+ (format "%x" user-id)
+ (rudel-obby-format-color color))))))
+
+ ;; Transmit list of disconnected users.
+ (let ((offline-users (remove-if #'rudel-connected users)))
+ (dolist (user offline-users)
+ (with-slots ((name :object-name) user-id color) user
+ (rudel-send this
+ "obby_sync_usertable_user"
+ (format "%x" user-id)
+ name
+ (rudel-obby-format-color color)))))
+
+ ;; Transmit document list
+ (dolist (document documents)
+ (with-slots ((name :object-name)
+ (doc-id :id)
+ owner-id
+ suffix
+ subscribed) document
+ (apply #'rudel-send
+ this
+ "obby_sync_doclist_document"
+ (format "%x" owner-id)
+ (format "%x" doc-id)
+ name
+ (format "%x" suffix)
+ "UTF-8"
+ (mapcar
+ (lambda (user1) ;; TODO we could use `user' here, but there is a bug in cl
+ (format "%x" (rudel-id user1)))
+ subscribed)))))
+
+ (rudel-send this "obby_sync_final")
+ 'idle))))
+ )
+
+
+;;; Class rudel-obby-server-state-idle
+;;
+
+(defclass rudel-obby-server-state-idle
+ (rudel-obby-server-connection-state)
+ ()
+ "Idle state of a server connection.
+
+The connection enters this state when all setup work is finished,
+the client has joined the session and no operation is in
+progress. In this state, the connection waits for new messages
+from the client that initiate operations. Simple (which means
+stateless in this case) operations are performed without leaving
+the idle state.")
+
+(defmethod rudel-obby/obby_user_colour
+ ((this rudel-obby-server-state-idle) color-)
+ "Handle obby 'user_colour' message.
+This method is called when the connected user requests a change
+of her color to COLOR."
+ (with-parsed-arguments ((color- color))
+ (with-slots (user) (oref this :connection)
+ (with-slots (color (user-id :user-id)) user
+ ;; Set color slot value.
+ (setq color color-)
+
+ ;; Run change hook.
+ (object-run-hook-with-args user 'change-hook)
+
+ (rudel-broadcast this (list 'exclude (oref this :connection))
+ "obby_user_colour"
+ (format "%x" user-id)
+ (rudel-obby-format-color color)))))
+ nil)
+
+(defmethod rudel-obby/obby_document_create
+ ((this rudel-obby-server-state-idle)
+ doc-id name encoding content)
+ "Handle obby 'document_create' message."
+ (with-parsed-arguments ((doc-id number)
+ (encoding coding-system))
+ (with-slots (user server) (oref this :connection)
+ (with-slots ((user-id :user-id)) user
+ ;; Create a (hidden) buffer for the new document.
+ (let* ((buffer (get-buffer-create
+ (generate-new-buffer-name
+ (concat " *" name "*"))))
+ ;; Create the new document object
+ (document (rudel-obby-document
+ name
+ :buffer buffer
+ :subscribed (list user)
+ :id doc-id
+ :owner-id user-id
+ :suffix 1)))
+
+ ;; Initialize the buffer's content
+ (with-current-buffer buffer
+ (insert content))
+
+ (with-slots (suffix) document
+ ;; Determine an appropriate suffix to provide an unique
+ ;; name for the new document.
+ (while (rudel-find-document server
+ (if (= suffix 1)
+ name
+ (format "%s<%d>" name suffix))
+ #'string= #'rudel-unique-name)
+ (incf suffix))
+
+ ;; Add the document to the server's document list
+ (rudel-add-document server document)
+
+ ;; Maybe notify the creating client of the changed suffix.
+ (unless (= suffix 1)
+ (rudel-send this
+ "obby_document"
+ (format "%x %x" user-id doc-id)
+ "rename"
+ (format "%x" user-id)
+ name
+ (format "%x" suffix)))
+
+ ;; Notify other clients of the new document
+ (rudel-broadcast this (list 'exclude (oref this :connection))
+ "obby_document_create"
+ (format "%x" user-id)
+ (format "%x" doc-id)
+ name
+ (format "%x" suffix)
+ (upcase (symbol-name encoding))))
+
+ ;; Add a jupiter context for (THIS DOCUMENT).
+ (rudel-add-context server (oref this :connection) document))))
+ nil)
+ )
+
+(defmethod rudel-obby/obby_document
+ ((this rudel-obby-server-state-idle) doc-id action &rest arguments)
+ "Handle obby 'document' messages."
+ (with-parsed-arguments ((doc-id document-id))
+ ;; Locate the document based on owner id and document id
+ (let ((document (with-slots (server) (oref this :connection)
+ (rudel-find-document server doc-id
+ #'equal #'rudel-both-ids))))
+ (rudel-obby-dispatch this action
+ (append (list document) arguments)
+ "rudel-obby/obby_document/")))
+ )
+
+(defmethod rudel-obby/obby_document/subscribe
+ ((this rudel-obby-server-state-idle) document user-id)
+ "Handle 'subscribe' submessage of obby 'document' message."
+ (with-parsed-arguments ((user-id number))
+ (let ((user (with-slots (server) (oref this :connection)
+ (rudel-find-user server user-id
+ #'= #'rudel-id))))
+ (with-slots (owner-id (doc-id :id) subscribed buffer) document
+
+ ;; Track subscription, handle duplicate subscription requests.
+ (when (memq user subscribed)
+ (error "User `%s' already subscribed to document `%s'"
+ (object-name user) (object-name document)))
+ (rudel-add-user document user)
+
+ ;; Synchronize the buffer content to the client.
+ (with-current-buffer buffer
+ ;; Send overall buffer size
+ (rudel-send this
+ "obby_document"
+ (format "%x %x" owner-id doc-id)
+ "sync_init"
+ (format "%x" (1- (position-bytes (point-max)))))
+
+ ;; Send buffer chunks with author ids
+ (dolist (chunk (rudel-chunks document))
+ (multiple-value-bind (from to author) chunk
+ (let ((string (buffer-substring (+ from 1) (+ to 1))))
+ (rudel-send this
+ "obby_document"
+ (format "%x %x" owner-id doc-id)
+ "sync_chunk"
+ string
+ (format "%x"
+ (if author
+ (oref author :user-id)
+ 0)))))))
+
+ ;; Notify clients of the new subscription (including our own
+ ;; client, who requested the subscription).
+ (with-slots ((user-id :user-id)) user
+ (rudel-broadcast this nil
+ "obby_document"
+ (format "%x %x" owner-id doc-id)
+ "subscribe"
+ (format "%x" user-id)))))
+
+ ;; Add a jupiter context for (THIS document).
+ (with-slots (server) (oref this :connection)
+ (rudel-add-context server (oref this :connection) document))
+ nil)
+ )
+
+(defmethod rudel-obby/obby_document/unsubscribe
+ ((this rudel-obby-server-state-idle) document user-id)
+ "Handle 'unsubscribe' submessage of 'obby_document' message."
+ (with-parsed-arguments ((user-id number))
+ (let ((user (with-slots (server) (oref this :connection)
+ (rudel-find-user server user-id
+ #'= #'rudel-id))))
+ (with-slots (owner-id (doc-id :id) subscribed) document
+
+ ;; Track subscription, handle invalid unsubscribe requests
+ (unless (memq user subscribed)
+ (error "User `%s' not subscribed to document `%s'"
+ (object-name user) (object-name document)))
+ (rudel-remove-user document user)
+
+ ;; Notify clients of the canceled subscription (including our
+ ;; own client, who requested being unsubscribed).
+ (with-slots ((user-id :user-id)) user
+ (rudel-broadcast this nil
+ "obby_document"
+ (format "%x %x" owner-id doc-id)
+ "unsubscribe"
+ (format "%x" user-id))))
+
+ ;; Remove jupiter context for (THIS DOCUMENT).
+ (with-slots (server) (oref this :connection)
+ (rudel-remove-context server (oref this :connection) document)))
+ nil)
+ )
+
+(defmethod rudel-obby/obby_document/record
+ ((this rudel-obby-server-state-idle)
+ document local-revision remote-revision action &rest arguments)
+ "Handle 'record' submessages of 'obby_document' message."
+ (with-parsed-arguments ((local-revision number)
+ (remote-revision number))
+ ;; Dispatch to specialized operation handlers.
+ (rudel-obby-dispatch
+ this action
+ (append (list document local-revision remote-revision)
+ arguments)
+ "rudel-obby/obby_document/record/"))
+ )
+
+(defmethod rudel-obby/obby_document/record/ins
+ ((this rudel-obby-server-state-idle)
+ document local-revision remote-revision position data)
+ "Handle 'ins' submessage of 'record' submessages of 'obby_document' message."
+ (with-parsed-arguments ((position number))
+ ;; Construct the operation object and process it.
+ (rudel-remote-operation
+ (oref this :connection) document
+ remote-revision local-revision
+ (jupiter-insert
+ (format "insert-%d-%d"
+ remote-revision local-revision)
+ :from position
+ :data data))
+ nil)
+ )
+
+(defmethod rudel-obby/obby_document/record/del
+ ((this rudel-obby-server-state-idle)
+ document local-revision remote-revision position length)
+ "Handle 'del' submessage of 'record' submessages of 'obby_document' message."
+ (with-parsed-arguments ((position number)
+ (length number))
+ ;; Construct the operation object and process it.
+ (rudel-remote-operation
+ (oref this :connection) document
+ remote-revision local-revision
+ (jupiter-delete
+ (format "delete-%d-%d"
+ remote-revision local-revision)
+ :from position
+ :to (+ position length)))
+ nil)
+ )
+
+
+;;; Client connection states.
+;;
+
+(defvar rudel-obby-server-connection-states
+ '((new . rudel-obby-server-state-new)
+ (encryption-negotiate . rudel-obby-server-state-encryption-negotiate)
+ (before-join . rudel-obby-server-state-before-join)
+ (idle . rudel-obby-server-state-idle))
+ "Name symbols and classes of connection states.")
+
+
+;;; Class rudel-obby-client
+;;
+
+(defclass rudel-obby-client (rudel-obby-socket-owner
+ rudel-state-machine)
+ ((server :initarg :server
+ :type rudel-obby-server
+ :documentation
+ "")
+ (id :initarg :id
+ :type integer
+ :accessor rudel-id
+ :documentation
+ "")
+ (user :initarg :user
+ :type (or rudel-obby-user null)
+ :initform nil
+ :documentation
+ "")
+ (encryption :initarg :encryption
+ :type boolean
+ :documentation
+ ""))
+ "Each object of this class represents one client, that is
+connected to the server. This object handles all direct
+communication with the client, while broadcast messages are
+handled by the server.")
+
+(defmethod initialize-instance ((this rudel-obby-client) &rest slots)
+ "Initialize slots of THIS and register state machine states."
+ ;; Initialize slots of THIS
+ (when (next-method-p)
+ (call-next-method))
+
+ ;; Register states.
+ (rudel-register-states this rudel-obby-server-connection-states)
+ )
+
+(defmethod rudel-register-state ((this rudel-obby-client) symbol state)
+ "Register SYMBOL and STATE and set connection slot of STATE."
+ ;; Associate THIS connection to STATE.
+ (oset state :connection this)
+
+ ;; Register STATE.
+ (call-next-method))
+
+(defmethod rudel-end ((this rudel-obby-client))
+ ""
+ (rudel-disconnect this))
+
+(defmethod rudel-close ((this rudel-obby-client))
+ ""
+ (with-slots (server) this
+ (rudel-remove-client server this)))
+
+(defmethod rudel-message ((this rudel-obby-client) message)
+ "Dispatch MESSAGE to the active state of THIS state machine."
+ ;; Dispatch message to state
+ (rudel-accept this message))
+
+(defmethod rudel-broadcast ((this rudel-obby-client)
+ receivers name &rest arguments)
+ "Broadcast message NAME with arguments ARGUMENTS to RECEIVERS."
+ (with-slots (server) this
+ (apply #'rudel-broadcast server receivers name arguments)))
+
+(defmethod rudel-remote-operation ((this rudel-obby-client)
+ document
+ local-revision remote-revision
+ operation)
+ "Execute and relay OPERATION on DOCUMENT."
+ (with-slots (server user) this
+ ;; Transform OPERATION and find clients that need to receive
+ ;; notifications.
+ (let* ((context (rudel-find-context server this document))
+ (transformed (jupiter-remote-operation
+ context
+ local-revision remote-revision
+ operation))
+ (receivers (rudel-subscribed-clients-not-self
+ this document)))
+
+ ;; Relay change notification to other clients. We use
+ ;; TRANSFORMED before the byte -> char conversion which is what
+ ;; the receivers expect.
+ (with-slots (user-id) user
+ (with-slots (owner-id (doc-id :id)) document
+ ;; Construct and send messages to all receivers individually
+ ;; since the contents of the messages depends on the state
+ ;; of the jupiter context associated the respective
+ ;; receiver.
+ (dolist (receiver receivers)
+
+ ;; Find the jupiter context for RECEIVER and use its
+ ;; revision information.
+ (let ((context (rudel-find-context server receiver document)))
+ ;; Construct and send one message.
+ (with-slots (local-revision remote-revision) context
+ (apply #'rudel-send
+ receiver
+ "obby_document"
+ (format "%x %x" owner-id doc-id)
+ "record"
+ (format "%x" user-id)
+ (format "%x" local-revision)
+ (format "%x" remote-revision)
+ (rudel-operation->message transformed)))
+
+ ;; Submit the operation to the jupiter context.
+ (jupiter-local-operation context transformed)))))
+
+ ;; Incorporate change into DOCUMENT (the server-side
+ ;; document). We have to convert bytes -> chars before we can do
+ ;; this.
+ (with-slots (buffer) document
+ (rudel-obby-byte->char transformed buffer))
+
+ (rudel-remote-operation document user transformed)))
+ )
+
+(defmethod rudel-subscribed-clients-not-self ((this rudel-obby-client)
+ document)
+ "Return a list of clients subscribed to DOCUMENT excluding THIS."
+ (with-slots (clients) (oref this :server)
+ (with-slots (subscribed) document
+ (remove-if
+ (lambda (client)
+ (with-slots (user) client
+ (or (eq client this)
+ (not (memq user subscribed)))))
+ clients)))
+ )
+
+
+;;; Class rudel-obby-server
+;;
+
+(defclass rudel-obby-server (rudel-server-session
+ rudel-socket-owner)
+ ((clients :initarg :clients
+ :type list
+ :initform nil
+ :documentation
+ "")
+ (next-client-id :initarg :next-client-id
+ :type integer
+ :initform 1
+ :documentation
+ "")
+ (next-user-id :initarg :next-user-id
+ :type integer
+ :initform 1
+ :documentation
+ "")
+ (contexts :initarg :contexts
+ :type hash-table
+ :documentation
+ ""))
+ "Class rudel-obby-server ")
+
+(defmethod initialize-instance ((this rudel-obby-server) &rest slots)
+ ""
+ (when (next-method-p)
+ (call-next-method))
+
+ (with-slots (contexts) this
+ (setq contexts (make-hash-table :test 'equal))))
+
+(defmethod rudel-end ((this rudel-obby-server))
+ ""
+ (rudel-disconnect this))
+
+(defmethod rudel-broadcast ((this rudel-obby-server)
+ receivers name &rest arguments)
+ "Send a message of type NAME with arguments ARGUMENTS to RECEIVERS.
+
+RECEIVERS can be a object derived from rudel-obby-client, a list
+of such objects or a list with car 'exclude and cdr a list of
+such objects derived from rudel-obby-client."
+ ;; Construct list of receivers.
+ (let ((receiver-list
+ (cond
+ ;; If RECEIVERS is nil, the message should be broadcast to
+ ;; all clients.
+ ((null receivers) (oref this :clients))
+ ;; If RECEIVERS is a (non-empty) list of rudel-obby-client
+ ;; (or derived) objects, treat it as a list of receivers.
+ ((and (listp receivers)
+ (rudel-obby-client-child-p (car receivers)))
+ receivers)
+ ;; If RECEIVERS is a (non-empty) list with cdr equal to
+ ;; 'exclude treat it as a list of receivers to exclude.
+ ((and (listp receivers)
+ (eq (car receivers) 'exclude))
+ (with-slots (clients) this
+ (set-difference clients (cdr receivers)
+ :key #'rudel-id)))
+ ;; If RECEIVERS is a single rudel-obby-client (or derived)
+ ;; object, send the message to that client.
+ ((rudel-obby-client-child-p receivers)
+ (list receivers))
+ ;;
+ (t (signal 'wrong-type-argument (type-of receivers))))))
+
+ ;; Send message to receivers.
+ (dolist (receiver receiver-list)
+ (apply #'rudel-send receiver name arguments)))
+ )
+
+(defmethod rudel-make-user ((this rudel-obby-server)
+ name client-id color encryption)
+ ""
+ (with-slots (next-user-id) this
+ (let ((user (rudel-obby-user name
+ :color color
+ :client-id client-id
+ :user-id next-user-id
+ :connected t
+ :encryption encryption)))
+ (incf next-user-id)
+ user))
+ )
+
+(defmethod rudel-check-username-and-color ((this rudel-obby-server)
+ username color)
+ "Check whether USERNAME and COLOR are valid.
+USERNAME must not be empty and must not be used by another
+user. COLOR has to be sufficiently different from used colors."
+ (cond
+ ;; The empty user name is not allowed
+ ((string= username "")
+ rudel-obby-error-username-invalid)
+
+ ;; Make sure the user name is not already in use.
+ ((rudel-find-user this username
+ #'string= #'object-name-string)
+ rudel-obby-error-username-in-use)
+
+ ;; Make sure the color is sufficiently dissimilar to all used
+ ;; colors.
+ ((rudel-find-user this color
+ (lambda (left right)
+ (< (color-distance left right) 20000)) ;; TODO constant
+ #'rudel-color)
+ rudel-obby-error-color-in-use))
+ )
+
+(defmethod rudel-add-client ((this rudel-obby-server)
+ client-socket)
+ ""
+ (with-slots (next-client-id clients) this
+ (let ((client (rudel-obby-client (process-name client-socket)
+ :server this
+ :socket client-socket
+ :id next-client-id
+ :encryption nil)))
+ (push client clients))
+ (incf next-client-id))
+ )
+
+(defmethod rudel-remove-client ((this rudel-obby-server)
+ client)
+ ""
+ (with-slots ((client-id :id) user) client
+ ;; Broadcast the part event to all remaining clients.
+ (rudel-broadcast this (list 'exclude client)
+ "net6_client_part"
+ (format "%x" client-id))
+
+ ;; If the client has an associated user object, set the status of
+ ;; the user object to offline.
+ (when user
+ ;; Set slot value.
+ (with-slots (connected) user
+ (setq connected nil))
+
+ ;; Run change hook.
+ (object-run-hook-with-args user 'change-hook)))
+
+ (object-remove-from-list this :clients client)
+ )
+
+(defmethod rudel-find-context ((this rudel-obby-server) client document)
+ "Return the jupiter context associated to (CLIENT DOCUMENT) in THIS."
+ (with-slots (contexts) this
+ (gethash (rudel-obby-context-key client document) contexts)))
+
+(defmethod rudel-add-context ((this rudel-obby-server) client document)
+ "Add a jupiter context for (CLIENT DOCUMENT) to THIS."
+ (with-slots (contexts) this
+ (with-slots ((client-id :id)) client
+ (with-slots ((doc-name :object-name)) document
+ (puthash
+ (rudel-obby-context-key client document)
+ (jupiter-context (format "%d-%s" client-id doc-name))
+ contexts))))
+ )
+
+(defmethod rudel-remove-context ((this rudel-obby-server) client document)
+ "Remove the jupiter context associated to (CLIENT DOCUMENT) from THIS."
+ (with-slots (contexts) this
+ (remhash
+ (rudel-obby-context-key client document)
+ contexts)))
+
+(defun rudel-obby-context-key (client document)
+ "Generate hash key based on CLIENT and DOCUMENT."
+ (with-slots ((client-id :id)) client
+ (with-slots ((doc-id :id)) document
+ (list client-id doc-id))))
+
+(defmethod object-print ((this rudel-obby-server) &rest strings)
+ "Print THIS with number of clients."
+ (with-slots (clients) this
+ (apply #'call-next-method
+ this
+ (format " clients: %d"
+ (length clients))
+ strings))
+ )
+
+(provide 'rudel-obby-server)
+;;; rudel-obby-server.el ends here
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-06 11:13:02 +0000