security: close 3 bypasses found reviewing the P0 fixes
Jaime Fournier <jaimef@linbsd.org>
02b8982858f0da03af961caf8b66cf9e8055a560
diff --git a/src/jcode/core/plugin.ss b/src/jcode/core/plugin.ss
index e950f7b..eb2c1fb 100644
--- a/src/jcode/core/plugin.ss
+++ b/src/jcode/core/plugin.ss
@@ -24,21 +24,48 @@
(and v (not (string=? v "")) (not (string=? v "0"))))
(config-ref "pluginAllowWorkspace")))
+(def (string-prefix-safe? prefix s)
+ (and (>= (string-length s) (string-length prefix))
+ (string=? prefix (substring s 0 (string-length prefix)))))
+
+(def (workspace-relative-dir? dir)
+ "True when DIR resolves to a location inside the current workspace (cwd).
+ A project-local ./jcode.json is attacker-controllable (a cloned repo could
+ ship one), so any configured pluginDir that lives in the workspace is
+ untrusted code and must obey the same opt-in gate as <cwd>/.jcode/plugins.
+ Absolute dirs outside the workspace come from the user's global config and
+ remain trusted."
+ (and (string? dir)
+ (let* ((cwd (current-directory))
+ (abs (if (string-prefix-safe? "/" dir) dir (path-join cwd dir)))
+ (cwd-slash (string-append cwd "/")))
+ (or (string=? abs cwd)
+ (string-prefix-safe? cwd-slash abs)))))
+
(def (plugin-dirs)
"Return list of directories to scan for plugins."
- (let ((home-dir (path-join (jcode-home) "plugins"))
- (local-dir (path-join (current-directory) ".jcode" "plugins"))
- (cfg-dirs (config-ref "pluginDirs")))
- (unless (workspace-plugins-allowed?)
+ (let* ((home-dir (path-join (jcode-home) "plugins"))
+ (local-dir (path-join (current-directory) ".jcode" "plugins"))
+ (cfg-dirs (config-ref "pluginDirs"))
+ (allow-ws (workspace-plugins-allowed?))
+ (cfg-dirs (if (and cfg-dirs (list? cfg-dirs)) cfg-dirs '()))
+ ;; Gate workspace-local configured dirs exactly like local-dir.
+ (safe-cfg (filter (lambda (d)
+ (or allow-ws (not (workspace-relative-dir? d))))
+ cfg-dirs)))
+ (unless allow-ws
(when (file-directory? local-dir)
(log-warn logger "workspace-plugins-skipped"
`((dir . ,local-dir)
- (hint . "set JCODE_ALLOW_WORKSPACE_PLUGINS=1 to load workspace-local plugins")))))
+ (hint . "set JCODE_ALLOW_WORKSPACE_PLUGINS=1 to load workspace-local plugins"))))
+ (unless (= (length safe-cfg) (length cfg-dirs))
+ (log-warn logger "workspace-pluginDirs-skipped"
+ `((hint . "a project pluginDir resolves inside the workspace; set JCODE_ALLOW_WORKSPACE_PLUGINS=1 to load it")))))
(filter file-directory?
(append
- (if (and cfg-dirs (list? cfg-dirs)) cfg-dirs '())
+ safe-cfg
(list home-dir)
- (if (workspace-plugins-allowed?) (list local-dir) '())))))
+ (if allow-ws (list local-dir) '())))))
(def (find-plugins)
"Find all .ss files in plugin directories."
diff --git a/src/jcode/proxy/server.ss b/src/jcode/proxy/server.ss
index f4f7fc5..4ad5cb4 100644
--- a/src/jcode/proxy/server.ss
+++ b/src/jcode/proxy/server.ss
@@ -97,8 +97,10 @@
(def (proxy-authorized? auth-header token)
"Constant-time check of an `Authorization: Bearer <token>` header against
- the expected TOKEN. #f token means auth is required but unset → reject."
- (and (string? token) (string? auth-header)
+ the expected TOKEN. #f or empty TOKEN means auth is required but unset →
+ reject; an empty expected token must never authenticate an empty bearer."
+ (and (string? token) (> (string-length token) 0)
+ (string? auth-header)
(string-prefix? "Bearer " auth-header)
(remote-auth-proof=?
(substring auth-header 7 (string-length auth-header))
diff --git a/src/jcode/tool/web.ss b/src/jcode/tool/web.ss
index ca687f9..b44ce77 100644
--- a/src/jcode/tool/web.ss
+++ b/src/jcode/tool/web.ss
@@ -88,15 +88,42 @@
(def *fetch-max-body-bytes* (* 5 1024 1024))
(def (ipv4-octets ip)
+ ;; Parse a STRICT canonical dotted-decimal IPv4 into 4 octets, or #f.
+ ;; Octets with a leading zero (e.g. "0177") are rejected: the OS resolver
+ ;; reads them as octal (0177 == 127) while string->number reads decimal,
+ ;; and that disagreement is a classic SSRF filter bypass. Non-canonical
+ ;; numeric encodings are failed-closed by blocked-host? instead.
(let ((parts (string-split ip #\.)))
(and (= (length parts) 4)
(let loop ((ps parts) (acc '()))
(cond
((null? ps) (reverse acc))
(else
- (let ((n (string->number (car ps))))
- (and (integer? n) (<= 0 n 255)
- (loop (cdr ps) (cons n acc))))))))))
+ (let ((tok (car ps)))
+ (and (string? tok)
+ (> (string-length tok) 0)
+ (or (= (string-length tok) 1)
+ (not (char=? (string-ref tok 0) #\0)))
+ (let ((n (string->number tok)))
+ (and (integer? n) (<= 0 n 255)
+ (loop (cdr ps) (cons n acc))))))))))))
+
+(def (numeric-ip-looking? host)
+ ;; True when HOST is made only of digits and dots — i.e. it could be an
+ ;; IPv4 address encoding (dotted decimal, octal octets, a packed integer
+ ;; like 2130706433, or a short form like 127.1). A host like this that is
+ ;; not strict canonical dotted-decimal is ambiguous: the OS resolver may
+ ;; map it to a private address our decimal parse would miss. No legitimate
+ ;; server is addressed this way, so blocked-host? fails closed on it.
+ (and (string? host)
+ (> (string-length host) 0)
+ (let loop ((i 0))
+ (cond
+ ((>= i (string-length host)) #t)
+ ((let ((c (string-ref host i)))
+ (or (char-numeric? c) (char=? c #\.)))
+ (loop (+ i 1)))
+ (else #f)))))
(def (ipv4-blocked? ip)
(let ((o (ipv4-octets ip)))
@@ -130,7 +157,15 @@
((or (not (string? host)) (string=? host "")) #t)
((or (string=? host "localhost")
(string-suffix? ".localhost" host)) #t)
+ ;; A leading '[' means an IPv6-literal URL; the URL parser hands us a
+ ;; mangled fragment we cannot safely classify, so fail closed.
+ ((char=? (string-ref host 0) #\[) #t)
+ ;; Strict canonical IPv4 literal: classify by octets.
((ipv4-octets host) (ipv4-blocked? host))
+ ;; Numeric-looking but not strict canonical (octal octets like 0177.0.0.1,
+ ;; packed integers like 2130706433, short forms like 127.1): the OS
+ ;; resolver may map these to a private address our decimal parse misses.
+ ((numeric-ip-looking? host) #t)
((string-contains host ":") (ipv6-blocked? host))
(else
(guard (e [else #t])
diff --git a/test/security-regression.ss b/test/security-regression.ss
index 28ed522..b1bd535 100644
--- a/test/security-regression.ss
+++ b/test/security-regression.ss
@@ -3,6 +3,7 @@
(import (scheme)
(jcode core path-policy)
(jcode core agent-defs)
+ (jcode core config)
(jcode core debug-repl)
(jcode core remote-auth)
(jcode core plugin)
@@ -11,6 +12,7 @@
(jcode core secrets)
(jcode core secrets-import)
(jcode tool web)
+ (prefix (only (jerboa core) make-hash-table hash-put!) jh:)
(std misc ports)
(std misc string)
(std net tcp))
@@ -174,6 +176,47 @@
(when (file-exists? plugin-marker) (delete-file plugin-marker))
(system (string-append "rm -rf '" plugin-home "'"))
+;; (a) extended: a project-local config (./jcode.json) is attacker-controllable
+;; in a cloned repo, so a configured pluginDir that resolves inside the
+;; workspace is untrusted and must obey the same opt-in gate as
+;; <cwd>/.jcode/plugins. (This was a separate autoload path that bypassed the
+;; workspace-plugin gate.)
+(define pd-dir (string-append (current-directory) "/jcode-sec-pd-dir"))
+(define pd-evil (string-append pd-dir "/evil.ss"))
+(define pd-marker "/tmp/jcode-sec-pd-marker")
+(define pd-home "/tmp/jcode-sec-pd-home")
+(define pd-saved-home (getenv "HOME"))
+(define pd-saved-config (*config*))
+(define pd-saved-opt (getenv "JCODE_ALLOW_WORKSPACE_PLUGINS"))
+(define pd-had-dir (file-directory? pd-dir))
+(system (string-append "mkdir -p '" pd-home "'"))
+(unless pd-had-dir (mkdir pd-dir))
+(when (file-exists? pd-evil) (delete-file pd-evil))
+(call-with-output-file pd-evil
+ (lambda (p)
+ (display (string-append "(call-with-output-file \"" pd-marker
+ "\" (lambda (pp) (display \"pwned\" pp)))") p)))
+(putenv "HOME" pd-home)
+(putenv "JCODE_ALLOW_WORKSPACE_PLUGINS" "0")
+(when (file-exists? pd-marker) (delete-file pd-marker))
+(let ((cfg (jh:make-hash-table)))
+ (jh:hash-put! cfg "pluginDirs" (list "./jcode-sec-pd-dir"))
+ (*config* cfg))
+(init-plugins)
+(check "workspace-relative pluginDir NOT auto-loaded without opt-in (no RCE)"
+ (not (file-exists? pd-marker)))
+(putenv "JCODE_ALLOW_WORKSPACE_PLUGINS" "1")
+(init-plugins)
+(check "workspace-relative pluginDir loads with explicit opt-in"
+ (file-exists? pd-marker))
+(*config* pd-saved-config)
+(putenv "HOME" pd-saved-home)
+(putenv "JCODE_ALLOW_WORKSPACE_PLUGINS" (or pd-saved-opt "0"))
+(when (file-exists? pd-evil) (delete-file pd-evil))
+(unless pd-had-dir (system (string-append "rmdir '" pd-dir "'")))
+(when (file-exists? pd-marker) (delete-file pd-marker))
+(system (string-append "rm -rf '" pd-home "'"))
+
;; ── (b) mentions command injection + policy bypass ────────────────────
(define diff-probe "/tmp/jcode-sec-diff-probe")
(when (file-exists? diff-probe) (delete-file diff-probe))
@@ -232,6 +275,10 @@
(not (proxy-content-length-ok? 999999999999)))
(check "proxy accepts bounded Content-Length"
(proxy-content-length-ok? 1024))
+(check "proxy rejects empty expected token (no empty-bearer bypass)"
+ (not (proxy-authorized? "Bearer " "")))
+(check "proxy rejects empty token against non-empty bearer"
+ (not (proxy-authorized? "Bearer anything" "")))
(define (condition-text e)
(guard (_ [else ""])
@@ -304,6 +351,26 @@
(check "ipv4-blocked? allows public address" (not (ipv4-blocked? "8.8.8.8")))
(check "header-value-safe? rejects CRLF" (not (header-value-safe? "a\r\nb")))
(check "header-value-safe? accepts plain value" (header-value-safe? "application/json"))
+;; SSRF numeric-encoding bypasses: the OS resolver may read these as a private
+;; address (octal octets, packed integer, short form) even though a naive
+;; decimal parse looks public. They must fail closed.
+(check "fetch blocks octal-encoded loopback 0177.0.0.1"
+ (refused? (lambda () (fetch-url "http://0177.0.0.1/" "GET" #f #f))))
+(check "fetch blocks packed-integer loopback 2130706433"
+ (refused? (lambda () (fetch-url "http://2130706433/" "GET" #f #f))))
+(check "fetch blocks short-form loopback 127.1"
+ (refused? (lambda () (fetch-url "http://127.1/" "GET" #f #f))))
+(check "fetch blocks bracketed IPv6 loopback [::1]"
+ (refused? (lambda () (fetch-url "http://[::1]/" "GET" #f #f))))
+(check "fetch blocks localhost hostname"
+ (refused? (lambda () (fetch-url "http://localhost/" "GET" #f #f))))
+(check "fetch blocks 0.0.0.0"
+ (refused? (lambda () (fetch-url "http://0.0.0.0/" "GET" #f #f))))
+(check "ipv4-blocked? flags CGNAT 100.64.0.1" (ipv4-blocked? "100.64.0.1"))
+(check "ipv4-blocked? flags 0.0.0.0" (ipv4-blocked? "0.0.0.0"))
+(check "ipv4-blocked? flags whole 169.254.0.0/16 range" (ipv4-blocked? "169.254.1.1"))
+(check "validate-fetch-url! allows a public IPv4 (no over-blocking)"
+ (guard (e [else #f]) (validate-fetch-url! "http://8.8.8.8/") #t))
(when (> failures 0)
(error 'security-regression (format "~a security regression test(s) failed" failures)))