--- /dev/null
+(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*)
--- /dev/null
+(defpackage "emp-net"
+ (:use "SB-BSD-SOCKETS" "CL"))
+
+(in-package "emp-net")
+
+; 2 Empire server ready
+; client testclient
+; 0 talking to testclient
+; coun POGO
+; 0 country name POGO
+; pass peter
+; 0 password ok
+; play
+; 2 2
+; 1 You're not a deity!
+; 3 so long...
+; Connection closed by foreign host.
+
+(defvar *socket*)
+(defvar *s*)
+
+(defun init ()
+ (setf *socket* (make-instance 'inet-socket :type :stream :protocol :tcp))
+ (let ((address (host-ent-address (get-host-by-name "localhost"))))
+ (socket-connect *socket* address 6665))
+ (setf *s* (socket-make-stream *socket* :input t :output t :buffering :line)))
+
+(defun read-reply ()
+ (let ((reply (read-line *s*)))
+ (assert (char= (aref reply 1) #\ ))
+ (cons (aref reply 0) (subseq reply 2))))
+
+(defconstant +C_CMDOK+ "0")
+(defconstant +C_DATA+ "1")
+(defconstant +C_INIT+ "2")
+(defconstant +C_EXIT+ "3")
+(defconstant +C_FLUSH+ "4")
+(defconstant +C_NOECHO+ "5")
+(defconstant +C_PROMPT+ "6")
+(defconstant +C_ABORT+ "7")
+(defconstant +C_REDIR+ "8")
+(defconstant +C_PIPE+ "9")
+(defconstant +C_CMDERR+ "a")
+(defconstant +C_BADCMD+ "b")
+(defconstant +C_EXECUTE+ "c")
+(defconstant +C_FLASH+ "d")
+(defconstant +C_INFORM+ "e")
+;(defconstant +C_LAST+ "e")
+
+(defun login (username country password)
+ (user username)
+ (coun country)
+ (pass password))
+
+(defun user (username)
+ (format *s* "user ~a~%" username)
+ (assert (char= +C_CMDOK+ (car (read-reply)))))
+
+(defun coun (country)
+ (format *s* "coun ~a~%" country)
+ (assert (char= +C_CMDOK+ (car (read-reply)))))
+
+(defun pass (password)
+ (format *s* "pass ~a~%" password))
+
+(defun reader (fd)
+ (declare (ignore fd))
+ (let ((line (read-line *s*)))
+ (format t "< ~a~%" line)
+ (reader)))
+
+(defun add-reader ()
+ (sb-sys:add-fd-handler (sb-sys:fd-stream-fd *s*)
+ :input
+ (lambda (fd)
+ (format t "input-handler: fd ~a~%" fd))))
projects / eow / commitdiff