SourceForge.net

CommunityJobsHelp
RSS

(root)/rudel/branches/0.2 : 239 : obby/rudel-obby-server.el

« back to all changes in this revision

Viewing changes to obby/rudel-obby-server.el

jan
2009-09-27 23:21:35
Revision ID: svn-v4:5a4003a7-c908-0410-aaae-b88a393cf3eb:prog/rudel/trunk:2355
* obby/rudel-obby-server.el (header): better documentation
  (require rudel-state-machine): now required for state machine style
  handling of client connections
  (require rudel-obby-state): now required; provides base class for
  states
  (rudel-obby-server-state-new): new class; client connection state
  new
  (rudel-obby-server-state-encryption-negotiate): new class; client
  connection state for negotiating encryption
  (rudel-obby-server-state-before-join): new class; client connection
  state for waiting for login request
  (rudel-obby-server-state-new): new class; client connection state
  entered after session setup and joining is complete
  (rudel-obby-server-connection-states): new variable; list of states
  and their symbolic names
  (rudel-obby-client): now derived from rudel-state-machine
closes: #18

Show diffs side-by-side

added added

removed removed

obby/rudel-obby-server.el
25
25
;;; Commentary:
26
26
;;
27
27
;; This file contains the server part of the obby backend for Rudel.
 
28
;;
 
29
;; It is implemented using one state machine (class
 
30
;; `rudel-obby-client') for each client connection. These state
 
31
;; machines have the following states:
 
32
;;
 
33
;; + new                  `rudel-obby-server-state-new'
 
34
;; + encryption-negotiate `rudel-obby-server-state-encryption-negotiate'
 
35
;; + before-join          `rudel-obby-server-state-before-join'
 
36
;; + idle                 `rudel-obby-server-state-idle'
28
37
 
29
38
 
30
39
;;; History:
31
40
;;
32
 
;; 0.1 - initial revision.
 
41
;; 0.2 - State machine.
 
42
;;
 
43
;; 0.1 - Initial revision.
33
44
 
34
45
 
35
46
;;; Code:
42
53
 
43
54
(require 'jupiter)
44
55
 
 
56
(require 'rudel-state-machine)
 
57
 
45
58
(require 'rudel-obby-errors)
46
59
(require 'rudel-obby-util)
 
60
(require 'rudel-obby-state)
47
61
 
48
62
 
49
 
;;; Class rudel-obby-client
 
63
;;; Class rudel-obby-server-state-new
50
64
;;
51
65
 
52
 
(defclass rudel-obby-client (rudel-obby-socket-owner)
53
 
  ((server     :initarg  :server
54
 
               :type     rudel-obby-server
55
 
               :documentation
56
 
               "")
57
 
   (id         :initarg  :id
58
 
               :type     integer
59
 
               :accessor rudel-id
60
 
               :documentation
61
 
               "")
62
 
   (user       :initarg  :user
63
 
               :type     (or rudel-obby-user null)
64
 
               :initform nil
65
 
               :documentation
66
 
               "")
67
 
   (encryption :initarg  :encryption
68
 
               :type     boolean
69
 
               :documentation
70
 
               ""))
71
 
  "Each object of this class represents one client, that is
72
 
connected to the server. This object handles all direct
73
 
communication with the client, while broadcast messages are
74
 
handled by the server.")
 
66
(defclass rudel-obby-server-state-new
 
67
  (rudel-obby-server-connection-state)
 
68
  ()
 
69
  "State in which new connections start out.")
75
70
 
76
 
(defmethod initialize-instance :after ((this rudel-obby-client) &rest slots)
 
71
(defmethod rudel-enter ((this rudel-obby-server-state-new))
77
72
  "Sends welcome messages to the client and starts the session
78
73
timeout timer."
79
74
  ;; Send greeting sequence to the client.
80
 
  (with-slots (socket) this
81
 
    (rudel-send this
82
 
                "obby_welcome"
83
 
                (number-to-string rudel-obby-protocol-version))
84
 
    (rudel-send this "net6_encryption" "0"))
85
 
  )
86
 
 
87
 
(defmethod rudel-end ((this rudel-obby-client))
88
 
  ""
89
 
  (rudel-disconnect this))
90
 
 
91
 
(defmethod rudel-close ((this rudel-obby-client))
92
 
  ""
93
 
  (with-slots (server) this
94
 
    (rudel-remove-client server this)))
95
 
 
96
 
(defmethod rudel-message ((this rudel-obby-client) message)
97
 
  "Dispatch MESSAGE to appropriate handler method of THIS object.
98
 
If there is no suitable method, generate a warning, but do
99
 
nothing else."
100
 
  ;; Dispatch message to handler
101
 
  (let ((name      (car message))
102
 
        (arguments (cdr message)))
103
 
    (rudel-obby-dispatch this name arguments)))
104
 
 
105
 
(defmethod rudel-broadcast ((this rudel-obby-client)
106
 
                            receivers name &rest arguments)
107
 
  "Broadcast message NAME with arguments ARGUMENTS to RECEIVERS."
108
 
  (with-slots (server) this
109
 
    (apply #'rudel-broadcast server receivers name arguments)))
110
 
 
111
 
(defmethod rudel-obby/net6_encryption_ok ((this rudel-obby-client))
112
 
  "Handle 'net6_encryption_ok' message.
 
75
  (rudel-send this
 
76
              "obby_welcome"
 
77
              (number-to-string rudel-obby-protocol-version))
 
78
 
 
79
  ;; Switch to encryption negotiation state.
 
80
  'encryption-negotiate)
 
81
 
 
82
 
 
83
;;; Class rudel-obby-server-state-encryption-negotiate
 
84
;;
 
85
 
 
86
(defclass rudel-obby-server-state-encryption-negotiate
 
87
  (rudel-obby-server-connection-state)
 
88
  ()
 
89
  "Encryption negotiation state.")
 
90
 
 
91
(defmethod rudel-enter ((this rudel-obby-server-state-encryption-negotiate))
 
92
  "Send net6 'encryption' message requesting to not enable encryption."
 
93
  (rudel-send this "net6_encryption" "0")
 
94
  nil)
 
95
 
 
96
(defmethod rudel-obby/net6_encryption_ok
 
97
  ((this rudel-obby-server-state-encryption-negotiate))
 
98
  "Handle net6 'encryption_ok' message.
113
99
Even if the client requests an encrypted connection, we cancel
114
100
the negotiation."
115
 
  (rudel-send this "net6_encryption_failed"))
 
101
  (rudel-send this "net6_encryption_failed")
 
102
  'before-join)
116
103
 
117
 
(defmethod rudel-obby/net6_encryption_failed ((this rudel-obby-client))
118
 
  "Handle 'net6_encryption_failed' message.
 
104
(defmethod rudel-obby/net6_encryption_failed
 
105
  ((this rudel-obby-server-state-encryption-negotiate))
 
106
  "Handle net6 'encryption_failed' message.
119
107
No action has to be taken, since the client simply proceeds after
120
 
failed encryption negotiation.")
121
 
 
122
 
(defmethod rudel-obby/net6_client_login ((this rudel-obby-client)
123
 
                                         username color)
124
 
  "Handle 'net6_client_login' message."
 
108
failed encryption negotiation."
 
109
  'before-join)
 
110
 
 
111
 
 
112
;;; Class rudel-obby-server-state-before-join
 
113
;;
 
114
 
 
115
(defclass rudel-obby-server-state-before-join
 
116
  (rudel-obby-server-connection-state)
 
117
  ()
 
118
  "Waiting for client request joining the session.")
 
119
 
 
120
(defmethod rudel-obby/net6_client_login
 
121
  ((this rudel-obby-server-state-before-join) username color)
 
122
  "Handle net6 'client_login' message."
125
123
  (with-parsed-arguments ((color color))
126
 
    (with-slots (server (client-id :id) user encryption) this
 
124
    (with-slots (server
 
125
                 (client-id :id)
 
126
                 user
 
127
                 encryption) (oref this :connection)
127
128
      ;; Make sure USERNAME and COLOR are valid.
128
129
      (let ((error (rudel-check-username-and-color
129
130
                    server username color)))
130
131
        (if error
131
132
            ;; If USERNAME or COLOR are invalid, send the error code
132
 
            ;; to the client.
133
 
            (rudel-send this
134
 
                        "net6_login_failed"
135
 
                        (format "%x" error))
 
133
            ;; to the client and stay in the current state.
 
134
            (progn
 
135
              (rudel-send this
 
136
                          "net6_login_failed"
 
137
                          (format "%x" error))
 
138
              nil)
136
139
 
137
140
          ;; Create a user object for this client and add it to the
138
141
          ;; server.
139
142
          (setq user (rudel-make-user
140
143
                      server
141
144
                      username client-id color encryption))
142
 
 
143
145
          (rudel-add-user server user)
144
146
 
145
147
          ;; Broadcast the join event to all clients (including the
146
148
          ;; new one).
147
149
          (with-slots ((name :object-name) color (user-id :user-id)) user
148
 
            (rudel-broadcast this (list 'exclude this)
 
150
            (rudel-broadcast this (list 'exclude (oref this :connection))
149
151
                             "net6_client_join"
150
152
                             (format "%x" client-id)
151
153
                             name
169
171
            ;; Transmit list of connected users.
170
172
            (dolist (client clients)
171
173
              (with-slots ((client-id :id) user) client
172
 
                (with-slots ((name    :object-name)
173
 
                             color
174
 
                             (user-id :user-id)) user
175
 
                  (rudel-send this
176
 
                              "net6_client_join"
177
 
                              (format "%x" client-id)
178
 
                              name
179
 
                              "0"
180
 
                              (format "%x" user-id)
181
 
                              (rudel-obby-format-color color)))))
 
174
                (when user
 
175
                  (with-slots ((name    :object-name)
 
176
                               color
 
177
                               (user-id :user-id)) user
 
178
                    (rudel-send this
 
179
                                "net6_client_join"
 
180
                                (format "%x" client-id)
 
181
                                name
 
182
                                "0"
 
183
                                (format "%x" user-id)
 
184
                                (rudel-obby-format-color color))))))
182
185
 
183
186
            ;; Transmit list of disconnected users.
184
187
            (let ((offline-users (remove-if #'rudel-connected users)))
206
209
                       (format "%x" suffix)
207
210
                       "UTF-8"
208
211
                       (mapcar
209
 
                        (lambda (user-) ;; TODO we could use `user' here, but there is a bug in cl
210
 
                          (format "%x" (rudel-id user-)))
211
 
                        subscribed))))
 
212
                        (lambda (user1) ;; TODO we could use `user' here, but there is a bug in cl
 
213
                          (format "%x" (rudel-id user1)))
 
214
                        subscribed)))))
212
215
 
213
 
            (rudel-send this "obby_sync_final"))))))
 
216
          (rudel-send this "obby_sync_final")
 
217
          'idle))))
214
218
  )
215
219
 
216
 
(defmethod rudel-obby/obby_user_colour ((this rudel-obby-client)
217
 
                                        color-)
218
 
  "Handle 'obby_user_colour' message.
 
220
 
 
221
;;; Class rudel-obby-server-state-idle
 
222
;;
 
223
 
 
224
(defclass rudel-obby-server-state-idle
 
225
  (rudel-obby-server-connection-state)
 
226
  ()
 
227
  "Idle state of a server connection.
 
228
 
 
229
The connection enters this state when all setup work is finished,
 
230
the client has joined the session and no operation is in
 
231
progress. In this state, the connection waits for new messages
 
232
from the client that initiate operations. Simple (which means
 
233
stateless in this case) operations are performed without leaving
 
234
the idle state.")
 
235
 
 
236
(defmethod rudel-obby/obby_user_colour
 
237
  ((this rudel-obby-server-state-idle) color-)
 
238
  "Handle obby 'user_colour' message.
219
239
This method is called when the connected user requests a change
220
240
of her color to COLOR."
221
241
  (with-parsed-arguments ((color- color))
222
 
    (with-slots (user) this
 
242
    (with-slots (user) (oref this :connection)
223
243
      (with-slots (color (user-id :user-id)) user
224
244
        ;; Set color slot value.
225
245
        (setq color color-)
227
247
        ;; Run change hook.
228
248
        (object-run-hook-with-args user 'change-hook)
229
249
 
230
 
        (rudel-broadcast this (list 'exclude this)
 
250
        (rudel-broadcast this (list 'exclude (oref this :connection))
231
251
                         "obby_user_colour"
232
252
                         (format "%x" user-id)
233
253
                         (rudel-obby-format-color color)))))
234
 
  )
 
254
  nil)
235
255
 
236
 
(defmethod rudel-obby/obby_document_create ((this rudel-obby-client)
237
 
                                            doc-id name encoding content)
 
256
(defmethod rudel-obby/obby_document_create
 
257
  ((this rudel-obby-server-state-idle)
 
258
   doc-id name encoding content)
238
259
  "Handle obby 'document_create' message."
239
260
  (with-parsed-arguments ((doc-id   number)
240
261
                          (encoding coding-system))
241
 
    (with-slots (user server) this
 
262
    (with-slots (user server) (oref this :connection)
242
263
      (with-slots ((user-id :user-id)) user
243
264
        ;; Create a (hidden) buffer for the new document.
244
 
        (let* ((buffer   (get-buffer-create
245
 
                          (generate-new-buffer-name
246
 
                           (concat " *" name "*"))))
 
265
        (let* ((buffer         (get-buffer-create
 
266
                                (generate-new-buffer-name
 
267
                                 (concat " *"  name "*"))))
247
268
               ;; Create the new document object
248
 
               (document (rudel-obby-document
249
 
                          name
250
 
                          :buffer     buffer
251
 
                          :subscribed (list user)
252
 
                          :id         doc-id
253
 
                          :owner-id   user-id
254
 
                          :suffix     1)))
 
269
               (document       (rudel-obby-document
 
270
                                name
 
271
                                :buffer     buffer
 
272
                                :subscribed (list user)
 
273
                                :id         doc-id
 
274
                                :owner-id   user-id
 
275
                                :suffix     1)))
255
276
 
256
277
          ;; Initialize the buffer's content
257
278
          (with-current-buffer buffer
281
302
                          (format "%x" suffix)))
282
303
 
283
304
            ;; Notify other clients of the new document
284
 
            (rudel-broadcast this (list 'exclude this)
 
305
            (rudel-broadcast this (list 'exclude  (oref this :connection))
285
306
                             "obby_document_create"
286
307
                             (format "%x" user-id)
287
308
                             (format "%x" doc-id)
290
311
                             (upcase (symbol-name encoding))))
291
312
 
292
313
          ;; Add a jupiter context for (THIS DOCUMENT).
293
 
          (rudel-add-context server this document)))))
 
314
          (rudel-add-context server (oref this :connection) document))))
 
315
    nil)
294
316
  )
295
317
 
296
 
(defmethod rudel-obby/obby_document ((this rudel-obby-client)
297
 
                                     doc-id action &rest arguments)
 
318
(defmethod rudel-obby/obby_document
 
319
  ((this rudel-obby-server-state-idle) doc-id action &rest arguments)
298
320
  "Handle obby 'document' messages."
299
321
  (with-parsed-arguments ((doc-id document-id))
300
322
    ;; Locate the document based on owner id and document id
301
 
    (let ((document (with-slots (server) this
 
323
    (let ((document (with-slots (server) (oref this :connection)
302
324
                      (rudel-find-document server doc-id
303
325
                                           #'equal #'rudel-both-ids))))
304
326
      (rudel-obby-dispatch this action
306
328
                           "rudel-obby/obby_document/")))
307
329
  )
308
330
 
309
 
(defmethod rudel-obby/obby_document/subscribe ((this rudel-obby-client)
310
 
                                               document user-id)
 
331
(defmethod rudel-obby/obby_document/subscribe
 
332
  ((this rudel-obby-server-state-idle) document user-id)
311
333
  "Handle 'subscribe' submessage of obby 'document' message."
312
334
  (with-parsed-arguments ((user-id number))
313
 
    (let ((user (with-slots (server) this
 
335
    (let ((user (with-slots (server) (oref this :connection)
314
336
                  (rudel-find-user server user-id
315
337
                                   #'= #'rudel-id))))
316
338
      (with-slots (owner-id (doc-id :id) subscribed buffer) document
354
376
                           (format "%x" user-id)))))
355
377
 
356
378
    ;; Add a jupiter context for (THIS document).
357
 
    (with-slots (server) this
358
 
      (rudel-add-context server this document)))
 
379
    (with-slots (server) (oref this :connection)
 
380
      (rudel-add-context server (oref this :connection) document))
 
381
    nil)
359
382
  )
360
383
 
361
 
(defmethod rudel-obby/obby_document/unsubscribe ((this rudel-obby-client)
362
 
                                                 document user-id)
 
384
(defmethod rudel-obby/obby_document/unsubscribe
 
385
  ((this rudel-obby-server-state-idle) document user-id)
363
386
  "Handle 'unsubscribe' submessage of 'obby_document' message."
364
387
  (with-parsed-arguments ((user-id number))
365
 
    (let ((user (with-slots (server) this
 
388
    (let ((user (with-slots (server) (oref this :connection)
366
389
                  (rudel-find-user server user-id
367
390
                                   #'= #'rudel-id))))
368
391
      (with-slots (owner-id (doc-id :id) subscribed) document
383
406
                           (format "%x" user-id))))
384
407
 
385
408
      ;; Remove jupiter context for (THIS DOCUMENT).
386
 
      (with-slots (server) this
387
 
        (rudel-remove-context server this document))))
 
409
      (with-slots (server) (oref this :connection)
 
410
        (rudel-remove-context server (oref this :connection) document)))
 
411
    nil)
388
412
  )
389
413
 
390
 
(defmethod rudel-obby/obby_document/record ((this rudel-obby-client)
391
 
                                            document
392
 
                                            local-revision remote-revision
393
 
                                            action &rest arguments)
 
414
(defmethod rudel-obby/obby_document/record
 
415
  ((this rudel-obby-server-state-idle)
 
416
   document local-revision remote-revision action &rest arguments)
394
417
  "Handle 'record' submessages of 'obby_document' message."
395
418
  (with-parsed-arguments ((local-revision  number)
396
419
                          (remote-revision number))
402
425
     "rudel-obby/obby_document/record/"))
403
426
  )
404
427
 
405
 
(defmethod rudel-obby/obby_document/record/ins ((this rudel-obby-client)
406
 
                                                document
407
 
                                                local-revision remote-revision
408
 
                                                position data)
 
428
(defmethod rudel-obby/obby_document/record/ins
 
429
  ((this rudel-obby-server-state-idle)
 
430
   document local-revision remote-revision position data)
409
431
  "Handle 'ins' submessage of 'record' submessages of 'obby_document' message."
410
432
  (with-parsed-arguments ((position number))
411
433
    ;; Construct the operation object and process it.
412
 
    (rudel-remote-operation this document
 
434
    (rudel-remote-operation
 
435
     (oref this :connection) document
413
436
     remote-revision local-revision
414
437
     (jupiter-insert
415
438
      (format "insert-%d-%d"
416
439
              remote-revision local-revision)
417
440
      :from position
418
 
      :data data)))
 
441
      :data data))
 
442
    nil)
419
443
  )
420
444
 
421
 
(defmethod rudel-obby/obby_document/record/del ((this rudel-obby-client)
422
 
                                                document
423
 
                                                local-revision remote-revision
424
 
                                                position length)
 
445
(defmethod rudel-obby/obby_document/record/del
 
446
  ((this rudel-obby-server-state-idle)
 
447
   document local-revision remote-revision position length)
425
448
  "Handle 'del' submessage of 'record' submessages of 'obby_document' message."
426
449
  (with-parsed-arguments ((position number)
427
450
                          (length   number))
428
451
    ;; Construct the operation object and process it.
429
 
    (rudel-remote-operation this document
 
452
    (rudel-remote-operation
 
453
     (oref this :connection) document
430
454
     remote-revision local-revision
431
455
     (jupiter-delete
432
456
      (format "delete-%d-%d"
433
457
              remote-revision local-revision)
434
458
      :from position
435
 
      :to   (+ position length))))
436
 
  )
 
459
      :to   (+ position length)))
 
460
    nil)
 
461
  )
 
462
 
 
463
 
 
464
;;; Client connection states.
 
465
;;
 
466
 
 
467
(defvar rudel-obby-server-connection-states
 
468
  '((new                  . rudel-obby-server-state-new)
 
469
    (encryption-negotiate . rudel-obby-server-state-encryption-negotiate)
 
470
    (before-join          . rudel-obby-server-state-before-join)
 
471
    (idle                 . rudel-obby-server-state-idle))
 
472
  "Name symbols and classes of connection states.")
 
473
 
 
474
 
 
475
;;; Class rudel-obby-client
 
476
;;
 
477
 
 
478
(defclass rudel-obby-client (rudel-obby-socket-owner
 
479
                             rudel-state-machine)
 
480
  ((server     :initarg  :server
 
481
               :type     rudel-obby-server
 
482
               :documentation
 
483
               "")
 
484
   (id         :initarg  :id
 
485
               :type     integer
 
486
               :accessor rudel-id
 
487
               :documentation
 
488
               "")
 
489
   (user       :initarg  :user
 
490
               :type     (or rudel-obby-user null)
 
491
               :initform nil
 
492
               :documentation
 
493
               "")
 
494
   (encryption :initarg  :encryption
 
495
               :type     boolean
 
496
               :documentation
 
497
               ""))
 
498
  "Each object of this class represents one client, that is
 
499
connected to the server. This object handles all direct
 
500
communication with the client, while broadcast messages are
 
501
handled by the server.")
 
502
 
 
503
(defmethod initialize-instance ((this rudel-obby-client) &rest slots)
 
504
  "Initialize slots of THIS and register state machine states."
 
505
  ;; Initialize slots of THIS
 
506
  (when (next-method-p)
 
507
    (call-next-method))
 
508
 
 
509
  ;; Register states.
 
510
  (rudel-register-states this rudel-obby-server-connection-states)
 
511
  )
 
512
 
 
513
(defmethod rudel-register-state ((this rudel-obby-client) symbol state)
 
514
  "Register SYMBOL and STATE and set connection slot of STATE."
 
515
  ;; Associate THIS connection to STATE.
 
516
  (oset state :connection this)
 
517
 
 
518
  ;; Register STATE.
 
519
  (call-next-method))
 
520
 
 
521
(defmethod rudel-end ((this rudel-obby-client))
 
522
  ""
 
523
  (rudel-disconnect this))
 
524
 
 
525
(defmethod rudel-close ((this rudel-obby-client))
 
526
  ""
 
527
  (with-slots (server) this
 
528
    (rudel-remove-client server this)))
 
529
 
 
530
(defmethod rudel-message ((this rudel-obby-client) message)
 
531
  "Dispatch MESSAGE to the active state of THIS state machine."
 
532
  ;; Dispatch message to state
 
533
  (rudel-accept this message))
 
534
 
 
535
(defmethod rudel-broadcast ((this rudel-obby-client)
 
536
                            receivers name &rest arguments)
 
537
  "Broadcast message NAME with arguments ARGUMENTS to RECEIVERS."
 
538
  (with-slots (server) this
 
539
    (apply #'rudel-broadcast server receivers name arguments)))
437
540
 
438
541
(defmethod rudel-remote-operation ((this rudel-obby-client)
439
542
                                   document

Loggerhead 1.17 is a web-based interface for Bazaar branches


Copyright 1999-2009 - Geeknet, Inc., All Rights Reserved
Feedback Legal Help