プログラミングを頑張る日記

プログラミングを勉強して、ハッカーになろう

Common Lispを頑張る(36)

Rubyをやると言ったな。あれは嘘だ。いや、それも嘘です。そのうちやります。
ただ本日はやります「Land of Lisp」。
ついにWebサーバを書きます。

そもそもWebサーバの仕組み

HTTPは、Webページをやりとりするためのインターネットのプロトコルです。
プロトコルってのは確か、決まり事、こうしてWebページをやりとりしようねって約束がHTTPなんですね。
確立されたソケットコネクションを通じて、TCP/IPの上でページをやりとりする層を定義していると。
クライアントコンピュータ上で走っているプログラムが定められた形式に沿ったリクエストを送ると
サーバは要求されたページを作りだして、ソケットスクリームを通してレスポンスを返す。

ふむふむ。ブラウザとかWebサーバはいつもそんなことをしてくれているのですね。
リクエストメッセージは、これがそうでしょうか。

Request URL: http://programcat.hatenablog.com/entry/2018/10/15/234849
Request Method: GET
Status Code: 200 OK
Remote Address: 13.230.115.161:80
Referrer Policy: no-referrer-when-downgrade

これから作るWebサーバに最も重要なのは、2行目の部分だそうです。あと1行目もかな。
参考書がfirefoxで自分がchromeだからか結構違っています。見当違いなところじゃなければいいんですが。

まあ、このMethodとURLの部分にはリクエストの種類と要求するページの名前があります。
この部分をリクエストヘッダと呼ぶそうです。
他の、リクエストヘッダに続いて送られる部分がリクエストボディで、
ここで送る情報を足せるわけですね。

リクエストを貰ったら、サーバはWebページを表現するHTML文書を、
ソケットストリームを通して送ります。このメッセージをレスポンスボディと呼ぶそう。
まあなんかあれですよね。の中に色々入れるやつ。
難しそうで敬遠してます。しかし避けて生きていけるわけがなかったしそろそろ戦わねば。

あと、レスボンスボディがあるからにはレスポンスヘッダという、
ドキュメントに関する追加情報を伝えるためのものもあるそうですが、
今回のWebサーバ作成では気にせずただボディだけを返すようにするとのこと。

リクエストパラメータ

よくあるログインフォームを考えます。ユーザネームとパスワードを入力するやつです。
ユーザが何かしらを入力して送信とかのボタンを押すと、
ブラウザはWebサーバにPOSTリクエストを送信するそうです。
POSTリクエストとGETリクエストの違いは、サーバにあるデータを変更するか否か。
...ログインするときにデータを変更しますかね。
まあ、データに触れる必要があるならPOSTって感じでしょうか。

...データを付与する場所が違うってのが一番大きいのかな。少なくとも表面的には。
GETならURLに情報が付与され、POSTならボディに付与されるみたいですね。
色々弄って身体で覚えていきたいですね。

また、POSTリクエストのリクエストヘッダには、ボディ部分のサイズ情報が付与されるそうです。

リクエストパラメータから情報を取り出す

HTMLでフォームのデータを送る際、通常のアルファベット以外の文字は、
HTMLエスケープコードと呼ばれる特殊な形式に変換されるそうです。
そうして、HTMLフォーマットで特殊な意味を持つ文字もデータとして送れるようにすると。
そういったデコードを行うための関数を書きます!なんか久しぶりにコード書きます。

CL-USER> (defun http-char (c1 c2 &optional (default #\Space)) ;オプション引数のデフォルトはスペース
           (let ((code (parse-integer
                        (coerce (list c1 c2) 'string) ;引数をリスト→文字列に変換
                        :radix 16                     ;16進数に変換
                        :junk-allowed t)))            ;変換できなかったゴミを無視
             (if code
                 (code-char code)       ;文字コードを文字に戻している?
                 default)))
HTTP-CHAR
CL-USER> (defun decode-param (s)
           (labels ((f (lst)            ;lstを引数にとる関数f
                      (when lst         ;lstがあれば
                        (case (car lst)
                          (#\% (cons (http-char (cadr lst) (caddr lst))
                                     (f (cdddr lst)))) ;lstのcarが%ならlstの次の要素とその次の要素をhttp-charに渡す、残りのリストで再帰。全ての要素はconsされる。
                          (#\+ (cons #\Space (f (cdr lst)))) ;lstのcarが+なら、残りの要素をfに渡してスペースとconsする
                          (otherwise (cons (car lst) (f (cdr lst)))))))) ;それら以外ならそのままにして残りの要素で再帰。
             (coerce (f (coerce s 'list)) 'string))) ;引数をリストにしてfに渡し、返ってきたもの(大量にconsされたもののはず)を文字列に変換。
DECODE-PARAM
CL-USER>

ちょっとしたリハビリ気分です。
coerce使ったことがある気もするんですけど忘れてしまいました。ちょっと動きを確認します。

CL-USER> (coerce "hey,yo! check it out!" 'list)
(#\h #\e #\y #\, #\y #\o #\! #\  #\c #\h #\e #\c #\k #\  #\i #\t #\  #\o #\u
 #\t #\!)
CL-USER> (coerce (coerce "hey,yo! check it out!" 'list) 'string)
"hey,yo! check it out!"
CL-USER>

文字列は文字コードにまで分解されリストへ、文字コードの集まりのリストを文字列にすることもできる。
decode-paramで受けとった文字列をバラバラの状態にしてローカル変数fに渡し、
fは引数の最初の要素を確認して、%なら次と次の要素をhttp-charに送ります。
http-charは受けとった要素をまず文字列にして、そのあと可能な限り16進数にします。
多少なりとも変換できていたら16進数をASCIIコードにしたがって(それとも処理系依存?)文字に変換し返します。
全然変換できなければスペースが返ります。
で、話はdecode-paramに戻ります。返ってきた要素は残りの要素をfに渡したものとconsされます。
もし引数の最初の要素が+だったなら、それはスペースとし残りの要素をfに渡したものとconsされます。
%でも+でもなければ、それはそのままの状態にして残りの要素をfに渡したものとconsされます。
lstを変換しきったら、全ての要素が変換されたリストが返り、そいつを文字列に変換します。

関数の動きはこれで合っているはず。それではちょいとURLを見てみますか。

https://www.google.co.jp/search?ei=vDbHW60hh_LwBZzKmugE&btnG=%E6%A4%9C%E7%B4%A2&q=land+of+lisp%3F

こちら、「Land of Lisp?」をGoogle検索したときのURLです。
お尻にくっついているものをみると、なるほど確かに#\+はスペースに、#\%のあとの2要素を1文字に変換するのは正しそうです。
試してみます。

CL-USER> (decode-param "https://www.google.co.jp/search?ei=vDbHW60hh_LwBZzKmugE&btnG=%E6%A4%9C%E7%B4%A2&q=land+of+lisp%3F")
"https://www.google.co.jp/search?ei=vDbHW60hh_LwBZzKmugE&btnG=æ¤ç´¢&q=land of lisp?"
CL-USER>

"Land of Lisp?"という文字列が復元されました。
しかし訳注で、「日本語はこのままじゃ無理」と書いてあります。マルチバイト文字ですもんね。
どうすりゃいいかも説明があるのですが、CLisp用なのでこのままでいきます。

...いや、それは情けないですね。夢はグレイトなハッカーなのでこれぐらい解決せねば。
まず、日本語を変換したときにどうなるかを確認します。
char-codeでchar-codeと逆のことができそうです。

CL-USER> (char-code #\あ)
12354
CL-USER>

...長いですね。調べたところutf-8とやらのようです。

訳注の中では、文字列をバイトに変換すること、バイトを文字列に変換することを行っています。
で、バイトをリストにしてfに渡して返ってきたものを配列にして文字列に戻しています。
むむ、decode-paramの中ではまだ文字コードのままリストを作るのか。
つまりdecode-paramが返すのは文字コードのリスト、それを配列にして文字列にする。
配列にするのは、文字列が結局は文字コードの配列でしかないからってことですね。

やらなきゃいけないことは、文字を受けとったらバイトに変換し、それらをリストにし
decode-paramに渡し、文字コードのリストにして返してもらう。ここでやることはさほど変わりませんね。
最後に返ってきたリストを配列にし文字列に。まあここはSBCLのやりかたに合わせるとこですが。
code-charでなんとかできないかな、と試してみましたが。

CL-USER> (mapcar #'code-char (mapcar #'char-code (coerce "あいうえお" 'list)))
(#\HIRAGANA_LETTER_A #\HIRAGANA_LETTER_I #\HIRAGANA_LETTER_U
 #\HIRAGANA_LETTER_E #\HIRAGANA_LETTER_O)
CL-USER>

あ、こうすればいいのか。

CL-USER> (coerce (mapcar #'code-char (mapcar #'char-code (coerce "あいうえお" 'list))) 'string)
"あいうえお"
CL-USER>

よし、つまり...

CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce s 'list)))) 'string)))
; in: DEFUN DECODE-PARAM
;     (HTTP-BYTE (CADR LST) (CADDR LST))
; 
; caught STYLE-WARNING:
;   undefined function: HTTP-BYTE
; 
; compilation unit finished
;   Undefined function:
;     HTTP-BYTE
;   caught 1 STYLE-WARNING condition
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER> (defun http-byte (c1 c2 &optional (default #.(char-code #\Space)))
           (let ((code (parse-integer
                        (coerce (list (code-char c1) (code-char c2)) 'string)
                        :radix 16
                        :junk-allowed t)))
             (or code default)))
HTTP-BYTE
CL-USER>

これでどうかな。試してみます。

CL-USER> (http-char "https://www.google.co.jp/search?q=%E3%81%AD%E3%81%93&oq=%E3%81%AD%E3%81%93&aqs=chrome..69i57j69i60j69i61l2j0l2.974j0j9&sourceid=chrome&ie=UTF-8")
; Evaluation aborted on #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {1003394063}>.
CL-USER>

だめか。どこかがおかしい。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (f (mapcar #'char-code (coerce "あいうえお" 'list))))
(12354 12356 12358 12360 12362)
CL-USER>

きりわけていきます。これなら動く。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (mapcar #'code-char (f (mapcar #'char-code (coerce "あいうえお?" 'list)))))
(#\HIRAGANA_LETTER_A #\HIRAGANA_LETTER_I #\HIRAGANA_LETTER_U
 #\HIRAGANA_LETTER_E #\HIRAGANA_LETTER_O #\FULLWIDTH_QUESTION_MARK)
CL-USER>

うん、動きます。括弧の位置とかミスってたのかな。最後の仕上げ...。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce "あいうえお?" 'list)))) 'string))
"あいうえお?"
CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce s 'list))))) 'string))
; in: DEFUN DECODE-PARAM
;     (COERCE (MAPCAR #'CODE-CHAR (F (MAPCAR #'CHAR-CODE (COERCE S 'LIST)))))
; 
; caught WARNING:
;   The function was called with one argument, but wants exactly two.
; 
; compilation unit finished
;   caught 1 WARNING condition
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER>

見直したら'stringの位置がおかしかったですね。

CL-USER> (decode-param "https://www.google.co.jp/search?q=land+of+lisp&oq=land+of+&aqs=chrome.1.69i59l2j69i60l3j69i57.7035j0j4&sourceid=chrome&ie=UTF-8")
; Evaluation aborted on #<SB-INT:SIMPLE-PROGRAM-ERROR "invalid number of arguments: ~S" {100420DB33}>.
CL-USER>

ってだめでした。どこの引数があかんのでしょう。

ええい、グダグダ考えるのはやめです。なぜなら、上の関数、動く部分で試しても日本語をどうにもできなかったからです。
下は、日本語でGoogle検索したときのURLの変換を試みたものです。

CL-USER> (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (coerce (mapcar #'code-char (f (mapcar #'char-code (coerce "https://www.google.co.jp/search?q=%E3%81%AD%E3%81%93%EF%BC%9F+%E3%81%AB%E3%82%83%E3%83%BC&oq=%E3%81%AD&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8" 'list)))) 'string))
"https://www.google.co.jp/search?q=ã­ãï¼ ã«ãã¼&oq=ã­&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8"
CL-USER>

最初の方針に戻ります。全てバイトにしてくれるようなSBCLの関数ないかな...。

CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (sb-ext:octets-to-string
              (coerce (f (coerce (sb-ext:string-to-octets s :external-format :utf-8) 'list))
                      'vector) :external-format :utf-8)))
; in: DEFUN DECODE-PARAM
;     (OCTETS-TO-STRING
;      (COERCE (F (COERCE (STRING-TO-OCTETS S :EXTERNAL-FORMAT :UTF-8) 'LIST))
;              'VECTOR)
;      :EXTERNAL-FORMAT :UTF-8)
; 
; caught WARNING:
;   Derived type of (REPLACE (MAKE-ARRAY (LENGTH SB-C::X)) SB-C::X) is
;     (VALUES SIMPLE-VECTOR &OPTIONAL),
;   conflicting with its asserted type
;     (VECTOR (UNSIGNED-BYTE 8)).
;   See also:
;     The SBCL Manual, Node "Handling of Types"
; 
; compilation unit finished
;   caught 1 WARNING condition
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER>

ありました。参考にしたのはこちら。
Common Lisp と 日本語 と 文字コード

怒られていますが、どうにも手掛りがないのでとりあえず実行、"neko"を変換しようとしました。
するとこう怒られます。

Value of (REPLACE (MAKE-ARRAY (LENGTH SB-C::X)) SB-C::X) in
(OCTETS-TO-STRING
 (COERCE (F (COERCE (STRING-TO-OCTETS S :EXTERNAL-FORMAT :UTF-8) 'LIST))
         'VECTOR)
 :EXTERNAL-FORMAT :UTF-8)

is
  #(110 101 107 111),
not a
  (VECTOR (UNSIGNED-BYTE 8)).
[Condition of type SIMPLE-TYPE-ERROR]

UNSIGNED-BYTEの配列じゃないから怒られている?

CL-USER> (defun decode-param (s)
           (labels ((f (lst)
                      (when lst
                        (case (car lst)
                          (#.(char-code #\%) (cons (http-byte (cadr lst) (caddr lst))
                                     (f (cdddr lst))))
                          (#.(char-code #\+) (cons #.(char-code #\space) (f (cdr lst))))
                          (otherwise (cons (car lst) (f (cdr lst))))))))
             (sb-ext:octets-to-string
              (coerce (f (coerce (sb-ext:string-to-octets s :external-format :utf-8) 'list))
                      '(VECTOR (UNSIGNED-BYTE 8))) :external-format :utf-8)))
WARNING: redefining COMMON-LISP-USER::DECODE-PARAM in DEFUN
DECODE-PARAM
CL-USER> (decode-param "neko")
"neko"
CL-USER> (decode-param "https://www.google.co.jp/search?q=lisp+coerce+type&oq=lisp+coerce+type&aqs=chrome..69i57.12279j0j4&sourceid=chrome&ie=UTF-8")
"https://www.google.co.jp/search?q=lisp coerce type&oq=lisp coerce type&aqs=chrome..69i57.12279j0j4&sourceid=chrome&ie=UTF-8"
CL-USER> (decode-param "https://www.google.co.jp/search?q=%E3%81%AD%E3%81%93%EF%BC%9F+%E3%81%AB%E3%82%83%E3%83%BC&oq=%E3%81%AD&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8")
"https://www.google.co.jp/search?q=ねこ? にゃー&oq=ね&aqs=chrome.3.69i57j69i59l3j69i61l2.4874j0j9&sourceid=chrome&ie=UTF-8"
CL-USER>

できた! ちょっと安直かなと不安になりましたが正解だったようです。

久し振りにCommon Lisp書いて楽しかったです。もう中毒ですね。
続きは明日にします。おやすみなさい。