Updating mudsync for 8sync suspendable-ports refactor
authorChristopher Allan Webber <cwebber@dustycloud.org>
Sun, 11 Dec 2016 00:00:25 +0000 (18:00 -0600)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Sun, 11 Dec 2016 00:02:06 +0000 (18:02 -0600)
configure.ac
mudsync/networking.scm

index 26d5eb95f0b0fd47b1c5902f40a3314789bd3277..34ed107a52977ce384a8aaf57c5f308ed8789513 100644 (file)
@@ -1,6 +1,6 @@
 AC_INIT([mudsync], [0.1.0-pre], [cwebber@dustycloud.org])
 
-PKG_CHECK_MODULES([GUILE], [guile-2.0])
+PKG_CHECK_MODULES([GUILE], [guile-2.2])
 
 AM_INIT_AUTOMAKE([-Wall -Werror foreign])
 
index 9f98a9ad112680be65d5a936b5323b8f3b2c3337..525997546ad024f05298bcacfc19e9b0af19fef0 100644 (file)
@@ -21,6 +21,7 @@
   #:use-module (8sync agenda)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
   #:use-module (oop goops)
 
   #:export (;; Should we be exporting these?
     ((send-to-client actor message client data)
      (nm-send-to-client-id actor client data)))))
 
-(define-method (nm-close-everything (nm <network-manager>) 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))))
+;;; TODO: We should provide something like this, but this isn't used currently,
+;;;    and uses old deprecated code (the 8sync-port-remove stuff).
+;; (define-method (nm-close-everything (nm <network-manager>) 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,
 
 (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?
-
-    (slot-set! nm 'server-socket 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)
+  (define s
+    (socket PF_INET  ; ipv4
+            SOCK_STREAM  ; two-way connection-based byte stream
+            0))
+  (define 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)
+
+  ;; Make port non-blocking
+  (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?
+
+  (slot-set! nm 'server-socket s)
+
+  (format #t "Listening for clients in pid: ~s\n" (getpid))
+
+  ;; TODO: set up periodic close of idle connections?
+  (let loop ()
+    ;; (yield)  ;; @@: Do we need this?
+    (define client-connection (accept s))
+    (8sync (nm-new-client nm s client-connection))
+    (loop)))
+
+(define (nm-new-client nm s client-connection)
   "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)
+  (define client-details (cdr client-connection))
+  (define client (car client-connection))
+  (define client-id (big-random-number))
+  (format #t "New client: ~s\n" client-details)
+  (format #t "Client address: ~s\n"
+          (gethostbyaddr
+           (sockaddr:addr client-details)))
+  (fcntl client F_SETFL (logior O_NONBLOCK (fcntl client F_GETFL)))
+  (hash-set! (nm-clients nm) client-id client)
+  (<- nm (nm-send-input-to nm) 'new-client #:client client-id)
+  (nm-client-receive-loop nm client client-id))
+
+(define (nm-client-receive-loop nm client 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 (loop)
+    (define line (string-trim-right (read-line client) #\return))
+    (nm-handle-line nm client client-id line)
+    (cond
+     ;; The port's been closed for some reason, so stop looping
+     ((port-closed? client)
+      (nm-handle-port-closed nm client client-id))
+     ;; We've reached the EOF object, which means we should close
+     ;; the port ourselves and stop looping
+     ((eof-object? (peek-char client))
+      (nm-handle-port-eof nm client client-id))
+     ;; Otherwise, let's read till the next line!
+     (else (loop))))
+  (loop))
 
 (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)
   (<- nm (nm-send-input-to nm) 'client-closed #:client 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)
+      (close client)
   (hash-remove! (nm-clients nm) client-id)
   (<- nm (nm-send-input-to nm) 'client-closed #:client client-id))