(in-package :empire) (defparameter *version* "0.0.1") ;; ;; Connection ;; (defvar *default-empire-server* "localhost") (defvar *default-empire-server-port* 6665) (defclass connection () ((user :initarg :user :accessor user) (password :initarg :password :accessor password :initform nil) (server-name :initarg :server-name :accessor server-name :initform "Unknown server") (server-port :initarg :server-port :accessor server-port :initform *default-empire-server-port*) (socket :initarg :socket :accessor socket :documentation "Slot to store socket (for internal use only).") (stream :initarg :stream :accessor network-stream :documentation "Stream used to talk to the empire server.") (logging-stream :initarg :logging-stream :accessor logging-stream :initform t :documentation "Messages coming back from the server is sent to this stream.") (connection-handler :accessor connection-handler :initform nil :documentation "Handler function for incoming messages") (mode :accessor connection-mode :initform nil :documentation "TODO(gefla)"))) (defun make-connection (&key (user nil) (password nil) (server-name *default-empire-server*) (server-port *default-empire-server-port*) (socket nil) (network-stream nil) (logging-stream nil)) (make-instance 'connection :user user :password password :server-name server-name :server-port server-port :socket socket :stream network-stream :logging-stream logging-stream)) ;;; interface (defun connect (&key (user nil) (password nil) (server-name *default-empire-server*) (server-port *default-empire-server-port*) (logging-stream *standard-output*)) "Connect to server and return a connection object." (let* ((socket (usocket:socket-connect server-name server-port)) (stream (usocket:socket-stream socket)) (connection (make-connection :user user :password password :socket socket :network-stream stream :logging-stream logging-stream :server-name server-name :server-port server-port)) (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)) (defparameter +C_CMDOK+ "0") (defparameter +C_DATA+ "1") (defparameter +C_INIT+ "2") (defparameter +C_EXIT+ "3") (defparameter +C_FLUSH+ "4") (defparameter +C_NOECHO+ "5") (defparameter +C_PROMPT+ "6") (defparameter +C_ABORT+ "7") (defparameter +C_REDIR+ "8") (defparameter +C_PIPE+ "9") (defparameter +C_CMDERR+ "a") (defparameter +C_BADCMD+ "b") (defparameter +C_EXECUTE+ "c") (defparameter +C_FLASH+ "d") (defparameter +C_INFORM+ "e") (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-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-data ((m play-mode) message) (let* ((c (connection m)) (log (logging-stream c))) (format log "handle-data ~a~%" message) (empire-web:data 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 minutes btus))))) (defparameter *line-type-dispatch* (list `(,+C_DATA+ . handle-data) `(,+C_INIT+ . handle-init) `(,+C_PROMPT+ . handle-prompt))) (defun parse-server-line (line) (let* ((first-space-index (loop for i from 0 below (length line) if (eq (char line i) #\Space) do (return i))) (message-type (subseq line 0 first-space-index)) (message (subseq line (+ first-space-index 1)))) (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)) (mode (connection-mode c))) (if handler (funcall handler mode message) (error 'no-handler :mode mode :type type)))) line)) (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) message)) (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*)