[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Logs-devel] rule macro attempt #1
|
From: |
Vijay Lakshminarayanan |
|
Subject: |
Re: [Logs-devel] rule macro attempt #1 |
|
Date: |
Mon, 5 Jun 2006 01:59:16 -0500 |
Hi Jim
I have made one or two more changes. I was shooting myself in the
foot trying to use cl-yacc. I'm sure it's a great tool but I couldn't
get the hang of it to parse LoGS rules. anyway, you were right about
it being a large hammer. I think we can do without it.
I've extended set-env to accept a LOOP like AND syntax:
(rule with foo = "one" and bar = "two" do (lambda (x) (list foo bar)))
I have a few more questions. I'll ask them in the morning. I've
added a keyword FILTER and have a question there.
Thanks Jim!
;;; Paul Graham, On Lisp, p191
(defmacro aif (test-form then-form &optional else-form)
`(let ((it ,test-form))
(if it ,then-form ,else-form)))
;;; an 'accessor' for the handle-fns
(defmacro handle-fn (keyword)
`(get ,keyword 'handle-fn))
(defmacro alias (keyword)
`(get ,keyword 'alias))
;;; Influenced by Peter Norvig's LOOP implementation
(defstruct rool
(name '())
(match '())
(timeout '())
(relative-timeout '())
(delete-rule '())
(continuep '())
(actions '())
(environment '())
(delete '()))
(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
:environment ',(rool-environment rool)
,@(loop as (key fn) in '((:match rool-match)
(:name rool-name)
(:timeout rool-timeout)
(:continuep rool-continuep)
(: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)
(let* ((keyword (or (alias keyword) keyword)))
(aif (handle-fn keyword)
(funcall it rool exprs)
(error "Unknown keyword ~S" keyword))))
(defun handle-name (rool exprs)
(destructuring-bind (name . cdr) exprs
;; rule names don't have to be symbols
;; symbols are (obviously) a pretty good idea, but
;; strings, etc. should work as well
(if (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
;; facilities to add other messages
(declare (ignore matches))
(destructuring-bind (car . cdr) exprs
(case car
(regexp (let ((msg (gensym "MESSAGE"))
(matches (gensym))
(sub-matches (gensym))
(regex (pop cdr)))
(setf (rool-match rool)
`(lambda (,msg)
(multiple-value-bind (,matches ,sub-matches)
(cl-ppcre:scan-to-strings
,regex
(logs::message ,msg))
(when ,matches
(values t
'((sub-matches ,sub-matches)))))))
cdr))
(message-length (let ((msg (gensym "MESSAGE"))
(relop (pop cdr))
(num (pop cdr)))
(setf (rool-match rool)
`(lambda (,msg)
(,relop (length (logs::message
,msg)) ,num)))
cdr))
(t (setf (rool-match rool) car) cdr)))))
(defun handle-filter (rool exprs)
(destructuring-bind (regexp regex . cdr) exprs
(let ((exprs (handle-match rool exprs)))
(setf (rool-continuep rool) t
;; There has to be some way to set the
;; whole to just NIL.
;; I see the following possibilities:
;; we parse EXPRS and remove all
;; action clauses.
;; We change the design of LoGS such
;; that actions is actually (by
;; default) (block NIL (list action-1
;; action-2)) and then we just do a
;; (setf (rool-actions rool) '(return))
(rool-actions rool) nil))))
(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))
(defun handle-setenv (rool exprs)
(destructuring-bind (variable = value &rest rest) exprs
(declare (ignore =))
(pushnew (list variable value)
(rool-environment rool)
:test
(lambda (x y) (equal (car x) (car y))))
(if (eq (car rest) 'and)
;; More than one variable has been
;; defined. Save that too.
(handle-setenv rool (cdr rest))
rest)))
;; add the given function to the actions list
(defun handle-do (rool exprs)
(destructuring-bind (todo &rest rest) exprs
(format t "rool: ~A~%todo: ~A~%rest: ~A~%~
rool-actions:~S~%~50~~%"
rool todo rest (rool-actions rool))
(setf (rool-actions rool) (append (rool-actions rool) (list (eval todo))))
rest))
;; set the continue slot to t
(defun handle-continue (rool exprs)
(setf (rool-continuep rool) t)
exprs)
;; set the delete slot to t
(defun handle-delete (rool exprs)
(setf (rool-delete rool) t)
exprs)
;;; Set aliases for keywords so we have synonyms
;;; and define the handler function
(defmacro defhandler (keywords alias handle-fn)
`(setf ,@(if (consp keywords)
(loop as keyword in keywords
appending `((alias ',keyword) ',alias))
`((alias ',keywords) ',alias))
(handle-fn ',alias) ,handle-fn))
(defhandler (match matching) :match #'handle-match)
(defhandler (name named) :name #'handle-name)
(defhandler (do doing) :do #'handle-do)
(defhandler continue :continue #'handle-continue)
(defhandler timeout :timeout #'handle-timeout)
(defhandler (set-env with) :set-env #'handle-setenv)
(defhandler delete :delete #'handle-delete)
;;; *eof*
On 6/4/06, Jim Prewett <address@hidden> wrote:
Hi Vijay,
I've had fun playing with your code today (unfortunately, some yard work,
etc. kept me busy for too much of it :). I've made a few minor
modifications, and generally think your code has a nice feel to it :)
kudos!
Here is an example using some of the new things I've added:
(rule
name 'foo
match regexp ".+"
;; set variable var1 to 42
setenv var1 = 42
;; first action
doing (lambda (x) (format t "message: ~A var1: ~A~%" (message x)
var1))
;; second action
doing #'print-message
;; set continuep slot to t
continue)
;;; Paul Graham, On Lisp, p191
(defmacro aif (test-form then-form &optional else-form)
`(let ((it ,test-form))
(if it ,then-form ,else-form)))
;;; an 'accessor' for the handle-fns
(defmacro handle-fn (keyword)
`(get ,keyword 'handle-fn))
;;; Influenced by Peter Norvig's LOOP implementation
(defstruct rool
(name '())
(match '())
(timeout '())
(relative-timeout '())
(delete-rule '())
(continuep '())
(actions '())
(environment '()))
(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
:environment ',(rool-environment rool)
:actions (rool-actions ,rool)
,@(loop as (key fn) in '((:match rool-match)
(:name rool-name)
(:timeout rool-timeout)
(:continuep rool-continuep)
(:relative-timeout rool-relative-timeout))
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)
(aif (handle-fn keyword)
(funcall it rool exprs)
(error "Unknown keyword ~S" keyword)))
(defun handle-name (rool exprs)
(destructuring-bind (name . cdr) exprs
;; rule names don't have to be symbols
;; symbols are (obviously) a pretty good idea, but
;; strings, etc. should work as well
(if (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"))
(matches (gensym))
(sub-matches (gensym))
(regex (pop cdr)))
(setf (rool-match rool)
`(lambda (,msg)
(multiple-value-bind (,matches ,sub-matches)
(cl-ppcre:scan-to-strings ,regex (message ,msg))
(when ,matches
(values t
'((sub-matches ,sub-matches)))))))
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))
(defun handle-setenv (rool exprs)
(destructuring-bind (variable equal value &rest rest) exprs
(pushnew (list variable value)
(rool-environment rool)
:test
(lambda (x y) (equal (car x) (car y))))
rest))
;; add the given function to the actions list
(defun handle-do (rool exprs)
(destructuring-bind (todo &rest rest) exprs
(format t "rool: ~A todo: ~A rest: ~A~%"
rool todo rest)
(append (rool-actions rool) (list (eval todo)))
rest))
;; set the continue slot to t
(defun handle-continue (rool exprs)
(setf (rool-continuep rool) t)
exprs)
(setf (handle-fn 'match) #'handle-match)
(setf (handle-fn 'name) #'handle-name)
(setf (handle-fn 'timeout) #'handle-timeout)
;; new
(setf (handle-fn 'continue) #'handle-continue)
(setf (handle-fn 'setenv) #'handle-setenv)
(setf (handle-fn 'doing) #'handle-do)
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 Sun, 4 Jun 2006, Vijay Lakshminarayanan wrote:
> On 6/4/06, Jim Prewett <address@hidden> wrote:
> > > > I was wondering how you're envisioning this working for rules that
> > create
> > > > rules ... that create rules?
> > > >
> > > > (make-instance 'rule
> > > > :actions
> > > > (list
> > > > (lambda (message)
> > > > (enqueue *root-ruleset* (make-instance 'rule ...)))))
> > >
> > > We just use the macro again, I guess.
> > >
> > > (rule performing (lambda (message) (enqueue *root-ruleset* (rule
> > ...))))
> > >
> >
> > I was hoping that was the answer :)
>
> Oh so it's a Good Thing? That's a relief :-)
>
> > > In time we should have a single function which does the enqueing.
> >
> > I don't think you're quite understanding the ruleset tree structure.
> > rulesets contain rules and other rulesets. You may want to have a rule
> > that creates a new rule on a completely different part of the tree.
>
> You're right. I completely forgot about this -- I was totally
> immersed into defining the macro's behavior itself.
>
> > In other words, I don't see specifying the ruleset you're adding the rule
> > to to be a loss.
> >
> > Jim
> >
>
> Will come up with more and better quality code soon, Jim.
>
> Thanks
> Vijay
>