中文LISP学习网站

一个CL-HTTP入门

介绍

CL-HTTP是一个功能强大且功能全面的Web服务器，以及一组相关工具，允许您在Common Lisp中构建动态交互式Web站点。

虽然CL-HTTP包含优秀的示例和全面的文档，但是对于想要了解如何在简单的基于Web的应用程序中使用CL-HTTP的首次用户而言，其广泛的功能和选项可能令人望而生畏。

因此，本入门手册的目的是提供最少的示例，以说明编写许多典型应用所需的内容。

这些将帮助您理解CL-HTTP操作的基本原理，并可用作在Lisp中创建真实Web应用程序的模板。

其他资源

官方CL-HTTP站点：http：//www.cl-http.org：8001 / cl- http /

维基百科页面：http： //en.wikipedia.org/wiki/CL-HTTP

在Raspberry Pi上运行CL-HTTP：http： //lispm.de/ccl

使用CL-HTTP创建的站点

而这个维基！

入门

在第一个例子中，我们将展示使用CL-HTTP创建基本Web页面是多么简单。我们将在本地Web服务器上的/demo.html创建一个Web页面。为避免与Mac OS X系统使用的已安装Apache副本发生冲突，我们将在端口8000上运行CL-HTTP，因此在本地计算机上访问我们页面的地址将为：

http://www.localhost:8000/demo.html

我们首先需要编写一个例程write-demo-page，它将为页面生成HTML。该响应函数有两个参数; 存储页面参数的URL对象，以及用于生成HTML的流。最简单的形式是：

(in-package :http-user)

(defun write-demo-page (url stream)

  "简单计算网址的响应函数。"

(declare (ignore url))

(with-successful-response (stream :html)

(format stream "<html>~%")

    (format stream "<head><title>演示页</title></head>~%")

    (format stream "<body><h1>演示页</h1><p>欢迎来到我们的网站！</p></body>~%")

(format stream "</html>~%")))

这将调用带有成功响应的CL-HTTP例程，以将Web页面的HTML返回到指定的流。然后，它使用一系列格式语句为页面编写 HTML。

要使页面在Web上可见，我们需要将其导出到CL-HTTP，并指定它应具有的URL，我们使用CL-HTTP例程export-url：

(export-url "http://localhost:8000/demo.html"

:computed

:response-function 'write-demo-page)

例程export-url有两个参数：网页的URL和导出的类型; 在这种情况下：computed指定响应由：response-function关键字指定的Lisp函数计算。

评估这使得页面在服务器上可用，我们可以从本地计算机上的Web浏览器连接到该页面：

演示page.gif

生成HTML

在Demo Page示例中，我们使用了一系列格式语句来发出页面所需的HTML。

事实上，CL-HTTP提供了更灵活的解决方案。它包括发出构建完成的Web页面所需的所有HTML的例程。使用这些例程比直接打印HTML有几个优点：

CL-HTTP例程通常描述其功能，因此您可以在不知道HTML的情况下编写Web页面。
他们正确地处理嵌套标签和结束标签。
在可能的情况下，他们会检查参数的有效性。
相同的例程可用于生成不同类型的标记; 例如，XHTML。

这里有些例子：

常规	常规	描述
with-html-document	与-HTML文档	创建一个<html> ... </ html>块。
with-document-preamble	与文档前导码	创建<head> ... </ head>块。
declare-title	声明标题	创建<title> ... </ title>语句。
with-document-body	与文档体	创建<body> ... </ body>块。
with-section-heading	同形部标题	创建<h1> ... </ h1>标题。
with-paragraph	有段	创建一个<p> ... </ p>段落。

该与-例程括与一个开始标记和结束标记语句块，而宣告例程发射的单个构建。每个例程都使用：stream关键字参数来指定Web服务器使用的输出流。

重写使用这些HTML生成例程的Demo Page示例如下：

(defun write-demo-page2 (url stream)

  "使用HTML生成的简单计算URL的响应函数。"

  (declare (ignore url))

  (with-successful-response (stream :html)

    (with-html-document (:stream stream)

      (with-document-preamble (:stream stream)

        (declare-title "Demo Page" :stream stream))

      (with-document-body (:stream stream)

        (with-section-heading ("Demo Page" :stream stream)

          (with-paragraph (:stream stream)

            (format stream "欢迎来到我们的网站！")))))))

(export-url "http://localhost:8000/demo2.html"

            :computed

            :response-function 'write-demo-page2)

创建标准响应函数

为方便起见，我们可以在页面宏中包装头部和身体代码的生成。它将url，stream和page title作为参数：

(defmacro with-page ((url stream title) &body body)

  "提供响应功能以发出页面主体。"

  `(with-successful-response (,stream :html)

     (with-html-document (:stream ,stream)

       (with-document-preamble (:stream ,stream)

         (declare-title ,title :stream ,stream))

       (with-document-body (:stream ,stream)

         (with-section-heading (,title :stream ,stream)

           ,@body)))))

我们的演示页面可以写成：

(defun write-demo-page3 (url stream)

  (declare (ignore url))

  (with-page (url stream "演示页面")

    (with-paragraph (:stream stream)

      (format stream "欢迎来到我们的网站！"))))

这导出：

(export-url "http://localhost:8000/demo3.html"

            :computed

            :response-function 'write-demo-page3)

我们将在本教程的其余示例中使用 with-page宏。

计算页面

在生成HTML 课程中创建的演示页面可能是由传统Web服务器（如Apache）提供的静态文件创建的。事实上，CL-HTTP也可以提供静态文件。

但是，当您想要创建内容发生变化的动态交互式Web页面时，CL-HTTP真正发挥作用。

下一个示例给出了一个轻松的例子，说明了它是如何工作的。

首先，我们创建了几个例程来提供帮助。第一个，random-elt，返回列表的随机元素：

(defun random-elt (list) (elt list (random (length list))))

使用这个我们定义一个随机格言程序：

(defun aphorism (stream)

  "写一个随意的格言来流。"

  (format stream "~a ~a."

          (random-elt

           '("许多人制造" "太多厨师破坏" "时间缝合节省"

             "所有的工作，没有游戏使" "金钱是"))

          (random-elt

           '("轻工" "汤" "九" "杰克一个沉闷的男孩" "万恶之源"))))

这是创建页面的例程：

(defun write-aphorism (url stream)

  "显示一个随意的格言。"

  (with-page (url stream "当天的格言")

    (with-paragraph (:stream stream)

      (aphorism stream))))

最后，我们使用export-url导出URL：

(export-url "http://localhost:8000/aphorism.html"

            :computed

            :response-function 'write-aphorism)

每次我们访问页面时都会生成一个新的格言：

创建表单

表单提供了一种从用户那里获取输入的便捷方式。本节介绍CL-HTTP提供的用于构造表单和处理从表单接收的数据的工具。

要创建计算表单，请使用带有参数的export-url函数：html-computed-form。它需要两个Lisp例程：

· 的：form-function形式与功能，当您连接到的表单页面中指定的URL被返回。

的：response-function响应功能，当用户点击该接收数据提交按钮后表单值回服务器。

在第一个例子中，我们将创建一个计算表单来实现一个简单的公告板。用户可以通过在文本框中键入注释并单击“ 提交” 按钮来向板添加注释。

完整列表

;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

; Bulletin board form example

(defmacro with-page ((url stream title) &body body)

  "Provides the response function to emit a page body."

  `(with-successful-response (,stream :html)

     (with-html-document (:stream ,stream)

       (with-document-preamble (:stream ,stream)

         (declare-title ,title :stream ,stream))

       (with-document-body (:stream ,stream)

         (with-section-heading (,title :stream ,stream)

           ,@body)))))

(defparameter *board* nil)

(defun display-bulletin-board (url stream)

  "Routine to display a bulletin board and a form."

  (with-page (url stream "Feedback")

             (dolist (topic (reverse *board*))

               (with-paragraph (:stream stream)

                 (write-string-quoting-specials topic stream)))

             (with-fillout-form (:post url :stream stream)

               (accept-input 'string "text" :stream stream)

               (accept-input 'submit-button "Submit" :stream stream))))

(defun update-bulletin-board (url stream alist)

  "Response function to add an entry to the bulletin board."

  (bind-query-values (text) (url alist)

    (atomic-push text *board*)

      (display-bulletin-board url stream)))

(export-url "http://localhost:8000/board.html"

            :html-computed-form

            :form-function 'display-bulletin-board

            :response-function 'update-bulletin-board)

描述

公告板将存储在此全局变量中：

(defparameter *board* nil)

首先让我们定义显示板的例程：

(defun display-bulletin-board (url stream)

  "例行展示公告牌和表格。"

  (with-page (url stream "反馈")

             (dolist (topic (reverse *board*))

               (with-paragraph (:stream stream)

                 (write-string-quoting-specials topic stream)))

             (with-fillout-form (:post url :stream stream)

               (accept-input 'string "text" :stream stream)

               (accept-input 'submit-button "提交" :stream stream))))

这首先显示存储在变量* board *中的主题字符串列表。这最初是空的。请注意，字符串由CL-HTTP例程write-string-quoting-specials写入流中，以确保用户输入的字符串包含任何特殊字符＆符号，小于，大于或大于 - 注意，这些将被转义。

例程with-fillout-form创建表单。它需要两个参数：响应类型，通常是：post，以及响应函数的URL。通常，在这种情况下，表单处理由与表单函数相同的URL处理，因此我们可以将第二个参数作为页面的url。

对accept-input的调用创建了各种表单元素 - 在本例中是一个文本输入框和一个Submit按钮。

响应功能

当用户单击“ 提交”按钮时，表单值将发布到响应函数 update-bulletin-board：

(defun update-bulletin-board (url stream alist)

  "响应函数可以在公告板中添加条目。"

  (bind-query-values (text) (url alist)

    (push text *board*)

      (display-bulletin-board url stream)))

CL-HTTP例程bind-query-values将每个表单值分配给具有表单字段名称的变量。在这种情况下，文本绑定到用户在文本字段中键入的文本。响应函数使用CL-HTTP函数atomic-push将此推送到* board *列表，因为不同的用户可能同时更新电路板。然后它再次调用显示板 以显示新的主题列表和新表单。

最后，这是将URL导出到CL-HTTP服务器的调用：

(export-url "http://localhost:8000/board.html"

            :html-computed-form

            :form-function 'display-bulletin-board

            :response-function 'update-bulletin-board)

要在 URL /board.html显示以下页面：

要在电路板上添加条目，请输入一些文本，然后单击“提交”：

主题将添加到主题列表中，并使用新主题重新显示表单：

处理表单字段

我们的下一个示例是更高级地使用表单来创建交互式测验。它基于我们为企业网站设计的测验处理程序。测验中的问题都在测验表格中编码; 响应函数只需要知道每个答案的分数。

完整列表

;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

; Quiz example

(defmacro with-page ((url stream title) &body body)

  "Provides the response function to emit a page body."

  `(with-successful-response (,stream :html)

     (with-html-document (:stream ,stream)

       (with-document-preamble (:stream ,stream)

         (declare-title ,title :stream ,stream))

       (with-document-body (:stream ,stream)

         (with-section-heading (,title :stream ,stream)

           ,@body)))))

(defun display-quiz (url stream)

  "The form function for a quiz. The form values are posted to the same URL."

  (with-page (url stream "So you think you know Lisp?")

    (with-fillout-form (:post url :stream stream)

      (with-paragraph (:stream stream)

        (write-string "Rate your knowledge of Lisp with the following questions. " stream)

        (write-string "Maximum score 100%." stream))

      (with-section-heading ("Which of the following are standard Common Lisp functions?"

                             :level 3 :stream stream)

        (accept-input 'checkbox "Q1" :layout :none :stream stream

                      :choices '("neq" "dribble" "while" "mapcdr" "tenth")))

      (with-section-heading ("When was the first version of Lisp specified?" :level 3 :stream stream)

        (accept-input 'radio-button "Q2"

                      :choices '("1938" "1985" "1958" "1948" "1984") :layout :none :stream stream ))

      (with-section-heading ("Which of the following features are a standard part of Common Lisp?"

                             :level 3 :stream stream)

        (accept-input 'checkbox "Q3" :layout :none :stream stream

                      :choices '("Streams" "Swirls" "Monads" "Series" "Structures")))

      (with-paragraph (:stream stream)

        (accept-input 'submit-button "Submit" :stream stream)))))

(defun mark (values answers)

  (reduce #'+ (if (listp values) values (list values))

          :key #'(lambda (str) (nth (parse-integer str) answers))))

(defun mark-quiz (url stream alist)

  "The response function for the quiz. This processes the form values and displays the result."

  (declare (ignore url))

  (bind-query-values (q1 q2 q3) (url alist)

    (let* ((total (+ (mark q1 '(-1 1 -1 -1 1))

                     (mark q2 '(0 0 2 0 0))

                     (mark q3 '(1 -1 -1 -1 1))))

           (score (round (* (+ total 6) 100) 12)))

      (with-page (url stream "Result")

        (with-paragraph (:stream stream)

          (cond

           ((> score 80)

            (format stream "Well done - your result is: ~a%" score))

           ((> score 50)

            (format stream "Not bad - your result is: ~a%" score))

(t

            (format stream "Pretty poor - your result is: ~a%" score))))))))

(export-url "http://localhost:8000/quiz.html"

            :html-computed-form

            :form-function 'display-quiz

            :response-function 'mark-quiz)

描述

此应用程序说明了如何使用CL-HTTP生成复选框和单选按钮，并说明如何解析表单返回的关联列表。

与前面的示例一样，我们使用 with-fillout-form来定义表单。表单包括两组复选框和一组单选按钮。

使用CL-HTTP函数accept-input显示表单字段。例如，显示一组复选框，其中包含：

(accept-input 'checkbox "Q1" :stream stream

                    :choices '("一" "二" "三" "四"))

这将创建五个复选框，其中的标签由：choices字符串指定：

集合中的每个复选框都具有名称Q1。默认情况下，复选框的格式为项目符号列表。或者：layout选项：none列出一行中的复选框。

显示测验表格

例程显示测验绘制表格：

(defun display-quiz (url stream)

  "测验的表单功能。表单值将发布到同一个URL。"

  (with-page (url stream "所以你认为你知道Lisp？")

    (with-fillout-form (:post url :stream stream)

      (with-paragraph (:stream stream)

        (write-string "使用以下问题评价您对Lisp的了解。" stream)

        (write-string "最高分100％。" stream))

      (with-section-heading ("以下哪个是标准Common Lisp函数？"

                             :level 3 :stream stream)

        (accept-input 'checkbox "Q1" :layout :none :stream stream

                      :choices '("neq" "dribble" "while" "mapcdr" "tenth")))

      (with-section-heading ("指定Lisp的第一个版本是什么时候？" :level 3 :stream stream)

        (accept-input 'radio-button "Q2"

                      :choices '("1938" "1985" "1958" "1948" "1984") :layout :none :stream stream ))

      (with-section-heading ("以下哪个特性是Common Lisp的标准部分？"

                             :level 3 :stream stream)

        (accept-input 'checkbox "Q3" :layout :none :stream stream

                      :choices '("Streams" "Swirls" "Monads" "Series" "Structures")))

      (with-paragraph (:stream stream)

        (accept-input 'submit-button "提交" :stream stream)))))

它生成以下页面：

响应函数mark-quiz接收已发布的表单结果并计算得分。使用关联列表调用响应函数，该关联列表将每个表单字段的名称与每个所选字段的索引相关联，从“0”开始。如果有多个具有相同名称的表单字段，则在这种情况下，值将作为列表返回：

((:Q1 ("2" "4") T) (:Q2 "2") (:Q3 ("0" "4") T) (:SUBMIT Submit))

CL-HTTP宏bind-query-values 将每个表单字段的值分配给同名的变量。从这些例程标记中，通过在包含每个答案的分数的列表中查找索引列表来计算每个问题的总分：

(defun mark (values answers)

  (reduce #'+ (if (listp values) values (list values))

          :key #'(lambda (str) (nth (parse-integer str) answers))))

这是mark-quiz的定义：

(defun mark-quiz (url stream alist)

  "测验的响应函数。它处理表单值并显示结果。"

  (declare (ignore url))

  (bind-query-values (q1 q2 q3) (url alist)

    (let* ((total (+ (mark q1 '(-1 1 -1 -1 1))

                     (mark q2 '(0 0 2 0 0))

                     (mark q3 '(1 -1 -1 -1 1))))

           (score (round (* (+ total 6) 100) 12)))

      (with-page (url stream "结果")

        (with-paragraph (:stream stream)

          (cond

           ((> score 80)

            (format stream "做得好 - 你的结果是：~a%" score))

           ((> score 50)

            (format stream "不错 - 你的结果是：~a%" score))

(t

            (format stream "相当差 - 你的结果是：~a%" score))))))))

这将处理表单并显示带有适当注释的分数：

最后，使用以下例程导出测验的URL：

(export-url "http://localhost:8000/quiz.html"

:html-computed-form

:form-function 'display-quiz

            :response-function 'mark-quiz)

上传文件

在设计允许文件上载的表单时，有一些特殊注意事项，因此本节提供了创建允许用户上载图像文件的网站的示例。

完整的例子在这里：

完整列表

;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

; Image site example

(defmacro with-page ((url stream title) &body body)

  "Provides the response function to emit a page body."

  `(with-successful-response (,stream :html)

     (with-html-document (:stream ,stream)

       (with-document-preamble (:stream ,stream)

         (declare-title ,title :stream ,stream))

       (with-document-body (:stream ,stream)

         (with-section-heading (,title :stream ,stream)

           ,@body)))))

(defparameter *images* nil)

(defun display-image-site (url stream)

  "Routine to display an image upload site."

  (with-page (url stream "Images")

    (dolist (pathname *images*)

      (image pathname pathname :stream stream))

    (with-paragraph (:stream stream)

      (with-fillout-form

          (:post url :stream stream :encoding-type '(:multipart :form-data))

        (accept-input 'file "photo" :directory #P"/uploads/" :stream stream)

        (accept-input 'submit-button "SUBMIT" :display-string "Upload" :stream stream)))))

(defun update-image-site (url stream alist)

  "Response function to add an image to the page."

  (capi:display-message "~s" alist)

  (bind-query-values (photo) (url alist)

    (atomic-push (namestring photo) *images*)

  (display-image-site url stream)))

(export-url "http://localhost:8000/uploads/"

            :image-directory

            :pathname #P"/uploads/")

(export-url "http://localhost:8000/images.html"

            :html-computed-form

            :form-function 'display-image-site

            :response-function 'update-image-site)

;; Advanced version

(defun update-image-site (url stream alist)

  "Response function to add an image to the page."

  (destructuring-bind

      (keyword pathname formname

               (&key upload-filename content-type copy-mode))

      (assoc :photo alist)

    (declare (ignore keyword formname upload-filename content-type copy-mode))

    (atomic-push (namestring pathname) *images*)

    (display-image-site url stream)))

文件上传表单字段

要创建文件上载表单字段，请使用CL-HTTP功能：

(accept-input 'file name :stream stream)

像往常一样，（accept-input'文件...）表单必须出现在with-fillout-form过程的主体内，但是为了支持文件数据，这必须指定：multipart ：form-data encoding类型，如在：

(with-fillout-form (:post url :stream stream :encoding-type '(:multipart :form-data)) ...)

指定上传目录

默认情况下，上传的文件放在CL-HTTP上传目录中，由变量 * file-upload-default-directory *指定，即 #p“http：uploads;” 。您可以重新定义此变量，以便为所有上载使用不同的目录。

或者，您可以使用optional ：directory 关键字为每个上载指定目录，如以下示例所示。例如，如果要将每个用户的上载存储在单独的目录中，这将非常有用。

为了避免将目录结构暴露给客户端，CL-HTTP为每个目录分配一个随机密钥，并维护一个哈希表以将每个密钥与相应的目录相关联。的密钥，与原始值一起名称标签，被存储在编码的字符串的名称标签。请注意，哈希表不会通过服务器重新启动保存; 因此，例如，如果用户尝试从页面的旧副本上载文件，则会失败。

示例图像站点

以下示例允许用户将图像发布到站点。它类似于创建表单中的公告表单示例。

主例程显示最初为空的图像，然后绘制包含文件上载字段的表单：

图像upload.png

单击上载然后将图像上载到服务器，并将其添加到页面：

图像upload2.png

首先，我们定义一个参数来保存图像路径名列表：

(defparameter *images* nil)

以下是显示图像和上传表单的例程的定义：

(defun display-image-site (url stream)

  "例行显示图片上传网站。"

  (with-page (url stream "图片")

    (dolist (pathname *images*)

      (image pathname pathname :stream stream))

    (with-paragraph (:stream stream)

      (with-fillout-form

          (:post url :stream stream :encoding-type '(:multipart :form-data))

        (accept-input 'file "photo" :directory #P"/uploads/" :stream stream)

        (accept-input 'submit-button "SUBMIT" :display-string "Upload" :stream stream)))))

响应函数处理上载的值以获取图像路径名，并将其添加到图像列表中：

(defun update-image-site (url stream alist)

  "将图像添加到页面的响应功能。"

  (bind-query-values (photo) (url alist)

    (push (namestring photo) *images*)

  (display-image-site url stream)))

我们需要导出上传目录，以便图像可供Web使用：

(export-url "http://localhost:8000/uploads/"

            :image-directory

            :pathname #P"/uploads/")

然后我们需要导出图像形式：

(export-url "http://localhost:8000/images.html"

            :html-computed-form

            :form-function 'display-image-site

            :response-function 'update-image-site)

附加要点

CL-HTTP变量 * file-upload-maximum-size *确定用户可以上载的最大文件大小 - 否则会生成错误。默认情况下，它设置为10MBytes。

传递给响应函数的alist包含原始文件名，文件类型和复制模式。例如：

((:PHOTO #P"/uploads/apple-with-leaf.jpg" NIL

  (:UPLOAD-FILENAME "apple-with-leaf.jpg"

   :CONTENT-TYPE (:IMAGE :JPEG)

   :COPY-MODE :BINARY))

 (:SUBMIT "上传"))

以下版本的update-image-site例程解析此问题以提取路径名。您可以使用其他参数来查找文件类型和原始文件名：

(defun update-image-site (url stream alist)

  "将图像添加到页面的响应功能。"

  (destructuring-bind

      (keyword pathname formname

               (&key upload-filename content-type copy-mode))

      (assoc :photo alist)

    (declare (ignore keyword formname upload-filename content-type copy-mode))

    (push (namestring pathname) *images*)

  (display-image-site url stream)))

搜索网址

到目前为止，我们已经查看了计算的URL和计算表单。CL-HTTP支持的第三种计算URL是搜索URL。

典型的搜索网址如下所示：

http://www.mysite.com/lookup?aardvark+bat+crayfish

其中查找是例程，而aardvark，bat和crayfish是例程的参数。具有命名参数的替代格式是：

http://www.mysite.com/lookup?name=aardvark&option=1&page=3

其中name，option和page是参数，aardvark，1和3是它们各自的值。CL-HTTP可以解释这两种格式。

在这个例子中，我们将编写一个响应函数来处理表单的URL：

/doc?function-name

其中function-name是一个任意字符串。这是定义：

(defun search-documentation (url stream)

  "处理表单的搜索URL: /doc?function-name以显示函数的文档。"

  (with-slots (search-keys) url

    (let* ((name (first url:search-keys))

           (title (format nil "Documentation of '~a'" name))

           (doc (documentation (find-symbol (string-upcase name) :http-user) 'function)))

      (with-page (url stream title)

        (with-paragraph (:stream stream)

          (write-string (or doc "Not found.") stream))))))

CL-HTTP自动解析搜索关键字并将其作为URL 的插槽搜索关键字中的列表返回。默认情况下，它假定搜索键以“+”字符分隔。在这个例子中，我们只使用第一个。

响应函数然后实现函数名称字符串，调用文档函数来检索函数的文档字符串，并显示它：

最后，这是为搜索创建URL的例程：

(export-url "http://localhost:8000/doc?" :search :response-function 'search-documentation)

搜索URL的经典用法是创建链接列表，例如站点的导航栏或目录的目录。为了说明这一点，我们将为我们已经创建的CL-HTTP演示例程创建一个目录。例程使用CL-HTTP例程note-anchor来创建链接。例如，以下调用会发出HTML以调用/ doc？mark-quiz：

(note-anchor "mark-quiz" :reference "/doc?mark-quiz" :stream stream)

例程使用*例程*中存储的例程列表：

(defparameter *routines*

  '("write-demo-page" "aphorism" "write-aphorism-page" "display-bulletin-board" "display-board"

                      "update-bulletin-board" "display-quiz" "mark-quiz" "search-documentation" "write-demo-toc"))

这是 write-demo-toc 例程：

(defun write-demo-toc (url stream)

  "为CL-HTTP演示例程编写目录"

  (with-page (url stream "Table of Contents")

    (dolist (entry *routines*)

      (with-paragraph (:stream stream)

        (note-anchor entry :reference (format nil "/doc?~a" entry) :stream stream)))))

像往常一样，我们使用export-url提供URL：

(export-url "http://localhost:8000/toc.html"

            :computed

            :response-function #'write-demo-toc)

这是结果：

单击任何链接可使用搜索URL显示例程的文档。

指定URL

在前面的示例中，我们已经为我们创建的每个网页指定了完整的URL; 例如：

(export-url "http://localhost:8000/demo.html"

            :computed

            :response-function 'write-demo-page)

在实际应用中，我们希望我们的网站位于公共域，例如www.mydomain.com，我们将使用DNS将此地址名称映射到我们的服务器计算机的IP地址。然后，export-url命令将变为：

(export-url "http://www.mydomain.com:8000/demo.html"

            :computed

            :response-function 'write-demo-page)

可移植地指定域名

为了灵活性，CL-HTTP提供了一个#u读取器宏，它允许您从指定的URL中省略基本域名，因此您只需编写：

(export-url #u"/demo.html"

            :computed

            :response-function 'write-demo-page)

使用运行CL-HTTP的服务器的DNS名称和端口创建完整域名。这些存储在变量中：

http::*local-host-domain-name*

http::*standard-http-port*

如果服务器有多个域名，您可以使用* http-host-name *为CL-HTTP服务器指定一个特定 的域名 ; 例如：

(setq http:*http-host-name* "www.mydomain.com")

从同一台服务器提供多个主机

该#U 读者宏有一个扩展语法，使您可以通过overvride服务器配置中指定的默认主机和端口。有关更多信息，请参阅虚拟主机。

导出文件和图像

前面的示例显示了CL-HTTP如何创建由Lisp例程动态生成的Web页面。但它也可以从静态HTML文件，图像和其他类型的文件创建URL，就像传统的Web服务器一样。以下是您如何执行此操作的快速概述。

文本文件

这是最简单的例子; 您只需指定要导出的文本文件的路径名，以及要使用的URL：

(export-url "http://localhost:8000/robots.txt"

            :text-file

            :pathname "robots.txt")

HTML文件

为什么要在动态生成静态网页时包含静态网页？无论如何，如果你需要这里的方式：

(export-url "http://localhost:8000/help.html"

            :html-file

            :pathname "help.html")

图片

您可以导出单个图像文件，也可以导出图像文件目录。以下是导出单个图像的示例：

(export-url "http://localhost:8000/favicon.ico"

            :ico-image

            :pathname "/images/favicon.ico")

这是一个图像目录。导出CL-HTTP知道的所有图像类型：

(export-url "http://localhost:8000/images/"

            :image-directory

            :pathname "/images/")

HTML生成

CL-HTTP包括一组用于生成HTML 4.0标准的HTML的综合例程。本节概述了可用的例程。

介绍

基本例程在：stream关键字参数指定的输出流上发出单个标记。例如：

(break-line :stream stream)

发出：

<br>

下一组例程发出一个构造，该构造由一个由开始和结束标记包围的字符串组成。例如：

(declare-title "Home Page" :stream stream)

发出：

<title>Home Page</title>

这些例程通常可以采用文字字符串，也可以采用流调用的函数; 例如：

(declare-title (lambda (stream) (format stream "Page ~a" n)) :stream stream)

环境宏

环境宏通过在正文中指定的例程周围发出开始和结束标记来建立环境。这些通常具有-xxx形式的名称。例如：

(with-paragraph (:stream stream)

  (write-stream "Log out" stream))

发出：

用于HTML生成的CL-HTTP例程试图通过提供执行相关功能的统一方法来合理化HTML标准中的一些不一致性。例如，with-division例程可用于创建div或span块，具体取决于其inline -p参数的值。例如：

(with-division (:id "heading" :stream *standard-output*)

  (write-string "Introduction" *standard-output*))

会发出：

<div id="heading">Introduction</div>

然而：

(with-division (:inline-p t :class :bold :stream *standard-output*)

  (write-string "Important!" *standard-output*))

会发出

<span class="bold">Important!</span>

常用关键字

在适当的情况下，许多HTML生成例程可以采用以下常用关键字：

关键词	关键词	描述
:class	：类	元素的类
:id	：ID	元素标识符
:title	：标题	用作元素标题的字符串。
:style	：样式	内联CSS参数。

每个参数的值可以指定为关键字，字符串或流的功能; 例如：

(with-paragraph (:class :bold :id "legal-notice" :stream stream)

  (write-string  "Copyright 2011" stream))

会发出：

<p id="legal-notice" class="bold">Copyright 2011</p>

为了提高效率，我们在这里使用关键字作为类名。如果对id使用关键字，则CL-HTTP将其大写以警告您id应该是唯一的，因此在这种情况下字符串更有效。

出口选项

此页面介绍了在CL-HTTP中导出URL时可用的其他选项。

指定到期时间

您可以为export-url提供：expiration参数。这允许浏览器提供页面的缓存版本，而不需要从服务器获取新的副本，从而提高效率。

如果要动态生成包含更改信息的页面，则需要指定页面立即过期，以便浏览器始终获取最新版本。但是，如果页面是一个很少更改的静态文本页面，则可以通过指定几分钟甚至几小时的到期时间来提高效率。

可以使用以下选项：

选项	选项	描述
:no-expiration-header	：没有过期头	没有发布EXPIRES标头。
:never	：决不	EXPIRES标题表示从现在起一年。
:time	：时间	EXPIRES标题表示通用时间。
:interval	：间隔	EXPIRES标题现在加上一个间隔。
:function	：功能	EXPIRES标头表示通过将函数应用于URL计算的通用时间。该函数应返回在EXPIRES头中使用的通用时间或nil，在这种情况下，不会发出EXPIRES头。

最常见的选择是：

:expiration '(:no-expiration-header)

对于永远不应缓存的动态页面，或者：

:expiration `(:interval ,(* 15. 60.))

允许缓存15分钟，以获得不经常更改的相当静态的页面。

例

以下示例说明了：expiration参数的用法：

(defparameter *version* 0)

(defparameter *last-fetch* 0)

(defmethod display-test-page ((url http-url) stream)

  "例行测试出口选择。"

  (let ((title "测试页")

        (now (get-universal-time)))

    (with-successful-response (stream :html :expires (expiration-universal-time url))

       (with-html-document (:declare-dtd-version-p :transitional :stream stream)

         (with-document-preamble (:stream stream)

           (declare-title title :stream stream))

         (with-document-body (:stream stream)

             (with-section-heading (title :stream stream)

               (with-paragraph (:stream stream)

                 (format stream "版本：~a. 自上一版本以来的时间：~a秒"

                         (incf *version*) (- now *last-fetch*))))

             (setq *last-fetch* now)

             (note-anchor "Update" :reference "/test.html" :stream stream))))))

我们使用：expiration参数5秒导出页面：

(export-url #u("/test.html" :host "localhost" :port 8000)

            :computed

            :response-function 'display-test-page

            :expiration `(:interval 5))

请注意，对with-successful-response的调用需要获取：expiration参数，并使用函数expiration-universal-time将其提供给：expires关键字。

这将显示以下页面：

到期-test.png

在5秒到期时间过后，单击“ 更新”链接无效，因为浏览器使用页面的缓存版本。

现在将export-url中的：expiration参数更改为：

:expiration '(:no-expiration-header)

现在，只要单击它，Update链接就会更新页面。

使用表格

使用宏with-fillout-form创建 表单， 以在表单主体周围建立表单环境。

在正文中，对accept-input的调用将创建表单字段。欲了解更多信息，请参阅表单域。

可以使用with-form-field-set将表单字段组合在一起 ; 请参阅将表单字段组合在一起 - with-form-field-set。

以下部分提供了有关这些功能的更多信息：

创建表单 - 带填充表单

(with-fillout-form (action destination &key keywords) &body body)

在表单主体周围建立表单环境。例如，最小形式是：

(with-fillout-form (:post url :stream stream)

  (accept-input 'string "Q2" :label "Name:" :size 36 :stream stream )

  (accept-input 'submit-button "Submit" :stream stream))

这显示为：

参数

动作是：post，：mail，：get或：none。：不推荐使用get操作，限制为1024个字符，包括目标URI的其余部分。

destination是返回表单值的URI。它必须是以下的HTTP URL：POST或：GET和MAILTO URI：MAIL。仅当“操作”为“无”时，DESTINATION才能为NIL。DESTINATION可以是实习URI或字符串。

关键词

ENCODING-TYPE是将表单值返回到DESTINATION时要使用的MIME内容类型。ENCODING-TYPE默认为'（：APPLICATION：X-WWW-FORM-URLENCODED）。当与输入类型FILE-UPLOAD一起使用时，ENCODING-TYPE应为'（：MULTIPART：FORM-DATA）。

NAME（在XHTML 1.0中不推荐使用）是标识样式表的表单元素的名称。在XHTML中，为此目的使用ID。

TARGET指定要打开文档的框架的名称。值是字符串或特殊关键字：

：BLANK - 始终将此链接加载到一个未命名的新窗口中

：SELF - 始终将此链接加载到您自己身上：父母 - 始终将此链接加载到您的父级上（如果您位于顶部，则变为自己）

：TOP - 始终在顶层加载此链接（如果您在顶部，则变为自己）

ACCEPT-MEDIA-TYPE是MIME内容类型或DESTINATION可接受的内容类型列表。默认值为：UNKNOWN，在客户端中建立目标接受包含表单的文档的媒体类型的期望。

ACCEPT-CHARSET是字符编码或DESTINATION可接受的字符编码列表（参见ISO 10646）

CLASS是元素ID的类，是元素标识符。

TITLE是一个用作元素标题的字符串。

STYLE指定要在默认样式表语言中使用的内联参数。

LANGUAGE是显示内容的两位数语言代码（参见RFC 1766）

DIRECTION是中性文本的基本方向性，可以是：LEFT-TO-RIGHT或：RIGHT-TO-LEFT。

EVENTS可以是任何内在事件:: KEY-DOWN，：KEY-PRESS，：KEY-UP，：MOUSE-CLICK，：MOUSE-DOUBLE-CLICK，：MOUSE-DOWN，：MOUSE-MOVE，：MOUSE-OUT ，：MOUSE-OVER，：MOUSE-UP，：RESET，：SUBMIT。

将表单字段组合在一起 - 使用表单字段集

表单字段可以使用with-form-field-set和添加了with-form-field-legend的图例组合在一起。例如：

(with-form-field-set (:stream stream)

        (with-form-field-legend (:stream stream) (write-string "请登录:" stream))

        (with-paragraph (:stream stream)

          (accept-input 'string "Q2" :label "姓名:" :size 36 :stream stream))

        (with-paragraph (:stream stream)

          (accept-input 'password "Q2" :label "密码：" :stream stream)))

这显示：

使用事件

您可以使用：events关键字将JavaScript代码与适当的HTML构造相关联。

的：事件关键字采用以下形式的事件定义的列表：

((event . :JavaScript) javascript-code)

其中event是关键字，例如：鼠标单击以定义应触发事件的操作，javascript-code是触发事件时要运行的代码。这应该是一个字符串，或者是一个以流作为参数调用的函数。

创建模态对话框

作为使用：events参数的简单示例，这是一个创建JavaScript模式对话框的简单应用程序：

(defparameter *overlay*

 "position:absolute;width:100%;height:100%;left:0;top:0;visibility:hidden;z-index:1000;")

(defparameter *dialog*

 "width:300px;margin:60px auto;background-color:white;border:2px solid;text-align:center;")

(defun write-events-demo (url stream)

  (declare (ignore url))

  (with-page (url stream "Events Demo")

    (with-paragraph (:stream stream)

      (note-anchor "点击显示对话框" :reference "#"

                   :events '(((:mouse-click . :java-script)

                              "document.getElementById('overlay').style.visibility='visible'"))

                   :stream stream))

    (with-division (:id "overlay" :style *overlay* :stream stream)

      (with-division (:style *dialog* :stream stream)

        (with-paragraph (:stream stream)

          (write-string "警告 - 关闭前保存！" stream))

          (note-anchor "Hide" :reference "#"

                   :events '(((:mouse-click . :java-script)

                              "document.getElementById('overlay').style.visibility='hidden'"))

                   :stream stream)))))

这是URL的定义：

(export-url "http://localhost:8000/events.html"

            :computed

            :response-function 'write-events-demo)

转到此页面会显示一个链接：

节目-dialog.png

单击该链接可显示模式对话框：

使用with-event-handlers

CL-HTTP包含一个带有事件处理程序的过程，可帮助您定义事件定义列表，以用作：events 关键字的参数。

在其最简单的版本中，  带有事件处理程序  的字符串可以定义您要发出的JavaScript。因此，您可以在上(with-event-handlers

      (show-event (:java-script :mouse-click

                   "document.getElementById('overlay').style.visibility='visible'"))

    (with-page (url stream "Events Demo")

      (with-paragraph (:stream stream)

        (note-anchor "点击显示对话框" :reference "#" :events show-event :stream stream))

使用事件2

在上一个主题中，我们了解了CL-HTTP如何允许您将一个或多个JavaScript调用与变量相关联，然后您可以将其用作过程中的：events关键字的参数以生成相应的HTML。

在以下示例中，我们使用事件将两个功能添加到之前定义的公告板示例中：

我们使用JavaScript函数在加载页面时为输入字段提供焦点。
我们使用JavaScript函数禁用“提交”按钮，直到用户在输入字段中输入文本为止。

完整列表

;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

; Events - Bulletin board examples using events

(defparameter *board* nil)

; Form example with input focus

(defun display-bulletin-board (url stream)

  "Form function to display a bulletin board with a text field."

  (let ((title "Feedback"))

    (with-event-handlers

        (make-focus (:java-script :load "document.myform.text.focus()"))

      (with-successful-response (stream :html)

        (with-html-document (:stream stream)

          (with-document-preamble (:stream stream)

            (declare-title title :stream ,stream))

          (with-document-body (:stream stream :events make-focus)

            (with-section-heading (title :stream stream)

              (dolist (topic (reverse *board*))

                (when topic

                  (with-paragraph (:stream stream)

                    (write-string-quoting-specials topic stream)))

              (with-fillout-form (:post url :name "myform" :stream stream)

                (accept-input 'string "text" :stream stream)

                (accept-input 'submit-button "Submit" :stream stream))))))))))

(defun update-bulletin-board (url stream alist)

  "Response function to add an entry to the bulleting board."

  (bind-query-values (text) (url alist)

    (atomic-push text *board*)

      (display-bulletin-board url stream)))

(export-url "http://localhost:8000/board.html"

            :html-computed-form

            :form-function 'display-bulletin-board

            :response-function 'update-bulletin-board)

; Form example with field validation

(defun display-bulletin-board (url stream)

  "Routine to display a bulletin board and a form."

  (let ((title "Feedback"))

    (with-event-handlers

        (make-focus

         (:java-script :load

          (lambda (stream)

            (fast-format stream "\"document.myform.mysubmit.disabled = true\""))))

      (with-event-handlers

          (check-field

           (:java-script :key-press

            (lambda (stream)

              (fast-format stream "\"if (this.value == '') document.myform.mysubmit.disabled = false\""))))

        (with-successful-response (stream :html)

          (with-html-document (:stream stream)

            (with-document-preamble (:stream stream)

              (declare-title title :stream stream))

            (with-document-body (:stream stream :events make-focus)

              (with-section-heading (title :stream stream)

                (dolist (topic (reverse *board*))

                  (with-paragraph (:stream stream) (write-string-quoting-specials topic stream)))

                (with-fillout-form (:post url :name "myform" :stream stream)

                  (accept-input 'string "text" :events check-field :stream stream)

                  (accept-input 'submit-button "mysubmit" :stream stream))))))))))

给予场输入焦点

下面的示例使用对JavaScript函数focus（）的调用，在页面加载时给出文本输入字段焦点。该事件被定义为 make-focus 与过程：

(with-event-handlers

        (make-focus (:java-script :load "document.myform.text.focus()"))

然后使用以下过程在<body>标记中发出：

(with-document-body (:stream stream :events make-focus) ...

整个定义如下：

(defun display-bulletin-board (url stream)

  "表单功能显示带有文本字段的公告板。"

  (let ((title "反馈"))

    (with-event-handlers

        (make-focus (:java-script :load "document.myform.text.focus()"))

      (with-successful-response (stream :html)

        (with-html-document (:stream stream)

          (with-document-preamble (:stream stream)

            (declare-title title :stream stream))

          (with-document-body (:stream stream :events make-focus)

            (with-section-heading (title :stream stream)

              (dolist (topic (reverse *board*))

                (when topic

                  (with-paragraph (:stream stream)

                    (write-string-quoting-specials topic stream)))

              (with-fillout-form (:post url :name "myform" :stream stream)

                (accept-input 'string "text" :stream stream)

                (accept-input 'submit-button "提交" :stream stream))))))))))

我们使用了with-successful-response的完整版本，而不是使用我们在生成HTML中定义的 with-page宏，因为我们希望在文档正文中包含：events参数。

响应函数与创建表单中的原始版本相同：

(defun update-bulletin-board (url stream alist)

  "响应功能，为项目符号板添加一个条目。"

  (bind-query-values (text) (url alist)

    (atomic-push text *board*)

      (display-bulletin-board url stream)))

我们在这里导出URL：

(export-url "http://localhost:8000/board.html"

            :html-computed-form

            :form-function 'display-bulletin-board

            :response-function 'update-bulletin-board)

验证表单输入

事件的另一个应用是在允许用户提交表单之前调用JavaScript例程来验证用户输入。

在以下示例中，我们在加载页面时禁用“ 提交”按钮，并仅在用户键入文本输入字段时启用它：

(defun display-bulletin-board (url stream)

  "例行展示公告牌和表格。"

  (let ((title "反馈"))

    (with-event-handlers

        (make-focus

         (:java-script :load

          (lambda (stream)

            (fast-format stream "\"document.myform.mysubmit.disabled = true\""))))

      (with-event-handlers

          (check-field

           (:java-script :key-press

            (lambda (stream)

              (fast-format stream "\"if (this.value == '') document.myform.mysubmit.disabled = false\""))))

        (with-successful-response (stream :html)

          (with-html-document (:stream stream)

            (with-document-preamble (:stream stream)

              (declare-title title :stream stream))

            (with-document-body (:stream stream :events make-focus)

              (with-section-heading (title :stream stream)

                (dolist (topic (reverse *board*))

                  (with-paragraph (:stream stream) (write-string-quoting-specials topic stream)))

                (with-fillout-form (:post url :name "myform" :stream stream)

                  (accept-input 'string "text" :events check-field :stream stream)

                  (accept-input 'submit-button "mysubmit" :stream stream))))))))))

相同的方法可用于验证数字输入，或检查电子邮件地址的格式等。

有关使用with-event-handlers的更多示例，请参阅下一主题“ 使用脚本”。

使用脚本

在上一个主题“ 使用事件”中，我们将JavaScript例程作为Lisp代码中的显式字符串包含在内，以生成Web页面。

CL-HTTP提供了几个例程，允许您以更简化的方式使用外语脚本（如JavaScript）：

define-script 允许您指定一个脚本，使用要在页面头部发出的JavaScript来定义脚本，以及要在页面正文中发出的JavaScript来调用脚本。在每种情况下，您都可以指定参数，将值从Lisp传递给正在发出的JavaScript。

intern-script 用于注册脚本。

declare-script 或 write-script 将流的定义发送到流。

以下各节将详细介绍这些内容。

定义脚本 - define-script

该 定义脚本 程序的格式为：

(define-script name (:JavaScript) :script script :caller caller )

其中 name 是用于引用脚本的名称。

的：脚本参数定义JavaScript来在页面的头部，通常用于为JavaScript函数的定义写出来。

的：主叫参数是用来定义JavaScript来调用JavaScript程序。

每个参数可以是字符串，也可以是流的函数，以将脚本写入流。

创建JavaScript弹出窗口

作为使用define-script的示例，这是一个显示或隐藏弹出窗口的JavaScript例程：

(define-script toggle-dialog (:Java-Script)

:caller

((script stream state)

(fast-format stream "\"document.getElementById('popup').style.visibility='~a'\"" state)))

以下是使用它的页面的定义：

(defun write-script-demo (url stream)

(declare (ignore url))

(let ((script (intern-script :toggle-dialog :java-script)))

(with-event-handlers

(events (:java-script :mouse-over (event-caller script "visible"))

(:java-script :mouse-out (event-caller script "hidden")))

(with-page (url stream "Script Demo")

(with-paragraph (:stream stream)

(note-anchor "Reset" :reference "#" :events events :stream stream)

(with-division (:inline-p t :id "popup" :style "visibility:hidden;" :stream stream)

(write-string "<- Click to reset your settings" stream)))))))

这是导出URL的代码：

(export-url "http://localhost:8000/script.html"

:computed

:response-function 'write-script-demo)

当用户将鼠标移到链接上时，弹出消息的可见性将设置为可见：

将鼠标指针移离链接会将可见性设置回隐藏状态。

使用Cookies

Cookie提供了一种在用户浏览器上存储有限数量信息的方法。典型用途包括会话跟踪和用户身份验证。

此示例显示如何使用cookie存储用户的登录信息，以便一旦他们登录到Web站点的受保护区域，他们就可以保持登录会话或指定时间。

完整列表

;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

; Cookies demo

; Global variable to store passwords

(defparameter *password-file* nil)

(defun lookup-user (name) (assoc name *password-file* :test #'equal))

(defun digest-user (username password)

  (md5:md5-digest-hexadecimal-string (concatenate 'string username password)))

(defun create-user (name password)

  (push (cons name (digest-user name password)) *password-file*))

; General macro to emit a page with additional headers

(defmacro with-headers-page ((stream title &key headers) &body body)

  "Provides the response function to emit a page body."

  `(with-successful-response (,stream :html :additional-headers ,headers)

     (with-html-document (:stream ,stream)

       (with-document-preamble (:stream ,stream)

         (declare-title ,title :stream ,stream))

       (with-document-body (:stream ,stream)

         (with-section-heading (,title :stream ,stream)

           ,@body)))))

; Displaying the login page

(defun display-login-page (url stream &optional error)

  "Form function to display a login form."

  (declare (ignore url))

  (with-headers-page (stream "Login")

    (when error

      (with-paragraph (:stream stream :style "color:red")

        (write-string error stream)))

    (with-fillout-form (:post "/login.html" :stream stream)

      (with-paragraph (:stream stream)

        (accept-input 'string "name" :label "User Name:" :stream stream :size 36))

      (with-paragraph (:stream stream)

        (accept-input 'password "password" :label "Password:" :stream stream :size 36)

        (accept-input 'submit-button "Login" :display-string "Login" :stream stream)))))

(defun respond-to-login (url stream alist)

  "Response function to process the login."

  (bind-query-values (name password) (url alist)

    (let ((user (lookup-user name))

          (digest (digest-user name password)))

      (if (or (null user) (not (equal digest (cdr user))))

          (display-login-page url stream "Invalid user name and/or password.")

        ;; Successful login

        (let ((title "Successful login")

              (cookie (http:set-cookie-http-headers

                        (:name name :expires nil :domain ".localhost" :path "/")

                        (:digest digest :expires nil :domain ".localhost" :path "/"))))

          (with-headers-page (stream title :headers cookie)

            (with-paragraph (:stream stream)

              (write-string "Welcome!" stream))

            (note-anchor "Continue" :reference "/user.html" :stream stream)))))))

(defun in-n-days (n) (+ (get-universal-time) (* 60 60 24 n)))

(export-url "http://localhost:8000/login.html"

            :html-computed-form

            :form-function 'display-login-page

            :response-function 'respond-to-login)

; Alternative version with an automatic redirect

(defun respond-to-login (url stream alist)

  "Response function to process the login."

  (bind-query-values (name password) (url alist)

    (let ((user (lookup-user name))

          (digest (digest-user name password)))

      (if (or (null user) (not (equal digest (cdr user))))

          (display-login-page url stream "Invalid user name and/or password.")

        ;; Successful login

        (let ((title "Successful login")

              (cookie (http:set-cookie-http-headers

                       (:name name :expires nil :domain ".localhost" :path "/")

                       (:digest digest :expires nil :domain ".localhost" :path "/")))

              (refresh (list :refresh "1;URL=/user.html")))

          (with-headers-page (stream title :headers (append cookie refresh))

            (with-paragraph (:stream stream)

              (write-string "Logging in..." stream))))))))

; Returns user info (name . digest)

(defmacro with-valid-user ((user url stream) &body body)

  `(http:with-cookie-values ((name digest))

     (let ((,user (valid-login name digest ,url ,stream)))

       (when ,user ,@body))))

(defun valid-login (name digest url stream)

  (cond

   ((null name) (display-login-page url stream "You need to login to access this page.") nil)

   (t (let ((user (lookup-user name)))

        (cond

         ((or (null user) (not (equal (cdr user) digest)))

          (display-login-page url stream "Invalid user/password.") nil)

         (t user))))))

(defun write-user-page (url stream)

  (with-valid-user (user url stream)

    (with-headers-page (stream "User Page")

      (with-paragraph (:stream stream)

      (format stream "User ~a page" (car user)))

      (note-anchor "Log out" :reference "/logout.html" :stream stream))))

(export-url "http://localhost:8000/user.html"

            :computed

            :response-function 'write-user-page)

; Logout page - clears both the cookies

(defun write-logout-page (url stream)

  (declare (ignore url))

  (let ((headers (http:set-cookie-http-headers

                  (:name "" :expires 0 :domain ".localhost" :path "/")

                  (:digest "" :expires 0 :domain ".localhost" :path "/"))))

    (with-headers-page (stream "Logout" :headers headers)

      (with-paragraph (:stream stream)

        (write-string "Logged out" stream)))))

(export-url "http://localhost:8000/logout.html"

            :computed

            :response-function 'write-logout-page)

使用带有CL-HTTP的cookie

CL-HTTP提供了两个用于处理cookie的主要例程：

set-cookie-http-headers构造一个标头，用于在用户的浏览器中存储cookie。
with-cookie-values读取一个或多个cookie的值，并使用绑定到同名变量的值变量执行body。

密码文件

我们首先创建一个密码文件，用于存储用户名和单向摘要的关联列表：

(defparameter *password-file* nil)

要构造摘要，我们使用CL-HTTP md5包中的例程， md5-digest-hexadecimal-string：

(defun digest-user (username password)

(md5:md5-digest-hexadecimal-string (concatenate 'string username password)))

密码文件仅包含md5摘要，而不包含密码，因此即使有人访问该文件，他们也很难为给定用户计算密码。我们在构造摘要时包含用户名，以确保即使两个用户选择了相同的密码，它们也会有不同的摘要。

这是创建用户和密码的例程：

(defun create-user (name password)

(push (cons name (digest-user name password)) *password-file*))

请注意，在实际应用程序中，还需要某种方法将密码文件保存到磁盘并重新加载它。

页面生成宏

首先，我们创建一个with-headers-page宏来发出一个页面。这几乎与生成HTML中使用的with-page宏相同，但添加了：headers关键字以允许我们向页面添加标题：

(defmacro with-headers-page ((stream title &key headers) &body body)

  "提供响应功能以发出页面主体。"

`(with-successful-response (,stream :html :additional-headers ,headers)

(with-html-document (:stream ,stream)

(with-document-preamble (:stream ,stream)

(declare-title ,title :stream ,stream))

(with-document-body (:stream ,stream)

(with-section-heading (,title :stream ,stream)

,@body)))))

登录页面

登录页面显示用户名和密码的字段，然后将表单提交到响应页面：

这是定义：

(defun display-login-page (url stream &optional error)

  "表单函数显示登录表单。"

(declare (ignore url))

  (with-headers-page (stream "登录")

(when error

(with-paragraph (:stream stream :style "color:red")

(write-string error stream)))

(with-fillout-form (:post "/login.html" :stream stream)

(with-paragraph (:stream stream)

        (accept-input 'string "姓名" :label "用户名：" :stream stream :size 36))

(with-paragraph (:stream stream)

(accept-input 'password "密码" :label "密码:" :stream stream :size 36)

        (accept-input 'submit-button "登录" :display-string "登录" :stream stream)))))

它包含一个可选的错误参数，允许我们包含一个错误字符串，以红色显示。

在与-fillout形式宏包含一个明确的URL参数张贴到形式/login.html，所以我们可以用同样的程序来从不同的URL显示登录表单。

成功登录页面

该响应到登录响应页面检查用户名和消化是有效的，然后显示成功登录页面：

这提供了一个继续链接以转到第一个受限页面。

在成功登录页面使用常规设置cookie的HTTP报头定义饼干名称和消化到用户的登录信息存储在用户的浏览器：

(defun respond-to-login (url stream alist)

  "处理登录的响应函数。"

(bind-query-values (name password) (url alist)

(let ((user (lookup-user name))

(digest (digest-user name password)))

(if (or (null user) (not (equal digest (cdr user))))

          (display-login-page url stream "无效的用户名和/或密码。")

;; Successful login

        (let ((title "成功登录")

(cookie (http:set-cookie-http-headers

(:name name :expires nil :domain ".localhost" :path "/")

(:digest digest :expires nil :domain ".localhost" :path "/"))))

(with-headers-page (stream title :headers cookie)

(with-paragraph (:stream stream)

              (write-string "欢迎！" stream))

(note-anchor "Continue" :reference "/user.html" :stream stream)))))))

Cookie的定义时：expires 参数设置为nil，这使得cookie在浏览器会话结束时到期。如果您想给cookie一个特定的到期时间，请使用例程：

(defun in-n-days (n) (+ (get-universal-time) (* 60 60 24 n)))

例如，制作一个30天的cookie：

:expires (in-n-days 30)

以下是导出登录页面URL的过程：

(export-url "http://localhost:8000/login.html"

:html-computed-form

:form-function 'display-login-page

:response-function 'respond-to-login)

避免继续链接

看起来成功的登录页面可能会引入多余的页面提取。但是，我们需要在设置cookie之前验证用户发布的用户名和密码，并且cookie只能通过页面提取来设置。

如果您想避免用户进行额外点击，一个解决方案是进行自动重定向：

(defun respond-to-login (url stream alist)

  "处理登录的响应函数。"

(bind-query-values (name password) (url alist)

(let ((user (lookup-user name))

(digest (digest-user name password)))

(if (or (null user) (not (equal digest (cdr user))))

          (display-login-page url stream "无效的用户名和/或密码。")

;; Successful login

(let ((title "Successful login")

(cookie (http:set-cookie-http-headers

(:name name :expires nil :domain ".localhost" :path "/")

(:digest digest :expires nil :domain ".localhost" :path "/")))

(refresh (list :refresh "1;URL=/user.html")))

(with-headers-page (stream title :headers (append cookie refresh))

(with-paragraph (:stream stream)

              (write-string "登录..." stream))))))))

在这里，我们添加一个刷新标题，显示“登录...”并在1秒后重定向到/user.html。

验证页面

只有登录用户才能访问的页面使用以下宏：

(defmacro with-valid-user ((user url stream) &body body)

`(http:with-cookie-values ((name digest))

(let ((,user (valid-login name digest ,url ,stream)))

(when ,user ,@body))))

这将读取名称和摘要 cookie，并使用例程valid-login检查用户名和摘要是否有效：

(defun valid-login (name digest url stream)

(cond

   ((null name) (display-login-page url stream "你需要登录才能访问这个页面。") nil)

(t (let ((user (lookup-user name)))

(cond

((or (null user) (not (equal (cdr user) digest)))

          (display-login-page url stream "用户/密码无效。") nil)

(t user))))))

一个例子是以下用户页面：

这包括允许用户注销的注销链接：

(defun write-user-page (url stream)

(with-valid-user (user url stream)

    (with-headers-page (stream "用户页面")

(with-paragraph (:stream stream)

(format stream "User ~a page" (car user)))

      (note-anchor "注销" :reference "/logout.html" :stream stream))))

使用以下例程导出：

(export-url "http://localhost:8000/user.html"

:computed

:response-function 'write-user-page)

退出页面

最后我们定义了注销页面。这会通过将过期时间设置为过去的时间来清除两个cookie，例如零：

(defun write-logout-page (url stream)

(declare (ignore url))

(let ((headers (http:set-cookie-http-headers

(:name "" :expires 0 :domain ".localhost" :path "/")

(:digest "" :expires 0 :domain ".localhost" :path "/"))))

(with-headers-page (stream "Logout" :headers headers)

(with-paragraph (:stream stream)

        (write-string "注销" stream)))))

这是导出定义：

(export-url "http://localhost:8000/logout.html"

:computed

:response-function 'write-logout-page)

CL-HTTP中的AJAX

AJAX是组合使用多种Web技术创建的交互式Web页面，用于更改其内容而无需获取整个新页面。

典型的应用是在用户在文本框中键入字符时更新网页上的匹配列表：

您可以在此处下载完整列表：

Ajax的test.lisp

;;;-*- Mode: Lisp; Package: HTTP-DEMO -*-

(in-package :http-user)

;;

;; AJAX Test

;;

; JavaScript

(define-script ajax (:Java-Script)

               :caller "\"submitRequest('/data?' + this.value, 'zone');\""

               :script "

function submitRequest(url, target)

        var req = null;

        document.getElementById(target).innerHTML = 'Started...';

        if (window.XMLHttpRequest)

                req = new XMLHttpRequest();

                if (req.overrideMimeType)

                        req.overrideMimeType('text/plain');

        else if (window.ActiveXObject)

                try {

                        req = new ActiveXObject('Msxml2.XMLHTTP');

                } catch (e)

                        try {

                                req = new ActiveXObject('Microsoft.XMLHTTP');

                        } catch (e) {}

        req.onreadystatechange = function()

                document.getElementById(target).innerHTML = 'Wait server...';

                if(req.readyState == 4)

                        if(req.status == 200)

                                document.getElementById(target).innerHTML  = req.responseText;

                        else

                                document.getElementById(target).innerHTML='Error: returned status code '

                                + req.status + ' ' + req.statusText;

};

        req.open('GET', url, true);

        req.send(null);

        }")))

; Test data

(defparameter *things*

   (let (things)

     (dotimes (x 10000 (reverse things))

       (push

        (format nil "~r" x)

        things))))

(defun show-ajax (url stream)

  (declare (ignore url))

  (let ((ajax-script (intern-script :ajax :java-script))

        (title "AJAX Demo"))

    (with-successful-response (stream :html)

      (with-html-document (:stream stream)

        (with-document-preamble (:stream stream)

          (declare-title title :stream stream)

          (declare-script ajax-script stream))

        (with-event-handlers

            (ajax-event

             (:java-script :key-up (event-caller ajax-script)))

          (with-document-body (:stream stream)

            (with-section-heading (title :stream stream)

              (accept-input 'string "text" :events ajax-event :label "Text:" :default nil :stream stream)

              (with-division (:id "zone" :stream stream)))))))))

(defun first-n (n list)

  (if (> (length list) n)

    (subseq list 0 n)

    list))

(defun filter (text things)

  (remove-if-not

             #'(lambda (item)

                  (if text (search text item) t))

             things))

(defun emit-data (url stream)

  (with-slots (search-keys) url

    (let ((text (first url:search-keys)))

      (with-successful-response (stream :text)

        (with-paragraph (:stream stream)

          (dolist (item (first-n 10 (filter text *things*)))

            (write-string item stream)

            (break-line :stream stream)))))))

(export-url "http://localhost:8000/ajax.html"

            :computed

            :response-function 'show-ajax)

(export-url "http://localhost:8000/data?"

            :search

            :response-function 'emit-data)

; File version

#|

(define-script ajax (:Java-Script)

               :caller "\"submitRequest('/data?' + this.value, 'zone');\""

               :location "http://localhost:8000/submitRequest.js")

(export-url "http://localhost:8000/submitRequest.js"

            :java-script-file

            :pathname "submitRequest.js")

|#

履行

这表示如下：

当用户在文本输入框中键入搜索字符串时，onkeyup事件会将搜索字符串作为参数调用JavaScript例程。

JavaScript例程使用JavaScript函数XMLHttpRequest（）向服务器上的搜索URL发出GET请求，并将搜索文本作为参数。

搜索URL以数据进行响应，该数据用于使用DOM命令修改网页。

返回到Web页面的数据传统上是XML格式，因此浏览器中的JavaScript例程可以解析数据并对其进行适当的操作。但是，没有理由说数据不应该是纯文本，HTML，甚至是Lisp数据。

在此示例中，数据以纯文本形式返回，但包含HTML格式化命令。

JavaScript脚本

应用程序首先在页面的head部分定义一个名为submitRequest（）的JavaScript函数。具有以下格式：

function submitRequest(url, target)

其中url是要调用的页面的URL，target是文档中div部分的id，其中将插入返回的文本。

然后，应用程序使用文本输入字段的onkeyup参数中的适当参数调用此函数：

onkeyup="submitForm('/data?' + this.value, 'zone');"

哪里/数据？是我们要定义的搜索URL以返回数据，this.value给出文本输入字段的内容，zone是我们想要放置数据的div的id。

将JavaScript与CL-HTTP一起使用

CL-HTTP包括几个过程，可帮助将JavaScript脚本和其他语言的脚本合并到Web页面中：

define-script允许您指定一个脚本，使用要在页面头部发出的JavaScript来定义脚本，以及要在页面正文中发出的JavaScript来调用脚本。在每种情况下，您都可以指定参数，将值从Lisp传递给正在发出的JavaScript。

intern-script用于注册脚本。

declare-script将流的脚本定义发送到流。

with-event-handlers将脚本与特定事件相关联，因此可以在HTML字段的：events参数中指定。

定义submitRequest（）脚本

在我们的应用程序中，submitRequest（）脚本由define-script过程定义。其格式如下：

(define-script name (:JavaScript):script script :caller caller )

其中name是用于引用脚本的名称，脚本是JavaScript例程的定义， 调用者是调用JavaScript例程的JavaScript。这是完整的定义：

(define-script ajax (:Java-Script)

               :caller "\"submitRequest('/data?' + this.value, 'zone');\""

               :script "

function submitRequest(url, target)

        var req = null;

        document.getElementById(target).innerHTML = 'Started...';

        if (window.XMLHttpRequest)

                req = new XMLHttpRequest();

                if (req.overrideMimeType)

                        req.overrideMimeType('text/plain');

        else if (window.ActiveXObject)

                try {

                        req = new ActiveXObject('Msxml2.XMLHTTP');

                } catch (e)

                        try {

                                req = new ActiveXObject('Microsoft.XMLHTTP');

                        } catch (e) {}

        req.onreadystatechange = function()

                document.getElementById(target).innerHTML = 'Wait server...';

                if(req.readyState == 4)

                        if(req.status == 200)

                                document.getElementById(target).innerHTML  = req.responseText;

                        else

                                document.getElementById(target).innerHTML='Error: returned status code '

                                + req.status + ' ' + req.statusText;

};

        req.open('GET', url, true);

        req.send(null);

}")

请注意，我一直小心地在JavaScript中使用单引号作为字符串，以避免在Lisp字符串中转义双引号。

定义页面

这是演示页面的定义。它使用intern-script来实现由define-script过程定义的脚本，declare-script来写出脚本的定义，并使用with-event-handler将调用与脚本关联：key-up（onkeyup））事件：

(defun show-ajax (url stream)

  (declare (ignore url))

  (let ((ajax-script (intern-script :ajax :java-script))

        (title "AJAX Demo"))

    (with-successful-response (stream :html)

      (with-html-document (:stream stream)

        (with-document-preamble (:stream stream)

          (declare-title title :stream stream)

          (declare-script ajax-script stream))

        (with-event-handlers

            (ajax-event

             (:java-script :key-up (event-caller ajax-script)))

          (with-document-body (:stream stream)

            (with-section-heading (title :stream stream)

              (accept-input 'string "text" :events ajax-event :label "Text:" :default nil :stream stream)

              (with-division (:id "zone" :stream stream)))))))))

请注意，accept-input过程不在表单内部，因为我们使用JavaScript来请求结果，而不是发布表单。我们将使用以下内容实习此网址：

(export-url "http://localhost:8000/ajax.html"

            :computed

            :response-function 'show-ajax)

定义响应函数

最后，我们定义函数以将结果返回给JavaScript调用。它使用一些测试数据，包括前10000个整数的文本版本：

(defparameter *things*

   (let (things)

     (dotimes (x 10000 (reverse things))

       (push

        (format nil "~r" x)

        things))))

这是响应搜索URL /数据的过程？例如，调用：

/data?ten

将返回：

十分十一百一百二十一百三十一<br>

四十一百五十一百六十一<br>

七一十八百一百九十一<br> <br> </ p>

它使用这些例程来过滤整数列表并返回前10个：

(defun first-n (n list)

  (if (> (length list) n)

    (subseq list 0 n)

    list))

(defun filter (text things)

  (remove-if-not

             #'(lambda (item)

                  (if text (search text item) t))

             things))

这是例程：

(defun emit-data (url stream)

  (with-slots (search-keys) url

    (let ((text (first url:search-keys)))

      (with-successful-response (stream :text)

        (with-paragraph (:stream stream)

          (dolist (item (first-n 10 (filter text *things*)))

            (write-string item stream)

            (break-line :stream stream)))))))

它是用这个定义实现的：

(export-url "http://localhost:8000/data?"

            :search

            :response-function 'emit-data)

从文件加载JavaScript

如果您愿意，可以将submitRequest（）例程保存到文件中，并使其可用：

(export-url "http://localhost:8000/submitRequest.js"

            :java-script-file

            :pathname "submitRequest.js")

然后，您可以通过将define-script例程更改为以下内容来指定页面应从文件加载它：

(define-script ajax (:Java-Script)

               :caller "\"submitRequest('/data?' + this.value, 'zone');\""

               :location "http://localhost:8000/submitRequest.js")

参考

有关AJAX的更多信息，请参阅：

Ajax（编程），一篇解释该技术的维基百科文章。

Ajax教程（异步Javascript + XML），这个应用程序中的JavaScript所基于的优秀教程。

安全

CL-HTTP允许您以两种方式之一限制对URL的访问：

子网安全
用户认证

以下各节将详细介绍这些内容。

子网安全

通过指定安全子网，可以将对特定URL的访问权限限制为指定的IP地址列表，其中0可以用作通配符。例如，

(export-url "/hosts.html")

            :computed

            :response-function 'hosts-page

            :secure-subnets '("80.288.178.48" "212.87.90.42"))

限制访问两个指定的IP地址。

123.123.123.0匹配子网中的所有IP地址。

以下导出参数允许控制哪些客户端可以执行HTTP方法，例如GET，HEAD，POST，：OPTIONS或：TRACE（读访问）与PUT或DELETE（写访问）。

：READ-SUBNETS允许在导出URL时在URL级别指定读访问权限。
：WRITE-SUBNETS允许在导出URL时在URL级别指定写访问权限。

DEFINE-READ-SUBNETS限制对服务器的全局读取访问。DEFINE-WRITE-SUBNETS限制对服务器的全局写访问。

写访问假定读访问，因此，写子网中的IP地址不需要包含在读子网中。要为写入方法选择全局身份验证策略，

HTTP：*接受-WRITE-方法*。

DEFINE-SUBNET可用于指定在子网规范中使用的命名子网。请注意，命名子网在使用时会被解析，例如通过调用EXPORT-URL，因此，对命名子网的更改需要重新导出引用它们的URL。

用户认证

可以使用：authentication-realm和：capabilities export参数指定URL身份验证。

例如，要创建一个名为admin的基本域：

(add-realm :identifont-admin :basic)

我们可以在域中定义用户，如下所示：

(add-user "david" :admin

          :password "secret123"

          :personal-name "David Johnson-Davies"

          :email-address "david@interface.co.uk")

然后，我们可以导出一个限制访问该域的URL，如下所示：

(export-url #u("/admin.html" :host #.*interface*)

            :html-computed-form

            :form-function #'admin-form

            :response-function #'respond-to-admin-form

            :authentication-realm :admin

            :capabilities nil)

默认设置：capabilities nil允许访问领域中的任何人。或者，可以在领域内创建访问控制组，并将URL限制为具有指定功能的用户。

RSS生成

如果您的站点包含定期更新或新闻项，您可能需要添加RSS或ATOM源以允许使用新闻阅读器的用户跟踪您的更新。

CL-HTTP包含对这两个标准中较旧版本RSS的内置支持，以下示例说明如何向站点添加RSS源。

首先，这是生成Feed的例程：

(defmethod write-rss-feed ((url url:http-url) stream)

  (with-successful-response (stream '(:text :xml))

    (rss2.0::with-rss-document (:stream stream)

      (rss2.0::with-rss-channel

          ("A CL-HTTP Primer"

           "http://clhttp.plasticki.com/"

           "Information about the Common Lisp Web Server CL-HTTP"

           :copyright "Copyright (c) 2014 David Johnson-Davies"

           :publication-date (encode-universal-time 0 0 0 3 3 2014)

           :build-date (encode-universal-time 0 0 0 3 3 2014)

           :generator "CL-HTTP RSS"

           :stream stream)

        (rss2.0::declare-rss-item

         stream

         :title "RSS Generation"

         :author "david@interface.co.uk (David Johnson-Davies)" ; optional

         :publication-date (encode-universal-time 0 0 0 3 3 2014)

         :unique-id "http://clhttp.plasticki.com/show?KO6"

         :description #'write-feed-item)))))

Feed有一个频道，“A CL-HTTP Primer”和一个项目，即此页面的介绍。

最后，这是生成Feed内容的例程：

(defun write-feed-item (stream)

  (with-paragraph (:stream stream)

    (fast-format

     stream

     "If your site includes regular updates or news items, ~

      you may want to add an RSS or ATOM feed to allow users who use news readers to track your updates."))

  (with-paragraph (:stream stream)

    (fast-format

     stream

     "CL-HTTP includes built-in support for the older of these two standards, ~

      RSS, and the following example shows how to add an RSS feed to your site.")))

以下是导出Feed网址的例程：

(export-url "http://localhost:8000/rss"

            :computed

            :response-function #'write-rss-feed

            :expiration `(:interval ,(* 15. 60.))

            :public t)

然后，您可以在以下位置订阅Feed：

http://localhost:8000/rss

它将出现在您最喜欢的新闻阅读器中，如下所示：

最后，您可能希望在主页上声明RSS源，其语句如下：

(declare-link :reference "http://clhttp.plasticki.com/rss"

              :relation "alternate" :title "Mazelog - RSS"

              :media-type "application/rss+xml" :stream stream)

在with-document-preamble部分。

顺便说一句，我建议您在以下位置验证您的Feed：

http://validator.w3.org/feed/

确保所有新闻读者都能接受他们。

杂

此页面包含一些与CL-HTTP一起使用的其他例程。

错误消息签名

默认的CL-HTTP错误消息包含指向页脚中CL-HTTP主页的链接。您可以使用例如以下例程将其自定义为指向您网站的链接：

(define cl-http-signature (&optional (stream *output-stream*))

  (with-emphasis (:address :stream stream)

    (note-anchor "Plasticki" :reference "http://www.plasticki.com/" :stream stream)))

页面未找到重定向

非法URL的默认行为是显示Not Found错误消息。以下例程可用于捕获此条件，并使其重定向到站点的主页：

(defmethod report-status-message ((condition document-not-found)

stream &optional format-string format-args)

(html4.0::with-html-document (:declare-dtd-version-p :transitional :stream stream)

(with-document-preamble (:stream stream)

(declare-title "Page Not Found" :stream stream)

(declare-meta-info "0; url=http://www.plasticki.com/" :header :refresh :stream stream))

(with-document-body (:stream stream)

(write-string "Page Not Found - Redirecting to Home Page" stream))))

在80号港口举办

大多数计算机已经在端口80上运行了内置Web服务器，并且很难禁用它们，因此首选解决方案是在另一个端口上运行CL-HTTP。传统的端口是端口8000。

您将通过以下调用在端口8000上导出URL：

(export-url "http://www.mydomain.com:8000/demo.html"

            :computed

            :response-function 'write-demo-page)

然后，外部世界可以使用以下URL连接到您的服务器：

http://www.mydomain.com:8000/demo.html

如果您希望将站点设置在端口80上，就外部世界而言，最佳解决方案是在端口8000上运行CL-HTTP，但将端口80重定向到端口8000.然后，您将在端口80上导出URL：

(export-url "http://www.mydomain.com/demo.html"

            :computed

            :response-function 'write-demo-page)

然后，外部世界可以使用以下URL连接到您的服务器：

http://www.mydomain.com/demo.html

您可以使用以下两种解决方案之一进行重定向：

使用外部路由器

使用外部路由器将端口80上的传入/传出流量映射到端口8000上的Mac。

使用内置防火墙

Mac有一个内置防火墙（ipfw），可以直接重定向端口。

Mac可以使用名为WaterRoof的共享软件控制面板，无需编辑配置文件即可进行必要的配置：

http://www.hanynet.com/waterroof/

使用方法如下：

单击NAT设置。
输入重定向：

保存配置
单击“ 启用NAT自动启动”。

虚拟主机

默认情况下，CL-HTTP将为位于以下指定的主机的单个网站提供服务：

http::*local-host-domain-name*

或者，如果指明，则：

http::*http-host-name*

另外，CL-HTTP提供了一个虚拟主机设施，允许您在同一台服务器上托管两个或多个独立的网站。以下示例显示了如何执行此操作。

在单个服务器上设置两个网站

此示例显示如何在域上运行两个网站

www.mydomain.com

和

www.yourdomain.com

第一步是使用以下命令定义两个虚拟主机：

(add-virtual-host domain-name &optional port protocol)

所以这些命令是：

(add-virtual-host "www.mydomain.com" 8000)

(add-virtual-host "www.yourdomain.com" 8000)

然后我们定义两个页面：

(defun mydomain (url stream)

  (with-page (url stream "MyDomain")

        (with-paragraph (:stream stream)

          (write-string "Welcome" stream))))

(export-url #u("/index.html" :host "www.mydomain.com" :port 8000)

            :computed

            :response-function 'mydomain)

(defun yourdomain (url stream)

  (with-page (url stream "YourDomain")

        (with-paragraph (:stream stream)

          (write-string "Hello" stream))))

(export-url #u("/index.html" :host "www.yourdomain.com" :port 8000)

            :computed

            :response-function 'yourdomain)

假设DNS服务器将www.mydomain.com 和 www.yourdomain.com解析为我们正在使用的服务器的IP地址，我们现在可以连接到这两个站点：

和：

测试虚拟主机

除非您可以访问自己的DNS服务器，否则使用虚拟主机测试站点可能非常棘手。一种方法是在测试计算机上运行DNS服务器，但幸运的是在Mac OS X上有一个更简单的解决方案，使用本地主机文件。

您需要以root用户身份编辑hosts文件，因此打开Terminal（在Applications中的Utilities文件夹中），然后输入：

sudo pico /etc/hosts

系统将提示您输入管理员密码：

输入管理员密码，默认主机文件将显示在Pico编辑器中：

默认hosts.png

使用光标键将光标移动到行尾：

127.0.0.1        localhost

然后将要解析的域名添加到本地计算机：

127.0.0.1        localhost       www.mydomain.com www.yourdomain.com

这是编辑过的文件：

编辑-hosts.png

然后键入Ctrl-O保存更改，按Ctrl-X退出Pico。请注意不要对文件进行任何其他更改，否则可能会破坏计算机上网络的运行。

您现在可以连接到计算机上的两个虚拟主机。

请注意，当您在外部服务器上使用这两个站点时，请记住从主机文件中删除引用，否则您将无法从计算机连接到它们。

高音量提示

此页面提供了为大量请求配置CL-HTTP服务器的一些提示。

配置文件设置

应在CL-HTTP配置文件中进行以下设置，通常为configuration.lisp。

通过电子邮件报告错误：

(setq http::*bug-report-destination* :mail)

不报告空闲连接错误：

(setq http::*report-idle-connection-scavenges* nil)

为了提高效率，请不要在日志中查找IP地址：

(setq *log-resolve-ip-addresses* nil)

增加可以同时连接到服务器的用户数。如果更多尝试连接，他们将收到消息“服务器已重载”（错误503）：

(set-maximum-number-of-connections 640.)

请注意，增加此值将增加服务器所需的打开文件数; 请参阅下面增加打开文件的数量。

保持日志文件打开，以提高效率：

(log-file-stream-stays-open t)

修复了在某些浏览器上投放小图片的问题; 例如Firefox。

(setq http::*connection-backlog* 128)

不允许服务器中的错误导致Lisp中断：

(setq http::*debug-server* nil)

关闭日志记录到CL-HTTP控制台，以提高效率：

(http::log-notifications-on (http::multiport-access-logs) nil)

增加打开文件的数量

在大多数Mac OS版本中，每个应用程序的最大打开文件数设置为256.如果最大连接数设置为大于默认值30，则有时可能会超过此限制。

如果您收到错误“打开文件太多”，请检查最大文件数：

launchctl limit

通过编辑配置文件来更改限制：

sudo pico /etc/launchd.conf

建议的设置是连接数的三倍，因此例如插入一行：

limit maxfiles 1920

键入Ctrl-O保存文件，按Ctrl-X退出。重新启动后，新限制将生效。

监控连接数

以下LispWorks应用程序显示活动量表，显示已连接用户的数量：

仪表自动重新调整到目前为止的最大用户数，即显示在刻度右侧的数字。

由上述连接的 set-maximum-of-of连接数设置的 * maximum-of-connections * 的值显示在仪表的标题栏中。

(defun make-activity-gauge ()

    (let* (process

           (max 10)

           (gauge

            (capi:contain

             (make-instance 'capi:slider :start 0 :end max :orientation :horizontal

                            :title (princ-to-string max) :title-position :right)

             :title (format nil "Activity (~a)" http::*maximum-number-of-connections*)

             :destroy-callback #'(lambda (interface)

                                   (declare (ignore interface)) (mp:process-kill process)))))

;;

        (flet ((update-gauge ()

           (loop

            (let ((activity (length (http:all-servers))))

              (setf (capi:range-slug-start gauge) activity)

              (when (> activity max)

                (setq max activity)

                (setf (capi:titled-object-title gauge) (princ-to-string max))

                (setf (capi:range-end gauge) max))

              (sleep 2)))))

;;

      (setq process (mp:process-run-function "Server Activity" nil #'update-gauge)))))

HTML标签和例程

以下按字母顺序排列的索引列出了所有HTML 4.01标记，以及使用该标记发出内容的相应CL-HTTP例程。

标签	描述	CL-HTTP例程
<!--...-->	定义评论	(comment ...) or (with-comment ( ) ...)
<!DOCTYPE>	定义文档类型	(declare-html-version ...)
<a>	定义锚点	(note-anchor ...) or (with-anchor-noted ( ) ...)
<abbr>	定义缩写	(with-emphasis :abbreviation ...)
<acronym>	定义首字母缩略词	(with-emphasis :acronym ...)
<address>	定义文档作者/所有者的联系信息	(with-emphasis :address ...)
<applet>	已过时。定义嵌入式小程序	(with-applet ...)
<area />	定义图像映射内的区域	(write-client-side-area ...)
<b>	定义粗体文本	(with-rendition (:bold) ...)
<base />	为页面上的所有链接定义默认地址或默认目标	(declare-base-reference ...)
<basefont />	已过时。定义页面中文本的默认字体，颜色或大小	(declare-default-font ...)
<bdo>	定义文本方向	(with-language-direction ...)
<big>	定义大文本	(with-rendition (:large) ...)
<blockquote>	定义长报价	(with-emphasis :quotation ...)
<body>	定义文档的正文	(with-document-body ( ) ...) or (with-standard-document-body ( ) ...)
<br />	定义单个换行符	(break-line)
<button>	定义按钮	(accept-input :client-side-button ...)
<caption>	定义表格标题	(with-caption ...)
<center>	已过时。定义居中文本	(with-centering ( ) ...)
<cite>	定义引文	(with-emphasis :citation ...)
<code>	定义计算机代码文本	(with-emphasis :code ...)
<col />	定义表中一个或多个列的属性值	(table-column-group ...)
<colgroup>	在表中定义一组列以进行格式化	(with-table-column-group ...)
<dd>	定义定义列表中术语的描述	(table-column-group ...)
<del>	定义已删除的文本	(with-editing-change :deletion ...)
<dfn>	定义定义术语	(with-emphasis :definition ...)
<dir>	已过时。定义目录列表	(with-enumeration ...) and (enumerating-item ...)
<div>	定义文档中的部分	(with-division ( ) ...)
<dl>	定义定义列表	(with-enumeration ...) and (enumerating-item ...)
<dt>	在定义列表中定义术语	(with-enumeration ...) and (enumerating-item ...)
<em>	定义强调文本	(with-emphasis :emphasis ...)
<fieldset>	定义表单中元素的边框	(with-form-field-set ( ) ...)
<font>	已过时。定义文本的字体，颜色和大小	(with-font ...)
<form>	为用户输入定义HTML表单	(with-fillout-form ( ) ...)
<frame />	定义框架集中的窗口（框架）	(note-document-frame ...)
<frameset>	定义一组框架	(with-document-frameset ...)
<h1> - <h6>	定义HTML标题	(section-heading ...) or (with-section-heading ...)
<head>	定义有关文档的信息	(with-document-preamble ( ) ...)
<hr />	定义水平线	(horizontal-line)
<html>	定义HTML文档	(with-html-document ( ) ...)
<i>	定义斜体文本	(with-rendition (:italic) ...)
<iframe>	定义内联框架	(note-inline-frame ...)
<img />	定义图像	(image ...)
<input />	定义输入控件	(accept-input ...)
<ins>	定义插入的文本	(with-editing-change :insertion ...)
<isindex>	已过时。定义与文档相关的可搜索索引	(declare-search-index ...)
<kbd>	定义键盘文本	(with-emphasis :keyboard ...)
<label>	定义输入元素的标签
<legend>	为fieldset元素定义标题	(with-form-field-legend ( ) ...)
<li>	定义列表项	(with-enumeration ( ) ...)
<link />	定义文档和外部资源之间的关系	(declare-link ...)
<map>	定义图像映射	(with-client-image-map ...)
<menu>	已过时。定义菜单列表	(with-enumeration ...) and (enumerating-item ...)
<meta />	定义有关HTML文档的元数据	(declare-meta-info ...)
<noframes>	为不支持框架的用户定义备用内容	(without-frame-capability ...)
<noscript>	为不支持客户端脚本的用户定义备用内容	(without-script-capability ...)
<object>	定义嵌入对象	(with-object ...) and (note-parameter ...)
<ol>	定义有序列表	(with-enumeration ...) and (enumerating-item ...)
<optgroup>	在选择列表中定义一组相关选项	(accept-input ...)
<option>	在选择列表中定义选项	(accept-input ...)
<p>	定义一个段落	(with-paragraph ( ) ...)
<param />	定义对象的参数	(note-parameter ...)
<pre>	定义预格式化的文本	(with-verbatim-text ...)
<q>	定义一个简短的报价	(with-emphasis :quote ...)
<s>	已过时。定义删除线文本	(with-rendition (:strike) ...)
<samp>	定义示例计算机代码	(with-emphasis :sample ...)
<script>	定义客户端脚本	(with-script ...)
<select>	定义选择列表（下拉列表）	(accept-input ...)
<small>	定义小文本	(with-rendition (:small) ...)
<span>	定义文档中的部分	(with-division (:inline-p t) ...)
<strike>	已过时。定义删除线文本	(with-rendition (:strike) ...)
<strong>	定义强文本	(with-emphasis :strong ...)
<style>	定义文档的样式信息	(with-document-style-declared ...)
<sub>	定义下标文本	(with-rendition (:subscript) ...)
<sup>	定义上标文本	(with-rendition (:superscript) ...)
<table>	定义一个表	(with-table ( ) ...)
<tbody>	将正文内容分组到表中	(with-table-row-group ...)
<td>	定义表中的单元格	(with-table-cell ( ) ...)
<textarea>	定义多行文本输入控件	(accept-input ...)
<tfoot>	将页脚内容分组到表中	(with-table-row-group ...)
<th>	在表中定义标题单元格	(with-table-cell ...)
<thead>	将表头内容分组到表中	(with-table-row-group ...)
<title>	定义文档的标题	(declare-title)
<tr>	定义表中的行	(with-table-row ( ) ...)
<tt>	定义电传文字	(with-rendition (:teletype) ...)
<u>	已过时。定义带下划线的文本	(with-rendition (:underline) ...)
<ul>	定义无序列表	(with-enumeration ...) and (enumerating-item ...)
<var>	定义文本的可变部分	(with-emphasis :variable ...)
<xmp>	已过时。定义预格式化的文本	n/a

有用的实用程序

此页面提供有关CL-HTTP中包含的有用实用程序的信息，用于执行编译Web站点时经常需要的翻译和其他操作。

转义和转义URL的字符串

请参阅：http://en.wikipedia.org/wiki/Percent-encoding

string-escape-special-chars（字符串和可选的开始结束）

使用％xx表示法在URL中转义字符非法。例如：

(string-escape-special-chars "Contact http://www.google.com/")

"Contact%20http%3A%2F%2Fwww.google.com%2F"

返回的第二个值表示是否有任何字符被转义。

write-string-escaping-special-chars (string &optional stream start end))

作为string-escape-special-chars，但将转义的字符串写入流。

tring-unescape-special-chars (string &optional start end)

Unescapes以百分比编码编码的字符。例如：

(string-unescape-special-chars "Contact%20http%3A%2F%2Fwww.google.com%2F")

"Contact http://www.google.com/"

返回的第二个值表示是否有任何字符未转义，第三个值表示是否返回了新字符串。

转义和转义HTML的字符串

write-string-quoting-specials（字符串和可选的流开始结束）

将字符串写入流，编码HTML中不允许的四个特殊字符：

><&"

例如：

(write-string-quoting-specials "Write <p>&nbsp;</p>" *standard-output*)

Write &lt;p&gt;&amp;nbsp;&lt;/p&gt;

NIL

编码和解码LISP表单

写入装甲弦（形式）

将LISP表单编码为base64编码的字符串，该字符串可以包含在URL中或作为表单字段的值。例如：

(write-to-armor-plated-string '(ant bee cat dog))

"KEFOVCBCRUUgQ0FUIERPRyk*"

读取装甲字符串（字符串）

将base64编码的字符串编码回LISP表单。例如：

(read-from-armor-plated-string "KEFOVCBCRUUgQ0FUIERPRyk*")

(ANT BEE CAT DOG)

表格字段

表单字段使用accept-input函数创建：

(accept-input INPUT-TYPE QUERY-NAME &REST ARGS &KEY STREAM &ALLOW-OTHER-KEYS)

响应函数将退货返回到导出的URL。请参阅EXPORT-URL和响应函数中使用的宏BIND-QUERY-VALUES。

必需的参数

input-type - 表示已定义输入类型的符号。提供以下类型：

QUERY-NAME - 表单提交返回的值的唯一名称。

关键字参数：

default - 用于代替用户输入的默认值（适用于大多数输入类型）。

disabled - 禁用用户输入的表单控件（布尔值）。

只读 - 禁止更改表单控件（布尔值）。

label - 提供表单控件的标签。除了CHECKBOX和RADIO-BUTTON之外，这可以是所有输入类型的字符串。对于FILE，IMAGE，MULTI-LINE-TEXT，PASSWORD，SELECT-CHOICES和STRING，它可以是形式的被破坏的参数列表:(标签 - 位置和关键访问 - 键ID类语言方向标题事件），其中POSITION可以是：BEFORE或：之后。

class - 元素的类（字符串，函数）。ID - 元素标识符（字符串，函数）。

style - 指定要在默认样式表语言中使用的内联参数（字符串，函数）。标签-

index - 表示Tab键顺序中位置的整数。

access-key - ISO 10646中的单个辅助功能字符。

title - 用作元素标题的字符串（字符串，函数）。

language - 显示内容的两位数语言代码（请参阅RFC 1766）（字符串，函数）。

方向 - 中性文本的基本方向性，可以是：LEFT-TO-RIGHT或：RIGHT-TO-LEFT。

事件 - 如果浏览器支持表单输入类型上的客户端事件，则可以通过此参数传入它们。事件可以是任何内在事件：输入 - DEFOCUS，：INPUT-FOCUS，：KEY-DOWN，：KEY-PRESS，：KEY-UP，：MOUSE-CLICK，：MOUSE-DOUBLE-CLICK，：MOUSE-DOWN ，：MOUSE-MOVE，：MOUSE-OUT，：MOUSE-OVER，：MOUSE-UP，：NEW-VALUE，：SELECT。使用宏WITH-EVENT-HANDLERS建立输入事件的绑定。请注意，表单提交事件是通过宏WITH-FILLOUT-FORM提供的。

preamble - 在输入类型之前写入的函数或字符串。如果PREAMBLE是一个函数，则使用（INPUT-TYPE STREAM ARGS）调用它。典型的用法是发出由输入类型调用的JavaScript。

stream - 用于编写由input-type生成的原始HTML的流。基于每种输入类型的附加参数。输入类型关键字参数

串

允许用户在一行中键入字符串。例如：

(accept-input 'string "date" :label "Enter the date:" :default "DD/MM/YY"

:size 36 :stream stream)

可选关键字参数

default 应为字符串或null。

size 是一个整数，默认为72，指定用于显示可见输入字段的大小。

max-length 是一个整数，默认为240，指定输入字段可以达到但不超过1024个字符的最大大小。

[Additional] LABEL, PREAMBLE, DISABLED, READ-ONLY, ID, CLASS, LANGUAGE, DIRECTION, TITLE, STYLE, EVENTS, TAB-INDEX, ACCESS-KEY.

密码

就像字符串 输入类型一样，除了客户端不显示输入。例如：

(accept-input 'password "pwd" :label "Enter password:" :default "Default"

  :title "Title" :stream stream )

size [可选]是一个整数，默认值为10，指定用于显示可见输入字段的大小。

[Additional] LABEL, PREAMBLE, DISABLED, READ-ONLY, ID, CLASS, LANGUAGE, DIRECTION, TITLE, STYLE, EVENTS, TAB-INDEX, ACCESS-KEY.

多行文字

允许用户在可滚动的输入框中键入或编辑多行文本。

可选关键字参数

default 应该是字符串，null或在STREAM上调用的函数。

columns 是一个整数，默认为72，指定可见输入字段的宽度。

rows 是一个整数，默认值为5，指定可见输入字段的高度。

[Additional] LABEL, PREAMBLE, DISABLED, READ-ONLY, ID, CLASS, LANGUAGE, DIRECTION, TITLE, STYLE, EVENTS, TAB-INDEX, ACCESS-KEY.

复选框和单选按钮

该复选框 允许用户通过 复选框选择值序列。的 单选按钮允许用户通过选择一个按钮来选择一个单一的值。否则它们是相同的。例如：

(accept-input 'checkbox "Q2" :choices '("One" "Two" "Three" "Four") :stream stream )

第二个示例显示：layout：none 选项：

(accept-input 'radio-button "Q1" :layout :none

  :choices '("One" "Two" "Three" "Four") :stream stream )

choices 是一个选择值列表，一个紧凑的虚线alist（<Choice-string>。<choice-value>），或（<choice-string>：VALUE <choice>）的alist。每个选项根据其在列表中的位置显示。

选择的扩展参数使用解构参数列表格式：<choice-spec> ::（CHOICE-STRING＆key VALUE DISABLED ID CLASS LANGUAGE DIRECTION TITLE STENTS EVENTS TAB-INDEX ACCESS-KEY）。扩展参数适用于个人选择。三种选择格式可以混合使用。

当扩展格式不提供更具体的值时，选项会将其扩展参数默认为顶级输入类型的以下参数：DISABLED，CLASS，LANGUAGE，DIRECTION，CHOICE-STYLE，CHOICE-EVENTS。

当ID提供给顶级输入类型时，单个选择ID会自动默认为“<id> <choice-position>”，其中<choice-position>是一个零的原点对应于所选位置的整数。

可选关键字参数

default 是单个值，这是默认值。它与使用EQUAL的CHOICES中的值进行比较。

布局控制按钮的布局，可以是:: ENUMERATION，：DIVISION，：INLINE或：NONE。

：枚举 是WITH-ENUMERATION的任何有效参数，仅在LAYOUT为：ENUMERATION时生效。

item-style 是ENUMERATING-ITEM的样式参数。

item-events 是ENUMERATING-ITEM的事件参数。

[附加]前序，DISABLED，ID，类，语言，DIRECTION，TITLE，STYLE EVENTS供给参数，以顶层用于计数或分割元件，以及枚举项（除了ID，前同步码）。

选择 - 选择

允许用户选择单个或多个选项。

[必需] CHOICES是选择值列表或（<choice-string>：VALUE <choice>）的列表。每个选项根据其在列表中的位置显示。选择选项的扩展参数使用解构参数列表格式：<choice-spec> ::（CHOICE-STRING＆key VALUE LABEL DISABLED ID CLASS LANGUAGE DIRECTION TITLE STYLE EVENTS TAB-INDEX）。扩展参数适用于个人选择。

三种选择格式可以混合使用。如果未使用扩展格式，则选择为顶级输入类型共享以下附加参数：CLASS，LANGUAGE，DIRECTION，STYLE。

可以通过以下格式提供条目来对选择进行分组：<choice-group> ::（（＆key LABEL DISABLED ID CLASS LANGUAGE DIRECTION TITLE STOURLE EVENTS）<choice-spec1> <choice-spec2> ...）组参数都是在第一个条目中提供。组条目的其余部分由组中的选项组成。

可选关键字参数

default是单个值或值列表，与EQUALP的选项进行比较。

sequence-p指定是否应返回值序列。

size是一个整数，指定滚动插入选项框中可见的可见行数。当：SEQUENCE-P为空时，您可以将SIZE指定为：PULL-DOWN-MENU以将选项呈现为下拉菜单。如果未指定大小，则默认为启发式值。

[附加]标签，序言，禁用，ID，类，语言，方向，标题，风格，事件，TAB-INDEX。

客户端按钮

在客户端上创建一个按钮，该按钮可以基于关联的客户端脚本执行某些客户端操作。

可选关键字参数

label是显示的标签; 默认“按钮”。

image-url是要显示为按钮的图标的URI。

替代文本在未加载IMAGE-URL时提供简短描述（字符串，函数）。

[附加] ID，CLASS，LANGUAGE，DIRECTION，TITLE，STYLE，EVENTS，TAB-INDEX，ACCESS-KEY。

文件

接受表单提交中的文件数据。系统会提示用户输入客户端计算机上的文件。然后，文件数据作为mime multipart表单值返回中的查询值传输，这需要用户代码进行特殊处理。

可选关键字参数

default应为字符串或null。

size是一个整数，默认为72，指定用于显示可见输入字段的大小。

max-length是一个整数，默认为240，指定输入字段可以达到但不超过1024个字符的最大大小。

directory是上传文件应存放在服务器上的目录。它默认为* file-upload-default-directory *。

accept-media-types是可接受的媒体类型列表。

[附加]禁用，ID，类，语言，方向，标题，风格，事件，TAB-INDEX，ACCESS-KEY。

隐

允许数据通过表单传递回服务器。这些被称为隐藏字段，因为它们对用户是不可见的。

[必需]：DEFAULT应为字符串或数字。HTTP：WRITE-TO-ARMOR-PLATED-STRING和HTTP：READ-FROM-ARMOR-PLATED-FORM可以帮助避免传输中的损坏。

图片

创建图形提交按钮并返回图像坐标。

当使用指针单击图像时，客户端或服务器可以处理XY协调，具体取决于CLIENT-SIDE-IMAGE-MAP和ACCEPT-COORDINATES-AT-URL。在表单返回中，客户端返回两个查询值，其名称通过将.X和.Y附加到QUERY-NAME来构造。X和Y的绑定以像素为单位，使用图像的左上角作为原点。效果就像SUBMIT输入类型一样，用户鼠标单击此字段会立即发送表单。

[必需] IMAGE-URL是要显示为按钮的图像的URI。

可选关键字参数

CLIENT-SIDE-IMAGE-MAP是客户端图像映射所在的URI。

ACCEPT-COORDINATES-AT-URL是服务器接受XY坐标的URI。

ALTERNATIVE-TEXT在未加载IMAGE-URL时提供简短描述（字符串，函数）。

ALIGNMENT（已弃用）可以是以下任何一种：LEFT，：CENTER，：RIGHT。

[Additional] LABEL, PREAMBLE, DISABLED, ID, CLASS, LANGUAGE, DIRECTION, TITLE, STYLE, EVENTS, TAB-INDEX, ACCESS-KEY.

提交按钮

用户按下时提交表单。

可选关键字参数

label是标签，默认为“提交”。

IMAGE-URL是要显示为按钮的图标的URI。[可选] ALTERNATIVE-TEXT在未加载IMAGE-URL时提供简短描述（字符串，函数）。

[Additional] ID, CLASS, LANGUAGE, DIRECTION, TITLE, STYLE, EVENTS, TAB-INDEX, ACCESS-KEY.

复位按钮

用户按下时，将表单的值重置为默认值。

可选关键字参数

label 是标签，默认为“Reset”。

IMAGE-URL是要显示为按钮的图标的URI。

ALTERNATIVE-TEXT在未加载IMAGE-URL时提供简短描述（字符串，函数）。

[Additional] ID, CLASS, LANGUAGE, DIRECTION, TITLE, STYLE, EVENTS, TAB-INDEX, ACCESS-KEY.