tests/server.lisp

   1 ;; multicast requires root
   2 (asdf:oos 'asdf:load-op :zeromq)
   3
   4 (defpackage :cl-cluster-server
   5   (:use :cl))
   6
   7 (in-package :cl-cluster-server)
   8
   9 (defvar *feed-address* "epgm://lo;226.0.0.1:5555")
  10 (defvar *repl-address* "tcp://127.0.0.1:5555")
  11 (defvar *generation* 0)
  12 (defvar *reqs* nil)
  13
  14 (zmq:with-context (ctx 2)
  15   (zmq:with-socket (feed ctx zmq:sub)
  16     (zmq:connect feed *feed-address*)
  17     (zmq:setsockopt feed zmq:subscribe "")
  18     (zmq:with-socket (repl ctx zmq:rep)
  19       (zmq:bind repl *repl-address*)
  20       (let ((msg (make-instance 'zmq:msg)))
  21         (loop
  22            (progn
  23              (format t "~%waiting for message~%")
  24              (zmq:with-polls ((polls . ((feed . zmq:pollin)
  25                                         (repl . zmq:pollin))))
  26                (let ((ret (zmq:poll polls))
  27                      req rep)
  28                  (format t "~a~%" ret)
  29
  30                  (cond
  31                    ((= (car ret) zmq:pollin)
  32                     (zmq:recv feed msg)
  33                     (setq req (zmq:msg-data-as-string msg))
  34                     (format t "new feed: ~s~%" req)
  35                     (handler-case
  36                         (progn
  37                           (eval (read-from-string req))
  38                           (incf *generation*)
  39                           (push req *reqs*))
  40                       (error (c)
  41                         (format t "error: ~a~%" c))))
  42                    ((= (cadr ret) zmq:pollin)
  43                     (zmq:recv repl msg)
  44                     (setq req (zmq:msg-data-as-string msg))
  45                     (format t "->: ~s~%" req)
  46                     (setq rep (format nil "~s"
  47                                       (handler-case
  48                                           (eval (read-from-string req))
  49                                         (error (c)
  50                                           (list 'error (format nil "~a" c))))))
  51                     (format t "<- ~s~%" rep)
  52                     (zmq:send repl (make-instance 'zmq:msg :data rep))))))))))
  53     (sleep 1)))
  54
  55 (tg:gc)
  56 #+sbcl (sb-ext:quit)
  57 #+clisp (ext:quit)
  58
  59 ;