fix: mutex deadlock, fd leaks, double-close, fail-closed integrity, platform detection, env cleanup
ober
d18106e51625df73a316cc0590df0b2a107ef3a1
--- a/bin/agent.ss +++ b/bin/agent.ss @@ -11,6 +11,7 @@ (secmon monitor events) (secmon platform provider) (secmon platform freebsd) + (secmon platform linux) (secmon monitor process) (secmon monitor network) (secmon monitor files) @@ -30,6 +31,9 @@ (secmon stealth init) (std text hex)) +(define on-freebsd? + (string-contains (symbol->string (machine-type)) "fb")) + (define (main . args) (let ([debug-mode (and (getenv "SECMON_DEBUG") #t)]) @@ -61,8 +65,12 @@ [psk-auth (make-psk-auth psk)] [buffer (make-event-buffer encryptor (agent-config-max-buffer-size config))] - [proc-provider (create-freebsd-process-provider)] - [net-provider (create-freebsd-network-provider)] + [proc-provider (if on-freebsd? + (create-freebsd-process-provider) + (create-linux-process-provider))] + [net-provider (if on-freebsd? + (create-freebsd-network-provider) + (create-linux-network-provider))] [hostname ((process-provider-get-hostname proc-provider))] [poll-ms (agent-config-poll-interval-ms config)]) --- a/bin/collector.ss +++ b/bin/collector.ss @@ -30,28 +30,38 @@ (define (connect-to-agent host port) (let ([c-socket (foreign-procedure "socket" (int int int) int)] - [c-connect (foreign-procedure __collect_safe "connect" (int u8* int) int)]) + [c-connect (foreign-procedure __collect_safe "connect" (int u8* int) int)] + [c-close (foreign-procedure "close" (int) int)]) (let ([fd (c-socket 2 1 0)]) (when (< fd 0) (error 'connect "socket() failed")) (let ([addr (make-connect-addr host port)]) (let ([rc (c-connect fd addr (bytevector-length addr))]) (when (< rc 0) + (c-close fd) (error 'connect "connect() failed" host port)) (values (open-fd-input-port fd) (open-fd-output-port fd))))))) (define (make-connect-addr host port) - (let ([addr (make-bytevector 16 0)] - [ip-parts (map string->number (string-split host #\.))]) - (bytevector-u16-set! addr 0 2 (endianness little)) - (bytevector-u16-set! addr 2 port (endianness big)) - (when (= (length ip-parts) 4) + (let* ([ip-parts (map string->number (string-split host #\.))] + [valid? (and (= (length ip-parts) 4) + (let loop ([ps ip-parts]) + (if (null? ps) #t + (let ([p (car ps)]) + (and p (integer? p) (exact? p) + (>= p 0) (<= p 255) + (loop (cdr ps)))))))]) + (unless valid? + (error 'make-connect-addr "invalid IPv4 address" host)) + (let ([addr (make-bytevector 16 0)]) + (bytevector-u16-set! addr 0 2 (endianness little)) + (bytevector-u16-set! addr 2 port (endianness big)) (bytevector-u8-set! addr 4 (list-ref ip-parts 0)) (bytevector-u8-set! addr 5 (list-ref ip-parts 1)) (bytevector-u8-set! addr 6 (list-ref ip-parts 2)) - (bytevector-u8-set! addr 7 (list-ref ip-parts 3))) - addr)) + (bytevector-u8-set! addr 7 (list-ref ip-parts 3)) + addr))) ;; --- Transport I/O --- @@ -266,7 +276,6 @@ (displayln (format "Buffered events: ~a" (cadr resp))) (displayln (format "Latest sequence: ~a" (caddr resp))) (displayln (format "Uptime: ~as" (cadddr resp)))) - (close-port in) (close-port out)))))) (define (run-poll args) @@ -302,7 +311,6 @@ (let ([ev (decrypt-event decryptor stored-ev)]) (when ev (print-event ev format-json?)))) (cadr resp)))) - (close-port in) (close-port out))))))) (define (run-watch args) @@ -329,28 +337,35 @@ (let ([psk-auth (make-psk-auth psk)] [decryptor (make-ecies-decryptor private-key)] [store (and db-path (open-event-store db-path))]) - (for-each - (lambda (host-str) - (fork-thread - (lambda () - (watch-host host-str psk-auth decryptor store format-json?)))) - (reverse hosts)) - ;; Block main thread - (let loop () - (sleep (make-time 'time-duration 0 3600)) - (loop)))))) - -(define (watch-host host-str psk-auth decryptor store format-json?) + (let ([store-mtx (and db-path (make-mutex))]) + (for-each + (lambda (host-str) + (fork-thread + (lambda () + (watch-host host-str psk-auth decryptor store store-mtx format-json?)))) + (reverse hosts)) + ;; Block main thread + (let loop () + (sleep (make-time 'time-duration 0 3600)) + (loop))))))) + +(define (watch-host host-str psk-auth decryptor store store-mtx format-json?) (let-values ([(host port) (parse-host-port host-str)]) (let ([last-seq (box 0)] - [backoff (box 1)]) + [backoff (box 1)] + [cur-out (box #f)]) (let loop () (guard (e [#t + (guard (e2 [#t (void)]) + (when (unbox cur-out) + (close-port (unbox cur-out)))) + (set-box! cur-out #f) (let ([wait (unbox backoff)]) (sleep (make-time 'time-duration 0 wait)) (set-box! backoff (min 30 (* wait 2))) (loop))]) (let-values ([(in out) (connect-to-agent host port)]) + (set-box! cur-out out) (authenticate! in out psk-auth) (set-box! backoff 1) (let poll-loop () @@ -364,7 +379,10 @@ (when ev (print-event ev format-json?) (when store - (store-decrypted-event! store stored-ev ev host-str))) + (dynamic-wind + (lambda () (mutex-acquire store-mtx)) + (lambda () (store-decrypted-event! store stored-ev ev host-str)) + (lambda () (mutex-release store-mtx))))) (set-box! last-seq (stored-event-seq stored-ev)))) (cadr resp)))) (sleep (make-time 'time-duration 0 1)) --- a/lib/secmon/buffer/ring.sls +++ b/lib/secmon/buffer/ring.sls @@ -26,40 +26,44 @@ (define (buffer-store! buf event) (let ([mtx (event-buffer-mutex buf)]) - (mutex-acquire mtx) - (let* ([seq (event-buffer-next-seq buf)] - [plaintext (security-event->bytevector event)] - [encrypted (ecies-encrypt (event-buffer-encryptor buf) plaintext)] - [enc-bytes (encrypted-payload->bytevector encrypted)] - [stored (make-stored-event seq - (security-event-timestamp-ms event) - enc-bytes)] - [events (event-buffer-events buf)] - [new-events (append events (list stored))]) - (event-buffer-next-seq-set! buf (+ seq 1)) - ;; Evict oldest if at capacity - (if (> (length new-events) (event-buffer-max-size buf)) - (event-buffer-events-set! buf (cdr new-events)) - (event-buffer-events-set! buf new-events)) - (mutex-release mtx) - stored))) + (dynamic-wind + (lambda () (mutex-acquire mtx)) + (lambda () + (let* ([seq (event-buffer-next-seq buf)] + [plaintext (security-event->bytevector event)] + [encrypted (ecies-encrypt (event-buffer-encryptor buf) plaintext)] + [enc-bytes (encrypted-payload->bytevector encrypted)] + [stored (make-stored-event seq + (security-event-timestamp-ms event) + enc-bytes)] + [events (event-buffer-events buf)] + [new-events (cons stored events)]) + (event-buffer-next-seq-set! buf (+ seq 1)) + (if (> (length new-events) (event-buffer-max-size buf)) + (event-buffer-events-set! buf + (list-head new-events (event-buffer-max-size buf))) + (event-buffer-events-set! buf new-events)) + stored)) + (lambda () (mutex-release mtx))))) (define (buffer-get-after buf seq) (let ([mtx (event-buffer-mutex buf)]) (mutex-acquire mtx) - (let ([result (filter (lambda (e) (> (stored-event-seq e) seq)) - (event-buffer-events buf))]) + (let ([result (reverse + (filter (lambda (e) (> (stored-event-seq e) seq)) + (event-buffer-events buf)))]) (mutex-release mtx) result))) (define (buffer-get-in-range buf start-ms end-ms) (let ([mtx (event-buffer-mutex buf)]) (mutex-acquire mtx) - (let ([result (filter - (lambda (e) - (and (>= (stored-event-timestamp-ms e) start-ms) - (<= (stored-event-timestamp-ms e) end-ms))) - (event-buffer-events buf))]) + (let ([result (reverse + (filter + (lambda (e) + (and (>= (stored-event-timestamp-ms e) start-ms) + (<= (stored-event-timestamp-ms e) end-ms))) + (event-buffer-events buf)))]) (mutex-release mtx) result))) --- a/lib/secmon/config.sls +++ b/lib/secmon/config.sls @@ -40,23 +40,38 @@ (hex-string->u8vector content)))] [else #f]))) + (define (clear-secmon-env!) + (let ([c-unsetenv (foreign-procedure "unsetenv" (string) int)]) + (for-each + (lambda (var) + (when (getenv var) + (c-unsetenv var))) + (list (obfstr "SECMON_LISTEN") (obfstr "SECMON_POLL_MS") + (obfstr "SECMON_BUFFER_SIZE") (obfstr "SECMON_PUBLIC_KEY") + (obfstr "SECMON_PSK") (obfstr "SECMON_PRIVATE_KEY") + (obfstr "SECMON_DEBUG"))))) + (define (load-agent-config) - (make-agent-config - (or (getenv (obfstr "SECMON_LISTEN")) (obfstr "127.0.0.1:31337")) - (or (and (getenv (obfstr "SECMON_POLL_MS")) - (string->number (getenv (obfstr "SECMON_POLL_MS")))) - 100) - (or (and (getenv (obfstr "SECMON_BUFFER_SIZE")) - (string->number (getenv (obfstr "SECMON_BUFFER_SIZE")))) - 10000) - (load-key-from-env (obfstr "SECMON_PUBLIC_KEY") (obfstr "keys/public.key")) - (load-key-from-env (obfstr "SECMON_PSK") (obfstr "keys/psk.key")) - (and (getenv (obfstr "SECMON_DEBUG")) #t))) + (let ([config (make-agent-config + (or (getenv (obfstr "SECMON_LISTEN")) (obfstr "127.0.0.1:31337")) + (or (and (getenv (obfstr "SECMON_POLL_MS")) + (string->number (getenv (obfstr "SECMON_POLL_MS")))) + 100) + (or (and (getenv (obfstr "SECMON_BUFFER_SIZE")) + (string->number (getenv (obfstr "SECMON_BUFFER_SIZE")))) + 10000) + (load-key-from-env (obfstr "SECMON_PUBLIC_KEY") (obfstr "keys/public.key")) + (load-key-from-env (obfstr "SECMON_PSK") (obfstr "keys/psk.key")) + (and (getenv (obfstr "SECMON_DEBUG")) #t))]) + (clear-secmon-env!) + config)) (define (load-collector-config) - ;; Returns (values private-key psk) - (values - (load-key-from-env (obfstr "SECMON_PRIVATE_KEY") (obfstr "keys/private.key")) - (load-key-from-env (obfstr "SECMON_PSK") (obfstr "keys/psk.key")))) + (let-values ([(private-key psk) + (values + (load-key-from-env (obfstr "SECMON_PRIVATE_KEY") (obfstr "keys/private.key")) + (load-key-from-env (obfstr "SECMON_PSK") (obfstr "keys/psk.key")))]) + (clear-secmon-env!) + (values private-key psk))) ) ;; end library --- a/lib/secmon/stealth/integrity.sls +++ b/lib/secmon/stealth/integrity.sls @@ -20,12 +20,10 @@ (define (verify-integrity) (let ([disk-ok (let ([h (hash-self-binary)]) (or (not (unbox *disk-hash*)) - (not h) - (equal? h (unbox *disk-hash*))))] + (and h (equal? h (unbox *disk-hash*)))))] [code-ok (let ([h (hash-code-section)]) (or (not (unbox *code-hash*)) - (not h) - (equal? h (unbox *code-hash*))))]) + (and h (equal? h (unbox *code-hash*))))]) (and disk-ok code-ok))) ;; ── Helpers ────────────────────────────────────────────────────── @@ -77,12 +75,15 @@ (let ([exe-path (if on-freebsd? (get-exe-path-freebsd) (readlink-safe (obfstr "/proc/self/exe")))]) - (when exe-path + (and exe-path (let ([p (open-file-input-port exe-path)]) - (let ([bv (get-bytevector-all p)]) - (close-port p) - (if (eof-object? bv) #f - (rust-sha256 bv)))))))) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([bv (get-bytevector-all p)]) + (if (eof-object? bv) #f + (rust-sha256 bv)))) + (lambda () (close-port p)))))))) ;; ── Hash code section ──────────────────────────────────────────── ;; Linux: /proc/self/maps + /proc/self/mem @@ -117,11 +118,14 @@ [size (- end start)]) (when (and start end (> size 0) (< size 10485760)) (let ([p (open-file-input-port (obfstr "/proc/self/mem"))]) - (set-port-position! p start) - (let ([bv (get-bytevector-n p size)]) - (close-port p) - (if (or (eof-object? bv) (not bv)) #f - (rust-sha256 bv)))))))) + (dynamic-wind + (lambda () (void)) + (lambda () + (set-port-position! p start) + (let ([bv (get-bytevector-n p size)]) + (if (or (eof-object? bv) (not bv)) #f + (rust-sha256 bv)))) + (lambda () (close-port p)))))))) ;; FreeBSD: hash .text section from ELF binary on disk (define (hash-code-section-freebsd)