我正在尝试在常见的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))))
摘要是：
"/sub"的请求，它应该保留该套接字以进行进一步的写入。"/pub"的请求，它应该向所有现有订阅者发送短消息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）。但在Chrome 中失败（触发onopen，每次更新都会触发onerror而不是onmessage）。
感谢任何帮助。
答案 0 :(得分：2)
我要确定一件事：它应该在输入和输出上正确处理CRLF。 CRLF用于HTTP。
有两个Common Lisp字符：#\return和#\linefeed。
请勿使用#\newline。这是一个特殊字符，取决于操作系统和特定的CL实现。在Unix OS上，它可能与#\linefeed相同。在Windows实现中，可能与return和linefeed的序列相同。因此，也不要使用换行符作为格式指令~%。
始终在HTTP协议中明确地将return和newline写为行结束。因此，您确保您的代码是可移植的并做正确的事。
另外，请注意，请确保不使用EQ进行字符比较。字符不一定是eq。使用EQL比较身份，数字和字符。
答案 1 :(得分：1)
好的，所以在尝试了很多东西之后，我有它的工作，但我不知道为什么。那将是我的下一个问题。
没有工作的内容：
force-output次呼叫的位置/存在（除非强制subscribe!和publish!消息，否则客户端不会触发任何事件）babel在发送之前将SSE事件编码为八位字节（此失败; socket-stream s不是binary-stream s cl-async重写服务器，(?:e|ium)有自己的写例程。可以看到这种努力的结果here，但它根本没有帮助。 Firefox / Iceweasel / Conkeror按预期执行，但Chrom onopen仍然以同样的方式失败。也就是说，事件流正常打开，onerror事件触发，但每当发送实际事件时，onmessage触发而不是bom (write-char (code-char #xfeff) s)。在启动流之前执行sniffit无效。 FF等人仍然接受该流，并且仍被Safari引擎浏览器拒绝。此时唯一剩下的就是破坏了数据包嗅探器。使用nginx/1.2.0，我发现实际上the nginx PushStream module正在发出的内容与我的实现所发出的内容之间存在差异。
我的（是的，我假装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
只是为了绝对减少回复之间的差异）：
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
nginx Push Stream模块：
bom在我的实现中添加“6d”行使其正常工作。我不知道为什么，除非这是我不熟悉的UTF-8 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*)))
为
(?:e|ium)诀窍。 Chrom {{1}}现在正确接受这些事件流，并且在消息发送时不会出错。
现在我需要明白到底发生了什么......