Jim
James E. Prewett address@hidden address@hidden
Systems Team Leader LoGS: http://www.hpc.unm.edu/~download/LoGS/
Designated Security Officer OpenPGP key: pub 1024D/31816D93
HPC Systems Engineer III UNM HPC 505.277.8210
On Sat, 3 Jun 2006, Vijay Lakshminarayanan wrote:
> Hi Jim
>
> Here's a very poor first attempt at making a macro to define rules
> easily. I don't have ideas for how to include environment, continue,
> kill-rule-after-usage etc. There are currently four clauses accepted
> (and that too not too well) and :actions aren't allowed, but I think
> it isn't too bad as an idea (can't say the same about the program).
>
> ;;; Influenced by Peter Norvig's LOOP implementation
>
> (defstruct rool
> (name '())
> (match '())
> (timeout '()) (relative-timeout '())
> (delete-rule '()) (continuep '())
> (actions '()))
>
> (defmacro rule (&rest exprs)
> (let ((r (make-rool)))
> (parse-rule r exprs)
> (fill-rule-template r)))
>
> (defun fill-rule-template (rool)
> `(make-instance
> 'logs::rule
> ,@(loop as (key fn) in '((:match rool-match)
> (:name rool-name)
> (:timeout rool-timeout)
> (:relative-timeout rool-relative-timeout)
> (:actions rool-actions))
> as res = (funcall fn rool)
> if res append `(,key ,res))))
>
> (defun parse-rule (rool exprs)
> (unless (null exprs)
> (parse-rule rool (parse-keyword rool (car exprs) (cdr exprs)))))
>
> (defun parse-keyword (rool keyword exprs)
> (if (get keyword 'handle-fn)
> (funcall (get keyword 'handle-fn) rool exprs)
> (error "Unknown keyword ~S" keyword)))
>
> (defun handle-name (rool exprs)
> (destructuring-bind (name . cdr) exprs
> (if (and (symbolp name)
> (null (rool-name rool)))
> (setf (rool-name rool) `',name)
> (error "Invalid name ~S" name))
> cdr))
>
> (defun handle-match (rool exprs)
> (let ((matches (rool-match rool)))
> ;; For now, we ignore. Later we add or something
> (declare (ignore matches))
> (destructuring-bind (car . cdr) exprs
> (case car
> (regexp (let ((msg (gensym "MESSAGE"))
> (regex (pop cdr)))
> (setf (rool-match rool)
> `(lambda (,msg)
> (cl-ppcre:scan-to-strings ,regex ,msg)))
> cdr))
> (message-length (let ((msg (gensym "MESSAGE"))
> (relop (pop cdr))
> (num (pop cdr)))
> (setf (rool-match rool)
> `(lambda (,msg)
> (,relop (length (message ,msg)) ,num)))
> cdr))
> (t (setf (rool-match rool) car) cdr)))))
>
> (defun handle-timeout (rool exprs)
> (destructuring-bind (preposition . (time . cdr)) exprs
> (case preposition
> (in (setf (rool-relative-timeout rool) time))
> (at (setf (rool-timeout rool) time)))
> cdr))
>
> (setf (get 'match 'handle-fn) #'handle-match)
> (setf (get 'name 'handle-fn) #'handle-name)
> (setf (get 'timeout 'handle-fn) #'handle-timeout)
>
> ;;;;; =========
>
> Here are some examples with their expansions:
>
> CL-USER> (macroexpand '(rule match regexp "a.*b"))
> (MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
> :MATCH
> (LAMBDA (#:MESSAGE1939)
> (CL-PPCRE:SCAN-TO-STRINGS "a.*b" #:MESSAGE1939)))
> T
> CL-USER> (macroexpand '(rule name 'simple-1 match regexp "a.*b"))
> (MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
> :MATCH
> (LAMBDA (#:MESSAGE1940)
> (CL-PPCRE:SCAN-TO-STRINGS "a.*b" #:MESSAGE1940))
> :NAME
> 'SIMPLE-1)
> T
> CL-USER> (macroexpand '(rule name 'simple-1
> match message-length <= 80))
> (MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
> :MATCH
> (LAMBDA (#:MESSAGE1941)
> (<= (LENGTH (MESSAGE #:MESSAGE1941)) 80))
> :NAME
> 'SIMPLE-1)
> T
> CL-USER> (macroexpand '(rule name 'simple-1
> match #'match-all))
> (MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE :MATCH #'MATCH-ALL :NAME 'SIMPLE-1)
> T
> CL-USER> (macroexpand '(rule name 'simple-1 timeout in (+ 4 8)))
> (MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE
> :NAME
> 'SIMPLE-1
> :RELATIVE-TIMEOUT
> (+ 4 8))
> T
> CL-USER> (macroexpand '(rule name 'simple-1 timeout at 85933))
> (MAKE-INSTANCE 'ORG.PREWETT.LOGS::RULE :NAME 'SIMPLE-1 :TIMEOUT 85933)
> T
>
> Please give me your thoughts. In which time hopefully I'll get a
> better implementation idea :)
>
> Thanks
> Vijay
>
>
> _______________________________________________
> LoGS-devel mailing list
> address@hidden
> http://lists.nongnu.org/mailman/listinfo/logs-devel
>