Common Lisp中的SSE服務器

Question

我試圖用通用Lisp編寫一個簡單的異步服務器。 強調簡單。 這是Take 2 （感謝Rainer的建議和格式化） ：

(ql:quickload (list :cl-ppcre :usocket))
(defpackage :test-server (:use :cl :cl-ppcre :usocket))
(in-package :test-server)

(defvar *socket-handle* nil)
(defparameter *channel* nil)

(defclass buffer ()
  ((contents :accessor contents :initform nil)
   (started :reader started :initform (get-universal-time))
   (state :accessor state :initform :empty)))

(defun listen-on (port &optional (stream *standard-output*))
  (setf *socket-handle* (socket-listen "127.0.0.1" port :reuse-address t))
  (let ((conns (list *socket-handle*))
        (buffers (make-hash-table)))
    (loop (loop for ready in (wait-for-input conns :ready-only t)
                do (if (typep ready 'stream-server-usocket)
                       (push (socket-accept ready) conns)
                     (let ((buf (gethash ready buffers (make-instance 'buffer))))
                       (buffered-read! (socket-stream ready) buf)
                       (when (starts-with? (list #\newline #\return #\newline #\return)
                                           (contents buf))
                         (format stream "COMPLETE ~s~%"
                                 (coerce (reverse (contents buf)) 'string))
                         (setf conns (remove ready conns))
                         (remhash ready buffers)
                         (let ((parsed (parse buf)))
                           (format stream "PARSED: ~s~%" parsed)
                           (handle-request ready (parse buf))))))))))

(defmethod parse ((buf buffer))
  (let ((lines (split "\\r?\\n" (coerce (reverse (contents buf)) 'string))))
    (second (split " " (first lines)))))

HTTP編寫：

(defmethod http-write (stream (line-end (eql :crlf)))
  (declare (ignore line-end))
  (write-char #\return stream)
  (write-char #\linefeed stream)
  (values))

(defmethod http-write (stream (line string))
  (write-string line stream)
  (http-write stream :crlf)
  (values))

(defmethod http-write (stream (lst list))
  (mapc (lambda (thing) (http-write stream thing)) lst)
  (values))

如何處理要求：

(defmethod handle-request (socket request)
  (let ((s (socket-stream socket)))
    (cond ((string= "/sub" request)
           (subscribe! socket))
          ((string= "/pub" request)
           (publish! "Got a message!")
           (http-write s (list "HTTP/1.1 200 OK"
                               "Content-Type: text/plain; charset=UTF-8"
                               "Cache-Control: no-cache, no-store, must-revalidate"
                               "Content-Length: 10" :crlf
                               "Published!" :crlf))
           (socket-close socket))
          (t (http-write s (list "HTTP/1.1 200 OK" 
                                 "Content-Type: text/plain; charset=UTF-9" 
                                 "Content-Length: 2" :crlf 
                                 "Ok" :crlf))
             (socket-close socket)))))

發布！

(defun publish! (msg)
  (loop for sock in *channel*
     do (handler-case
            (let ((s (socket-stream sock)))
              (format s "data: ~a" msg)
              (http-write s (list :crlf :crlf))
              (force-output s))
          (error (e)
             (declare (ignore e))
             (setf *channel* (remove sock *channel*))))))

訂閱！

(defun subscribe! (sock)
  (let ((s (socket-stream sock)))
    (http-write s (list "HTTP/1.1 200 OK" 
                        "Content-Type: text/event-stream; charset=utf-8"
                        "Transfer-Encoding: chunked"
                        "Connection: keep-alive"
                        "Expires: Thu, 01 Jan 1970 00:00:01 GMT"
                        "Cache-Control: no-cache, no-store, must-revalidate" :crlf))
    (force-output s)
    (push sock *channel*)))

基本實用程序：

(defmethod starts-with? ((prefix list) (list list) &optional (test #'eql))
  (loop for (p . rest-p) on prefix for (l . rest-l) on list
     when (or (and rest-p (not rest-l)) (not (funcall test p l))) 
     do (return nil)
     finally (return t)))

(defun stop ()
  (when *socket-handle*
    (loop while (socket-close *socket-handle*))
    (setf *socket-handle* nil
      *channel* nil)))

(defmethod buffered-read! (stream (buffer buffer))
  (loop for char = (read-char-no-hang stream nil :eof)
     until (or (null char) (eql :eof char))
     do (push char (contents buffer))))

摘要是：

1. 它偵聽指定的端口並將請求數據轉儲到指定的流
2. 如果它收到對"/sub"的請求，則應該保留該套接字以進行進一步的寫操作。
3. 如果收到"/pub"的請求，則應該向所有現有訂閱者發送一條短消息
4. 它會在其他任何請求上發回plain-text "Ok" 。

與往常一樣，歡迎所有反饋。 從版本2開始（添加了HTTP友好的行尾以及策略性地放置了兩個force-output調用） ，瀏覽器對我來說似乎更快樂，但是當實際將消息發送到現有頻道時，Chrome仍然令人窒息。 知道剩下的錯誤還有多少publish! 是？

明確地說，

var src = new EventSource("/sub");
src.onerror = function (e) { console.log("ERROR", e); };
src.onopen = function (e) { console.log("OPEN", e); };
src.onmessage = function (e) { console.log("MESSAGE", e) };

現在，我在FireFox中獲得了一個工作事件流（它觸發onopen ，並且onmessage發送更新都會觸發onmessage ） 。 但是在Chrome中失敗（觸發onopen ，每次更新觸發onerror而不是onmessage ） 。

任何幫助表示贊賞。

Answer 1

我要確保的一件事：它應該在輸入和輸出上正確處理CRLF。 CRLF在HTTP中使用。

有兩個Common Lisp字符： #\\return和#\\linefeed 。

不要使用#\\newline 。 這是一個特殊字符，取決於操作系統和特定的CL實現。 在Unix操作系統上，它可能與#\\linefeed相同。 在Windows的實現可能是相同的符和換行符的序列。 因此也不要將換行符用作格式指令~% 。

始終在HTTP協議的末尾顯式寫入return和換行符。 因此，您可以確保代碼具有可移植性，並且可以做正確的事情。

另外，請注意，請確保未使用EQ完成字符比較。 字符不一定是eq。 使用EQL比較身份，數字和字符。

Answer 2

好的，所以在嘗試了一堆東西之后，我已經開始工作了，但是我不知道為什么。 這將是我的下一個問題。

什么不工作：

• 更改force-output調用的位置/狀態（除非同時force-output執行subscribe!和publish!消息，否則根本不會在客戶端觸發任何事件）
• 在發送八位字節之前使用babel將SSE事件編碼為八位字節（此操作失敗； socket-stream不是binary-stream
• 使用cl-async重寫服務器，該服務器具有自己的寫入例程。 可以在這里看到這種努力的結果 ，但是完全沒有幫助。 Firefox / Iceweasel / Conkeror的運行正常，但是Chrom (?:e|ium)仍然失敗。 也就是說，事件流正常打開，會觸發onopen事件，但是每發送一個實際事件，就會觸發onerror而不是onmessage
• 按照SSE spec的“解析事件流”部分中的指定輸出bom 。 在啟動流之前執行(write-char (code-char #xfeff) s)無效。 FF等仍將接受該流，而Safari引擎瀏覽器仍將拒絕該流。

此時剩下的唯一事情就是清除數據包嗅探器。 使用sniffit ，我發現nginx PushStream模塊發出的內容與我的實現發出的內容實際上是有區別的。

我的（是的，我假裝為nginx/1.2.0只是為了最大程度地減少響應之間的差異）：

HTTP/1.1 200 OK
Server: nginx/1.2.0
Date: Sun, 15 Oct 2013 10:29:38 GMT-5
Content-Type: text/event-stream; charset=utf-8
Transfer-Encoding: chunked
Connection: keep-alive
Expires: Thu, 01 Jan 1970 00:00:01 GMT
Cache-Control: no-cache, no-store, must-revalidate

data: message goes here

Nginx推送流模塊：

HTTP/1.1 200 OK
Server: nginx/1.2.0
Date: Sun, 15 Sep 2013 14:40:12 GMT
Content-Type: text/event-stream; charset=utf-8
Connection: close
Expires: Thu, 01 Jan 1970 00:00:01 GMT
Cache-Control: no-cache, no-store, must-revalidate
Transfer-Encoding: chunked

6d
data: message goes here

在我的實現中添加“ 6d”行使其可以正常工作。 我不知道為什么，除非這是我不熟悉的UTF-8中bom的約定。 換句話說，重寫subscribe! 如

(defun subscribe! (sock)
  (let ((s (socket-stream sock)))
    (http-write s (list "HTTP/1.1 200 OK" 
                        "Content-Type: text/event-stream; charset=utf-8"
                        "Transfer-Encoding: chunked"
                        "Connection: keep-alive"
                        "Expires: Thu, 01 Jan 1970 00:00:01 GMT"
                        "Cache-Control: no-cache, no-store, must-revalidate" :crlf
                        "6d"))
    (force-output s)
    (push sock *channel*)))

絕招。 Chrom (?:e|ium)現在可以正確接受這些事件流，並且在消息發送時不會出錯。

現在我需要確切地了解那里發生了什么...