sigma: port secmon's Sigma YAML rule importer (untyped layer)
Jaime Fournier <jaimef@linbsd.org>
d690cc90d1be57e8cf3485ff5a3a8f727f783bc0
diff --git a/Makefile b/Makefile
index 8c0183e..7c1039d 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 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 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)"
@@ -90,6 +90,12 @@ geoip-check: rust
cd $(BUILD) && cargo build --release
$(LOADER_ENV) SECMON_GEOIP_CSV="$(GEOIP_CSV)" $(SCHEME) --libdirs $(LIBDIRS) --script examples/geoip_check.ss
+# Sigma rule importer: translate Sigma YAML into secmon's YamlRule schema,
+# checked against secmon's src/sigma.rs conversion vectors. Pure YAML+strings,
+# no native lib needed.
+sigma-check:
+ $(SCHEME) --libdirs $(LIBDIRS) --script examples/sigma_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
@@ -99,6 +105,7 @@ checks: kernels-check
$(LOADER_ENV) $(SCHEME) --libdirs $(LIBDIRS) --script examples/threats_check.ss
$(LOADER_ENV) $(SCHEME) --libdirs $(LIBDIRS) --script examples/triage_store_check.ss
$(LOADER_ENV) SECMON_GEOIP_CSV="$(GEOIP_CSV)" $(SCHEME) --libdirs $(LIBDIRS) --script examples/geoip_check.ss
+ $(SCHEME) --libdirs $(LIBDIRS) --script examples/sigma_check.ss
clean:
rm -rf $(BUILD)
diff --git a/README.md b/README.md
index 7d58b48..8060f2e 100644
--- a/README.md
+++ b/README.md
@@ -29,6 +29,7 @@ make detect-check # full pipeline: events -> detect -> analytics (all kernels
make storage-check # SQLite round-trip: store -> query -> detect -> analytics
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 checks # every Jerboa-side check in one shot
```
@@ -74,7 +75,7 @@ then crypto orchestration, then I/O / async / FFI (monitors, server, storage).
| `triage` classifiers | `typed/triage.ss` | ✅ pure predicates (transient-unit?, phantom-rootkit-race?); vectors pass |
| `triage` engine (rules + dispatch) | `jsecmon/triage.ss` | ✅ **untyped layer** — all 18 false-positive rules + first-match engine, in secmon's exact RULES order, dispatch in ordinary Jerboa delegating byte/string classification to the typed kernels; 40 triage vectors pass (`make triage-check`), incl. the security-relevant negatives (non-sshd reading host keys, systemd impersonated from /tmp, unknown daemon reading passwd). |
| `triage::compute_triaged_ids` (triage-aware mode) | `jsecmon/triage-store.ss` | ✅ **untyped layer** — the bridge above storage+triage: query every in-scope event, triage each, return the sorted benign/expected ID set to drop into a filter's `exclude_event_ids`. `make triage-store-check` proves the round-trip — detection then sees only the real attacks. |
-| `sigma` | — | ⏳ YAML import — I/O, untyped layer |
+| `sigma` (Sigma rule importer) | `jsecmon/sigma.ss` | ✅ **untyped layer** — port of secmon's `src/sigma.rs`: parse a Sigma YAML rule (via `(std text yaml)`), map `logsource.category` → event_type, translate the BTreeMap-first selection's fields (`Field` → json_eq, `Field\|contains/startswith/endswith/re` → data_contains, Windows field names aliased to Linux JSON paths), `level` → severity, `attack.tNNNN` tags → ATT&CK IDs, and render secmon's `YamlRule` YAML back out. `make sigma-check` reproduces secmon's four conversion vectors (process_creation, network_connection, unsupported-category skip, safe-name). Pure YAML+strings, untyped. |
| `psk::constant_time_eq` | `typed/psk.ss` | ✅ ported, vectors pass |
| `psk::from_hex` (hex codec) | `typed/psk.ss` | ✅ hex encode + decode + 32-byte precondition; vectors pass (decode∘encode identity over all 256 byte values) |
| `psk` HKDF/SHA256/AES-GCM | — | ⏳ FFI-delegated to vetted crates (not reimplemented) |
diff --git a/examples/sigma_check.ss b/examples/sigma_check.ss
new file mode 100644
index 0000000..8617663
--- /dev/null
+++ b/examples/sigma_check.ss
@@ -0,0 +1,121 @@
+;;; Parity check for (jsecmon sigma) against secmon's src/sigma.rs #[test] vectors.
+;;;
+;;; Reproduces converts_simple_process_creation, converts_network_connection,
+;;; skips_unsupported_category, and safe_name_alphanumeric. The first two assert
+;;; on substrings of the rendered YamlRule text (exactly what the Rust tests
+;;; check); the third asserts the unsupported category is rejected; the fourth
+;;; checks the safe-name shape through the converted rule's name.
+;;;
+;;; scheme --libdirs "$JERBOA/lib:." --script examples/sigma_check.ss
+
+(import (jerboa prelude)
+ (jsecmon sigma))
+
+(def nl (string #\newline))
+(def (lines . xs) (apply string-append (map (lambda (s) (string-append s nl)) xs)))
+
+(def fails 0)
+(def (check name ok) (unless ok (set! fails (+ fails 1)))
+ (displayln (if ok " ok " " FAIL ") name))
+(def (has? hay sub) (and (string-contains hay sub) #t))
+
+;; ── converts_simple_process_creation ─────────────────────────────────────────
+(def proc-sigma
+ (lines
+ "title: Suspicious Wget Pipe to Shell"
+ "id: aaaa-bbbb"
+ "description: |"
+ " Detects wget piped to a shell."
+ "level: high"
+ "tags:"
+ " - attack.t1059"
+ " - attack.t1105"
+ "logsource:"
+ " category: process_creation"
+ " product: linux"
+ "detection:"
+ " selection:"
+ " Image|endswith: '/wget'"
+ " CommandLine|contains: '| sh'"
+ " condition: selection"))
+
+(displayln "sigma parity (secmon src/sigma.rs vectors):")
+(let ((r (convert-sigma-rule proc-sigma)))
+ (check "process_creation converts" (ok? r))
+ (when (ok? r)
+ (let* ((rec (unwrap r)) (y (imported-rule-yaml rec)) (n (imported-rule-name rec)))
+ (check " name starts sigma_" (string-prefix? "sigma_" n))
+ (check " name has suspicious" (has? n "suspicious"))
+ (check " name no space" (not (string-contains n " ")))
+ (check " event_type process_start"(has? y "event_type: process_start"))
+ (check " data_contains present" (has? y "data_contains"))
+ (check " exe endswith /wget" (has? y "\"$.exe\": \"/wget\""))
+ (check " cmdline contains | sh" (has? y "\"$.cmdline\": \"| sh\""))
+ (check " severity high" (has? y "severity: high"))
+ (check " attack T1059" (has? y "T1059"))
+ (check " attack T1105" (has? y "T1105")))))
+
+;; ── converts_network_connection ──────────────────────────────────────────────
+(def net-sigma
+ (lines
+ "title: Reverse Shell to High Port"
+ "level: critical"
+ "logsource:"
+ " category: network_connection"
+ " product: linux"
+ "detection:"
+ " selection:"
+ " DestinationPort: 4444"
+ " condition: selection"))
+
+(let ((r (convert-sigma-rule net-sigma)))
+ (check "network_connection converts" (ok? r))
+ (when (ok? r)
+ (let ((y (imported-rule-yaml (unwrap r))))
+ (check " event_type network_connection" (has? y "event_type: network_connection"))
+ (check " remote_port path" (has? y "$.remote_port"))
+ (check " port 4444" (has? y "4444"))
+ (check " port is bare number (json_eq)" (has? y "\"$.remote_port\": 4444"))
+ (check " severity critical" (has? y "severity: critical")))))
+
+;; ── skips_unsupported_category ───────────────────────────────────────────────
+(def win-sigma
+ (lines
+ "title: Windows Eventlog Cleared"
+ "level: high"
+ "logsource:"
+ " category: windows_eventlog_clear"
+ "detection:"
+ " selection:"
+ " EventID: 1102"
+ " condition: selection"))
+
+(check "unsupported category -> err" (err? (convert-sigma-rule win-sigma)))
+
+;; ── safe_name_alphanumeric (via convert: title with punctuation) ─────────────
+(def bang-sigma
+ (lines
+ "title: Suspicious Wget Pipe to Shell!"
+ "id: abcdef12345"
+ "level: high"
+ "logsource:"
+ " category: process_creation"
+ "detection:"
+ " selection:"
+ " Image|endswith: '/wget'"
+ " condition: selection"))
+
+(let ((r (convert-sigma-rule bang-sigma)))
+ (check "punct title converts" (ok? r))
+ (when (ok? r)
+ (let ((n (imported-rule-name (unwrap r))))
+ (check " safe-name starts sigma_" (string-prefix? "sigma_" n))
+ (check " safe-name has suspicious" (has? n "suspicious"))
+ (check " safe-name no bang" (not (string-contains n "!")))
+ (check " safe-name no space" (not (string-contains n " ")))
+ (check " id suffix first-8" (string-suffix? "abcdef12" n)))))
+
+(newline)
+(if (= fails 0)
+ (displayln "OK: sigma importer matches secmon's vectors.")
+ (begin (displayln fails " FAILURES") (exit 1)))
diff --git a/jsecmon/sigma.ss b/jsecmon/sigma.ss
new file mode 100644
index 0000000..8af8ad7
--- /dev/null
+++ b/jsecmon/sigma.ss
@@ -0,0 +1,280 @@
+#!chezscheme
+;;; jsecmon sigma — Sigma rule importer, untyped orchestration.
+;;;
+;;; Port of secmon's src/sigma.rs. Sigma (https://github.com/SigmaHQ/sigma) is
+;;; the de-facto YAML format for SIEM detection rules; importing it lets the
+;;; analyzer reuse thousands of community rules. We read a Sigma rule and
+;;; translate the common shapes (process_creation, network_connection,
+;;; dns_query, file_event/file_change) into secmon's own `YamlRule` schema,
+;;; rendered back out as YAML text ready to drop in a --rules dir.
+;;;
+;;; The conversion is intentionally lossy and matches secmon's choices exactly:
+;;; - logsource.category -> our event_type (unsupported categories are skipped)
+;;; - one detection selection (the BTreeMap-first map-valued, non-`condition`
+;;; key); multi-selection boolean conditions are NOT interpreted
+;;; - `Field` -> json_eq (equality); `Field|contains/startswith/endswith/re`
+;;; -> data_contains (substring); Windows field names aliased to Linux paths
+;;; - level -> severity (informational/low collapse to info)
+;;; - tags `attack.tNNNN` -> ATT&CK technique IDs
+;;;
+;;; Pure YAML parse + field mapping + string building, so it stays untyped.
+;;; `yaml-load-string` from (std text yaml) already returns native scheme data:
+;;; a mapping is an alist with string keys, a sequence is a plain list, a scalar
+;;; is a number/string/bool. Verified against secmon's own sigma test vectors in
+;;; examples/sigma_check.ss.
+
+(library (jsecmon sigma)
+ (export imported-rule? imported-rule-yaml imported-rule-name
+ convert-sigma-rule)
+ (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?)
+ (std text yaml))
+
+ ;; convert-sigma-rule returns (ok imported-rule) | (err "reason").
+ (defstruct imported-rule (yaml name))
+
+ ;; ── alist helpers over yaml-load-string output ──────────────────────────────
+ ;; A mapping is an alist of (string . val); a sub-mapping/sequence value is a
+ ;; list. Tell a mapping value (list whose first item is a string-keyed pair)
+ ;; apart from a sequence value (list of scalars).
+ (def (mapping-value? v)
+ (and (pair? v) (pair? (car v)) (string? (caar v))))
+
+ (def (m-ref m key)
+ (let ((e (and (pair? m) (assoc key m)))) (and e (cdr e))))
+
+ ;; A Sigma selection value may be a sequence (OR); secmon takes the first
+ ;; element. A scalar is used as-is. A nested mapping yields a pair here and is
+ ;; later rejected by the string? guard (matches Rust's as_str() == None).
+ (def (entry-scalar v)
+ (if (and (pair? v) (not (null? v))) (car v) v))
+
+ (def (char-index s ch)
+ (let ((n (string-length s)))
+ (let loop ((i 0))
+ (cond ((>= i n) #f)
+ ((char=? (string-ref s i) ch) i)
+ (else (loop (+ i 1)))))))
+
+ (def (trim-leading-char s ch)
+ (let ((n (string-length s)))
+ (let loop ((i 0))
+ (if (and (< i n) (char=? (string-ref s i) ch)) (loop (+ i 1))
+ (substring s i n)))))
+
+ ;; ── field mapping (mirrors Rust's map_sigma_field) ──────────────────────────
+ ;; Sigma field (lowercased) + event_type -> JSON path in the event `data`
+ ;; column, or the sentinel "process_name_column" for the top-level column, or
+ ;; #f for an unknown field (skipped silently).
+ (def (map-sigma-field field event-type)
+ (let ((f (string-downcase field)))
+ (cond
+ ((string=? event-type "process_start")
+ (cond ((string=? f "image") "$.exe")
+ ((string=? f "originalfilename") "$.exe")
+ ((string=? f "processname") "process_name_column")
+ ((string=? f "commandline") "$.cmdline")
+ ((string=? f "parentimage") "$.parent_exe")
+ ((string=? f "parentcommandline") "$.parent_cmdline")
+ ((string=? f "user") "$.user")
+ ((string=? f "currentdirectory") "$.cwd")
+ (else #f)))
+ ((string=? event-type "network_connection")
+ (cond ((string=? f "destinationip") "$.remote_addr")
+ ((string=? f "destinationport") "$.remote_port")
+ ((string=? f "destinationhostname") "$.remote_host")
+ ((string=? f "sourceip") "$.local_addr")
+ ((string=? f "sourceport") "$.local_port")
+ ((string=? f "image") "$.exe")
+ ((string=? f "user") "$.user")
+ ((string=? f "initiated") "$.direction")
+ (else #f)))
+ ((string=? event-type "dns_query")
+ (cond ((string=? f "query") "$.query_name")
+ ((string=? f "queryname") "$.query_name")
+ ((string=? f "querytype") "$.query_type")
+ ((string=? f "image") "$.exe")
+ ((string=? f "answer") "$.response_addrs")
+ (else #f)))
+ ((string=? event-type "file_change")
+ (cond ((string=? f "targetfilename") "$.path")
+ ((string=? f "filename") "$.path")
+ ((string=? f "image") "$.exe")
+ ((string=? f "user") "$.user")
+ ((string=? f "newhash") "$.new_hash")
+ ((string=? f "hash") "$.new_hash")
+ (else #f)))
+ (else #f))))
+
+ ;; ── safe name + YAML escaping ───────────────────────────────────────────────
+ ;; Title -> [a-z0-9_] with runs of '_' collapsed and trimmed, capped at 60,
+ ;; then "sigma_<name>" (plus first 8 chars of the rule id if present).
+ (def (make-safe-name title id)
+ (let* ((lowered (list->string
+ (map (lambda (c)
+ (if (or (char-alphabetic? c) (char-numeric? c))
+ (char-downcase c) #\_))
+ (string->list title))))
+ (collapsed (let loop ((cs (string->list lowered)) (acc '()))
+ (cond ((null? cs) (list->string (reverse acc)))
+ ((and (char=? (car cs) #\_) (pair? acc) (char=? (car acc) #\_))
+ (loop (cdr cs) acc))
+ (else (loop (cdr cs) (cons (car cs) acc))))))
+ (trimmed (let ((s (string-trim collapsed)))
+ ;; string-trim drops spaces; here trim leading/trailing '_'
+ (let* ((a (trim-leading-char collapsed #\_))
+ (ra (list->string (reverse (string->list a))))
+ (rb (trim-leading-char ra #\_)))
+ (list->string (reverse (string->list rb))))))
+ (capped (if (> (string-length trimmed) 60) (substring trimmed 0 60) trimmed)))
+ (if (and id (string? id) (> (string-length id) 0))
+ (str "sigma_" capped "_" (substring id 0 (min 8 (string-length id))))
+ (str "sigma_" capped))))
+
+ ;; Always-double-quote a scalar (matches Rust's yaml_escape / {:?}).
+ (def (yaml-escape s)
+ (if (string=? s "")
+ "\"\""
+ (let ((out (open-output-string)))
+ (write-char #\" out)
+ (for-each (lambda (c)
+ (cond ((char=? c #\") (display "\\\"" out))
+ ((char=? c #\\) (display "\\\\" out))
+ ((char=? c #\newline) (display "\\n" out))
+ ((char=? c #\return) (display "\\r" out))
+ ((char=? c #\tab) (display "\\t" out))
+ (else (write-char c out))))
+ (string->list s))
+ (write-char #\" out)
+ (get-output-string out))))
+
+ (def (yaml-value-inline v)
+ (cond ((eq? v #t) "true")
+ ((eq? v #f) "false")
+ ((number? v) (number->string v))
+ ((string? v) (yaml-escape v))
+ ((null? v) "null")
+ (else (yaml-escape (format "~a" v)))))
+
+ ;; ── tags -> ATT&CK technique IDs ────────────────────────────────────────────
+ (def (tag->technique t)
+ (and (string? t) (string-prefix? "attack." t)
+ (let ((rest (substring t 7 (string-length t))))
+ (and (> (string-length rest) 0)
+ (let ((c0 (string-ref rest 0)))
+ (and (or (char=? c0 #\t) (char=? c0 #\T))
+ (str "T" (string-upcase
+ (trim-leading-char (trim-leading-char rest #\t) #\T)))))))))
+
+ ;; ── selection extraction ────────────────────────────────────────────────────
+ ;; Map-valued, non-`condition` keys, sorted by name (Rust's BTreeMap order);
+ ;; returns the list of (name . selection-map) candidates.
+ (def (detection-selections detection)
+ (let ((cands (filter (lambda (e)
+ (and (pair? e) (string? (car e))
+ (not (string=? (car e) "condition"))
+ (mapping-value? (cdr e))))
+ detection)))
+ (list-sort (lambda (a b) (string<? (car a) (car b))) cands)))
+
+ ;; ── main conversion ─────────────────────────────────────────────────────────
+ (def (convert-sigma-rule yaml-text)
+ (let ((parsed (try (yaml-load-string yaml-text) (catch (e) #f))))
+ (cond
+ ((not (mapping-value? parsed)) (err "parse: not a yaml mapping"))
+ (else
+ (let ((title (m-ref parsed "title"))
+ (logsource (m-ref parsed "logsource"))
+ (detection (m-ref parsed "detection")))
+ (cond
+ ((not (string? title)) (err "parse: missing title"))
+ ((not (mapping-value? logsource)) (err "parse: missing logsource"))
+ ((not (mapping-value? detection)) (err "parse: missing detection"))
+ (else
+ (let* ((category (let ((c (m-ref logsource "category"))) (if (string? c) c "")))
+ (event-type
+ (cond ((string=? category "process_creation") "process_start")
+ ((string=? category "network_connection") "network_connection")
+ ((string=? category "dns_query") "dns_query")
+ ((or (string=? category "file_event") (string=? category "file_change")) "file_change")
+ (else #f))))
+ (if (not event-type)
+ (err (str "unsupported logsource category: '" category "'"))
+ (let ((cands (detection-selections detection)))
+ (if (null? cands)
+ (err "no detection selection")
+ (let* ((sel-map (cdr (car cands)))
+ (je (make-hash-table)) ;; json_eq
+ (dc (make-hash-table)) ;; data_contains
+ (pname (box #f)))
+ (for-each
+ (lambda (entry)
+ (when (and (pair? entry) (string? (car entry)))
+ (let* ((raw-key (car entry))
+ (bar (char-index raw-key #\|))
+ (field (if bar (substring raw-key 0 bar) raw-key))
+ (modifier (and bar (substring raw-key (+ bar 1) (string-length raw-key))))
+ (target (map-sigma-field field event-type)))
+ (when target
+ (let ((scalar (entry-scalar (cdr entry))))
+ (cond
+ ((and modifier (member modifier '("contains" "startswith" "endswith" "re")))
+ (when (string? scalar) (hash-put! dc target scalar)))
+ ((not modifier)
+ (if (string=? target "process_name_column")
+ (when (string? scalar) (set-box! pname scalar))
+ (hash-put! je target scalar)))
+ (else (void)))))))) ;; unsupported modifier: skip
+ sel-map)
+ (if (and (null? (hash->list je)) (null? (hash->list dc)) (not (unbox pname)))
+ (err "no usable fields after mapping")
+ (let* ((level (let ((l (m-ref parsed "level"))) (if (string? l) l "medium")))
+ (severity (cond ((string=? level "critical") "critical")
+ ((string=? level "high") "high")
+ ((string=? level "medium") "medium")
+ (else "info")))
+ (tags (let ((tg (m-ref parsed "tags"))) (if (list? tg) tg '())))
+ (attack (filter-map tag->technique tags))
+ (id (let ((i (m-ref parsed "id"))) (and (string? i) i)))
+ (safe-name (make-safe-name title id))
+ (description
+ (let* ((d (m-ref parsed "description"))
+ (base (if (string? d) d title))
+ (first-line (car (string-split base #\newline))))
+ (string-trim first-line)))
+ (je-sorted (list-sort (lambda (a b) (string<? (car a) (car b))) (hash->list je)))
+ (dc-sorted (list-sort (lambda (a b) (string<? (car a) (car b))) (hash->list dc)))
+ (yaml
+ (with-output-to-string
+ (lambda ()
+ (display (str "name: " safe-name "\n"))
+ (display (str "description: " (yaml-escape description) "\n"))
+ (display (str "severity: " severity "\n"))
+ (when (pair? attack)
+ (display (str "attack: [" (string-join attack ", ") "]\n")))
+ (display "type: match\n")
+ (display "match:\n")
+ (display (str " event_type: " event-type "\n"))
+ (when (unbox pname)
+ (display (str " process_name: " (yaml-escape (unbox pname)) "\n")))
+ (when (pair? je-sorted)
+ (display " json_eq:\n")
+ (for-each (lambda (kv)
+ (display (str " " (yaml-escape (car kv)) ": "
+ (yaml-value-inline (cdr kv)) "\n")))
+ je-sorted))
+ (when (pair? dc-sorted)
+ (display " data_contains:\n")
+ (for-each (lambda (kv)
+ (display (str " " (yaml-escape (car kv)) ": "
+ (yaml-escape (cdr kv)) "\n")))
+ dc-sorted))))))
+ (ok (make-imported-rule yaml safe-name)))))))))))))))))