jsecmon: port secmon's buffer::ring as untyped (jsecmon buffer)

Jaime Fournier <jaimef@linbsd.org>

ca55b011364c2e00ce376d6b35115d92597141d1

diff --git a/Makefile b/Makefile
index bfe598a..bc95eac 100644
--- a/Makefile
+++ b/Makefile
@@ -8,7 +8,7 @@ SCHEME ?= $(JERBOA)/.chez/bin/scheme
 BUILD  ?= build/rust
 TYPED  := $(wildcard typed/*.ss)
 
-.PHONY: rust test ffi-demo kernels-check triage-check triage-store-check analytics-check detect-check storage-check threats-check geoip-check sigma-check yaml-rules-check checks clean
+.PHONY: rust test ffi-demo kernels-check triage-check triage-store-check analytics-check detect-check storage-check threats-check geoip-check sigma-check yaml-rules-check buffer-check checks clean
 # Combined libdir path so sibling libraries `(jsecmon ...)` resolve to ./jsecmon
 # (a second --libdirs would replace, not append, the jerboa one).
 LIBDIRS := "$(JERBOA)/lib:$(CURDIR)"
@@ -101,6 +101,13 @@ sigma-check:
 yaml-rules-check:
 	$(LOADER_ENV) $(SCHEME) --libdirs $(LIBDIRS) --script examples/yaml_rules_check.ss
 
+# The agent's encrypted event ring buffer (secmon src/buffer/ring.rs): FIFO +
+# monotonic seq + priority eviction + little-endian header codec. Pure
+# orchestration — payload is opaque, encryption is FFI-deferred — so prelude
+# only, no native lib.
+buffer-check:
+	$(SCHEME) --libdirs $(LIBDIRS) --script examples/buffer_check.ss
+
 # Everything that runs through the Jerboa side of the bridge, one shot.
 checks: kernels-check
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/triage_check.ss
@@ -112,6 +119,7 @@ checks: kernels-check
 	$(LOADER_ENV) SECMON_GEOIP_CSV="$(GEOIP_CSV)" $(SCHEME) --libdirs $(LIBDIRS) --script examples/geoip_check.ss
 	$(SCHEME) --libdirs $(LIBDIRS) --script examples/sigma_check.ss
 	$(LOADER_ENV) $(SCHEME) --libdirs $(LIBDIRS) --script examples/yaml_rules_check.ss
+	$(SCHEME) --libdirs $(LIBDIRS) --script examples/buffer_check.ss
 
 clean:
 	rm -rf $(BUILD)
diff --git a/README.md b/README.md
index c407d65..4517056 100644
--- a/README.md
+++ b/README.md
@@ -31,6 +31,7 @@ make threats-check   # SQL-aggregation threat rules vs secmon detection vectors
 make geoip-check     # geoip CSV vectors + geoip-gated impossible_travel detector
 make sigma-check     # Sigma YAML rule importer vs secmon conversion vectors
 make yaml-rules-check # user YAML detection rules (threshold/distinct/sequence/match)
+make buffer-check    # the agent's encrypted event ring buffer (FIFO + priority eviction)
 make checks          # every Jerboa-side check in one shot
 ```
 
@@ -88,4 +89,5 @@ then crypto orchestration, then I/O / async / FFI (monitors, server, storage).
 | `storage` time-window aggregates (frequency_spike, severity_cluster, off_hours, kill_chain) | `jsecmon/threats.ss` | ✅ **untyped layer** — secmon's full `detect_anomalies` family: per-(host,event_type) hour count 3x above its own average, 5+ crit/high on a host /5min, crit/high outside 08:00-18:00 UTC weekday (SQLite `strftime`), and 3+ distinct kill-chain phases /1h. `run-anomaly-detections` is the dispatcher (frequency_spike first, as secmon runs it). `make threats-check` covers each with threshold/negative cases. |
 | `geoip` (CSV GeoIP/ASN, IPv4+IPv6, binary-search range lookup, is_private) | `jsecmon/geoip.ss` | ✅ **untyped layer** — full port of secmon's `src/geoip.rs`: parse `start,end,country,asn,name` CSV rows (v4 + one-`::`-expanding v6), sort-by-start + binary-search lookup, RFC1918/loopback/link-local/multicast/ULA/CGNAT → synthetic `PRIVATE`. Pure parsing + integer math + file read, so untyped. `make geoip-check` runs secmon's geoip vectors. |
 | `storage` impossible_travel | `jsecmon/threats.ss` | ✅ **untyped layer** — geoip-gated (reads `SECMON_GEOIP_CSV`): pair a user's consecutive successful `auth_event`s, fire `high` when the two source IPs resolve to different countries within `SECMON_TRAVEL_GAP_MIN` (default 30). Private IPs are dropped before pairing. `make geoip-check` proves the fire + the gap/same-country/private/cross-user negatives. |
+| `buffer::ring` (StoredEvent ring buffer) | `jsecmon/buffer.ss` | ✅ **untyped layer** — port of secmon's `src/buffer/ring.rs`: the agent's bounded in-memory event ring. FIFO list + monotonic seq numbering, priority eviction (`event_severity_u8` table, drop lowest-severity oldest-first, oldest-critical last), seq/time-range polling, FIFO delivery-ack (`clear_before`), and the little-endian header codec (`seq u64 ∥ ts i64 ∥ sev u8 ∥ payload`). Pure mechanics, so untyped — the one security step, ECIES payload encryption, is FFI-deferred: the caller hands `buffer-store!` opaque ciphertext bytes. `make buffer-check` reproduces secmon's three ring tests (store/seq, priority eviction, FIFO-oldest) + codec round-trip. |
 | monitors / server / ebpf / dtrace | —  | ⏳ I/O+async+FFI, last           |
diff --git a/examples/buffer_check.ss b/examples/buffer_check.ss
new file mode 100644
index 0000000..154581e
--- /dev/null
+++ b/examples/buffer_check.ss
@@ -0,0 +1,107 @@
+;;; Parity check for (jsecmon buffer) against secmon's src/buffer/ring.rs tests.
+;;;
+;;; Reproduces test_store_and_retrieve (seq numbering + get_events_after),
+;;; test_priority_eviction (a critical evicts an info, never the medium), and
+;;; test_buffer_eviction_oldest_when_full (same-severity flood is FIFO). Also
+;;; checks event-severity-u8's priority table and the StoredEvent LE codec.
+;;; The payload is an opaque bytevector here (encryption is the caller's job),
+;;; so we feed synthetic payloads — the buffer never inspects them.
+;;;
+;;;   scheme --libdirs "$JERBOA/lib:." --script examples/buffer_check.ss
+
+(import (jerboa prelude)
+        (jsecmon buffer))
+
+(def fails 0)
+(def (check name got want)
+  (let ((ok (equal? got want)))
+    (unless ok (set! fails (+ fails 1)))
+    (displayln (if ok "  ok   " "  FAIL ") name
+               (if ok "" (str "   got " got " want " want)))))
+(def (pay s) (string->utf8 s))            ;; a stand-in encrypted payload
+
+;; ── event-severity-u8 priority table (ring.rs event_severity_u8) ────────────
+(displayln "event-severity-u8 (eviction priority, not json severity):")
+(check "reverse_shell -> 3"   (event-severity-u8 "reverse_shell") 3)
+(check "log_tampering -> 3"   (event-severity-u8 "log_tampering") 3)
+(check "persistence_event ->3"(event-severity-u8 "persistence_event") 3)
+(check "webshell -> 2"        (event-severity-u8 "webshell") 2)        ;; json-sev critical, evict 2
+(check "setuid_execution -> 2"(event-severity-u8 "setuid_execution") 2)
+(check "selinux_event -> 2"   (event-severity-u8 "selinux_event") 2)
+(check "auth_event -> 1"      (event-severity-u8 "auth_event") 1)
+(check "capability_event -> 1"(event-severity-u8 "capability_event") 1)
+(check "heartbeat -> 0"       (event-severity-u8 "heartbeat") 0)
+(check "ptrace_event -> 0"    (event-severity-u8 "ptrace_event") 0)   ;; json-sev critical, evict 0
+
+;; ── store + retrieve + seq (test_store_and_retrieve) ────────────────────────
+(displayln "store / retrieve / seq:")
+(let ((b (make-buffer 100)))
+  (check "first seq is 0"      (buffer-store! b 100 0 (pay "e0")) 0)
+  (check "after(0) empty"      (buffer-events-after b 0) '())
+  (check "second seq is 1"     (buffer-store! b 200 0 (pay "e1")) 1)
+  (let ((evs (buffer-events-after b 0)))
+    (check "after(0) has 1"    (length evs) 1)
+    (check "  it is seq 1"     (stored-event-seq (car evs)) 1)
+    (check "  ts preserved"    (stored-event-timestamp-ms (car evs)) 200))
+  (check "len is 2"            (buffer-len b) 2)
+  (check "latest-seq is 2"     (buffer-latest-seq b) 2))
+
+;; ── priority eviction (test_priority_eviction) ──────────────────────────────
+(displayln "priority eviction (critical evicts info, keeps medium):")
+(let ((b (make-buffer 3)))
+  (buffer-store! b 1 0 (pay "i0"))         ;; info
+  (buffer-store! b 2 0 (pay "i1"))         ;; info
+  (buffer-store! b 3 1 (pay "m0"))         ;; medium
+  (check "full at 3" (buffer-len b) 3)
+  (buffer-store! b 4 3 (pay "c0"))         ;; critical -> must evict an info
+  (check "still 3" (buffer-len b) 3)
+  (let ((sevs (map stored-event-severity (buffer-events-after b -1))))
+    (check "  a critical remains" (and (member 3 sevs) #t) #t)
+    (check "  the medium remains" (and (member 1 sevs) #t) #t)
+    (check "  one info evicted"   (length (filter (lambda (s) (= s 0)) sevs)) 1)))
+
+;; ── FIFO eviction when all equal severity (test_buffer_eviction_oldest...) ──
+(displayln "oldest-out FIFO when severities equal:")
+(let ((b (make-buffer 3)))
+  (dotimes (i 5) (buffer-store! b i 0 (pay (str "e" i))))
+  (check "capped at 3" (buffer-len b) 3)
+  (let ((evs (buffer-events-after b -1)))
+    (check "  3 survive"      (length evs) 3)
+    (check "  oldest is seq 2" (stored-event-seq (car evs)) 2)
+    (check "  newest is seq 4" (stored-event-seq (list-ref evs 2)) 4)))
+
+;; ── clear-before (FIFO ack) ─────────────────────────────────────────────────
+(displayln "clear-before (delivery ack):")
+(let ((b (make-buffer 100)))
+  (dotimes (i 5) (buffer-store! b i 0 (pay (str "e" i))))   ;; seqs 0..4
+  (buffer-clear-before! b 2)                                 ;; drop seq <= 2
+  (let ((evs (buffer-events-after b -1)))
+    (check "  2 remain"        (length evs) 2)
+    (check "  first now seq 3" (stored-event-seq (car evs)) 3)))
+
+;; ── time-range query ────────────────────────────────────────────────────────
+(displayln "time-range query:")
+(let ((b (make-buffer 100)))
+  (buffer-store! b 100 0 (pay "a"))
+  (buffer-store! b 200 0 (pay "b"))
+  (buffer-store! b 300 0 (pay "c"))
+  (check "range [150,250] -> 1" (length (buffer-events-in-range b 150 250)) 1)
+  (check "range [100,300] -> 3" (length (buffer-events-in-range b 100 300)) 3))
+
+;; ── StoredEvent LE codec round-trip (to_bytes / from_bytes) ─────────────────
+(displayln "header codec round-trip:")
+(let* ((se (make-stored-event 258 -5 3 (pay "payload-bytes")))
+       (bytes (stored-event->bytes se))
+       (back (bytes->stored-event bytes)))
+  (check "encodes 17 + payload" (bytevector-length bytes) (+ 17 (bytevector-length (pay "payload-bytes"))))
+  (check "decodes ok"    (ok? back) #t)
+  (check "  seq"         (stored-event-seq (unwrap back)) 258)
+  (check "  ts (signed)" (stored-event-timestamp-ms (unwrap back)) -5)
+  (check "  severity"    (stored-event-severity (unwrap back)) 3)
+  (check "  payload"     (utf8->string (stored-event-payload (unwrap back))) "payload-bytes"))
+(check "short data -> err" (err? (bytes->stored-event (make-bytevector 5 0))) #t)
+
+(newline)
+(if (= fails 0)
+    (displayln "OK: buffer matches secmon's ring.rs behaviour.")
+    (begin (displayln fails " FAILURES") (exit 1)))
diff --git a/jsecmon/buffer.ss b/jsecmon/buffer.ss
new file mode 100644
index 0000000..25c352d
--- /dev/null
+++ b/jsecmon/buffer.ss
@@ -0,0 +1,134 @@
+#!chezscheme
+;;; jsecmon buffer — the agent's encrypted event ring buffer, untyped orchestration.
+;;;
+;;; Port of secmon's src/buffer/ring.rs. The agent buffers events in memory
+;;; before delivery; each event is encrypted on insertion (the agent holds only
+;;; the collector's public key and cannot read events back) and the buffer is
+;;; bounded with priority-aware eviction so a flood of low-value events can't
+;;; push out a critical one.
+;;;
+;;; The buffer's *mechanics* are pure orchestration: a FIFO of StoredEvent
+;;; {seq, timestamp_ms, severity, payload}, monotonic sequence numbering,
+;;; priority eviction (drop the lowest-severity event, oldest-critical last),
+;;; seq/time-range polling, and a little-endian header codec. That all lives
+;;; here, untyped. The one security-critical step — ECIES encryption of the
+;;; payload — is NOT done here: the caller encrypts via the vetted crypto FFI
+;;; kernel and hands `buffer-store!` the ciphertext bytes, exactly the
+;;; typed/untyped split the rest of jsecmon follows. So `payload` is an opaque
+;;; bytevector to this module.
+;;;
+;;; Verified against secmon's ring.rs behaviour (priority + FIFO eviction,
+;;; seq polling, header round-trip) in examples/buffer_check.ss.
+
+(library (jsecmon buffer)
+  (export stored-event? make-stored-event
+          stored-event-seq stored-event-timestamp-ms stored-event-severity stored-event-payload
+          event-severity-u8
+          stored-event->bytes bytes->stored-event
+          make-buffer ebuffer?
+          buffer-store! buffer-events-after buffer-events-in-range
+          buffer-len buffer-empty? buffer-latest-seq buffer-clear-before!)
+  (import (except (chezscheme)
+                  make-hash-table hash-table?
+                  sort sort!
+                  printf fprintf
+                  path-extension path-absolute?
+                  with-input-from-string with-output-to-string
+                  iota 1+ 1-
+                  partition
+                  make-date make-time)
+          (except (jerboa prelude) meta atom?))
+
+  ;; A buffered event. payload is an opaque (already-encrypted) bytevector.
+  (defstruct stored-event (seq timestamp-ms severity payload))
+  ;; The buffer: events is a FIFO list (oldest first); seq is the next number.
+  (defstruct ebuffer (events max-size seq))
+
+  ;; defstruct gives the raw 3-arg make-ebuffer; the public ctor takes just the cap.
+  (def (make-buffer max-size) (make-ebuffer '() max-size 0))
+
+  ;; ── priority from event type (mirrors ring.rs event_severity_u8) ─────────────
+  ;; NB: this is the eviction priority 0..3, which is its OWN table — not the
+  ;; severity *string* emitted in the event JSON (e.g. webshell is json-severity
+  ;; "critical" but eviction-priority 2). Keyed by secmon's event_type tags.
+  (def *sev3* '("reverse_shell" "log_tampering" "persistence_event"))
+  (def *sev2* '("suspicious_exec" "suspicious_connection" "suspicious_file_change"
+                "webshell" "lateral_movement" "kernel_module" "setuid_execution"
+                "container_event" "selinux_event"))
+  (def *sev1* '("auth_event" "scheduled_task_change" "capability_change" "capability_event"))
+  (def (event-severity-u8 event-type)
+    (cond ((member event-type *sev3*) 3)
+          ((member event-type *sev2*) 2)
+          ((member event-type *sev1*) 1)
+          (else 0)))
+
+  ;; ── little-endian header codec (StoredEvent::to_bytes / from_bytes) ──────────
+  ;; layout: seq u64 LE | timestamp_ms i64 LE | severity u8 | payload bytes…
+  (def (stored-event->bytes se)
+    (let* ((pay (stored-event-payload se))
+           (plen (bytevector-length pay))
+           (out (make-bytevector (+ 17 plen) 0)))
+      (bytevector-u64-set! out 0 (stored-event-seq se) (endianness little))
+      (bytevector-s64-set! out 8 (stored-event-timestamp-ms se) (endianness little))
+      (bytevector-u8-set! out 16 (stored-event-severity se))
+      (bytevector-copy! pay 0 out 17 plen)
+      out))
+
+  (def (bytes->stored-event data)            ;; -> (ok stored-event) | (err reason)
+    (let ((n (bytevector-length data)))
+      (if (< n 17)
+          (err "data too short")
+          (let* ((plen (- n 17))
+                 (pay (make-bytevector plen 0)))
+            (bytevector-copy! data 17 pay 0 plen)
+            (ok (make-stored-event
+                  (bytevector-u64-ref data 0 (endianness little))
+                  (bytevector-s64-ref data 8 (endianness little))
+                  (bytevector-u8-ref data 16)
+                  pay))))))
+
+  ;; ── eviction ─────────────────────────────────────────────────────────────────
+  ;; Drop the first (oldest) event of the lowest present severity; if none below
+  ;; critical, drop the oldest (front). Returns the trimmed list.
+  (def (remove-first pred lst)
+    (let loop ((xs lst) (acc '()))
+      (cond ((null? xs) (reverse acc))                       ;; not found: unchanged
+            ((pred (car xs)) (append (reverse acc) (cdr xs)))
+            (else (loop (cdr xs) (cons (car xs) acc))))))
+  (def (evict-lowest-priority lst)
+    (let loop ((target 0))
+      (cond ((>= target 3) (if (null? lst) lst (cdr lst)))   ;; pop_front (oldest critical)
+            ((find (lambda (e) (= (stored-event-severity e) target)) lst)
+             (remove-first (lambda (e) (= (stored-event-severity e) target)) lst))
+            (else (loop (+ target 1))))))
+
+  ;; ── store / poll / clear ─────────────────────────────────────────────────────
+  (def (buffer-store! buf timestamp-ms severity payload)   ;; -> assigned seq
+    (let ((seq (ebuffer-seq buf)))
+      (ebuffer-seq-set! buf (+ seq 1))
+      (let ((se (make-stored-event seq timestamp-ms severity payload))
+            (evicted (let loop ((evs (ebuffer-events buf)))
+                       (if (>= (length evs) (ebuffer-max-size buf))
+                           (loop (evict-lowest-priority evs))
+                           evs))))
+        (ebuffer-events-set! buf (append evicted (list se)))
+        seq)))
+
+  (def (buffer-events-after buf after-seq)
+    (filter (lambda (e) (> (stored-event-seq e) after-seq)) (ebuffer-events buf)))
+
+  (def (buffer-events-in-range buf start-ms end-ms)
+    (filter (lambda (e) (and (>= (stored-event-timestamp-ms e) start-ms)
+                             (<= (stored-event-timestamp-ms e) end-ms)))
+            (ebuffer-events buf)))
+
+  (def (buffer-len buf) (length (ebuffer-events buf)))
+  (def (buffer-empty? buf) (= (buffer-len buf) 0))
+  (def (buffer-latest-seq buf) (ebuffer-seq buf))
+
+  ;; Drop every front event with seq <= the delivered seq (FIFO ack).
+  (def (buffer-clear-before! buf seq)
+    (let loop ((evs (ebuffer-events buf)))
+      (if (and (pair? evs) (<= (stored-event-seq (car evs)) seq))
+          (loop (cdr evs))
+          (ebuffer-events-set! buf evs)))))