X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=6230e9369070f4a335567838273d4cb098ef9656;hp=fa088df853f29dc7613639fa036a139ce82ddcab;hb=58c69aa5c7a9fceb42e36c9ab8d901c7cf66f643;hpb=f457ab38fddc9a587b37b3d97b8bcc19d5c412cb diff --git a/empire.lisp b/empire.lisp index fa088df..6230e93 100644 --- a/empire.lisp +++ b/empire.lisp @@ -42,7 +42,15 @@ this stream.") (connection-handler :accessor connection-handler :initform nil - :documentation "Handler function for incoming messages"))) + :documentation "Handler function for incoming messages") + (mode + :accessor connection-mode + :initform nil + :documentation "TODO(gefla)") + (session + :accessor session + :initarg :session + :documentation "web session to which this connection belongs"))) (defun make-connection (&key (user nil) (password nil) @@ -50,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 @@ -58,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)) @@ -75,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) @@ -93,7 +105,7 @@ this stream.") (defparameter +C_EXIT+ "3") (defparameter +C_FLUSH+ "4") (defparameter +C_NOECHO+ "5") -(defparameter +C_PROMPT+ "6") +(defparameter +C_PROMPT+ "6") (defparameter +C_ABORT+ "7") (defparameter +C_REDIR+ "8") (defparameter +C_PIPE+ "9") @@ -103,13 +115,70 @@ this stream.") (defparameter +C_FLASH+ "d") (defparameter +C_INFORM+ "e") -(defgeneric init-mode (connection message)) -(defmethod init-mode ((c connection) message) +(defclass base-mode () + ((connection :initarg :connection :accessor connection))) +(defclass init-mode (base-mode) + ((play-sent-p :initform nil + :documentation "Have we already sent the play command?"))) +(defclass play-mode (base-mode) nil) + +(defun make-mode (connection mode) + (make-instance mode :connection connection)) + +(defgeneric set-new-mode (base-mode new-mode)) +(defmethod set-new-mode ((m base-mode) new-mode) + (let* ((c (connection m)) + (mode (make-mode c new-mode))) + (setf (connection-mode c) mode))) + +(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) + (declare (ignorable message)) + (with-slots (play-sent-p) m + (if (not play-sent-p) + (progn + (play (connection m)) + (setf play-sent-p t)) + (set-new-mode m 'play-mode)))) + +(defmethod handle-exit ((m init-mode) message) (declare (ignorable message)) - (play c)) + (quit (connection m))) -(defvar *line-type-dispatch* - (list `(,+C_INIT+ . init-mode))) +(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) + (empire-web:data (session c) message))) + +(defmethod handle-flush ((m play-mode) message) + (let* ((c (connection m)) + (log (logging-stream c))) + (format log "handle-flush ~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)) ;;FIXME DANGEROUS + (btus (read s))) + (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) (let* ((first-space-index @@ -121,20 +190,33 @@ this stream.") (values message message-type))) (defmethod handle-connection ((c connection)) + (setf (connection-mode c) (make-mode c 'init-mode)) (loop while (read-message c))) (defun lookup-handler (message-type) (cdr (assoc message-type *line-type-dispatch* :test 'string=))) +(define-condition no-handler (error) + ((mode :initarg :mode) + (type :initarg :type)) + (:report (lambda (condition stream) + (with-slots (mode type) condition + (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))) - (funcall handler c message))) - 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))