diff --git a/lib/host/blog.sx b/lib/host/blog.sx index cdad9642..5e594eaf 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -326,26 +326,28 @@ (let ((slug (dream-param req "slug"))) (let ((r (host/blog-get slug))) (if r - ;; Compute the rendered body + related block in let bindings BEFORE the - ;; quasiquote — host/blog--related-block does durable reads, and IO must - ;; happen in the handler body, not while the page tree is being built. - (let ((body-html (host/blog-render r)) - (related-block (host/blog--related-block slug - (not (nil? (host/current-principal req)))))) - (dream-html - (host/blog--page (get r :title) - (quasiquote - (div - (article (raw! (unquote body-html))) - (unquote related-block) - (p :style "margin-top:2em;font-size:0.9em;opacity:0.8" - (a :href (unquote (str "/" slug "/source")) "view source") - " · " - (a :href (unquote (str "/" slug "/edit")) "edit") - " · " - (a :href "/" "all posts") - " · " - (unquote (host/auth-footer req)))))))) + ;; Compute everything that does durable reads — body, related block, AND + ;; the auth footer (a durable session read now) — in let bindings BEFORE + ;; the quasiquote. IO must run in the handler body, never while the page + ;; tree is built (a perform there raises VmSuspended under http-listen). + (let ((principal (host/current-principal req))) + (let ((body-html (host/blog-render r)) + (related-block (host/blog--related-block slug (not (nil? principal)))) + (auth-foot (host/auth-footer req))) + (dream-html + (host/blog--page (get r :title) + (quasiquote + (div + (article (raw! (unquote body-html))) + (unquote related-block) + (p :style "margin-top:2em;font-size:0.9em;opacity:0.8" + (a :href (unquote (str "/" slug "/source")) "view source") + " · " + (a :href (unquote (str "/" slug "/edit")) "edit") + " · " + (a :href "/" "all posts") + " · " + (unquote auth-foot)))))))) (dream-html-status 404 (host/blog--page "Not found" (quasiquote @@ -364,7 +366,10 @@ posts))) (let ((listing (if (> (len posts) 0) (list (quote ul) items) - (quote (p "No posts yet."))))) + (quote (p "No posts yet.")))) + ;; auth-footer does a durable session read — bind it BEFORE the + ;; quasiquote (a perform during tree-build raises VmSuspended). + (auth-foot (host/auth-footer req))) (dream-html (host/blog--page "Blog" (quasiquote @@ -372,7 +377,7 @@ (unquote listing) (p (a :href "/new" "+ New post")) (p :style "margin-top:2em;font-size:0.9em;opacity:0.8" - (unquote (host/auth-footer req)))))))))))) + (unquote auth-foot))))))))))) (define host/blog-index (fn (req) (host/ok (host/blog-list)))) diff --git a/lib/host/serve.sh b/lib/host/serve.sh index 6f2f9811..1259d18b 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -111,11 +111,18 @@ EPOCH=1 echo "(epoch $EPOCH)" echo "(eval \"(host/blog-load-edges!)\")" EPOCH=$((EPOCH+1)) - # Session signing secret + admin login credentials, then grant the admin - # principal "edit" on "blog" so a logged-in session passes the ACL gate on the - # write routes. Sessions stay IN-MEMORY (default store) — logins reset on - # restart but the durable KV isn't spammed by anonymous/ crawler sessions - # (lazy session creation is a future lib/dream/session.sx improvement). + # Sessions on the DURABLE store, LAZILY: only a logged-in session (one that + # writes a field) persists, so a login survives a restart while anonymous / + # crawler traffic leaves no rows. host/session-init! bumps the per-boot epoch + # that keeps sids unique across restarts. Then the signing secret + admin + # credentials, and grant admin "edit" on "blog" so a logged-in session passes + # the ACL gate on the write routes. + echo "(epoch $EPOCH)" + echo "(eval \"(host/session-use-store! (persist/durable-backend))\")" + EPOCH=$((EPOCH+1)) + echo "(epoch $EPOCH)" + echo "(eval \"(host/session-init!)\")" + EPOCH=$((EPOCH+1)) echo "(epoch $EPOCH)" echo "(eval \"(host/session-set-secret! \\\"$SESSION_SECRET\\\")\")" EPOCH=$((EPOCH+1)) diff --git a/lib/host/session.sx b/lib/host/session.sx index 5004617c..86cc5f69 100644 --- a/lib/host/session.sx +++ b/lib/host/session.sx @@ -20,26 +20,37 @@ ;; ── keys ──────────────────────────────────────────────────────────── (define host/-sess-key (fn (sid) (str "session:" sid))) -(define host/-sess-counter-key "session:-counter") +(define host/-sess-epoch-key "session:-epoch") -;; mint the next sid from a persisted counter (signature guards guessability) +;; sid generation: a per-BOOT epoch (one durable write at startup) + an in-memory +;; counter. The epoch keeps sids unique across restarts WITHOUT a write per +;; request, so anonymous traffic costs no disk. host/session-init! bumps the epoch +;; on boot (serve.sh); without it (e.g. tests) epoch 0 is fine within one process. +(define host/session-epoch 0) +(define host/session-ctr 0) +(define host/session-init! + (fn () + (let ((e (+ 1 (or (persist/backend-kv-get host/session-store host/-sess-epoch-key) 0)))) + (begin + (persist/backend-kv-put host/session-store host/-sess-epoch-key e) + (set! host/session-epoch e) + (set! host/session-ctr 0))))) (define host/-sess-next-sid (fn () - (let ((n (+ 1 (or (persist/backend-kv-get host/session-store host/-sess-counter-key) 0)))) - (begin - (persist/backend-kv-put host/session-store host/-sess-counter-key n) - (str "s" n))))) + (begin + (set! host/session-ctr (+ host/session-ctr 1)) + (str "s" host/session-epoch "-" host/session-ctr)))) ;; ── backend io fn: dispatch session/* ops onto the persist KV ─────── +;; LAZY: session/create mints a sid but writes NO row, so an anonymous request +;; (which never sets a field) leaves no durable trace — the store isn't spammed by +;; crawlers. The row appears on the first session/set (i.e. login), so a logged-in +;; session persists and survives a restart; session/exists is "has a written row". (define host/session-backend (fn (op) (let ((kind (get op :op))) (cond - ((= kind "session/create") - (let ((sid (host/-sess-next-sid))) - (begin - (persist/backend-kv-put host/session-store (host/-sess-key sid) {}) - sid))) + ((= kind "session/create") (host/-sess-next-sid)) ((= kind "session/exists") (persist/backend-kv-has? host/session-store (host/-sess-key (get op :sid)))) ((= kind "session/get") diff --git a/lib/host/tests/session.sx b/lib/host/tests/session.sx index 3040792d..0cda1b49 100644 --- a/lib/host/tests/session.sx +++ b/lib/host/tests/session.sx @@ -126,6 +126,18 @@ (dream-status (host-se-secure host-se-live-cookie))) 401) +;; ── lazy persistence: only a written (logged-in) session leaves a durable row ── +(host-se-test "session/create writes no row (anonymous leaves no durable trace)" + (host/session-backend {:op "session/exists" :sid (host/session-backend {:op "session/create"})}) + false) +(host-se-test "session/set creates the row (a login persists)" + (let ((sid (host/session-backend {:op "session/create"}))) + (begin + (host/session-backend {:op "session/set" :sid sid :key :principal :val "bob"}) + (list (host/session-backend {:op "session/exists" :sid sid}) + (host/session-backend {:op "session/get" :sid sid :key :principal})))) + (list true "bob")) + (define host-se-tests-run! (fn () {:total (+ host-se-pass host-se-fail)