jsecmon: port monitor::dns_sniffer wire parser + dedup as untyped layer
Jaime Fournier
ad2b5648b98408cd8666548ddd4505013638e8f8
--- 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 buffer-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 dns-sniffer-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)" @@ -108,6 +108,12 @@ yaml-rules-check: buffer-check: $(SCHEME) --libdirs $(LIBDIRS) --script examples/buffer_check.ss +# DNS wire-format parser (QNAME + compression pointers, QTYPE, answer RRs) and +# the dedup state machine, from secmon src/monitor/dns_sniffer.rs. Pure byte +# parsing — no socket, no native lib — so prelude only. +dns-sniffer-check: + $(SCHEME) --libdirs $(LIBDIRS) --script examples/dns_sniffer_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 @@ -120,6 +126,7 @@ checks: kernels-check $(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 + $(SCHEME) --libdirs $(LIBDIRS) --script examples/dns_sniffer_check.ss clean: rm -rf $(BUILD) --- a/README.md +++ b/README.md @@ -32,6 +32,7 @@ make geoip-check # geoip CSV vectors + geoip-gated impossible_travel detecto 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 dns-sniffer-check # DNS wire-format parser (QNAME/compression/answers) + dedup state make checks # every Jerboa-side check in one shot ``` @@ -91,4 +92,5 @@ then crypto orchestration, then I/O / async / FFI (monitors, server, storage). | `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. | +| `monitor::dns_sniffer` (DNS wire parser + dedup) | `jsecmon/dns-sniffer.ss` | ✅ **untyped layer** — the platform-independent half of secmon's `src/monitor/dns_sniffer.rs`: the DNS wire-format parser (QNAME decoding with compression-pointer chasing capped at 128 steps, QTYPE→string, question + A/AAAA answer-RR extraction) and the 5s dedup / 30s cleanup state machine. Every bounds check is preserved — a truncated/malformed/looping packet yields `#f`, never a bad read. Pure byte parsing → untyped, like geoip. The AF_PACKET raw-socket capture + `/proc` PID lookup stay for the monitor I/O driver. `make dns-sniffer-check` reproduces secmon's parser + dedup tests (+ AAAA, qtype table, pointer-loop/qdcount guards). | | monitors / server / ebpf / dtrace | — | ⏳ I/O+async+FFI, last | new file mode 100644 --- /dev/null +++ b/examples/dns_sniffer_check.ss @@ -0,0 +1,117 @@ +;;; Parity check for (jsecmon dns-sniffer) against secmon's src/monitor/dns_sniffer.rs +;;; tests. Reproduces make_dns_query / make_dns_response and the four parser +;;; tests (query, response-with-A, subdomain, too-short) plus the dedup state +;;; test, then adds an AAAA answer, the QTYPE table, and the malformed-packet +;;; guards (compression-pointer loop, qdcount=0). +;;; +;;; scheme --libdirs "$JERBOA/lib:." --script examples/dns_sniffer_check.ss + +(import (jerboa prelude) + (jsecmon dns-sniffer)) + +(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))))) + +;; ── packet builders (mirror the Rust test helpers) ────────────────────────── +(def (bytes lst) ;; byte-list -> bytevector + (let ((bv (make-bytevector (length lst) 0))) + (let loop ((i 0) (xs lst)) + (if (null? xs) bv + (begin (bytevector-u8-set! bv i (car xs)) (loop (+ i 1) (cdr xs))))))) +(def (str-bytes s) ;; string -> list of utf-8 byte values + (let ((bv (string->utf8 s))) + (map (lambda (i) (bytevector-u8-ref bv i)) (iota (bytevector-length bv))))) +(def (encode-qname name) ;; labels (len+bytes) then root 0 + (append (append-map (lambda (label) + (let ((lb (str-bytes label))) (cons (length lb) lb))) + (string-split name #\.)) + (list 0))) +(def (u16-bytes n) (list (quotient n 256) (modulo n 256))) + +(def (build-query name qtype) + (bytes (append (list #xAB #xCD #x01 #x00 #x00 #x01 #x00 #x00 #x00 #x00 #x00 #x00) + (encode-qname name) (u16-bytes qtype) (list #x00 #x01)))) + +;; Answer name is a compression pointer back to the question at offset 12. +(def (build-response name ip4) + (bytes (append (list #xAB #xCD #x81 #x80 #x00 #x01 #x00 #x01 #x00 #x00 #x00 #x00) + (encode-qname name) + (list #x00 #x01) (list #x00 #x01) ;; QTYPE=A QCLASS=IN + (list #xC0 12) ;; name -> offset 12 + (list #x00 #x01) (list #x00 #x01) ;; TYPE=A CLASS=IN + (list #x00 #x00 #x01 #x2C) (list #x00 #x04) ;; TTL=300 RDLEN=4 + ip4))) +(def (build-response-aaaa name addr16) + (bytes (append (list #xAB #xCD #x81 #x80 #x00 #x01 #x00 #x01 #x00 #x00 #x00 #x00) + (encode-qname name) + (list #x00 #x1C) (list #x00 #x01) ;; QTYPE=AAAA(28) QCLASS=IN + (list #xC0 12) + (list #x00 #x1C) (list #x00 #x01) ;; TYPE=AAAA CLASS=IN + (list #x00 #x00 #x01 #x2C) (list #x00 #x10) ;; TTL RDLEN=16 + addr16))) + +;; ── test_parse_query ───────────────────────────────────────────────────────── +(displayln "parse query (example.com / A):") +(let ((r (parse-dns-payload (build-query "example.com" 1) "8.8.8.8" 12345 #f))) + (check "is captured-dns" (captured-dns? r) #t) + (check " query_name" (captured-dns-query-name r) "example.com") + (check " query_type A" (captured-dns-query-type r) "A") + (check " server_addr" (captured-dns-server-addr r) "8.8.8.8") + (check " local_port" (captured-dns-local-port r) 12345) + (check " no addrs" (captured-dns-response-addrs r) '()) + (check " not response" (captured-dns-is-response r) #f)) + +;; ── test_parse_response_with_a_record ──────────────────────────────────────── +(displayln "parse response with A record:") +(let ((r (parse-dns-payload (build-response "example.com" '(93 184 216 34)) "8.8.8.8" 12345 #t))) + (check " query_name" (captured-dns-query-name r) "example.com") + (check " query_type A" (captured-dns-query-type r) "A") + (check " A addr" (captured-dns-response-addrs r) '("93.184.216.34")) + (check " is response" (captured-dns-is-response r) #t)) + +;; ── test_parse_subdomain (AAAA qtype, multi-label) ─────────────────────────── +(displayln "parse subdomain (AAAA qtype):") +(let ((r (parse-dns-payload (build-query "www.sub.example.com" 28) "1.1.1.1" 54321 #f))) + (check " full name" (captured-dns-query-name r) "www.sub.example.com") + (check " query_type AAAA" (captured-dns-query-type r) "AAAA")) + +;; ── test_too_short ─────────────────────────────────────────────────────────── +(displayln "guards:") +(check "10-byte packet -> #f" (parse-dns-payload (make-bytevector 10 0) "x" 0 #f) #f) +(check "qdcount 0 -> #f" + (parse-dns-payload (bytes (list #xAB #xCD #x01 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00)) + "x" 0 #f) #f) +;; a name that is a pointer to itself must terminate (step cap) and reject. +(check "pointer loop -> #f" + (parse-dns-payload (bytes (append (list #xAB #xCD #x01 #x00 #x00 #x01 #x00 #x00 #x00 #x00 #x00 #x00) + (list #xC0 12))) "x" 0 #f) #f) + +;; ── AAAA answer + QTYPE table ──────────────────────────────────────────────── +(displayln "AAAA answer + qtype table:") +(let ((r (parse-dns-payload + (build-response-aaaa "ipv6.example" '(#x20 #x01 #x0d #xb8 0 0 0 0 0 0 0 0 0 0 0 #x01)) + "8.8.8.8" 53 #t))) + (check " query_type AAAA" (captured-dns-query-type r) "AAAA") + (check " AAAA addr" (captured-dns-response-addrs r) '("2001:db8:0:0:0:0:0:1"))) +(check "qtype 15 -> MX" (dns-type-str 15) "MX") +(check "qtype 12 -> PTR" (dns-type-str 12) "PTR") +(check "qtype 999 -> OTHER"(dns-type-str 999) "OTHER") + +;; ── test_sniffer_state_dedup ───────────────────────────────────────────────── +(displayln "dedup state (5s window):") +(let ((st (make-dns-sniffer "test-host")) + (cap (make-captured-dns "example.com" "A" "8.8.8.8" 12345 '() #f))) + (check "first time emits" (and (dns-sniffer-process st cap 1000) #t) #t) + (check "within 5s deduped" (dns-sniffer-process st cap 2000) #f) + (check "after 5s re-emits" (and (dns-sniffer-process st cap 7000) #t) #t) + (dns-sniffer-cleanup st 40000) ;; >30s since last (7000) -> dropped + (check "cleanup then re-emits" (and (dns-sniffer-process st cap 41000) #t) #t)) + +(newline) +(if (= fails 0) + (displayln "OK: dns-sniffer matches secmon's dns_sniffer.rs behaviour.") + (begin (displayln fails " FAILURES") (exit 1))) new file mode 100644 --- /dev/null +++ b/jsecmon/dns-sniffer.ss @@ -0,0 +1,189 @@ +#!chezscheme +;;; jsecmon DNS sniffer — wire-format parser + dedup state, untyped. +;;; +;;; Port of the platform-independent half of secmon's src/monitor/dns_sniffer.rs: +;;; the DNS wire parser (QNAME decoding with compression pointers, QTYPE +;;; mapping, question + answer-RR extraction) and the dedup/correlation state +;;; machine. The Linux AF_PACKET raw-socket capture and the /proc PID lookup are +;;; OS I/O and live in the (eventual) untyped monitor driver, not here — exactly +;;; secmon's own split (its parser is `#![allow(dead_code)]` cross-platform so +;;; it can be unit-tested without a socket). +;;; +;;; Parsing untrusted network bytes is pure integer/byte work that yields a +;;; structured record, so — like geoip and sigma — it's untyped Jerboa rather +;;; than a single-value typed kernel. Every bounds check from the Rust is +;;; preserved: a malformed or truncated packet yields #f, never a bad read, and +;;; the compression-pointer chase is capped at 128 steps to defeat pointer loops. +;;; +;;; Verified against secmon's dns_sniffer.rs tests in examples/dns_sniffer_check.ss. + +(library (jsecmon dns-sniffer) + (export make-captured-dns captured-dns? + captured-dns-query-name captured-dns-query-type captured-dns-server-addr + captured-dns-local-port captured-dns-response-addrs captured-dns-is-response + parse-dns-name dns-type-str parse-dns-payload + make-dns-sniffer dns-sniffer-state? dns-sniffer-process dns-sniffer-cleanup) + (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?)) + + ;; Parsed DNS info from a captured packet (secmon's CapturedDns). + (defstruct captured-dns (query-name query-type server-addr + local-port response-addrs is-response)) + + ;; ── small byte helpers ─────────────────────────────────────────────────── + (def (u16-be d off) ;; big-endian u16 at off + (+ (* 256 (bytevector-u8-ref d off)) (bytevector-u8-ref d (+ off 1)))) + (def (bv-slice bv start len) ;; fresh bytevector copy of [start,start+len) + (let ((out (make-bytevector len 0))) + (bytevector-copy! bv start out 0 len) + out)) + + ;; ── DNS wire-format parser (platform-independent) ───────────────────────── + ;; Parse a domain name at `pos`; -> (cons name consumed) | #f. `consumed` is + ;; the offset just past the name in the *original* stream (so the caller keeps + ;; reading after a compression pointer, not at the pointer target). + (def (parse-dns-name data pos) + (let ((n (bytevector-length data))) + (let loop ((pos pos) (labels '()) (jumped #f) (end-pos 0) (steps 0)) + (cond + ((or (>= pos n) (> steps 128)) #f) ;; OOB or pointer-loop guard + (else + (let ((len (bytevector-u8-ref data pos))) + (cond + ((= len 0) + (cons (string-join (reverse labels) ".") + (if jumped end-pos (+ pos 1)))) + ((= (bitwise-and len #xC0) #xC0) ;; compression pointer + (if (>= (+ pos 1) n) + #f + (let ((ptr (bitwise-ior + (bitwise-arithmetic-shift-left (bitwise-and len #x3F) 8) + (bytevector-u8-ref data (+ pos 1))))) + (loop ptr labels #t + (if jumped end-pos (+ pos 2)) + (+ steps 1))))) + (else + (let ((p2 (+ pos 1))) + (if (> (+ p2 len) n) + #f + (loop (+ p2 len) + (cons (utf8->string (bv-slice data p2 len)) labels) + jumped end-pos (+ steps 1)))))))))))) + + ;; QTYPE number -> human-readable string (secmon dns_type_str). + (def (dns-type-str qtype) + (cond ((= qtype 1) "A") ((= qtype 2) "NS") ((= qtype 5) "CNAME") + ((= qtype 6) "SOA") ((= qtype 12) "PTR") ((= qtype 15) "MX") + ((= qtype 16) "TXT") ((= qtype 28) "AAAA")((= qtype 33) "SRV") + ((= qtype 255) "ANY")(else "OTHER"))) + + (def (ipv4-str d off) + (str (bytevector-u8-ref d off) "." (bytevector-u8-ref d (+ off 1)) "." + (bytevector-u8-ref d (+ off 2)) "." (bytevector-u8-ref d (+ off 3)))) + (def (ipv6-str d off) ;; 8 colon-joined lowercase-hex groups + (string-join ;; Chez number->string is uppercase; Rust {:x} is lower + (map (lambda (i) (string-downcase (number->string (u16-be d (+ off (* i 2))) 16))) (iota 8)) + ":")) + + ;; Walk up to `count` answer RRs from `apos`, collecting A/AAAA addresses. + ;; Any bounds failure stops the walk (secmon's `break`), keeping what we have. + (def (parse-answers dns apos count) + (let ((n (bytevector-length dns))) + (let loop ((apos apos) (i 0) (acc '())) + (if (>= i count) + (reverse acc) + (let ((nm (parse-dns-name dns apos))) + (if (not nm) + (reverse acc) + (let ((apos (cdr nm))) + (if (> (+ apos 10) n) + (reverse acc) + (let ((rtype (u16-be dns apos)) + (rdlen (u16-be dns (+ apos 8))) + (apos2 (+ apos 10))) + (if (> (+ apos2 rdlen) n) + (reverse acc) + (let ((addr (cond + ((and (= rtype 1) (= rdlen 4)) (ipv4-str dns apos2)) + ((and (= rtype 28) (= rdlen 16)) (ipv6-str dns apos2)) + (else #f)))) + (loop (+ apos2 rdlen) (+ i 1) + (if addr (cons addr acc) acc))))))))))))) + + ;; Parse a DNS payload (everything after the UDP header) -> captured-dns | #f. + (def (parse-dns-payload dns server-addr local-port is-response) + (if (< (bytevector-length dns) 12) + #f + (let ((qr (bitwise-and (bitwise-arithmetic-shift-right (u16-be dns 2) 15) 1)) + (qdcount (u16-be dns 4)) + (ancount (u16-be dns 6))) + (if (= qdcount 0) + #f + (let ((nm (parse-dns-name dns 12))) + (if (not nm) + #f + (let ((query-name (car nm)) (pos (cdr nm))) + (if (> (+ pos 4) (bytevector-length dns)) + #f + (let ((qtype (u16-be dns pos)) + (addrs (if (and (= qr 1) (> ancount 0)) + (parse-answers dns (+ pos 4) (min ancount 32)) + '()))) + (make-captured-dns query-name (dns-type-str qtype) + server-addr local-port + addrs is-response)))))))))) + + ;; ── dedup + correlation state (DnsSnifferState) ──────────────────────────── + ;; recent: dedup-key "name:type" -> (cons timestamp-ms response-addrs). + (defstruct dns-sniffer-state (hostname recent)) + (def (make-dns-sniffer hostname) (make-dns-sniffer-state hostname (make-hash-table))) + + ;; Build the dns_query event (a row-hash, as the rest of jsecmon represents + ;; events). PID/process are #f here — the /proc correlation is Linux I/O, + ;; matching secmon's non-Linux `(None, None)` branch. + (def (dns-query-event hostname captured) + (let ((data (make-hash-table))) + (hash-put! data "query_name" (captured-dns-query-name captured)) + (hash-put! data "query_type" (captured-dns-query-type captured)) + (hash-put! data "response_addrs" (captured-dns-response-addrs captured)) + (hash-put! data "server_addr" (captured-dns-server-addr captured)) + (hash-put! data "pid" #f) + (hash-put! data "process_name" #f) + (let ((ev (make-hash-table))) + (hash-put! ev "host" hostname) + (hash-put! ev "type" "dns_query") + (hash-put! ev "data" data) + ev))) + + ;; Process a captured packet -> event-hash if new, #f if a dup within 5s. + (def (dns-sniffer-process state captured now-ms) + (let* ((key (str (captured-dns-query-name captured) ":" + (captured-dns-query-type captured))) + (recent (dns-sniffer-state-recent state)) + (entry (hash-get recent key))) + (if (and entry (< (- now-ms (car entry)) 5000)) + (begin ;; within window: maybe upgrade addrs, no re-emit + (when (and (captured-dns-is-response captured) + (not (null? (captured-dns-response-addrs captured)))) + (hash-put! recent key (cons (car entry) + (captured-dns-response-addrs captured)))) + #f) + (begin + (hash-put! recent key (cons now-ms (captured-dns-response-addrs captured))) + (dns-query-event (dns-sniffer-state-hostname state) captured))))) + + ;; Drop entries older than 30s (secmon cleanup). + (def (dns-sniffer-cleanup state now-ms) + (let ((recent (dns-sniffer-state-recent state))) + (for-each (lambda (k) + (when (>= (- now-ms (car (hash-get recent k))) 30000) + (hash-remove! recent k))) + (hash-keys recent)))))