security: realpath containment for project-file-path symlink escape
ober
8801fa6417c84aaeee1b11fb700300d125ccac67
--- a/mcp/server.ss +++ b/mcp/server.ss @@ -7,6 +7,7 @@ (std os path) (std os flock) (std os shell) + (only (std os exec-id) exec-id-realpath-of) (std security profile) (std security taint) (std port-position) @@ -3193,6 +3194,46 @@ (string-contains file "support/typed") (string-contains file "test-typed"))) +;; Symlink containment (follow-up to P0 #5). The lexical check canonicalizes +;; "." / ".." segments but cannot see through a symbolic link placed inside the +;; project that points outside it (e.g. proj/link -> ../secret): "link" is +;; lexically under the root, yet reading or writing it escapes. realpath(3) +;; expands every symlink component, so we resolve the project root and the +;; deepest already-existing ancestor of the candidate path and require the +;; resolved candidate to stay under the resolved root. +;; +;; project-file-path also serves not-yet-existing files (create/write), so for +;; a missing candidate we resolve its nearest existing ancestor (the parent +;; directory, or the closest parent that exists). A symlink escape requires the +;; symlink itself to exist, so resolving the deepest existing ancestor always +;; surfaces it; if nothing resolves we fall back to the lexical check that has +;; already passed rather than breaking legitimate creates. +(def (deepest-existing-ancestor path) + (let loop ([p path]) + (cond + [(file-exists? p) p] + [else + (let ([parent (path-directory p)]) + (cond + [(or (string=? parent p) + (string=? parent "") + (string=? parent "/")) + p] + [else (loop parent)]))]))) + +(def (realpath-contained-under-root? root full) + ;; A resolution error falls back to allowing: the lexical check has already + ;; passed, and we only add symlink protection on top of it. + (guard (e [else #t]) + (cond + ;; Project root missing: nothing to resolve against; allow. + [(not (file-exists? root)) #t] + [else + (let ([rroot (exec-id-realpath-of root)] + [ranchor (exec-id-realpath-of (deepest-existing-ancestor full))]) + (or (string=? ranchor rroot) + (string-prefix? (string-append rroot "/") ranchor)))]))) + (def (project-file-path project file) (cond [(path-absolute? file) file] @@ -3207,10 +3248,13 @@ (path-strip-trailing-directory-separator (path-normalize project)))] [full (lexically-clean-path (path-normalize file root))]) - (if (and (not (path-parent-component? full)) - (string-prefix? (string-append root "/") full)) - full - (error 'project-file-path "path escapes project root" file)))])) + (cond + [(or (path-parent-component? full) + (not (string-prefix? (string-append root "/") full))) + (error 'project-file-path "path escapes project root" file)] + [(not (realpath-contained-under-root? root full)) + (error 'project-file-path "path escapes project via symlink" file)] + [else full]))])) (def (contains-any? text needles) (any (lambda (needle) (string-contains text needle)) needles)) --- a/mcp/test/security-test.ss +++ b/mcp/test/security-test.ss @@ -75,6 +75,42 @@ (check "traversal bare .. rejected" (eval-raises? '(project-file-path "/proj" ".."))) +;; (c) project-file-path symlink containment. +;; A symlink placed inside the project that points outside it is lexically +;; under the root, so the "../" guard cannot catch it. Once resolved with +;; realpath(3) the candidate must be rejected -- for an existing target AND +;; for a not-yet-created file whose parent directory is the symlink (the +;; create/write path). Legitimate in-project paths, existing or not, must +;; still resolve so normal create/write keeps working. +(define sym-proj + (let ([t (current-time)]) + (string-append "/tmp/jmcp-symtest-" + (number->string (time-second t)) + (number->string (time-nanosecond t))))) +(define sym-secret (string-append sym-proj "-secret")) +(mkdir sym-proj) +(call-with-output-file sym-secret + (lambda (p) (display "TOP-SECRET" p))) +(call-with-output-file (string-append sym-proj "/real.txt") + (lambda (p) (display "ok" p))) +(system (format "ln -s ~a ~a/link" sym-secret sym-proj)) +(system (format "ln -s /etc ~a/etc-link" sym-proj)) + +(check "existing symlink to outside file rejected" + (eval-raises? `(project-file-path ,sym-proj "link"))) +(check "existing path resolved through symlink rejected" + (eval-raises? `(project-file-path ,sym-proj "etc-link/passwd"))) +(check "not-yet-created file through symlinked parent rejected" + (eval-raises? `(project-file-path ,sym-proj "etc-link/no-such-file-xyz"))) +(check "legit existing in-project file still resolves under project" + (starts-with? (eval-val `(project-file-path ,sym-proj "real.txt")) + (string-append sym-proj "/"))) +(check "legit not-yet-created file in real subdir still resolves" + (starts-with? (eval-val `(project-file-path ,sym-proj "subdir/new.txt")) + (string-append sym-proj "/"))) + +(system (format "rm -rf ~a ~a" sym-proj sym-secret)) + (newline) (printf "Results: ~a passed, ~a failed~%" pass fail) (unless (zero? fail) (exit 1))