[noctool-cvs] CVS source

jprewett jprewett at common-lisp.net
Fri May 16 19:23:09 UTC 2008


Update of /project/noctool/cvsroot/source
In directory clnet:/tmp/cvs-serv26803

Modified Files:
	config.lisp scheduler.lisp tests.lisp 
Log Message:

made ip nested macro create ping monitor for the equipment

made process method with event argument use no-noctool-threads feature to turn off creating a separate thread (to help with debugging!).

wrote parse-df function to parse the output of df into a list of lists, each list containing the contents of one disk entry (which is not necessarily one line, at least on my systems).

rewrote process-disk to use parse-df function



--- /project/noctool/cvsroot/source/config.lisp	2008/03/17 08:27:58	1.1.1.1
+++ /project/noctool/cvsroot/source/config.lisp	2008/05/16 19:23:06	1.2
@@ -91,7 +91,9 @@
 
 (defnested ip (address)
   :machine
-  `(setf (slot-value ,*config-object* 'noctool::address) ,address))
+  `(progn
+     (setf (slot-value ,*config-object* 'noctool::address) ,address)
+     (noctool::make-monitor 'noctool::ping-monitor ,*config-object*)))
 
 (defmacro defmon (mon-class)
   (export (list mon-class))
--- /project/noctool/cvsroot/source/scheduler.lisp	2008/03/17 08:27:58	1.1.1.1
+++ /project/noctool/cvsroot/source/scheduler.lisp	2008/05/16 19:23:06	1.2
@@ -129,5 +129,9 @@
   (loop for event in (events slot)
 	do (process event)))
 
+
 (defmethod process ((event event))
-  (sb-thread:make-thread (lambda () (process (object event)))))
+  #-no-noctool-threads
+  (sb-thread:make-thread (lambda () (process (object event))))
+  #+no-noctool-threads  
+  (process (object event)))
\ No newline at end of file
--- /project/noctool/cvsroot/source/tests.lisp	2008/03/17 08:27:58	1.1.1.1
+++ /project/noctool/cvsroot/source/tests.lisp	2008/05/16 19:23:08	1.2
@@ -30,50 +30,65 @@
 
 (defgeneric process-disk (monitor host))
 
+(defun parse-df (pty)
+  "parse output from df from the given pty"
+  (read-pty-line pty) ;; throw away informational line
+  (let ((ret NIL))
+    (loop for line = (read-pty-line pty nil)
+       for split = (split-line line)
+       with last = NIL
+       for len = (+ (length split) (length last))
+       while line
+       when (> 6 len)
+       do
+         (setf last split)
+       else
+       do
+         (push (nconc last split) ret)
+         (setf last NIL))
+    ret))
+
+
 (defmethod process-disk ((monitor disk-container) (host linux-host))
   (with-pty (pty (make-ssh-command "df" (address host) (username host)))
     ;; Process disk block usage
-    (read-pty-line pty)
-    (loop for line = (read-pty-line pty nil)
-	  while line
-	  do
-	  (let ((split (split-line line)))
-	    (destructuring-bind (device disk used free percent mount)
-		split
-	      (declare (ignore percent))
-	      (unless (member device (ignore-list monitor) :test #'string=)
-		(let ((disk (parse-integer disk))
-		      (used (parse-integer used))
-		      (free (parse-integer free)))
-		  (let ((platter (find device (disk-list monitor)
-				       :test #'string=
-				       :key 'device)))
-		    (unless platter
-		      (setf platter
-			    (make-instance 'disk-monitor
-					   :device device
-					   :equipment (equipment monitor)
-					   :disk-max disk
-					   :interval (interval monitor)))
-		      (add-graphs platter)
-		      (push platter
-			    (disk-list monitor)))
+    (loop for split in (parse-df pty)
+       do
+       (destructuring-bind (device disk used free percent mount)
+           split
+         (declare (ignore percent))
+         (unless (member device (ignore-list monitor) :test #'string=)
+           (let ((disk (parse-integer disk))
+                 (used (parse-integer used))
+                 (free (parse-integer free)))
+             (let ((platter (find device (disk-list monitor)
+                                  :test #'string=
+                                  :key 'device)))
+               (unless platter
+                 (setf platter
+                       (make-instance 'disk-monitor
+                                      :device device
+                                      :equipment (equipment monitor)
+                                      :disk-max disk
+                                      :interval (interval monitor)))
+                 (add-graphs platter)
+                 (push platter
+                       (disk-list monitor)))
 		    
-		    (when platter
-		      (setf (mountpoint platter) mount)
-		      (setf (disk-free platter) free)
-		      (add-value (disk-graph platter) used)
-		      (let ((percent (* 100 (/ used disk))))
-			(setf (alert-level platter)
-			      (decay-alert
-			       (alert-level platter)
-			       (cond ((<= (disk-percent platter) percent)
-				      *alerting*)
-				     ((<= (* 0.9 (disk-percent platter))
-					  percent)
-				      *warning*)
-				     (t 0))))))))))))))
-
+               (when platter
+                 (setf (mountpoint platter) mount)
+                 (setf (disk-free platter) free)
+                 (add-value (disk-graph platter) used)
+                 (let ((percent (* 100 (/ used disk))))
+                   (setf (alert-level platter)
+                         (decay-alert
+                          (alert-level platter)
+                          (cond ((<= (disk-percent platter) percent)
+                                 *alerting*)
+                                ((<= (* 0.9 (disk-percent platter))
+                                     percent)
+                                 *warning*)
+                                (t 0)))))))))))))
 
 (defmethod process ((monitor disk-container))
   (process-disk monitor (equipment monitor))




More information about the noctool-cvs mailing list