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