From 1bd48ef37e2267d788ab2721044d9d12129e9087 Mon Sep 17 00:00:00 2001 From: Gerd Flaig Date: Sat, 20 Dec 2008 22:00:43 +0100 Subject: [PATCH] introduce session objects --- empire.lisp | 26 +++++++++++++++++++------- package.lisp | 4 +--- web.lisp | 50 +++++++++++++++++++++++++++++++++++--------------- 3 files changed, 55 insertions(+), 25 deletions(-) diff --git a/empire.lisp b/empire.lisp index 7ef68bf..6d756a9 100644 --- a/empire.lisp +++ b/empire.lisp @@ -46,7 +46,11 @@ this stream.") (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) @@ -54,7 +58,8 @@ this stream.") (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 @@ -62,14 +67,16 @@ this 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*) - (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)) @@ -79,7 +86,8 @@ this stream.") :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) @@ -137,6 +145,10 @@ this stream.") (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))) @@ -145,7 +157,7 @@ this stream.") (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)) @@ -154,7 +166,7 @@ this stream.") (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) diff --git a/package.lisp b/package.lisp index 5cf8ad0..a8e0026 100644 --- a/package.lisp +++ b/package.lisp @@ -8,8 +8,7 @@ (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :empire (:use :cl) - (:export :read-message-loop - :read-message + (:export :session :make-connection :connect :send-message)) @@ -19,4 +18,3 @@ (defpackage :empire-web (:use :cl :hunchentoot) (:export :start :send :prompt :data))) - diff --git a/web.lisp b/web.lisp index 5c186c9..e648f31 100644 --- a/web.lisp +++ b/web.lisp @@ -31,41 +31,61 @@ (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" - (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." - (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 () - (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 - (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 () - (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))) -- 2.43.0