security: serve resolved realpath in httpd static to close check-then-open TOCTOU
ober
4aed067985fccd813509440f6c622cd71e5a8575
--- a/lib/std/net/httpd.ss +++ b/lib/std/net/httpd.ss @@ -234,8 +234,9 @@ ;; serving directory that points outside it (e.g. www/link -> /etc/passwd). ;; realpath(3) expands every symlink component, so we resolve both the serving ;; directory and the joined candidate and require the candidate's real path to - ;; remain under the directory's real path. The original (un-resolved) joined - ;; path is still what gets served, so callers see the path they constructed. + ;; remain under the directory's real path. The RESOLVED real path is what gets + ;; served (not the original joined path), so the path validated and the path + ;; opened are the same path — closing the check-then-open TOCTOU below. (def c-realpath (guard (exn [#t #f]) (foreign-procedure "realpath" (string u8*) void*))) @@ -261,32 +262,38 @@ (let ([np (string-length pre)] [ns (string-length s)]) (and (<= np ns) (string=? pre (substring s 0 np))))) - ;; #t iff JOINED, after symlink expansion, stays within DIRECTORY. When realpath - ;; is unavailable or a path does not exist yet, falls back to allowing the - ;; (already lexically-validated) path — a missing target simply 404s, and an - ;; escape only matters once the symlink target actually exists. - (def (symlink-contained? directory joined) + ;; Return JOINED's canonical (realpath) path when it stays within DIRECTORY's + ;; canonical path, or #f when it escapes. Serving the RESOLVED path — not the + ;; original JOINED — closes the check-then-open TOCTOU: the path validated here + ;; is exactly the path http-respond-file opens, so a symlink swapped between the + ;; containment check and the open cannot redirect the read outside the root. + ;; Falls back to the already lexically-validated JOINED when realpath is + ;; unavailable or DIRECTORY cannot be resolved. When the target does not exist + ;; yet, realpath fails and we likewise fall back to JOINED so a missing file + ;; still 404s (an escape only matters once the target actually exists). + (def (symlink-resolved-path directory joined) (if (not c-realpath) - #t + joined (let ([rdir (realpath-str directory)]) (if (not rdir) - #t + joined (let ([rjoined (realpath-str joined)]) (if (not rjoined) - #t - (or (string=? rjoined rdir) - (string-has-prefix? (string-append rdir "/") rjoined)))))))) - - ;; Resolve a static-serving suffix against DIRECTORY. Returns the joined - ;; path when it stays contained within DIRECTORY, or #f when the suffix - ;; attempts to escape — lexically ("..", %2e/%2f, backslash, NUL) or via a - ;; symbolic link that resolves outside DIRECTORY. Exported so the guard is - ;; testable. + joined + (and (or (string=? rjoined rdir) + (string-has-prefix? (string-append rdir "/") rjoined)) + rjoined))))))) + + ;; Resolve a static-serving suffix against DIRECTORY. Returns the canonical + ;; (realpath) path to serve when it stays contained within DIRECTORY, or #f when + ;; the suffix attempts to escape — lexically ("..", %2e/%2f, backslash, NUL) or + ;; via a symbolic link that resolves outside DIRECTORY. The returned path is the + ;; validated resolved path, so the containment check and the served path are one + ;; and the same (no window between them). Exported so the guard is testable. (def (httpd-resolve-static-path directory suffix) (and (static-path-safe? directory suffix) (let ([joined (string-append directory "/" suffix)]) - (and (symlink-contained? directory joined) - joined)))) + (symlink-resolved-path directory joined)))) (def (httpd-route-static router prefix directory) (router-add-prefix! router prefix --- a/tests/test-httpd-static.ss +++ b/tests/test-httpd-static.ss @@ -56,6 +56,26 @@ (loop (read-char p) (cons c acc))))))] [else 'not-found]))) +;; realpath helper mirroring the module's, used to assert the served path is the +;; canonical resolved path (the path actually opened). +(define c-realpath + (guard (exn [#t #f]) + (foreign-procedure "realpath" (string u8*) void*))) +(define (test-realpath path) + (and c-realpath + (guard (exn [#t #f]) + (let ([buf (make-bytevector 4096 0)]) + (let ([res (c-realpath path buf)]) + (and (not (= res 0)) + (let loop ([i 0] [chars '()]) + (cond + [(= i 4096) #f] + [(= (bytevector-u8-ref buf i) 0) + (list->string (reverse chars))] + [else (loop (+ i 1) + (cons (integer->char (bytevector-u8-ref buf i)) + chars))])))))))) + ;; (a) Traversal suffixes must NOT return file contents outside the root. (test "reject ../ secret" (serve "/../secret.txt") 'forbidden) (test "reject ../../ etc" (serve "/../../etc/passwd") 'forbidden) @@ -74,13 +94,24 @@ (test "resolver #f on ../" (httpd-resolve-static-path root "/../secret.txt") #f) (test "resolver #f on encoded" (httpd-resolve-static-path root "/%2e%2e%2fx") #f) -;; (b) Legitimate paths still resolve and stay contained under the root. +;; (b) Legitimate paths still resolve and stay contained under the root. The +;; resolver now returns the canonical realpath — the exact path that gets opened — +;; so containment holds against the canonical root. On macOS /tmp resolves to +;; /private/tmp, and the served path is the canonicalized file path (not the +;; literal path the caller constructed). (test "serve public file" (serve "/public.txt") "public-content") -(test-t "resolved stays under root" +(test "served path is the resolved realpath" + (httpd-resolve-static-path root "/public.txt") + (test-realpath (string-append root "/public.txt"))) +(test-t "served path is canonicalized (e.g. /tmp -> /private/tmp)" (let ([full (httpd-resolve-static-path root "/public.txt")]) - (and full - (>= (string-length full) (string-length root)) - (string=? (substring full 0 (string-length root)) root)))) + (and full (string=? full (test-realpath (string-append root "/public.txt")))))) +(test-t "resolved stays under canonical root" + (let ([full (httpd-resolve-static-path root "/public.txt")] + [rroot (test-realpath root)]) + (and full rroot + (>= (string-length full) (string-length rroot)) + (string=? (substring full 0 (string-length rroot)) rroot)))) ;; (c) Symbolic-link escape: a link placed inside the root that points outside ;; must be rejected. The lexical check cannot see through symlinks, so the @@ -95,6 +126,16 @@ (let ([alias (string-append root "/alias.txt")]) (system (string-append "ln -s " root "/public.txt " alias)) (test "serve internal symlink" (serve "/alias.txt") "public-content") + ;; The served path is the resolved TARGET (canonical public.txt), not the + ;; un-resolved alias path. Opening the resolved target — not the symlink — is + ;; what closes the TOCTOU: swapping alias.txt after the check cannot redirect + ;; the open, because the open goes straight to the already-resolved real file. + (test "internal symlink serves resolved target realpath" + (httpd-resolve-static-path root "/alias.txt") + (test-realpath (string-append root "/public.txt"))) + (test-t "internal symlink does not serve the un-resolved link path" + (let ([full (httpd-resolve-static-path root "/alias.txt")]) + (and full (not (string=? full (string-append root "/alias.txt")))))) (guard (e [#t (void)]) (delete-file alias))) (guard (e [#t (void)]) (delete-file link-path)))