From 20660ae0821d01f38105617ea3114b3251b8fd3a Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Mon, 2 May 2016 11:39:03 -0500 Subject: [PATCH] Move networking stuff into its own file --- mudsync.scm | 202 +++++------------------------------------ mudsync/networking.scm | 171 ++++++++++++++++++++++++++++++++++ 2 files changed, 195 insertions(+), 178 deletions(-) create mode 100644 mudsync/networking.scm diff --git a/mudsync.scm b/mudsync.scm index 35cc0be..a722633 100644 --- a/mudsync.scm +++ b/mudsync.scm @@ -16,174 +16,14 @@ ;;; 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) - (gdbm) - (oop goops)) - +(define-module (mudsync) + #:use-module (8sync systems actors) + #:use-module (8sync agenda) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (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) - ;; @@: Do we need an 8sync-port-wait here? - ;; Is such a thing even possible? :\ - (8sync-port client #:read (nm-make-client-receive nm client-id)) - (<- nm (nm-send-input-to nm) 'new-client #:client 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" - (define client-obj (hash-ref (nm-clients nm) client-id)) - (if (not client-obj) - (throw 'no-such-client - "Asked to send data to client but that client doesn't exist" - #:client-id client-id - #:data data)) - (display data client-obj)) - ; (ez-run-hive hive (list (bootstrap-message hive (actor-id nm) 'start-listening))) @@ -391,7 +231,7 @@ with an anonymous persona" ;; how to print our name (name-f #:init-keyword #:name-f #:getter gameobj-name-f - #:init-value gameobj-simple-name-f) + #:init-value (wrap gameobj-simple-name-f)) ;; Name aliases (aliases #:init-keyword #:aliases @@ -453,11 +293,27 @@ with an anonymous persona" (reply-message actor message #:val (slot-ref actor slot)))) +(define always (const #t)) + +;; TODO: remove hack +(define full-command list) + +;; TODO: fill these in +(define cmatch-just-verb #f) +(define cmatch-direct-verb #f) +(define cmatch-direct-obj #f) + +(define %room-contain-commands + (list + (full-command "look" cmatch-just-verb always 'look-room) + (full-command "look" cmatch-direct-obj always 'look-member) + (full-command "go" cmatch-just-verb always 'go-where) + (full-command "go" cmatch-direct-obj always 'go-exit))) ;; TODO: Subclass from container? (define-class () (desc #:init-value "" - #:init-keyword #:desc) + #:init-keyword #:desc) ;; TODO: Switch this to be loc based ;; Uses a hash table like a set (values ignored) (occupants #:init-thunk make-hash-table) @@ -487,16 +343,6 @@ with an anonymous persona" (hash-remove! (slot-ref actor 'occupants) who)) (wire-exits! (wrap-apply room-wire-exits!))))) -(define always (const #t)) - -(define %room-contain-commands - (list - (full-command "look" cmatch-just-verb always 'look-room) - (full-command "look" cmatch-direct-obj always 'look-member) - (full-command "go" cmathc-just-verb always 'go-where) - (full-command "go" cmatch-direct-obj always 'go-exit))) - - (define (room-wire-exits! room message) "Actually hook up the rooms' exit addresses to the rooms they claim to point to." diff --git a/mudsync/networking.scm b/mudsync/networking.scm new file mode 100644 index 0000000..76758c1 --- /dev/null +++ b/mudsync/networking.scm @@ -0,0 +1,171 @@ +(define-module (mudsync networking) + #:use-module (8sync systems actors) + #:use-module (8sync agenda) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (oop goops) + + #:export (;; Should we be exporting these? + %default-server + %default-port + + + nm-close-everything)) + +;;; 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) + ;; @@: Do we need an 8sync-port-wait here? + ;; Is such a thing even possible? :\ + (8sync-port client #:read (nm-make-client-receive nm client-id)) + (<- nm (nm-send-input-to nm) 'new-client #:client 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" + (define client-obj (hash-ref (nm-clients nm) client-id)) + (if (not client-obj) + (throw 'no-such-client + "Asked to send data to client but that client doesn't exist" + #:client-id client-id + #:data data)) + (display data client-obj)) -- 2.31.1