introduce session objects

diff --git a/empire.lisp b/empire.lisp
index 7ef68bfc3506f1e4f9fe3a487b0e376b79d6df95..6d756a97fc93ddab8ba9a3ed7aa3d52754017c99 100644 (file)
--- a/empire.lisp
+++ b/empire.lisp
@@ -46,7 +46,11 @@ this stream.")
    (mode
     :accessor connection-mode
     :initform nil
    (mode
     :accessor connection-mode
     :initform nil

-    :documentation "TODO(gefla)")))
+    :documentation "TODO(gefla)")
+   (session
+    :accessor session
+    :initarg :session
+    :documentation "web session to which this connection belongs")))

 
 (defun make-connection (&key (user nil)
                        (password nil)
 
 (defun make-connection (&key (user nil)
                        (password nil)


@@ -54,7 +58,8 @@ this stream.")
                        (server-port *default-empire-server-port*)
                        (socket nil)
                        (network-stream nil)
                        (server-port *default-empire-server-port*)
                        (socket nil)
                        (network-stream nil)

-                       (logging-stream nil))
+                       (logging-stream nil)
+                       session)

   (make-instance 'connection
                 :user user
                 :password password
   (make-instance 'connection
                 :user user
                 :password password


@@ -62,14 +67,16 @@ this stream.")
                 :server-port server-port
                 :socket socket
                 :stream network-stream
                 :server-port server-port
                 :socket socket
                 :stream network-stream

-                :logging-stream logging-stream))
+                :logging-stream logging-stream
+                :session session))

 
 ;;; interface
 (defun connect  (&key (user nil)
                 (password nil)
                 (server-name *default-empire-server*)
                 (server-port *default-empire-server-port*)
 
 ;;; interface
 (defun connect  (&key (user nil)
                 (password nil)
                 (server-name *default-empire-server*)
                 (server-port *default-empire-server-port*)

-                (logging-stream *standard-output*))
+                (logging-stream *standard-output*)
+                session)

   "Connect to server and return a connection object."
   (let* ((socket (usocket:socket-connect server-name server-port))
          (stream (usocket:socket-stream socket))
   "Connect to server and return a connection object."
   (let* ((socket (usocket:socket-connect server-name server-port))
          (stream (usocket:socket-stream socket))


@@ -79,7 +86,8 @@ this stream.")
                                       :network-stream stream
                                       :logging-stream logging-stream
                                       :server-name server-name
                                       :network-stream stream
                                       :logging-stream logging-stream
                                       :server-name server-name

-                                     :server-port server-port))
+                                     :server-port server-port
+                                     :session session))

         (handler (spawn-with-name (format nil "empire-handler-~a" user)
                                   #'handle-connection connection)))
     (setf (connection-handler connection) handler)
         (handler (spawn-with-name (format nil "empire-handler-~a" user)
                                   #'handle-connection connection)))
     (setf (connection-handler connection) handler)


@@ -137,6 +145,10 @@ this stream.")
          (setf play-sent-p t))
        (set-new-mode m 'play-mode))))
 
          (setf play-sent-p t))
        (set-new-mode m 'play-mode))))
 

+(defmethod handle-exit ((m init-mode) message)
+  (declare (ignorable message))
+  (quit (connection m)))
+

 (defmethod handle-exit ((m play-mode) message)
   (declare (ignorable message))
   (quit (connection m)))
 (defmethod handle-exit ((m play-mode) message)
   (declare (ignorable message))
   (quit (connection m)))


@@ -145,7 +157,7 @@ this stream.")
   (let* ((c (connection m))
         (log (logging-stream c)))
     (format log "handle-data ~a~%" message)
   (let* ((c (connection m))
         (log (logging-stream c)))
     (format log "handle-data ~a~%" message)

-    (empire-web:data message)))
+    (empire-web:data (session c) message)))

 
 (defmethod handle-prompt ((m play-mode) message)
   (let* ((c (connection m))
 
 (defmethod handle-prompt ((m play-mode) message)
   (let* ((c (connection m))


@@ -154,7 +166,7 @@ this stream.")
       (let* ((minutes (read s)) ;;FIXME DANGEROUS
             (btus (read s)))
        (format log "[~a:~a]: ~%" minutes btus)
       (let* ((minutes (read s)) ;;FIXME DANGEROUS
             (btus (read s)))
        (format log "[~a:~a]: ~%" minutes btus)

-       (empire-web:prompt minutes btus)))))
+       (empire-web:prompt (session c) minutes btus)))))

 
 (defparameter *line-type-dispatch*
   (list `(,+C_DATA+ . handle-data)
 
 (defparameter *line-type-dispatch*
   (list `(,+C_DATA+ . handle-data)

diff --git a/package.lisp b/package.lisp
index 5cf8ad0cf40d6a31ad1cd51392dd4c5cea099e0c..a8e00266d080bdcb1c3400390fd3e878182b5691 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -8,8 +8,7 @@
 (eval-when (:execute :load-toplevel :compile-toplevel)
   (defpackage :empire
       (:use :cl)
 (eval-when (:execute :load-toplevel :compile-toplevel)
   (defpackage :empire
       (:use :cl)

-    (:export :read-message-loop
-             :read-message
+    (:export :session

             :make-connection
             :connect
             :send-message))
             :make-connection
             :connect
             :send-message))


@@ -19,4 +18,3 @@
   (defpackage :empire-web
     (:use :cl :hunchentoot)
     (:export :start :send :prompt :data)))
   (defpackage :empire-web
     (:use :cl :hunchentoot)
     (:export :start :send :prompt :data)))

-

diff --git a/web.lisp b/web.lisp
index 5c186c95f549f3cf0bf5d69409f7ff5d7d6853e6..e648f319f150cd1804c91ffddac05b5431c6a17e 100644 (file)
--- a/web.lisp
+++ b/web.lisp
@@ -31,41 +31,61 @@
          (fullname (concatenate 'string +static-files-root+ fname)))
     (handle-static-file fullname)))
 
          (fullname (concatenate 'string +static-files-root+ fname)))
     (handle-static-file fullname)))
 

-(defvar *update-queue* (locked-queue:create))
+(defclass session ()
+  ((update-queue
+    :accessor update-queue
+    :initform (locked-queue:create)
+    :documentation "Updates to be sent to the browser")
+   (connection
+   :accessor connection
+   :documentation "Connection to the empire game server")))
+
+(defun make-session (username password)
+  (let* ((session (make-instance 'session))
+        (connection (empire:connect :user username
+                                    :password password
+                                    :session session)))
+    (setf (slot-value session 'connection) connection)
+    session))
+
+(defgeneric send (session string))
+(defgeneric prompt (session minutes btus))
+(defgeneric data (session message))

 
 (defun update ()
   "Send stream of updates to client"
 
 (defun update ()
   "Send stream of updates to client"

-  (locked-queue:dequeue *update-queue*))
+  (let ((s (session-value `session)))
+    (locked-queue:dequeue (update-queue s))))

 
 

-(defun send (string)
+(defmethod send ((s session) string)

   "Push a javascript update fragment to the client."
   "Push a javascript update fragment to the client."

-  (locked-queue:enqueue *update-queue* string))
+  (locked-queue:enqueue (update-queue s) string))

 
 

-(defun prompt (minutes btus)
-  (send (format nil "prompt(~a,~a);~%" minutes btus)))
+(defmethod prompt ((s session) minutes btus)
+  (send s (format nil "prompt(~a,~a);~%" minutes btus)))

 
 

-(defun data (message)
-  (send (parenscript:ps* `(msg ,message))))
+(defmethod data ((s session) message)
+  (send s (parenscript:ps* `(msg ,message))))

 
 (defun login ()
 
 (defun login ()

-  (let ((connection (session-value 'connection)))
-    (if connection
+  (let ((s (session-value 'session)))
+    (if s

        (redirect +root-url+)
        (redirect +login-page+))))
 
 ;; destination of login-form
 (defun login-action ()
   (handler-case
        (redirect +root-url+)
        (redirect +login-page+))))
 
 ;; destination of login-form
 (defun login-action ()
   (handler-case

-      (let ((connection (empire:connect :user (post-parameter "username")
-                                       :password (post-parameter "password"))))
-       (setf (session-value 'connection) connection)
+      (let ((session (make-session (post-parameter "username")
+                                  (post-parameter "password"))))
+       (setf (session-value 'session) session)

        (redirect +root-url+))
     (usocket:connection-refused-error (e)
       (format nil "Connection error: ~a~%" e))))
 
 (defun command-action ()
        (redirect +root-url+))
     (usocket:connection-refused-error (e)
       (format nil "Connection error: ~a~%" e))))
 
 (defun command-action ()

-  (let ((connection (session-value 'connection)))
-    (empire:send-message connection (get-parameter "q"))))
+  (let ((s (session-value 'session)))
+    (empire:send-message (connection s) (get-parameter "q"))))

 
 (defun dispatch (request)
   (let ((script-name (script-name request)))
 
 (defun dispatch (request)
   (let ((script-name (script-name request)))