X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=2a0c137a79684a8419573dff9a0e48cd3a6edafd;hp=7685f5582a7ff93d4ed2acf5d5a1713c690566fe;hb=c9ddb9951cd5e39280f14d1f316afb251db74087;hpb=ae10588ada2b32b3c715056b32c042fd221a534d diff --git a/empire.lisp b/empire.lisp index 7685f55..2a0c137 100644 --- a/empire.lisp +++ b/empire.lisp @@ -37,7 +37,7 @@ :initarg :logging-stream :accessor logging-stream :initform t - :documentation "Messages coming back from the server is sent to + :documentation "Messages coming back from the server are sent to this stream.") (connection-handler :accessor connection-handler @@ -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,17 +86,28 @@ 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) connection)) - (defgeneric quit (connection)) (defgeneric handle-connection (connection)) (defgeneric read-message (connection)) (defgeneric send-message (connection message)) +(defgeneric reconnect (conncetion)) + +(defmethod reconnect ((c connection)) + (with-slots (server-name server-port user password socket stream connection-handler) c + (let* ((sock (usocket:socket-connect server-name server-port)) + (s (usocket:socket-stream sock)) + (handler (spawn-with-name (format nil "empire-handler-~a" user) + #'handle-connection c))) + (setf socket sock + stream s + connection-handler handler)))) (defparameter +C_CMDOK+ "0") (defparameter +C_DATA+ "1") @@ -125,7 +143,9 @@ 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)) +(defgeneric handle-simple-message (base-mode message)) (defmethod handle-init ((m init-mode) message) (declare (ignorable message)) @@ -136,10 +156,25 @@ 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-simple-message ((m play-mode) message) + (let* ((c (connection m)) + (log (logging-stream c))) + (format log "handle-simple-message ~a~%" message) + (empire-web:data (session c) message))) (defmethod handle-prompt ((m play-mode) message) (let* ((c (connection m)) @@ -148,11 +183,15 @@ 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) `(,+C_INIT+ . handle-init) + `(,+C_EXIT+ . handle-exit) + `(,+C_FLUSH+ . handle-simple-message) + `(,+C_BADCMD+ . handle-simple-message) + `(,+C_FLASH+ . handle-simple-message) `(,+C_PROMPT+ . handle-prompt))) (defun parse-server-line (line) @@ -161,7 +200,9 @@ this stream.") if (eq (char line i) #\Space) do (return i))) (message-type (subseq line 0 first-space-index)) - (message (subseq line (+ first-space-index 1)))) + (message (if first-space-index + (subseq line (+ first-space-index 1)) + ""))) (values message message-type))) (defmethod handle-connection ((c connection)) @@ -179,25 +220,43 @@ 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) + (end-of-file () nil))) + +(defun raw-send-message (s message) + (write-sequence message s) + (terpri s) + (force-output s)) (defmethod send-message ((c connection) message) (let ((s (network-stream c)) (log (logging-stream c))) (format log "< ~a~%" message) - (write-sequence message s) - (terpri s) - (force-output s) + (let ((sent-p nil) + (tries 3)) + (loop + while (and (not sent-p) + (> tries 0)) + do (handler-case + (progn + (raw-send-message s message) + (setf sent-p t)) + (sb-int:closed-stream-error () + (progn + (decf tries) + (reconnect c)))))) message)) (defgeneric play (connection))