[noctool-cvs] CVS source
jprewett
jprewett at common-lisp.net
Tue Aug 26 15:54:30 UTC 2008
Update of /project/noctool/cvsroot/source
In directory clnet:/tmp/cvs-serv749
Modified Files:
classes.lisp config.lisp scheduler.lisp tests.lisp
Log Message:
added scaffolding to make it easier to get the alert-level of any object
without querying its children.
This should make it easier to instrument the code for web display stuff (I hope)
--- /project/noctool/cvsroot/source/classes.lisp 2008/08/13 05:58:43 1.12
+++ /project/noctool/cvsroot/source/classes.lisp 2008/08/26 15:54:29 1.13
@@ -13,19 +13,34 @@
(defmacro get-instance-by-id (id-string)
`(gethash ,id-string *id-objects*))
-(defclass equipment (id-object)
+(defclass parented-object ()
+ ((parent :accessor parent :initform NIL :initarg :parent)))
+
+(defclass alert-level ()
+ ((alert-level :accessor alert-level :initarg :alert-level :initform 0)))
+
+(defmethod (setf alert-level) :AFTER (new (alert-level alert-level))
+ (when (slot-exists-p alert-level 'parent)
+ (if (parent alert-level)
+ (update-alert (parent alert-level)))))
+
+
+(defclass equipment (id-object alert-level)
((monitors :accessor monitors :initarg :monitors :initform nil)
(name :reader name :initarg :name)
(address :reader address :initarg :address)
(username :reader username :initarg :username :initform nil)
- (proxies :accessor proxies :initarg :proxies :initform nil)
- )
+ (proxies :accessor proxies :initarg :proxies :initform nil))
(:default-initargs :id (gensym "EQ-")))
;; if an instance has a name, but no address, give it an address
;; if an instance has an address, but no name, give it a name
;; if it has neither, signal an error
(defmethod initialize-instance :after ((instance equipment) &key)
+ ;; set the alert-level to the max of the children
+ (setf (alert-level instance)
+ (reduce #'max (monitors instance) :key 'alert-level :initial-value 0))
+ ;; make sure the name and address are bound
(cond ((and (not (slot-boundp instance 'address))
(not (slot-boundp instance 'name)))
(error "both name and address are unbound for this host!"))
@@ -53,23 +68,22 @@
(setf (aref arr i) element))
arr)))))))
-
(defclass proxy ()
((remote-node :reader remote-node :initarg :remote-node)
(object :reader object :initarg :object)
))
-(defclass monitor (id-object)
+(defclass monitor (id-object parented-object alert-level)
((equipment :reader equipment :initarg :equipment)
- (alert-level :accessor alert-level :initarg :alert-level :initform 0)
(interval :accessor interval :initarg :interval :initform 300)
(last-updated :accessor last-updated :initarg :last-updated)
(proxies :accessor proxies :initform nil)
)
(:default-initargs :id (gensym "MON-")))
-(defmethod alert-level ((kit equipment))
- (reduce #'max (monitors kit) :key 'alert-level :initial-value 0))
+;; no longer needed since this is now a slot
+;; (defmethod alert-level ((kit equipment))
+;; (reduce #'max (monitors kit) :key 'alert-level :initial-value 0))
(defclass cpu-monitor (monitor)
((num :reader num :initarg :num :initform 0)
@@ -156,12 +170,17 @@
(defclass disk-container (monitor)
((disk-list :accessor disk-list :initarg :disk-list :initform nil)
- (ignore-list :reader ignore-list :initarg :ignore-list)
- )
+ (ignore-list :reader ignore-list :initarg :ignore-list))
(:default-initargs :interval 600 :ignore-list (list "tmpfs")))
-(defmethod alert-level ((kit disk-container))
- (reduce #'max (disk-list kit) :initial-value 0 :key #'alert-level))
+(defmethod initialize-instance :after ((instance disk-container) &key)
+ ;; set the alert-level to the max of the children
+ (setf (alert-level instance)
+ (reduce #'max (disk-list instance) :key 'alert-level :initial-value 0)))
+
+;; now a slot in disk-container
+;; (defmethod alert-level ((kit disk-container))
+;; (reduce #'max (disk-list kit) :initial-value 0 :key #'alert-level))
(defclass host (equipment)
((passwd :reader passwd :initarg :passwd)
@@ -255,4 +274,21 @@
(defmethod initial-enqueue ((object monitor))
(noctool-scheduler:schedule object (+ 1
(get-universal-time)
- (random (interval mon)))))
+ (random (interval object)))))
+
+(defmethod update-alert ((thing disk-container))
+ (format t "updating alert for ~A~%" thing)
+ (setf (alert-level thing)
+ (reduce #'max (disk-list thing)
+ :key 'alert-level :initial-value 0)))
+
+(defmethod update-alert ((thing host))
+ (format t "updating alert for ~A~%" thing)
+ (setf (alert-level thing)
+ (reduce #'max (monitors thing)
+ :key 'alert-level :initial-value 0)))
+
+(defmethod (setf alert-level) :AFTER (new (alert-level alert-level))
+ (when (slot-exists-p alert-level 'parent)
+ (if (parent alert-level)
+ (update-alert (parent alert-level)))))
--- /project/noctool/cvsroot/source/config.lisp 2008/06/12 06:11:01 1.8
+++ /project/noctool/cvsroot/source/config.lisp 2008/08/26 15:54:29 1.9
@@ -107,7 +107,7 @@
(defnested disks (&rest diskspec)
:machine
(let ((*macro-nesting* (cons :disk *macro-nesting*)))
- `(let ((*disk-container* (car (noctool::make-monitor 'noctool::disk-container ,*config-object*))))
+ `(let ((*disk-container* (car (noctool::make-monitor 'noctool::disk-container ,*config-object* :parent ,*config-object*))))
,@(mapcar #'macroexpand diskspec))))
(defnested disk (path disk-percent &optional (inodes-percent 90))
@@ -116,7 +116,8 @@
:device ,path
:equipment ,*config-object*
:disk-percent ,disk-percent
- :inodes-percent ,inodes-percent)))
+ :inodes-percent ,inodes-percent
+ :parent *disk-container*)))
(noctool::add-graphs platter)
(push platter (noctool::disk-list *disk-container*))))
--- /project/noctool/cvsroot/source/scheduler.lisp 2008/08/13 05:56:29 1.6
+++ /project/noctool/cvsroot/source/scheduler.lisp 2008/08/26 15:54:29 1.7
@@ -145,7 +145,8 @@
(defmethod process :before ((event net.hexapodia.noctool-scheduler:event))
(let ((obj (net.hexapodia.noctool-scheduler::object event)))
- (when (or (proxies (equipment obj)) (proxies obj))
+ (when (or (noctool::proxies (noctool::equipment obj))
+ (noctool::proxies obj))
(push obj *network-updates-needed*))))
(defun scheduler-loop ()
--- /project/noctool/cvsroot/source/tests.lisp 2008/07/03 07:30:24 1.5
+++ /project/noctool/cvsroot/source/tests.lisp 2008/08/26 15:54:29 1.6
@@ -76,7 +76,8 @@
:device device
:equipment (equipment monitor)
:disk-max disk
- :interval (interval monitor)))
+ :interval (interval monitor)
+ :parent monitor))
(add-graphs platter)
(push platter
(disk-list monitor)))
More information about the noctool-cvs
mailing list