Common Lisp中的SSE服务器

Question

I'm trying to write a simple async server in common lisp. Emphasis on simple. Here's Take 2 (thanks to Rainer for advice and formatting) :

(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 writing:

(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))

How to handle a request:

(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)))))

Publish!

(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*))))))

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))
    (force-output s)
    (push sock *channel*)))

Basic utility:

(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))))

The summary is:

1. It listens on a specified port and dumps request data to the specified stream
2. If it gets a request to "/sub" , it's supposed to keep that socket around for further writes.
3. If it gets a request to "/pub" , it's supposed to send a short message out to all existing subscribers
4. It sends back a plain-text "Ok" on any other request.

All feedback welcome, as usual. As of version 2 (added HTTP-friendly line-endings and a couple strategically placed force-output calls) , browsers seem happier with me, but Chrome still chokes when a message is actually sent to an existing channel. Any idea what the remaining bugs in publish! are?

To be clear, doing

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) };

Now gets me a working event stream in FireFox (it triggers onopen , and triggers an onmessage per sent update) . But fails in Chrome (triggers onopen , with each update triggering onerror instead of onmessage ) .

Any help is appreciated.

Answer 1

One thing I would make sure: it should handle the CRLF correctly on both input and output. CRLF are used in HTTP.

There are two Common Lisp characters: #\\return and #\\linefeed .

Don't use #\\newline . This is a special character which depends on the operating system and the particular CL implementation. On a Unix OS it might be the same as #\\linefeed . On a Windows implementation it may be the same as the sequence of return and linefeed. Thus also don't use newline as a format instruction ~% .

Always explicitly write return and newline in HTTP protocols as line ends. Thus you make sure that your code is portable AND does the right thing.

Also, side note, make sure that the comparison of characters is not done with EQ . Characters are not necessarily eq. Use EQL to compare for identity, numbers and characters.

Answer 2

Ok, so after trying a bunch of things, I have it working, but I have no idea why. That's going to be my next question.

What didn't work:

• varying the position/presence of force-output calls (unless both the subscribe! and the publish! messages are forced, no events fire on the client side at all)
• using babel to encode the SSE events to octets before sending them (this failed; socket-stream s aren't binary-stream s
• Re-writing the server using cl-async , which has its own write routines. The result of that effort can be seen here , but it didn't help at all. Firefox/Iceweasel/Conkeror perform as expected, but Chrom (?:e|ium) still fails the same way. That is, the event stream is open as normal, the onopen event fires, but whenever an actual event is sent, onerror triggers instead of onmessage
• Outputting the bom as specified in the "Parsing an event stream" section of the SSE spec . Doing (write-char (code-char #xfeff) s) before starting up the stream had no effect. The stream would still be accepted by FF et al, and still be rejected by Safari engine browsers.

The only thing left at this point was busting out the packet sniffer. Using sniffit , I discovered that there was in fact a difference between what the nginx PushStream module was emitting, and what was being emitted by my implementation.

Mine (yes, I pretended to be nginx/1.2.0 just to absolutely minimize the differences between responses):

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

The nginx Push Stream module:

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

Adding that "6d" line to my implementation made it work properly. I have no idea why, unless this is some convention for bom s in UTF-8 that I'm unfamiliar with. In other words, re-writing subscribe! as

(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*)))

does the trick. Chrom (?:e|ium) now properly accept these event streams, and don't error on message sends.

Now I need to understand exactly what the hell happened there...