X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=6d756a97fc93ddab8ba9a3ed7aa3d52754017c99;hp=4797ac71e4817e424e26ad250c26ffab57d82ad5;hb=1bd48ef37e2267d788ab2721044d9d12129e9087;hpb=36b33da8ff346a9085d8459ad0e9dd6609b8f3f4 diff --git a/empire.lisp b/empire.lisp index 4797ac7..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) @@ -125,6 +133,7 @@ this stream.") (defgeneric handle-data (base-mode message)) (defgeneric handle-init (base-mode message)) +(defgeneric handle-exit (base-mode message)) (defgeneric handle-prompt (base-mode message)) (defmethod handle-init ((m init-mode) message) @@ -136,22 +145,33 @@ 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))) + (defmethod handle-data ((m play-mode) message) (let* ((c (connection m)) (log (logging-stream c))) - (format log "handle-data ~a~%" message))) + (format log "handle-data ~a~%" message) + (empire-web:data (session c) message))) (defmethod handle-prompt ((m play-mode) message) (let* ((c (connection m)) (log (logging-stream c))) (with-input-from-string (s message) - (let* ((minutes (read s)) + (let* ((minutes (read s)) ;;FIXME DANGEROUS (btus (read s))) - (format log "[~a:~a]: ~%" minutes btus))))) + (format log "[~a:~a]: ~%" minutes btus) + (empire-web:prompt (session c) minutes btus))))) (defparameter *line-type-dispatch* (list `(,+C_DATA+ . handle-data) `(,+C_INIT+ . handle-init) + `(,+C_EXIT+ . handle-exit) `(,+C_PROMPT+ . handle-prompt))) (defun parse-server-line (line) @@ -178,17 +198,19 @@ this stream.") (format stream "No handler for ~a in mode ~a." type mode))))) (defmethod read-message ((c connection)) - (let* ((s (network-stream c)) - (log (logging-stream c)) - (line (read-line s))) - (format log "< ~a~%" line) - (multiple-value-bind (message type) (parse-server-line line) - (let ((handler (lookup-handler type)) - (mode (connection-mode c))) - (if handler - (funcall handler mode message) - (error 'no-handler :mode mode :type type)))) - line)) + (handler-case + (let* ((s (network-stream c)) + (log (logging-stream c)) + (line (read-line s))) + (format log "< ~a~%" line) + (multiple-value-bind (message type) (parse-server-line line) + (let ((handler (lookup-handler type)) + (mode (connection-mode c))) + (if handler + (funcall handler mode message) + (error 'no-handler :mode mode :type type)))) + line) + (sb-int:closed-stream-error () nil))) (defmethod send-message ((c connection) message) (let ((s (network-stream c))