host: reject malformed sx_content at write time (blog 33/33, 199 total)
Complete the malformed-post defence: instead of only degrading on read, refuse to store a post whose body won't parse, so bad content never enters the durable store in the first place. - host/blog-content-ok?: empty body is allowed, otherwise it must parse (parse-safe non-nil). - POST /new (form): missing title OR unparseable body -> 400 HTML page. - POST /posts (JSON): unparseable sx_content -> 400 "invalid sx_content". - PUT /posts/:slug (JSON): unparseable sx_content -> 400, existing post left intact. - 6 new blog tests: each write path rejects "<h1 broken)" with 400 and does not store / does not mutate. Verified live: malformed publish -> 400 + slug 404 (not stored); valid publish unaffected. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -159,22 +159,42 @@
|
||||
(button :type "submit" "Publish")))
|
||||
(p (a :href "/" "all posts"))))))))
|
||||
|
||||
;; ── write-time validation ───────────────────────────────────────────
|
||||
;; sx_content must be storable as renderable SX: empty is allowed (an empty post),
|
||||
;; otherwise it must parse. parse-safe returns nil on malformed input (the kernel
|
||||
;; parser raises a native Parse_error an SX guard can't catch), so this rejects a
|
||||
;; bad body at write time instead of letting it 500 on read. Mirrors the read-path
|
||||
;; guard in host/blog-render — bad content never enters the durable store.
|
||||
(define host/blog-content-ok?
|
||||
(fn (sx)
|
||||
(or (nil? sx) (= sx "") (not (nil? (parse-safe sx))))))
|
||||
|
||||
;; ── write handlers ──────────────────────────────────────────────────
|
||||
;; POST /new — form-urlencoded ingest (the editor's submit shape: title,
|
||||
;; sx_content, status, custom_excerpt, csrf_token). Slug derived from the title.
|
||||
;; Redirects to the new post on success.
|
||||
;; Redirects to the new post on success; rejects a missing title or unparseable
|
||||
;; body with a 400 HTML page (this path serves a browser form).
|
||||
(define host/blog-form-submit
|
||||
(fn (req)
|
||||
(let ((title (dream-form-field req "title"))
|
||||
(sx-content (dream-form-field req "sx_content"))
|
||||
(status (or (dream-form-field req "status") "published")))
|
||||
(if (and title (not (= title "")))
|
||||
(let ((slug (host/blog-slugify title)))
|
||||
(begin
|
||||
(host/blog-put! slug title (or sx-content "") status)
|
||||
(dream-redirect (str "/" slug "/"))))
|
||||
(dream-html-status 400
|
||||
(host/blog--page "Error" "<p>Title is required. <a href=\"/new\">back</a></p>"))))))
|
||||
(cond
|
||||
((or (nil? title) (= title ""))
|
||||
(dream-html-status 400
|
||||
(host/blog--page "Error"
|
||||
(quasiquote (div (h1 "Error") (p "Title is required.")
|
||||
(p (a :href "/new" "Back")))))))
|
||||
((not (host/blog-content-ok? sx-content))
|
||||
(dream-html-status 400
|
||||
(host/blog--page "Error"
|
||||
(quasiquote (div (h1 "Error") (p "Post body is not valid SX markup.")
|
||||
(p (a :href "/new" "Back")))))))
|
||||
(else
|
||||
(let ((slug (host/blog-slugify title)))
|
||||
(begin
|
||||
(host/blog-put! slug title (or sx-content "") status)
|
||||
(dream-redirect (str "/" slug "/")))))))))
|
||||
|
||||
;; POST /posts — JSON create {slug?,title,sx_content,status}. 409 if slug exists.
|
||||
(define host/blog-create
|
||||
@@ -182,15 +202,18 @@
|
||||
(let ((p (dream-json-body req)))
|
||||
(if (= (type-of p) "dict")
|
||||
(let ((title (get p :title)))
|
||||
(if (and title (not (= title "")))
|
||||
(let ((slug (or (get p :slug) (host/blog-slugify title))))
|
||||
(if (host/blog-exists? slug)
|
||||
(host/error 409 "post already exists")
|
||||
(begin
|
||||
(host/blog-put! slug title (or (get p :sx_content) "")
|
||||
(or (get p :status) "published"))
|
||||
(host/ok-status 201 {:slug slug :title title}))))
|
||||
(host/error 400 "title required")))
|
||||
(cond
|
||||
((or (nil? title) (= title "")) (host/error 400 "title required"))
|
||||
((not (host/blog-content-ok? (get p :sx_content)))
|
||||
(host/error 400 "invalid sx_content"))
|
||||
(else
|
||||
(let ((slug (or (get p :slug) (host/blog-slugify title))))
|
||||
(if (host/blog-exists? slug)
|
||||
(host/error 409 "post already exists")
|
||||
(begin
|
||||
(host/blog-put! slug title (or (get p :sx_content) "")
|
||||
(or (get p :status) "published"))
|
||||
(host/ok-status 201 {:slug slug :title title})))))))
|
||||
(host/error 400 "invalid payload")))))
|
||||
|
||||
;; PUT /posts/<slug> — JSON update {title?,sx_content?,status?}. 404 if absent.
|
||||
@@ -199,14 +222,17 @@
|
||||
(let ((slug (dream-param req "slug")) (p (dream-json-body req)))
|
||||
(if (= (type-of p) "dict")
|
||||
(let ((r (host/blog-get slug)))
|
||||
(if r
|
||||
(begin
|
||||
(host/blog-put! slug
|
||||
(or (get p :title) (get r :title))
|
||||
(or (get p :sx_content) (get r :sx-content))
|
||||
(or (get p :status) (get r :status)))
|
||||
(host/ok {:slug slug :updated true}))
|
||||
(host/error 404 "no such post")))
|
||||
(cond
|
||||
((nil? r) (host/error 404 "no such post"))
|
||||
((not (host/blog-content-ok? (get p :sx_content)))
|
||||
(host/error 400 "invalid sx_content"))
|
||||
(else
|
||||
(begin
|
||||
(host/blog-put! slug
|
||||
(or (get p :title) (get r :title))
|
||||
(or (get p :sx_content) (get r :sx-content))
|
||||
(or (get p :status) (get r :status)))
|
||||
(host/ok {:slug slug :updated true})))))
|
||||
(host/error 400 "invalid payload")))))
|
||||
|
||||
;; DELETE /posts/<slug>
|
||||
|
||||
@@ -124,6 +124,31 @@
|
||||
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" "" "")))
|
||||
404)
|
||||
|
||||
;; -- write-time validation: malformed sx_content rejected, never stored --
|
||||
;; "%3Ch1+broken%29" decodes to "<h1 broken)" — a typo'd paren the parser rejects.
|
||||
(host-bl-test "form ingest malformed sx_content -> 400"
|
||||
(dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
|
||||
"application/x-www-form-urlencoded"
|
||||
"title=Bad+Form&sx_content=%3Ch1+broken%29&status=published")))
|
||||
400)
|
||||
(host-bl-test "rejected form post was not stored"
|
||||
(dream-status (host-bl-wapp (host-bl-req "/bad-form/")))
|
||||
404)
|
||||
(host-bl-test "json create malformed sx_content -> 400"
|
||||
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
|
||||
"{\"title\":\"Bad Json\",\"sx_content\":\"<h1 broken)\"}")))
|
||||
400)
|
||||
(host-bl-test "rejected json post was not stored"
|
||||
(dream-status (host-bl-wapp (host-bl-req "/bad-json/")))
|
||||
404)
|
||||
(host-bl-test "json update malformed sx_content -> 400"
|
||||
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/my-first-post" "Bearer good"
|
||||
"application/json" "{\"sx_content\":\"<h1 broken)\"}")))
|
||||
400)
|
||||
(host-bl-test "rejected update left content intact"
|
||||
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
|
||||
true)
|
||||
|
||||
;; -- experimental unguarded create-only route (POST /new, no auth) --
|
||||
(define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
|
||||
(host/blog-use-store! (persist/open))
|
||||
|
||||
Reference in New Issue
Block a user