[noctool-cvs] CVS source
jprewett
jprewett at common-lisp.net
Wed Dec 3 12:28:01 UTC 2008
Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv9086
Modified Files:
classes.lisp scheduler.lisp tests.lisp utils.lisp web.lisp
Log Message:
added OVER-RTT slot to PING-MONITOR class to keep track of how many times in a row the RTT limit has been exceeded. This is mostly for the Web UI stuff.
Changed SCHEDULE from a function to a method so we can play some fun CLOS games there.
Added additional logic to PROCESS for PING-MONITOR
- some of it is cruft!
reworked HOST-PINGS
- only consider a host to not be pingable if it has FAILED previously
added more to the Web UI
--- /project/noctool/cvsroot/source/classes.lisp 2008/10/28 20:52:54 1.15
+++ /project/noctool/cvsroot/source/classes.lisp 2008/12/03 12:28:01 1.16
@@ -139,6 +139,7 @@
((max-fail :reader max-fail :initarg :max-fail :initform 1)
(max-rtt :reader max-rtt :initarg :max-rtt :initform 20)
(failed :accessor failed :initarg :failed :initform 0)
+ (over-rtt :accessor over-rtt :initarg :over-rtt :initform 0)
(ping-count :reader ping-count :initarg :ping-count :initform 5)
(graph :reader graph :initarg :graph :initform nil)
)
--- /project/noctool/cvsroot/source/scheduler.lisp 2008/12/02 14:52:28 1.13
+++ /project/noctool/cvsroot/source/scheduler.lisp 2008/12/03 12:28:01 1.14
@@ -176,13 +176,26 @@
(when scheduler
(time (first-timeslot scheduler))))
-(defun schedule (object time &optional (scheduler *default-scheduler*))
+(defmethod 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)))
+#+debug
+(defmethod process :around ((slot timeslot))
+ (format t "about to process timeslot: ~A at ~A~%"
+ (sb-int:format-universal-time NIL (time slot))
+ (sb-int:format-universal-time NIL (get-universal-time)))
+ (call-next-method)
+ (format t "done processing timeslot: ~A~%"
+ (sb-int:format-universal-time NIL (time slot)))
+ (if (next-time)
+ (format t "next timeslot: ~A~%"
+ (sb-int:format-universal-time NIL (next-time)))
+ (format t "no next timeslot!~%")))
+
(defmethod process ((slot timeslot))
(loop for event in (events slot)
do (process event)))
@@ -218,6 +231,5 @@
(cond ((null next) (sleep 60))
((<= next (get-universal-time))
(process (next-timeslot)))
- (t (sleep (min 1 (- next (get-universal-time))))
- (process (next-timeslot)))))))
+ (t (sleep (min 1 (- next (get-universal-time)))))))))
--- /project/noctool/cvsroot/source/tests.lisp 2008/12/02 14:52:28 1.10
+++ /project/noctool/cvsroot/source/tests.lisp 2008/12/03 12:28:01 1.11
@@ -20,15 +20,19 @@
(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))))))))
+ (warn "host ~A doesn't ping! failed: ~A over-rtt: ~A"
+ (noctool::name (noctool::equipment monitor))
+ (failed ping-monitor)
+ (over-rtt ping-monitor))
+ ;; this might not be needed
+ (if noctool-scheduler::*default-scheduler*
+ (unless (noctool-scheduler::find-object
+ ping-monitor
+ noctool-scheduler::*default-scheduler*)
+ (schedule ping-monitor (+ (get-universal-time) 1)))
+ (warn "no default scheduler!")))))))
(schedule monitor
(+ (get-universal-time)
(*
@@ -48,7 +52,9 @@
*alerting*
0)
(* 10 failed)
- (* 5 over-rtt))))
+ (* 5 over-rtt)))
+ (failed monitor) failed
+ (over-rtt monitor) over-rtt)
(when (graph monitor)
(add-value (graph monitor) (reduce #'max data))))))))
--- /project/noctool/cvsroot/source/utils.lisp 2008/10/22 19:41:10 1.11
+++ /project/noctool/cvsroot/source/utils.lisp 2008/12/03 12:28:01 1.12
@@ -141,10 +141,18 @@
(defmethod get-ping-monitor ((mon monitor))
(get-ping-monitor (equipment mon)))
-(defun host-pings (mon)
- (< (alert-level (get-ping-monitor mon))
- *alerting*))
+;; (defun host-pings (mon)
+;; (let ((ping-mon (get-ping-monitor mon)))
+;; (and (> (failed (get-ping-monitor mon)) 0)
+;; (< (alert-level (get-ping-monitor mon))
+;; *alerting*))))
+(defun host-pings (mon)
+ (let ((ping-mon (get-ping-monitor mon)))
+ (or
+ (< (alert-level (get-ping-monitor mon))
+ *alerting*)
+ (eql (failed ping-mon) 0))))
;;; Text encoding
(defun decode-base64 (str &key (result :latin1))
--- /project/noctool/cvsroot/source/web.lisp 2008/12/02 14:52:28 1.2
+++ /project/noctool/cvsroot/source/web.lisp 2008/12/03 12:28:01 1.3
@@ -56,11 +56,22 @@
,@',body
(setf (gethash ,instance ,,hash) widget))))))))
+(defmacro toggle (thing on-expr off-expr &key (default :on))
+ (declare (ignore thing))
+ (let ((v (gensym)))
+ `(let ((,v (eq ,default :on)))
+ (iambda
+ (if (setf ,v (not ,v))
+ ,on-expr
+ ,off-expr)))))
+
;; XXX do I need all of these damn hashes???
(defvar *monitor-hash* (make-hash-table))
(defvar *last-updated-hash* (make-hash-table))
+(defvar *next-run-hash* (make-hash-table))
(defvar *last-rtt-hash* (make-hash-table))
(defvar *last-failed-hash* (make-hash-table))
+(defvar *last-over-rtt-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))
@@ -76,7 +87,8 @@
(aref (noctool-graphs::short ,graph)
(mod
(1- (noctool-graphs::short-ix ,graph))
- 300))))))
+ 300)))
+ :css-class (alert-class (noctool::alert-level instance)))))
,span)
,hash
(defmethod noctool::add-value
@@ -85,7 +97,9 @@
(format NIL
"~2$"
(aref (noctool-graphs::short graph)
- (mod (1- (noctool-graphs::short-ix graph)) 300))))))))
+ (mod (1- (noctool-graphs::short-ix graph)) 300))))
+ (setf (css-class-of widget)
+ (alert-class (noctool::alert-level instance)))))))
(ensure-load ensure-load-1 noctool::graph-1 *load-1-hash*)
(ensure-load ensure-load-5 noctool::graph-5 *load-5-hash*)
@@ -107,51 +121,81 @@
load-10 (ensure-load-10 monitor))
(add-to widget load (mk-span " ") load-1 (mk-span " ") load-5 (mk-span " ") load-10))))
-(defensure ensure-monitor-widget (make-instance 'monitor :monitor instance) *monitor-hash*
+(defensure ensure-monitor-widget (make-instance 'monitor :monitor instance :css-class (alert-class (noctool::alert-level instance))) *monitor-hash*
(defmethod (setf noctool::alert-level) :after (new (instance (eql instance)))
(setf (css-class-of widget)
(alert-class (noctool::alert-level instance)))))
+(defmacro print-last-updated (instance)
+ `(handler-case (sb-int:format-universal-time NIL (noctool::last-updated ,instance))
+ (t () "Never")))
+
(defensure ensure-last-updated-widget
- (mk-span (sb-int:format-universal-time NIL (noctool::last-updated instance)))
+ (mk-span (print-last-updated instance)
+ :css-class (alert-class (noctool::alert-level 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))))
+ (sb-int:format-universal-time NIL new))
+ (setf (css-class-of widget)
+ (alert-class (noctool::alert-level instance)))))
(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)))
+ (let ((next-time (noctool-scheduler::time (noctool-scheduler::find-object instance noctool-scheduler::*default-scheduler*))))
+ (mk-span (if next-time
+ (sb-int:format-universal-time NIL next-time)
+ "None!") :css-class (alert-class (noctool::alert-level instance))))
+ *next-run-hash*
+ (defmethod noctool-scheduler::schedule :after ((object (eql instance)) time &optional scheduler)
(setf (html-of widget)
- (sb-int:format-universal-time NIL new))))
+ (sb-int:format-universal-time NIL time))
+ (setf (css-class-of widget)
+ (alert-class (noctool::alert-level instance)))))
(defensure ensure-last-rtt
(mk-span
(let ((idx (noctool-graphs::short-ix (noctool::graph instance))))
(format NIL "~A seconds"
(aref (noctool-graphs::short (noctool::graph instance))
- (mod (1- idx) 300)))))
+ (mod (1- idx) 300))))
+ :css-class (alert-class (noctool::alert-level instance)))
*last-rtt-hash*
(defmethod noctool::add-value :after ((graph (eql (noctool::graph instance))) value)
(setf (html-of widget)
(format NIL "~A seconds"
(aref (noctool-graphs::short
graph)
- (mod (1- (noctool-graphs::short-ix graph)) 300))))))
+ (mod (1- (noctool-graphs::short-ix graph)) 300))))
+ (setf (css-class-of widget)
+ (alert-class (noctool::alert-level instance)))))
(defensure ensure-last-failed
(mk-span
(format NIL "~A"
- (noctool::failed instance)))
+ (noctool::failed instance))
+ :css-class (alert-class (noctool::alert-level instance)))
*last-failed-hash*
(defmethod (setf noctool::failed) :after (new (instance (eql instance)))
(setf (html-of widget)
- (format NIL "~A" new))))
+ (format NIL "~A" new))
+ (setf (css-class-of widget)
+ (alert-class (noctool::alert-level instance)))))
+
+(defensure ensure-last-over-rtt
+ (mk-span
+ (format NIL "~A"
+ (noctool::over-rtt instance))
+ :css-class (alert-class (noctool::alert-level instance)))
+ *last-over-rtt-hash*
+ (defmethod (setf noctool::over-rtt) :after (new (instance (eql instance)))
+ (setf (html-of widget)
+ (format NIL "~A" new))
+ (setf (css-class-of widget)
+ (alert-class (noctool::alert-level instance)))))
(defensure ensure-last-load
(make-instance 'load-widget :monitor instance)
- *last-load-hash*
+ *last-load-hash*
())
(defensure ensure-noc-host-widget
@@ -174,13 +218,6 @@
(setf (css-class-of widget)
(alert-class (noctool::alert-level instance)))))
-(defmacro toggle (thing on-expr off-expr &key (default :on))
- (let ((v (gensym)))
- `(let ((,v (eq ,default :on)))
- (iambda
- (if (setf ,v (not ,v))
- ,on-expr
- ,off-expr)))))
(defmacro h/s (thing &key (hide "hide") (normal "normal"))
`(toggle ,thing
@@ -233,8 +270,12 @@
(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))))
+ (ensure-last-updated-widget mon)
+ (mk-span "Next Update: ")
+ (ensure-next-run mon)
+ (mk-span (who (:br))))))
(defmethod display-monitor-info ((mon noctool::disk-container))
(mk-container
@@ -242,8 +283,12 @@
(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)))
+ (mk-span "Next Update: ")
+ (ensure-next-run mon)
(mk-span (who (:br))))
(loop for disk in (noctool::disk-list mon)
nconc
@@ -260,12 +305,15 @@
(mk-span " Last Updated ")
(ensure-last-updated-widget mon)
(mk-span (who (:br)))
+ (mk-span "Next Update: ")
(ensure-next-run mon)
(mk-span (who (:br)))
(mk-span "last rtt: ")
(ensure-last-rtt mon)
(mk-span " failed: ")
(ensure-last-failed mon)
+ (mk-span " over rtt: ")
+ (ensure-last-over-rtt mon)
(mk-span (who (:br)))
)))
@@ -274,9 +322,13 @@
(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)))
+ (mk-span "Next Update: ")
+ (ensure-next-run mon)
+ (mk-span (who (:br)))
(ensure-last-load mon))))
(defapp noctool-app ()
More information about the noctool-cvs
mailing list