(defvar *new-line* (concatenate 'string (string #\Return) (string #\Newline)))
utf-8のストリームからバイトを読み取り、 trivial-utf-8関数utf-8-bytes-to-stringを使用して文字列に変換する関数も必要です。
(defun read-utf-8-string (stream &optional (end 0)) (let ((byte -1) (buffer (make-array 1 :fill-pointer 0 :adjustable t))) (handler-case (loop do (setq byte (read-byte stream)) (if (/= byte end) (vector-push-extend byte buffer)) while (/= byte end)) (end-of-file ())) (trivial-utf-8:utf-8-bytes-to-string buffer)))
私たちが行うことは、値の終わりのバイトを取得する前にバイトを読み取り、結果のバイト配列を文字列に変換することです。 この関数は別の方法で（より効率的に）書くことができますが、ここでそのようなオプションを取得しました。 良いアイデアがあれば、コメントでそれらを見て喜んでいるでしょう。 別の関数を宣言する (defun response-write (text stream) (trivial-utf-8:write-utf-8-bytes text stream))
彼女は、クライアントへの回答を同じ形式（utf-8）で書くのを手伝います
WebサーバーはGETリクエストのみを処理できます。 興味がある人は、POSTリクエストの処理を記述できますが、現時点ではGETリクエストに限定します。 典型的なHTTP GETリクエストは次のようになります
GET /path/to/a/resource?param1=paramvalue1¶m1=paramvalu2 HTTP/1.1 \r\n HeaderName: HeaderValue \r\n .... HeaderName: HeaderValue \r\n \r\n
最初に行うことは、Webサーバーで受信した要求の種類を確認することです。
(defun parse-request (stream) (let ((header (read-utf-8-string stream 10))) (if (eq (length header) 0) '() (if (equal (subseq header 0 4) "POST") (parse-post-header header stream) (parse-get-header header stream)))))
POSTリクエストに対しては何もしませんので、簡単な関数を書きます
(defun parse-post-header (header stream) (cons "POST" nil))
GETリクエストの場合、リクエストされたリソースと他のすべてのヘッダーのパスを取得する必要があります
(defun parse-get-header (header stream) (cons "GET" (cons (parse-path (subseq header (position #\/ header) (position #\Space header :from-end t))) (parse-headers stream))))
このために、関数parse-pathおよびparse-headersを使用します
parse-pathから始めましょう
(defun parse-path (path) (if (position #\? path) (cons (subseq path 0 (position #\? path)) (parse-params (subseq path (1+ (position #\? path))))) (cons path nil)))
ここにあるように、パスをパラメーターから分離し、 parse-params関数を使用してパラメーターを個別に解析します
パラメータの解析を開始する前に、16進数のパラメータで使用される文字を即値に変換するための別の補助関数が必要です。
(defun http-char (c1 c2 &optional (default #\Space)) (let ((code (parse-integer (coerce (list c1 c2) 'string) :radix 16 :junk-allowed t))) (if code (code-char code) default)))
この関数はhttp-char-decodeと呼ばれます
ここで、パラメーターをalistに変更します。
(defun parse-params (s) (let ((params (decode-params s))) (remove-duplicates params :test (lambda (x1 x2) (equal (car x1) (car x2))) :from-end nil))) (defun decode-params (s) (let ((p1 (position #\& s))) (if p1 (cons (decode-kv (subseq s 0 p1)) (parse-params (subseq s (1+ p1)))) (list (decode-kv s))))) (defun decode-kv (s) (let ((p1 (position #\= s))) (if p1 (cons (decode-param (subseq s 0 p1)) (decode-param (subseq s (1+ p1)))) (cons (decode-param s) nil)))) (defun decode-param (s) (labels ((f (1st) (when 1st (case (car 1st) (#\% (cons (http-char (cadr 1st) (caddr 1st)) (f (cdddr 1st)))) (#\+ (cons #\Space (f (cdr 1st)))) (otherwise (cons (car 1st) (f (cdr 1st)))))))) (coerce (f (coerce s 'list)) 'string)))
ご覧のとおり、 decode-paramsを使用して、 decode-kvでname = valueパラメーターを事前解析した後、再びparse-paramsを再帰的に呼び出します。 最後に、補助関数decode-paramを使用します。これは、特別なhttp文字を分離し、すでに変換されたデータを返すhttp-charを使用して変換します
parse-paramsの準備は完了しました。parse-headers関数を記述する必要があります。ここではすべてがずっと簡単です
(defun parse-headers (stream) (let ((headers nil) (header nil)) (loop do (setq header (read-utf-8-string stream 10)) (if (> (length header) 2) (setq headers (cons (parse-header header) headers))) while (> (length header) 2)) (reverse headers))) (defun parse-header (header) (let ((pos (position #\: header))) (if pos (cons (string-downcase (subseq header 0 pos)) (string-trim (concatenate 'string (string #\Space) (string #\Return)) (subseq header (1+ pos)))))))
最初に（read-utf-8-string stream 10）を使用して文字列を取得します。10はASCIIの値\ nで、2文字を超える場合は、parse-headerで解析します。 その結果、すべてのヘッダーのリストを取得します。
これで、 parse-get-headerの準備が整い、タイプの構造を返すはずです
'("GET" ("path/to/file" (("param1" . "value1") ("param2" . "value2"))) (("header1" . "value1") ("header2" . "value2")))
この構造での作業の便宜上、2つの補助関数を追加します
(defun get-param (name request) (cdr (assoc name (cdadr request) :test #'equal))) (defun get-header (name request) (cdr (assoc (string-downcase name) (cddr request) :test #'equal)))
リクエストができたので、クライアントにレスポンスを送信できます。 典型的な答えは次のようになります
HTTP/1.1 200 OK HeaderName: HeaderValue \r\n .... HeaderName: HeaderValue \r\n \r\n Data
回答の操作に役立つ補助関数をいくつか作成します
(defun http-response (code headers stream) (response-write (concatenate 'string "HTTP/1.1 " code *new-line*) stream) (mapcar (lambda (header) (response-write (concatenate 'string (car header) ": " (cdr header) *new-line*) stream)) headers) (response-write *new-line* stream)) (defun http-404-not-found (message stream) (http-response "404 Not Found" nil stream) (response-write message stream))
ご覧のとおり、ここのすべても簡単です。
これで、 Webディレクトリからファイルを提供する関数を記述することができます。
(defun file-response (filename type request stream) (handler-case (with-open-file (in (concatenate 'string "web/" filename) :element-type '(unsigned-byte 8)) (if (equal (get-header "if-modified-since" request) (format-timestring nil (universal-to-timestamp (file-write-date in)) :format +asctime-format+)) (http-response "304 Not Modified" nil stream) (progn (http-response "200 OK" (cons (cons "Last-Modified" (format-timestring nil (universal-to-timestamp (file-write-date in)) :format +asctime-format+)) (cons (cons "Content-Type" type) nil)) stream) (let ((buf (make-array 4096 :element-type (stream-element-type in)))) (loop for pos = (read-sequence buf in) while (plusp pos) do (write-sequence buf stream :end pos))) ))) (file-error () (http-404-not-found "404 File Not Found" stream) )))
これにより、Webサーバーは画像やHTMLページなどのファイルを返すことができます。 その際、ファイルが最後に変更された日付とともにLast-Modifiedヘッダーも返します。 if-modified-sinceヘッダーを使用して同じファイルのリクエストを2回目に受け取った場合、ファイルの最終変更日で日付を固定します。 日付が変更されていない場合、これは、Webブラウザーのキャッシュにファイルの最新バージョンがあるため、単に304 Not Modifiedというコードを返すことを意味します
次に、2番目のhtml-template関数を作成します。この関数は、 Webディレクトリからテキストファイルを取得し、タイプ$ {name}の値を同じ名前のalistリストで指定された値に置き換えます。 一種のプリミティブテンプレートエンジン
(defun html-template (filename type params request stream) (handler-case (with-open-file (in (concatenate 'string "web/" filename) :element-type '(unsigned-byte 8)) (loop for line = (read-utf-8-string in 10) while (and line (> (length line) 0)) do (progn (mapcar (lambda (i) (let* ((key (concatenate 'string "${" (car i) "}"))) (loop for pos = (search key line) while pos do (setq line (concatenate 'string (subseq line 0 pos) (cdr i) (subseq line (+ pos (length key))))) ) )) params) (response-write line stream) (response-write (string #\Return) stream)) ) ) (file-error () (http-404-not-found "404 File Not Found" stream) )))
これで、 util.lispの準備がほぼ整いました。ログ用の関数を記述するだけです。 log.lispファイルのcl-log設定から始めましょう
(setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) (start-messenger 'text-file-messenger :filename "log/web.log") (defmethod format-message ((self formatted-message)) (format nil "~a ~a ~?~&" (local-time:format-timestring nil (local-time:universal-to-timestamp (timestamp-universal-time (message-timestamp self)))) (message-category self) (message-description self) (message-arguments self)))
ここではすべてが標準であり、変更されたのはformat-messageのみです。ここでは、フォーマットされた形式で日付を単純に表示します。
では、util.lispにログを記録する関数を追加します。この関数は、1秒間に1回を超えないで同時に別のスレッドにメッセージを記録します。 ロギングから直接ロードをオフにできるもの
(defvar *log-queue-lock* (bt:make-lock)) (defvar *log-queue-cond* (bt:make-condition-variable)) (defvar *log-queue-cond-lock* (bt:make-lock)) (defvar *log-queue* nil) (defvar *log-queue-time* (get-universal-time)) (defun log-worker () (bt:with-lock-held (*log-queue-lock*) (progn (mapcar (lambda (i) (if (cdr i) (cl-log:log-message (car i) (cdr i)))) (reverse *log-queue*)) (setq *log-queue* nil) )) (bt:with-lock-held (*log-queue-cond-lock*) (bt:condition-wait *log-queue-cond* *log-queue-cond-lock*) ) (log-worker)) (bt:make-thread #'log-worker :name "log-worker")
このために、補助ログ機能を使用します
(defun log-info (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :info message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) (defun log-warning (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :warning message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) (defun log-error (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :error message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) )))
process-requestをhandler.lispに追加して関数を試すことは残ります
(defun process-request (request stream) (let ((path (caadr request))) (cond ((equal path "/logo.jpg") (myweb.util:file-response "logo.jpg" "image/jpeg" request stream)) (t (process-index request stream))))) (defun process-index (request stream) (let ((name (myweb.util:get-param "name" request))) (if (and name (> (length name) 0)) (myweb.util:html-template "index.html" "text/html;encoding=UTF-8" `(("name" . ,name)) request stream) (myweb.util:html-template "name.html" "text/html;encoding=UTF-8" nil request stream) )))
Webフォルダーにindex.htmlファイルを作成します
<html> <head> <title>myweb</title> </head> <body> <image src="logo.jpg"> <h1>Hello ${name}</h1> </body> </html>
そしてname.htmlファイル
<html> <head> <title>myweb</title> </head> <body> <image src="logo.jpg"> <h2>Hello stranger. What's your name?</h2> <form action="/" method="GET"> Name: <input type="text" name="name"> <input type="submit" value="Submit"> </form> </body> </html>
そして、そこに美しいlogo.jpgを置くことを忘れないでください
（myweb：start-http "localhost" 8080）を使用してWebサーバーを起動し、 localhost ：8080ブラウザに移動します
ご清聴ありがとうございました。