[noctool-cvs] CVS source

jprewett jprewett at common-lisp.net
Wed Nov 12 21:56:25 UTC 2008


Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv18109

Modified Files:
	tests.lisp 
Log Message:

ERRORS?  ERRORS? We don't >>NEED<< no stinking errors!

added without-errors macro to discard any error conditions

wrapped just about everything in it

moved rescheduling monitors into an around method global to all monitors



--- /project/noctool/cvsroot/source/tests.lisp	2008/08/29 17:29:45	1.8
+++ /project/noctool/cvsroot/source/tests.lisp	2008/11/12 21:56:24	1.9
@@ -1,34 +1,40 @@
 (in-package #:net.hexapodia.noctool)
 
-(defmethod process :around ((monitor monitor))
-  (if (host-pings monitor)
-      (call-next-method)
-    (schedule monitor (+ (get-universal-time) (interval monitor)))))
+;; 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))))
 
-(defmethod process :around ((monitor ping-monitor))
-  (call-next-method))
+(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))))
 
 (defmethod process ((monitor ping-monitor))
-  (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))))
-	(when (graph monitor)
-	  (add-value (graph monitor) (reduce #'max data)))
-	(let ((now (get-universal-time)))
-	  (setf (last-updated monitor) now)
-	  (schedule monitor
-		  (+ now
-		     (*
-		      (interval monitor)
-		      (if (>= (alert-level monitor) *alerting*) 5 1)))))))))
+  (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))))
+          (when (graph monitor)
+            (add-value (graph monitor) (reduce #'max data))))))))
 
 (defgeneric process-disk (monitor host))
 (defgeneric process-df (host pty))
@@ -67,10 +73,12 @@
 
 (defmethod process-df (host pty)
   (declare (ignore host))
-  (parse-df pty))
+  (without-errors NIL
+    (parse-df pty)))
 
 (defmethod process-disk ((monitor disk-container) (host linux-host))
-  (with-pty (pty (make-ssh-command "df" (address host) (username host)))
+  (without-errors NIL
+      (with-pty (pty (make-ssh-command "df" (address host) (username host)))
     ;; Process disk block usage
     (loop for split in (parse-df pty)
        do
@@ -100,6 +108,7 @@
                  (setf (mountpoint platter) mount)
                  (setf (disk-free platter) free)
                  (add-value (disk-graph platter) used)
+                 (setf (last-updated platter) (get-universal-time))
                  (let ((percent (if (= 0 disk) 100 (* 100 (/ used disk)))))
                    (setf (alert-level platter)
                          (decay-alert
@@ -109,38 +118,32 @@
                                 ((<= (* 0.9 (disk-percent platter))
                                      percent)
                                  *warning*)
-                                (t 0)))))))))))))
+                                (t 0))))))))))))))
 
 (defmethod process ((monitor disk-container))
-    (process-disk monitor (equipment monitor)) 
-    (let ((now (get-universal-time)))
-      (setf (last-updated monitor) now)
-      (schedule monitor (+ now
-			   (interval monitor))))
-    )
+  (without-errors NIL
+    (process-disk monitor (equipment monitor))))
 
 (defmethod process ((monitor load-monitor))
-  (with-pty (pty (make-ssh-command "uptime" (address (equipment monitor)) (username (equipment monitor))))
-    (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 (nth 0 loads))))
-	  (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 (nth 1 loads)))
-	  (add-value (graph-10 monitor) (read-from-string (nth 2 loads)))))))
-  (schedule monitor
-	    (+ (get-universal-time)
-	       (interval 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)
+                                              (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")))))))))
 
 (defmethod process ((monitor tcp-monitor))
   (when (and (sent-data monitor)





More information about the noctool-cvs mailing list