diff --git a/package.lisp b/package.lisp index 26a0688..545c0b9 100644 --- a/package.lisp +++ b/package.lisp @@ -31,7 +31,7 @@ *port*)) ;;set debug level during development -(declaim (optimize (debug 3))) +;;(declaim (optimize (debug 3))) ;;convenience function (defun start () (nya:start-game)) diff --git a/package.lisp b/package.lisp index 26a0688..545c0b9 100644 --- a/package.lisp +++ b/package.lisp @@ -31,7 +31,7 @@ *port*)) ;;set debug level during development -(declaim (optimize (debug 3))) +;;(declaim (optimize (debug 3))) ;;convenience function (defun start () (nya:start-game)) diff --git a/server-protocol.txt b/server-protocol.txt index d3f7d0b..96b8ce2 100644 --- a/server-protocol.txt +++ b/server-protocol.txt @@ -7,19 +7,25 @@ The server will always return a string answer to a command. +#TODO remove "NIL" return values (too ambiguous) COMMANDS * login - -> "T" on acceptance, "NIL" on denial + -> player name echoed on acceptance, error signalled otherwise -> Warning: passwords are transmitted and stored in plain text! -> required before all other commands +* signup + -> create a new player with the given password and log him in + -> signals error if a player by that name already exists + * news -> latest news item relevant to the player -* patch-char - -> " " of the specified patch +* map + -> a 2d list of ( ) pairs, representing the visible + game map * describe-patch -> a string representation of a list of lines describing the specified patch diff --git a/package.lisp b/package.lisp index 26a0688..545c0b9 100644 --- a/package.lisp +++ b/package.lisp @@ -31,7 +31,7 @@ *port*)) ;;set debug level during development -(declaim (optimize (debug 3))) +;;(declaim (optimize (debug 3))) ;;convenience function (defun start () (nya:start-game)) diff --git a/server-protocol.txt b/server-protocol.txt index d3f7d0b..96b8ce2 100644 --- a/server-protocol.txt +++ b/server-protocol.txt @@ -7,19 +7,25 @@ The server will always return a string answer to a command. +#TODO remove "NIL" return values (too ambiguous) COMMANDS * login - -> "T" on acceptance, "NIL" on denial + -> player name echoed on acceptance, error signalled otherwise -> Warning: passwords are transmitted and stored in plain text! -> required before all other commands +* signup + -> create a new player with the given password and log him in + -> signals error if a player by that name already exists + * news -> latest news item relevant to the player -* patch-char - -> " " of the specified patch +* map + -> a 2d list of ( ) pairs, representing the visible + game map * describe-patch -> a string representation of a list of lines describing the specified patch diff --git a/src/client.lisp b/src/client.lisp index 276150b..05e428c 100644 --- a/src/client.lisp +++ b/src/client.lisp @@ -21,13 +21,14 @@ (defun current-server () naledi-server) ;TODO remove after development - (defun query-server (request) + (defun query-server (&rest request) "Send a request string to the server and return the answer" (unless naledi-server ;XXX do this with exceptions (return-from query-server "You are not connected to a server!")) - (let ((servstr (usocket:socket-stream naledi-server))) + (let ((servstr (usocket:socket-stream naledi-server)) + (req (string-from-list request))) (logging "CLIENT: sending request ~S" request) - (format servstr "~A~%" request) + (format servstr "~A~%" req) (finish-output servstr) ;;FIXME server still doesn't receive string until disconnect... (logging "CLIENT: waiting for server response") diff --git a/package.lisp b/package.lisp index 26a0688..545c0b9 100644 --- a/package.lisp +++ b/package.lisp @@ -31,7 +31,7 @@ *port*)) ;;set debug level during development -(declaim (optimize (debug 3))) +;;(declaim (optimize (debug 3))) ;;convenience function (defun start () (nya:start-game)) diff --git a/server-protocol.txt b/server-protocol.txt index d3f7d0b..96b8ce2 100644 --- a/server-protocol.txt +++ b/server-protocol.txt @@ -7,19 +7,25 @@ The server will always return a string answer to a command. +#TODO remove "NIL" return values (too ambiguous) COMMANDS * login - -> "T" on acceptance, "NIL" on denial + -> player name echoed on acceptance, error signalled otherwise -> Warning: passwords are transmitted and stored in plain text! -> required before all other commands +* signup + -> create a new player with the given password and log him in + -> signals error if a player by that name already exists + * news -> latest news item relevant to the player -* patch-char - -> " " of the specified patch +* map + -> a 2d list of ( ) pairs, representing the visible + game map * describe-patch -> a string representation of a list of lines describing the specified patch diff --git a/src/client.lisp b/src/client.lisp index 276150b..05e428c 100644 --- a/src/client.lisp +++ b/src/client.lisp @@ -21,13 +21,14 @@ (defun current-server () naledi-server) ;TODO remove after development - (defun query-server (request) + (defun query-server (&rest request) "Send a request string to the server and return the answer" (unless naledi-server ;XXX do this with exceptions (return-from query-server "You are not connected to a server!")) - (let ((servstr (usocket:socket-stream naledi-server))) + (let ((servstr (usocket:socket-stream naledi-server)) + (req (string-from-list request))) (logging "CLIENT: sending request ~S" request) - (format servstr "~A~%" request) + (format servstr "~A~%" req) (finish-output servstr) ;;FIXME server still doesn't receive string until disconnect... (logging "CLIENT: waiting for server response") diff --git a/src/server.lisp b/src/server.lisp index 34a680d..7982dac 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -87,11 +87,11 @@ (bt:make-thread #'update-loop :name "world-thread")) (setf server-thread (bt:make-thread #'run-server :name "server-thread")) - (notify "Server initialized."))) + (logging "SERVER: initialized"))) (defun terminate () ;;TODO do some error catching if the threads no longer exist - (notify "Terminating the world.") + (logging "SERVER: terminating the world.") (setf running NIL) ;;XXX have to use destroy-thread because the server mostly idles, ;; waiting for connections - only checks 'running' when connecting @@ -110,6 +110,8 @@ (defun reset-server-threads () (set-list NIL server-thread world-thread player-threads)) + + ;;TODO remove threads named `terminated' (defun update-loop () "The main loop, updating the world in the background" @@ -141,58 +143,70 @@ (let ((thread (bt:make-thread #'(lambda () (handle-connection socket)) - :name (string-from-list - (list "player-thread" - (length player-threads)) "-")))) - (setf player-threads (cons thread player-threads)) + :name "anonymous"))) + (setf player-threads + (cons thread player-threads)) (sleep 1)))))) ;;give the socket a chance to connect (defun handle-connection (socket) "Answer requests until the player disconnects" (usocket:with-connected-socket (conn (usocket:socket-accept socket)) - (logging "~&SERVER: received a connection.") ; cf. `get-peer-name' + (logging "~&SERVER: received a connection") ; cf. `get-peer-name' (do* ((sockstr (usocket:socket-stream conn)) (request (read-line sockstr NIL) (read-line sockstr NIL))) - ;;TODO remember player name - ;;TODO remove player-thread from list when terminated - ((or (not running) (null request))) + ((or (not running) (null request)) (logout)) (format sockstr "~S~%" (to-string (answer request))) (finish-output sockstr))))) +(defparameter api + ;; An alist of API commands and their corresponding functions + '((login #'login) + (map #'get-map) + (signup #'create-player) + (describe-patch #'describe-patch))) + (defun answer (request) + "Dispatch on the functions registerd in `api'" (logging "SERVER: received request ~S" request) (let* ((reqelts (extract-elements request)) - (player-name (first reqelts)) - (cmd (second reqelts)) - (args (cddr reqelts))) - (cond ((eq player-name 'ACK) "ACK ACK") ;debug - ((eq cmd 'get-map) (get-map player-name)) - ((eq cmd 'describe-patch) (describe-patch args)) - ;;TODO - ))) + (cmd (car reqelts)) + (args (cdr reqelts))) + (when (member cmd (keys api) :test #'eq) + (if (and (equalp (thread-name (current-thread)) "anonymous") + (not (member cmd '(login signup) :test #'eq))) + "ERROR: not logged in" + (apply (cassoc cmd api :test #'eq) args))))) ;;; COMMUNICATION FUNCTIONS (defun login (name passwd) "Log this player in" (let ((p (get-player name))) - ;;TODO wrong password and non-existent player give the same return value - (when (and p (equalp passwd (player-password p))) - (setf (player-online p) T) - (setf (patch-occupant ;;TODO check for previous occupants + (cond ((not p) "ERROR: nonexistent player") + ((not (equalp passwd (player-password p))) "ERROR: bad password") + (T (setf (player-online p) T) + (setf (patch-occupant ;;TODO check for previous occupants + (coord (.x (player-human p)) (.y (player-human p)))) + (player-human p)) + (setf (thread-name (current-thread)) name) + name)))) + +(defun logout () + "Log the player out again" + (let ((p (get-player (thread-name (current-thread))))) + (when p + (setf (player-online p) NIL) + (setf (patch-occupant (coord (.x (player-human p)) (.y (player-human p)))) - (player-human p)) - name))) + NIL) ;;TODO set to "statue of " + (setf (thread-name (current-thread)) "terminated")))) (defun create-player (name passwd) - "Create a new player" - (unless (get-player name) - (add-player name passwd) name)) - -(defun get-map (player-name) - "Return a 2d list of map places (each a list of a char and a colour)" - ;;TODO - ) + "Create and log in a new player" + (if (get-player name) "ERROR: player exists" + (progn + (add-player name passwd) + (login name passwd)))) (defun describe-patch (coords) "Return a list of lines describing the patch at these coordinates."