server/server.lisp

   1 ;;; -*- mode: lisp; syntax: common-lisp; package: existenz-server; coding: utf-8-unix; -*-
   2
   3 (in-package #:existenz-server)
   4 \f
   5 #-(or)
   6 (progn
   7   (defun start-server (&optional (host +ipv6-unspecified+) (port 4000))
   8     (spawn-thread (lambda ()
   9                     (run-server host port))
  10                  :name "Existenz Server IO"))
  11
  12   (defun run-server (host port)
  13     (with-event-base (event-base)
  14       (let ((server (make-socket :ipv6 T
  15                                  :type :datagram
  16                                  :local-host host
  17                                  :local-port port
  18                                  :reuse-address T)))
  19         (unwind-protect (dispatch-server event-base server)
  20           (close server)))))
  21
  22   (defun dispatch-server (event-base server)
  23     (flet ((read-event (fd event-type errorp)
  24              (read-server-event server fd event-type errorp)))
  25       (set-io-handler event-base (fd-of server) :read #'read-event)
  26       (iterate
  27         (iterate
  28           (for (values message from) = (recv-nowait distlisp::*current-process*))
  29           (while from)
  30           (case message
  31             (:exit (abort-thread))))
  32         (event-dispatch event-base :timeout 0.001)))))
  33 \f
  34 #+(or)
  35 (progn
  36   (defun start-server (&optional (host +ipv6-unspecified+) (port 4000))
  37     (multiple-value-bind (left right)
  38         (iolib.syscalls:pipe)
  39       (make-thread (lambda ()
  40                      (unwind-protect
  41                           (run-server host port right)
  42                        (iolib.syscalls:close left)
  43                        (iolib.syscalls:close right)))
  44                    :name "EXISTENZ-SERVER-IO")
  45       left))
  46
  47   (defun run-server (host port pipe)
  48     (with-event-base (event-base)
  49       (let ((server (make-socket :ipv6 T
  50                                  :type :datagram
  51                                  :local-host host
  52                                  :local-port port
  53                                  :reuse-address T)))
  54         (unwind-protect (dispatch-server event-base server pipe)
  55           (close server)))))
  56
  57   (defun dispatch-server (event-base server pipe)
  58     (flet ((read-event (fd event-type errorp)
  59              (read-server-event fd event-type errorp server))
  60            (read-pipe (fd event-type errorp)
  61              (declare (ignore fd event-type errorp))
  62              (format T "received signal on pipe~%")
  63              (exit-event-loop event-base)))
  64       (set-io-handler event-base (fd-of server) :read #'read-event)
  65       (set-io-handler event-base pipe :read #'read-pipe)
  66       (event-dispatch event-base))))
  67
  68 (defvar *clients* (make-hash-table :test 'eql))
  69
  70 (defun read-server-event (server fd event-type errorp)
  71   (declare (ignore fd event-type errorp))
  72   (multiple-value-bind (buffer length host port)
  73       (receive-from server :size 500)
  74     (format T "received ~A bytes from ~A:~A~%"
  75             length host port)
  76     (unless (>= length 4)
  77       (format T "malformed message, length ~D of 4~%" length)
  78       (send-to server #(1 0 0 1) :remote-host host :remote-port port)
  79       (return-from read-server-event))
  80     (let ((version (aref buffer 0)))
  81       (format T "version ~D~%" version)
  82       (let ((sequence-number (+ (ash (aref buffer 1) 8) (aref buffer 2))))
  83         (format T "sequence number ~D~%" sequence-number)
  84         (let ((event-type (aref buffer 3)))
  85           (format T "event type ~D~%" event-type))))))
  86
  87 #+(or)
  88 (defenum event-type
  89   :error                                ; transport error
  90   :ping                                 ; hello there
  91   :pong                                 ; yes, i heard you
  92   :login                                ; now assign me an identifier
  93   :logged-in)                           ; and this is your session id
  94
  95 ;; movement, actions, updates?
  96 ;; data via http or bittorrent
  97
  98 ;; :ping -> :pong
  99 ;; :login -> :error, :logged-in
 100
 101 #+(or)
 102 (defun handle-event/default-state (buffer)
 103   (case event-type
 104     (:ping (send-event client :pong))
 105     (T (send-event client :error))))