;;;; UC Santa Barbara ArchLab
;;;; String Match Engine RuleCompiler - Release 0.8
;;;;
;;;; Copyright (c) 2005 The Regents of the University of California.
;;;; All Rights Reserved.
;;;;
;;;; Permission to use, copy, modify, and distribute this software and its
;;;; documentation for educational, research and non-profit purposes,
;;;; without fee, and without a written agreement is hereby granted,
;;;; provided that the above copyright notice, this paragraph and the
;;;; following three paragraphs appear in all copies.
;;;;
;;;; Permission to incorporate this software into commercial products may
;;;; be obtained by contacting the University of California. For
;;;; information about obtaining such a license contact:
;;;; Tim Sherwood <sherwood@cs.ucsb.edu>
;;;;
;;;; This software program and documentation are copyrighted by The Regents
;;;; of the University of California. The software program and
;;;; documentation are supplied "as is", without any accompanying services
;;;; from The Regents. The Regents does not warrant that the operation of
;;;; the program will be uninterrupted or error-free. The end-user
;;;; understands that the program was developed for research purposes and
;;;; is advised not to rely exclusively on the program for any reason.
;;;;
;;;; IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY
;;;; FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES,
;;;; INCLUDING LOST PROFITS, ARISING OUT OF THE USE OF THIS SOFTWARE AND
;;;; ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF CALIFORNIA HAS BEEN
;;;; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE UNIVERSITY OF
;;;; CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT
;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;; A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
;;;; BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATIONS TO PROVIDE
;;;; MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

;;;; Ryan Dixon
;;;; 25 Oct 2005
;;;;
;;;; File: sme_RuleCompiler.lisp
;;;;
;;;; A compiler using the algorithms (and architecture) described in:
;;;; "Bit-Split String Matching Engines for Intrusion Detection and Prevention"
;;;;  by Lin Tan, Brett Brotherton, and Timothy Sherwood
;;;;


;;;; Macro syntax helpers
(defmacro until (test &body body)
  "Continue looping until TEST is satisfied."
  `(do ()
       (,test)
     ,@body))


;;;; List processing helpers
(defun flatten (lst)
  "Removes nestings from a list."
  (cond ((atom lst) lst)
	((listp (car lst))
	 (append (flatten (car lst)) (flatten (cdr lst))))
	(t (append (list (car lst)) (flatten (cdr lst))))))


;;;; String generation and comparison functions
;;;; Validate user string input and convert hex numbers (#\Xnn) into
;;;; the appropriate character ASCII codes
(defun hex-char-p (c)
  "Returns T if C is either a digit-char-p or a hexadecimal letter and NIL otherwise"
  (or (digit-char-p c)
      (find (char-downcase c) "abcdef")))
       
(defun hex-string-p (str)
  "Returns T if STR is at least of length 4 and begins with the format \"#\Xhh\"
   where 'X' is the letter X and 'h' is a hex-char-p.  Returns NIL otherwise."
  (if (and (>= (length str) 4)
	   (equal (char str 0) #\#)
	   (equal (char-upcase (char str 1)) #\X)
	   (hex-char-p (char str 2))
	   (hex-char-p (char str 3)))
      (read-from-string (subseq str 0 4))
      nil))

(defun bsglist->string (bsglst)
  "Converts the BSG compatible list of characters to a string."
  (format nil "~{~@[~C~]~}" bsglst))

(defun string->list (str)
  "Converts a string to a list of characters, converting occurrences of
   hex-string-p into characterp"
  (let ((lst nil))
    (do ((i 0 (1+ i)))
	((>= i (length str)) (reverse lst))
      (let ((c (hex-string-p (subseq str i))))
	(if (hex-string-p (subseq str i))
	    (progn
	      (setf lst (cons (code-char c) lst))
	      (setf i (+ i 3)))
	    (setf lst (cons (char str i) lst)))))))


;;;; Structural abstractions responsible for the graphs discussed in the paper
(defstruct (bsm-node (:print-function
		      (lambda (n s d)
			(declare (ignore d))
			(format s "#<BSM Node: ~A>" (bsm-node-elt n)))))
  elt                                         ; a simple node name, usually sequential, starting from 0
  (out       (make-hash-table :test #'equal)) ; a hashtable representing the out-state transitions
  (goal      nil)                             ; boolean representing whether or not this node is an output state
  (state-set nil))                            ; a list corresponding to the bsg-nodes represented by this node

(defun bsm-node-out-k (k node)
  (gethash k (bsm-node-out node)))

(defun (setf bsm-node-out-k) (val k node)
  (setf (gethash k (bsm-node-out node)) val))

(defstruct (bsm-graph)
  (nodes (list (make-bsm-node :elt 0 :state-set '(0)))))

(defun bsm-graph-root (graph)
  (car (bsm-graph-nodes graph)))

(defun next-bsm-index (graph)
  (length (bsm-graph-nodes graph)))


(defstruct (bsg-node (:print-function
		      (lambda (n s d)
			(declare (ignore d))
			(format s "#<BSG Node: ~A>" (bsg-node-elt n)))))
  elt	                     ; a simple node name, usually sequential, starting from 0
  (out   (make-hash-table))  ; a hashtable representing the out-state transitions
  (delta (make-hash-table))  ; a hashtable representing the dfa state transitions
  (output nil)		     ; the actual output of this state (a set)
  (goal   nil)               ; boolean representing whether or not this node is an output state
  (fail nil))                ; failure traversal for the graph


(defstruct (bsg-graph)
  (nodes (list (make-bsg-node :elt 0)))
  (key-chars nil))

(defun bsg-graph-root (graph)
  (car (bsg-graph-nodes graph)))

(defun next-bsg-index (graph)
  "Calculate the current bsg-graph index"
  (length (bsg-graph-nodes graph)))

(defun add-transition (c graph node)
  "Add an out edge to the current graph"
  (setf (gethash c (bsg-node-out graph)) node))

(defun find-transition (c graph &key (ignore-root t))
  "Find the bsg-node found by following the transition 'c', if it exists."
  (let ((val (gethash c (bsg-node-out graph))))
    (if ignore-root
	val
	(if (and (null val) (= (bsg-node-elt graph) 0))
	    graph
	    val))))

(defun find-delta-transition (c graph &key (ignore-root t))
  "Find the bsg-node found by following the transition 'c', if it exists."
  (let ((val (gethash c (bsg-node-delta graph))))
    (if ignore-root
	val
	(if (and (null val) (= (bsg-node-elt graph) 0))
	    graph
	    val))))

(defun bsg-graph-insert (key graph)
  "Inserts KEY keyword into an existing Aho Corasick insertion GRAPH."
  (let ((keyword (string->list key)))
    (setf (bsg-graph-key-chars graph) (remove-duplicates (concatenate 'list keyword (bsg-graph-key-chars graph))))
    (bsg-insert keyword graph (bsg-graph-root graph))))

(defun bsg-insert (obj graph node &optional (output obj))
  "Inserts OBJ keyword into an existing Aho Corasick insertion GRAPH."
  (if (null obj)
      (progn
	(setf (bsg-node-goal node) t)
	(setf (bsg-node-output node) (list (bsglist->string output)))
	graph)
      (let ((transition (find-transition (car obj) node)))
	(if (null transition)
	    (let ((next (make-bsg-node :elt (next-bsg-index graph) :out (make-hash-table :size 15 :rehash-size 8))))
	      (setf (bsg-graph-nodes graph) (nconc (bsg-graph-nodes graph) (list next)))
	      (add-transition (car obj) node next)
	      (bsg-insert (cdr obj) graph next output))
	    (progn
	      (bsg-insert (cdr obj) graph transition output))))))


;;;; Failure Function
(defun create-failure-graph (graph)
  "Computes the failure graph edges for the original Aho Corasick keyword insertion GRAPH."
  (let ((node (bsg-graph-root graph))
	(queue nil))
    (maphash #'(lambda (transition next-node) (declare (ignore transition))
		 (setf queue (union queue (list next-node)))
		 (setf (bsg-node-fail next-node) node))
	     (bsg-node-out node))
    (until (null queue)
      (let ((r (car queue)))
	(setf queue (cdr queue))
	(maphash #'(lambda (a s)
		     (setf queue (append queue (list s)))
		     (let ((state (bsg-node-fail r)))
		       (until (find-transition a state :ignore-root nil)
			 (setf state (bsg-node-fail state)))
		       (setf (bsg-node-fail s) (find-transition a state :ignore-root nil))
		       (setf (bsg-node-output s) (union (bsg-node-output s) (bsg-node-output (bsg-node-fail s))))))
		 (bsg-node-out r))))))


;;;; DFA Construction
(defun create-dfa (graph)
  "Constructs an Aho Corasick DFA when given the original Aho Corasick keyword insertion GRAPH."
  (let ((node (bsg-graph-root graph))
	(queue nil))
    (mapcar #'(lambda (a)
		(setf (gethash a (bsg-node-delta node)) (find-transition a node :ignore-root nil))
		(when (not (eql (find-transition a node :ignore-root nil) node))
		  (setf queue (union queue (list (find-transition a node :ignore-root nil))))))
	    (bsg-graph-key-chars graph))
    (until (null queue)
      (let ((r (car queue)))
	(setf queue (cdr queue))
	(mapcar #'(lambda (a)
		    (let ((s (find-transition a r :ignore-root nil)))
		      (if s
			  (progn
			    (setf queue (append queue (list s)))
			    (setf (gethash a (bsg-node-delta r)) s))
			  (setf (gethash a (bsg-node-delta r)) (find-delta-transition a (bsg-node-fail r))))))
		(bsg-graph-key-chars graph))))))


(defun print-bsg-node (node)
  "Prints detailed information about a specific bsg-node."
  (unless (null node)
    (format t "--------------~%")
    (format t "~A~%" (bsg-node-elt node))
    (maphash #'(lambda (transition next-node)
		 (format t "(~C)->~A~%" transition (bsg-node-elt next-node)))
	     (bsg-node-out node))
    (format t "~%DFA:~%")
    (maphash #'(lambda (transition next-node)
		 (format t "(~C)->~A~%" transition (bsg-node-elt next-node)))
	     (bsg-node-delta node))
    (format t "~%Fail: ~A~%" (when (bsg-node-fail node) (bsg-node-elt (bsg-node-fail node))))
    (format t "Goal:   ~A~%" (bsg-node-goal node))
    (format t "Output: {~{~@[~S~^, ~]~}}~%" (bsg-node-output node))
    (format t "--------------~%")))

(defun print-bsg-graph (graph)
  "Prints detailed information about each bsg-node contained within GRAPH."
  (length (mapcar #'print-bsg-node (bsg-graph-nodes graph))))


(defun dfa-node->dot (node)
  "Prints a DOT-compatible representation of NODE"
  (maphash #'(lambda (transition next-node)
	       (format t "~A -> ~A [label=\"~A\"]~%" (bsg-node-elt node) (bsg-node-elt next-node) transition))
	   (bsg-node-delta node)))

(defun dfa->dot (graph)
  "Prints a DOT-compatible representation of GRAPH"
  (format t "digraph dfa {~%")
  (mapcar #'dfa-node->dot (bsg-graph-nodes graph))
  (format t "}"))

(defun maphashlist (fn hash)
  "Returns a list of the results of FN after applying
   it to every value contained within HASH"
  (let ((lst nil))
    (maphash #'(lambda (k v)
		 (setf lst (cons (funcall fn k v) lst)))
	     hash)
    lst))

(defun collect-transitions (val node pos &optional (bits-per-cycle 1))
  "Returns a list of every transition out of NODE matching VAL.  POS and BITS-PER-CYCLE are
   required to match the specifications of the binary state machine being constructed."
  (flatten (maphashlist #'(lambda (k v)
			    (when (equal (ldb (byte bits-per-cycle (* (- (- (/ 8 bits-per-cycle) 1) pos) bits-per-cycle)) (char-code k)) val)
			      (bsg-node-elt v)))
			(bsg-node-out node))))

(defun collect-every-transition (val graph lst pos &optional (bits-per-cycle 1))
  "Returns a list of every possible transition out of the nodes named in LST
   matching VAL within the specified GRAPH.  POS and BITS-PER-CYCLE are required to match
   the specifications of the binary state machine being constructed."
  (let ((transitions nil))
    (mapcar #'(lambda (node)
		(setf transitions (append transitions (collect-transitions val (elt (bsg-graph-nodes graph) node) pos bits-per-cycle))))
	    lst)
    (sort (flatten (cons '0 transitions)) #'<)))

(defun create-bsm (graph pos &optional (bits-per-cycle 1))
  "Creates the binary state machine graph using the Aho Corasick GRAPH as input.
   POS represents the bit position being evaluated by this binary state machine.
   (Bits positions are zero-indexed and numbered from left to right).
   Altering BITS-PER-CYCLE will compress the binary state machine graph and
   therefore affect the number of binary state machines that must be constructed.
   The default of 1 bit-per-cycle will require the creation of 8 binary state machines."
  (let* ((bsm-graph (make-bsm-graph))
	 (queue     (list (bsm-node-state-set (bsm-graph-root bsm-graph)))))
    (until (null queue)
      (let* ((a            (car queue))
	     (current-node (find a (bsm-graph-nodes bsm-graph)
				 :test #'equal
				 :key #'(lambda (n) (unless (null n) (bsm-node-state-set n))))))
	(dotimes (index (expt 2 bits-per-cycle))
	  (let ((transition (collect-every-transition index graph a pos bits-per-cycle)))
	    (let ((existing-state (find transition (bsm-graph-nodes bsm-graph)
					:test #'equal
					:key #'(lambda (n) (bsm-node-state-set n)))))
	      (if (null existing-state)
		  ;; create a new node and set transition to the new node
		  (progn 
		    (let ((new-node (make-bsm-node :elt (next-bsm-index bsm-graph) :state-set transition)))
		      (setf queue (nconc queue (list transition)))
		      (setf (bsm-node-out-k index current-node) new-node)
		      (setf (bsm-graph-nodes bsm-graph) (nconc (bsm-graph-nodes bsm-graph) (list new-node)))))
		  ;; else, set transition to pre-existing node
		  (setf (bsm-node-out-k index current-node) existing-state))))))

      (setf queue (cdr queue)))   ; remove current node from queue

    ;; compute final state-sets and goal states
    (dolist (bnode (bsm-graph-nodes bsm-graph))
      (setf (bsm-node-state-set bnode)
	    (remove-if-not #'(lambda (state) (bsg-node-goal (elt (bsg-graph-nodes graph) state)))
			   (bsm-node-state-set bnode)))
      (if (bsm-node-state-set bnode)
	  (setf (bsm-node-goal bnode) t)))
    
    ;; return binary state machine graph
    bsm-graph))


(defun print-bsm-node (node)
  "Prints detailed information about a specific bsm-node."
  (unless (null node)
    (format t "--------------~%")
    (format t "~A~%" (bsm-node-elt node))
    (maphash #'(lambda (k v) (format t "(~A)->~A~%" k v))
	     (bsm-node-out node))
    (format t "~%")
    (format t "Goal: ~A~%" (bsm-node-goal node))
    (format t "State Set: {~{~@[~S~^, ~]~}}~%" (bsm-node-state-set node))
    (format t "--------------~%")))

(defun print-bsm-graph (graph)
  "Prints detailed information about each bsm-node contained within GRAPH."
  (length (mapcar #'print-bsm-node (bsm-graph-nodes graph))))

(defun pmv-association (graph)
  "Returns an association list mapping each GRAPH state
   to a bit location in the partial match vector."
  (let ((alst '())
	(index 16))
    (dolist (node (bsg-graph-nodes graph))
      (when (bsg-node-goal node)
	(setf alst (cons (cons (bsg-node-elt node) (decf index)) alst))))
    alst))
	

(defun bsmvector->table (graph bmvector)
  "Prints the 'chip ready' representation of the binary state machine tables."
  (let ((alst (pmv-association graph)))
    (dotimes (index (length bmvector))
      (format t "begin:~A~%" index)
      (format t "state:e0:e1:e2:e3:match_set~%")
      (let ((state -1))
	(mapcar #'(lambda (node)
		    (format t "~3,'0d:" (incf state))
		    (maphash #'(lambda (k v) (declare (ignore k)) (format t "~3,'0d:" (bsm-node-elt v)))
			     (bsm-node-out node))
		    (let ((pmv 0))
		      (mapcar #'(lambda (bg-node-elt)
				  (setf pmv (logior pmv (expt 2 (cdr (assoc bg-node-elt alst))))))
			      (bsm-node-state-set node))
		      (format t "~16,'0B~%" pmv)))
		(bsm-graph-nodes (aref bmvector index)))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  Examples ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; String processing
;;;; (thanks to Paul Graham)
(defun tokens (str test start)
  "Returns a list of tokenized values derived from STR,
   using TEST, and begining from location START"
  (let ((p1 (position-if test str :start start)))
   (if p1
       (let ((p2 (position-if #'(lambda (c) 
                                  (not (funcall test c)))
                              str :start p1)))
         (cons (subseq str p1 p2)
               (if p2 
                   (tokens str test p2) 
                   nil)))
       nil)))


;;;; List processing
(defun list-by-n (lst n)
  "Regroup elements within LST into subgroups of size N.
   The last subgroup will be of size: 1 <= (length subgroup) <= N"
  (let ((grp-lst nil)
	(clone lst))
    (until (null clone)
      (let ((group nil))
	(dotimes (index n)
	  (when (consp clone)
	    (setf group (cons (car clone) group)))
	  (setf clone (cdr clone)))
	(setf grp-lst (cons (reverse group) grp-lst))))
    (reverse grp-lst)))


;;; Check if the character is both a printable character and NOT a colon
(defun valid-char (object)
  "Return T if OBJECT is both a printable character and not a colon and NIL otherwise"
  (and (graphic-char-p object)
       (not (char= object #\:))))

;;; Convert a line of keyword tokens into a complete keyword string
(defun keylst->keystring (lst &optional (str nil))
  "Convert a line of keyword tokens into a complete keyword string"
  (if (null lst)
      str
      (cond ((= (length (car lst)) 2) (keylst->keystring (cdr lst) (concatenate 'string str (string (code-char (parse-integer (car lst) :radix 16))))))
	    (t                        (keylst->keystring (cdr lst) (concatenate 'string str (car lst)))))))

;;; Read the specified colon-delimited keyword file
;;; and return a list of the strings discovered
(defun read-keyword-file (path)
  "Parse colon-delimited keyword file and return a list of keyword strings"
  (with-open-file (stream path)
    (read-keyword-stream stream)))


(defun read-keyword-stream (stream)
  "Parse colon-delimited character stream and return a list of keyword strings"
  (let ((keys nil))
    (do ((line (read-line stream nil)
	       (read-line stream nil)))
	((null line) (reverse (remove-if #'null keys)))
      (let ((tempkey (keylst->keystring (tokens line #'valid-char 0))))
	(setf keys (cons tempkey keys))))))


(defun compile-rules-from-file (path)
  (with-open-file (stream path)
    (compile-rules-from-stream stream)))
	     
(defun compile-rules-from-stream (stream)
  "Compile a set of rules defined in an ASCII text file.
   Each line of the text file represents a keyword.  Blank lines are ignored.
   Each character on each line must be prefixed with \":\" (colon). A user
   can specify any 8-bit byte using two consecutive hexadecimal digits
   in place of a single character."
  (let* ((*keys*        (sort (read-keyword-stream stream) #'string<))
	 (*groupedkeys* (list-by-n *keys* 16)))
     (until (null *groupedkeys*)
       (catch 'table-size-exceeded
	 (unwind-protect
	      (let ((current-group (car *groupedkeys*))
		    (graph         (make-bsg-graph))
		    (bmachine      (make-array '(4) :element-type 'bsm-graph :initial-element nil)))

		(setf *groupedkeys* (cdr *groupedkeys*))

		;; Insert current group of keywords
		(dolist (snortkey current-group)
		  (bsg-graph-insert snortkey graph))

		;; Create Failure Graph
		(create-failure-graph graph)

		;; Create DFA
		(create-dfa graph)

		;; Verify the number of goal states fits within the current architecture
		(let ((goal-states 0))
		  (dolist (node (bsg-graph-nodes graph))
		    (if (bsg-node-goal node)
			(incf goal-states)))

		  (when (> goal-states 16)
		    (error "The number of goal states exceeds the current architecture's bounds!")))

		;; Create binary state machines.
		(dotimes (index 4)
		  (setf (aref bmachine index) (create-bsm graph index 2))

		  (when (> (length (bsm-graph-nodes (aref bmachine index))) 256)
		    (progn
		      (when (< (length current-group) 2)
			(error "Unable to divide keywords further!  This set of strings does not fit within the current architecture's bounds!"))
		      (setf current-group (list-by-n current-group (floor (/ (length current-group) 2))))
		      (setf *groupedkeys* (append current-group *groupedkeys*))
		      (throw 'table-size-exceeded nil))))

		(bsmvector->table graph bmachine))
	   )))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Example 1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; An example creating four binary state machines
;;;; based on the keywords "he" "she" "his" and "hers"
;;;; Note that the ordering MATTERS!  This ordering
;;;; reflects the output described in the paper.

;;; Uncomment the functions below to see a more
;;; detailed print-out of the objects being created.
(defun run-example-1 ()
  (let ((mygraph (make-bsg-graph))
	(bmvector(make-array '(4)
			     :element-type 'bsm-graph
			     :initial-element nil)))
    (bsg-graph-insert "he"   mygraph)
    (bsg-graph-insert "she"  mygraph)
    (bsg-graph-insert "his"  mygraph)
    (bsg-graph-insert "hers" mygraph)

    (create-failure-graph mygraph)
    (create-dfa mygraph)

    ;;(print-bsg-graph mygraph)
    ;;(dfa->dot mygraph)
   
    (dotimes (index 4 bmvector)
      (setf (aref bmvector index) (create-bsm mygraph index 2))
      ;;(print-bsm-graph (aref bmvector index))
      )

    (bsmvector->table mygraph bmvector)))
                                                                            ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Example 2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Another example creating four binary state machines.
;;;; Note that some keywords contain 8-bit byte
;;;; sequences represented by hexadecimal values (#Xhh).

(defun run-example-2 ()
  (let ((mygraph (make-bsg-graph))
	(bmvector(make-array '(4)
			     :element-type 'bsm-graph
			     :initial-element nil)))
    (bsg-graph-insert "mixing#X23charsWithHex#X00"  mygraph)
    (bsg-graph-insert "nohexhere" mygraph)
    (bsg-graph-insert "#X0A#X10#X07" mygraph)

    (create-failure-graph mygraph)
    (create-dfa mygraph)

    (dotimes (index 4 bmvector)
      (setf (aref bmvector index) (create-bsm mygraph index 2)))

    (bsmvector->table mygraph bmvector)))
                                                                            ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Example 3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; An example of compiling rules using keywords from a file.
;;;; Providing a full path to (compile-rules-from-file) will parse and sort
;;;; the specified file in lexicographical order, ignoring blank lines.
;;;; 
;;;; Keywords appear on each line of the (colon-delimited) text input file.
;;;; If all keywords can be compiled successfully with respect to the
;;;; current architecture's size constraints, the compiled rules will be
;;;; printed to standard output.

(defun run-example-3 ()
  (compile-rules-from-file "snort.in"))
                                                                            ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Executable Example ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Read characters from the standard input and compile the keywords
;;;; Input can be piped from the command-line, depending on the user's
;;;; Lisp implementation.

(compile-rules-from-stream *standard-input*)
                                                                            ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;