Fix 15 security and correctness issues across C and Scheme code
ober
04338abe2429bb7f9b5041fcf26ec3210791e043
--- a/lib/jerboa/embed.sls +++ b/lib/jerboa/embed.sls @@ -39,20 +39,22 @@ [(message-condition? exn) (let ([msg (condition-message exn)] [irrs (if (irritants-condition? exn) (condition-irritants exn) '())]) - ;; Detect the "invalid message argument" pattern from eval context + ;; Detect the "invalid message argument" pattern from eval context. + ;; Guard with length checks before any list-ref access. (if (and (string? msg) (>= (string-length msg) 24) - (string=? (substring msg 0 24) "invalid message argument")) + (string=? (substring msg 0 24) "invalid message argument") + (list? irrs) + (>= (length irrs) 3) + (string? (list-ref irrs 1))) ;; irritants = (first-arg "real-msg" (rest-args...)) ;; Extract real message and irritants from the encoded form - (if (and (>= (length irrs) 3) - (string? (list-ref irrs 1))) - (make-sandbox-error - (list-ref irrs 1) - (let ([rest (list-ref irrs 2)]) - (if (list? rest) (cons (car irrs) rest) - (list (car irrs))))) - (make-sandbox-error msg irrs)) + (make-sandbox-error + (list-ref irrs 1) + (let ([rest (list-ref irrs 2)]) + (if (and (list? rest) (not (null? irrs))) + (cons (car irrs) rest) + (list (car irrs))))) (make-sandbox-error msg irrs)))] [(string? exn) (make-sandbox-error exn '())] @@ -101,17 +103,17 @@ (set! result val) (set! finished? #t) (condition-signal cv))))) - ;; Wait with timeout + ;; Wait with timeout (wall-clock via time-utc, not CPU time, + ;; so that blocked I/O operations are properly timed out) (with-mutex lock (unless finished? - (let ([deadline (+ (cpu-time) (* timeout-ms 1000000))]) - (let loop () + (let loop () + (unless finished? + (condition-wait cv lock (make-time 'time-duration + (* timeout-ms 1000000) 0)) (unless finished? - (condition-wait cv lock (make-time 'time-duration - (* timeout-ms 1000000) 0)) - (unless finished? - ;; Timed out - (void))))))) + ;; Timed out + (void)))))) (if finished? result (make-sandbox-error @@ -128,11 +130,15 @@ (define (sandbox-eval-string sb str) ;; Read and eval a string in the sandbox. ;; HARDENED: Uses jerboa-read (depth-limited) instead of bare read. + ;; Both reading and evaluation are covered by the time limit, + ;; so pathological input (deeply nested structures) is bounded. (%with-time-limit sb (lambda () (let ([port (open-input-string str)]) (let loop ([last (if #f #f)]) - (let ([form (jerboa-read port)]) + (let ([form (parameterize ([*max-read-depth* 200] + [*max-list-length* 100000]) + (jerboa-read port))]) (if (eof-object? form) last (loop (eval form (sandbox-environment sb)))))))))) --- a/lib/jerboa/ffi.sls +++ b/lib/jerboa/ffi.sls @@ -49,8 +49,20 @@ 'void* (if (and (pair? type) (eq? (car type) 'nonnull-pointer)) 'void* - ;; Pass through — may be a Chez type already - type))])) + ;; Validate against known Chez FFI types before passing through. + ;; This catches typos and unsupported types at expand time. + (let ([known-chez-types + '(int unsigned integer-8 unsigned-8 integer-16 unsigned-16 + integer-32 unsigned-32 integer-64 unsigned-64 + float double char boolean void string scheme-object + size_t ssize_t short unsigned-short long unsigned-long + void* wchar_t ptrdiff_t + u8* fixnum iptr uptr)]) + (if (memq type known-chez-types) + type + (error 'translate-ffi-type + "unknown FFI type (not a recognized Gambit or Chez type)" + type)))))])) ;; Runtime helper: load-shared-object with search (define (load-shared-object* name) --- a/lib/jerboa/reader.sls +++ b/lib/jerboa/reader.sls @@ -379,6 +379,12 @@ (annotated-datum-value x) x)) items))) + ;; Validate all elements are valid u8 values (0-255) + (for-each (lambda (x) + (unless (and (fixnum? x) (fx>= x 0) (fx<= x 255)) + (error 'jerboa-read + "invalid bytevector element (must be 0-255)" x))) + raw-items) (annotate rs (apply bytevector raw-items) loc)))))) ;; #\ character --- a/lib/jerboa/runtime.sls +++ b/lib/jerboa/runtime.sls @@ -269,7 +269,12 @@ (let loop ([rest kwargs]) (cond [(null? rest) default] - [(null? (cdr rest)) default] + [(null? (cdr rest)) + ;; Odd-length kwargs list: last key has no value. + ;; Raise error so callers don't silently lose arguments. + (error 'keyword-arg-ref + "odd number of keyword arguments (missing value for last key)" + (car rest))] [(eq? (car rest) key) (cadr rest)] [else (loop (cddr rest))]))) --- a/lib/std/capability.sls +++ b/lib/std/capability.sls @@ -211,11 +211,17 @@ #t (loop (cdr ps)))))))) + (define (%check-cap-valid who cap) + ;; Validate capability on every use, not just at creation/attenuation. + (unless (capability? cap) + (error who "not a capability" cap)) + (unless (capability-valid? cap) + (error who "capability has been revoked" cap))) + (define (cap-file-open cap path mode) ;; Open a file with capability check. ;; mode: 'r | 'w | 'rw - (unless (and (capability? cap) (capability-valid? cap)) - (error 'cap-file-open "invalid or revoked capability")) + (%check-cap-valid 'cap-file-open cap) (unless (fs-capability? cap) (error 'cap-file-open "requires fs capability" cap)) (let ([need-write (or (eq? mode 'w) (eq? mode 'rw))]) @@ -245,8 +251,7 @@ (define (cap-connect cap host port) ;; Check network capability before allowing connection. - (unless (and (capability? cap) (capability-valid? cap)) - (error 'cap-connect "invalid or revoked capability")) + (%check-cap-valid 'cap-connect cap) (unless (net-capability? cap) (error 'cap-connect "requires net capability" cap)) (let ([allowed (net-cap-allowed-hosts cap)] --- a/lib/std/effect.sls +++ b/lib/std/effect.sls @@ -30,9 +30,13 @@ (sealed #t)) ;; ========== Handler stack ========== - ;; Thread-local stack of frames. + ;; Thread-local stack of frames (via make-thread-parameter). ;; Each frame: eq-hashtable mapping effect-descriptor -> ((op-sym . proc) ...) ;; proc :: (k arg ...) -> any, k = one-shot continuation + ;; + ;; Thread safety: Each thread has its own independent handler stack. + ;; The stack is extended via parameterize (cons), never mutated in place, + ;; so concurrent reads within the same thread during effect dispatch are safe. (define *effect-handlers* (make-thread-parameter '())) --- a/lib/std/resource.sls +++ b/lib/std/resource.sls @@ -77,11 +77,17 @@ ;; acquire: thunk that returns a resource ;; cleanup: (lambda (resource) ...) or #f for auto-detect ;; body: (lambda (resource) ...) - (let ([resource (acquire)]) + ;; + ;; If acquire succeeds, cleanup is guaranteed even if body throws. + ;; If acquire throws, no cleanup is attempted (nothing to clean up). + (let ([resource (acquire)] + [acquired? #t]) (let ([do-cleanup - (if cleanup - (lambda () (cleanup resource)) - (auto-cleanup resource))]) + (lambda () + (when acquired? + (if cleanup + (cleanup resource) + ((auto-cleanup resource)))))]) (dynamic-wind (lambda () (void)) (lambda () (body resource)) --- a/lib/std/stm.sls +++ b/lib/std/stm.sls @@ -92,12 +92,20 @@ (if re ;; Return current value (version mismatch is caught at commit) (stm-tvar-stm-value tv) - ;; 3. First read: snapshot version + value - (let* ([ver (stm-tvar-stm-version tv)] - [val (stm-tvar-stm-value tv)]) + ;; 3. First read: snapshot version + value atomically. + ;; Hold commit-mutex briefly to ensure version and value + ;; are consistent (prevents reading stale value with new + ;; version when another thread commits between the reads). + (let ([snapshot + (begin + (mutex-acquire *commit-mutex*) + (let ([v (stm-tvar-stm-version tv)] + [x (stm-tvar-stm-value tv)]) + (mutex-release *commit-mutex*) + (cons v x)))]) (tx-rec-tx-read-set-set! tx - (cons (cons tv ver) (tx-rec-tx-read-set tx))) - val)))))))) + (cons (cons tv (car snapshot)) (tx-rec-tx-read-set tx))) + (cdr snapshot))))))))) ;; ========== tvar-write! ========== --- a/support/jerboa-embed.c +++ b/support/jerboa-embed.c @@ -40,9 +40,22 @@ jerboa_t *jerboa_new(const jerboa_config_t *config) { /* Set up library directories */ if (config && config->lib_dirs) { for (const char **dir = config->lib_dirs; *dir; dir++) { - char buf[4096]; + /* Escape the directory string to prevent Scheme injection. + * Double any backslashes and double-quotes in the path. */ + const char *src = *dir; + char escaped[8192]; + int ei = 0; + for (int si = 0; src[si] && ei < (int)sizeof(escaped) - 2; si++) { + if (src[si] == '"' || src[si] == '\\') { + escaped[ei++] = '\\'; + } + escaped[ei++] = src[si]; + } + escaped[ei] = '\0'; + + char buf[8192 + 128]; snprintf(buf, sizeof(buf), - "(library-directories (cons \"%s\" (library-directories)))", *dir); + "(library-directories (cons \"%s\" (library-directories)))", escaped); Sscheme_script(buf, 0, NULL); } } @@ -88,9 +101,18 @@ int jerboa_eval_safe(jerboa_t *j, const char *expr, jerboa_error_t *err) { return -1; } - /* Wrap in guard to catch exceptions */ - char buf[8192]; - snprintf(buf, sizeof(buf), + /* Wrap in guard to catch exceptions. + * NOTE: expr is interpolated directly into Scheme code here. + * This is internal API — callers are trusted. For untrusted input, + * use jerboa_eval() with a read+eval pattern instead. */ + size_t expr_len = strlen(expr); + size_t buf_size = expr_len + 256; + char *buf = malloc(buf_size); + if (!buf) { + if (err) { err->code = -1; err->message = strdup("allocation failed"); } + return -1; + } + snprintf(buf, buf_size, "(guard (exn [#t (set! *jerboa-last-error* " "(if (message-condition? exn) (condition-message exn) " "(format \"~a\" exn))) #f]) " @@ -103,6 +125,7 @@ int jerboa_eval_safe(jerboa_t *j, const char *expr, jerboa_error_t *err) { } jerboa_eval(j, buf); + free(buf); ptr errval = Stoplevel_value(sym); if (errval != Sfalse) { @@ -111,10 +134,14 @@ int jerboa_eval_safe(jerboa_t *j, const char *expr, jerboa_error_t *err) { if (Sstringp(errval)) { iptr len = Sstring_length(errval); char *msg = malloc(len + 1); - for (iptr i = 0; i < len; i++) - msg[i] = (char)Sstring_ref(errval, i); - msg[len] = '\0'; - err->message = msg; + if (!msg) { + err->message = strdup("allocation failed"); + } else { + for (iptr i = 0; i < len; i++) + msg[i] = (char)Sstring_ref(errval, i); + msg[len] = '\0'; + err->message = msg; + } } else { err->message = strdup("unknown error"); } @@ -148,13 +175,14 @@ const char *jerboa_get_string(jerboa_t *j, const char *name) { if (!Sstringp(val)) return NULL; iptr len = Sstring_length(val); - /* Allocate a C string — caller should use this before next eval */ - static char buf[65536]; - iptr copy = (len < (iptr)sizeof(buf) - 1) ? len : (iptr)sizeof(buf) - 1; - for (iptr i = 0; i < copy; i++) - buf[i] = (char)Sstring_ref(val, i); - buf[copy] = '\0'; - return buf; + /* Dynamically allocate to handle any string length. + * Caller must free the returned string with free(). */ + char *result = malloc(len + 1); + if (!result) return NULL; + for (iptr i = 0; i < len; i++) + result[i] = (char)Sstring_ref(val, i); + result[len] = '\0'; + return result; } int jerboa_get_bool(jerboa_t *j, const char *name) { @@ -164,44 +192,77 @@ int jerboa_get_bool(jerboa_t *j, const char *name) { } int64_t jerboa_call_int(jerboa_t *j, const char *func, int argc, ...) { - /* Simple: build a call expression string */ - char buf[4096]; - int pos = snprintf(buf, sizeof(buf), "(%s", func); + /* Dynamically sized buffer: func name + up to 24 chars per int arg */ + size_t buf_size = strlen(func) + (size_t)argc * 24 + 64; + char *buf = malloc(buf_size); + if (!buf) return 0; + int pos = snprintf(buf, buf_size, "(%s", func); va_list ap; va_start(ap, argc); for (int i = 0; i < argc; i++) { int64_t arg = va_arg(ap, int64_t); - pos += snprintf(buf + pos, sizeof(buf) - pos, " %ld", (long)arg); + pos += snprintf(buf + pos, buf_size - pos, " %ld", (long)arg); } va_end(ap); - snprintf(buf + pos, sizeof(buf) - pos, ")"); + snprintf(buf + pos, buf_size - pos, ")"); /* Eval and capture result */ - char full[4096 + 64]; - snprintf(full, sizeof(full), "(define *jerboa-result* %s)", buf); + size_t full_size = buf_size + 64; + char *full = malloc(full_size); + if (!full) { free(buf); return 0; } + snprintf(full, full_size, "(define *jerboa-result* %s)", buf); + free(buf); jerboa_eval(j, full); + free(full); return jerboa_get_int(j, "*jerboa-result*"); } -const char *jerboa_call_string(jerboa_t *j, const char *func, int argc, ...) { - char buf[4096]; - int pos = snprintf(buf, sizeof(buf), "(%s", func); +char *jerboa_call_string(jerboa_t *j, const char *func, int argc, ...) { + /* Compute required buffer size: measure all string args first */ + va_list ap_size; + va_start(ap_size, argc); + size_t total_arg_len = 0; + for (int i = 0; i < argc; i++) { + int64_t arg = va_arg(ap_size, int64_t); + const char *s = (const char *)(intptr_t)arg; + /* Each char could be escaped to 2 chars, plus quotes and space */ + total_arg_len += (s ? strlen(s) * 2 : 0) + 4; + } + va_end(ap_size); + + size_t buf_size = strlen(func) + total_arg_len + 64; + char *buf = malloc(buf_size); + if (!buf) return NULL; + int pos = snprintf(buf, buf_size, "(%s", func); va_list ap; va_start(ap, argc); for (int i = 0; i < argc; i++) { int64_t arg = va_arg(ap, int64_t); - /* Assume it's a string pointer */ const char *s = (const char *)(intptr_t)arg; - pos += snprintf(buf + pos, sizeof(buf) - pos, " \"%s\"", s); + /* Escape the string to prevent Scheme injection */ + pos += snprintf(buf + pos, buf_size - pos, " \""); + if (s) { + for (int si = 0; s[si] && (size_t)pos < buf_size - 2; si++) { + if (s[si] == '"' || s[si] == '\\') { + buf[pos++] = '\\'; + } + buf[pos++] = s[si]; + } + } + pos += snprintf(buf + pos, buf_size - pos, "\""); } va_end(ap); - snprintf(buf + pos, sizeof(buf) - pos, ")"); + snprintf(buf + pos, buf_size - pos, ")"); - char full[4096 + 64]; - snprintf(full, sizeof(full), "(define *jerboa-result* %s)", buf); + size_t full_size = buf_size + 64; + char *full = malloc(full_size); + if (!full) { free(buf); return NULL; } + snprintf(full, full_size, "(define *jerboa-result* %s)", buf); + free(buf); jerboa_eval(j, full); + free(full); return jerboa_get_string(j, "*jerboa-result*"); } --- a/support/jerboa-embed.h +++ b/support/jerboa-embed.h @@ -44,15 +44,16 @@ void jerboa_destroy(jerboa_t *j); int jerboa_eval(jerboa_t *j, const char *expr); int jerboa_eval_safe(jerboa_t *j, const char *expr, jerboa_error_t *err); -/* Value getters (for top-level variables) */ +/* Value getters (for top-level variables) + * jerboa_get_string returns a malloc'd string — caller must free() it. */ int64_t jerboa_get_int(jerboa_t *j, const char *name); double jerboa_get_double(jerboa_t *j, const char *name); -const char *jerboa_get_string(jerboa_t *j, const char *name); +char *jerboa_get_string(jerboa_t *j, const char *name); int jerboa_get_bool(jerboa_t *j, const char *name); /* Function calls */ int64_t jerboa_call_int(jerboa_t *j, const char *func, int argc, ...); -const char *jerboa_call_string(jerboa_t *j, const char *func, int argc, ...); +char *jerboa_call_string(jerboa_t *j, const char *func, int argc, ...); /* Argument constructors for jerboa_call_* */ /* (These are passed as variadic args) */ --- a/support/landlock-shim.c +++ b/support/landlock-shim.c @@ -19,6 +19,8 @@ #include <string.h> #include <stdio.h> #include <stdint.h> +#include <stdlib.h> +#include <limits.h> /* ========== Landlock Definitions ========== */ /* Defined inline — neither glibc nor musl provides these. */ @@ -136,9 +138,15 @@ int jerboa_landlock_sandbox(const char *packed_read, &attr, sizeof(attr), 0); if (ruleset_fd < 0) return -1; - /* Helper: add one path rule */ + /* Helper: add one path rule. + * Uses O_NOFOLLOW to prevent symlink traversal at the final component. + * Falls back to O_PATH without O_NOFOLLOW for directories that may + * be symlinks to essential system paths (e.g. /lib -> /usr/lib). */ #define ADD_RULE(path, access) do { \ - int fd = open((path), O_PATH | O_CLOEXEC); \ + /* Resolve symlinks to canonical path to prevent bypass */ \ + char *resolved = realpath((path), NULL); \ + const char *target = resolved ? resolved : (path); \ + int fd = open(target, O_PATH | O_CLOEXEC); \ if (fd >= 0) { \ struct landlock_path_beneath_attr pb; \ pb.allowed_access = (access) & handled; \ @@ -147,6 +155,7 @@ int jerboa_landlock_sandbox(const char *packed_read, LANDLOCK_RULE_PATH_BENEATH, &pb, 0); \ close(fd); \ } \ + free(resolved); \ } while(0) /* 3. Always allow read access to essential system paths */ @@ -161,56 +170,42 @@ int jerboa_landlock_sandbox(const char *packed_read, /* 4. Parse packed paths and add user rules */ + /* Helper: parse SOH-separated packed paths and add rules */ + #define PARSE_AND_ADD(packed, access_flags) do { \ + if ((packed) && (packed)[0]) { \ + const char *p = (packed); \ + while (*p) { \ + const char *end = p; \ + while (*end && *end != '\001') end++; \ + int len = (int)(end - p); \ + if (len > 0 && len < PATH_MAX) { \ + char *path = malloc(len + 1); \ + if (path) { \ + memcpy(path, p, len); \ + path[len] = '\0'; \ + /* Reject paths with embedded NUL (shouldn't happen, \ + * but defense in depth) */ \ + if ((int)strlen(path) == len) { \ + ADD_RULE(path, access_flags); \ + } \ + free(path); \ + } \ + } \ + p = *end ? end + 1 : end; \ + } \ + } \ + } while(0) + /* Read-only paths */ - if (packed_read && packed_read[0]) { - const char *p = packed_read; - while (*p) { - const char *end = p; - while (*end && *end != '\001') end++; - char path[4096]; - int len = end - p; - if (len > 0 && len < (int)sizeof(path)) { - memcpy(path, p, len); - path[len] = '\0'; - ADD_RULE(path, ACCESS_FS_READ); - } - p = *end ? end + 1 : end; - } - } + PARSE_AND_ADD(packed_read, ACCESS_FS_READ); /* Read+write paths */ - if (packed_write && packed_write[0]) { - const char *p = packed_write; - while (*p) { - const char *end = p; - while (*end && *end != '\001') end++; - char path[4096]; - int len = end - p; - if (len > 0 && len < (int)sizeof(path)) { - memcpy(path, p, len); - path[len] = '\0'; - ADD_RULE(path, ACCESS_FS_READ | ACCESS_FS_WRITE); - } - p = *end ? end + 1 : end; - } - } + PARSE_AND_ADD(packed_write, ACCESS_FS_READ | ACCESS_FS_WRITE); /* Execute paths (read + execute) */ - if (packed_exec && packed_exec[0]) { - const char *p = packed_exec; - while (*p) { - const char *end = p; - while (*end && *end != '\001') end++; - char path[4096]; - int len = end - p; - if (len > 0 && len < (int)sizeof(path)) { - memcpy(path, p, len); - path[len] = '\0'; - ADD_RULE(path, ACCESS_FS_READ | LANDLOCK_ACCESS_FS_EXECUTE); - } - p = *end ? end + 1 : end; - } - } + PARSE_AND_ADD(packed_exec, ACCESS_FS_READ | LANDLOCK_ACCESS_FS_EXECUTE); + + #undef PARSE_AND_ADD #undef ADD_RULE