500 行代码或更少
基于事件驱动的 Web 框架

Leo Zovic

Leo（网络上更广为人知的名字是 inaimathi）是一位正在康复的平面设计师，曾专业编写 Scheme、Common Lisp、Erlang、Javascript、Haskell、Clojure、Go、Python、PHP 和 C 代码。他目前在博客上分享编程相关内容，玩桌游，并在加拿大多伦多的一家 Ruby 起步公司工作。

2013 年，我决定编写一个 基于 Web 的游戏原型工具 用于卡牌和棋盘游戏，名为 House。在这些类型的游戏中，通常一名玩家需要等待另一名玩家行动；但是，当另一名玩家最终采取行动时，我们希望等待的玩家能够尽快收到通知。

事实证明，这个问题比看起来更复杂。在本章中，我们将探讨使用 HTTP 构建这种交互的弊端，然后我们将使用 Common Lisp 构建一个 Web 框架，使我们能够在未来解决类似的问题。

HTTP 服务器的基本原理

从最简单的层面上讲，HTTP 交换是一个单一请求，之后紧随一个单一响应。客户端发送一个请求，其中包括资源标识符、HTTP 版本标签、一些标题和一些参数。服务器解析该请求，确定如何处理它，并发送一个响应，其中包含相同的 HTTP 版本标签、响应代码、一些标题和一个响应主体。

请注意，在本说明中，服务器对来自特定客户端的请求做出响应。在我们的例子中，我们希望每个玩家都能在 任何 行动发生后立即收到更新，而不是仅在他们自己的行动发生时才收到通知。这意味着我们需要服务器在没有首先收到信息请求的情况下，向客户端 推送 消息。1

有几种标准方法可以实现 HTTP 上的服务器推送。

Comet/长轮询

"长轮询" 技术要求客户端在收到响应后立即向服务器发送新请求。服务器不会立即完成该请求，而是等待后续事件才能做出响应。这有点像概念上的区别，因为客户端仍然在每次更新时都采取行动。

服务器发送事件 (SSE)

服务器发送事件要求客户端发起连接并保持打开状态。服务器会定期将新数据写入连接，而不会关闭连接，客户端会在新消息到达时解释传入的这些消息，而不是等待响应连接终止。与 Comet/长轮询方法相比，这种方法的效率更高，因为每条消息都不必承担新 HTTP 标题的开销。

WebSocket

WebSocket 是建立在 HTTP 之上的通信协议。服务器和客户端打开一个 HTTP 会话，然后执行握手和协议升级。最终结果是它们仍然通过 TCP/IP 进行通信，但它们根本不使用 HTTP 进行通信。与 SSE 相比，这种方法的优势在于您可以自定义协议以提高效率。

长连接

这三种方法彼此之间大不相同，但它们都具有一个重要的共同点：它们都依赖于长连接。长轮询依赖于服务器保留请求，直到有新数据可用；SSE 在客户端和服务器之间保持一个开放的流，数据会定期写入该流；WebSocket 会更改特定连接使用的协议，但会保持连接打开状态。

要了解这可能会给您常用的 HTTP 服务器带来哪些问题，让我们考虑一下底层实现的工作原理。

传统的 HTTP 服务器架构

 

单个 HTTP 服务器会并发处理许多请求。历史上，许多 HTTP 服务器都采用过 每个请求一个线程 的架构。也就是说，对于每个传入请求，服务器都会创建一个线程来完成响应所需的处理。

由于这些连接都旨在保持短暂的连接，因此我们不需要并行执行许多线程来处理所有连接。此模型还简化了服务器的 实现，因为服务器程序员可以编写代码，就好像一次只处理一个连接一样。它还让我们能够通过杀死相应的线程并让垃圾收集器执行其工作，自由地清理失败或“僵尸”连接及其关联的资源。

关键的观察结果是，承载“传统” Web 应用程序的 HTTP 服务器，在具有 \(N\) 个并发用户的情况下，可能只需要并行处理 \(N\) 个请求中的一小部分就能成功。对于我们正在尝试构建的交互式应用程序类型，\(N\) 个用户几乎肯定会要求应用程序同时并行维护至少 \(N\) 个连接。

保持长连接会导致我们：

有一些编程环境，如 Racket、Erlang 和 Haskell，它们提供了类似线程的结构，这些结构足够“轻量级”，可以考虑第一个选项。这种方法要求程序员明确处理同步问题，而这些问题在连接长时间保持打开状态并且可能都在争用类似资源的系统中会更加普遍。具体来说，如果我们有一些由多个用户同时共享的中心数据，我们需要以某种方式协调对该数据的读写操作。

如果我们没有廉价的线程可用，或者我们不愿意使用显式同步，则必须考虑让单个线程处理多个连接。2 在这种模型中，我们的单个线程会同时处理许多请求的小部分，并在它们之间尽可能高效地切换。这种系统架构模式最常被称为 事件驱动 或 基于事件。3

由于我们只管理一个线程，因此不必过多地担心保护共享资源免受同时访问。但是，在这个模型中，我们确实遇到了一个独特的问题。由于我们的单个线程同时处理所有正在进行的请求，因此必须确保它 永远不会阻塞。在任何连接上阻塞都会阻止整个服务器在任何其他请求上取得进展。如果当前连接无法进一步处理，我们必须能够继续处理其他客户端，并且需要以一种不会丢弃迄今为止完成的工作的方式来做到这一点。4

虽然程序员通常不会明确地指示线程停止工作，但许多常见操作都有阻塞的风险。由于线程非常普遍，并且对异步性的推理给程序员带来了沉重的负担，因此许多语言及其框架都假设在 I/O 上阻塞是一个理想的属性。这使得意外地在某个地方阻塞变得非常容易。幸运的是，Common Lisp 确实为我们提供了一组最小的异步 I/O 原语，我们可以在此基础上构建。

架构决策

现在我们已经研究了这个问题的背景，我们已经到达需要对 要 构建的内容做出明智决策的阶段。

在我开始考虑这个项目时，Common Lisp 没有完整的绿色线程实现，而 标准可移植线程库 并不符合“真正非常便宜”的标准。这些选项归结为选择另一种语言，或者为我的目的构建一个事件驱动的 Web 服务器。我选择了后者。

除了服务器架构之外，我们还需要选择三种服务器推送方法中的哪一种。我们正在考虑的用例（交互式多人棋盘游戏）要求频繁更新每个客户端，但来自每个客户端的请求相对较少，这适合使用 SSE 方法来推送更新，因此我们将使用这种方法。

现在我们已经说明了我们的架构决策，并决定了模拟客户端和服务器之间双向通信的机制，让我们开始构建我们的 Web 框架。我们将首先构建一个相对“愚蠢”的服务器，然后将其扩展为一个 Web 应用程序框架，让我们能够专注于高度交互式程序需要做什么，而不是如何做到这一点。

构建事件驱动的 Web 服务器

大多数使用单个进程来管理并发工作流的程序都使用一种称为 事件循环 的模式。让我们看看我们的 Web 服务器的事件循环可能是什么样子。

事件循环

我们的事件循环需要：

(defmethod start ((port integer))
  (let ((server (socket-listen
         usocket:*wildcard-host* port
         :reuse-address t
         :element-type 'octet))
    (conns (make-hash-table)))
    (unwind-protect
     (loop (loop for ready
          in (wait-for-input
              (cons server (alexandria:hash-table-keys conns))
              :ready-only t)
          do (process-ready ready conns)))
      (loop for c being the hash-keys of conns
     do (loop while (socket-close c)))
      (loop while (socket-close server)))))

如果您以前从未编写过 Common Lisp 程序，则此代码块需要一些解释。我们在这里编写的是一个 方法定义。虽然 Lisp 通常被称为函数式语言，但它也有自己的面向对象编程系统，称为“Common Lisp Object System”，通常缩写为“CLOS”。5

CLOS 和泛型函数

在 CLOS 中，我们不是专注于类和方法，而是编写 泛型函数，这些函数作为 方法 的集合实现。在此模型中，方法并不属于类，而是专门针对类型。6 我们刚刚编写的 start 方法是一个一元方法，其中参数 port 专门针对类型 integer。这意味着我们可以有几种 start 的实现，其中 port 的类型不同，并且在调用 start 时，运行时会根据 port 的类型选择要使用的实现。

更一般地说，方法可以专门针对多个参数。当调用一个 method 时，运行时会：

处理套接字

我们将在 process-ready 中看到另一个泛型函数在工作，该函数是在我们之前的事件循环中调用的。它根据我们正在处理的套接字类型，使用两种方法之一处理准备好的套接字。

我们关注的两种类型是 stream-usocket，它表示将发出请求并期望接收一些数据的客户端套接字，以及 stream-server-usocket，它表示我们本地 TCP 监听器，它将拥有新的客户端连接供我们处理。

如果 stream-server-socket ready，这意味着有一个新的客户端套接字正在等待开始对话。我们调用 socket-accept 来接受连接，然后将结果放入我们的连接表中，以便我们的事件循环可以开始与其他连接一起处理它。

(defmethod process-ready ((ready stream-server-usocket) (conns hash-table))
  (setf (gethash (socket-accept ready :element-type 'octet) conns) nil))

当 stream-usocket ready 时，这意味着它有一些字节准备供我们读取。（也可能对方已终止连接。）

(defmethod process-ready ((ready stream-usocket) (conns hash-table))
  (let ((buf (or (gethash ready conns)
         (setf (gethash ready conns)
               (make-instance 'buffer :bi-stream (flex-stream ready))))))
    (if (eq :eof (buffer! buf))
    (ignore-errors
      (remhash ready conns)
      (socket-close ready))
    (let ((too-big?
           (> (total-buffered buf)
          +max-request-size+))
          (too-old?
           (> (- (get-universal-time) (started buf))
          +max-request-age+))
          (too-needy?
           (> (tries buf)
          +max-buffer-tries+)))
      (cond (too-big?
         (error! +413+ ready)
         (remhash ready conns))
        ((or too-old? too-needy?)
         (error! +400+ ready)
         (remhash ready conns))
        ((and (request buf) (zerop (expecting buf)))
         (remhash ready conns)
         (when (contents buf)
           (setf (parameters (request buf))
             (nconc (parse buf) (parameters (request buf)))))
         (handler-case
             (handle-request ready (request buf))
           (http-assertion-error () (error! +400+ ready))
           ((and (not warning)
             (not simple-error)) (e)
             (error! +500+ ready e))))
        (t
         (setf (contents buf) nil)))))))

这比第一种情况更复杂。我们：

  1. 获取与该套接字关联的缓冲区，如果它还不存在则创建它；
  2. 将输出读入该缓冲区，这在调用buffer!时发生；
  3. 如果该读取得到一个:eof，则另一端挂断了，因此我们丢弃套接字及其缓冲区；
  4. 否则，我们检查缓冲区是否为complete?、too-big?、too-old?或too-needy?。如果是，我们将其从连接表中删除并返回相应的 HTTP 响应。

这是我们第一次在事件循环中看到 I/O。在我们关于传统 HTTP 服务器架构的讨论中，我们提到，在事件驱动的系统中，我们必须非常小心地处理 I/O，因为我们可能会意外地阻塞我们的单线程。那么，我们在这里做了什么来确保这种情况不会发生呢？我们必须探索我们对buffer!的实现，以找出它的确切工作原理。

处理连接而不阻塞

我们处理连接而不阻塞的方法的基础是库函数read-char-no-hang，它在调用没有可用数据的流时立即返回nil。如果有数据要读取，我们将使用缓冲区来存储此连接的中间输入。

(defmethod buffer! ((buffer buffer))
  (handler-case
      (let ((stream (bi-stream buffer)))
        (incf (tries buffer))
        (loop for char = (read-char-no-hang stream) until (null char)
           do (push char (contents buffer))
           do (incf (total-buffered buffer))
           when (request buffer) do (decf (expecting buffer))
           when (line-terminated? (contents buffer))
           do (multiple-value-bind (parsed expecting) (parse buffer)
            (setf (request buffer) parsed
                  (expecting buffer) expecting)
            (return char))
           when (> (total-buffered buffer) +max-request-size+) return char
           finally (return char)))
    (error () :eof)))

当在buffer上调用buffer!时，它

它还跟踪任何\r\n\r\n序列，以便我们以后可以检测到完整的请求。最后，如果出现任何错误，它将返回一个:eof来指示process-ready应该丢弃此连接。

buffer类型是一个 CLOS 类。CLOS 中的类允许我们定义具有名为slots的字段的类型。我们没有看到与buffer相关的行为在类定义上，因为（正如我们已经了解到的），我们使用buffer!这样的泛型函数来实现。

defclass允许我们指定 getter/setter（reader/accessor）和插槽初始化程序；:initform指定默认值，而:initarg标识一个钩子，make-instance的调用者可以使用它来提供默认值。

(defclass buffer ()
  ((tries :accessor tries :initform 0)
   (contents :accessor contents :initform nil)
   (bi-stream :reader bi-stream :initarg :bi-stream)
   (total-buffered :accessor total-buffered :initform 0)
   (started :reader started :initform (get-universal-time))
   (request :accessor request :initform nil)
   (expecting :accessor expecting :initform 0)))

我们的buffer类有七个插槽

解释请求

  现在我们已经了解了如何从汇集到缓冲区中的数据片段中逐步组装完整的请求，那么当我们准备处理完整的请求时会发生什么呢？这发生在handle-request方法中。

(defmethod handle-request ((socket usocket) (req request))
  (aif (lookup (resource req) *handlers*)
       (funcall it socket (parameters req))
       (error! +404+ socket)))

此方法添加了另一层错误处理，以便如果请求过旧、过大或需要过多，我们可以发送400响应来指示客户端向我们提供了某些错误或缓慢的数据。但是，如果这里发生任何其他错误，则是因为程序员在定义处理程序时犯了错误，这应该被视为500错误。这将通知客户端由于其合法请求而导致服务器出现问题。

如果请求格式正确，我们会完成一个小而明显的工作，即在*handlers*表中查找所请求的资源。如果我们找到一个，我们会funcall it，并将客户端socket以及解析后的请求参数传递过去。如果*handlers*表中没有匹配的处理程序，我们会改为发送404错误。处理程序系统将是我们完整的web 框架的一部分，我们将在后面的部分中讨论。

我们还没有看到如何从缓冲区中解析和解释请求。让我们接下来看看这一点

(defmethod parse ((buf buffer))
  (let ((str (coerce (reverse (contents buf)) 'string)))
    (if (request buf)
        (parse-params str)
        (parse str))))

此高级方法委托给parse的专门化，它适用于纯字符串，或委托给parse-params，它将缓冲区内容解释为 HTTP 参数。根据我们已经处理了多少请求，它们会被调用；最后的parse发生在我们已经在buffer中保存了部分request时，此时我们只希望解析请求主体。

(defmethod parse ((str string))
  (let ((lines (split "\\r?\\n" str)))
    (destructuring-bind (req-type path http-version) (split " " (pop lines))
      (declare (ignore req-type))
      (assert-http (string= http-version "HTTP/1.1"))
      (let* ((path-pieces (split "\\?" path))
         (resource (first path-pieces))
         (parameters (second path-pieces))
         (req (make-instance 'request :resource resource)))
    (loop
       for header = (pop lines)
       for (name value) = (split ": " header)
       until (null name)
       do (push (cons (->keyword name) value) (headers req)))
    (setf (parameters req) (parse-params parameters))
    req))))

(defmethod parse-params ((params null)) nil)

(defmethod parse-params ((params string))
  (loop for pair in (split "&" params)
     for (name val) = (split "=" pair)
     collect (cons (->keyword name) (or val ""))))

在parse方法专门针对string时，我们将内容转换为可用的片段。我们对字符串进行处理，而不是直接处理缓冲区，因为这使得在解释器或 REPL 等环境中更容易测试实际的解析代码。

解析过程为

  1. 在"\\r?\\n"上分割。
  2. 将该行的第一行在" "上分割，以获取请求类型（POST、GET等）/URI 路径/http 版本。
  3. 断言我们正在处理HTTP/1.1请求。
  4. 在"?"上分割 URI 路径，这将为我们提供与任何GET参数分开的纯资源。
  5. 使用资源创建一个新的request实例。
  6. 使用每个分割的头行填充该request实例。
  7. 将该request的参数设置为解析我们GET参数的结果。

正如你现在可能预料到的，request是 CLOS 类的实例

    (defclass request ()
      ((resource :accessor resource :initarg :resource)
       (headers :accessor headers :initarg :headers :initform nil)
       (parameters :accessor parameters :initarg :parameters :initform nil)))

我们现在已经了解了我们的客户端如何发送请求，并让服务器解释和处理这些请求。我们作为核心服务器接口必须实现的最后一件事是将响应写回客户端的功能。

渲染响应

在讨论渲染响应之前，我们必须考虑，我们可能返回给客户端的响应有两种类型。第一种是“正常”的 HTTP 响应，包含 HTTP 头部和主体。我们使用response类的实例来表示这些类型的响应

(defclass response ()
  ((content-type
    :accessor content-type :initform "text/html" :initarg :content-type)
   (charset
    :accessor charset :initform "utf-8")
   (response-code
    :accessor response-code :initform "200 OK" :initarg :response-code)
   (keep-alive?
    :accessor keep-alive? :initform nil :initarg :keep-alive?)
   (body
    :accessor body :initform nil :initarg :body)))

第二种是SSE 消息，我们将使用它向客户端发送增量更新。

(defclass sse ()
  ((id :reader id :initarg :id :initform nil)
   (event :reader event :initarg :event :initform nil)
   (retry :reader retry :initarg :retry :initform nil)
   (data :reader data :initarg :data)))

每当我们收到完整的 HTTP 请求时，我们会发送 HTTP 响应；但是，我们如何知道何时以及何地发送 SSE 消息，而无需原始的客户端请求？

一个简单的解决方案是注册通道7，我们将在需要时订阅这些通道socket。

(defparameter *channels* (make-hash-table))

(defmethod subscribe! ((channel symbol) (sock usocket))
  (push sock (gethash channel *channels*))
  nil)

然后，我们可以立即向这些通道publish!通知，只要这些通知可用。

(defmethod publish! ((channel symbol) (message string))
  (awhen (gethash channel *channels*)
     (setf (gethash channel *channels*)
           (loop with msg = (make-instance 'sse :data message)
          for sock in it
          when (ignore-errors
             (write! msg sock)
             (force-output (socket-stream sock))
             sock)
          collect it))))

在publish!中，我们调用write!来实际向套接字写入sse。我们还需要write!在response上的专门化，以便写入完整的 HTTP 响应。让我们先处理 HTTP 情况。

(defmethod write! ((res response) (socket usocket))
  (handler-case
      (with-timeout (.2)
    (let ((stream (flex-stream socket)))
      (flet ((write-ln (&rest sequences)
           (mapc (lambda (seq) (write-sequence seq stream)) sequences)
           (crlf stream)))
        (write-ln "HTTP/1.1 " (response-code res))
        (write-ln
         "Content-Type: " (content-type res) "; charset=" (charset res))
        (write-ln "Cache-Control: no-cache, no-store, must-revalidate")
        (when (keep-alive? res)
          (write-ln "Connection: keep-alive")
          (write-ln "Expires: Thu, 01 Jan 1970 00:00:01 GMT"))
        (awhen (body res)
          (write-ln "Content-Length: " (write-to-string (length it)))
          (crlf stream)
          (write-ln it))
        (values))))
    (trivial-timeout:timeout-error ()
      (values))))

此版本的write!采用一个response和一个名为sock的usocket，并将内容写入sock提供的流。我们在本地定义函数write-ln，它接收一些序列，并将它们写入流，后跟crlf。这是为了可读性；我们也可以直接调用write-sequence/crlf。

请注意，我们再次执行“不能阻塞”的操作。虽然写入很可能被缓冲，并且阻塞的风险比读取低，但我们仍然不希望服务器在出现问题时停滞不前。如果写入花费超过 0.2 秒8，我们只会继续执行（抛出当前套接字），而不是等待更长时间。

写入SSE在概念上类似于写入response

(defmethod write! ((res sse) (socket usocket))
  (let ((stream (flex-stream socket)))
    (handler-case
    (with-timeout (.2)
      (format
       stream "~@[id: ~a~%~]~@[event: ~a~%~]~@[retry: ~a~%~]data: ~a~%~%"
       (id res) (event res) (retry res) (data res)))
      (trivial-timeout:timeout-error ()
        (values)))))

这比处理完整的 HTTP 响应更简单，因为 SSE 消息标准没有指定CRLF行尾，因此我们可以使用一个format调用来完成。~@[...~]块是条件指令，允许我们优雅地处理nil插槽。例如，如果(id res)非空，我们将输出id: <the id here>，否则我们将完全忽略该指令。我们增量更新data的有效负载是sse的唯一必需插槽，因此我们可以包含它，而无需担心它为空。同样，我们不会等待太长时间。如果写入在 0.2 秒后没有完成，我们将超时并继续执行下一项操作。

错误响应

到目前为止，我们对请求/响应循环的处理还没有涵盖出现问题时会发生什么。具体来说，我们在handle-request和process-ready中使用了error!函数，但没有描述它的作用。

(define-condition http-assertion-error (error)
  ((assertion :initarg :assertion :initform nil :reader assertion))
  (:report (lambda (condition stream)
         (format stream "Failed assertions '~s'"
             (assertion condition)))))

define-condition在 Common Lisp 中创建新的错误类。在本例中，我们定义了一个 HTTP 断言错误，并声明它将专门需要知道它正在执行的实际断言，以及将其输出到流的方法。在其他语言中，你会称之为方法。在这里，它是一个函数，它碰巧是类的插槽值。

我们如何向客户端表示错误？让我们定义我们将经常使用的4xx和5xx类 HTTP 错误

(defparameter +404+
  (make-instance
   'response :response-code "404 Not Found"
   :content-type "text/plain"
   :body "Resource not found..."))

(defparameter +400+
  (make-instance
   'response :response-code "400 Bad Request"
   :content-type "text/plain"
   :body "Malformed, or slow HTTP request..."))

(defparameter +413+
  (make-instance
   'response :response-code "413 Request Entity Too Large"
   :content-type "text/plain"
   :body "Your request is too long..."))

(defparameter +500+
  (make-instance
   'response :response-code "500 Internal Server Error"
   :content-type "text/plain"
   :body "Something went wrong on our end..."))

现在我们可以看到error!的作用了

(defmethod error! ((err response) (sock usocket) &optional instance)
  (declare (ignorable instance))
  (ignore-errors
    (write! err sock)
    (socket-close sock)))

它接受一个错误响应和一个套接字，将响应写入套接字并关闭它（忽略错误，以防另一端已经断开连接）。这里的instance参数用于日志记录/调试目的。

有了这些，我们就有了可以响应 HTTP 请求或发送 SSE 消息的事件驱动 web 服务器，并附带错误处理功能！

将服务器扩展为 web 框架

我们现在已经构建了一个相当实用的 web 服务器，它可以将请求、响应和消息传送到客户端。由该服务器托管的任何 web 应用程序的实际工作都是通过委托给处理程序函数来完成的，这些处理程序函数在解释请求中进行了介绍，但没有详细说明。

我们的服务器和托管应用程序之间的接口非常重要，因为它决定了应用程序程序员使用我们基础设施的难易程度。理想情况下，我们的处理程序接口应该将请求中的参数映射到执行实际工作的函数

(define-handler (source :is-stream? nil) (room)
  (subscribe! (intern room :keyword) sock))

(define-handler (send-message) (room name message)
  (publish! (intern room :keyword)
        (encode-json-to-string
         `((:name . ,name) (:message . ,message)))))

(define-handler (index) ()
  (with-html-output-to-string (s nil :prologue t :indent t)
    (:html
     (:head (:script
         :type "text/javascript"
         :src "/static/js/interface.js"))
     (:body (:div :id "messages")
        (:textarea :id "input")
        (:button :id "send" "Send")))))

我在编写 House 时考虑过的一个问题是，就像任何对更大互联网开放的应用程序一样，它会处理来自不受信任客户端的请求。能够明确地说出每个请求应该包含什么类型的数据，这将是一件好事，方法是提供一个描述数据的模式。我们之前的处理程序列表将如下所示

(defun len-between (min thing max)
  (>= max (length thing) min))

(define-handler (source :is-stream? nil)
    ((room :string (len-between 0 room 16)))
  (subscribe! (intern room :keyword) sock))

(define-handler (send-message)
    ((room :string (len-between 0 room 16))
     (name :string (len-between 1 name 64))
     (message :string (len-between 5 message 256)))
  (publish! (intern room :keyword)
        (encode-json-to-string
         `((:name . ,name) (:message . ,message)))))

(define-handler (index) ()
  (with-html-output-to-string (s nil :prologue t :indent t)
    (:html
     (:head (:script
         :type "text/javascript"
         :src "/static/js/interface.js"))
     (:body (:div :id "messages")
        (:textarea :id "input")
        (:button :id "send" "Send")))))

虽然我们仍然使用 Lisp 代码，但这个接口开始看起来几乎像一种声明式语言，在这种语言中，我们声明了我们希望处理程序验证什么，而无需过多考虑它们将如何执行。我们正在做的是构建一个用于处理程序函数的领域特定语言（DSL）；也就是说，我们创建了一种特定的约定和语法，使我们能够简洁地表达我们希望处理程序验证的内容。这种构建小型语言来解决眼前问题的做法经常被 Lisp 程序员使用，它是一种有用的技术，可以应用于其他编程语言。

用于处理程序的 DSL

现在我们已经对我们希望处理程序 DSL 呈现的方式有了松散的规范，我们如何实现它？也就是说，当我们调用define-handler时，我们具体希望发生什么？让我们考虑上面send-message的定义

(define-handler (send-message)
    ((room :string (len-between 0 room 16))
     (name :string (len-between 1 name 64))
     (message :string (len-between 5 message 256)))
  (publish! (intern room :keyword)
        (encode-json-to-string
         `((:name . ,name) (:message . ,message)))))

我们希望define-handler在这里做的是

  1. 将操作(publish! ...)绑定到*handlers*表中的 URI/send-message。
  2. 当向该 URI 发出请求时
  3. 在返回响应后，关闭通道。

虽然我们可以编写Lisp函数来完成所有这些操作，然后手动将它们组装起来，但更常见的方法是使用Lisp中的一个名为macros的功能来为我们生成Lisp代码。这使我们能够简洁地表达我们希望我们的DSL做什么，而无需维护大量代码来实现它。您可以将宏视为一个“可执行模板”，它将在运行时扩展为Lisp代码。

这是我们的define-handler宏9

(defmacro define-handler
    ((name &key (is-stream? t) (content-type "text/html")) (&rest args)
     &body body)
  (if is-stream?
      `(bind-handler
    ,name (make-closing-handler
           (:content-type ,content-type)
           ,args ,@body))
      `(bind-handler
    ,name (make-stream-handler ,args ,@body))))

它委托给三个其他宏（bind-handler、make-closing-handler、make-stream-handler），我们将在后面定义这些宏。make-closing-handler将为完整的HTTP请求/响应周期创建一个处理程序；make-stream-handler将处理SSE消息。谓词is-stream?为我们区分了这些情况。反引号和逗号是宏特有的运算符，我们可以使用它们在我们的代码中“挖洞”，这些洞将被我们在实际使用define-handler时在Lisp代码中指定的特定值填充。

请注意，我们的宏是如何紧密地符合我们对define-handler想要做的规范的：如果我们要编写一系列Lisp函数来完成所有这些操作，那么代码的意图将难以通过检查来辨别。

扩展处理程序

让我们逐步完成send-message处理程序的扩展，以便更好地理解当Lisp为我们“扩展”我们的宏时实际发生了什么。我们将使用SLIME Emacs模式中的宏扩展功能来执行此操作。在define-handler上调用macro-expander将以一个“级别”扩展我们的宏，将我们的辅助宏保留在其仍然压缩的形式中

(BIND-HANDLER
 SEND-MESSAGE
 (MAKE-CLOSING-HANDLER
  (:CONTENT-TYPE "text/html")
  ((ROOM :STRING (LEN-BETWEEN 0 ROOM 16))
   (NAME :STRING (LEN-BETWEEN 1 NAME 64))
   (MESSAGE :STRING (LEN-BETWEEN 5 MESSAGE 256)))
  (PUBLISH! (INTERN ROOM :KEYWORD)
        (ENCODE-JSON-TO-STRING
         `((:NAME ,@NAME) (:MESSAGE ,@MESSAGE))))))

我们的宏已经通过将我们的send-message特定代码替换到我们的处理程序模板中为我们节省了一些输入。bind-handler是另一个宏，它将URI映射到我们处理程序表上的处理程序函数；由于它现在是我们扩展的根节点，让我们看看它在进一步扩展之前是如何定义的。

(defmacro bind-handler (name handler)
  (assert (symbolp name) nil "`name` must be a symbol")
  (let ((uri (if (eq name 'root) "/" (format nil "/~(~a~)" name))))
    `(progn
       (when (gethash ,uri *handlers*)
     (warn ,(format nil "Redefining handler '~a'" uri)))
       (setf (gethash ,uri *handlers*) ,handler))))

绑定发生在最后一行：(setf (gethash ,uri *handlers*) ,handler)，这就是在Common Lisp中哈希表分配的样子（减去逗号，逗号是我们的宏的一部分）。请注意，assert在引号区域之外，这意味着它将在宏被调用时运行，而不是在它的结果被求值时运行。

当我们进一步扩展send-message define-handler的扩展时，我们得到

(PROGN
  (WHEN (GETHASH "/send-message" *HANDLERS*)
    (WARN "Redefining handler '/send-message'"))
  (SETF (GETHASH "/send-message" *HANDLERS*)
    (MAKE-CLOSING-HANDLER
     (:CONTENT-TYPE "text/html")
     ((ROOM :STRING (LEN-BETWEEN 0 ROOM 16))
      (NAME :STRING (LEN-BETWEEN 1 NAME 64))
      (MESSAGE :STRING (LEN-BETWEEN 5 MESSAGE 256)))
     (PUBLISH! (INTERN ROOM :KEYWORD)
           (ENCODE-JSON-TO-STRING
            `((:NAME ,@NAME) (:MESSAGE ,@MESSAGE)))))))

这开始看起来更像是我们自己编写的一个自定义实现，它将请求从URI映射到处理程序函数，如果我们自己编写的话。但我们不必这样做！

在我们的扩展中，我们还有make-closing-handler需要完成。这是它的定义

(defmacro make-closing-handler
    ((&key (content-type "text/html")) (&rest args) &body body)
  `(lambda (sock parameters)
     (declare (ignorable parameters))
     ,(arguments
       args
       `(let ((res (make-instance
            'response
            :content-type ,content-type
            :body (progn ,@body))))
      (write! res sock)
      (socket-close sock)))))

因此，创建一个闭合处理程序涉及创建一个lambda，这正是你在Common Lisp中调用匿名函数的方式。我们还设置了一个内部作用域，它从我们传入的body参数中创建了一个response，对请求的套接字执行write!，然后关闭它。剩下的问题是，什么是arguments？

(defun arguments (args body)
  (loop with res = body
     for arg in args
     do (match arg
     ((guard arg-sym (symbolp arg-sym))
      (setf res `(let ((,arg-sym ,(arg-exp arg-sym))) ,res)))
     ((list* arg-sym type restrictions)
      (setf res
        (let ((sym (or (type-expression
                (arg-exp arg-sym)
                type restrictions)
                   (arg-exp arg-sym))))
          `(let ((,arg-sym ,sym))
             ,@(awhen (type-assertion arg-sym type restrictions)
             `((assert-http ,it)))
             ,res)))))
     finally (return res)))

欢迎来到最难的部分。arguments将我们用处理程序注册的验证器转换为解析尝试和断言的树。type-expression、arg-exp和type-assertion用于实现和强制执行我们期望在响应中获得的数据类型的“类型系统”；我们将在HTTP“类型”中讨论它们。将它与make-closing-handler一起使用将实现我们在此处编写的验证规则

(define-handler (send-message)
    ((room :string (>= 16 (length room)))
     (name :string (>= 64 (length name) 1))
     (message :string (>= 256 (length message) 5)))
  (publish! (intern room :keyword)
        (encode-json-to-string
         `((:name . ,name) (:message . ,message)))))

...作为“展开”的验证请求所需的检查序列

(LAMBDA (SOCK #:COOKIE?1111 SESSION PARAMETERS)
  (DECLARE (IGNORABLE SESSION PARAMETERS))
  (LET ((ROOM (AIF (CDR (ASSOC :ROOM PARAMETERS))
           (URI-DECODE IT)
           (ERROR (MAKE-INSTANCE
               'HTTP-ASSERTION-ERROR
               :ASSERTION 'ROOM)))))
    (ASSERT-HTTP (>= 16 (LENGTH ROOM)))
    (LET ((NAME (AIF (CDR (ASSOC :NAME PARAMETERS))
             (URI-DECODE IT)
             (ERROR (MAKE-INSTANCE
                 'HTTP-ASSERTION-ERROR
                 :ASSERTION 'NAME)))))
      (ASSERT-HTTP (>= 64 (LENGTH NAME) 1))
      (LET ((MESSAGE (AIF (CDR (ASSOC :MESSAGE PARAMETERS))
              (URI-DECODE IT)
              (ERROR (MAKE-INSTANCE
                  'HTTP-ASSERTION-ERROR
                  :ASSERTION 'MESSAGE)))))
    (ASSERT-HTTP (>= 256 (LENGTH MESSAGE) 5))
    (LET ((RES (MAKE-INSTANCE
            'RESPONSE :CONTENT-TYPE "text/html"
            :COOKIE (UNLESS #:COOKIE?1111
                  (TOKEN SESSION))
            :BODY (PROGN
                (PUBLISH!
                 (INTERN ROOM :KEYWORD)
                 (ENCODE-JSON-TO-STRING
                  `((:NAME ,@NAME)
                (:MESSAGE ,@MESSAGE))))))))
      (WRITE! RES SOCK)
      (SOCKET-CLOSE SOCK))))))

这为我们提供了验证完整的HTTP请求/响应周期所需的验证。我们的SSE呢？make-stream-handler与make-closing-handler做基本相同的事情，只是它写入SSE而不是RESPONSE，并且它调用force-output而不是socket-close，因为我们希望在不关闭连接的情况下将数据刷新到连接上

(defmacro make-stream-handler ((&rest args) &body body)
  `(lambda (sock parameters)
     (declare (ignorable parameters))
     ,(arguments
       args
       `(let ((res (progn ,@body)))
      (write! (make-instance
           'response
           :keep-alive? t
           :content-type "text/event-stream")
          sock)
      (write!
       (make-instance 'sse :data (or res "Listening..."))
       sock)
      (force-output
       (socket-stream sock))))))

(defmacro assert-http (assertion)
  `(unless ,assertion
     (error (make-instance
         'http-assertion-error
         :assertion ',assertion))))

assert-http是一个宏，它创建了我们在错误情况下需要的样板代码。它扩展为检查给定的断言，如果失败则抛出http-assertion-error，并将原始断言打包到该事件中。

(defmacro assert-http (assertion)
  `(unless ,assertion
     (error (make-instance
         'http-assertion-error
         :assertion ',assertion))))

HTTP“类型”

 

在上一节中，我们简要地提到了三个用于实现HTTP类型验证系统的表达式：arg-exp、type-expression和type-assertion。一旦你理解了它们，我们的框架中就不会有任何魔法了。我们将从最简单的一个开始。

arg-exp

arg-exp接受一个符号并创建一个aif表达式来检查参数是否存在。

(defun arg-exp (arg-sym)
  `(aif (cdr (assoc ,(->keyword arg-sym) parameters))
    (uri-decode it)
    (error (make-instance
        'http-assertion-error
        :assertion ',arg-sym))))

在符号上评估arg-exp看起来像

HOUSE> (arg-exp 'room)
(AIF (CDR (ASSOC :ROOM PARAMETERS))
     (URI-DECODE IT)
     (ERROR (MAKE-INSTANCE
         'HTTP-ASSERTION-ERROR
         :ASSERTION 'ROOM)))
HOUSE>

我们一直在使用aif和awhen之类的形式，而不理解它们是如何工作的，所以现在让我们花一些时间来探索它们。

回想一下，Lisp代码本身也是用树表示的。这就是括号的作用；它们向我们展示了叶子和树枝是如何组合在一起的。如果我们回到上一节所做的事情，make-closing-handler调用一个名为arguments的函数来生成它正在构建的Lisp树的一部分，该函数又调用一些树操作辅助函数（包括arg-exp）来生成它的返回值。

也就是说，我们构建了一个小型系统，它以Lisp表达式作为输入，并产生一个不同的Lisp表达式作为输出。可能是将此概念化最简单的方法是将其视为一个专门针对当前问题的简单Common-Lisp-to-Common-Lisp编译器。

这种编译器的一个广泛使用的分类是anaphoric macros。这个术语来自语言学中的anaphor概念，它指的是用一个词代替前面的一组词。aif和awhen是anaphoric macros，它们也是我唯一倾向于经常使用的宏。在anaphora包中还有许多其他可用的宏。

据我所知，anaphoric macros是由Paul Graham在OnLisp章节中首次定义的。他给出的用例是，当你想要进行某种昂贵的或半昂贵的检查，然后根据结果有条件地执行某些操作时。在上面的上下文中，我们使用aif来检查alist遍历的结果。

(aif (cdr (assoc :room parameters))
     (uri-decode it)
     (error (make-instance
         'http-assertion-error
         :assertion 'room)))

这将查找关联列表parameters中的符号:room的结果的cdr。如果它返回一个非nil值，则对其进行uri-decode，否则抛出一个类型为http-assertion-error的错误。

换句话说，上面的代码等价于

(let ((it (cdr (assoc :room parameters))))
  (if it
      (uri-decode it)
      (error (make-instance
          'http-assertion-error
          :assertion 'room))))

像Haskell这样的强类型函数式语言通常在这种情况下使用Maybe类型。在Common Lisp中，我们在扩展中捕获符号it作为检查结果的名称。

了解这一点，我们应该能够看到arg-exp正在生成我们最终想要评估的代码树的特定、重复的部分。在这种情况下，该部分检查给定参数在处理程序的parameters中是否存在。现在，让我们继续讨论...

type-expression

(defgeneric type-expression (parameter type)
  (:documentation
   "A type-expression will tell the server
how to convert a parameter from a string to
a particular, necessary type."))
...
(defmethod type-expression (parameter type) nil)

这是一个生成新的树结构（巧合的是Lisp代码）的泛型函数，而不仅仅是一个函数。上面唯一告诉你的就是，默认情况下，type-expression是NIL。也就是说，我们没有。如果遇到NIL，我们将使用arg-exp的原始输出，但这并没有告诉我们太多关于最常见情况的信息。为了看到这一点，让我们看看内置的（到:house）define-http-type表达式。

(define-http-type (:integer)
    :type-expression `(parse-integer ,parameter :junk-allowed t)
    :type-assertion `(numberp ,parameter))

一个:integer是我们通过使用parse-integer从parameter中创建的。junk-allowed参数告诉parse-integer，我们不确定我们给它的数据是否真的可以解析，所以我们需要确保返回的结果是一个整数。如果不是，我们将得到这种行为

HOUSE> (type-expression 'blah :integer)
(PARSE-INTEGER BLAH :JUNK-ALLOWED T)
HOUSE>

define-http-handler10是我们框架的导出符号之一。这允许我们的应用程序程序员定义自己的类型，以便简化对我们给他们的几个“内置类型”（:string、:integer、:keyword、:json、:list-of-keyword和:list-of-integer）之上的解析。

(defmacro define-http-type ((type) &key type-expression type-assertion)
  (with-gensyms (tp)
    `(let ((,tp ,type))
       ,@(when type-expression
      `((defmethod type-expression (parameter (type (eql ,tp)))
          ,type-expression)))
       ,@(when type-assertion
      `((defmethod type-assertion (parameter (type (eql ,tp)))
          ,type-assertion))))))

它的工作原理是为正在定义的类型创建type-expression和type-assertion方法定义。我们可以让我们的框架用户毫不费力地手动执行此操作；但是，添加这种额外的间接级别使我们这些框架程序员能够自由地更改类型的实现方式，而无需强迫我们的用户重新编写他们的规范。这不仅仅是一个学术上的考虑；我个人在第一次构建系统时对系统的这部分进行了重大更改，并很高兴地发现，我只需要对依赖它的应用程序进行很少的编辑。

让我们看看那个整数定义的扩展，以详细了解它是如何工作的

(LET ((#:TP1288 :INTEGER))
  (DEFMETHOD TYPE-EXPRESSION (PARAMETER (TYPE (EQL #:TP1288)))
    `(PARSE-INTEGER ,PARAMETER :JUNK-ALLOWED T))
  (DEFMETHOD TYPE-ASSERTION (PARAMETER (TYPE (EQL #:TP1288)))
    `(NUMBERP ,PARAMETER)))

正如我们所说，它并没有减少很多代码量，但它确实防止了我们需要注意这些方法的具体参数，甚至它们是否是方法。

type-assertion

现在我们可以定义类型了，让我们看看如何使用type-assertion来验证解析是否满足我们的要求。它也采用与type-expression相同的互补defgeneric/defmethod对的形式

(defgeneric type-assertion (parameter type)
  (:documentation
   "A lookup assertion is run on a parameter
immediately after conversion. Use it to restrict
 the space of a particular parameter."))
...
(defmethod type-assertion (parameter type) nil)

以下是它的输出

HOUSE> (type-assertion 'blah :integer)
(NUMBERP BLAH)
HOUSE>

在某些情况下，type-assertion不需要做任何事情。例如，由于HTTP参数以字符串形式提供给我们，因此我们的:string类型断言没有要验证的内容

HOUSE> (type-assertion 'blah :string)
NIL
HOUSE>

现在让我们一起

我们做到了！我们在事件驱动的Web服务器实现之上构建了一个Web框架。我们的框架（和处理程序DSL）通过以下方式定义新的应用程序：

现在我们可以像这样描述我们的应用程序

(defun len-between (min thing max)
  (>= max (length thing) min))

(define-handler (source :is-stream? nil)
    ((room :string (len-between 0 room 16)))
  (subscribe! (intern room :keyword) sock))

(define-handler (send-message)
    ((room :string (len-between 0 room 16))
     (name :string (len-between 1 name 64))
     (message :string (len-between 5 message 256)))
  (publish! (intern room :keyword)
        (encode-json-to-string
         `((:name . ,name) (:message . ,message)))))

(define-handler (index) ()
  (with-html-output-to-string (s nil :prologue t :indent t)
    (:html
     (:head (:script
         :type "text/javascript"
         :src "/static/js/interface.js"))
     (:body (:div :id "messages")
        (:textarea :id "input")
        (:button :id "send" "Send")))))

(start 4242)

一旦我们编写了interface.js来提供客户端交互性，这将在端口4242上启动一个HTTP聊天服务器，并监听传入的连接。

  1. 解决这个问题的一个方案是强制客户端轮询服务器。也就是说，每个客户端都会定期向服务器发送一个请求，询问是否有任何变化。这对简单的应用程序来说是有效的，但在本章中，我们将重点关注当这种模式不再有效时可用的解决方案。↩

  2. 我们可以考虑一个更通用的系统，该系统使用\(M\)个线程来处理\(N\)个并发用户，其中\(M\)是某个可配置的值；在这种模型中，\(N\)个连接被认为是多路复用到\(M\)个线程上的。在本章中，我们将重点关注编写一个\(M\)固定为1的程序；但是，这里学到的经验教训应该部分适用于更通用的模型。↩

  3. 这种命名法有点令人困惑，它起源于早期的操作系统研究。它指的是多个并发进程之间如何进行通信。在基于线程的系统中，通信是通过同步资源（如共享内存）进行的。在基于事件的系统中，进程通常通过队列进行通信，它们在队列中发布描述它们所做的事情或想要做的事情的项目，这些项目由我们唯一的执行线程维护。由于这些项目通常描述了期望的或过去的动作，因此它们被称为“事件”。↩

  4. 查看有关此问题的另一种观点。↩

  5. 发音为“kloss”、“see-loss”或“see-lows”，具体取决于你与谁交谈。↩

  6. Julia编程语言对面向对象编程采用了类似的方法；你可以在中了解更多信息。↩

  7. 顺便说一下，我们在这里引入了新的语法。这是我们声明可变变量的方式。它的格式为 (defparameter <name> <value> <optional docstring>)。 ↩

  8. with-timeout 在不同的 Lisp 上有不同的实现。在某些环境中，它可能会创建另一个线程或进程来监控调用它的线程。虽然我们一次最多只会创建一个这样的线程，但它是一个相对重量级的操作，需要在每次写入时执行。我们可能需要考虑在这些环境中使用另一种方法。 ↩

  9. 我应该指出，下面的代码块对 Common Lisp 来说非常非常规的缩进。参数列表通常不会在多行上拆分，并且通常与宏/函数名称保持在同一行。我不得不这样做以遵守本书的行宽指南，但否则我更喜欢更长的行，这些行在代码内容指示的地方自然地断开。 ↩

  10. 这个宏很难阅读，因为它试图通过尽可能地使用 ,@ 来扩展 NIL，从而使它的输出对人类可读。 ↩