コードリーディング: Lack の Session ミドルウェアを理解する

Webアプリケーションを構築する際にはユーザのセッション管理が必須である.今回は lack-middleware-session のソースを読みながらSessionミドルウェアの使い方を学ぶ.本稿の最後ではSessionミドルウェアを使ったサンプルWebアプリケーションを構築する.

Sessionミドルウェアの概観

Sessionミドルウェアはセッション変数として,文字列をキーにしたハッシュテーブルを提供する.つまり,セッション毎にハッシュテーブルが用意される.Webアプリケーションは任意のセッション情報をこのセッション変数(ハッシュテーブル)に格納することができる.

各セッションはセッションIDによって識別される.新規セッションが開始されると,セッションIDとセッション変数(ハッシュテーブル)が生成され,サーバー側の store バックエンドに保存される.一方,クライアント側ではセッションIDがブラウザ・クッキーに保存される.Sessionミドルウェアはクッキーに保存されたセッションIDを用いてクライアントを識別する.

セッション変数の保存先である store バックエンドのデフォルトは,インメモリのハッシュテーブル(キーがセッションIDで値がセッション変数)である.したがって,セッション変数も store バックエンドもハッシュテーブルである.store バックエンドはオプションでRedisとSQLデータベースを指定できる.

リクエストがあるとSessionミドルウェアはクッキーからセッションIDを取り出し,セッション変数(ハッシュテーブル)を store バックエンドから取り出す.

セッション変数を使うには,Sessionミドルウェアより後のパイプラインにあるアプリケーションで

(getf env :lack.session)

を実行し env からセッション変数(ハッシュテーブル)を取り出す.取り出したハッシュテーブルに,任意のキー・バリューを保存することができる.セッション変数は,パイプライン後方のアプリケーションを実行した後,Sessionミドルウェアの事後処理で自動的にバックエンドに保存される.

以下,コードを追いながら細かい設定事項と動作の詳細を見ていく.

Sessionミドルウェアの引数

Sessionミドルウェア はアプリケーション・ビルド時に3つのキーワード引数,:store:state:keep-empty をとる.

コード 1. Sessionミドルウェアの引数
(lambda (app &key
            (store (make-memory-store))
            (state (make-cookie-state))
            (keep-empty t))
    (lambda (env)
    ...
    ミドルウェア本体
    ...
    ))

:store キーワードでセッション変数の格納場所を指定する.デフォルトの格納先はメモリ上のハッシュテーブルである.ちなみに store に保存されるセッション変数自体もハッシュテーブルである.

:state キーワードには,セッションIDとセッション状態を管理する state 構造体インスタンスを指定する.デフォルトでは cookie-state 構造体インスタンスが使われる.クッキーの設定を変更したい場合は,属性をカスタム設定したインスタンスを指定する.

:keep-empty キーワードが t の場合,セッション情報が store バックエンドに保存される.

コード 1の2—​4行目は,Webアプリケーション構築時に1回だけ実行される.したがって,セッションを管理する store もクッキーの雛形になる state も,全てのリクエストで共有される.

セッション保存方法の設定

コード 1の2行目,store のデフォルト値は memory-store 構造体インスタンスである.memory-store 構造体は src/middleware/seesion/store/memory.lisp で以下のように定義されている.

コード 2. memory-store 構造体の定義
(defstruct (memory-store (:include store))
  (stash (make-hash-table :test 'equal)))			(1)

(defmethod fetch-session ((store memory-store) sid)
  (gethash sid (memory-store-stash store)))

(defmethod store-session ((store memory-store) sid session)
  (setf (gethash sid (memory-store-stash store))		(2)
        session))

(defmethod remove-session ((store memory-store) sid)
  (remhash sid (memory-store-stash store)))
1 stash スロットにセッション変数を格納するハッシュテーブルを用意.キーは文字列から成るセッションIDなので,テスト関数は equal を指定している.
2 セッションIDをキーとしてセッション変数を保存する.保存されるセッション変数も文字列をキーとしたハッシュテーブルである.memory-store-stashstash スロットへのアクセサ関数で defstruct 時に自動的に定義される.

memory-store 構造体は,stash スロットの初期値として,文字列キーで比較するハッシュテーブルを設定する.memory-store が継承する store 構造体はスロットのない抽象構造で src/middleware/session/store.lisp で以下のように定義されている.

コード 3. store 構造体の定義
(defstruct store)

(defgeneric fetch-session (store sid))
(defgeneric store-session (store sid session))
(defgeneric remove-session (store sid))

store 構造体はセッション変数を格納するバックエンド用に3つの抽象インターフェースを定義する.Sessionミドルウェアはこれら3つの総称関数を用いて,ユーザが :store キーワードで指定した store インスタンスに対し,セッションIDの取り出し,保存,削除を行う.ちなみに,Lackにはインメモリのバックエンドに加え,Redis用の redis-store と SQLデータベース用の dbi-store がオプションとして用意されている(2017年10月時点).dbi-store深町氏Cl-DBI を使ってSQLデータベースにセッションIDを保存するバックエンドだ.

ちなみにRedisはメモリ上にデータベースを構築するので,永続化するにはRDBファイルに定期的に書き出すか,更新差分のコマンドを記録するAOF(Append Only File)を書き出す必要がある(2017年10月現在).

1つのLackアプリケーションにつき store インスタンスは1個だけ作成され,複数のWebリクエストで使われる.Webサーバーが複数スレッド(またはプロセス)を起動し,各スレッドでLackアプリケーションを立ち上げた場合,インメモリにセション情報を保持する memory-store 構造体を使用した場合,別スレッドで処理された過去のセッション情報にアクセスすることができない.Webリクエストを並列(並行)処理で捌く場合には,必ずデータベースか共有メモリを store バックエンドに指定しなければならないことに注意しよう.

セッション状態定義の設定

次に,コード 1の3行目,:state キーワードを見ていく.state キーワード変数には,セッションの状態を管理する cookie-state 構造体インスタンスが設定される.cookie-state 構造体は state 構造体を継承する.state 構造体はセッションIDの生成や状態管理を担い,cookie-state 構造体はクッキーに与える制約を設定する.まず,state 構造体の詳細を調べ,次に cookie-state 構造体を見ていく.

sate 構造体は src/middleware/session/state.lisp で定義されている.state 構造体の定義をコード 4に掲げる.

コード 4. state 構造体の定義
(defstruct state
  (sid-generator (lambda (env)					(1)
                   (declare (ignore env))
                   (generate-random-id)))
  (sid-validator (lambda (sid)
                   (not (null (ppcre:scan "\\A[0-9a-f]{40}\\Z" sid))))))

(defun generate-sid (state env)					(2)
  (funcall (state-sid-generator state) env))

(defgeneric extract-sid (state env))				(3)
(defmethod extract-sid :around ((state state) env)
  (let ((sid (call-next-method)))
    (when (and sid
               (funcall (state-sid-validator state) sid))
      sid)))

(defgeneric expire-state (state sid res options))		(4)

(defgeneric finalize-state (state sid res options))		(5)
1 sid-generator スロットにセッションIDを生成する関数を設定する.デフォルトの生成関数はこの後コード 5で詳しく見ていく.
2 Sessionミドルウェアは generate-sid 関数を使ってセッションIDを生成するので,その際に sid-generator スロットの関数が起動される.デフォルトでは src/util.lisp 内で定義されている generate-random-id 関数でIDを生成する.
3 state 構造体インスタンスと環境変数 env から,セッションIDを抽出する総称関数を宣言.12—​16行目がその実装.:around 修飾子が付いているので,ユーザ実装のメソッドより前に12—​16行目のメソッドが実行される.この実装は call-next-method でユーザーによる実装を呼び出しセッションIDを取得し,妥当性を検査して返す.妥当でない場合は nil が返る.
4 セッションを有効期限切れにして無効化する総称関数を宣言.src/middleware/session/state/cookie.lisp 内で実装されている(コード 10参照).src/middleware/session.lisp 内から呼び出される(コード 8の11行目).
5 セッションのfinalizeを担う総称関数を宣言.src/middleware/session/state/cookie.lisp 内で実装されている.同ファイル内と src/middleware/session.lisp 内から呼び出される.

コード 4の9行目で呼び出される generate-random-id の定義は以下のとおり.

コード 5. デフォルトのセッションID生成関数
(defun generate-random-id ()
  "Generates a random token."
  (byte-array-to-hex-string
   (digest-sequence
    (make-digest :SHA1)
    (ascii-string-to-byte-array
     (format nil "~A~A"
      (random 1.0) (get-universal-time))))))

乱数とシステム・クロックの経過時間を繋げた文字列をキーに,SHA1ハッシュ関数でランダムな文字列を生成する.生成には ironclad パッケージの関数が使われている.

次に,state 構造体を継承した cookie-state 構造体を見てみよう.cookie-state 構造体は,クッキーに与える制約属性をスロットに保持する.以下のデフォルト設定を変更したい場合には,Sessionミドルウェアの :state 引数に独自設定の cookie-state インスタンスを渡せば良い.

1 Path属性.クライアントがクッキーをサーバーに送信できるサーバーのパスを指定する.デフォルト値はWebアプリのルートになる.
2 Domain属性.クライアントがクッキーを送信するサーバーのドメインは設定しない.この場合,クッキーを発行したサーバーのみが送信先になる.
3 Expires属性.クッキーの寿命を設定.デフォルト値は現在時刻になる.
4 Secure属性.デフォルトで設定されない.t に設定するとhttps接続以外ではクッキーを送信しなくなる.
5 HttpOnly属性.デフォルトでは設定されない.t に設定するとJavaScriptからクッキーにアクセスできなくなる.
6 セッションIDを保持するクッキーのキー名を指定.デフォルト値は "lack.session".リスポンスヘッダは Set-Cookie: lack.session=セッションID となる.

以上がSessionミドルウェアの引数でデフォルトで渡される cookie-state 構造体インスタンスの中身である.デフォルト設定に関して幾つか注意点を挙げておく.

まずPath属性でWebアプリのルートディレクトリを指定しているため,Webアプリの全てのサブディレクトリに対するリクエストでクッキーが送信される.Path属性を指定しないと,クッキーが設定されたディレクトリ以外にはクッキーが送信されない.

Domain属性で nil が設定されているため,クッキーが設定されたホストだけにクッキーが送信され,サブドメインに対しても送信されない.www.host.comにもblog.host.comにもクッキーを送信したければDomain属性にhost.comを指定しなければならない.

Expires属性に現在時刻が設定されているため,クライアントが次にWebアプリにアクセスする時にはこのクッキーはサーバーに送信されない.

Sessionミドルウェアを使用するアプリケーション側からはクッキー情報を保持する cookie-state 構造体インスタンスにアクセスする術がない.ミドルウェアとアプリケーションの間の情報のやり取りは env 環境変数を通してのみ行われるからだ(「Lackアプリケーションを理解する」参照).従って,リクエストごとにクッキーの設定を変更することはできない.唯一変更できるのはExpires属性で,後で説明するように env 環境変数内に格納されている :lack.session.options を使って変更する.

keep-empty 引数

Sessionミドルウェアの最後の引数である keep-empty について見てみよう.keep-emptystore バックエンドにセッション変数を保存するか否かを指定するフラグである.keep-emptyt ならセッション変数は store に保存され,nil なら保存されない.

コード 7の20行目で keep-empty 引数が t だと24行目の finalize が呼び出される.finalize はセッション変数を store バックエンドに保存する役目と,ブラウザにクッキーを送信する役目を担う.クッキーが送信されるためにはさらに追加の条件が必要なので,keep-emptystore バックエンドにセッション変数を保存するか否かを決定するフラグになる.

Sessionミドルウェア本体

ここまで長かったが,Sessionミドルウェアの引数を全て解明したので,いよいよミドルウェア本体の処理を見ていく.

コード 7. Sessionミドルウェア本体
(defparameter *lack-middleware-session*
  (lambda (app &key
            (store (make-memory-store))
            (state (make-cookie-state))
            (keep-empty t))
    (lambda (env)
      (let* ((sid (extract-sid state env))
             (session (and sid
                           (fetch-session store sid)))
             (sid (or sid
                      (generate-sid state env)))
             (new-session-p (not session))
             (session (or session (make-hash-table :test 'equal))))
        (setf (getf env :lack.session) session)
        (setf (getf env :lack.session.options)
              (if new-session-p
                  (list :id sid :new-session t   :change-id nil :expire nil)
                  (list :id sid :new-session nil :change-id nil :expire nil)))
        (let ((res (funcall app env)))
          (if (and (not keep-empty)
                   new-session-p
                   (zerop (hash-table-count session)))
              res
              (finalize store state env res))))))
  "Middleware for session management")

6行目の lambda 式がミドルウェアチェーンの中で呼び出される.まず,7行目で環境 env からセッションIDを取り出す.もしセッションIDを既に持っているなら store からセッション変数を取り出し session に代入する(9行目).ここで取り出されたセッション変数はハッシュテーブルで,セッション毎に保存しておきたい値を自由に格納できる.10行目ではセッションIDが割り当てられていない新規セッションに向けて新たなセッションIDを生成し sid に代入する.この時点で,新規・既存いずれのセッションにおいても sid にセッションIDが格納されていることになる.12行目ではセッション変数が設定されているか否かで,新規セッションか否かを表す述語変数 new-session-p を設定する.新規セッションならば13行目で session に新しいハッシュテーブルが設定される.この時点で新規・既存セッションを問わず session ローカル変数も設定が完了する.

14行目で env 環境変数(ハッシュテーブル)に :lack.session をキーにセッション変数を代入する.既存セッションには無駄な処理のように見える.

15行では,env:lack.session.options をキーにオプションリストを設定する.ここでは,新規セッション時にのみ :new-session キーを t に設定し,他のオプションをデフォルト設定に戻している.デフォルトでは(:change-id nil)と :expire を `nil`に設定している.

ミドルウェア・チェーンの後段が19行目の (funcall app env) で呼び出されるが,その中で :change-idt に設定すれば,24行目の (finalize store state env res) 内で新しいセッションIDが生成される.ログイン時には必ずセッションIDを更新することが IPAの「安全なウェブサイトの作り方」 でも推奨されているので,その場合には後で示す サンプルアプリ(例3) ように後段のミドルウェアで :change-idt に設定する.

:expire オプションはログアウト時など即座にセッションを切りたい時に使うフラグで,:expiret に設定するとコード 8の10—​11行目でセッションをexpireする処理が実行される.ちなみに,スペルが1文字違いの :expires オプションが別途あるので注意を要する.:expires オプションはクッキーの有効期間を秒数で指定するものである(後ほど説明).

これらオプションを変更するには,Sessionミドルウェアより後のミドルウェアチェーンの事前または事後処理で env から :lack.session.options キーの値を取り出して上書きする.これらオプションはSessionミドルウェア事後処理の finaizefinalize-state 関数(コード 11を参照)で使用される.

19行目でミドルウェアチェーンの次のアプリケーションを呼び出し,結果を res に代入する.20行目以降が事後処理である.

事後処理は,keep-emptynil で且つ,新規セッション且つ,セッション変数が空なら,何もせずに res を返し,それ以外はファイナライズ処理を行う.

24行目の finalize 関数の定義は同じファイル内にある.finalize の役割は前にも説明した通り,セッション変数を store バックエンドに保存する役目と,ブラウザにクッキーを送信する役目を担う.

コード 8. finaize 関数の定義
(defun finalize (store state env res)
  (let* ((session (getf env :lack.session))
         (options (getf env :lack.session.options))
         (id (getf options :id))
         (new-id (if (getf options :change-id)
                     (generate-sid state env)
                     id)))
    (when session
      (apply #'commit store new-id session options))
    (if (getf options :expire)
        (expire-state state id res options)
        (finalize-state state new-id res options))))

コード 8の8—​9行目で,store バックエンドにセッション変数が保存される.commit 関数は同じファイル内でコード 9のように定義されている.

コード 8の10行目では :expire オプションが t の時に expire-state 関数を呼び出して直ちにセッションを切る処理をしている.expire-stateコード 10に定義されているように,クッキーの有効期間(秒数)を保持する :expires オプションを0に設定することで直ちにセッションを無効化している.

コード 9. commit 関数の定義
(defun commit (store new-sid session &key id expire change-id &allow-other-keys)
  (cond
    (expire
     (remove-session store id))
    (change-id
     (remove-session store id)
     (store-session store new-sid session))
    (t
     (store-session store id session))))
コード 10. expire-state メソッドの定義
(defmethod expire-state ((state cookie-state) sid res options)
  (setf (getf options :expires) 0)
  (finalize-state state sid res options))

コード 8の最後で呼び出される finalize-state は総称関数で,:expire オプションが nil の時に呼び出され src/middleware/session/state/cookie.lisp で2つの実装が定義されている.引数の state 変数には cookie-state 構造体インスタンスが渡される.1つ目の実装(コード 11,1—​4行目)は,res 引数が関数の場合,すなわち,別のミドルウェアかアプリケーションの場合に呼び出される.この場合は,この関数を実行して実際のレスポンスを生成する.最終的なレスポンスは「ステータス・コード,ヘッダ,レスポンス・ボディ」の3つの要素から成るリストになる.この場合は,コード 11の6行目以降で定義されている実装が事後処理として呼び出される.

コード 11. finalize-state メソッドの定義
(defmethod finalize-state ((state cookie-state) sid (res function) options)
  (lambda (responder)
    (funcall res (lambda (actual-res)
                   (funcall responder (finalize-state state sid actual-res options))))))

(defmethod finalize-state ((state cookie-state) sid (res list) options)  (1)
  ;; Don't send Set-Cookie header when it's not necessary.
  (destructuring-bind (&key no-store new-session change-id expire &allow-other-keys)
      options
    (when (or no-store
              (not (or new-session change-id expire)))
      (return-from finalize-state res)))               (2)

  (let ((res (apply #'make-response res))                         (3)
        (options (with-slots (path domain expires secure httponly) state  (4)
                   (list :path path
                         :domain domain
                         :secure secure
                         :httponly httponly
                         :expires (+ (get-universal-time)
                                     (getf options :expires expires)))))) (5)
    (setf (getf (response-set-cookies res) (cookie-state-cookie-key state))
          `(:value ,sid ,@options))
    (finalize-response res)))
1 この時点で引数の options には,env から取り出した lack.session.options のplistがコピーされている.
2 no-store オプションが t か,または,新規セッション,セッションIDの変更,クッキーの期限切れのいずれでもなければ(いずれも nil ならば),クッキーはブラウザに送信されず直ちにレスポンスを返る.ちなみに no-store オプションはデフォルトでは設定されないオプションなので,Webアプリの方でクッキーを送信したくない時に使用する.
3 これ以降は更新したクッキーヘッダをレスポンスオブジェクトに含める処理をする.
4 現在のクッキー情報を格納する state から path, domain, expires, secure, httponly を取り出し,options に設定する.この options が次に送信されるクッキーの設定(22—​23行目)に使われる.
5 getf:expires プロパティの値を取り出す元となる optionsenv から取り出された lack.session.options のplistのコピー.options 内に :expires プロパティがなければ15行目で cookie-state インスタンスの expires スロットから取り出した値が有効期間となる.ここで指定された秒数は24行目の finalize-response を通して適切な文字列フォーマットに変換される( bake-cookie 参照).

finalize-stateコード 11の10行目の条件が成立しない時,クッキーをブラウザに送信する.すなわち,env 内の :lack.session.options で,:no-store オプションが nil で且つ,:new-session:change-id:expire オプション値の全てが nil の場合にクッキーが送信される.

:expires オプションはセッション有効期間を秒数で指定するもので,直ちにセッションを無効化する :expire オプションとは異なるので注意.次のリクエストが :expires で指定された秒数を超えた場合にはクッキーに保存されたセッション情報が無効になりセッションが切れる.

最終アクセスから :expires 秒後にセッションを無効化したい場合,:expires の指定だけでは不十分で,new-sessionchange-id のいずれかを t に設定する必要がある.なぜなら,これらが nil のときコード 11の12行目が実行され,クッキーのExpire属性が更新されずにリクエストを返してしまうからである.new-sessionchange-idt に設定せずに :expires だけ設定した場合には,最初のアクセスから :expires 秒後にセッションが切れることになる.

サンプルコード

ここではSessionミドルウェアを使った3つのサンプルアプリを示す.1つ目はデフォルト設定,2つ目は :expires オプションを使って最終アクセスから5秒後にセッションが切れる設定,3つ目はログイン・ログアウトを実現するアプリである.

例1)デフォルト設定のサンプル・アプリ

コード 12はデフォルト設定のままSessionミドルウェアを使ったサンプル・アプリで,Sessionミドルウェアの設定以外は例2と同じものになる( middleware-session-default.lisp on GitHub ).

サンプルアプリの実行方法を説明しておく.コード 12をREPLで評価するとHunchentootサーバーが起動する.REPL上のメッセージに従ってブラウザで http://localhost:5000 にアクセスする.サーバーを終了するには,コード 12の最終行でコメントアウトされている (clack:stop *handler*) をREPLで評価する.(例2)(例3)の実行方法も同様である.

コード 12. デフォルト設定のサンプル・アプリ
(require 'clack)
(require 'lack)

(defparameter *subtitle* "<h2>--- With Default Settings ---</h2>")

;; information to extract from :lack.session.options from env
(defparameter *options*
  (list :new-session :change-id :no-store :expire :expires))

;;
;; Echos session info
;;
(defparameter *my-echo*
      (lambda (env)
	(let* ((session (getf env :lack.session))
	       (counter (gethash :visit session -1)))
	  (setf (gethash :visit session) (incf counter))
	  `(200 (:content-type "text/html")
		,(append
		  (list "<html><h1>Lack Session Middleware Test</h1>"
			*subtitle*
			"<ul>"
			(format nil "<li>Visiting times: ~A</li>" counter))
		  (mapcar (lambda (key)
			    (let ((val (getf (getf env :lack.session.options)
					     key)))
			      (format nil "<li>~A = ~A</li>" key val)))
			  *options*)
		  (list "</ul></html>"))))))
;;
;; Creates Lack Application
;;
(defparameter *app*
  (lack:builder
   :session
   *my-echo*))

;;
;; Starts the Web server
;;
(defparameter *handler*
  (clack:clackup *app*))

;;
;; Stops the Web server
;;
; (clack:stop *handler*)

例2) :expires オプションを使い最終アクセスから5秒後にセッションを切るアプリ

例1)の *my-echo* を以下のように変更する.ここでは変更部分のみ示すので全ソースコードは こちら(GitHub) を参照されたい.

(defparameter *my-echo*
  (lambda (env)
	(let* ((session (getf env :lack.session))
	       (counter (gethash :visit session -1)))
	  (setf (gethash :visit session) (incf counter))
	  ;; expires after 5 seconds since the last acess
	  (setf (getf (getf env :lack.session.options) :expires) 5)     (1)
	  (setf (getf (getf env :lack.session.options) :new-session) t) (2)
	  `(200 (:content-type "text/html")
		,(append
		  (list "<html><h1>Lack Session Middleware Test</h1>"
			*subtitle*
			"<ul>"
			(format nil "<li>Visiting times: ~A</li>" counter))
		  (mapcar (lambda (key)
			    (let ((val (getf (getf env :lack.session.options)
					     key)))
			      (format nil "<li>~A = ~A</li>" key val)))
			  *options*)
		  (list "</ul></html>"))))))
1 env プロパティ・リストから :lack.session.options プロパティ・リストを取り出し,:expires プロパティの値を5に設定.これでクッキーのExpires属性が5秒に設定される.
2 さらに同オプションの :new-session プロパティの値を t に設定することで,クッキーヘッダがブラウザに送信され更新される.これを忘れるとセッションが切れないので注意.

Lispの変数は全て参照渡し(ポインタのコピー)なので,:lack.session.options に格納されているプロパティ・リストへのポインタをコード 13の様に,一旦 op に格納し,上の7—​8行目のプロパティ・リストの取り出しを1回で済ませようとすると,:expires の設定が反映されないので注意を要する.

コード 13. 誤った設定例
  (lambda (env)
	(let* ((session (getf env :lack.session))
	       (counter (gethash :visit session -1))
	       (op (getf env :lack.session.options)))  ;; ローカル変数にenv内のoptionsをバインド
	  ;; expires after 5 seconds since the last acess
	  (setf (getf op :expires) 5)  ;;  (setf (getf (getf env :lack.session.options) :expires) 5)

なぜ反映されないかというと,プロパティ・リストに setf で破壊的に代入を試みても,リスト内にキーが無い場合,新しいキーと値からなるコンスセルがプロパティ・リストの先頭に追加され,env 内の :lack.session.options は相変わらず古いリストへのポインタ(新しいリストの2番目のコンスセルを指すポインタ)を保持しているからだ.

以下は,それぞれの setf の呼び出し方の違いがどのように処理されるかを自分自身の覚書として記録したもので,例3まで飛ばして頂いて問題ない.

プロパティ・リストに対する setf で使われる SB-IMPL::%PUTF の定義は以下のとおり(以下SBCLの場合).

(defun %putf (place property new-value)
  (declare (type list place))
  (do ((plist place (cddr plist)))
      ((endp plist) (list* property new-value place)) (1)
    (declare (type list plist))
    (when (eq (car plist) property)
      (setf (cadr plist) new-value)
      (return place))))                               (2)
1 property が見つからないときは,propertynew-value を先頭要素に加えたリストを返す.つまり返されたリストを指すポインタは元の place とは異なるアドレスを指す.
2 見つかったときは place,すなわち元のプロパティ・リストを返す.

まず DO ループの定義は,

(do ((var init-form step-form)*)
    (end-test-form result-form*)
    statement*)

そして,endp は引数が空リストのとき真で,コンスのとき偽を返す.

コード 14. :lack.session.options を設定する時の注意
CL-USER> (macroexpand '(setf (getf (getf env :lack.session.options) :expires) 5))
(LET* ((#:NEW624 5))     (1)
  (LET ((#:NEW623
         (SB-IMPL::%PUTF (GETF ENV :LACK.SESSION.OPTIONS NIL) :EXPIRES
                         #:NEW624)))  (2)
    (LET ((#:NEW1 (SB-IMPL::%PUTF ENV :LACK.SESSION.OPTIONS #:NEW623)))  (3)
      (SETQ ENV #:NEW1)
      #:NEW623)
    #:NEW624))
1 引数が1回だけ評価されることを保証するために :expire プロパティに設定する値を一時変数 #:NEW624 に保存.
2 SB-IMPL::%PUTF 関数は ENV から取り出した :LACK.SESSION.OPTIONS の値(この場合プロパティ・リスト)から :expire プロパティを探し,見つかればその場所に5を破壊的に代入しプロパティ・リストへのポインタを返す.見つからなければ,元のプロパティ・リストの先頭に :expire 5 を追加し連結後のリストを返す.ただし,後ろに連結されたリストはメモリ上では元のリストと同じオブジェクトである.
3 上の <2> で代入後のリストを元の ENV:LACK.SEESION.OPTIONS の値に設定する.上の <2> で :expire が見つからなかった場合には,この時点で :LACK.SEESION.OPTIONS の値は新しいリストへのをポインタに変更されている.
CL-USER> (macroexpand '(setf (getf op :expires) 5))
(LET* ((#:NEW625 5))
  (LET ((#:NEW1 (SB-IMPL::%PUTF OP :EXPIRES #:NEW625)))  (1)
    (SETQ OP #:NEW1)  (2)
    #:NEW625))
1 ここまでは,コード 14と同じ.
2 ここで,:expires プロパティが見つからなかった時に新しいリストに変更されているが,一時変数 OP にそのリストへのポインタが設定されるだけで,ENV ないの :LACK.SESSION.OPTIONS プロパティの値は変更されない.

一方,ハッシュテーブルの場合は,キーが見つからずに新規にキー・バリューが設定されても,ハッシュテーブル・オブジェクト自身のアドレスは変更されないので,問題ない.

CL-USER> (macroexpand '(setf (gethash :visit session) (incf counter)))
(LET* ((#:HASHTABLE SESSION)     (1)
      	 (#:NEW1 (INCF COUNTER)))
  (SB-KERNEL:%PUTHASH :VISIT #:HASHTABLE #:NEW1))  (2)
1 引数の session の値(ハッシュテーブルへのポインタ)が一時変数 #:HASHTABLE に設定される.
2 #:HASHTABLEsession は同じハッシュテーブルを指すので,ここで #:NEW1 の値を設定すれば,元の session 変数の中身も変わる.

例3)ログイン・ログアウトの実装

特定のディレクトリ以下のアクセスにはログインを強要するWebアプリの例を示す.それ以外のディレクトリは自由にアクセスできる.

ここでは要所要所の解説のみを示すので,全ソースコードは こちら(GitHub) を参照されたい.

アプリケーションは lack:builder を使って構築している.

コード 15. アプリケーション構成
(defparameter *app*
  (lack:builder
   :session
   (secure-mw #'redirect-to-login-page '("/private"))
   (:mount "/login" *login*)
   (:mount "/auth" *auth*)
   (:mount "/logout" *logout*)
   (:mount "/private" *private*)
   *sample-app*))

ミドルウェア・チェーンの先頭は :session ミドルウェアでセッション変数の管理を移譲する(コード 15,3行目).次の secure-mw が独自実装のミドルウェアで定義はコード 16の通りである.secure-mw は,特定のパス以下にアクセスする場合にログインを要求するミドルウェアである.すでにログイン済みの場合は,ミドルウェア・チェーンの後段に処理を渡す.

コード 16. セキュア領域を守るミドルウェア
;;; Middleware to proctect the secure area
;;; :uidが設定されていない場合,protected-pathにアクセスすると
;;; redirect関数を呼び出してログインページへリダイレクトする.
(defun secure-mw (redirect protected-path)
  (lambda (app)
    (lambda (env)
      ;; preprocessing
      (let* ((url (getf env :path-info))
             (session (getf env :lack.session))
             (uid (gethash :uid session)))
        (if (and (null uid)
                 (dolist (prefix protected-path)
                        (when (starts-with url prefix) (return t))))
            (progn
              ;;当初のアクセス先をセッション変数に保存
              (setf (gethash :prev-url session) url)
              (funcall redirect))
            (funcall app env))))))

コード 16の17行目でログインページへリダイレクトする前に,現在のアクセス先URLをセッション変数に保存している.ログインに成功した時には,セッション変数からこのURLを取り出し,元のページへリダイレクトする.

ログインページへのリダイレクトを担う関数はコード 15の4行目で指定された redirect-to-login-page 関数で,以下のように定義されている.

コード 17. リダイレクト
;;; ログインページへリダイレクトするレスポンスを返す.
(defun redirect-to-login-page ()
  '(303 (:location "/login") ("")))

ログインページの定義は以下の通りで,セッション変数内に uid が設定されていればログイン済みメッセージを表示し,設定されていなければログインフォームを表示する.

コード 18. ログインページ
(defparameter *login*
  (lambda (env)
    (let ((uid (get-uid env)))
      `(200 (:content-type "text/html")
            ,(append (page-header)
                     (if uid
                         (list "<p>You are already logged in as " uid ".</p>")
                         (login-form))
                     (page-footer))))))

ログインフォームは,「パラメータと値」をドット対のリストに格納し,POSTメソッドのbodyとして送信してくる.ログインフォームは /auth にマウントしている以下のアプリケーションを呼び出す.

(defparameter *auth*
  (lambda (env)
    (let* ((params (getf env :body-parameters))
           (name (cdr (assoc "uname" params :test #'string=)))
           (pass (cdr (assoc "passwd" params :test #'string=))))
      (if (and (= (length params) 2)
               (authenticate name pass))
          (let* ((session (getf env :lack.session))
                 (url (gethash :prev-url session "/")))
            (setf (gethash :uid session "/") name)
            (setf (getf (getf env :lack.session.options) :change-id) t) (1)
            `(303 (:location ,url) ("")))
          (redirect-to-login-page)))))
1 ログイン後は新しいセッションIDを割り当てる.次回アクセス時には :change-id の値は nil にリセットされるため,セッションIDの更新は1回限りである.

認証自体は authenticate 関数に委譲し,成功すればセッション変数から :prev-url に保存されている当初のアクセス先を取り出しリダイレクトする.失敗すればログインページへリダイレクトする.セッションの乗っ取りを避けるためにログイン時に新たなセッションIDを割り当てる設定をする(11行目).

ログアウトは,:lack.session.options:expire キーの値を t に設定することで実現する.

(defparameter *logout*
  (lambda (env)
    (setf (getf (getf env :lack.session.options) :expire) t)
    `(200 (:content-type "text/html")
          ,(append (page-header)
                   (list "<p>You have logged out.</p>")
                   (page-footer)))))