Permalink
Browse files

* socket/rudel-socket.el (rudel-socket-listener): new class;

  implements `rudel-listener'
  (rudel-tcp-backend::rudel-wait-for-connections): removed argument
  dispatch-callback; added argument info-callback; ensure info
  contains required properties; create a listener socket and pass it
  to a new listener object
* rudel.el (rudel-host-session): added argument info; generate empty
  info list in interactive form; create a listener object and pass it
  to the protocol backend
* rudel-transport.el (rudel-listener): new abstract class; generic
  functionality for accepting incoming connections
  (rudel-transport-backend::rudel-wait-for-connections): removed
  argument dispatch-callback; added argument info-callback; updated
  documentation string
* rudel-protocol.el (rudel-protocol-backend::rudel-ask-connect-info):
  added optional argument info; updated documentation string
  (rudel-protocol-backend::rudel-ask-host-info): added optional
  argument info; updated documentation string
* obby/rudel-obby.el (rudel-obby-backend::rudel-ask-host-info): added
  optional argument info
  (rudel-obby-backend::rudel-host): renamed
  argument`transport-backend' -> `listener'; do not install dispatch
  function; the server does this itself
* obby/rudel-obby-server.el (require rudel-obby): required to silence
  the byte-compiler
  (rudel-obby-server::listener): new slot; stores listener object of
  the server
  (rudel-obby-server::initialize-instance): install `rudel-add-client'
  into the listener as dispatch function
  • Loading branch information...
scymtym committed Dec 4, 2009
1 parent 2fd925d commit abb234379621262d0a2c9bb7a3af3ffb13c10edc
Showing with 157 additions and 70 deletions.
  1. +19 −2 obby/rudel-obby-server.el
  2. +6 −15 obby/rudel-obby.el
  3. +6 −2 rudel-protocol.el
  4. +30 −7 rudel-transport.el
  5. +23 −12 rudel.el
  6. +73 −32 socket/rudel-socket.el
View
@@ -60,6 +60,7 @@
(require 'rudel-obby-errors)
(require 'rudel-obby-util)
(require 'rudel-obby-state)
+(require 'rudel-obby) ;; for `rudel-obby-user' and `rudel-obby-document'
;;; Class rudel-obby-server-state-new
@@ -634,7 +635,12 @@ handled by the server.")
;;
(defclass rudel-obby-server (rudel-server-session)
- ((clients :initarg :clients
+ ((listener :initarg :listener
+ :type rudel-listener
+ :documentation
+ "The listener object that dispatches incoming
+connections to this server.")
+ (clients :initarg :clients
:type list
:initform nil
:documentation
@@ -657,11 +663,22 @@ handled by the server.")
(defmethod initialize-instance ((this rudel-obby-server) &rest slots)
""
+ ;; Initialize slots of THIS.
(when (next-method-p)
(call-next-method))
+ ;; Create a hash-table to store the contexts.
(with-slots (contexts) this
- (setq contexts (make-hash-table :test 'equal))))
+ (setq contexts (make-hash-table :test 'equal)))
+
+ ;; Dispatch incoming connections to our `rudel-add-client' method.
+ (with-slots (listener) this
+ (lexical-let ((this1 this))
+ (rudel-set-dispatcher
+ listener
+ (lambda (client-transport)
+ (rudel-add-client this1 client-transport)))))
+ )
(defmethod rudel-end ((this rudel-obby-server))
""
View
@@ -228,33 +228,24 @@ Return the connection object."
;; The connection is now usable; return it.
connection))
-(defmethod rudel-ask-host-info ((this rudel-obby-backend))
+(defmethod rudel-ask-host-info ((this rudel-obby-backend)
+ &optional info)
"Ask user for information required to host an obby session."
(let ((port (read-number "Port: " 6522)))
(list
:address "0.0.0.0"
:port port)))
-(defmethod rudel-host ((this rudel-obby-backend) transport-backend info)
+(defmethod rudel-host ((this rudel-obby-backend) listener info)
"Host an obby session using the information INFO.
Return the created server."
;; Before we start, we load the server functionality.
(require 'rudel-obby-server)
;; Construct and return the server object.
- (let ((server (rudel-obby-server
- "obby-server"
- :backend this)))
-
- ;; Dispatch incoming connections to SERVER.
- (lexical-let ((server1 server))
- (rudel-wait-for-connections
- transport-backend info
- (lambda (client-transport)
- (rudel-add-client server1 client-transport))))
-
- ;; Return the constructed server object.
- server))
+ (rudel-obby-server
+ "obby-server"
+ :listener listener))
(defmethod rudel-make-document ((this rudel-obby-backend)
name session)
View
@@ -58,8 +58,10 @@
"Interface implemented by protocol backends."
:abstract t)
-(defgeneric rudel-ask-connect-info ((this rudel-protocol-backend))
+(defgeneric rudel-ask-connect-info ((this rudel-protocol-backend)
+ &optional info)
"Retrieve information for joining a session from user.
+When INFO is non-nil, augment INFO to produce new list.
Return a property list that contains the collected information.")
(defgeneric rudel-connect ((this rudel-protocol-backend) transport
@@ -79,8 +81,10 @@ Implementations can rely on the fact that the property :session
in INFO contains the `rudel-session' object to which the new
connection will be associated.")
-(defgeneric rudel-ask-host-info ((this rudel-protocol-backend))
+(defgeneric rudel-ask-host-info ((this rudel-protocol-backend)
+ &optional info)
"Retrieve information for hosting a session from user.
+When INFO is non-nil, augment INFO to produce new list.
Return a property list that contains the collected information.")
(defgeneric rudel-host ((this rudel-protocol-backend) backend
View
@@ -84,6 +84,25 @@
"Start THIS.")
+;;; Class rudel-listener
+;;
+
+(defclass rudel-listener ()
+ ()
+ "Interface for listener objects.
+Listener objects wait for incoming connections and create
+transport objects representing such connections."
+:abstract t)
+
+(defgeneric rudel-set-dispatcher ((this rudel-listener) handler)
+ "Install HANDLER as dispatch function for incoming connections.
+HANDLER has to accept a single argument which will be a transport
+object representing the incoming connection.")
+
+(defgeneric rudel-close ((this rudel-listener))
+ "Cause THIS to stop listening for incoming connections.")
+
+
;;; Class rudel-transport-backend
;;
@@ -92,8 +111,8 @@
"Interface implemented by transport backends."
:abstract t)
-(defgeneric rudel-make-connection ((this rudel-transport-backend) info
- info-callback
+(defgeneric rudel-make-connection ((this rudel-transport-backend)
+ info info-callback
&optional progress-callback)
"Create a transport object according to INFO.
@@ -114,12 +133,16 @@ sense that it does not attempt to dispatch any data to the filter
function before `rudel-start' has been called.")
(defgeneric rudel-wait-for-connections ((this rudel-transport-backend)
- info dispatch-callback)
- "Create transport objects according to INFO for incoming connections.
+ info info-callback)
+ "Create and return listener object according to INFO.
+INFO has to be a property list specifying desired properties of
+the created listener.
-Call DISPATCH-CALLBACK each time a connection is
-established. DISPATCH-CALLBACK has to accept the created
-`rudel-transport' object as its only argument.")
+INFO-CALLBACK is called when the information provided in INFO is
+not sufficient for creating the requested listener. INFO-CALLBACK
+has to accept the backend object and a property list containing
+the current information and return a property list containing
+augmented information.")
(provide 'rudel-transport)
;;; rudel-transport.el ends here
View
@@ -860,23 +860,34 @@ will be prompted for."
session))
;;;###autoload
-(defun rudel-host-session ()
+(defun rudel-host-session (info)
"Host a collaborative editing session.
All data required to host a session will be prompted for
interactively."
- (interactive)
+ (interactive
+ ;; Empty info plist for now.
+ (list nil))
;; If necessary, ask the user for the backend we should use.
- (let* ((transport-backend (cdr (rudel-backend-choose
- 'transport
- (lambda (backend)
- (rudel-capable-of-p backend 'listen)))))
- (protocol-backend (cdr (rudel-backend-choose
- 'protocol
- (lambda (backend)
- (rudel-capable-of-p backend 'host)))))
- (info (rudel-ask-host-info protocol-backend)))
+ (let ((transport-backend (cdr (rudel-backend-choose
+ 'transport
+ (lambda (backend)
+ (rudel-capable-of-p backend 'listen)))))
+ (protocol-backend (cdr (rudel-backend-choose
+ 'protocol
+ (lambda (backend)
+ (rudel-capable-of-p backend 'host)))))
+ (listener))
+
+ ;; TODO temporary solution
+ (setq info (or info (rudel-ask-host-info protocol-backend info)))
+
+ ;;
+ (setq listener (rudel-wait-for-connections
+ transport-backend info #'ignore))
+
;; Create the session object.
- (rudel-host protocol-backend transport-backend info)))
+ (rudel-host protocol-backend listener info))
+ )
;;;###autoload
(defun rudel-end-session ()
View
@@ -100,6 +100,49 @@
(continue-process socket)))
+;;; Class rudel-socket-listener
+;;
+
+(defclass rudel-socket-listener (rudel-listener)
+ ((socket :initarg :socket
+ :type (or null process)
+ :initform nil
+ :documentation
+ "The server socket represented by this listener
+object.")
+ (dispatch :initarg :dispatch
+ :type (or null function)
+ :documentation
+ ""))
+ "")
+
+(defmethod rudel-set-dispatcher ((this rudel-socket-listener) handler)
+ "Install HANDLER as dispatch function for incoming connections.
+HANDLER has to accept a single argument which will be a transport
+object representing the incoming connection."
+ (oset this :dispatch handler))
+
+(defmethod rudel-close ((this rudel-socket-listener))
+ "Make THIS stop listening for incoming connections."
+ (with-slots (socket) this
+ (delete-process socket)))
+
+(defmethod rudel-handle-connect ((this rudel-socket-listener) socket)
+ "Handle incoming connection SOCKET."
+ (with-slots (dispatch) this
+ (when dispatch
+ ;; Wrap SOCKET in a transport object. Pass the constructed
+ ;; object to the dispatch function.
+ (let ((transport (rudel-socket-transport
+ (format
+ "TCP from %s"
+ (format-network-address
+ (process-contact socket :remote)))
+ :socket socket)))
+ (funcall dispatch transport))))
+ )
+
+
;;; Class rudel-tcp-backend
;;
@@ -142,39 +185,37 @@ and :port."
)
(defmethod rudel-wait-for-connections ((this rudel-tcp-backend)
- info dispatch-callback)
- "Create TCP server according to INFO, dispatch to DISPATCH-CALLBACK."
- ;; Extract information from INFO and create the socket.
- (let* ((address (plist-get info :address))
- (port (plist-get info :port)))
- ;; Create the network process
- (lexical-let ((dispatch-callback1 dispatch-callback))
- (apply
- #'make-network-process
- :name (format "TCP on %s" port)
- :service port
- :server t
- :filter #'ignore
- :sentinel #'ignore
- :log
- (lambda (server connection message)
- (rudel-tcp-handle-connect connection dispatch-callback1))
- (when address
- (list :host address)))))
- )
+ info info-callback)
+ "Create TCP server according to INFO.
+INFO has to be a property list containing the key :port."
+ ;; Ensure that INFO contains all necessary information.
+ (unless (every (lambda (keyword) (member keyword info))
+ '(:port))
+ (setq info (funcall info-callback this info)))
-(defun rudel-tcp-handle-connect (connection dispatch-callback)
- "Handle incoming connection CONNECTION and call DISPATCH-CALLBACK."
- ;; Wrap CONNECTION in a transport object. Pass the constructed
- ;; object to DISPATCH-CALLBACK.
- (let ((transport (rudel-socket-transport
- (format
- "TCP from %s"
- (format-network-address
- (process-contact connection :remote)))
- :socket connection)))
- (funcall dispatch-callback transport))
- )
+ ;; Extract information from INFO and create the socket.
+ (let* ((address (plist-get info :address))
+ (port (plist-get info :port))
+ ;; Create the listener object; without process for now.
+ (listener (rudel-socket-listener
+ (format "on %s:%s" (or address "*") port)))
+ ;; Create the network process.
+ (socket (lexical-let ((listener1 listener))
+ (apply
+ #'make-network-process
+ :name (format "TCP on %s" port)
+ :service port
+ :server t
+ :filter #'ignore
+ :sentinel #'ignore
+ :log
+ (lambda (server socket message)
+ (rudel-handle-connect listener1 socket))
+ (when address
+ (list :host address))))))
+ ;; Return the listener.
+ (oset listener :socket socket)
+ listener))
;;; Autoloading

0 comments on commit abb2343

Please sign in to comment.