(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"))) (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") (defgeneric init-mode (connection message)) (defmethod init-mode ((c connection) message) (declare (ignorable message)) (play c)) (defvar *line-type-dispatch* (list `(,+C_INIT+ . init-mode))) (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)) (loop while (read-message c))) (defun lookup-handler (message-type) (cdr (assoc message-type *line-type-dispatch* :test 'string=))) (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)) (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*)