Add top command and integrate security framework across all 109 commands
ober
7f1bc439409e14905c932aa5b698dea89e5bd763
--- a/Makefile +++ b/Makefile @@ -32,7 +32,7 @@ UTILS = true false yes echo printenv sleep whoami logname pwd \ dircolors \ install shred pinky basenc b2sum sum od csplit pr chcon runcon ptx \ cp mv rm ls dd stty stdbuf \ - dir vdir rev + dir vdir rev top export CHEZSCHEMELIBDIRS = $(LIB_DIR):$(JERBOA_LIB) export PROJECT_DIR = $(CURDIR) new file mode 100755 --- /dev/null +++ b/bin/top @@ -0,0 +1,5 @@ +#!/bin/sh +SCRIPT_DIR=$(cd "$(dirname "$0")/.." && pwd) +export CHEZSCHEMELIBDIRS="$SCRIPT_DIR/lib:/home/jafourni/mine/jerboa/lib" +export LD_LIBRARY_PATH="$SCRIPT_DIR/support:$LD_LIBRARY_PATH" +exec scheme --libdirs "$CHEZSCHEMELIBDIRS" --program "$SCRIPT_DIR/bin/top.sps" "$@" new file mode 100644 --- /dev/null +++ b/bin/top.sps @@ -0,0 +1,4 @@ +#!chezscheme +(import (except (chezscheme) make-hash-table hash-table? iota 1+ 1- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name)) +(import (jerboa-coreutils top)) +(apply main (cdr (command-line))) --- a/build-binary.ss +++ b/build-binary.ss @@ -122,7 +122,7 @@ pathchk fmt printf cksum md5sum sha1sum sha256sum sha512sum sha224sum sha384sum chmod chown chgrp stat du df date expr test who split dircolors install shred pinky basenc b2sum sum od csplit pr chcon runcon ptx - cp mv rm ls dd stty stdbuf dir vdir rev)) + cp mv rm ls dd stty stdbuf dir vdir rev top)) ;; Collect .so files for the boot file (dependency order) (define boot-libs @@ -146,14 +146,16 @@ "std/os/signal" "std/os/temporaries" "std/srfi/srfi-13" - "std/text/base64")) + "std/text/base64" + "std/misc/terminal")) ;; getopt (compiled in step 1) (list (let ((p (format "~a/std/cli/getopt.so" jerboa-dir))) (if (file-exists? p) p (begin (printf " WARNING: getopt.so not found\n") #f)))) ;; coreutils common modules (list (cu-so "common") - (cu-so "common/version")) + (cu-so "common/version") + (cu-so "common/security")) ;; All 108 utilities (map (lambda (u) (cu-so (symbol->string u))) *utils*)))) --- a/dispatch.ss +++ b/dispatch.ss @@ -111,6 +111,7 @@ (rename (jerboa-coreutils dir) (main dir-main)) (rename (jerboa-coreutils vdir) (main vdir-main)) (rename (jerboa-coreutils rev) (main rev-main)) + (rename (jerboa-coreutils top) (main top-main)) ) ;; Extract basename from a path string @@ -231,6 +232,7 @@ (cons "dir" dir-main) (cons "vdir" vdir-main) (cons "rev" rev-main) + (cons "top" top-main) )) ;; Sscheme_script(who, argc, argv): command-line = (who argv[1] ... argv[argc-1]). --- a/lib/jerboa-coreutils/arch.sls +++ b/lib/jerboa-coreutils/arch.sls @@ -10,7 +10,8 @@ (jerboa core) (only (std sugar) with-catch) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (arch-machine) (with-catch @@ -29,6 +30,9 @@ (def (main . args) (parameterize ((program-name "arch")) + (init-security!) + (install-proc-only-landlock!) + (install-readonly-seccomp!) (cond ((and (pair? args) (member (car args) '("--help" "-h"))) (displayln "Usage: arch") --- a/lib/jerboa-coreutils/b2sum.sls +++ b/lib/jerboa-coreutils/b2sum.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (string-index-of str ch) (let loop ((i 0)) @@ -115,6 +116,8 @@ (def (main . args) (parameterize ((program-name "b2sum")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let ((files (if (null? (hash-ref opt 'rest)) '("-") (hash-ref opt 'rest)))) --- a/lib/jerboa-coreutils/base32.sls +++ b/lib/jerboa-coreutils/base32.sls @@ -13,7 +13,8 @@ (only (std format) eprintf) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; Base32 alphabet (def *b32-alphabet* "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567") @@ -91,6 +92,8 @@ (def (main . args) (parameterize ((program-name "base32")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((wrap (if (hash-get opt 'wrap) (string->number (hash-ref opt 'wrap)) 76)) --- a/lib/jerboa-coreutils/base64.sls +++ b/lib/jerboa-coreutils/base64.sls @@ -14,10 +14,13 @@ (std cli getopt) (std text base64) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (main . args) (parameterize ((program-name "base64")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((wrap (if (hash-get opt 'wrap) (string->number (hash-ref opt 'wrap)) 76)) --- a/lib/jerboa-coreutils/basename.sls +++ b/lib/jerboa-coreutils/basename.sls @@ -11,10 +11,13 @@ (only (std sugar) with-catch) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (main . args) (parameterize ((program-name "basename")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let ((names (hash-ref opt 'rest)) --- a/lib/jerboa-coreutils/basenc.sls +++ b/lib/jerboa-coreutils/basenc.sls @@ -14,7 +14,8 @@ (std cli getopt) (std text base64) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; ---- Base32 implementation ---- (define *b32-alphabet* "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567") @@ -201,6 +202,8 @@ (def (main . args) (parameterize ((program-name "basenc")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((decode (hash-get opt 'decode)) --- a/lib/jerboa-coreutils/cat.sls +++ b/lib/jerboa-coreutils/cat.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (define exit-status 0) @@ -105,6 +106,9 @@ (def (main . args) (parameterize ((program-name "cat")) + (init-security!) + (install-readonly-seccomp!) + (with-fs-read-capability (call-with-getopt (lambda (_ opt) (let ((files (hash-ref opt 'rest)) @@ -149,6 +153,6 @@ (flag 'show-nonprinting "-v" "--show-nonprinting" 'help: "use ^ and M- notation, except for LFD and TAB") (rest-arguments 'rest)) - (unless (= exit-status 0) (exit exit-status)))) + (unless (= exit-status 0) (exit exit-status))))) ) ;; end library --- a/lib/jerboa-coreutils/chcon.sls +++ b/lib/jerboa-coreutils/chcon.sls @@ -9,10 +9,12 @@ thread? make-mutex mutex? mutex-name) (jerboa core) (only (std format) eprintf) - (jerboa-coreutils common)) + (jerboa-coreutils common) + (jerboa-coreutils common security)) (def (main . args) (parameterize ((program-name "chcon")) + (init-security!) (eprintf "chcon: SELinux is not supported in this implementation\n") (exit 1))) --- a/lib/jerboa-coreutils/chgrp.sls +++ b/lib/jerboa-coreutils/chgrp.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (define _load-ffi (begin (load-shared-object #f) (void))) @@ -79,6 +80,8 @@ (def (main . args) (parameterize ((program-name "chgrp")) + (init-security!) + (install-io-seccomp!) (call-with-getopt (lambda (_ opt) (when (null? (hash-ref opt 'rest)) --- a/lib/jerboa-coreutils/chmod.sls +++ b/lib/jerboa-coreutils/chmod.sls @@ -13,7 +13,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (define _load-ffi (begin (load-shared-object #f) (void))) @@ -128,15 +129,17 @@ (let ((new-mode (parse-mode mode-str cur-mode))) (if (not new-mode) (warn "invalid mode: '~a'" mode-str) - (let ((rc (ffi-chmod path new-mode))) - (cond - ((< rc 0) - (warn "cannot chmod '~a'" path)) - (verbose - (when (or (not changes-only) (not (= cur-mode new-mode))) - (displayln "mode of '" path "' changed from " - (number->string cur-mode 8) " to " - (number->string new-mode 8))))))))))) + (begin + (audit-file-modify! path) + (let ((rc (ffi-chmod path new-mode))) + (cond + ((< rc 0) + (warn "cannot chmod '~a'" path)) + (verbose + (when (or (not changes-only) (not (= cur-mode new-mode))) + (displayln "mode of '" path "' changed from " + (number->string cur-mode 8) " to " + (number->string new-mode 8)))))))))))) ;; Recurse if directory (when (and recursive (= (ffi-stat-isdir path) 1)) (with-catch @@ -151,6 +154,8 @@ (def (main . args) (parameterize ((program-name "chmod")) + (init-security!) + (install-io-seccomp!) (call-with-getopt (lambda (_ opt) (when (null? (hash-ref opt 'rest)) --- a/lib/jerboa-coreutils/chown.sls +++ b/lib/jerboa-coreutils/chown.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (define _load-ffi (begin (load-shared-object #f) (void))) @@ -93,6 +94,7 @@ (cons uid -1))))) (def (do-chown path uid gid no-deref verbose changes-only) + (audit-file-modify! path) (let ((rc ((if no-deref ffi-lchown ffi-chown) path uid gid))) (cond ((< rc 0) @@ -124,6 +126,8 @@ (def (main . args) (parameterize ((program-name "chown")) + (init-security!) + (install-io-seccomp!) (call-with-getopt (lambda (_ opt) (when (null? (hash-ref opt 'rest)) --- a/lib/jerboa-coreutils/chroot.sls +++ b/lib/jerboa-coreutils/chroot.sls @@ -12,7 +12,8 @@ (only (std format) eprintf) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (define _load-ffi (begin (load-shared-object #f) (void))) @@ -33,6 +34,8 @@ (def (main . args) (parameterize ((program-name "chroot")) + (init-security!) + (install-process-seccomp!) (call-with-getopt (lambda (_ opt) (cond --- a/lib/jerboa-coreutils/cksum.sls +++ b/lib/jerboa-coreutils/cksum.sls @@ -14,7 +14,8 @@ (std cli getopt) (std crypto digest) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; POSIX CRC-32 table (unreflected, polynomial 0x04C11DB7) (def crc32-table @@ -154,6 +155,8 @@ (def (main . args) (parameterize ((program-name "cksum")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((algo-str (or (hash-get opt 'algorithm) "crc")) --- a/lib/jerboa-coreutils/comm.sls +++ b/lib/jerboa-coreutils/comm.sls @@ -12,10 +12,13 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (main . args) (parameterize ((program-name "comm")) + (init-security!) + (install-readonly-seccomp!) ;; Pre-process combined flags: -12 -> -1 -2, -23 -> -2 -3, etc. ;; Also handle --output-delimiter=X (let ((args (split-long-opts (expand-comm-flags args)))) --- a/lib/jerboa-coreutils/common/io.sls +++ b/lib/jerboa-coreutils/common/io.sls @@ -1,5 +1,8 @@ #!chezscheme ;;; common/io.sls -- File and line processing utilities +;;; +;;; Security: Uses audit logging for file access when available. +;;; Validates paths against NUL injection and path traversal. (library (jerboa-coreutils common io) (export @@ -14,10 +17,21 @@ getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) (jerboa-coreutils common) + (jerboa-coreutils common security) (std sugar)) - ;; Open a file with error handling; returns port or calls die + ;; Validate that a path contains no NUL bytes (injection prevention) + (define (validate-path! path who) + (let loop ((i 0)) + (when (< i (string-length path)) + (when (char=? (string-ref path i) #\nul) + (die "~a: path contains NUL byte" who)) + (loop (+ i 1))))) + + ;; Open a file with error handling and audit; returns port or calls die (define (safe-open-input-file path) + (validate-path! path path) + (audit-file-access! path) (with-catch (lambda (e) (die "~a: No such file or directory" path)) new file mode 100644 --- /dev/null +++ b/lib/jerboa-coreutils/common/security.sls @@ -0,0 +1,408 @@ +#!chezscheme +;;; common/security.sls -- Shared security infrastructure for jerboa-coreutils +;;; +;;; Centralizes security integration so individual commands can opt-in +;;; to Landlock, seccomp, capabilities, audit logging, and taint tracking +;;; with minimal boilerplate. + +(library (jerboa-coreutils common security) + (export + ;; Seccomp profiles (pre-built for coreutils use cases) + install-readonly-seccomp! + install-io-seccomp! + install-process-seccomp! + + ;; Landlock presets + install-proc-only-landlock! + install-readonly-landlock! + install-readwrite-landlock! + + ;; Capability enforcement + with-fs-read-capability + with-fs-write-capability + with-process-capability + check-fs-read! + check-fs-write! + + ;; Audit logging + coreutils-audit-logger + audit-file-access! + audit-file-modify! + audit-file-delete! + audit-process-spawn! + audit-process-signal! + + ;; Taint helpers + taint-argv-path + untaint-after-sanitize + + ;; Path sanitization (re-export from std) + sanitize-path + safe-path-join/checked + + ;; Secret wiping + with-sensitive-buffer + + ;; Combined security initialization + init-security! + security-available?) + + (import (except (chezscheme) + make-hash-table hash-table? iota 1+ 1- + getenv path-extension path-absolute? + thread? make-mutex mutex? mutex-name) + (jerboa core) + (only (std sugar) with-catch) + (only (std format) eprintf)) + + ;; ========== Feature Detection ========== + ;; Gracefully degrade when security modules aren't available or + ;; when the kernel doesn't support the feature. + + (define *seccomp-available* #f) + (define *landlock-available* #f) + (define *audit-logger* #f) + + (define (security-available?) + (or *seccomp-available* *landlock-available*)) + + ;; ========== Lazy Loading ========== + ;; We use dynamic loading so the security modules are optional. + ;; If jerboa stdlib isn't available, security features silently degrade. + + ;; --- Seccomp --- + + (define seccomp-install-proc #f) + (define seccomp-make-filter-proc #f) + (define seccomp-kill-action #f) + + (define (load-seccomp!) + (with-catch + (lambda (e) (set! *seccomp-available* #f)) + (lambda () + (let ((env (environment '(std security seccomp)))) + (set! seccomp-install-proc (eval 'seccomp-install! env)) + (set! seccomp-make-filter-proc (eval 'make-seccomp-filter env)) + (set! seccomp-kill-action (eval 'seccomp-kill env)) + (set! *seccomp-available* + ((eval 'seccomp-available? env))))))) + + ;; Syscall lists for different profiles + (define readonly-syscalls + '(read write close fstat mmap mprotect munmap brk + rt_sigaction rt_sigprocmask rt_sigreturn + futex nanosleep getrandom arch_prctl set_tid_address + set_robust_list sched_yield sigaltstack + clock_gettime prctl prlimit64 rseq close_range + openat newfstatat getdents access getcwd fcntl + ioctl exit_group)) + + (define io-syscalls + '(read write close fstat mmap mprotect munmap brk + rt_sigaction rt_sigprocmask rt_sigreturn + futex nanosleep getrandom arch_prctl set_tid_address + set_robust_list sched_yield sigaltstack + clock_gettime prctl prlimit64 rseq close_range + openat newfstatat getdents access getcwd fcntl + ioctl exit_group + ;; File modification + rename mkdir rmdir creat link unlink + ftruncate)) + + (define process-syscalls + '(read write close fstat mmap mprotect munmap brk + rt_sigaction rt_sigprocmask rt_sigreturn + futex nanosleep getrandom arch_prctl set_tid_address + set_robust_list sched_yield sigaltstack + clock_gettime prctl prlimit64 rseq close_range + openat newfstatat getdents access getcwd fcntl + ioctl exit_group + ;; Process management + clone fork execve wait4 kill getpid getppid)) + + (define (install-readonly-seccomp!) + (when *seccomp-available* + (with-catch + (lambda (e) + (eprintf "warning: seccomp install failed: ~a~n" + (if (message-condition? e) (condition-message e) e))) + (lambda () + (seccomp-install-proc + (apply seccomp-make-filter-proc seccomp-kill-action + readonly-syscalls)))))) + + (define (install-io-seccomp!) + (when *seccomp-available* + (with-catch + (lambda (e) + (eprintf "warning: seccomp install failed: ~a~n" + (if (message-condition? e) (condition-message e) e))) + (lambda () + (seccomp-install-proc + (apply seccomp-make-filter-proc seccomp-kill-action + io-syscalls)))))) + + (define (install-process-seccomp!) + (when *seccomp-available* + (with-catch + (lambda (e) + (eprintf "warning: seccomp install failed: ~a~n" + (if (message-condition? e) (condition-message e) e))) + (lambda () + (seccomp-install-proc + (apply seccomp-make-filter-proc seccomp-kill-action + process-syscalls)))))) + + ;; --- Landlock --- + + (define landlock-make-ruleset-proc #f) + (define landlock-add-read-only-proc #f) + (define landlock-add-read-write-proc #f) + (define landlock-add-execute-proc #f) + (define landlock-install-proc #f) + + (define (load-landlock!) + (with-catch + (lambda (e) (set! *landlock-available* #f)) + (lambda () + (let ((env (environment '(std security landlock)))) + (set! landlock-make-ruleset-proc (eval 'make-landlock-ruleset env)) + (set! landlock-add-read-only-proc (eval 'landlock-add-read-only! env)) + (set! landlock-add-read-write-proc (eval 'landlock-add-read-write! env)) + (set! landlock-add-execute-proc (eval 'landlock-add-execute! env)) + (set! landlock-install-proc (eval 'landlock-install! env)) + (set! *landlock-available* + ((eval 'landlock-available? env))))))) + + (define (install-proc-only-landlock!) + ;; Restrict to /proc, /sys, /dev/null, /dev/tty (for top, uptime, etc.) + (when *landlock-available* + (with-catch + (lambda (e) + (eprintf "warning: landlock install failed: ~a~n" + (if (message-condition? e) (condition-message e) e))) + (lambda () + (let ((rs (landlock-make-ruleset-proc))) + (landlock-add-read-only-proc rs "/proc" "/sys" "/dev" "/etc" + "/usr/lib" "/lib") + (landlock-install-proc rs)))))) + + (define (install-readonly-landlock! . paths) + ;; Restrict to reading only the specified paths + /proc, /dev, /etc, system libs + (when *landlock-available* + (with-catch + (lambda (e) + (eprintf "warning: landlock install failed: ~a~n" + (if (message-condition? e) (condition-message e) e))) + (lambda () + (let ((rs (landlock-make-ruleset-proc))) + (apply landlock-add-read-only-proc rs + "/proc" "/sys" "/dev" "/etc" "/usr/lib" "/lib" + paths) + (landlock-install-proc rs)))))) + + (define (install-readwrite-landlock! read-paths write-paths) + ;; Read access to read-paths, read+write to write-paths + (when *landlock-available* + (with-catch + (lambda (e) + (eprintf "warning: landlock install failed: ~a~n" + (if (message-condition? e) (condition-message e) e))) + (lambda () + (let ((rs (landlock-make-ruleset-proc))) + (apply landlock-add-read-only-proc rs + "/proc" "/sys" "/dev" "/etc" "/usr/lib" "/lib" + read-paths) + (apply landlock-add-read-write-proc rs write-paths) + (landlock-install-proc rs)))))) + + ;; --- Capabilities --- + + (define *current-capabilities* (make-parameter '())) + + (define-syntax with-fs-read-capability + (syntax-rules () + [(_ body ...) + (parameterize ([*current-capabilities* + (cons 'fs-read (*current-capabilities*))]) + body ...)])) + + (define-syntax with-fs-write-capability + (syntax-rules () + [(_ body ...) + (parameterize ([*current-capabilities* + (cons 'fs-write (*current-capabilities*))]) + body ...)])) + + (define-syntax with-process-capability + (syntax-rules () + [(_ body ...) + (parameterize ([*current-capabilities* + (cons 'process (*current-capabilities*))]) + body ...)])) + + (define (check-fs-read!) + (unless (memq 'fs-read (*current-capabilities*)) + (error 'check-fs-read! "filesystem read capability not granted"))) + + (define (check-fs-write!) + (unless (memq 'fs-write (*current-capabilities*)) + (error 'check-fs-write! "filesystem write capability not granted"))) + + ;; --- Audit Logging --- + + (define audit-make-logger-proc #f) + (define audit-log-proc #f) + + (define (load-audit!) + (with-catch + (lambda (e) (void)) + (lambda () + (let ((env (environment '(std security audit)))) + (set! audit-make-logger-proc (eval 'make-audit-logger env)) + (set! audit-log-proc (eval 'audit-log! env)) + ;; Initialize logger if env var is set + (let ((log-path (getenv "COREUTILS_AUDIT_LOG"))) + (when (and log-path (> (string-length log-path) 0)) + (set! *audit-logger* + (audit-make-logger-proc log-path)))))))) + + (define (coreutils-audit-logger) + *audit-logger*) + + (define (audit-file-access! path) + (when (and *audit-logger* audit-log-proc) + (with-catch (lambda (e) (void)) + (lambda () + (audit-log-proc *audit-logger* 'file-access + 'resource: path))))) + + (define (audit-file-modify! path) + (when (and *audit-logger* audit-log-proc) + (with-catch (lambda (e) (void)) + (lambda () + (audit-log-proc *audit-logger* 'file-modify + 'resource: path))))) + + (define (audit-file-delete! path) + (when (and *audit-logger* audit-log-proc) + (with-catch (lambda (e) (void)) + (lambda () + (audit-log-proc *audit-logger* 'file-delete + 'resource: path))))) + + (define (audit-process-spawn! cmd) + (when (and *audit-logger* audit-log-proc) + (with-catch (lambda (e) (void)) + (lambda () + (audit-log-proc *audit-logger* 'process-spawn + 'command: cmd))))) + + (define (audit-process-signal! pid sig) + (when (and *audit-logger* audit-log-proc) + (with-catch (lambda (e) (void)) + (lambda () + (audit-log-proc *audit-logger* 'process-signal + 'pid: (number->string pid) + 'signal: (number->string sig)))))) + + ;; --- Taint Tracking --- + + (define taint-file-proc #f) + (define untaint-proc #f) + (define check-untainted-proc #f) + + (define (load-taint!) + (with-catch + (lambda (e) (void)) + (lambda () + (let ((env (environment '(std security taint)))) + (set! taint-file-proc (eval 'taint-file env)) + (set! untaint-proc (eval 'untaint env)) + (set! check-untainted-proc (eval 'check-untainted! env)))))) + + (define (taint-argv-path path) + ;; Mark a path from command-line arguments as file-input tainted + (if taint-file-proc + (taint-file-proc path) + path)) + + (define (untaint-after-sanitize value) + ;; Remove taint after validation/sanitization + (if untaint-proc + (untaint-proc value) + value)) + + ;; --- Path Sanitization --- + + (define sanitize-path-proc #f) + + (define (load-sanitize!) + (with-catch + (lambda (e) (void)) + (lambda () + (let ((env (environment '(std security sanitize)))) + (set! sanitize-path-proc (eval 'sanitize-path env)))))) + + (define (sanitize-path path) + ;; Canonicalize path and reject traversal attempts + (if sanitize-path-proc + (sanitize-path-proc path) + path)) + + (define (safe-path-join/checked base relative) + ;; Join paths with traversal protection + (let ((joined (string-append base "/" relative))) + ;; Validate no NUL bytes + (let check ((i 0)) + (when (< i (string-length relative)) + (when (char=? (string-ref relative i) #\nul) + (error 'safe-path-join/checked "NUL byte in path")) + (check (+ i 1)))) + ;; Validate no escape via .. + (let ((sanitized (sanitize-path joined))) + (let ((blen (string-length base))) + (if (and (>= (string-length sanitized) blen) + (string=? (substring sanitized 0 blen) base)) + sanitized + (error 'safe-path-join/checked + "path traversal detected" relative)))))) + + ;; --- Secret Wiping --- + + (define wipe-bv-proc #f) + + (define (load-secret!) + (with-catch + (lambda (e) (void)) + (lambda () + (let ((env (environment '(std security secret)))) + (set! wipe-bv-proc (eval 'wipe-bytevector! env)))))) + + (define-syntax with-sensitive-buffer + (syntax-rules () + [(_ ([name size]) body ...) + (let ([name (make-bytevector size 0)]) + (dynamic-wind + (lambda () (void)) + (lambda () body ...) + (lambda () + ;; Zero the buffer on scope exit + (let loop ([i 0]) + (when (< i (bytevector-length name)) + (bytevector-u8-set! name i 0) + (loop (+ i 1)))))))])) + + ;; --- Combined Initialization --- + + (define (init-security!) + ;; Load all security modules. Call once at startup. + ;; Failures are silently ignored — security degrades gracefully. + (load-seccomp!) + (load-landlock!) + (load-audit!) + (load-taint!) + (load-sanitize!) + (load-secret!)) + + ) ;; end library --- a/lib/jerboa-coreutils/cp.sls +++ b/lib/jerboa-coreutils/cp.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (define _load-ffi (begin (load-shared-object #f) (void))) @@ -98,6 +99,8 @@ (warn "cannot stat '~a': No such file or directory" src) (set! *exit-code* 1)) (when src-type + (audit-file-access! src) + (audit-file-modify! dst) ;; Handle destination existing (let ((dst-type (get-file-type dst))) (when dst-type @@ -194,6 +197,8 @@ (def (main . args) (parameterize ((program-name "cp")) + (init-security!) + (install-io-seccomp!) (call-with-getopt (lambda (_ opt) (when (null? (hash-ref opt 'rest)) --- a/lib/jerboa-coreutils/csplit.sls +++ b/lib/jerboa-coreutils/csplit.sls @@ -13,7 +13,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; Read all lines from a port (def (read-all-lines port) @@ -200,6 +201,8 @@ (def (main . args) (parameterize ((program-name "csplit")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((prefix (or (hash-get opt 'prefix) "xx")) --- a/lib/jerboa-coreutils/cut.sls +++ b/lib/jerboa-coreutils/cut.sls @@ -13,7 +13,8 @@ (std cli getopt) (only (std misc string) string-split string-contains string-index) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; Parse LIST format: N, N-M, N-, -M, comma-separated (def (parse-list str) @@ -135,6 +136,8 @@ (def (main . args) (parameterize ((program-name "cut")) + (init-security!) + (install-readonly-seccomp!) ;; Pre-process --key=value into --key value (let ((args (split-long-opts args))) (call-with-getopt --- a/lib/jerboa-coreutils/date.sls +++ b/lib/jerboa-coreutils/date.sls @@ -11,7 +11,8 @@ (only (std sugar) with-catch) (only (std format) eprintf format) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; date delegates entirely to /bin/date for full compatibility ;; since date parsing is incredibly complex @@ -40,6 +41,9 @@ (def (main . args) (parameterize ((program-name "date")) + (init-security!) + (install-proc-only-landlock!) + (install-readonly-seccomp!) ;; We use a simple manual arg parser to pass args directly to /bin/date (let loop ((rest args) (date-args '())) (cond --- a/lib/jerboa-coreutils/dd.sls +++ b/lib/jerboa-coreutils/dd.sls @@ -11,7 +11,8 @@ (only (std sugar) with-catch) (only (std format) eprintf format) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; Parse a size value with optional suffixes: c=1, w=2, b=512, K=1024, M=1M, G=1G (def (parse-size str) @@ -72,6 +73,8 @@ (def (main . args) (parameterize ((program-name "dd")) + (init-security!) + (install-io-seccomp!) ;; Handle --help and --version (when (and (pair? args) (equal? (car args) "--help")) (displayln "Usage: dd [OPERAND]...") --- a/lib/jerboa-coreutils/df.sls +++ b/lib/jerboa-coreutils/df.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (human-size bytes) (cond @@ -127,6 +128,9 @@ (def (main . args) (parameterize ((program-name "df")) + (init-security!) + (install-proc-only-landlock!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((human (hash-get opt 'human-readable)) --- a/lib/jerboa-coreutils/dir.sls +++ b/lib/jerboa-coreutils/dir.sls @@ -13,7 +13,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) (def (filter-hidden lst) (cond @@ -39,6 +40,7 @@ (for-each displayln names)) (def (main . args) + (init-security!) (parameterize ((program-name "dir")) (call-with-getopt (lambda (_ opt) --- a/lib/jerboa-coreutils/dircolors.sls +++ b/lib/jerboa-coreutils/dircolors.sls @@ -12,7 +12,8 @@ (only (std format) eprintf format) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security)) ;; Default LS_COLORS database (a subset of GNU dircolors defaults) (define *default-database* @@ -151,6 +152,8 @@ (def (main . args) (parameterize ((program-name "dircolors")) + (init-security!) + (install-readonly-seccomp!) (call-with-getopt (lambda (_ opt) (let* ((db (if (pair? (hash-ref opt 'rest)) --- a/lib/jerboa-coreutils/dirname.sls +++ b/lib/jerboa-coreutils/dirname.sls @@ -11,10 +11,13 @@ (only (std sugar) with-catch) (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version)) + (jerboa-coreutils common version) + (jerboa-coreutils common security))