commit 83026acb09c2b60ae57bd4ae269cdbe8a5cb4db2
parent 0bcc42aa26912d6e56d5e267ef03513dbf4ba44e
Author: Daniel Barlow <dan@telent.net>
Date: Wed, 9 Sep 2026 19:02:08 +0100
create path module and use it for static file lookup
make pathame-safing textual instead of relying on the actual
filesystem: look for . and .. segments in the provided pathnames
instead of using realpath
This changes the behaviour around symlinks, if you put symlinks in the
document root it will now follow them, so if you don't want it to
follow symlinks don't put them in the document root. We assume that
you wouldn't point the server at a directory not under your control
(for this and other reasons)
Diffstat:
5 files changed, 122 insertions(+), 12 deletions(-)
diff --git a/Makefile b/Makefile
@@ -2,7 +2,7 @@ FENNEL?=fennel
PREFIX?=/usr/local
NAME?=cripslock
-MODULES=main.fnl textile.fnl site.fnl html.fnl lib.fnl rss.fnl server.fnl
+MODULES=main.fnl path.fnl textile.fnl site.fnl html.fnl lib.fnl rss.fnl server.fnl
SOURCES=$(MODULES) assert.fnl stem.lua
default:
diff --git a/lib.fnl b/lib.fnl
@@ -103,6 +103,9 @@
)
+
+
+
{
: prepend : string-stream : trace "%%" string.format
: clone
diff --git a/main.fnl b/main.fnl
@@ -10,7 +10,9 @@
(local rss (require :rss))
(local { : to-html } (require :html))
-(local { : string-stream : prepend : %% : trace } (require :lib))
+(local { : string-stream : prepend : %% : trace : clone } (require :lib))
+(local { : Path } (require :path))
+
(local { : view } (require :fennel))
diff --git a/path.fnl b/path.fnl
@@ -0,0 +1,106 @@
+(import-macros { : define-tests : expect : expect= } :assert)
+(local { : clone } (require :lib))
+
+(local Path
+ (let [mt {}
+ new (fn [components absolute? directory?]
+ (doto { : components : absolute? : directory? }
+ (setmetatable mt)))
+ parse
+ (fn [raw]
+ (if (= (type raw) :string)
+ (new (icollect [c (string.gmatch raw "([^/]+)")] c)
+ (string.find raw "^/")
+ (or (string.find raw "/$")
+ (string.find raw "/%.$")
+ (string.find raw "/%.%.$")))
+ (new raw.components raw.absolute? raw.directory?)))
+ join
+ (fn [base leaf]
+ (let [addl (parse leaf)]
+ (if addl.absolute?
+ addl
+ (let [c (clone base.components)]
+ (each [_ v (ipairs addl.components)]
+ (table.insert c v))
+ (new c base.absolute? addl.directory? )))))
+ canonicalise
+ (fn [self]
+ (let [out []]
+ (each [_ component (ipairs self.components)]
+ (case component
+ ".." (table.remove out)
+ "." nil
+ c (table.insert out c)))
+ (new out self.absolute? self.directory?)))
+ ]
+ (tset mt :__div join)
+ (tset mt :__index {
+ :parent (fn [x]
+ (new (doto (clone x.components) (table.remove))
+ x.absolute?))
+ :join join
+ :canonicalise canonicalise
+ :relativise (fn [p]
+ (new p.components false p.directory?))
+ })
+ (tset mt :__tostring (fn [self]
+ (.. (if self.absolute? "/" "")
+ (table.concat self.components "/")
+ (if self.directory? "/" "")
+ )))
+
+
+ parse))
+
+(define-tests :path
+ (let [p (Path "/etc/passwd")
+ q (Path "/var/spool/mail/")]
+ (expect= p.components ["etc" "passwd"])
+ (expect p.absolute?)
+ (expect= (tostring (/ p "foo/bar/")) "/etc/passwd/foo/bar/")
+ (expect= (tostring (p:parent)) "/etc")
+ (expect q.directory?)
+ (let [c (/ p "subdir/")]
+ (expect= (tostring c) "/etc/passwd/subdir/")
+ (expect c.directory?))
+ (let [c (/ p (Path "subdir/"))]
+ (expect= (tostring c) "/etc/passwd/subdir/")
+ (expect c.directory?))
+
+ (let [p (Path "/etc/../var/log/../spool/foo")]
+ (expect= (tostring (p:canonicalise)) "/var/spool/foo"))
+ (let [p (Path "/etc/private/..")]
+ (expect p.absolute?)
+ (expect p.directory?))
+
+ ))
+
+
+(define-tests :dedot-path
+ (let [dedot-path #(-> "/" Path (/ $1) (: :canonicalise) tostring)]
+ (expect= (dedot-path "/hello") "/hello")
+ ;; relative pathnames are treated as if at root directory
+ (expect= (dedot-path "hello") "/hello")
+ (expect= (dedot-path "hello/goo") "/hello/goo")
+ ;; repeated / is treated as if single /
+ (expect= (dedot-path "/hello///goodbye") "/hello/goodbye")
+ (expect= (dedot-path "/hello/there/../goodbye") "/hello/goodbye")
+ ;; if the input ends in / then preserve it
+ (expect= (dedot-path "/hello/there/") "/hello/there/")
+ ;; if the final entry is . or .. then we must be desiring a directory
+ (expect= (dedot-path "/hello/there/..") "/hello/")
+ (expect= (dedot-path "/hello/there/../.") "/hello/")
+
+ (expect= (dedot-path "/./../hello/") "/hello/")
+
+ (expect= (dedot-path "/hello/there/ab") "/hello/there/ab")
+ (expect= (dedot-path "/hello/there/./goodbye") "/hello/there/goodbye")
+
+ (expect= (dedot-path "../../foo") "/foo")
+ ))
+
+
+
+
+{ : Path }
diff --git a/site.fnl b/site.fnl
@@ -10,6 +10,7 @@
(local lcmark (require :lcmark))
(local { : to-html } (require :html))
(local { : clone : prepend : parse-timestamp : trace : %% } (require :lib))
+(local { : Path } (require :path))
(fn markup-bare-urls [str]
@@ -206,11 +207,14 @@
(expect= (. freqs (stem "duck")) 3)))
+(fn safe-relative-path [basedir name]
+ (.. (-> basedir Path tostring)
+ (-> name Path (: :canonicalise) (: :relativise) tostring)))
+
+(define-tests :safe-relative-path
+ (expect= (safe-relative-path "/doc/root/" "/index.html") "/doc/root/index.html"))
+
-(fn static-path-if-safe [basedir name]
- (let [prefix (realpath basedir)
- fullpath (realpath (.. basedir name))]
- (and fullpath (string.find fullpath prefix 1 true) fullpath)))
(fn topics [posts]
(let [counts {}]
@@ -342,7 +346,7 @@
:search #(search-posts posts frequencies $2)
:path path
:static-file (fn [_ name]
- (static-path-if-safe path name))
+ (safe-relative-path path name))
:topics #(topics posts)
:weighted-topics #(weighted-topics posts)
:refresh (fn [self]
@@ -354,9 +358,4 @@
(: :refresh)))
-(define-tests :static-path
- (expect (static-path-if-safe "./" "/README.md"))
- (expect (not (static-path-if-safe "./tests/" "../README.md")))
- (expect (not (static-path-if-safe "./tests/" "no such file"))))
-
{ : for-pathname }
