git.fiddlerwoaroof.com
Raw Blame History
(defpackage :fwoar.hub.server
  (:use :cl :alexandria :fw.lu :fwoar.string-utils)
  (:export
   #:main
   #:web-main))
(in-package :fwoar.hub.server)

(defun construct-packet (path data)
  (with-output-to-string (s)
    (princ path s)
    (princ #\space s)
    (yason:encode-plist data s)))

(defun main-loop-tick (socket packet)
  (format t "~&~a~%" packet)
  (pzmq:send socket packet)
  (sleep (* (random 5)
            0.01)))

(defun main (data-queue &optional (port "tcp://*:5557"))
  (pzmq:with-socket socket :pub
    (pzmq:bind socket port)
    (loop
      (main-loop-tick socket
                      (apply 'construct-packet
                             (lparallel.queue:pop-queue data-queue))))))

(defun parse-qs (qs)
  (when qs
    (map 'list (op (coerce (split #\= _ :count 2) 'list))
         (split #\& qs))))

(defun web-main (data-queue)
  (woo:run
   (lambda (env)
     ;; (format t "~&~s~%" (hash-table-alist (getf env :headers)))
     (let ((qs (parse-qs (getf env :query-string)))
           (path (getf env :path-info)))
       (if (and (string-equal path "/push")
                (equal (cadr (assoc "hub.mode" qs :test 'equalp)) "subscribe"))
           (progn
             `(200 () (,(cadr (assoc "hub.challenge" qs :test 'equalp)))))
           (progn (lparallel.queue:push-queue
                   (list path
                         (list "method" (format nil ":~a" (getf env :request-method))
                               "path" path
                               "qs" qs
                               "body" (babel:octets-to-string
                                       (read-stream-content-into-byte-vector
                                        (getf env :raw-body)))))

                   data-queue)
                  '(200 () ("pushed"))))))))