[noctool-cvs] CVS source
jprewett
jprewett at common-lisp.net
Tue Dec 2 14:52:28 UTC 2008
Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv7896
Modified Files:
config.lisp globals.lisp scheduler.lisp tests.lisp web.lisp
Log Message:
added load-monitor to config syntax (not named "load" for obvious reasons!)
added FIND-EQUIPMENT-BY-NAME function to find a piece of gear in the *equipment*
list by its name.
added FIND-OBJECT method to find an object in a SCHEDULER, TIMESLOT, or EVENT.
This is used to see if an object is already scheduled! Also hella useful for de
bugging! :)
fixed thunko where all monitors wouldn't be run if the host didn't ping INCLUDIN
G FREAKIN' PING MONITORS!!! D'OH! (I think I introduced this bug! :P )
added code to ensure that the ping monitor is scheduled! (may not be needed!)
Worked a little on parsing df output a little better. Ignoring lines with Files
ystem at the beginning instead of simply assuming the first line is that (I had
some errors where, apparently, the first line was blank, then the second was the
"Filesystem" line.. :P )
a little work on the Web UI
--- /project/noctool/cvsroot/source/config.lisp 2008/08/26 15:54:29 1.9
+++ /project/noctool/cvsroot/source/config.lisp 2008/12/02 14:52:28 1.10
@@ -145,6 +145,10 @@
(list max-rtt max-fail interval ping-count)
`(noctool::make-monitor 'ping-monitor ,*config-object* , at args))
+(defnested load-monitor (&optional (low-water 1.0) (high-water 5.0))
+ :machine
+ `(noctool::make-monitor 'load-monitor ,*config-object* :low-water ,low-water :high-water ,high-water))
+
(defmacro defmon (mon-class)
(export (list mon-class))
`(defnested ,mon-class (&rest options) :machine
--- /project/noctool/cvsroot/source/globals.lisp 2008/03/17 08:27:58 1.1.1.1
+++ /project/noctool/cvsroot/source/globals.lisp 2008/12/02 14:52:28 1.2
@@ -22,3 +22,8 @@
(defmacro default-monitor (class monitor-class)
`(add-default-monitor (find-class ',class) ',monitor-class))
+
+(defun find-equipment-by-name (name)
+ (loop for e in *equipment*
+ when (equal (name e) name)
+ do (return e)))
--- /project/noctool/cvsroot/source/scheduler.lisp 2008/11/12 17:56:28 1.12
+++ /project/noctool/cvsroot/source/scheduler.lisp 2008/12/02 14:52:28 1.13
@@ -3,6 +3,23 @@
(defvar *default-scheduler* nil)
(defvar *network-updates-needed* nil)
+(defvar *total-processes*
+ #+darwin 1
+ #-darwin 32)
+
+(defvar *process-semaphore* (sb-thread:make-semaphore :name "Simultaneous processes" :count *total-processes*))
+
+(defmacro with-semaphore (semaphore &body body)
+ `(progn
+ (sb-thread:wait-on-semaphore ,semaphore)
+ (unwind-protect
+ (progn , at body)
+ (sb-thread:signal-semaphore ,semaphore))))
+
+(defmacro noc-thread (&body body)
+ `(with-semaphore *process-semaphore*
+ , at body))
+
(defclass event ()
((time :reader time :initarg :time)
(object :reader object :initarg :object)))
@@ -22,6 +39,25 @@
)
(:default-initargs :first-timeslot nil :last-timeslot nil))
+(defgeneric find-object (object store))
+
+(defmethod find-object (object (event event))
+ (equal object (object event)))
+
+(defmethod find-object (object (timeslot timeslot))
+ (loop for event in (events timeslot)
+ when (find-object object event)
+ do (return t)))
+
+(defmethod find-object (object (scheduler scheduler))
+ (loop with timeslot = (first-timeslot scheduler)
+ when (find-object object timeslot)
+ do (return timeslot)
+ when t
+ do (if (equal timeslot (last-timeslot scheduler))
+ (return NIL)
+ (setf timeslot (next timeslot)))))
+
(defmethod time ((foo null))
foo)
(defmethod first-timeslot ((foo null))
@@ -100,9 +136,13 @@
(defmethod add-event ((event event) (store scheduler))
(with-object-lock store
- (let ((time (time event)))
- (let ((slot (find-timeslot store time)))
- (add-event event slot)))))
+ (let* ((time (time event))
+ (object (object event))
+ (slot (find-timeslot store time))
+ (found (find-object object store)))
+ (if found
+ (progn (warn "not scheduling object: ~A as it is already scheduled at ~A!~%" object (time found)))
+ (add-event event slot)))))
(defmethod add-event ((event event) (store timeslot))
(with-object-lock store
@@ -120,10 +160,10 @@
(defun next-timeslot (&optional (scheduler *default-scheduler*))
(with-object-lock (if scheduler
- scheduler
- (or *default-scheduler*
- (setf *default-scheduler*
- (make-instance 'scheduler))))
+ scheduler
+ (or *default-scheduler*
+ (setf *default-scheduler*
+ (make-instance 'scheduler))))
(prog1
(first-timeslot scheduler)
(setf (first-timeslot scheduler) (next (first-timeslot scheduler)))
@@ -137,11 +177,11 @@
(time (first-timeslot scheduler))))
(defun schedule (object time &optional (scheduler *default-scheduler*))
- (let ((event (make-instance 'event :time time :object object)))
- (when (null scheduler)
- (setf *default-scheduler* (make-instance 'scheduler))
- (setf scheduler *default-scheduler*))
- (add-event event scheduler)))
+ (let ((event (make-instance 'event :time time :object object)))
+ (when (null scheduler)
+ (setf *default-scheduler* (make-instance 'scheduler))
+ (setf scheduler *default-scheduler*))
+ (add-event event scheduler)))
(defmethod process ((slot timeslot))
(loop for event in (events slot)
@@ -149,23 +189,6 @@
(defvar *process-mutex* (sb-thread:make-mutex :name "process lock"))
-(defvar *total-processes*
- #+darwin 1
- #-darwin 32)
-
-(defvar *process-semaphore* (sb-thread:make-semaphore :name "Simultaneous processes" :count *total-processes*))
-
-(defmacro with-semaphore (semaphore &body body)
- `(progn
- (sb-thread:wait-on-semaphore ,semaphore)
- (unwind-protect
- (progn , at body)
- (sb-thread:signal-semaphore ,semaphore))))
-
-(defmacro noc-thread (&body body)
- `(with-semaphore *process-semaphore*
- , at body))
-
(defmethod process ((event event))
#-no-noctool-threads
(sb-thread:make-thread
@@ -174,7 +197,8 @@
(sb-ext:with-timeout 3000
(noc-thread (process (object event))))
(sb-ext::timeout ()
- (warn "Timing out thread ~A~%" sb-thread:*current-thread*)))))
+ (warn "Timing out thread ~A~%" sb-thread:*current-thread*))))
+ :name (format NIL "~A ~A" (object event) (noctool::name (noctool::equipment (object event)))))
#+no-noctool-threads
(process (object event)))
--- /project/noctool/cvsroot/source/tests.lisp 2008/11/12 21:56:24 1.9
+++ /project/noctool/cvsroot/source/tests.lisp 2008/12/02 14:52:28 1.10
@@ -8,17 +8,33 @@
,error-form))))
(defmethod process :around ((monitor monitor))
- (unwind-protect
- (if (host-pings monitor)
- (call-next-method))
- (let ((now (get-universal-time)))
- (setf (last-updated monitor) now)
- (schedule monitor
- (+ now
- (*
- (interval monitor)
- (if (>= (alert-level monitor) *alerting*) 5 1))))
- (format t "just rescheduled monitor: ~A~%" monitor))))
+ (unwind-protect
+ (typecase monitor
+ (noctool::ping-monitor
+ (progn
+ (call-next-method)
+ (setf (noctool:last-updated monitor) (get-universal-time))))
+ (t
+ (if (host-pings monitor)
+ (progn
+ (call-next-method)
+ (setf (noctool:last-updated monitor) (get-universal-time)))
+ (progn
+ (warn "host ~A doesn't ping!"
+ (noctool::name (noctool::equipment monitor)))
+ ;; this might not be needed
+ (let ((ping-monitor
+ (get-ping-monitor (noctool::equipment monitor))))
+ (unless (noctool-scheduler::find-object
+ ping-monitor
+ noctool-scheduler::*default-scheduler*)
+ (schedule ping-monitor (+ (get-universal-time) 1))))))))
+ (schedule monitor
+ (+ (get-universal-time)
+ (*
+ (interval monitor)
+ (if (>= (alert-level monitor) *alerting*) 5 1))))))
+
(defmethod process ((monitor ping-monitor))
(without-errors NIL
@@ -58,7 +74,10 @@
with last = NIL
for len = (+ (length split) (length last))
while line
- if (> 6 len)
+ if (cl-ppcre::scan "(^$|^Filesystem)" line)
+ do
+ (setf len 0)
+ else if (> 6 len)
do
(setf last split)
else
@@ -127,23 +146,23 @@
(defmethod process ((monitor load-monitor))
(without-errors NIL
(with-pty (pty (make-ssh-command "uptime" (address (equipment monitor)) (username (equipment monitor))))
- (let ((data (split-line (string-trim '(#\Space #\Return #\Newline)
+ (let ((data (split-line (string-trim '(#\Space #\Return #\Newline)
(read-line pty)))))
- (let ((loads (cdr (member "average" data :test #'search))))
- (let ((now-load (read-from-string (or (nth 0 loads) "-1"))))
- (let ((new-alert
- (cond ((< now-load (low-water monitor)) 0)
- ((<= (low-water monitor) now-load (high-water monitor))
- (+ *warning* (* (- now-load (low-water monitor))
- (/ (- *alerting* *warning*)
- (- (high-water monitor)
- (low-water monitor))))))
- (t *alerting*))))
- (setf (alert-level monitor) (decay-alert (alert-level monitor)
- (round new-alert))))
- (add-value (graph-1 monitor) now-load)
- (add-value (graph-5 monitor) (read-from-string (or (nth 1 loads) "-1")))
- (add-value (graph-10 monitor) (read-from-string (or (nth 2 loads) "-1")))))))))
+ (let ((loads (cdr (member "average" data :test #'search))))
+ (let ((now-load (read-from-string (or (nth 0 loads) "-1"))))
+ (let ((new-alert
+ (cond ((< now-load (low-water monitor)) 0)
+ ((<= (low-water monitor) now-load (high-water monitor))
+ (+ *warning* (* (- now-load (low-water monitor))
+ (/ (- *alerting* *warning*)
+ (- (high-water monitor)
+ (low-water monitor))))))
+ (t *alerting*))))
+ (setf (alert-level monitor) (decay-alert (alert-level monitor)
+ (round new-alert))))
+ (add-value (graph-1 monitor) now-load)
+ (add-value (graph-5 monitor) (read-from-string (or (nth 1 loads) "-1")))
+ (add-value (graph-10 monitor) (read-from-string (or (nth 2 loads) "-1")))))))))
(defmethod process ((monitor tcp-monitor))
(when (and (sent-data monitor)
--- /project/noctool/cvsroot/source/web.lisp 2008/11/10 16:44:57 1.1
+++ /project/noctool/cvsroot/source/web.lisp 2008/12/02 14:52:28 1.2
@@ -60,6 +60,7 @@
(defvar *monitor-hash* (make-hash-table))
(defvar *last-updated-hash* (make-hash-table))
(defvar *last-rtt-hash* (make-hash-table))
+(defvar *last-failed-hash* (make-hash-table))
(defvar *last-load-hash* (make-hash-table))
(defvar *disk-widget-hash* (make-hash-table))
(defvar *load-1-hash* (make-hash-table))
@@ -118,6 +119,13 @@
(setf (html-of widget)
(sb-int:format-universal-time NIL new))))
+(defensure ensure-next-run
+ (mk-span (sb-int:format-universal-time NIL (noctool::last-updated instance)))
+ *last-updated-hash*
+ (defmethod (setf noctool::last-updated) :after (new (instance (eql instance)))
+ (setf (html-of widget)
+ (sb-int:format-universal-time NIL new))))
+
(defensure ensure-last-rtt
(mk-span
(let ((idx (noctool-graphs::short-ix (noctool::graph instance))))
@@ -132,13 +140,25 @@
graph)
(mod (1- (noctool-graphs::short-ix graph)) 300))))))
+(defensure ensure-last-failed
+ (mk-span
+ (format NIL "~A"
+ (noctool::failed instance)))
+ *last-failed-hash*
+ (defmethod (setf noctool::failed) :after (new (instance (eql instance)))
+ (setf (html-of widget)
+ (format NIL "~A" new))))
+
(defensure ensure-last-load
(make-instance 'load-widget :monitor instance)
*last-load-hash*
())
(defensure ensure-noc-host-widget
- (make-instance 'noc-host :noc-host instance) *noc-host-hash*
+ (make-instance 'noc-host
+ :noc-host instance
+ :css-class (alert-class (noctool::alert-level instance)))
+ *noc-host-hash*
(defmethod (setf noctool::alert-level)
:after (new-val (host (eql instance)))
(setf (css-class-of widget)
@@ -175,16 +195,6 @@
(t
"normal")))
-;; put this somewhere else! XXX
-(defmethod noctool-scheduler:process :after ((monitor noctool::monitor))
- (setf (noctool:last-updated monitor) (get-universal-time))
- (format t "just processed monitor: ~A for equipment: ~A~%"
- monitor
- (noctool::name (noctool::equipment monitor))))
-
-(defmethod noctool-scheduler:process :after ((slot noctool-scheduler::timeslot))
- (format t "just processed timeslot: ~A~%" slot))
-
(defwidget eqp (container)
((system-name :initform NIL :initarg :system-name :accessor system-name)
(system :initform (error "system must be supplied") :initarg :system :accessor system)
@@ -246,12 +256,18 @@
(list
(mk-div (noctool::name (noctool::equipment mon)))
(mk-span (symbol-name (class-name (class-of mon))))
+ (mk-span (who (:br)))
(mk-span " Last Updated ")
(ensure-last-updated-widget mon)
(mk-span (who (:br)))
+ (ensure-next-run mon)
+ (mk-span (who (:br)))
(mk-span "last rtt: ")
(ensure-last-rtt mon)
- (mk-span (who (:br))))))
+ (mk-span " failed: ")
+ (ensure-last-failed mon)
+ (mk-span (who (:br)))
+ )))
(defmethod display-monitor-info ((mon noctool::load-monitor))
(mk-container
@@ -309,17 +325,15 @@
(push (create-prefix-dispatcher "/images/" #'noctool-image-dispatch)
*dispatch-table*)
+(defvar *unwanted-monitors* '(noctool::cpu-monitor))
+
(defun schedule-all-monitors ()
(loop for equipment in noctool::*equipment*
do
(loop for mon in
(remove-if
(lambda (x)
- (eql 'noctool::cpu-monitor (type-of x)))
+ (member (type-of x) *unwanted-monitors*))
(noctool::monitors equipment))
- ;; (remove-if
-;; (lambda (x)
-;; (not (eql 'load-monitor (type-of x))))
-;; (noctool::monitors equipment))
do
(noctool::schedule mon (1+ (get-universal-time))))))
\ No newline at end of file
More information about the noctool-cvs
mailing list