X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync.scm;h=15f4c862ad18d7ead1d2339c0f8b7cb3a284035d;hp=544dc3a426b993c9d1df9aeace96d9bebc441307;hb=6212897253ee040f58bf1351dabd1b2a3f3e1b75;hpb=f96e5f3c95dd19e79dde36097379cb1c388cea83 diff --git a/mudsync.scm b/mudsync.scm index 544dc3a..15f4c86 100644 --- a/mudsync.scm +++ b/mudsync.scm @@ -1,5 +1,6 @@ ;;; Mudsync --- Live hackable MUD ;;; Copyright © 2016 Christopher Allan Webber +;;; Copyright © 2012, 2014 Ludovic Courtès ;;; ;;; This file is part of Mudsync. ;;; @@ -16,242 +17,28 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mudsync. If not, see . -(use-modules (8sync systems actors) - (8sync systems actors debug) - (8sync agenda) - (ice-9 format) - (ice-9 match) - (oop goops)) - - - -;;; Networking -;;; ========== - -(define %default-server #f) -(define %default-port 8889) - -(define-class () - (server-socket #:accessor nm-server-socket) - ;; mapping of client -> client-id - (clients #:accessor nm-clients - #:init-thunk make-hash-table) - ;; send input to this actor - (send-input-to #:getter nm-send-input-to - #:init-keyword #:send-input-to) - (message-handler - #:init-value - (make-action-dispatch - ((start-listening actor message) - (nm-install-socket actor (message-ref message 'server %default-server) - (message-ref message 'port %default-port))) - ((send-to-client actor message client data) - (nm-send-to-client-id actor client data))))) - -(define-method (nm-close-everything (nm ) remove-from-agenda) - "Shut it down!" - ;; close all clients - (hash-for-each - (lambda (_ client) - (close client) - (if remove-from-agenda - (8sync-port-remove client))) - (nm-clients nm)) - ;; reset the clients list - (set! (nm-clients) (make-hash-table)) - ;; close the server - (close (nm-server-socket nm)) - (if remove-from-agenda - (8sync-port-remove (nm-server-socket nm)))) - -;; Maximum number of backlogged connections when we listen -(define %maximum-backlog-conns 128) ; same as SOMAXCONN on Linux 2.X, - ; says the intarwebs - -(define (nm-install-socket nm server port) - "Install socket on SERVER with PORT" - (let ((s (socket PF_INET ; ipv4 - SOCK_STREAM ; two-way connection-based byte stream - 0)) - (addr (if server - (inet-pton AF_INET server) - INADDR_LOOPBACK))) - ;; Totally mimed from the Guile manual. Not sure if we need this, but: - ;; http://www.unixguide.net/network/socketfaq/4.5.shtml - (setsockopt s SOL_SOCKET SO_REUSEADDR 1) ; reuse port even if port is busy - ;; Connecting to a non-specific address: - ;; (bind s AF_INET INADDR_ANY port) - ;; Should this be an option? Guess I don't know why we'd need it - ;; @@: If we wanted to support listening on a particular hostname, - ;; could see 8sync's irc.scm... - (bind s AF_INET addr port) - ;; Listen to connections - (listen s %maximum-backlog-conns) - - ;; Throw a system-error rather than block on an (accept) - ;; that has nothing to do - (fcntl s F_SETFL - (logior O_NONBLOCK - (fcntl s F_GETFL))) - - ;; @@: This is used in Guile's http server under the commit: - ;; * module/web/server/http.scm (http-open): Ignore SIGPIPE. Keeps the - ;; server from dying in some circumstances. - ;; (sigaction SIGPIPE SIG_IGN) - ;; Will this break other things that use pipes for us though? - - (set! (nm-server-socket nm) s) - - (format #t "Listening for clients in pid: ~s\n" (getpid)) - (8sync-port s #:read (lambda (s) (nm-new-client nm s))) - ;; TODO: set up periodic close of idle connections? - )) - -(define (nm-new-client nm s) - "Handle new client coming in to socket S" - (let* ((client-connection (accept s)) - (client-details (cdr client-connection)) - (client (car client-connection))) - (format #t "New client: ~s\n" client-details) - (format #t "Client address: ~s\n" - (gethostbyaddr - (sockaddr:addr client-details))) - - (let ((client-id (big-random-number))) - (hash-set! (nm-clients nm) client-id client) - (8sync-port client #:read (nm-make-client-receive nm client-id))))) - -(define (nm-make-client-receive nm client-id) - "Make a method to receive client data" - (let ((buffer '())) - (define (reset-buffer) - (set! buffer '())) - (define (should-read-char client) - (and (not (port-closed? client)) - (char-ready? client) - (not (eof-object? (peek-char client))))) - (define (receive-handler client) - (while (should-read-char client) - (set! buffer (cons (read-char client) buffer)) - (match buffer - (;; @@: Do we need the "char?" - (#\newline #\return (? char? line-chars) ...) - (let ((ready-line (list->string (reverse line-chars)))) - ;; reset buffer - (set! buffer '()) - ;; run it - (nm-handle-line nm client client-id ready-line))) - (_ #f))) - ;; Shut things down on closed port or EOF object - (cond - ((port-closed? client) - (nm-handle-port-closed nm client client-id)) - ((and (char-ready? client) - (eof-object? (peek-char client))) - (nm-handle-port-eof nm client client-id)))) - receive-handler)) - -(define (nm-handle-port-closed nm client client-id) - "Handle a closed port" - (format #t "DEBUG: handled closed port ~x\n" client-id) - (8sync-port-remove client) - (hash-remove! (nm-clients nm) client-id)) - -(define-method (nm-handle-port-eof nm client client-id) - "Handle seeing an EOF on port" - (format #t "DEBUG: handled eof-object on port ~x\n" client-id) - (close client) - (8sync-port-remove client) - (hash-remove! (nm-clients nm) client-id)) - -(define-method (nm-handle-line nm client client-id line) - "Handle an incoming line of input from a client" - (<- nm (nm-send-input-to nm) 'client-input - #:data line - #:client client-id)) - -(define-method (nm-send-to-client-id nm client-id data) - "Send DATA to TO-CLIENT id" - (display data - (hash-ref (nm-clients nm) client-id))) - -; (ez-run-hive hive (list (bootstrap-message hive (actor-id nm) 'start-listening))) - - -;; (define-method (nm-close-port (nm ))) - - -;;; The game master! Runs the world. -;;; ================================= - -;; @@: We could call this a "world builder" instead... -;; I kinda like calling it a GM though. - -(define (gm-init-world gm message) - ;; Load database - ;; TODO - - ;; Init basic rooms / structure - ;; TODO - - ;; Restore database-based actors - ;; TODO - - ;; Set up the network - (gm-setup-network gm)) - -(define (gm-setup-network gm) - ;; Create a default network manager if none available - (set! (gm-network-manager gm) - (create-actor* gm "netman" - #:send-input-to (actor-id gm))) - - ;; TODO: Add host and port options - (<-wait gm (gm-network-manager gm) 'start-listening)) - -(define (gm-handle-client-input actor message) - "Handle input from a client." - (define client-id (message-ref message 'client)) - (define input (message-ref message 'data)) - (format #t "From ~s: ~s\n" client-id input) - (<- actor (gm-network-manager actor) 'send-to-client - #:client client-id - #:data "Thanks, we got it!\n")) - -(define-class () - ;; The directory is a "namespaced" directory of all "special" content - ;; in the game, identifiable by some special key. - ;; (The namespace is simply a cons of (namespace . special-symbol)) - (directory #:init-thunk make-hash-table) - ;; A mapping of client ids to in-game actors - (client-to-actor #:init-thunk make-hash-table) - ;; Network manager - (network-manager #:accessor gm-network-manager - #:init-val #f) - - (message-handler - #:init-value - (make-action-dispatch - (init-world gm-init-world) - (client-input gm-handle-client-input)))) - - -(define-method (gm-setup-database (gm )) - 'TODO) - -(define-method (gm-setup-rooms-etc (gm )) - 'TODO) - - -;; Debugging stuff -(define %test-gm #f) - -(define (run-demo . args) - (define hive (make-hive)) - (define gm - (hive-create-actor-gimmie* hive "gm")) - (set! %test-gm gm) - ;; @@: Boy, wouldn't it be nice if the agenda could do things - ;; on interrupt :P - (ez-run-hive hive - (list (bootstrap-message hive (actor-id gm) 'init-world)))) +(define-module (mudsync) + #:use-module (8sync actors) + #:use-module (8sync agenda) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (oop goops)) + + +;;; Composite model stuff borrowed from Guix. Thanks, Ludo! +(eval-when (eval load compile) + (begin + (define %public-modules + '(game-master + gameobj + networking + command + player + room + run-game + thing)) + + (for-each (let ((i (module-public-interface (current-module)))) + (lambda (m) + (module-use! i (resolve-interface `(mudsync ,m))))) + %public-modules)))