| (in-package #:nekod.regex)
|
|
|
|
|
|
|
|
|
| (defvar *event-filters* (make-hash-table :test #'equal))
|
| (defvar *compiled-filters* (make-hash-table :test #'equal))
|
|
|
|
|
|
|
| (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"))
|
|
|
|
|
|
|
| (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))))
|
|
|
|
|
|
|
| (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*)))
|
|
|
|
|
|
|
| (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)))
|
|
|
|
|
|
|
| (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)))
|
|
|
