fix: psk-transport min-length check, connection aging, store-close, hex validation, TMPDIR buffer
ober
012815644f9eaf618e7a71000c87b492ce3b879b
--- a/bin/collector.ss +++ b/bin/collector.ss @@ -48,7 +48,7 @@ message->bytes message-from-bytes make-serialized-event serialized-event-seq serialized-event-timestamp-ms serialized-event-encrypted-data) - (only (jsecmon kernels) hex-decode derive-auth-key derive-transport-key) + (only (jsecmon kernels) hex-decode psk-hex-32? derive-auth-key derive-transport-key) (only (jsecmon crypto-psk) transport-encrypt transport-decrypt respond-to-challenge) (only (jsecmon crypto-ecies) ecies-decrypt) @@ -107,6 +107,17 @@ ((path-like-key? value) (read-key-path env-var value)) (else value)))) +;; A collector secret (PSK or ECIES private key) is exactly 32 bytes = 64 hex +;; digits. Validate the length and hex characters up front, before hex-decode, +;; so a malformed key fails here with a clean message instead of a decode error +;; or a wrong-length key surfacing deep in the crypto kernels. +(def (load-secret-key env-var file-env-var) + (let ((value (load-key env-var file-env-var))) + (unless (psk-hex-32? value) + (die env-var " must be exactly 64 hex digits (32 bytes); got " + (string-length value) " characters")) + value)) + ;; ── host:port split (last colon; default port when none) ────────────────────── (def (last-colon s) (let loop ((i (- (string-length s) 1))) @@ -332,8 +343,8 @@ ;; ── subcommand: poll ────────────────────────────────────────────────────────── (def (cmd-poll host after-seq format db-path) - (let* ((priv-hex (load-key "SECMON_PRIVATE_KEY" "SECMON_PRIVATE_KEY_FILE")) - (psk-hex (load-key "SECMON_PSK" "SECMON_PSK_FILE")) + (let* ((priv-hex (load-secret-key "SECMON_PRIVATE_KEY" "SECMON_PRIVATE_KEY_FILE")) + (psk-hex (load-secret-key "SECMON_PSK" "SECMON_PSK_FILE")) (secret (try (hex-decode priv-hex) (catch (e) (die "Invalid private key: " e)))) (db (and db-path (try (let ((d (store-open db-path))) (eprintln "Storing events to " db-path) d) @@ -352,7 +363,7 @@ ;; ── subcommand: status ──────────────────────────────────────────────────────── (def (cmd-status host) - (let* ((psk-hex (load-key "SECMON_PSK" "SECMON_PSK_FILE")) + (let* ((psk-hex (load-secret-key "SECMON_PSK" "SECMON_PSK_FILE")) (client (try (client-connect host psk-hex) (catch (e) (die "Connection failed: " e)))) (st (try (client-get-status client) (catch (e) (client-close client) (die "Request failed: " e))))) @@ -369,8 +380,8 @@ ;; ── subcommand: watch (sequential round-robin sweep) ────────────────────────── (def (cmd-watch hosts format db-path) - (let* ((priv-hex (load-key "SECMON_PRIVATE_KEY" "SECMON_PRIVATE_KEY_FILE")) - (psk-hex (load-key "SECMON_PSK" "SECMON_PSK_FILE")) + (let* ((priv-hex (load-secret-key "SECMON_PRIVATE_KEY" "SECMON_PRIVATE_KEY_FILE")) + (psk-hex (load-secret-key "SECMON_PSK" "SECMON_PSK_FILE")) (secret (try (hex-decode priv-hex) (catch (e) (die "Invalid private key: " e)))) (db (and db-path (try (let ((d (store-open db-path))) (eprintln "Storing events to " db-path) d) @@ -383,10 +394,19 @@ s)) hosts))) (eprintln "Watching " (length hosts) " host(s); Ctrl-C to stop") - (let sweep () - (for-each (lambda (s) (watch-step s db secret psk-hex format)) states) - (sleep-ms 1000) - (sweep))))) + ;; The sweep loop never returns normally; dynamic-wind guarantees the + ;; SQLite store (and any open per-host clients) are closed when we leave + ;; it, including on a Ctrl-C interrupt — otherwise the db handle leaked. + (dynamic-wind + (lambda () (values)) + (lambda () + (let sweep () + (for-each (lambda (s) (watch-step s db secret psk-hex format)) states) + (sleep-ms 1000) + (sweep))) + (lambda () + (for-each (lambda (s) (awhen (hash-get s "client") (client-close it))) states) + (when db (store-close db))))))) (def (watch-step s db secret psk-hex format) (let ((host (hash-get s "host"))) --- a/build-binary.ss +++ b/build-binary.ss @@ -1789,13 +1789,15 @@ (for-each (lambda (l) (display l out) (newline out)) (list "int main(int argc, char *argv[]) {" - " char prog_path[256];" " const char *tmpdir = getenv(\"TMPDIR\"); if (!tmpdir) tmpdir = \"/tmp\";" - " snprintf(prog_path, sizeof(prog_path), \"%s/jsecmon-XXXXXX\", tmpdir);" + " size_t prog_path_size = strlen(tmpdir) + sizeof(\"/jsecmon-XXXXXX\");" + " char *prog_path = malloc(prog_path_size);" + " if (!prog_path) { perror(\"malloc\"); return 1; }" + " snprintf(prog_path, prog_path_size, \"%s/jsecmon-XXXXXX\", tmpdir);" " int fd = mkstemp(prog_path);" - " if (fd < 0) { perror(\"mkstemp\"); return 1; }" + " if (fd < 0) { perror(\"mkstemp\"); free(prog_path); return 1; }" " if (write(fd, program_data, program_size) != (ssize_t)program_size) {" - " perror(\"write\"); close(fd); unlink(prog_path); return 1; }" + " perror(\"write\"); close(fd); unlink(prog_path); free(prog_path); return 1; }" " close(fd);" " Sscheme_init(NULL);" " Sregister_boot_file_bytes(\"petite\", (void*)petite_boot_data, petite_boot_size);" @@ -1806,6 +1808,7 @@ " register_static_ffi_symbols();" " int status = Sscheme_script(prog_path, argc, (const char **)argv);" " unlink(prog_path);" + " free(prog_path);" " Sscheme_deinit();" " return status;" "}")))) --- a/jsecmon/monitor-network.ss +++ b/jsecmon/monitor-network.ss @@ -19,8 +19,11 @@ ;;; * de-dup keys are exactly secmon's format! strings: listener ;;; "proto:laddr:lport"; connection "proto:laddr:lport:raddr:rport:state". ;;; * a provider Err on either list simply skips that half of the scan. -;;; * secmon never ages connections out (the cleanup is a no-op TODO), so the -;;; known sets only grow — no exit events. Ported as-is. +;;; * secmon never ages connections out (the cleanup is a no-op TODO), so its +;;; known sets only grow. We deviate for memory safety: de-dup entries are +;;; aged out after a configurable TTL (default 1h, see *known-ttl-ms*) and +;;; their last-seen time is refreshed while a connection stays present, so +;;; the sets stay bounded; a connection reappearing after aging is re-reported. ;;; * event categories/severities match event_json.rs: listening_port/info, ;;; network_connection/info, suspicious_connection/high. @@ -34,6 +37,7 @@ make-net-state net-state-hostname net-state-known-connections net-state-known-listeners make-network-monitor scan-connections + known-ttl-ms set-known-ttl-ms! make-linux-network-provider linux-list-connections linux-list-listeners) (import (except (scheme) make-hash-table hash-table? @@ -59,13 +63,32 @@ ;; hostname : string (defstruct net-provider (list-connections list-listeners hostname)) - ;; accumulated knowledge (secmon NetworkMonitor fields): two grow-only key sets. + ;; accumulated knowledge (secmon NetworkMonitor fields): two key sets, aged + ;; out after *known-ttl-ms* so they do not grow without bound. Each key maps + ;; to the last-seen timestamp (not #t) so aging can tell stale entries apart. (defstruct net-state (hostname known-connections known-listeners)) (def (make-network-monitor provider) (make-net-state (net-provider-hostname provider) (make-hash-table) (make-hash-table))) + ;; De-dup entries are aged out after this many milliseconds (default 1 hour) + ;; so the known sets stay bounded — secmon's cleanup is a no-op TODO and its + ;; sets grow forever. Set to 0 to disable aging entirely. + (def *known-ttl-ms* 3600000) + (def (known-ttl-ms) *known-ttl-ms*) + (def (set-known-ttl-ms! ms) (set! *known-ttl-ms* ms)) + + ;; Drop de-dup keys last seen more than *known-ttl-ms* before `now`. No-op when + ;; aging is disabled (ttl 0). Values are the last-seen timestamps. + (def (age-known! table now) + (when (> *known-ttl-ms* 0) + (for-each (lambda (k) + (let ((seen (hash-get table k))) + (when (and seen (> (- now seen) *known-ttl-ms*)) + (hash-remove! table k)))) + (hash-keys table)))) + ;; secmon's two format! de-dup keys, verbatim. (def (listen-key c) (str (conn-info-protocol c) ":" (conn-info-local-addr c) ":" (conn-info-local-port c))) @@ -99,15 +122,20 @@ (kl (net-state-known-listeners state)) (kc (net-state-known-connections state)) (events '())) + ;; bound the grow-only sets: drop entries not seen within the TTL. + (age-known! kl now) + (age-known! kc now) ;; listeners first (secmon order) (let ((ls ((net-provider-list-listeners provider)))) (when ls (for-each (lambda (c) (let ((k (listen-key c))) - (unless (hash-key? kl k) - (hash-put! kl k #t) - (set! events (cons (listening-port-event host now c) events))))) + (if (hash-key? kl k) + (hash-put! kl k now) ;; still present: refresh last-seen + (begin + (hash-put! kl k now) + (set! events (cons (listening-port-event host now c) events)))))) ls))) ;; then established connections, classified (let ((cs ((net-provider-list-connections provider)))) @@ -115,17 +143,19 @@ (for-each (lambda (c) (let ((k (conn-key c))) - (unless (hash-key? kc k) - (hash-put! kc k #t) - (let ((reason (connection-suspicious? - (conn-info-remote-port c) - (conn-info-remote-addr c) - (conn-info-process-name c)))) - (set! events - (cons (if reason - (suspicious-connection-event host now c reason) - (new-connection-event host now c)) - events)))))) + (if (hash-key? kc k) + (hash-put! kc k now) ;; still present: refresh last-seen + (begin + (hash-put! kc k now) + (let ((reason (connection-suspicious? + (conn-info-remote-port c) + (conn-info-remote-addr c) + (conn-info-process-name c)))) + (set! events + (cons (if reason + (suspicious-connection-event host now c reason) + (new-connection-event host now c)) + events))))))) cs))) (reverse events))) --- a/typed/psk.ss +++ b/typed/psk.ss @@ -129,8 +129,14 @@ ;; decrypt_transport: split the leading 12-byte nonce back off the frame and ;; AEAD-open the remainder. (Some plaintext) on success, None on a bad tag. + ;; A frame shorter than the 12-byte nonce plus the 16-byte GCM tag (28 bytes) + ;; cannot hold even an empty plaintext, so reject it up front (None) instead + ;; of letting bytevector-copy / aes-256-gcm-open panic on the short input. (def (psk-transport-open (transport-key : Bytes) (sealed : Bytes)) : (Option Bytes) - (aes-256-gcm-open transport-key - (bytevector-copy sealed 0 12) - (bytevector-copy sealed 12 (bytevector-length sealed)) - (string->utf8 "")))) + (let ((n (bytevector-length sealed))) + (if (< n 28) + (option-none Bytes) + (aes-256-gcm-open transport-key + (bytevector-copy sealed 0 12) + (bytevector-copy sealed 12 n) + (string->utf8 ""))))))