hunchentootでログイン処理

OS XでのLisp処理系としてSBCLを使っていたんだけど、これはmacppcではスレッドが使えない。

いや、別に使いたいわけじゃないんだけど使いたいアプリがスレッドの実装を要求するのでしょうがないから代替となるLisp処理系を探すことになる。

で、Clozure CLを使っている。インストールして使えるようにするところまでの記録を書こうと思う。いつか。

今日はその使いたいアプリhunchentootでのログイン処理について。

hunchentootはLispで書かれたWebアプリサーバだ。Apacheは基本的にドキュメントルート配下のファイルをブラウザに送信するだけで、動的なコンテンツはCGIに依頼したりで自分では何もできない。
しかし、hunchentootはコンテンツの生成を全部Lispのプログラムでやる。プログラムはもちろん自分で書く。プログラムはhunchentootの一部として動作するのでCGIと違ってWebサーバが内部に持っているほとんどどんな情報でもその気になれば使えるわけだ。すごい。

しかも、SLIMEから関数定義を更新すれば(C-c C-c)ただちにWebサーバの動作に反映される。再起動とかリロードとかまったく不要。神の領域。違う？

このhenchentootの上に構築されたWebアプリフレームワークとしてWeblocksというものがある。あるんだけどその斬新な機構に自分の学習曲線が追いつかずよくわからんので、日本語で解説本が出るまで待つ事にしよう。
それまでは素のhunchentootを使うことにする。すなわちブラウザのリクエスト(GETとかPOSTとか)のパラメタを関数の引数とみなして手書きで作ったHTMLをだらっと返す、古き良きCGI的なモデルでWebアプリをつくる。CGIよりちょっと良くなる。このくらいの学習曲線でないとついていけない。

本題。

なにはともあれWebアプリではセッション＋認証が不可欠だろうからそこからトライしてみた。
セッションについてはhunchentootが完全に面倒をみてくれるのでそれを利用して、認証つまりログイン処理を書いてみた。

ログイン処理の基本についてはこちらのサイトがとても参考になった。処理に手落ちがある場合の具体的な攻撃手順も解説されてるので、何が本質的な問題なのか納得できました。

で、レベル３を目指して書いてみたのが以下。参考になればうれしいです。


* 日本語リテラルが文字化けせず表示されることの確認。けっこう苦労するんで。
* login.html はログインページを表示する。すでにログインしていればログアウトする。
* login.html は処理後にリダイレクトして元いたページへ戻る。ログアウト時も同様。
* リダイレクトのURLをチェックして変なところには飛ばない。
* HTMLはさすがに手書きではなくCL-WHOを使って楽する。LispプログラムとHTMLテンプレート言語のシームレスな融合の美しさをご覧あれ。
* パスワードは Login: foo Password: bar です。
* (login)関数の最初の10行ぐらいが大事なとこ。(redirect-safe)と(auth-valid-p)もチェック。あとはこれらを動作させるためのサンプルにすぎない。

(defvar *this-file* (load-time-value
                     (or #.*compile-file-pathname* *load-pathname*)))

(defmacro with-html (&body body)
  `(with-html-output-to-string (*standard-output* nil :prologue t)
     ,@body))

(defun menu-link ()
  (with-html-output (*standard-output*)
    (:p (:hr
         (:a :href "/hunchentoot/test" "Back to menu")
         (htm (:a :href (format nil "/hunchentoot/login.html?from=~A" (url-encode (request-uri)))
                  (str (if *session* " | Logout" " | Login"))))))))

(defparameter *headline*
  (load-time-value
   (format nil "Hunchentoot (see file ~A)"
           (merge-pathnames (make-pathname :type "lisp") *this-file*))))

(defvar *utf-8* (flex:make-external-format :utf-8 :eol-style :lf))

(defvar *utf-8-file* (merge-pathnames "UTF-8-demo.html" *this-file*)
  "Demo file stolen from .")

(defun auth-valid-p (user pass)
  (and (equal user "foo")
       (equal pass "bar")))

(defun redirect-safe (url)
  (let ((url (url-decode url)))
    (cond ((and (< 0 (length url))
                (eql #\/ (aref url 0)))
           (redirect url))
          (t
           (redirect "/hunchentoot/test")))))

(defun logout ()
  (if *session*
      (remove-session *session*))
  (redirect-safe (get-parameter "from")))

(defun login ()
  (if *session* (logout))
  (let ((user (post-parameter "name"))
        (pass (post-parameter "pass")))
    (cond ((post-parameter "cancel")
           (redirect-safe (post-parameter "from")))
          ((auth-valid-p user pass)
           (setf (session-value 'user) user)
           (redirect-safe (post-parameter "from"))))

    (no-cache)
    (setf (content-type) "text/html; charset=utf-8"
          (reply-external-format) *utf-8*)
    (with-html
      (:html
       (:head
        (:title "ログイン処理"))
       (:body
        (:p (if *session*
                (fmt "User: ~A" (session-value 'user))
                (fmt "Not Login.")))
        (:p (:form :method :post
                   "Login: "
                   (:input :type :text
                           :name "name"
                           :value (or (session-value 'user) user ""))
                   :br
                   "Password: "
                   (:input :type :password
                           :name "pass"
                           :value "")
                   (:input :type :hidden
                           :name "from"
                           :value (get-parameter "from"))
                   :br
                   (:input :type :submit
                           :value "Login")
                   :br
                   (:input :type :submit
                           :name "cancel"
                           :value "Cancel"))))))))

(defun menu ()
  (setf (content-type) "text/html; charset=utf-8"
        (reply-external-format) *utf-8*)
  (with-html
    (:html
     (:head
      (:link :rel "shortcut icon"
             :href "/hunchentoot/test/favicon.ico" :type "image/x-icon")
      (:title "Hunchentoot テスト menu ©"))
     (:body
      (:h2 (str *headline*))
      (:p (str (script-name)))
      (:p (:a :href "/hunchentoot/test/menu.html" "menu page"))
      (menu-link)
      ))))

(setq *dispatch-table*
      (nconc
       (list 'dispatch-easy-handlers)
       (mapcar (lambda (args)
                 (apply #'create-prefix-dispatcher args))
               '(("/hunchentoot/test/form-test.html" form-test)
                 ("/hunchentoot/test/menu.html" menu)
                 ("/hunchentoot/test" menu)
                 ("/hunchentoot/login.html" login)))
       (list #'default-dispatcher)))