From jprewett at common-lisp.net Tue Dec 2 14:52:28 2008 From: jprewett at common-lisp.net (jprewett) Date: Tue, 02 Dec 2008 14:52:28 +0000 Subject: [noctool-cvs] CVS source Message-ID: 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 From jprewett at common-lisp.net Wed Dec 3 12:28:01 2008 From: jprewett at common-lisp.net (jprewett) Date: Wed, 03 Dec 2008 12:28:01 +0000 Subject: [noctool-cvs] CVS source Message-ID: 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 () From jprewett at common-lisp.net Wed Dec 3 14:58:53 2008 From: jprewett at common-lisp.net (jprewett) Date: Wed, 03 Dec 2008 14:58:53 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv8286 Modified Files: tests.lisp Log Message: changed monitor rescheduling so instead of an alerting monitor being run 5 times less frequently, its run twice as often. - it doesn't make sense to me why I would want to monitor a place where I think I'm having a problem *less* than usual! - Maybe I just *don't get it!* :P :) --- /project/noctool/cvsroot/source/tests.lisp 2008/12/03 12:28:01 1.11 +++ /project/noctool/cvsroot/source/tests.lisp 2008/12/03 14:58:53 1.12 @@ -35,9 +35,10 @@ (warn "no default scheduler!"))))))) (schedule monitor (+ (get-universal-time) - (* - (interval monitor) - (if (>= (alert-level monitor) *alerting*) 5 1)))))) + (ceiling + (* + (interval monitor) + (if (>= (alert-level monitor) *alerting*) .5 1))))))) (defmethod process ((monitor ping-monitor)) From jprewett at common-lisp.net Wed Dec 3 16:42:28 2008 From: jprewett at common-lisp.net (jprewett) Date: Wed, 03 Dec 2008 16:42:28 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv31184 Modified Files: config.lisp web.lisp Log Message: made it so objects loaded via config file have proper parents minor web ui fixups - more info about monitors! --- /project/noctool/cvsroot/source/config.lisp 2008/12/02 14:52:28 1.10 +++ /project/noctool/cvsroot/source/config.lisp 2008/12/03 16:42:28 1.11 @@ -143,16 +143,16 @@ (interval 60)) :machine (list max-rtt max-fail interval ping-count) - `(noctool::make-monitor 'ping-monitor ,*config-object* , at args)) + `(noctool::make-monitor 'ping-monitor ,*config-object* :parent ,*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)) + `(noctool::make-monitor 'load-monitor ,*config-object* :low-water ,low-water :high-water ,high-water :parent ,*config-object*)) (defmacro defmon (mon-class) (export (list mon-class)) `(defnested ,mon-class (&rest options) :machine - `(noctool::make-monitor ',',mon-class ,*config-object* , at options))) + `(noctool::make-monitor ',',mon-class ,*config-object* :parent ,*config-object* , at options))) (defmacro cluster ((fmt low high &optional (name nil) (c-fmt t)) form) (let ((format-string (if c-fmt --- /project/noctool/cvsroot/source/web.lisp 2008/12/03 12:28:01 1.3 +++ /project/noctool/cvsroot/source/web.lisp 2008/12/03 16:42:28 1.4 @@ -68,6 +68,7 @@ ;; XXX do I need all of these damn hashes??? (defvar *monitor-hash* (make-hash-table)) (defvar *last-updated-hash* (make-hash-table)) +(defvar *alert-level-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)) @@ -140,6 +141,16 @@ (setf (css-class-of widget) (alert-class (noctool::alert-level instance))))) +(defensure ensure-alert-level + (mk-span (format NIL "~A" (noctool::alert-level instance)) + :css-class (alert-class (noctool::alert-level instance))) + *alert-level-hash* + (defmethod (setf noctool::alert-level) :after (new (instance (eql instance))) + (setf (html-of widget) + (format NIL "~A" (noctool::alert-level instance))) + (setf (css-class-of widget) + (alert-class (noctool::alert-level instance))))) + (defensure ensure-next-run (let ((next-time (noctool-scheduler::time (noctool-scheduler::find-object instance noctool-scheduler::*default-scheduler*)))) (mk-span (if next-time @@ -268,8 +279,13 @@ (defmethod display-monitor-info (mon) (mk-container (list - (mk-div (noctool::name (noctool::equipment mon))) - (mk-span (symbol-name (class-name (class-of mon)))) + (mk-container + (list + (mk-span (noctool::name (noctool::equipment mon))) + (mk-span " Alert Level: ") + (ensure-alert-level (noctool::equipment mon)))) + (mk-span " Alert Level: ") + (ensure-alert-level mon) (mk-span (who (:br))) (mk-span " Last Updated ") (ensure-last-updated-widget mon) @@ -281,8 +297,14 @@ (mk-container (nconc (list - (mk-div (noctool::name (noctool::equipment mon))) + (mk-container + (list + (mk-span (noctool::name (noctool::equipment mon))) + (mk-span " Alert Level: ") + (ensure-alert-level (noctool::equipment mon)))) (mk-span (symbol-name (class-name (class-of mon)))) + (mk-span " Alert Level: ") + (ensure-alert-level mon) (mk-span (who (:br))) (mk-span " Last Updated ") (ensure-last-updated-widget mon) @@ -299,8 +321,14 @@ (defmethod display-monitor-info ((mon noctool::ping-monitor)) (mk-container (list - (mk-div (noctool::name (noctool::equipment mon))) + (mk-container + (list + (mk-span (noctool::name (noctool::equipment mon))) + (mk-span " Alert Level: ") + (ensure-alert-level (noctool::equipment mon)))) (mk-span (symbol-name (class-name (class-of mon)))) + (mk-span " Alert Level: ") + (ensure-alert-level mon) (mk-span (who (:br))) (mk-span " Last Updated ") (ensure-last-updated-widget mon) @@ -320,8 +348,14 @@ (defmethod display-monitor-info ((mon noctool::load-monitor)) (mk-container (list - (mk-div (noctool::name (noctool::equipment mon))) + (mk-container + (list + (mk-span (noctool::name (noctool::equipment mon))) + (mk-span " Alert Level: ") + (ensure-alert-level (noctool::equipment mon)))) (mk-span (symbol-name (class-name (class-of mon)))) + (mk-span " Alert Level: ") + (ensure-alert-level mon) (mk-span (who (:br))) (mk-span " Last Updated ") (ensure-last-updated-widget mon) @@ -365,6 +399,7 @@ (loop for eqp in systems do (add-to systems-pane eqp)) + (add-to systems-pane (mk-div "")) (add-to *root* systems-pane) (add-to *root* info-pane))) From jprewett at common-lisp.net Mon Dec 8 20:53:50 2008 From: jprewett at common-lisp.net (jprewett) Date: Mon, 08 Dec 2008 20:53:50 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv5171 Modified Files: config.lisp generics.lisp scheduler.lisp tests.lisp web.lisp Log Message: made various config objects set their PARENT slot made "multiple after methods" work for web UI --- /project/noctool/cvsroot/source/config.lisp 2008/12/03 16:42:28 1.11 +++ /project/noctool/cvsroot/source/config.lisp 2008/12/08 20:53:50 1.12 @@ -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* :parent ,*config-object*)))) + `(let ((*disk-container* (car (noctool::make-monitor 'noctool::disk-container ,*config-object*)))) ,@(mapcar #'macroexpand diskspec)))) (defnested disk (path disk-percent &optional (inodes-percent 90)) @@ -143,16 +143,16 @@ (interval 60)) :machine (list max-rtt max-fail interval ping-count) - `(noctool::make-monitor 'ping-monitor ,*config-object* :parent ,*config-object* , at args)) + `(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 :parent ,*config-object*)) + `(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 - `(noctool::make-monitor ',',mon-class ,*config-object* :parent ,*config-object* , at options))) + `(noctool::make-monitor ',',mon-class ,*config-object* , at options))) (defmacro cluster ((fmt low high &optional (name nil) (c-fmt t)) form) (let ((format-string (if c-fmt --- /project/noctool/cvsroot/source/generics.lisp 2008/03/17 08:27:58 1.1.1.1 +++ /project/noctool/cvsroot/source/generics.lisp 2008/12/08 20:53:50 1.2 @@ -2,7 +2,7 @@ (defun make-monitor (type kit &rest options) - (let ((monitor (apply 'make-instance type :equipment kit options))) + (let ((monitor (apply 'make-instance type :equipment kit :parent kit options))) (push monitor (monitors kit)))) (defun class-list-class (class) --- /project/noctool/cvsroot/source/scheduler.lisp 2008/12/03 12:28:01 1.14 +++ /project/noctool/cvsroot/source/scheduler.lisp 2008/12/08 20:53:50 1.15 @@ -4,7 +4,7 @@ (defvar *network-updates-needed* nil) (defvar *total-processes* - #+darwin 1 + #+darwin 8 #-darwin 32) (defvar *process-semaphore* (sb-thread:make-semaphore :name "Simultaneous processes" :count *total-processes*)) --- /project/noctool/cvsroot/source/tests.lisp 2008/12/03 14:58:53 1.12 +++ /project/noctool/cvsroot/source/tests.lisp 2008/12/08 20:53:50 1.13 @@ -3,9 +3,9 @@ ;; OK, this is *awesome* programming form, but... (defmacro without-errors (error-form &body body) `(handler-case , at body - (t (c) (progn - (warn "ignoring condition: ~A" c) - ,error-form)))) + (t (c) (progn + (warn "ignoring condition: ~A" c) + ,error-form)))) (defmethod process :around ((monitor monitor)) (unwind-protect --- /project/noctool/cvsroot/source/web.lisp 2008/12/03 16:42:28 1.4 +++ /project/noctool/cvsroot/source/web.lisp 2008/12/08 20:53:50 1.5 @@ -44,8 +44,7 @@ (defmacro defensure (name widget-form hash &body body) `(defmacro ,name (instance ) (with-gensyms ((val "VAL") - (foundp "FOUNDP") - (the-widget-form "WIDGET-FORM")) + (foundp "FOUNDP")) ` (multiple-value-bind (,val ,foundp) (gethash ,instance ,,hash) (if ,foundp @@ -79,6 +78,54 @@ (defvar *load-5-hash* (make-hash-table)) (defvar *load-10-hash* (make-hash-table)) +(defvar *method-hash* (make-hash-table :test #'equal)) + +(defmacro get-method-actions (method instance) + (let ((i instance)) + `(gethash (list ,method ,i) *method-hash*))) + +(defmacro add-method-actions (method instance action) + `(setf (get-method-actions ',method ,instance) + (append + (get-method-actions ',method ,instance) + (list ,action)))) + +(defmacro method-after-method (method instance (&rest args)) + (let ((actions (gensym)) + (action (gensym))) + `(defmethod ,method :after (, at args) + (let ((,actions (get-method-actions ',method ,instance))) + (mapcar + (lambda (,action) + (funcall ,action ,@(mapcan (lambda (x) + (cond ((listp x) + (list (car x))) + ((eql x '&optional) + ()) + (t (list x)))) + args))) + ,actions))))) + +(defmacro defaftermethod (method instance widget-form (&rest lambda-list) &body body) + (let ((func (gensym)) + (actions (gensym)) + (action (gensym)) + (reduced-lambda-list (gensym))) + `(let* ((instance ,instance) + (widget ,widget-form) + (,func #'(lambda (,@(mapcan (lambda (x) + (cond ((listp x) + (list (car x))) + ((eql x '&optional) + ()) + (t (list x)))) + lambda-list)) + , at body))) + ;; set up the after method + (method-after-method ,method ,instance ,lambda-list) + ;; add this func to the list + (add-method-actions ,method ,instance ,func)))) + (defmacro ensure-load (name graph-slot hash) (with-gensyms ((graph "GRAPH") (span "SPAN")) `(defensure ,name @@ -92,8 +139,8 @@ :css-class (alert-class (noctool::alert-level instance))))) ,span) ,hash - (defmethod noctool::add-value - :after ((graph (eql (slot-value instance ',graph-slot))) value) + (defaftermethod noctool::add-value instance widget + ((graph (eql (slot-value instance ',graph-slot))) value) (setf (html-of widget) (format NIL "~2$" @@ -123,9 +170,10 @@ (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 :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))))) + (let ((i instance)) + (defaftermethod (setf noctool::alert-level) instance widget (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)) @@ -135,7 +183,7 @@ (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))) + (defaftermethod (setf noctool::last-updated) instance widget (new (instance (eql instance))) (setf (html-of widget) (sb-int:format-universal-time NIL new)) (setf (css-class-of widget) @@ -145,7 +193,7 @@ (mk-span (format NIL "~A" (noctool::alert-level instance)) :css-class (alert-class (noctool::alert-level instance))) *alert-level-hash* - (defmethod (setf noctool::alert-level) :after (new (instance (eql instance))) + (defaftermethod (setf noctool::alert-level) instance widget (new (instance (eql instance))) (setf (html-of widget) (format NIL "~A" (noctool::alert-level instance))) (setf (css-class-of widget) @@ -157,7 +205,7 @@ (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) + (defaftermethod noctool-scheduler::schedule instance widget ((object (eql instance)) time &optional scheduler) (setf (html-of widget) (sb-int:format-universal-time NIL time)) (setf (css-class-of widget) @@ -171,7 +219,7 @@ (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) + (defaftermethod noctool::add-value instance widget ((graph (eql (noctool::graph instance))) value) (setf (html-of widget) (format NIL "~A seconds" (aref (noctool-graphs::short @@ -186,7 +234,7 @@ (noctool::failed instance)) :css-class (alert-class (noctool::alert-level instance))) *last-failed-hash* - (defmethod (setf noctool::failed) :after (new (instance (eql instance))) + (defaftermethod (setf noctool::failed) instance widget (new (instance (eql instance))) (setf (html-of widget) (format NIL "~A" new)) (setf (css-class-of widget) @@ -198,7 +246,7 @@ (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))) + (defaftermethod (setf noctool::over-rtt) instance widget (new (instance (eql instance))) (setf (html-of widget) (format NIL "~A" new)) (setf (css-class-of widget) @@ -214,8 +262,8 @@ :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))) + (defaftermethod (setf noctool::alert-level) + instance widget (new-val (host (eql instance))) (setf (css-class-of widget) (alert-class (noctool::alert-level instance))))) @@ -224,8 +272,8 @@ (setf (css-class-of widget) (alert-class (noctool::alert-level instance))) widget) *disk-widget-hash* - (defmethod (setf noctool::alert-level) - :after (new-val (host (eql instance))) + (defaftermethod (setf noctool::alert-level) + instance widget (new-val (host (eql instance))) (setf (css-class-of widget) (alert-class (noctool::alert-level instance))))) From jprewett at common-lisp.net Thu Dec 11 20:24:52 2008 From: jprewett at common-lisp.net (jprewett) Date: Thu, 11 Dec 2008 20:24:52 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv4266 Modified Files: web.lisp Log Message: got rid of hunchentoot dependencies (since SymbolicWeb got rid of HT dependencies) --- /project/noctool/cvsroot/source/web.lisp 2008/12/08 20:53:50 1.5 +++ /project/noctool/cvsroot/source/web.lisp 2008/12/11 20:24:52 1.6 @@ -1,20 +1,13 @@ (in-package :sw) (eval-when (:compile-toplevel :load-toplevel :execute) - (require :hunchentoot) (require :cl-who) (require :symbolicweb) - (use-package :hunchentoot) (use-package :cl-who) (use-package :symbolicweb)) (setf *SHOW-LISP-BACKTRACES-P* t) (setf *SHOW-LISP-ERRORS-P* t) -(setf CHUNGA:*ACCEPT-BOGUS-EOLS* t) - -;; turn off SW debugging -(setf *sw-debug* NIL) - ;; with-gensyms is modified from Paul Graham On Lisp (defmacro with-gensyms (symbols &body body) @@ -451,15 +444,11 @@ (add-to *root* systems-pane) (add-to *root* info-pane))) -(push (hunchentoot::create-static-file-dispatcher-and-handler "/noctool.css" "/noctool/source/noctool.css" "text/css") (tbnl:server-dispatch-table (sw::ht-server-instance-of sw::*server*))) +;; (push (hunchentoot::create-static-file-dispatcher-and-handler "/noctool.css" "/noctool/source/noctool.css" "text/css") (tbnl:server-dispatch-table (sw::ht-server-instance-of sw::*server*))) (defun noctool-image-dispatch () ()) -;; XXX unimplemented! -(push (create-prefix-dispatcher "/images/" #'noctool-image-dispatch) - *dispatch-table*) - (defvar *unwanted-monitors* '(noctool::cpu-monitor)) (defun schedule-all-monitors () From jprewett at common-lisp.net Fri Dec 19 21:14:23 2008 From: jprewett at common-lisp.net (jprewett) Date: Fri, 19 Dec 2008 21:14:23 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv31647 Modified Files: classes.lisp graph-monitors.lisp graph-utils.lisp graphing.lisp scheduler.lisp tests.lisp utils.lisp web.lisp Log Message: added PING-INTERVAL slot to PING-MONITOR class made SHOW method on PING-MONITOR return the image reworked how PROCESS works with PING-MONITOR uses new slot made MAKE-PING take keyword args instead of optional, added interval arg fixes with web UI --- /project/noctool/cvsroot/source/classes.lisp 2008/12/03 12:28:01 1.16 +++ /project/noctool/cvsroot/source/classes.lisp 2008/12/19 21:14:23 1.17 @@ -141,8 +141,9 @@ (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) - ) + (graph :reader graph :initarg :graph :initform nil) + (ping-interval :reader ping-interval :initarg :ping-interval + :initform (if (eql 0 (sb-posix:geteuid)) 0.1 1))) (:default-initargs :interval 60)) (defmethod initialize-instance :after ((instance ping-monitor) &key) --- /project/noctool/cvsroot/source/graph-monitors.lisp 2008/06/22 11:02:21 1.6 +++ /project/noctool/cvsroot/source/graph-monitors.lisp 2008/12/19 21:14:23 1.7 @@ -79,9 +79,10 @@ (let ((image (image:make-image 350 140))) (image:rect image 0 0 349 139 t 240 240 240) (multiple-value-bind (percentile max scale) - (show (noctool::graph graph) image nil :selector selector :scale scale) + (show (noctool::graph graph) image format :selector selector :scale scale) (graph-ignore percentile max scale) - ))) + ) + image)) (defmethod show ((graph noctool::disk-container) sink format &key (selector :short) scale &allow-other-keys) (graph-ignore scale) --- /project/noctool/cvsroot/source/graph-utils.lisp 2008/03/17 08:27:58 1.1.1.1 +++ /project/noctool/cvsroot/source/graph-utils.lisp 2008/12/19 21:14:23 1.2 @@ -21,7 +21,6 @@ (display :reader display :initarg :display) )) - (defmacro add-graph-info (monitor slot data display) `(push (make-instance 'graph-info :slot ',slot @@ -29,6 +28,7 @@ :display ',display) (gethash ',monitor *monitor-graph-map*))) + (defun add-graphs (monitor) (let ((class (class-name (class-of monitor)))) (let ((graphs (gethash class *monitor-graph-map*))) --- /project/noctool/cvsroot/source/graphing.lisp 2008/09/22 05:49:24 1.8 +++ /project/noctool/cvsroot/source/graphing.lisp 2008/12/19 21:14:23 1.9 @@ -278,9 +278,9 @@ (/ height percentile))))) (loop for n from 0 for value across data - do (when (> value 0) - (plot-data sink - (+ base-x n) base-y (max 0 (round (* value scale))) - style color))) + do (if (>= value 0) + (plot-data sink + (+ base-x n) base-y (max 0 (round (* value scale))) + style color))) (values percentile (reduce #'max tmpdata) scale)))))) --- /project/noctool/cvsroot/source/scheduler.lisp 2008/12/08 20:53:50 1.15 +++ /project/noctool/cvsroot/source/scheduler.lisp 2008/12/19 21:14:23 1.16 @@ -207,7 +207,7 @@ (sb-thread:make-thread #'(lambda () (handler-case - (sb-ext:with-timeout 3000 + (sb-ext:with-timeout 10000 (noc-thread (process (object event)))) (sb-ext::timeout () (warn "Timing out thread ~A~%" sb-thread:*current-thread*)))) --- /project/noctool/cvsroot/source/tests.lisp 2008/12/08 20:53:50 1.13 +++ /project/noctool/cvsroot/source/tests.lisp 2008/12/19 21:14:23 1.14 @@ -43,21 +43,22 @@ (defmethod process ((monitor ping-monitor)) (without-errors NIL - (let ((kit (equipment monitor))) - (let ((data (make-ping (name kit)))) - (let ((failed (count -1.0 data :test #'=)) - (over-rtt (count (max-rtt monitor) data :test #'<))) - (setf (alert-level monitor) - (decay-alert (alert-level monitor) - (+ (if (>= failed (max-fail monitor)) - *alerting* - 0) - (* 10 failed) - (* 5 over-rtt))) - (failed monitor) failed - (over-rtt monitor) over-rtt) - (when (graph monitor) - (add-value (graph monitor) (reduce #'max data)))))))) + (with-slots (equipment ping-count ping-interval max-rtt alert-level max-fail graph) monitor + (let ((kit equipment)) + (let ((data (make-ping (name kit) :interval ping-interval :count ping-count))) + (let ((failed (count -1.0 data :test #'=)) + (over-rtt (count max-rtt data :test #'<))) + (setf alert-level + (decay-alert alert-level + (+ (if (>= failed max-fail) + *alerting* + 0) + (* 10 failed) + (* 5 over-rtt))) + (failed monitor) failed + (over-rtt monitor) over-rtt) + (when graph + (add-value graph (reduce #'max data))))))))) (defgeneric process-disk (monitor host)) (defgeneric process-df (host pty)) --- /project/noctool/cvsroot/source/utils.lisp 2008/12/03 12:28:01 1.12 +++ /project/noctool/cvsroot/source/utils.lisp 2008/12/19 21:14:23 1.13 @@ -76,8 +76,7 @@ eof-value) (read-line pty))) - -(defun make-ping (host &optional (count 5)) +(defun make-ping (host &key (count 5) (interval 1)) "Start a ping session to HOST, sending COUNT (default 5) packets. This function will need tailoring depending on the host OS. @@ -85,7 +84,9 @@ Return a vector with ms response times (using -1.0 as a placeholder for missed values)." - (let ((args `("ping" "-c" ,(format nil "~d" count) ,host)) + (let ((args `("ping" "-c" ,(format nil "~d" count) + "-i" ,(format nil "~d" interval) + ,host)) (rv (make-array count :initial-element -1.0))) (with-pty (run-command args) (loop for line = (read-pty-line pty nil) --- /project/noctool/cvsroot/source/web.lisp 2008/12/11 20:24:52 1.6 +++ /project/noctool/cvsroot/source/web.lisp 2008/12/19 21:14:23 1.7 @@ -52,26 +52,21 @@ (declare (ignore thing)) (let ((v (gensym))) `(let ((,v (eq ,default :on))) - (iambda + (iambda (if (setf ,v (not ,v)) - ,on-expr - ,off-expr))))) + ,on-expr + ,off-expr))))) + +(defmacro defhashes (&rest hashes) + (cons 'progn + (loop for hash in hashes collect + (if (listp hash) + `(defvar ,(car hash) (make-hash-table :test ,(cadr hash))) + `(defvar ,hash (make-hash-table)))))) ;; XXX do I need all of these damn hashes??? -(defvar *monitor-hash* (make-hash-table)) -(defvar *last-updated-hash* (make-hash-table)) -(defvar *alert-level-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)) -(defvar *load-5-hash* (make-hash-table)) -(defvar *load-10-hash* (make-hash-table)) +(defhashes *MONITOR-HASH* *LAST-UPDATED-HASH* *ALERT-LEVEL-HASH* *NEXT-RUN-HASH* *LAST-RTT-HASH* *LAST-FAILED-HASH* *LAST-OVER-RTT-HASH* *LAST-LOAD-HASH* *DISK-WIDGET-HASH* *LOAD-1-HASH* *LOAD-5-HASH* *LOAD-10-HASH* (*METHOD-HASH* #'equal)) -(defvar *method-hash* (make-hash-table :test #'equal)) (defmacro get-method-actions (method instance) (let ((i instance)) @@ -142,6 +137,13 @@ (setf (css-class-of widget) (alert-class (noctool::alert-level instance))))))) +(defun class-graphs (class) + (mapcar #'noctool-graphs::slot + (gethash (class-name (find-class class)) + noctool-graphs::*monitor-graph-map*))) + + + (ensure-load ensure-load-1 noctool::graph-1 *load-1-hash*) (ensure-load ensure-load-5 noctool::graph-5 *load-5-hash*) (ensure-load ensure-load-10 noctool::graph-10 *load-10-hash*) @@ -299,23 +301,28 @@ (add-to namebox namelink) (add-to eqp namebox) (setf (css-class-of monitorbox) "hide") - (setf (on-click-of namelink) - (h/s monitorbox)) + (let ((h/s (h/s monitorbox))) + (setf (on-click-of namelink) + (lambda (&rest rest) + (declare (ignore rest)) + (remove-all (cadr (children-of *root*))) + (funcall h/s)))) (add-to eqp monitorbox) (loop for mon in (noctool::monitors system) do (let ((link (mk-link (ensure-monitor-widget mon) :href "#")) (mon2 mon)) (add-to monitorbox link) - (setf (on-click-of link) - (iambda - (if (eql (info-show *app*) mon2) - (progn - (remove-all (info-pane *app*)) - (setf (info-show *app*) NIL)) - (let ((info (display-monitor-info mon2))) - (remove-all (info-pane *app*)) - (add-to (info-pane *app*) info) - (setf (info-show *app*) mon2)))))))))) + (let ((info-show NIL)) + (setf (on-click-of link) + (iambda + (if (eql info-show mon2) + (progn + (remove-all (cadr (children-of *root*))) + (setf info-show NIL)) + (let ((info (display-monitor-info mon2))) + (remove-all (cadr (children-of *root*))) + (add-to (cadr (children-of *root*)) info) + (setf info-show mon2))))))))))) (defmethod display-monitor-info (mon) (mk-container @@ -411,15 +418,7 @@ ;; :allocation :class :initform (loop for eqp in noctool::*equipment* collect - (make-instance 'eqp :system eqp))) - (systems-pane :accessor systems-pane :initform (mk-container NIL)) - (info-show :accessor info-show :initform NIL) - (info-pane :accessor info-pane :initform (mk-container NIL)))) - -(defmethod initialize-instance :AFTER ((app noctool-app) &key) - (with-slots (systems-pane info-pane) app - (setf (css-class-of systems-pane) "systems") - (setf (css-class-of info-pane) "zoom"))) + (make-instance 'eqp :system eqp))))) (set-uri 'noctool-app "/") @@ -427,27 +426,26 @@ (who (:html (:head - (:title "Noctool") + (:title (str (format NIL "~A NOCTool" (sb-unix:unix-gethostname)))) (str (js-sw-headers app)) - (:link :rel :stylesheet :type :text/css :href "/noctool.css")) + (:link :rel :stylesheet :type :text/css :href "/static/noctool.css")) (:body (str (sw-heading :title (string-downcase (princ-to-string (type-of app))))) (:div :id "sw-root") (:noscript "JavaScript needs to be enabled."))))) (defmethod render-viewport ((viewport viewport) (app noctool-app)) - (with-slots (systems systems-pane info-pane) app - (loop for eqp in systems - do - (add-to systems-pane eqp)) - (add-to systems-pane (mk-div "")) - (add-to *root* systems-pane) - (add-to *root* info-pane))) - -;; (push (hunchentoot::create-static-file-dispatcher-and-handler "/noctool.css" "/noctool/source/noctool.css" "text/css") (tbnl:server-dispatch-table (sw::ht-server-instance-of sw::*server*))) - -(defun noctool-image-dispatch () - ()) + (let ((systems-pane (mk-container NIL)) + (info-pane (mk-container NIL))) + (setf (css-class-of systems-pane) "systems") + (setf (css-class-of info-pane) "zoom") + (with-slots (systems) app + (loop for eqp in noctool::*equipment* + do + (add-to systems-pane (make-instance 'eqp :system eqp))) + (add-to systems-pane (mk-div "")) + (add-to *root* systems-pane) + (add-to *root* info-pane)))) (defvar *unwanted-monitors* '(noctool::cpu-monitor)) @@ -460,4 +458,5 @@ (member (type-of x) *unwanted-monitors*)) (noctool::monitors equipment)) do - (noctool::schedule mon (1+ (get-universal-time)))))) \ No newline at end of file + (noctool::schedule mon (1+ (get-universal-time)))))) + From jprewett at common-lisp.net Fri Dec 19 22:19:26 2008 From: jprewett at common-lisp.net (jprewett) Date: Fri, 19 Dec 2008 22:19:26 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv17710 Modified Files: web.lisp Log Message: more web fixups - now web ui is *independant* in different tabs --- /project/noctool/cvsroot/source/web.lisp 2008/12/19 21:14:23 1.7 +++ /project/noctool/cvsroot/source/web.lisp 2008/12/19 22:19:26 1.8 @@ -297,7 +297,8 @@ (defmethod initialize-instance :AFTER ((eqp eqp) &key) (with-slots (system namebox monitorbox) eqp - (let ((namelink (mk-link (ensure-noc-host-widget system)))) + (let ((namelink (mk-link (ensure-noc-host-widget system))) + (info-show NIL)) (add-to namebox namelink) (add-to eqp namebox) (setf (css-class-of monitorbox) "hide") @@ -306,23 +307,24 @@ (lambda (&rest rest) (declare (ignore rest)) (remove-all (cadr (children-of *root*))) - (funcall h/s)))) + (funcall h/s) + (setf (visible *app*) NIL)))) (add-to eqp monitorbox) (loop for mon in (noctool::monitors system) do (let ((link (mk-link (ensure-monitor-widget mon) :href "#")) (mon2 mon)) (add-to monitorbox link) - (let ((info-show NIL)) (setf (on-click-of link) (iambda - (if (eql info-show mon2) + (if (equal (visible *app*) mon2) (progn + (warn "~A and ~A are same" mon2 (visible *app*)) (remove-all (cadr (children-of *root*))) - (setf info-show NIL)) + (setf (visible *app*) NIL)) (let ((info (display-monitor-info mon2))) (remove-all (cadr (children-of *root*))) (add-to (cadr (children-of *root*)) info) - (setf info-show mon2))))))))))) + (setf (visible *app*) mon2)))))))))) (defmethod display-monitor-info (mon) (mk-container @@ -418,7 +420,8 @@ ;; :allocation :class :initform (loop for eqp in noctool::*equipment* collect - (make-instance 'eqp :system eqp))))) + (make-instance 'eqp :system eqp))) + (visible :accessor visible :initform NIL))) (set-uri 'noctool-app "/") From jprewett at common-lisp.net Mon Dec 22 15:28:53 2008 From: jprewett at common-lisp.net (jprewett) Date: Mon, 22 Dec 2008 15:28:53 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv25726 Modified Files: graph-monitors.lisp Log Message: added background keyword to SHOW method to specify background color --- /project/noctool/cvsroot/source/graph-monitors.lisp 2008/12/19 21:14:23 1.7 +++ /project/noctool/cvsroot/source/graph-monitors.lisp 2008/12/22 15:28:53 1.8 @@ -75,9 +75,10 @@ 0 0 0)))))))) -(defmethod show ((graph noctool::ping-monitor) sink format &key (selector :short) scale &allow-other-keys) +(defmethod show ((graph noctool::ping-monitor) sink format &key (selector :short) (background '(240 240 240)) + scale &allow-other-keys) (let ((image (image:make-image 350 140))) - (image:rect image 0 0 349 139 t 240 240 240) + (apply #'image:rect image 0 0 349 139 t background) (multiple-value-bind (percentile max scale) (show (noctool::graph graph) image format :selector selector :scale scale) (graph-ignore percentile max scale) @@ -112,12 +113,12 @@ t (nth 0 color) (nth 1 color)(nth 2 color))))) image))) -(defmethod show ((graph noctool::disk-container) sink format &key (selector :short) scale &allow-other-keys) +(defmethod show ((graph noctool::disk-container) sink format &key (selector :short) (background '(192 192 192)) scale &allow-other-keys) (graph-ignore scale) (let ((lines (length (noctool::disk-list graph))) (disks (sort (copy-list (noctool::disk-list graph)) #'> :key #'noctool::disk-max))) (let ((image (image:make-image 350 (+ 130 (* 10 lines))))) - (image:rect image 0 0 349 (1- (image::height image)) t 192 192 192) + (apply #'image:rect image 0 0 349 (1- (image::height image)) t background) (multiple-value-bind (percentile max scale) (show (noctool::disk-graph (car disks)) image nil :color '(0 0 0 0.0) :base-x 25 :base-y 110 :height 100