Commit0f0213caRecorded17 Jul 2026Repositorylantern

lantern-system: add fs.home, and return listings in canonical order

Message

fs.home #{} -> #{ path: } lets a client expand "~" without hardcoding a host convention. The home that matters belongs to the machine being BROWSED, which for a remote node is not the machine typing, so it has to come from the capability surface. Grant-checked inside sigil-system (as a read of that directory), so a scoped embedding cannot use it to discover where the owner's home lives; the desktop posture is allow-all, so in practice it just answers.

Canonical listing order. sigil-system now sorts fs-read-dir (dirs before files, hidden before visible within each, alphabetical case-insensitively) — but this command deliberately does NOT go through fs-read-dir, because that stats every name and overflows at /gnu/store scale. It lists names, caps, then stats the survivors. So sorting in sigil-system alone would never have reached a user: this path is the only one Slate's folder view and find-file see.

It now calls sigil-system's fs-sort-entries on the entries it kept, so the order is identical to fs-read-dir's without re-deriving the rule here and drifting from it. Sorting the KEPT entries rather than all names is the point: sorting first would need a stat per name, which is the overflow this path exists to avoid. An ordinary directory is fully ordered; a capped one is an ordered view of the same arbitrary slice it already showed. Browsing past the cap remains dired virtualization's problem.

Also fixes fs.write-file's doc comment, which advertised create-dirs?: while the code read create-dirs:. A caller trusted the comment, sent a keyword nothing reads, and got no mkdir and no error — the flag is optional, so a wrong name is indistinguishable from an absent one. Pins the contract with tests that assert the file exists ON DISK (the caller-side test that only proved what was SENT passed happily while the feature was broken), including the one-missing- level limit the grant model imposes: canonical-target needs a real anchor, so it realpaths the parent and re-appends the basename. Two missing levels leave nothing to realpath and are denied — the safe default, since resolving further would re-append an unresolved tail whose ".." could escape the grant root.

dev-redirects.sgl points sigil-system at the local checkout: fs.home and fs-sort-entries are unreleased, and lantern-system pins ^0.1 from git, so the two cannot be developed together without it. It stops mattering once sigil-system 0.1.1 is tagged and lantern-system relocks.

Changed
 dev-redirects.sgl                           | 16 ++++++++++++++++
 lantern-system/src/lantern-system/fs.sgl    | 45 +++++++++++++++++++++++++++++++++++++--------
 lantern-system/test/test-lantern-system.sgl | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 135 insertions(+), 8 deletions(-)
Diff
dev-redirects.sgladded
@@ -0,0 +1,16 @@
+1
;; Development redirects — point dependencies at local sibling checkouts during
+2
;; iteration. Pass `--redirects ./dev-redirects.sgl` to sigil commands.
+3
;;
+4
;; lantern-system pins `sigil-system ^0.1` from git, so it resolves the RELEASED
+5
;; tag. This redirect is what lets the two be developed together: fs.home and
+6
;; fs-sort-entries live in an unreleased sigil-system, and without it lantern-system
+7
;; cannot see them (the build fails on an unbound fs-home rather than on anything
+8
;; meaningful).
+9
;;
+10
;; Not a substitute for the release: once sigil-system 0.1.1 is tagged and pushed,
+11
;; lantern-system relocks onto it and this stops mattering for a normal build.
+12
(redirects
+13
repos: (list
+14
(for-repo
+15
url: "codeberg:sigil/sigil-system"
+16
use: (from-path dir: "../sigil-system"))))
lantern-system/src/lantern-system/fs.sglmodified
@@ -77,13 +77,27 @@
77
(reverse acc)
78
(loop (cdr ns) (+ i 1) (cons (car ns) acc))))
79
names))
−80
(entries (let loop ((ns kept) (acc '()))
−81
(if (null? ns)
−82
(reverse acc)
−83
(let ((st (guard (e (#t #f))
−84
(fs-stat g (path-join path (car ns))))))
−85
(loop (cdr ns)
−86
(if st (cons (stat->json st) acc) acc)))))))
+80
;; Stat the survivors, then put them in sigil-system's CANONICAL
+81
;; order (dirs before files, hidden before visible, alphabetical
+82
;; case-insensitively within each tier) by calling its sort
+83
;; rather than re-deriving it here — this path cannot use
+84
;; fs-read-dir (which stats every name), but it must not drift
+85
;; from fs-read-dir's ORDER.
+86
;;
+87
;; Sorting the KEPT entries, not all names: sorting first would
+88
;; need a stat per name, which is the overflow this path exists
+89
;; to avoid. So an ordinary directory (under the cap) is fully
+90
;; ordered, while a capped one is an ordered view of an
+91
;; arbitrary slice — the same slice it already showed, now at
+92
;; least sorted. Browsing past the cap is dired virtualization's
+93
;; problem, not this one's.
+94
(stats (let loop ((ns kept) (acc '()))
+95
(if (null? ns)
+96
(reverse acc)
+97
(let ((st (guard (e (#t #f))
+98
(fs-stat g (path-join path (car ns))))))
+99
(loop (cdr ns) (if st (cons st acc) acc))))))
+100
(entries (map stat->json (fs-sort-entries stats))))
101
(dict entries: entries total: total)))))
102
103
;; fs.stat #{ path: } -> a stat dict.
@@ -91,6 +105,16 @@
105
(lambda (args ctx)
106
(stat->json (fs-stat g (req args path:)))))
107
+108
;; fs.home #{} -> #{ path: <home dir> }.
+109
;; So a client can expand "~" without hardcoding a host convention: the
+110
;; home that matters belongs to the machine being BROWSED, which for a
+111
;; remote node is not the machine typing. Grant-checked (as a read of that
+112
;; directory) inside sigil-system, so a scoped embedding cannot use this to
+113
;; discover where the owner's home is.
+114
(lantern-command "fs.home"
+115
(lambda (args ctx)
+116
(dict path: (fs-home g))))
+117
118
;; fs.read-file #{ path: encoding?: } — delivered on the bridge's BULK
119
;; lane: the handler returns #{ bulk-b64: <base64 of the raw bytes>
120
;; meta: #{ encoding: } }, so the file body never passes through
@@ -107,7 +131,12 @@
131
(dict bulk-b64: (base64-encode (fs-read-file-bytes g path))
132
meta: (dict encoding: enc)))))
133
−110
;; fs.write-file #{ path: content: encoding?: create-dirs?: } -> stat.
+134
;; fs.write-file #{ path: content: encoding: create-dirs: } -> stat.
+135
;; (This comment used to advertise `create-dirs?:` while the code below
+136
;; read `create-dirs:`. A caller trusted the comment, sent a keyword
+137
;; nothing reads, and got no mkdir and no error — the flag is optional, so
+138
;; a wrong name is indistinguishable from an absent one. Keep the arg names
+139
;; here identical to the dict-refs below.)
140
;; Atomic (tmp + rename) via sigil-system. base64 content decodes to a
141
;; bytevector (byte-exact — binary-safe writes), plain content is written
142
;; as UTF-8 text; both paths are accepted by fs-write-file. Large saves
lantern-system/test/test-lantern-system.sglmodified
@@ -22,6 +22,7 @@
22
(sigil io)
23
(sigil fs)
24
(sigil path)
+25
(sigil process) ; getenv (fs.home tests)
26
(sigil async)
27
(lantern-system base64)
28
(sigil system grant)
@@ -111,6 +112,25 @@
112
(else (loop (cdr es)))))))
113
(assert-equal (dict-ref sub type: #f) "directory")))))
114
+115
(test "fs.read-dir returns entries in sigil-system's canonical order"
+116
;; This is the ONLY path Slate's folder view and find-file actually see, and it
+117
;; does NOT go through sigil-system's fs-read-dir (which stats every name and
+118
;; overflows at /gnu/store scale) — so sorting there alone would never reach a
+119
;; user. It calls fs-sort-entries on the entries it kept instead, which is what
+120
;; keeps this order identical to fs-read-dir's without re-deriving the rule.
+121
(let* ((fx (fs-fixture))
+122
(dir (dict-ref fx dir:))
+123
(g (dict-ref fx g:))
+124
(rd (handler-for (dict-ref fx cmds:) "fs.read-dir")))
+125
;; the fixture holds a.txt + sub/; add the other two tiers, out of order
+126
(write-file-string (path-join dir "README.md") "r")
+127
(write-file-string (path-join dir ".gitignore") "i")
+128
(ensure-directory (path-join dir ".git"))
+129
(let* ((r (rd (dict path: dir) #f))
+130
(names (map (lambda (e) (dict-ref e name: #f)) (dict-ref r entries: '()))))
+131
;; hidden dirs, dirs, hidden files, files — alphabetical within each tier
+132
(assert-equal names (list ".git" "sub" ".gitignore" "a.txt" "README.md")))))
+133
134
(test "fs.read-dir honors limit: and always reports the full total"
135
(let* ((fx (fs-fixture))
136
(rd (handler-for (dict-ref fx cmds:) "fs.read-dir")))
@@ -137,6 +157,25 @@
157
(assert-equal (dict-ref (dict-ref r meta: #{}) encoding: #f) "base64")
158
(assert-equal (utf8->string (base64-decode (dict-ref r bulk-b64: #f))) "hello A"))))
159
+160
(test "fs.home reports the home directory"
+161
;; Lets a client expand "~" without hardcoding a host convention — for a remote
+162
;; node the home that matters is the NODE's, not the one typing. The fixture's
+163
;; grants are scoped to a temp dir, so this asserts the scoped DENIAL; the
+164
;; allowed path is covered in sigil-system, which owns the grant check.
+165
(let* ((fx (fs-fixture))
+166
(home-cmd (handler-for (dict-ref fx cmds:) "fs.home")))
+167
(assert-true (guard (e (#t #t)) (home-cmd (dict) #f) #f))))
+168
+169
(test "fs.home reports the home directory when granted"
+170
(let* ((dir (make-temp-directory))
+171
(g (make-grants))
+172
(home (getenv "HOME")))
+173
(grant-add! g (string-append "fs:ro:" home))
+174
(let* ((cmds (lantern-system-commands g))
+175
(home-cmd (handler-for cmds "fs.home")))
+176
(assert-equal (dict-ref (home-cmd (dict) #f) path: #f)
+177
(or (realpath home) home)))))
+178
179
(test "fs.write-file writes atomically and returns a stat"
180
(let* ((fx (fs-fixture))
181
(wf (handler-for (dict-ref fx cmds:) "fs.write-file"))
@@ -159,6 +198,49 @@
198
(wf (dict path: path bulk: "bulk body wins") #f)
199
(assert-equal (read-file-string path) "bulk body wins")))
200
+201
(test "fs.write-file create-dirs: creates a missing parent directory"
+202
;; The ONLY test that can prove this contract: it asserts the file exists ON
+203
;; DISK, i.e. that the host ACTED. A caller-side test can only prove what was
+204
;; sent — and one did exactly that while the feature was broken, because the
+205
;; doc comment above fs.write-file advertised `create-dirs?:` and the code read
+206
;; `create-dirs:`. The flag is optional, so a misspelled name is
+207
;; indistinguishable from an absent one: no mkdir, no error.
+208
;;
+209
;; Slate's find-file needs this — you CREATE a file by typing a path that does
+210
;; not exist, and that path can name a directory that does not exist either.
+211
(let* ((fx (fs-fixture))
+212
(wf (handler-for (dict-ref fx cmds:) "fs.write-file"))
+213
(path (path-join (dict-ref fx dir:) "fresh/new.txt")))
+214
(wf (dict path: path content: "made the parent" create-dirs: #t) #f)
+215
(assert-equal (read-file-string path) "made the parent")))
+216
+217
(test "fs.write-file create-dirs: reaches exactly ONE missing level, by design"
+218
;; Pins a real limit of the GRANT model rather than of this command. To decide
+219
;; whether a path is inside a grant, sigil-system's canonical-target needs a real
+220
;; anchor: it realpaths the path, or (for a write) realpaths the PARENT and
+221
;; re-appends the basename. Two missing levels leave nothing to realpath, so the
+222
;; write is denied before mkdir is ever reached.
+223
;;
+224
;; That is the SAFE default, not an oversight: resolving further up would mean
+225
;; re-appending an unresolved tail, and a ".." in that tail could escape the
+226
;; grant root — precisely what realpath'ing the parent prevents today. Lifting it
+227
;; needs normalization of the missing tail, i.e. a deliberate change to security
+228
;; code, not a drive-by.
+229
(let* ((fx (fs-fixture))
+230
(wf (handler-for (dict-ref fx cmds:) "fs.write-file"))
+231
(path (path-join (dict-ref fx dir:) "deep/deeper/new.txt")))
+232
(assert-true (guard (e (#t #t))
+233
(wf (dict path: path content: "x" create-dirs: #t) #f)
+234
#f))))
+235
+236
(test "fs.write-file WITHOUT create-dirs: does not invent directories"
+237
;; The other half of the contract: mkdir is opt-in, so a typo'd path fails loudly
+238
;; instead of silently scattering directories across the filesystem.
+239
(let* ((fx (fs-fixture))
+240
(wf (handler-for (dict-ref fx cmds:) "fs.write-file"))
+241
(path (path-join (dict-ref fx dir:) "absent/new.txt")))
+242
(assert-true (guard (e (#t #t)) (wf (dict path: path content: "x") #f) #f))))
+243
244
(test "fs.mkdir / fs.rename / fs.delete take effect on disk"
245
(let* ((fx (fs-fixture))
246
(dir (dict-ref fx dir:))