lantern: handle-scoped lantern://local/<handle> fs-serving route

Message

Add a secure filesystem-serving route to the lantern:// scheme so a container app (Slate) can serve a real local file's bytes to the webview as a streamed <img src="lantern://local/<handle>"> load instead of a base64 data: URI (33% bloat + a giant DOM string).

Security boundary (handle-scoped): the resolver serves ONLY files explicitly registered via the grant-checked fs.serve-file command, each yielding an opaque handle; every unregistered handle 404s. The scheme can never become an arbitrary full-disk read. fs.serve-file grant-checks the path (fs-stat) before registering, so a scoped embedding can only serve files it may already read -- the route adds no authority beyond the existing fs.read-file.

- (lantern serve): make-servable-registry + servable-register!/ unregister!/lookup (opaque per-run handles), make-fs-resolver (handle -> bytes+mime, exact-match lookup, no path join), parse-lantern-uri + make-scheme-resolver (host-routed: app -> assets, local -> fs route). Harden normalize-request-path to strip ALL leading slashes -- a single strip left an absolute remainder that path-join resolved off the asset root (arbitrary read on the app origin); now tested. - (lantern backend gtk): hand the resolver the full geturi (host intact); getpath strips the host, collapsing local onto app. Probed on WebKitGTK. - (lantern app): lantern-plugin gains routes:; lantern-run composes the asset resolver with plugin host routes. - (lantern-system fs): fs.serve-file / fs.unserve-file, grant-checked. - (lantern-system plugin): one shared servable registry wires the commands and the local route together.

Tests: lantern 39 passed, lantern-system 28 passed. The scoping test is proven fallible (serving by path turns it red). WebKitGTK geturi/getpath behavior confirmed with a real probe.

Changed

 lantern-system/src/lantern-system/fs.sgl     |  35 ++++++++++++++++++++++++++++++--
 lantern-system/src/lantern-system/plugin.sgl |  18 ++++++++++++++---
 lantern-system/test/test-lantern-system.sgl  |  43 +++++++++++++++++++++++++++++++++++++++
 lantern/src/lantern/app.sgl                  |  24 ++++++++++++++++++----
 lantern/src/lantern/backend/gtk.sgl          |  15 +++++++-------
 lantern/src/lantern/serve.sgl                | 162 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------
 lantern/test/test-lantern.sgl                | 126 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 401 insertions(+), 22 deletions(-)

Diff

lantern-system/src/lantern-system/fs.sglmodified

@@ -18,8 +18,10 @@

(sigil path) ; path-dirname / path-join

(lantern-system base64) ; base64-encode / base64-decode (no crypto dep)

(sigil system fs)

−21

(lantern app)) ; lantern-command

−22

(export fs-commands)

+21

(lantern app) ; lantern-command

+22

(lantern serve)) ; servable-register! / servable-unregister!

+23

(export fs-commands

+24

fs-serve-commands)

(begin

;; A sentinel distinct from every JSON value, so a required argument that is

@@ -169,4 +171,33 @@

171

(lantern-command "fs.delete"

172

(lambda (args ctx)

173

(fs-delete g (req args path:) recursive: (dict-ref args recursive: #f))

+174

(dict ok: #t)))))

+175

+176

;; fs.serve-file / fs.unserve-file — the lantern://local/<handle> streaming

+177

;; route's registration commands, bound to grants `g` and the servable

+178

;; registry `reg` the plugin shares with its `local` resolver route (so the

+179

;; command that registers a path and the resolver that serves it agree on one

+180

;; table). Kept separate from `fs-commands` because they need `reg`, not just

+181

;; `g`; the plugin appends both lists.

+182

(define (fs-serve-commands g reg)

+183

(list

+184

;; fs.serve-file #{ path: } -> #{ handle: url: }. Registers `path` for

+185

;; streamed serving over lantern://local/<handle> and returns the URL an

+186

;; <img>/<video>/… loads. GRANT-CHECKED: fs-stat raises outside the grant,

+187

;; so a scoped (deny-by-default) embedding can only serve files it may

+188

;; already read — and the handle-scoped resolver then serves ONLY this

+189

;; path, never an arbitrary one. Adds no authority beyond fs.read-file.

+190

(lantern-command "fs.serve-file"

+191

(lambda (args ctx)

+192

(let ((path (req args path:)))

+193

(fs-stat g path)

+194

(let ((handle (servable-register! reg path)))

+195

(dict handle: handle

+196

url: (string-append "lantern://local/" handle))))))

+197

;; fs.unserve-file #{ handle: } -> #{ ok: #t }. Revokes a handle so its

+198

;; file stops being servable — called when the image view closes, so a

+199

;; handle's authority never outlives the view that needed it.

+200

(lantern-command "fs.unserve-file"

+201

(lambda (args ctx)

+202

(servable-unregister! reg (req args handle:))

203

(dict ok: #t)))))))

lantern-system/src/lantern-system/plugin.sglmodified

@@ -24,6 +24,7 @@

(import (sigil core)

(sigil system grant)

(lantern app) ; lantern-plugin

+27

(lantern serve) ; make-servable-registry / make-fs-resolver

(lantern-system fs)

(lantern-system pty))

(export make-lantern-system-plugin

@@ -32,13 +33,24 @@

;; The combined command list for a grants table — the fs (Resource) commands

;; followed by the pty (Session) commands. Exposed for a harness that drives

−35

;; the commands through a registry directly.

+36

;; the commands through a registry directly. (The serve commands need a

+37

;; servable registry too, so they are added by make-lantern-system-plugin, not

+38

;; here.)

(define (lantern-system-commands g)

(append (fs-commands g) (pty-commands g)))

;; The plugin value for `plugins:` in a lantern-app. `grants:` overrides the

;; default allow-all owner posture.

+44

;;

+45

;; ONE servable registry is created here and shared two ways: the

+46

;; `fs.serve-file`/`fs.unserve-file` COMMANDS register/revoke paths in it, and

+47

;; the `local` HOST ROUTE (make-fs-resolver over the same registry) serves the

+48

;; bytes over lantern://local/<handle>. That shared table is the whole point:

+49

;; the resolver serves ONLY what a grant-checked command registered.

(define (make-lantern-system-plugin (keys: (grants #f)))

−42

(let ((g (or grants (grant-allow-all))))

+51

(let ((g (or grants (grant-allow-all)))

+52

(reg (make-servable-registry)))

(lantern-plugin "system"

−44

commands: (lantern-system-commands g))))))

+54

commands: (append (lantern-system-commands g)

+55

(fs-serve-commands g reg))

+56

routes: (list (cons "local" (make-fs-resolver reg))))))))

lantern-system/test/test-lantern-system.sglmodified

@@ -29,7 +29,9 @@

(lantern registry)

(lantern webview)

(lantern bridge)

+32

(lantern serve) ; make-servable-registry / make-fs-resolver

(lantern-system plugin)

+34

(lantern-system fs) ; fs-serve-commands

(lantern-system pty))

;; ============================================================

@@ -98,6 +100,47 @@

100

(assert-equal (dict-ref r name: #f) "a.txt")

101

(assert-true (string? (dict-ref r type: #f))))))

102

+103

;; ---- fs.serve-file / the lantern://local/<handle> round-trip ----

+104

;; The load-bearing new path: a grant-checked command registers a real file, the

+105

;; handle-scoped fs route then serves its bytes, and unserve revokes it. The

+106

;; command and the route share ONE registry, exactly as the plugin wires them.

+107

+108

(test "fs.serve-file registers a file the fs route serves; unserve revokes it"

+109

(let* ((dir (make-temp-directory))

+110

(g (make-grants))

+111

(_ (grant-add! g (string-append "fs:rw:" dir)))

+112

(img (path-join dir "pic.png"))

+113

(__ (write-file-string img "PNGDATA"))

+114

(reg (make-servable-registry))

+115

(serve-cmds (fs-serve-commands g reg))

+116

(serve (handler-for serve-cmds "fs.serve-file"))

+117

(unserve (handler-for serve-cmds "fs.unserve-file"))

+118

(resolve (make-fs-resolver reg))

+119

(r (serve (dict path: img) #f))

+120

(handle (dict-ref r handle: #f)))

+121

(assert-true (string? handle))

+122

(assert-equal (dict-ref r url: #f) (string-append "lantern://local/" handle))

+123

;; the fs route now serves the registered file (200 + real-extension mime)

+124

(let ((resp (resolve (string-append "/" handle))))

+125

(assert-equal (dict-ref resp status: #f) 200)

+126

(assert-equal (dict-ref resp mime: #f) "image/png"))

+127

;; unserve revokes the handle -> 404 (authority does not outlive the view)

+128

(unserve (dict handle: handle) #f)

+129

(assert-equal (dict-ref (resolve (string-append "/" handle)) status: #f) 404)))

+130

+131

;; Registration HONORS the grant scope (fs-stat gates it): a path outside the

+132

;; grant raises, so a scoped embedding cannot register a file it may not read.

+133

(test "fs.serve-file refuses a path outside the grant scope"

+134

(let* ((dir (make-temp-directory))

+135

(g (make-grants))

+136

(_ (grant-add! g (string-append "fs:rw:" dir)))

+137

(reg (make-servable-registry))

+138

(serve (handler-for (fs-serve-commands g reg) "fs.serve-file"))

+139

(raised (guard (e (#t #t)) (serve (dict path: "/etc/hostname") #f) #f)))

+140

(assert-true raised)

+141

;; and nothing got registered for a would-be handle

+142

(assert-equal (servable-lookup reg "f1") #f)))

+143

144

(test "fs.read-dir lists entries with kinds"

145

(let* ((fx (fs-fixture))

146

(rd (handler-for (dict-ref fx cmds:) "fs.read-dir")))

lantern/src/lantern/app.sglmodified

@@ -42,8 +42,12 @@

(define (lantern-command name handler (keys: (spec #f)))

(dict lantern/command: #t name: name handler: handler spec: spec))

−45

(define (lantern-plugin name (keys: (commands (list)) (init #f) (js #f)))

−46

(dict lantern/plugin: #t name: name commands: commands init: init js: js))

+45

;; `routes:` lets a plugin serve its OWN lantern:// host(s): an alist of

+46

;; (host-string . (path->response)) folded into the scheme resolver, so e.g.

+47

;; the lantern-system plugin owns lantern://local/<handle> for streamed

+48

;; filesystem serving alongside the app's bundled assets on lantern://app.

+49

(define (lantern-plugin name (keys: (commands (list)) (init #f) (js #f) (routes (list))))

+50

(dict lantern/plugin: #t name: name commands: commands init: init js: js routes: routes))

(define (lantern-app (keys: (name "lantern-app")

(assets "./dist")

@@ -90,6 +94,14 @@

(dict-ref app plugins: (list))))))

(append from-modules from-app from-plugins)))

+97

;; Every plugin's lantern:// host routes, folded into one alist for the scheme

+98

;; resolver. A collision (two plugins claiming one host) keeps the FIRST — a

+99

;; deliberate host clash is a config error, and assoc's first-wins is the least

+100

;; surprising resolution.

+101

(define (collect-routes app)

+102

(apply append (map (lambda (p) (dict-ref p routes: (list)))

+103

(dict-ref app plugins: (list)))))

+104

105

;; ---- origin gating ----------------------------------------------------

106

107

(define (starts-with? s prefix)

@@ -128,9 +140,13 @@

140

width: width height: height

141

decorated: decorated transparent: transparent))))

142

−131

;; Serve local assets over lantern://; a URL loads directly.

+143

;; Serve local assets over lantern://app; plugin routes (e.g.

+144

;; lantern://local/<handle> from lantern-system) serve their own hosts. A

+145

;; URL asset loads directly, so no scheme is registered in that mode.

146

(unless is-url

−133

(webview-register-scheme wv "lantern" (make-asset-resolver assets)))

+147

(webview-register-scheme wv "lantern"

+148

(make-scheme-resolver (make-asset-resolver assets)

+149

(collect-routes app))))

150

151

;; Inject the wasm streaming->buffer fallback FIRST (before the app boots

152

;; and calls compileStreaming): WebKitGTK will not stream-compile wasm over

lantern/src/lantern/backend/gtk.sglmodified

@@ -142,11 +142,12 @@

142

;; Tab/Shift+Tab into the page (v1 is single-window; see the callback note).

143

(define *main-view* #f)

144

−145

(define (path-of request)

−146

(let ((p (webkit-uri-scheme-request-get-path request)))

−147

(if (or (not p) (= (string-length p) 0) (string=? p "/"))

−148

"/index.html"

−149

p)))

+145

;; The FULL request URI (host intact): "lantern://app/index.html",

+146

;; "lantern://local/<handle>". The resolver is a uri->response that parses the

+147

;; host itself and dispatches (make-scheme-resolver) — get_path would strip the

+148

;; host, collapsing lantern://local onto lantern://app, so we hand over get_uri.

+149

(define (request-uri request)

+150

(webkit-uri-scheme-request-get-uri request))

151

152

;; Scheme handler (2-arg C->Sigil callback). Resolves synchronously and

153

;; finishes the request in-place - no suspension, all inside a guard.

@@ -165,8 +166,8 @@

166

(define (on-scheme-request request user-data)

167

(guarded "scheme-request" #f

168

(lambda ()

−168

(let* ((path (path-of request))

−169

(resp (and *scheme-resolver* (*scheme-resolver* path))))

+169

(let* ((uri (request-uri request))

+170

(resp (and *scheme-resolver* (string? uri) (*scheme-resolver* uri))))

171

(if (and resp (dict-ref resp bytes: #f))

172

(let* ((bytes (dict-ref resp bytes: #f))

173

(mime (dict-ref resp mime: "application/octet-stream"))

lantern/src/lantern/serve.sglmodified

@@ -17,7 +17,14 @@

(sigil path)

(sigil fs))

(export make-asset-resolver

−20

mime-for-path)

+20

mime-for-path

+21

make-servable-registry

+22

servable-register!

+23

servable-unregister!

+24

servable-lookup

+25

make-fs-resolver

+26

parse-lantern-uri

+27

make-scheme-resolver)

(begin

;; Extension -> MIME. An alist (string keys) looked up with assoc/string=?.

@@ -71,15 +78,25 @@

(let ((i (string-index s (lambda (c) (char=? c ch)))))

(if i (substring s 0 i) s)))

+81

;; Drop every leading '/' so the result is a path RELATIVE to the asset root.

+82

;; Stripping only ONE leaves an absolute remainder ("//etc/passwd" -> "/etc/

+83

;; passwd"), and path-join with an absolute second arg DISCARDS the base dir —

+84

;; i.e. it would read /etc/passwd straight off the disk. A request path is

+85

;; always relative to the asset dir, so all leading slashes are noise.

+86

(define (strip-leading-slashes s)

+87

(let loop ((i 0))

+88

(if (and (< i (string-length s)) (char=? (string-ref s i) #\/))

+89

(loop (+ i 1))

+90

(substring s i (string-length s)))))

+91

;; Normalize a request path to a relative asset path: drop any query string

;; or fragment (cache-busting URLs like app.js?v=2 must still resolve to

−76

;; app.js), strip the leading slash, and reject parent-directory traversal.

+94

;; app.js), strip ALL leading slashes (see above — one is not enough; an

+95

;; absolute remainder escapes the asset dir), and reject parent-directory

+96

;; traversal.

(define (normalize-request-path path)

(let* ((clean (cut-at (cut-at path #\?) #\#))

−79

(rel (if (and (> (string-length clean) 0)

−80

(char=? (string-ref clean 0) #\/))

−81

(substring clean 1 (string-length clean))

−82

clean)))

+99

(rel (strip-leading-slashes clean)))

100

(if (string-contains? rel "..") #f rel)))

101

102

;; Encode an ASCII string to a bytevector. Framework-generated bodies (the

@@ -99,6 +116,139 @@

116

mime: "text/plain; charset=utf-8"

117

bytes: (ascii->bytes (string-append "lantern: not found: " path))))

118

+119

;; ---- servable-file registry (the lantern://local/<handle> fs route) ------

+120

;;

+121

;; THE SECURITY BOUNDARY for filesystem serving. The fs resolver serves ONLY

+122

;; files that were explicitly registered (each registration yields an opaque

+123

;; handle); an unregistered handle 404s. So the lantern:// scheme can never be

+124

;; turned into an arbitrary full-disk read by web content — a page may request

+125

;; lantern://local/<anything>, but only handles the HOST registered ever

+126

;; resolve. The host command that registers a path (lantern-system's

+127

;; fs.serve-file) grant-checks it first, so registration also honors the

+128

;; embedding's grant scope; this route adds no authority beyond that command.

+129

;;

+130

;; A registry is a dict of op-closures over one shared mutable table. Handles

+131

;; are a per-run monotonic counter (the same globally-unique-for-the-run

+132

;; scheme the pty session ids use) — sufficient for the scoping guarantee,

+133

;; since only registered handles ever resolve. A page cannot forge authority

+134

;; by guessing a handle: an unregistered one 404s, and a registered one only

+135

;; ever names a path the host already chose to serve.

+136

+137

;; Remove one (handle . path) pair from an alist, preserving order.

+138

(define (alist-remove al key)

+139

(let loop ((xs al) (acc (list)))

+140

(cond ((null? xs) (reverse acc))

+141

((string=? (car (car xs)) key) (loop (cdr xs) acc))

+142

(else (loop (cdr xs) (cons (car xs) acc))))))

+143

+144

(define (make-servable-registry)

+145

(let ((entries (list)) ; alist: handle (string) -> absolute path

+146

(counter 0))

+147

(dict

+148

register!: (lambda (abs-path)

+149

(set! counter (+ counter 1))

+150

(let ((handle (string-append "f" (number->string counter))))

+151

(set! entries (cons (cons handle abs-path) entries))

+152

handle))

+153

unregister!: (lambda (handle)

+154

(set! entries (alist-remove entries handle)))

+155

lookup: (lambda (handle)

+156

(let ((hit (assoc handle entries)))

+157

(if hit (cdr hit) #f))))))

+158

+159

;; Register `abs-path`, returning its opaque handle (a bare string; the caller

+160

;; forms the lantern://local/<handle> URL). Nothing validates the path here —

+161

;; the grant check lives in the host command that calls this.

+162

(define (servable-register! reg abs-path)

+163

((dict-ref reg register!: #f) abs-path))

+164

+165

;; Drop a handle so its file is no longer servable (view close / cleanup).

+166

(define (servable-unregister! reg handle)

+167

((dict-ref reg unregister!: #f) handle))

+168

+169

;; The absolute path for a handle, or #f if it was never registered.

+170

(define (servable-lookup reg handle)

+171

((dict-ref reg lookup: #f) handle))

+172

+173

;; A request path -> its opaque handle: drop any query/fragment (an <img> may

+174

;; append ?v=… ; a handle carries none but be robust), strip the leading

+175

;; slash, and reject the empty handle. The handle is matched EXACTLY against

+176

;; the registry, so a multi-segment or dotted request (lantern://local/f1/x)

+177

;; simply misses and 404s — there is no path join, hence no traversal surface.

+178

(define (request->handle path)

+179

(let* ((clean (cut-at (cut-at path #\?) #\#))

+180

(h (if (and (> (string-length clean) 0)

+181

(char=? (string-ref clean 0) #\/))

+182

(substring clean 1 (string-length clean))

+183

clean)))

+184

(if (= (string-length h) 0) #f h)))

+185

+186

;; Build an fs resolver over a servable registry: path -> response. Serves the

+187

;; registered file's bytes with the MIME of its REAL extension (the handle has

+188

;; none); an unregistered handle, or a registered path that has since

+189

;; vanished, 404s. No caching — an image is fetched once and browser-cached,

+190

;; and re-reading avoids serving stale bytes; the GTK backend retains the

+191

;; returned buffer for the stream's life.

+192

(define (make-fs-resolver reg)

+193

(lambda (path)

+194

(let ((handle (request->handle path)))

+195

(if (not handle)

+196

(not-found path)

+197

(let ((full (servable-lookup reg handle)))

+198

(if (and full (file-exists? full))

+199

(dict status: 200

+200

mime: (mime-for-path full)

+201

bytes: (read-file-bytes full))

+202

(not-found path)))))))

+203

+204

;; ---- host-routed scheme resolver (app assets + fs handles) ---------------

+205

;;

+206

;; The webview scheme handler hands us the FULL request URI (get_uri returns

+207

;; it verbatim, host intact — probed on WebKitGTK; get_path strips the host,

+208

;; so a path-only resolver could not tell lantern://local from lantern://app).

+209

;; We parse the authority (host) ourselves and dispatch: a registered host

+210

;; (e.g. "local" -> the fs handle route) serves its own way; every other host

+211

;; ("app", or anything) falls through to the bundled-asset resolver.

+212

+213

;; "lantern://<host>/<path>" -> (cons host path); path keeps its leading

+214

;; slash. "lantern://app" (no path) -> (cons "app" "/"). A string that is not

+215

;; a lantern:// URI is treated as a bare asset path under the empty host, so a

+216

;; caller that still passes a plain path keeps working.

+217

(define lantern-uri-prefix "lantern://")

+218

+219

(define (has-prefix? s prefix)

+220

(let ((pl (string-length prefix)))

+221

(and (>= (string-length s) pl)

+222

(string=? (substring s 0 pl) prefix))))

+223

+224

(define (parse-lantern-uri uri)

+225

(if (not (has-prefix? uri lantern-uri-prefix))

+226

(cons "" uri)

+227

(let* ((rest (substring uri (string-length lantern-uri-prefix)

+228

(string-length uri)))

+229

(slash (string-index rest (lambda (c) (char=? c #\/)))))

+230

(if slash

+231

(cons (substring rest 0 slash)

+232

(substring rest slash (string-length rest)))

+233

(cons rest "/")))))

+234

+235

;; Compose an asset resolver (path->response) with host-routed resolvers into

+236

;; the uri->response the scheme handler calls. `routes` is an alist of

+237

;; (host-string . (path->response)). The asset branch applies the root ->

+238

;; /index.html default (the SPA entry) the backend's path-of used to.

+239

(define (make-scheme-resolver asset-resolver routes)

+240

(lambda (uri)

+241

(let* ((hp (parse-lantern-uri uri))

+242

(host (car hp))

+243

(path (cdr hp))

+244

(route (assoc host routes)))

+245

(if route

+246

((cdr route) path)

+247

(asset-resolver

+248

(if (or (= (string-length path) 0) (string=? path "/"))

+249

"/index.html"

+250

path))))))

+251

252

;; Build a resolver over a directory of static assets, with a small in-memory

253

;; cache (which also keeps served byte buffers alive for the stream's life).

254

(define (make-asset-resolver dir)

lantern/test/test-lantern.sglmodified

@@ -72,6 +72,132 @@

(resolve (make-asset-resolver dir)))

(assert-equal (dict-ref (resolve "/../../etc/passwd") status: #f) 404)))

+75

;; ---- servable-file registry + fs resolver (lantern://local/<handle>) ----

+76

;; The handle-scoped fs-serving route: only explicitly-registered files resolve.

+77

+78

(test "servable registry registers, looks up, and unregisters a handle"

+79

(let* ((reg (make-servable-registry))

+80

(h (servable-register! reg "/tmp/some/image.png")))

+81

(assert-true (string? h))

+82

(assert-equal (servable-lookup reg h) "/tmp/some/image.png")

+83

(servable-unregister! reg h)

+84

(assert-equal (servable-lookup reg h) #f)))

+85

+86

(test "servable registry issues distinct handles per registration"

+87

(let* ((reg (make-servable-registry))

+88

(h1 (servable-register! reg "/a.png"))

+89

(h2 (servable-register! reg "/b.png")))

+90

(assert-true (not (string=? h1 h2)))

+91

(assert-equal (servable-lookup reg h1) "/a.png")

+92

(assert-equal (servable-lookup reg h2) "/b.png")))

+93

+94

(test "fs resolver serves a registered file with its real-extension mime"

+95

(let* ((dir (make-temp-directory))

+96

(img (path-join dir "pic.png"))

+97

(_ (write-file-string img "PNGDATA"))

+98

(reg (make-servable-registry))

+99

(h (servable-register! reg img))

+100

(resolve (make-fs-resolver reg))

+101

(resp (resolve (string-append "/" h))))

+102

(assert-equal (dict-ref resp status: #f) 200)

+103

(assert-equal (dict-ref resp mime: #f) "image/png")

+104

(assert-true (bytevector? (dict-ref resp bytes: #f)))

+105

(assert-true (> (bytevector-length (dict-ref resp bytes: #f)) 0))))

+106

+107

(test "fs resolver ignores a cache-busting query or fragment on the handle"

+108

(let* ((dir (make-temp-directory))

+109

(img (path-join dir "pic.jpg"))

+110

(_ (write-file-string img "JPG"))

+111

(reg (make-servable-registry))

+112

(h (servable-register! reg img))

+113

(resolve (make-fs-resolver reg)))

+114

(assert-equal (dict-ref (resolve (string-append "/" h "?v=2")) status: #f) 200)

+115

(assert-equal (dict-ref (resolve (string-append "/" h "#frag")) status: #f) 200)))

+116

+117

;; THE SCOPING GUARANTEE, proven fallible: a REAL file addressed by its own

+118

;; absolute path (never registered) 404s — the resolver serves by HANDLE, never

+119

;; by path. If make-fs-resolver ever served `path` from disk directly (dropping

+120

;; the registry lookup), this exact request would return 200 and leak the file,

+121

;; so the test goes red. This is the security boundary David reviews.

+122

(test "fs resolver 404s a real file addressed by path instead of a handle"

+123

(let* ((dir (make-temp-directory))

+124

(secret (path-join dir "secret.txt"))

+125

(_ (write-file-string secret "TOPSECRET"))

+126

(reg (make-servable-registry))

+127

(resolve (make-fs-resolver reg))

+128

;; request the real absolute path AS IF it were a handle — must NOT serve

+129

(resp (resolve (string-append "/" secret))))

+130

(assert-equal (dict-ref resp status: #f) 404)))

+131

+132

(test "fs resolver 404s an arbitrary unregistered handle"

+133

(let* ((reg (make-servable-registry))

+134

(resolve (make-fs-resolver reg)))

+135

(assert-equal (dict-ref (resolve "/f1") status: #f) 404)))

+136

+137

(test "fs resolver 404s traversal-shaped and empty requests (no path join)"

+138

(let* ((reg (make-servable-registry))

+139

(resolve (make-fs-resolver reg)))

+140

(assert-equal (dict-ref (resolve "/../../etc/passwd") status: #f) 404)

+141

(assert-equal (dict-ref (resolve "/") status: #f) 404)

+142

(assert-equal (dict-ref (resolve "") status: #f) 404)))

+143

+144

(test "fs resolver 404s a registered handle whose file does not exist"

+145

(let* ((reg (make-servable-registry))

+146

(h (servable-register! reg "/nonexistent/nope.png"))

+147

(resolve (make-fs-resolver reg)))

+148

(assert-equal (dict-ref (resolve (string-append "/" h)) status: #f) 404)))

+149

+150

;; ---- parse-lantern-uri + make-scheme-resolver (host-routed dispatch) ----

+151

+152

(test "parse-lantern-uri splits host and path, preserving the leading slash"

+153

(assert-equal (parse-lantern-uri "lantern://app/index.html") (cons "app" "/index.html"))

+154

(assert-equal (parse-lantern-uri "lantern://local/f7") (cons "local" "/f7"))

+155

(assert-equal (parse-lantern-uri "lantern://local/sub/dir/x.png")

+156

(cons "local" "/sub/dir/x.png"))

+157

;; no path after the host -> "/"

+158

(assert-equal (parse-lantern-uri "lantern://app") (cons "app" "/"))

+159

(assert-equal (parse-lantern-uri "lantern://app/") (cons "app" "/"))

+160

;; not a lantern:// URI -> empty host, whole string as path (defensive)

+161

(assert-equal (parse-lantern-uri "/plain/path") (cons "" "/plain/path")))

+162

+163

(test "scheme resolver routes app host to assets (root -> index.html)"

+164

(let* ((dir (make-temp-directory))

+165

(_ (write-file-string (path-join dir "index.html") "<h1>root</h1>"))

+166

(__ (write-file-string (path-join dir "app.js") "1"))

+167

(resolve (make-scheme-resolver (make-asset-resolver dir) (list))))

+168

(assert-equal (dict-ref (resolve "lantern://app/index.html") status: #f) 200)

+169

(assert-equal (dict-ref (resolve "lantern://app/") status: #f) 200) ; -> index.html

+170

(assert-equal (dict-ref (resolve "lantern://app") status: #f) 200) ; -> index.html

+171

(assert-equal (dict-ref (resolve "lantern://app/app.js") status: #f) 200)

+172

(assert-equal (dict-ref (resolve "lantern://app/missing.js") status: #f) 404)))

+173

+174

(test "scheme resolver routes local host to the fs handle route"

+175

(let* ((dir (make-temp-directory))

+176

(_ (write-file-string (path-join dir "index.html") "<h1>x</h1>"))

+177

(img (path-join dir "pic.png"))

+178

(___ (write-file-string img "PNG"))

+179

(reg (make-servable-registry))

+180

(h (servable-register! reg img))

+181

(resolve (make-scheme-resolver (make-asset-resolver dir)

+182

(list (cons "local" (make-fs-resolver reg))))))

+183

(assert-equal (dict-ref (resolve (string-append "lantern://local/" h)) status: #f) 200)

+184

(assert-equal (dict-ref (resolve (string-append "lantern://local/" h)) mime: #f) "image/png")

+185

(assert-equal (dict-ref (resolve "lantern://local/f999") status: #f) 404))) ; unregistered

+186

+187

;; Cross-host scoping, proven fallible: a real file addressed on EITHER host by

+188

;; its own path must not leak. The app host joins under the assets dir (an

+189

;; absolute /etc path lands outside and 404s); the local host is handle-scoped.

+190

(test "scheme resolver leaks no file addressed by absolute path on either host"

+191

(let* ((dir (make-temp-directory))

+192

(_ (write-file-string (path-join dir "index.html") "<h1>x</h1>"))

+193

(secret (path-join dir "secret.txt"))

+194

(__ (write-file-string secret "TOPSECRET"))

+195

(reg (make-servable-registry)) ; secret registered NOWHERE

+196

(resolve (make-scheme-resolver (make-asset-resolver dir)

+197

(list (cons "local" (make-fs-resolver reg))))))

+198

(assert-equal (dict-ref (resolve (string-append "lantern://local/" secret)) status: #f) 404)

+199

(assert-equal (dict-ref (resolve (string-append "lantern://app/" secret)) status: #f) 404)))

+200

201

;; ============================================================

202

;; (lantern registry)

203

;; ============================================================