mudsync.scm

   1 (use-modules (8sync systems actors)
   2              (8sync agenda)
   3              (ice-9 format)
   4              (ice-9 match)
   5              (oop goops))
   6
   7
   8 (define %default-server #f)
   9 (define %default-port 8889)
  10
  11 (define-class <network-manager> (<actor>)
  12   (server-socket #:accessor nm-server-socket)
  13   (clients #:accessor nm-clients
  14            #:init-thunk make-hash-table)
  15   (message-handler
  16    #:init-value
  17    (make-action-dispatch
  18     ((start-listening actor message)
  19      (nm-install-socket actor (message-ref message 'server %default-server)
  20                         (message-ref message 'port %default-port))))))
  21
  22 (define-method (nm-close-everything (nm <network-manager>) remove-from-agenda)
  23   ;; close all clients
  24   (hash-for-each
  25    (lambda (client _)
  26      (close client)
  27      (if remove-from-agenda
  28          (8sync-port-remove client)))
  29    (nm-clients nm))
  30   ;; close the server
  31   (close (nm-server-socket nm))
  32   (if remove-from-agenda
  33       (8sync-port-remove (nm-server-socket nm))))
  34
  35 ;; Maximum number of backlogged connections when we listen
  36 (define %maximum-backlog-conns 128)     ; same as SOMAXCONN on Linux 2.X,
  37                                         ; says the intarwebs
  38
  39 (define-method (nm-install-socket (nm <network-manager>) server port)
  40   "Install socket on SERVER with PORT"
  41   (let ((s (socket PF_INET  ; ipv4
  42                    SOCK_STREAM  ; two-way connection-based byte stream
  43                    0))
  44         (addr (if server
  45                   (inet-pton AF_INET server)
  46                   INADDR_LOOPBACK)))
  47     ;; Totally mimed from the Guile manual.  Not sure if we need this, but:
  48     ;; http://www.unixguide.net/network/socketfaq/4.5.shtml
  49     (setsockopt s SOL_SOCKET SO_REUSEADDR 1) ; reuse port even if port is busy
  50     ;; Connecting to a non-specific address:
  51     ;;   (bind s AF_INET INADDR_ANY port)
  52     ;; Should this be an option?  Guess I don't know why we'd need it
  53     ;; @@: If we wanted to support listening on a particular hostname,
  54     ;;   could see 8sync's irc.scm...
  55     (bind s AF_INET addr port)
  56     ;; Listen to connections
  57     (listen s %maximum-backlog-conns)
  58
  59     ;; Throw a system-error rather than block on an (accept)
  60     ;; that has nothing to do
  61     (fcntl s F_SETFL
  62            (logior O_NONBLOCK
  63                    (fcntl s F_GETFL)))
  64
  65     ;; @@: This is used in Guile's http server under the commit:
  66     ;;       * module/web/server/http.scm (http-open): Ignore SIGPIPE. Keeps the
  67     ;;         server from dying in some circumstances.
  68     ;;   (sigaction SIGPIPE SIG_IGN)
  69     ;; Will this break other things that use pipes for us though?
  70
  71     (set! (nm-server-socket nm) s)
  72
  73     (format #t "Listening for clients in pid: ~s\n" (getpid))
  74     (8sync-port s #:read (lambda (s) (nm-new-client nm s)))
  75     ;; TODO: set up periodic close of idle connections
  76     ))
  77
  78 (define-method (nm-new-client (nm <network-manager>) s)
  79   (let* ((client-connection (accept s))
  80          (client-details (cdr client-connection))
  81          (client (car client-connection)))
  82     (format #t "New client: ~s\n" client-details)
  83     (format #t "Client address: ~s\n"
  84             (gethostbyaddr
  85              (sockaddr:addr client-details)))
  86
  87     (hash-set! (nm-clients nm) client #f)
  88     (8sync-port client #:read (nm-make-client-receive nm))))
  89
  90 (define-method (nm-make-client-receive (nm <network-manager>))
  91   (let ((buffer '()))
  92     (define (reset-buffer)
  93       (set! buffer '()))
  94     (define (should-read-char client)
  95       (and (not (port-closed? client))
  96            (char-ready? client)
  97            (not (eof-object? (peek-char client)))))
  98     (define (receive-handler client)
  99       (display "Horray, we got something!\n")
 100       (while (should-read-char client)
 101         (set! buffer (cons (read-char client) buffer))
 102         (match buffer
 103           (;; @@: Do we need the "char?"
 104            (#\newline #\newline (? char? line-chars) ...)
 105            (let ((ready-line (list->string (reverse line-chars))))
 106              ;; reset buffer
 107              (set! buffer '())
 108              ;; run it
 109              (nm-handle-line nm client ready-line)))
 110           (_ #f)))
 111       ;; Shut things down on closed port or EOF object
 112       (cond
 113        ((port-closed? client)
 114         ;; TODO: replace with nm-handle-port-closed
 115         (display "port closed time\n")
 116         (8sync-port-remove client))
 117        ((and (char-ready? client)
 118              (eof-object? (peek-char client)))
 119         (display "port eof time\n")
 120         ;; TODO: replace with nm-handle-port-eof
 121         (close client)
 122         (8sync-port-remove client))))
 123     receive-handler))
 124
 125 (define-method (nm-handle-line (nm <network-manager>) client line)
 126   "Handle an incoming line of input from a client"
 127   (format #t "Got line: ~s\n" line))
 128
 129
 130 ;; (define-method (nm-close-port (nm <network-manager>)))
 131
 132
 133 (define-generic gm-init-world)
 134 (define-class <game-master> (<actor>)
 135   (message-handler
 136    #:init-value
 137    (make-action-dispatch
 138     ;; init-world
 139     )))
 140