X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=empire.lisp;h=edb8316846ed5ede51dadfbd2b9eac86c7a77118;hp=c32696c3504258bd0f4bf78d61806f3b419c11c0;hb=HEAD;hpb=ed19bd38851ee35d2cfcb193e2b3f06112fda8b7 diff --git a/empire.lisp b/empire.lisp index c32696c..edb8316 100644 --- a/empire.lisp +++ b/empire.lisp @@ -127,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) @@ -141,6 +141,7 @@ (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)) @@ -151,14 +152,35 @@ (defmethod handle-init ((m init-mode) message) (declare (ignorable message)) - (with-slots (play-sent-p) m - (if (not play-sent-p) - (let ((c (connection m))) - (login-and-play c) - (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)) + (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) @@ -186,13 +208,17 @@ (cons (let ((message (car next-event)) (mode (cdr next-event))) (send-message-one c message) - (set-new-mode c mode)))))) + (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)))) (send-next-line c))) @@ -208,7 +234,7 @@ `(,+C_FLUSH+ . handle-flush) `(,+C_BADCMD+ . handle-simple-message) `(,+C_FLASH+ . handle-simple-message) - `(,+C_CMDOK+ . handle-ignore) + `(,+C_CMDOK+ . handle-cmdok) `(,+C_PROMPT+ . handle-prompt))) (defun parse-server-line (line) @@ -249,6 +275,7 @@ (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) @@ -275,8 +302,52 @@ (and (> (length line) 0) (char= +special-command-char+ (aref line 0)))) +(defclass xdump-mode (play-mode) + ((parser :initform (xdump:make-parser)) + (phase :initform :meta-meta) + (dump-queue :initform nil) + (dump-index :initform 0))) + +(defmethod handle-data ((m xdump-mode) message) + (with-slots (connection parser phase dump-queue dump-index) m + (if (xdump:parse-line parser message) + ;;XXX consider something like a 'pop-mode function + (ccase phase + (:meta-meta + (setf phase :meta-table + parser (xdump:make-parser)) + (send-message connection "xdump meta table")) + (:meta-table + (setf phase :table-table + parser (xdump:make-parser)) + (send-message connection "xdump table *")) + (:table-table + (setf phase :tables-meta + dump-queue (xdump::table-entries (xdump::get-table "table")) + dump-index 0 + parser (xdump:make-parser)) + (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue 0))))) + (:tables-meta + (setf phase :tables-content + parser (xdump:make-parser)) + (send-message connection (format nil "xdump ~a *" (xdump-data::table-name (aref dump-queue dump-index))))) + (:tables-content + (if (< dump-index (fill-pointer dump-queue)) + (progn (setf phase :tables-meta + parser (xdump:make-parser)) + (incf dump-index) + (loop while (and (< dump-index (fill-pointer dump-queue)) + (let ((dump-queue-entry (aref dump-queue dump-index))) + (or (null dump-queue-entry) + (string= "meta" (xdump-data::table-name dump-queue-entry))))) + do (incf dump-index)) + (if (and (<= dump-index (fill-pointer dump-queue)) + (not (null (aref dump-queue dump-index)))) + (send-message connection (format nil "xdump meta ~a" (xdump-data::table-name (aref dump-queue dump-index)))))) + (set-new-mode (connection-mode connection) 'play-mode))))))) + (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)) @@ -287,20 +358,5 @@ (cond ((special-command-p line) (special-command c (subseq line 1))) (t (send-message c line)))) -(defgeneric login-and-play (connection)) -(defmethod login-and-play ((c connection)) - (send-message-one c (format nil "client eow ~a" *version*)) - (send-message-one c "user FIXME") - (with-slots (user password) c - (send-message-one c (format nil "coun ~a" user)) - (send-message-one c (format nil "pass ~a" password))) - (send-message-one c "kill") - (send-message-one c "play")) - (defmethod quit ((c connection)) (usocket:socket-close (socket c))) - - -;;; Tests -(defvar *l1* "2 Empire server ready") -;; (parse-server-line *l1*)