diff --git a/lib/host/auth.sx b/lib/host/auth.sx index 95fe9afc..e008520e 100644 --- a/lib/host/auth.sx +++ b/lib/host/auth.sx @@ -29,37 +29,49 @@ (= user host/admin-user) (= pass host/admin-password)))) -;; ── GET /login — minimal SX login form ────────────────────────────── +;; A return-to target is only honoured if it's a same-site absolute PATH — guards +;; against an open-redirect (//evil.com, http://…) smuggled through ?next=. +(define host/-safe-next + (fn (n) + (if (and n (not (= n "")) (starts-with? n "/") (not (starts-with? n "//"))) + n "/"))) + +;; The login form, parameterised by where to return after success. +(define host/-login-form + (fn (next-path message) + (host/-auth-page "Log in" + (quasiquote + (div + (h1 "Log in") + (unquote (if message (quasiquote (p :style "color:#b00" (unquote message))) "")) + (form :method "post" :action "/login" + (input :type "hidden" :name "next" :value (unquote next-path)) + (p (input :name "username" :placeholder "username")) + (p (input :name "password" :type "password" :placeholder "password")) + (p (button :type "submit" "Log in")))))))) + +;; ── GET /login — login form, honouring ?next= (where to go after login) ───── (define host/login-page (fn (req) (dream-html - (host/-auth-page "Log in" - (quasiquote - (div - (h1 "Log in") - (form :method "post" :action "/login" - (p (input :name "username" :placeholder "username")) - (p (input :name "password" :type "password" :placeholder "password")) - (p (button :type "submit" "Log in"))))))))) + (host/-login-form (host/-safe-next (dream-query-param req "next")) nil)))) -;; ── POST /login — verify, write session principal, redirect home ──── +;; ── POST /login — verify, write session principal, redirect to ?next ──────── ;; The session middleware (host/sessions) has already created/loaded the session ;; and will set the cookie on this response, so writing :principal here lands on -;; the right sid and the browser keeps the cookie. +;; the right sid and the browser keeps the cookie. On failure the form re-renders +;; with the same return target so the user lands where they were headed. (define host/login-submit (fn (req) (let ((user (dream-form-field req "username")) - (pass (dream-form-field req "password"))) + (pass (dream-form-field req "password")) + (next-path (host/-safe-next (dream-form-field req "next")))) (if (host/-verify-cred user pass) (begin (host/login! req user) - (dream-redirect "/")) + (dream-redirect next-path)) (dream-html-status 401 - (host/-auth-page "Log in" - (quasiquote - (div (h1 "Log in") - (p "Invalid credentials.") - (p (a :href "/login" "Try again.")))))))))) + (host/-login-form next-path "Invalid credentials — try again.")))))) ;; ── POST /logout — clear the session, redirect home ───────────────── (define host/logout-submit @@ -75,22 +87,40 @@ (dream-post "/login" host/login-submit) (dream-post "/logout" host/logout-submit))) -;; ── auth middleware: session principal OR bearer token ────────────── +;; The authenticated principal for a request, or nil: a logged-in session takes +;; precedence, else a Bearer token resolved by `resolve` (the API fallback). +(define host/-principal-of + (fn (req resolve) + (let ((sp (host/current-principal req))) + (if (and sp (not (= sp ""))) + sp + (let ((tok (dream-bearer-token req))) + (if tok (resolve tok) nil)))))) + +;; ── auth middleware (API shape): session principal OR bearer token ── ;; Place AFTER the session middleware (so host/current-principal can read the -;; session) and BEFORE host/require-permission. resolve : token -> principal | nil -;; is the bearer fallback for API clients; a logged-in browser needs no token. +;; session) and BEFORE host/require-permission. On failure -> JSON 401 with a +;; Bearer challenge. For API/JSON routes; browser pages want host/require-login. (define host/require-user (fn (resolve) (fn (next) (fn (req) - (let ((sp (host/current-principal req))) - (let ((principal - (if (and sp (not (= sp ""))) - sp - (let ((tok (dream-bearer-token req))) - (if tok (resolve tok) nil))))) - (if (or (nil? principal) (= principal "")) - (dream-add-header - (host/error 401 "unauthorized") - "www-authenticate" "Bearer") - (next (assoc req :dream-principal principal))))))))) + (let ((principal (host/-principal-of req resolve))) + (if (or (nil? principal) (= principal "")) + (dream-add-header + (host/error 401 "unauthorized") + "www-authenticate" "Bearer") + (next (assoc req :dream-principal principal)))))))) + +;; ── auth middleware (browser shape): same check, but on failure REDIRECT to +;; the login page with a return-to, instead of a raw JSON 401. Use this for HTML +;; routes (an edit form, the create form) so an unauthenticated click lands on a +;; usable login page and returns to where it was headed after logging in. ── +(define host/require-login + (fn (resolve) + (fn (next) + (fn (req) + (let ((principal (host/-principal-of req resolve))) + (if (or (nil? principal) (= principal "")) + (dream-redirect (str "/login?next=" (host/-safe-next (dream-path req)))) + (next (assoc req :dream-principal principal)))))))) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 4a62fc46..bbbf7f17 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -346,12 +346,24 @@ (host/require-user resolve) (host/require-permission "edit" (fn (req) "blog"))) h))) +;; Browser variant: identical ACL gate, but an unauthenticated request REDIRECTS +;; to the login page (host/require-login) rather than returning a raw JSON 401 — +;; the form/edit pages are HTML, so a logged-out click should land on /login and +;; return here afterwards. +(define host/blog--protect-html + (fn (resolve h) + (host/pipeline + (list + host/wrap-errors + (host/require-login resolve) + (host/require-permission "edit" (fn (req) "blog"))) + h))) (define host/blog-write-routes (fn (resolve) (list - (dream-post "/new" (host/blog--protect resolve host/blog-form-submit)) - (dream-get "/:slug/edit" (host/blog--protect resolve host/blog-edit-form)) - (dream-post "/:slug/edit" (host/blog--protect resolve host/blog-edit-submit)) + (dream-post "/new" (host/blog--protect-html resolve host/blog-form-submit)) + (dream-get "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-form)) + (dream-post "/:slug/edit" (host/blog--protect-html resolve host/blog-edit-submit)) (dream-post "/posts" (host/blog--protect resolve host/blog-create)) (dream-put "/posts/:slug" (host/blog--protect resolve host/blog-update-handler)) (dream-delete "/posts/:slug" (host/blog--protect resolve host/blog-delete-handler))))) diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 93819b0e..f4d5a604 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -70,10 +70,14 @@ (host/blog-use-store! (persist/open)) ;; -- editor form ingest (form-urlencoded, the editor's submit shape) -- -(host-bl-test "form ingest no auth -> 401" +(host-bl-test "form ingest no auth -> redirect to login" (dream-status (host-bl-wapp (host-bl-send "POST" "/new" nil "application/x-www-form-urlencoded" "title=X"))) - 401) + 303) +(host-bl-test "form ingest no auth Location is /login" + (contains? (dream-resp-header (host-bl-wapp (host-bl-send "POST" "/new" nil + "application/x-www-form-urlencoded" "title=X")) "location") "/login") + true) (host-bl-test "form ingest authed -> 303 redirect" (dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good" "application/x-www-form-urlencoded" @@ -164,17 +168,22 @@ (dream-status (host-bl-wapp (host-bl-req "/my-first-post/"))) 200) ;; -- edit source (guarded GET form + guarded POST save) -- -(host-bl-test "edit form no auth -> 401" - (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" ""))) 401) +(host-bl-test "edit form no auth -> redirect to login" + (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" ""))) 303) +(host-bl-test "edit form no auth Location carries next=/…/edit" + (contains? + (dream-resp-header (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" "")) "location") + "/login?next=/my-first-post/edit") + true) (host-bl-test "edit form authed -> 200" (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" ""))) 200) (host-bl-test "edit form shows current source" (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" ""))) "(article") true) -(host-bl-test "edit submit no auth -> 401" +(host-bl-test "edit submit no auth -> redirect to login" (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" nil - "application/x-www-form-urlencoded" "sx_content=(p+%22x%22)"))) 401) + "application/x-www-form-urlencoded" "sx_content=(p+%22x%22)"))) 303) (host-bl-test "edit submit authed -> 303" (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good" "application/x-www-form-urlencoded" diff --git a/lib/host/tests/session.sx b/lib/host/tests/session.sx index 7b867af3..3040792d 100644 --- a/lib/host/tests/session.sx +++ b/lib/host/tests/session.sx @@ -69,6 +69,23 @@ (host-se-test "login bad creds -> 401" (dream-status (host-se-login "admin" "wrong")) 401) +;; ── return-to (?next=) after login ────────────────────────────────── +(host-se-test "login page carries ?next in a hidden field" + (contains? + (dream-resp-body (host-se-app (dream-request "GET" "/login?next=/secure" {} ""))) + "value=\"/secure\"") + true) +(host-se-test "login redirects to next on success" + (dream-resp-header + (host-se-app (dream-request "POST" "/login" {} "username=admin&password=secret&next=/secure")) + "location") + "/secure") +(host-se-test "login rejects open-redirect next (//evil) -> /" + (dream-resp-header + (host-se-app (dream-request "POST" "/login" {} "username=admin&password=secret&next=//evil.com")) + "location") + "/") + ;; ── session-authed write ──────────────────────────────────────────── (host-se-test "logged-in session passes the guarded write -> 201" (dream-status (host-se-secure (host-se-cookie-of (host-se-login "admin" "secret"))))