Some basic network code that kinda sorta works
authorChristopher Allan Webber <cwebber@dustycloud.org>
Fri, 29 Apr 2016 16:42:18 +0000 (11:42 -0500)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Fri, 29 Apr 2016 16:42:18 +0000 (11:42 -0500)
mudsync.scm [new file with mode: 0644]

diff --git a/mudsync.scm b/mudsync.scm
new file mode 100644 (file)
index 0000000..3d1d214
--- /dev/null
@@ -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 <network-manager> (<actor>)
+  (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 <network-manager>) 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 <network-manager>) 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 <network-manager>) 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 <network-manager>))
+  (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 <network-manager>) client line)
+  "Handle an incoming line of input from a client"
+  (format #t "Got line: ~s\n" line))
+
+
+;; (define-method (nm-close-port (nm <network-manager>)))
+
+
+(define-generic gm-init-world)
+(define-class <game-master> (<actor>)
+  (message-handler
+   #:init-value
+   (make-action-dispatch
+    ;; init-world
+    )))
+