File size: 6,667 Bytes
3b70664 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | (in-package #:nekod.regex)
;;; Socket/container event filtering via compiled DFA
;;; Pipeline: octets -> decode -> canonicalize -> automaton -> classification -> features
(defvar *event-filters* (make-hash-table :test #'equal))
(defvar *compiled-filters* (make-hash-table :test #'equal))
;;; --- Event classes ---
(defparameter *event-class-lifecycle* '("start" "stop" "die" "kill" "pause" "unpause"))
(defparameter *event-class-health* '("healthy" "unhealthy"))
(defparameter *event-class-network* '("connect" "disconnect" "create" "destroy"))
(defparameter *event-class-critical* '("die" "kill" "oom"))
;;; --- Filter registration ---
(defun register-event-filter (name pattern-re)
"Register a named event filter from a regex algebra tree.
Compiles directly to DFA for O(n) matching."
(let ((compiled (compile-regex-to-dfa pattern-re)))
(setf (gethash name *event-filters*) pattern-re)
(setf (gethash name *compiled-filters*) compiled)
name))
(defun filter-event-dfa (event-string filter-name)
"Test event string against compiled DFA filter. O(n) per character."
(let ((dfa (gethash filter-name *compiled-filters*)))
(when dfa
(dfa-run dfa event-string))))
;;; --- Default filter initialization ---
(defun build-union-re (strings)
"Build a union regex from a list of literal strings."
(if (null (cdr strings))
(re-literal (car strings))
(re-union (re-literal (car strings))
(build-union-re (cdr strings)))))
(defun init-default-filters ()
"Initialize compiled DFA filters for all event classes."
(register-event-filter :lifecycle
(build-union-re *event-class-lifecycle*))
(register-event-filter :health
(build-union-re *event-class-health*))
(register-event-filter :network
(build-union-re *event-class-network*))
(register-event-filter :critical
(build-union-re *event-class-critical*)))
;;; --- Event classification pipeline ---
(defstruct event-record
(type "" :type string)
(action "" :type string)
(actor-id "" :type string)
(time 0 :type integer)
(raw "" :type string))
(defun json-extract-string (json key)
"Extract string value for KEY from JSON. Handles escaped quotes and whitespace."
(let* ((key-pattern (format nil "\"~a\"" key))
(key-pos (search key-pattern json)))
(when key-pos
(let ((colon-pos (position #\: json :start (+ key-pos (length key-pattern)))))
(when colon-pos
(let ((val-start (position #\" json :start (1+ colon-pos))))
(when val-start
(let ((i (1+ val-start))
(result (make-array 0 :element-type 'character
:adjustable t :fill-pointer 0)))
(loop
(when (>= i (length json)) (return (coerce result 'string)))
(let ((c (char json i)))
(cond
((char= c #\\)
(incf i)
(when (< i (length json))
(vector-push-extend (char json i) result)))
((char= c #\")
(return (coerce result 'string)))
(t (vector-push-extend c result))))
(incf i))))))))))
(defun json-extract-integer (json key)
"Extract integer value for KEY from JSON."
(let* ((key-pattern (format nil "\"~a\"" key))
(key-pos (search key-pattern json)))
(when key-pos
(let ((colon-pos (position #\: json :start (+ key-pos (length key-pattern)))))
(when colon-pos
(let ((num-start (position-if #'digit-char-p json :start (1+ colon-pos))))
(when num-start
(parse-integer json :start num-start :junk-allowed t))))))))
(defun decode-event-json (json-string)
"Parse Docker event JSON into event-record struct.
Handles nested Actor.ID, handles both Action and status fields."
(make-event-record
:type (or (json-extract-string json-string "Type") "")
:action (or (json-extract-string json-string "Action")
(json-extract-string json-string "status") "")
:actor-id (or (json-extract-string json-string "ID") "")
:time (or (json-extract-integer json-string "time")
(json-extract-integer json-string "timeNano") 0)
:raw json-string))
(defun canonicalize-event (event-record)
"Return the canonical action string for classification."
(event-record-action event-record))
(defun classify-event (event-string)
"Classify a Docker event JSON string.
Returns list of matching event classes as keywords."
(let* ((record (decode-event-json event-string))
(action (canonicalize-event record))
(classes nil))
(when (filter-event-dfa action :lifecycle) (push :lifecycle classes))
(when (filter-event-dfa action :health) (push :health classes))
(when (filter-event-dfa action :network) (push :network classes))
(when (filter-event-dfa action :critical) (push :critical classes))
(values (nreverse classes) record)))
;;; --- Feature vector derivation for MoE routing ---
(defun event-to-feature-vector (event-string)
"Convert event JSON to 8-element routing feature vector.
Indices: 0=is-proof 1=is-auth 2=is-code 3=is-system
4=complexity 5=entropy 6=confidence 7=urgency"
(multiple-value-bind (classes record) (classify-event event-string)
(let ((features (make-array 8 :element-type 'double-float
:initial-element 0.0d0))
(action (event-record-action record)))
(when (member :critical classes)
(setf (aref features 7) 1.0d0))
(when (member :lifecycle classes)
(setf (aref features 3) 1.0d0))
(when (member :network classes)
(setf (aref features 3) 0.8d0))
(when (member :health classes)
(setf (aref features 3) 0.6d0))
(when (or (search "auth" action) (search "login" action))
(setf (aref features 1) 1.0d0))
(when (or (search "verify" action) (search "proof" action))
(setf (aref features 0) 1.0d0))
(setf (aref features 6) 0.9d0)
(let ((action-len (length action)))
(setf (aref features 4) (min 1.0d0 (/ (coerce action-len 'double-float) 50.0d0))))
(let ((unique-chars (length (remove-duplicates (coerce action 'list)))))
(setf (aref features 5) (min 1.0d0 (/ (coerce unique-chars 'double-float) 20.0d0))))
features)))
|