X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=2f3452e3af8113b120fd87fd0a6873c70231ae7e;hp=34aea1367f279b6a5c6130f00719a420083b3673;hb=007a52ce7b04a24281a7f713838c5c7aecd27e61;hpb=5f6fe572cf671662da4c7c7e5d38207da6ced92e diff --git a/empire.lisp b/empire.lisp index 34aea13..2f3452e 100644 --- a/empire.lisp +++ b/empire.lisp @@ -44,7 +44,11 @@ (session :accessor session :initarg :session - :documentation "web session to which this connection belongs"))) + :documentation "web session to which this connection belongs") + (send-queue + :accessor send-queue + :initform (locked-queue:create) + :documentation "lines outstanding to be sent at next prompt"))) (defun make-connection (&key (user nil) (password nil) @@ -81,24 +85,27 @@ (handler (spawn-with-name (format nil "empire-handler-~a" user) #'handle-connection connection))) (setf (connection-handler connection) handler) - (empire-log:info "empire:connect: ~a" connection) + (empire-log:info "~a: connect" connection) connection)) (defgeneric quit (connection)) (defgeneric handle-connection (connection)) (defgeneric read-message (connection)) -(defgeneric send-message (connection message)) +(defgeneric send-message (connection message &key next-mode)) +(defgeneric connected-p (connection)) (defgeneric reconnect (conncetion)) +(defmethod connected-p ((c connection)) + (sb-thread:thread-alive-p (connection-handler c))) + (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))) + (s (usocket:socket-stream sock))) (setf socket sock stream s - connection-handler handler))) + connection-handler (spawn-with-name (format nil "empire-handler-~a" user) + #'handle-connection c)))) (empire-log:info "~a: reconnect" c)) (defparameter +C_CMDOK+ "0") @@ -120,8 +127,8 @@ (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?"))) + ((phase :initform :initial + :documentation "Initialization phase"))) (defclass play-mode (base-mode) nil) (defun make-mode (connection mode) @@ -134,25 +141,48 @@ (empire-log:info "~a: set-new-mode ~a -> ~a" c (connection-mode c) new-mode) (setf (connection-mode c) mode))) +(defgeneric handle-cmdok (base-mode message)) (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-flush (base-mode message)) (defgeneric handle-simple-message (base-mode message)) +(defgeneric handle-ignore (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)))) + (with-slots (phase connection) m + (ecase phase + (:initial (handle-cmdok m message)) + (:play-sent (set-new-mode m 'play-mode))))) + +(defmethod handle-cmdok ((m init-mode) message) + (declare (ignorable message)) + (with-slots (phase connection) m + (flet ((init-phase (mode send-args next-phase) + (with-slots (phase connection) mode + (send-message-one connection (apply #'format nil send-args)) + (setf phase next-phase)))) + (with-slots (user password) (connection m) + (ecase phase + (:initial (init-phase m `("client eow ~a" ,*version*) :client-sent)) + (:client-sent (init-phase m `("coun ~a" ,user) :coun-sent)) + (:coun-sent (init-phase m `("pass ~a" ,password) :pass-sent)) + (:pass-sent (init-phase m '("play") :play-sent))))))) (defmethod handle-exit ((m init-mode) message) (declare (ignorable message)) - (quit (connection m))) + (with-slots (phase connection) m + (ecase phase + (:play-sent (send-message-one connection "kill") + (setf phase :kill-sent)) + (:kill-sent (send-message-one connection "play") + (setf phase :play-sent))))) + +(defmethod handle-data ((m init-mode) message) + (declare (ignorable message)) + t) (defmethod handle-exit ((m play-mode) message) (declare (ignorable message)) @@ -168,15 +198,34 @@ (defmethod handle-flush ((m play-mode) message) (let* ((c (connection m))) - (empire-web:prompt (session c) message))) + (empire-web:prompt (session c) message) + (send-next-line c))) + +(defmethod send-next-line ((c connection)) + (let ((next-event (locked-queue:dequeue (send-queue c)))) + (etypecase next-event + (string (send-message-one c next-event)) + (cons (let ((message (car next-event)) + (mode (cdr next-event))) + (send-message-one c message) + (set-new-mode (connection-mode c) mode)))))) + +(defun read-no-eval (stream) + (let ((*read-eval* nil)) + (read stream))) (defmethod handle-prompt ((m play-mode) message) (let* ((c (connection m))) (with-input-from-string (s message) - (let* ((minutes (read s)) ;;FIXME DANGEROUS - (btus (read s))) + (let* ((minutes (read-no-eval s)) + (btus (read-no-eval s))) (empire-web:prompt (session c) - (format nil "[~a,~a]: " minutes btus)))))) + (format nil "[~a,~a]: " minutes btus)))) + (send-next-line c))) + +(defmethod handle-ignore ((m init-mode) message) + (declare (ignorable message)) + t) (defparameter *line-type-dispatch* (list `(,+C_DATA+ . handle-data) @@ -185,6 +234,7 @@ `(,+C_FLUSH+ . handle-flush) `(,+C_BADCMD+ . handle-simple-message) `(,+C_FLASH+ . handle-simple-message) + `(,+C_CMDOK+ . handle-cmdok) `(,+C_PROMPT+ . handle-prompt))) (defun parse-server-line (line) @@ -225,38 +275,51 @@ (error 'no-handler :mode mode :type type)))) line) (sb-int:closed-stream-error () nil) + (sb-int:simple-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) + +(defgeneric send-message-one (connection string)) +(defmethod send-message-one ((c connection) message) (empire-log:info "~a: > ~a" c message) - (let ((sent-p nil) - (tries 3)) - (loop - while (and (not sent-p) - (> tries 0)) - do (handler-case - (let ((s (network-stream c))) - (raw-send-message s message) - (setf sent-p t)) - (sb-int:closed-stream-error () - (progn - (decf tries) - (empire-log:info "~a: Connection close - retrying (~a tries left)" c tries) - (reconnect c)))))) - message) + (let ((s (network-stream c))) + (raw-send-message s message))) + +(defmethod send-message ((c connection) message &key next-mode) + (if (not (connected-p c)) + (reconnect c)) + (if next-mode + (locked-queue:enqueue (send-queue c) (cons message next-mode)) + (locked-queue:enqueue (send-queue c) message))) (defparameter +special-command-char+ #\;) (defun special-command-p (line) - (char= +special-command-char+ (aref line 0))) + (and (> (length line) 0) + (char= +special-command-char+ (aref line 0)))) + +(defclass xdump-mode (play-mode) + ((table-buffer + :initform nil + :accessor table-buffer + :documentation "Intermediate storage for incomplete table dump."))) + +(defmethod handle-data ((m xdump-mode) message) + (with-slots (connection table-buffer) m + (if (char= #\/ (aref message 0)) + (progn + (format t "table: ~a~%" table-buffer) + (set-new-mode m 'play-mode))) + ;XXX check table size + (with-input-from-string (s (format nil "(~a)" message)) + (setf table-buffer (cons (read s) table-buffer))))) (defmethod special-xup ((c connection)) - t) + (send-message c "xdump meta meta" :next-mode 'xdump-mode)) (defmethod special-command ((c connection) line) (cond ((string= line "xup") (special-xup c)) @@ -267,15 +330,5 @@ (cond ((special-command-p line) (special-command c (subseq line 1))) (t (send-message c line)))) -(defgeneric play (connection)) -(defmethod play ((c connection)) - (with-slots (user password) c - (send-message c (format nil "play FIXME ~a ~a" user password)))) - (defmethod quit ((c connection)) (usocket:socket-close (socket c))) - - -;;; Tests -(defvar *l1* "2 Empire server ready") -;; (parse-server-line *l1*)