Skip to content

review pass: load-boundary hardening + codegen dedup #64

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
avanelsas merged 1 commit into from
May 26, 2026
Merged

review pass: load-boundary hardening + codegen dedup #64

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 12 additions & 0 deletions public/index.html
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,18 @@
background: var(--x-color-border, rgba(127, 127, 127, 0.35));
}
.toolbar-icon-button span { font-size: 16px; line-height: 1; }
.toolbar-autosave-warn {
display: inline-flex;
align-items: center;
justify-content: center;
width: 22px;
height: 22px;
margin-left: 6px;
color: var(--x-color-warning, #c97a00);
font-size: 16px;
cursor: help;
}
.toolbar-autosave-warn[hidden] { display: none; }
.panel {
border-right: 1px solid var(--x-color-border, rgba(127, 127, 127, 0.2));
padding: 12px;
Expand Down
32 changes: 16 additions & 16 deletions src/bareforge/dnd/drag.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -229,22 +229,22 @@
(let [^js br (.getBoundingClientRect host)
sl (.-scrollLeft host)
st (.-scrollTop host)
^js nodes (.querySelectorAll host "[data-bareforge-id]")
out (volatile! [])]
(dotimes [i (.-length nodes)]
(let [^js el (.item nodes i)
id (.getAttribute el "data-bareforge-id")]
(when (and id (not= id "root"))
(let [^js eb (.getBoundingClientRect el)
left (+ (- (.-left eb) (.-left br)) sl)
top (+ (- (.-top eb) (.-top br)) st)
rect {:left left
:top top
:right (+ left (.-width eb))
:bottom (+ top (.-height eb))}]
(when (rects-overlap? marquee-rect rect)
(vswap! out conj id))))))
@out))
^js nodes (.querySelectorAll host "[data-bareforge-id]")]
(into []
(keep (fn [i]
(let [^js el (.item nodes i)
id (.getAttribute el "data-bareforge-id")]
(when (and id (not= id "root"))
(let [^js eb (.getBoundingClientRect el)
left (+ (- (.-left eb) (.-left br)) sl)
top (+ (- (.-top eb) (.-top br)) st)
rect {:left left
:top top
:right (+ left (.-width eb))
:bottom (+ top (.-height eb))}]
(when (rects-overlap? marquee-rect rect)
id))))))
(range (.-length nodes)))))

(defn- commit-marquee! [^js e]
(let [^js host (canvas-el)
Expand Down
118 changes: 113 additions & 5 deletions src/bareforge/doc/sanitize.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,14 +2,20 @@
"Pure sanitisation helpers for the two doc fields that ship raw
user-supplied strings into the DOM: `:inner-html` (raw SVG/HTML on
`:raw-html-slot?` components like x-icon) and `:attrs` URL values
(`href`, `src`, …).
(`href`, `src`, …). Plus an identifier-shape scanner that guards
the export pipeline against doc fields that the codegen later
interpolates verbatim into emitted JS / CLJS source.

Two layers of protection:
Three layers of protection:

- **Block-list scanners** (`unsafe-findings`): given a doc, return a
vector of `[path reason]` entries naming each suspect site. Used at
the load boundary by `storage/project-file/validate-project` to
refuse a malicious payload outright with an explanatory message.
Covers XSS payloads in `:inner-html` / URL attrs **and** unsafe
identifier shapes in attr keys, binding keys, field / action
names, and trigger action-refs (everything codegen splices into
a JS or CLJS string literal).

- **Best-effort sanitisers** (`sanitize-svg-fragment`,
`sanitize-doc`): strip the obvious payloads — `<script>` /
Expand Down Expand Up @@ -117,6 +123,99 @@
;; with javascript-like schemes.
(str/replace dangerous-url-attr-re ""))))

;; --- identifier safety ---------------------------------------------------

(def ^:private safe-attr-key-re
;; HTML / SVG / ARIA attribute name. Letters or `_` to start; letters,
;; digits, `-`, `_`, `.`, `:` after (covers `xlink:href`, `aria-*`,
;; CSS-variable-shaped attrs). Refuses anything codegen would have to
;; escape — whitespace, quotes, backslash, parens, brackets, `;`, `#`,
;; comment markers, etc.
#"^[A-Za-z_][A-Za-z0-9_\-.:]*$")

(def ^:private safe-identifier-name-re
;; Local-name component of a keyword (field / action / action-ref
;; local) emitted into CLJS or JS source. Tighter than attr keys:
;; no colons (colons inside a local keyword name would re-namespace
;; it at the keyword reader; in JS strings they're a syntax hazard
;; on object literals).
#"^[A-Za-z][A-Za-z0-9_\-.]*$")

(defn- safe-attr-key? [s]
(and (string? s) (boolean (re-matches safe-attr-key-re s))))

(defn- safe-identifier-name? [s]
(and (string? s) (boolean (re-matches safe-identifier-name-re s))))

(defn- keyword-name-safe? [kw]
(and (keyword? kw) (safe-identifier-name? (cljs.core/name kw))))

(defn- action-ref-safe?
"True when a qualified keyword's namespace segments and local name
all parse as safe identifiers. Codegen splices each piece into a
JS string literal (`dispatch([\"<alias>/<name>\"])`); anything
outside `safe-identifier-name-re` can break out of that string."
[kw]
(and (qualified-keyword? kw)
(every? safe-identifier-name? (str/split (namespace kw) #"\."))
(safe-identifier-name? (cljs.core/name kw))))

(defn- node-identifier-findings
"Collect identifier-shape findings for one node. The codegen splices
each of these values into emitted source code; an unsafe character
in any of them produces malformed (or malicious) output."
[path node]
(concat
;; Attribute keys — both static `:attrs` and `:bindings`.
(for [[k _] (:attrs node)
:when (not (safe-attr-key? k))]
{:path (conj path :attrs k)
:reason (str "attr key " (pr-str k)
" contains characters unsafe for codegen")
:preview (pr-str k)})
(for [[k _] (:bindings node)
:when (not (safe-attr-key? k))]
{:path (conj path :bindings k)
:reason (str "binding prop name " (pr-str k)
" contains characters unsafe for codegen")
:preview (pr-str k)})
;; Binding `:field` keywords — emitted as the dispatched setter name.
(for [[_ b] (:bindings node)
:when (and (:field b) (not (keyword-name-safe? (:field b))))]
{:path (conj path :bindings)
:reason (str "binding :field " (pr-str (:field b))
" contains characters unsafe for codegen")
:preview (pr-str (:field b))})
;; Trigger `:action-ref` qualified keywords.
(for [t (:events node)
:when (and (:action-ref t) (not (action-ref-safe? (:action-ref t))))]
{:path (conj path :events)
:reason (str "trigger :action-ref " (pr-str (:action-ref t))
" contains characters unsafe for codegen")
:preview (pr-str (:action-ref t))})
;; Payload entries that reference fields by name.
(for [t (:events node)
pe (:payload t)
:when (and (:field pe) (not (keyword-name-safe? (:field pe))))]
{:path (conj path :events)
:reason (str "trigger payload :field " (pr-str (:field pe))
" contains characters unsafe for codegen")
:preview (pr-str (:field pe))})
;; Field-def names + action names (referenced verbatim by setter
;; / sub / handler emission).
(for [fd (:fields node)
:when (and (:name fd) (not (keyword-name-safe? (:name fd))))]
{:path (conj path :fields)
:reason (str "field-def :name " (pr-str (:name fd))
" contains characters unsafe for codegen")
:preview (pr-str (:name fd))})
(for [a (:actions node)
:when (and (:name a) (not (keyword-name-safe? (:name a))))]
{:path (conj path :actions)
:reason (str "action :name " (pr-str (:name a))
" contains characters unsafe for codegen")
:preview (pr-str (:name a))})))

;; --- doc walker -----------------------------------------------------------

(defn- walk-nodes-with-path
Expand All @@ -137,8 +236,16 @@

(defn unsafe-findings
"Walk `doc` and return a vector of `{:path :reason :preview}` maps,
one per unsafe `:inner-html` or URL-typed attr value. Empty
vector means the doc is clean. The load-boundary check uses
one per unsafe site. Three families:

- `:inner-html` carrying a script / event / javascript-url payload.
- URL-typed attrs (`href`, `src`, …) with a dangerous scheme.
- Identifier-shaped fields the exporter splices into emitted source
(attr keys, binding prop names, binding `:field`, trigger
`:action-ref`, payload `:field`, field-def `:name`, action
`:name`) that contain characters unsafe for codegen.

Empty vector means the doc is clean. The load-boundary check uses
this directly: any non-empty result refuses the load."
[doc]
(vec
Expand All @@ -154,7 +261,8 @@
:when (and (url-attr? k) (string? v) (not (safe-url? v)))]
{:path (conj path :attrs k)
:reason (str "attr " (pr-str k) " carries unsafe URL scheme")
:preview v})))
:preview v})
(node-identifier-findings path node)))
(walk-nodes-with-path doc))))

(defn- sanitize-node-attrs
Expand Down
65 changes: 28 additions & 37 deletions src/bareforge/export/cljs_project.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -176,24 +176,11 @@
(def ^:private collect-trigger-payload-fields em/collect-trigger-payload-fields)
(def ^:private collect-trigger-action-refs em/collect-trigger-action-refs)

(defn- action-ref->alias
"Turn an action-ref qualified keyword like :app.cart.events/add-to-cart
into the require alias string: \"cart.events\". Matches the
dot-notation alias convention used elsewhere in the generator.

The group segment is passed through `actions/name->ns-segment`
so an action-ref that was committed before the
`bareforge.doc.actions/action-ref` canonicalisation fix (e.g.
`:app.Dashboard.events/tick` in an older doc) still emits a
lowercase require — `[app.dashboard.events :as dashboard.events]`
matching the file at `src/app/dashboard/events.cljs`."
[ref]
(let [ns (namespace ref)
first-dot (.indexOf ns ".")
last-dot (.lastIndexOf ns ".")
group-seg (subs ns (inc first-dot) last-dot)
suffix (subs ns last-dot)] ;; ".events" or ".subs"
(str (actions/name->ns-segment group-seg) suffix)))
(def ^:private action-ref->alias
"Shared action-ref → require-alias helper. Lives in the export
model so the cljs and vanilla-js plugins agree byte-for-byte on
the canonical form (see `em/action-ref-canonical-ns` for why)."
em/action-ref-alias)

;; --- :write / :read-write binding → DOM event handler ---------------------
;;
Expand Down Expand Up @@ -390,32 +377,36 @@
template sub-group emits its iteration form; later encounters
return nil so a parent with N seed-backed clones still emits
one iteration. Singleton sub-groups return the plain
`(<ns>.views/<ns>)` call as a `:raw` value."
`(<ns>.views/<ns>)` call as a `:raw` value.

Template-source resolution routes through
`em/resolve-template-source` — single source of truth shared with
the vanilla-js plugin, so both targets pick the same source for
every instance."
[ctx child gname tpl? rendered-tpls]
(let [{:keys [doc all-groups field-owner-ns-map]} ctx]
(cond
(and tpl? (contains? rendered-tpls gname))
[nil rendered-tpls]

tpl?
(let [;; Fall back to the (single) collection field that
;; points at this template when the instance has no
;; explicit :source-field / :source-sub set. Lets the
;; user declare a collection + name the template
;; without also having to manually wire the
;; 'Rendered from' source in the inspector.
fallback (when (and (nil? (:source-sub child))
(nil? (:source-field child)))
(stateful-host-for-template
doc all-groups gname))
src-field (or (:source-field child)
(when fallback (keyword (:field-name fallback))))
field-ns (or (get field-owner-ns-map (:source-field child))
(when fallback (:ns-name fallback)))]
[(collection-iteration-form gname
(:source-sub child)
src-field
field-ns)
(let [src (em/resolve-template-source
(assoc child :ns-name gname)
doc all-groups field-owner-ns-map)
;; Map the resolver's :kind back onto the three values
;; `collection-iteration-form` already accepts. :source-sub
;; carries the explicit sub keyword; :source-field carries
;; an explicit field + owner; :auto-host is the implicit
;; fallback where the field-name is a string we re-key.
[source-sub source-field field-owner-ns]
(case (and src (:kind src))
:source-sub [(:sub src) nil nil]
:source-field [nil (:field src) (:owner-ns src)]
:auto-host [nil
(keyword (:field-name src))
(:owner-ns src)]
[nil nil nil])]
[(collection-iteration-form gname source-sub source-field field-owner-ns)
(conj rendered-tpls gname)])

:else
Expand Down
33 changes: 33 additions & 0 deletions src/bareforge/export/model.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,39 @@
ns-name)]
[pick (conj seen pick)]))

;; --- action-ref canonicalisation -----------------------------------------

(defn action-ref-canonical-ns
"Canonicalise an action-ref qualified keyword's namespace so the
group segment matches the rest of the generator. An action-ref
committed before the canonicalisation fix can carry the raw
user-typed name (`:app.Dashboard.events/tick`); every other
generator path (file paths, ns forms, db aliases) uses
`name->ns-segment` to lowercase / dash-collapse it. Without this
pass, dispatch fires on a key the registry doesn't know.

Single source of truth for both plugins (`cljs_project` and
`vanilla_js`). Returns the full canonical namespace string —
e.g. `\"app.dashboard.events\"`."
[ref]
(let [ns (namespace ref)
first-dot (.indexOf ns ".")
last-dot (.lastIndexOf ns ".")
app-pref (subs ns 0 (inc first-dot))
grp-seg (subs ns (inc first-dot) last-dot)
suffix (subs ns last-dot)]
(str app-pref (name->ns-segment grp-seg) suffix)))

(defn action-ref-alias
"The require-alias string for an action-ref qualified keyword:
`action-ref-canonical-ns` with the leading `app.` prefix stripped.
Used by the CLJS plugin as the `[<canonical> :as <alias>]` form.

`:app.Dashboard.events/tick` → `\"dashboard.events\"`."
[ref]
(let [ns (action-ref-canonical-ns ref)]
(subs ns (inc (.indexOf ns ".")))))

;; --- group detection -----------------------------------------------------

(defn- named-node?
Expand Down
15 changes: 3 additions & 12 deletions src/bareforge/export/vanilla_js/codegen.cljs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -562,18 +562,9 @@
[trigger {:keys [template-record-sym template-field-syms]
:as ctx}]
(let [aref (:action-ref trigger)
;; Canonicalise the action-ref's group segment: an older doc
;; can carry `:app.Dashboard.events/tick` (raw user-typed
;; name) while the registry id was built from the lowercased
;; `:ns-name` — without this, `dispatch` fires on a key the
;; registry doesn't know.
alias (let [ns (namespace aref)
first-dot (.indexOf ns ".")
last-dot (.lastIndexOf ns ".")
app-pref (subs ns 0 (inc first-dot))
grp (subs ns (inc first-dot) last-dot)
suffix (subs ns last-dot)]
(str app-pref (actions/name->ns-segment grp) suffix))
;; Shared with the CLJS plugin via em/action-ref-canonical-ns,
;; so the two emitters dispatch on identical alias strings.
alias (em/action-ref-canonical-ns aref)
ename (cljs.core/name aref)
payload (:payload trigger)
args (cond
Expand Down
Loading
Loading