[noctool-cvs] CVS source
imattsson
imattsson at common-lisp.net
Thu Feb 19 17:33:34 UTC 2009
Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv17842
Modified Files:
classes.lisp packages.lisp config.lisp
Log Message:
IM
Moved most (though not all) :AFTER methods for INITIALIZE-INSTANCE
to POST-CONFIG-FIXUP GF methods and inserted a call to that in
NOCTOOL-CONFIG:LOAD.
--- /project/noctool/cvsroot/source/classes.lisp 2009/02/17 17:48:20 1.21
+++ /project/noctool/cvsroot/source/classes.lisp 2009/02/19 17:33:34 1.22
@@ -29,41 +29,6 @@
(proxies :accessor proxies :initarg :proxies :initform nil))
(:default-initargs :id (gentemp "EQ-" (find-package :noctool-symbols))))
-;; 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
- (unless *dont-muck-with-instance*
- (cond ((and (not (slot-boundp instance 'address))
- (not (slot-boundp instance 'name)))
- (error "both name and address are unbound for this host!"))
- ((not (slot-boundp instance 'address))
- (setf (slot-value instance 'address)
- (let ((hostent
- (sb-bsd-sockets:host-ent-address
- (sb-bsd-sockets:get-host-by-name (name instance)))))
- (format NIL "~A.~A.~A.~A"
- (aref hostent 0)
- (aref hostent 1)
- (aref hostent 2)
- (aref hostent 3)))))
- ((not (slot-boundp instance 'name))
- (setf (slot-value instance 'name)
- (sb-bsd-sockets:host-ent-name
- (sb-bsd-sockets:get-host-by-address
- (let ((arr (make-array '(4))))
- (loop
- for i from 0
- for element in
- (mapcar #'read-from-string
- (cl-ppcre:split #\. (address instance)))
- do
- (setf (aref arr i) element))
- arr))))))))
(defclass proxy ()
((remote-node :reader remote-node :initarg :remote-node)
@@ -95,10 +60,6 @@
)
(:default-initargs :low-water 1.0 :high-water 5.0))
-(defmethod initialize-instance :after ((instance load-monitor) &key)
- (unless *dont-muck-with-instance*
- (add-graphs instance)))
-
(defclass tcp-monitor (monitor)
((sent-data :reader sent-data :initarg :sent-data :initform nil)
(match-data :reader match-data :initarg :match-data :initform nil)
@@ -280,6 +241,53 @@
)
(:default-initargs :display-objects nil))
+(defgeneric post-config-fixup (object))
+(defmethod post-config-fixup (object)
+ ;; Default do-naught method
+ (values))
+
+(defmethod post-config-fixup ((instance load-monitor) &key)
+ (unless *dont-muck-with-instance*
+ (add-graphs instance)))
+
+;; 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 post-config-fixup ((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
+ (unless *dont-muck-with-instance*
+ (cond ((and (not (slot-boundp instance 'address))
+ (not (slot-boundp instance 'name)))
+ (error "both name and address are unbound for this host!"))
+ ((not (slot-boundp instance 'address))
+ (setf (slot-value instance 'address)
+ (let ((hostent
+ (sb-bsd-sockets:host-ent-address
+ (sb-bsd-sockets:get-host-by-name (name instance)))))
+ (format NIL "~A.~A.~A.~A"
+ (aref hostent 0)
+ (aref hostent 1)
+ (aref hostent 2)
+ (aref hostent 3)))))
+ ((not (slot-boundp instance 'name))
+ (setf (slot-value instance 'name)
+ (sb-bsd-sockets:host-ent-name
+ (sb-bsd-sockets:get-host-by-address
+ (let ((arr (make-array '(4))))
+ (loop
+ for i from 0
+ for element in
+ (mapcar #'read-from-string
+ (cl-ppcre:split #\. (address instance)))
+ do
+ (setf (aref arr i) element))
+ arr))))))
+ (loop for monitor in (monitors instance)
+ do (post-config-fixup monitors))
+ ))
(defgeneric initial-enqueue (object))
(defmethod initial-enqueue ((object equipment))
--- /project/noctool/cvsroot/source/packages.lisp 2009/02/19 17:27:17 1.11
+++ /project/noctool/cvsroot/source/packages.lisp 2009/02/19 17:33:34 1.12
@@ -17,7 +17,7 @@
(:use #:cl #:usocket #:net.hexapodia.noctool-scheduler #:net.hexapodia.noctool-graphs
#+sbcl :sb-mop)
(:export
- #:proxies #:*proxies* #:*peers* #:*equipment* #:*views* #:*noctool-package* #:id #:last-updated #:unix-host #:linux-host #:cpu-monitor #:load-monitor #:ping-monitor #:remote-node #:decode-base64 #:encode-base64 #:octetify #:destination #:alert-level #:conn #:monitors #:my-name #:my-passwd #:serialize-data #:remote-node #:dst-port #:remote-passwd #:name #:graph-type #:object #:disk-container
+ #:post-config-fixup #:proxies #:*proxies* #:*peers* #:*equipment* #:*views* #:*noctool-package* #:id #:last-updated #:unix-host #:linux-host #:cpu-monitor #:load-monitor #:ping-monitor #:remote-node #:decode-base64 #:encode-base64 #:octetify #:destination #:alert-level #:conn #:monitors #:my-name #:my-passwd #:serialize-data #:remote-node #:dst-port #:remote-passwd #:name #:graph-type #:object #:disk-container
))
(defpackage #:net.hexapodia.noctool-config
--- /project/noctool/cvsroot/source/config.lisp 2009/02/18 17:56:12 1.14
+++ /project/noctool/cvsroot/source/config.lisp 2009/02/19 17:33:34 1.15
@@ -205,6 +205,7 @@
(cl:load file)
(loop for val in *loaded-objects*
+ do (post-config-fixup val)
do (cond ((typep val (find-class 'noctool::equipment))
(noctool::default-monitors val)
(push val *equipment*))
More information about the noctool-cvs
mailing list