From 47c165486537192942bac3a3ea806b81852cb762 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Fri, 29 Apr 2016 11:42:18 -0500 Subject: [PATCH] Some basic network code that kinda sorta works --- mudsync.scm | 140 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 140 insertions(+) create mode 100644 mudsync.scm diff --git a/mudsync.scm b/mudsync.scm new file mode 100644 index 0000000..3d1d214 --- /dev/null +++ b/mudsync.scm @@ -0,0 +1,140 @@ +(use-modules (8sync systems actors) + (8sync agenda) + (ice-9 format) + (ice-9 match) + (oop goops)) + + +(define %default-server #f) +(define %default-port 8889) + +(define-class () + (server-socket #:accessor nm-server-socket) + (clients #:accessor nm-clients + #:init-thunk make-hash-table) + (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)))))) + +(define-method (nm-close-everything (nm ) remove-from-agenda) + ;; close all clients + (hash-for-each + (lambda (client _) + (close client) + (if remove-from-agenda + (8sync-port-remove client))) + (nm-clients nm)) + ;; 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-method (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-method (nm-new-client (nm ) 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))) + + (hash-set! (nm-clients nm) client #f) + (8sync-port client #:read (nm-make-client-receive nm)))) + +(define-method (nm-make-client-receive (nm )) + (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) + (display "Horray, we got something!\n") + (while (should-read-char client) + (set! buffer (cons (read-char client) buffer)) + (match buffer + (;; @@: Do we need the "char?" + (#\newline #\newline (? char? line-chars) ...) + (let ((ready-line (list->string (reverse line-chars)))) + ;; reset buffer + (set! buffer '()) + ;; run it + (nm-handle-line nm client ready-line))) + (_ #f))) + ;; Shut things down on closed port or EOF object + (cond + ((port-closed? client) + ;; TODO: replace with nm-handle-port-closed + (display "port closed time\n") + (8sync-port-remove client)) + ((and (char-ready? client) + (eof-object? (peek-char client))) + (display "port eof time\n") + ;; TODO: replace with nm-handle-port-eof + (close client) + (8sync-port-remove client)))) + receive-handler)) + +(define-method (nm-handle-line (nm ) client line) + "Handle an incoming line of input from a client" + (format #t "Got line: ~s\n" line)) + + +;; (define-method (nm-close-port (nm ))) + + +(define-generic gm-init-world) +(define-class () + (message-handler + #:init-value + (make-action-dispatch + ;; init-world + ))) + -- 2.31.1