From imattsson at common-lisp.net  Tue Aug 12 05:54:05 2008
From: imattsson at common-lisp.net (imattsson)
Date: Tue, 12 Aug 2008 01:54:05 -0400 (EDT)
Subject: [noctool-cvs] CVS source/docs
Message-ID: <20080812055405.7232F67045@common-lisp.net>

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

Modified Files:
	noctool-protocol.txt 
Log Message:
IM

Ooops, un-checked-in protocol spec.
Minor differences.


--- /project/noctool/cvsroot/source/docs/noctool-protocol.txt	2008/06/17 06:00:32	1.3
+++ /project/noctool/cvsroot/source/docs/noctool-protocol.txt	2008/08/12 05:54:04	1.4
@@ -56,4 +56,4 @@
 
 **Deleting proxies
   (delete-proxy-equipment <id>)
-  (delete-proxy-monitor <id>)
+  (delete-proxy-graph <id>)



From imattsson at common-lisp.net  Wed Aug 13 05:56:30 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 13 Aug 2008 01:56:30 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080813055630.825BE3700D@common-lisp.net>

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

Modified Files:
	scheduler.lisp 
Log Message:
IM

Added a scheduler loop and a control variable.


--- /project/noctool/cvsroot/source/scheduler.lisp	2008/07/09 14:40:06	1.5
+++ /project/noctool/cvsroot/source/scheduler.lisp	2008/08/13 05:56:29	1.6
@@ -2,6 +2,7 @@
 
 (defvar *default-scheduler* nil)
 (defvar *network-updates-needed* nil)
+(defvar *scheduler-loop-control* nil "Set to NIL to terminate a running scheduler loop")
 
 (defclass event ()
   ((time :reader time :initarg :time)
@@ -146,3 +147,12 @@
   (let ((obj (net.hexapodia.noctool-scheduler::object event)))
     (when (or (proxies (equipment obj)) (proxies obj))
       (push obj *network-updates-needed*))))
+
+(defun scheduler-loop ()
+  (setf *scheduler-loop-control* t)
+  (loop while *scheduler-loop-control*
+	do (let ((next (next-time)))
+	     (cond ((null next) (sleep 60))
+		   ((<= next (get-universal-time)) (process (next-timeslot)))
+		   (t (sleep (min 1 (- next (get-universal-time))))
+		      (process (next-timeslot)))))))



From imattsson at common-lisp.net  Wed Aug 13 05:58:43 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 13 Aug 2008 01:58:43 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080813055843.AD55E8317D@common-lisp.net>

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

Modified Files:
	classes.lisp 
Log Message:
IM

Added an ENQUEUE generic function and methods for EQUIPMENT and MONITOR.
The idea is that the monitors get enqueued with a random wait time.


--- /project/noctool/cvsroot/source/classes.lisp	2008/07/09 14:40:07	1.11
+++ /project/noctool/cvsroot/source/classes.lisp	2008/08/13 05:58:43	1.12
@@ -248,3 +248,11 @@
   (:default-initargs :display-objects nil))
 
 
+(defgeneric initial-enqueue (object))
+(defmethod initial-enqueue ((object equipment))
+  (loop for mon in (monitors object)
+	do (initial-enqueue mon)))
+(defmethod initial-enqueue ((object monitor))
+  (noctool-scheduler:schedule object (+ 1
+					(get-universal-time)
+					(random (interval mon)))))



From jprewett at common-lisp.net  Tue Aug 26 15:54:30 2008
From: jprewett at common-lisp.net (jprewett)
Date: Tue, 26 Aug 2008 11:54:30 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080826155430.22FFED091@common-lisp.net>

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

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

added scaffolding to make it easier to get the alert-level of any object
without querying its children.

This should make it easier to instrument the code for web display stuff (I hope)





--- /project/noctool/cvsroot/source/classes.lisp	2008/08/13 05:58:43	1.12
+++ /project/noctool/cvsroot/source/classes.lisp	2008/08/26 15:54:29	1.13
@@ -13,19 +13,34 @@
 (defmacro get-instance-by-id (id-string)
   `(gethash ,id-string *id-objects*))
 
-(defclass equipment (id-object)
+(defclass parented-object ()
+  ((parent :accessor parent :initform NIL :initarg :parent)))
+
+(defclass alert-level ()
+  ((alert-level :accessor alert-level :initarg :alert-level :initform 0)))
+
+(defmethod (setf alert-level) :AFTER (new (alert-level alert-level))
+  (when (slot-exists-p alert-level 'parent)
+    (if (parent alert-level)
+        (update-alert (parent alert-level)))))
+
+
+(defclass equipment (id-object alert-level)
   ((monitors :accessor monitors :initarg :monitors :initform nil)
    (name :reader name :initarg :name)
    (address :reader address :initarg :address)
    (username :reader username :initarg :username :initform nil) 
-   (proxies :accessor proxies :initarg :proxies :initform nil) 
-   )
+   (proxies :accessor proxies :initarg :proxies :initform nil))
   (:default-initargs :id (gensym "EQ-")))
 
 ;; if an instance has a name, but no address, give it an address
 ;; if an instance has an address, but no name, give it a name
 ;; if it has neither, signal an error
 (defmethod initialize-instance :after ((instance equipment) &key)
+  ;; set the alert-level to the max of the children
+  (setf (alert-level instance)
+        (reduce #'max (monitors instance) :key 'alert-level :initial-value 0))
+  ;; make sure the name and address are bound
   (cond ((and (not (slot-boundp instance 'address))
               (not (slot-boundp instance 'name)))
          (error "both name and address are unbound for this host!"))
@@ -53,23 +68,22 @@
                       (setf (aref arr i) element))
                    arr)))))))
 
-
 (defclass proxy ()
   ((remote-node :reader remote-node :initarg :remote-node)
    (object :reader object :initarg :object) 
    ))
 
-(defclass monitor (id-object)
+(defclass monitor (id-object parented-object alert-level)
   ((equipment :reader equipment :initarg :equipment)
-   (alert-level :accessor alert-level :initarg :alert-level :initform 0)
    (interval :accessor interval :initarg :interval :initform 300)
    (last-updated :accessor last-updated :initarg :last-updated)
    (proxies :accessor proxies :initform nil)
    )
   (:default-initargs :id (gensym "MON-")))
 
-(defmethod alert-level ((kit equipment))
-  (reduce #'max (monitors kit) :key 'alert-level :initial-value 0))
+;; no longer needed since this is now a slot
+;; (defmethod alert-level ((kit equipment))
+;;   (reduce #'max (monitors kit) :key 'alert-level :initial-value 0))
 
 (defclass cpu-monitor (monitor)
   ((num :reader num :initarg :num :initform 0)
@@ -156,12 +170,17 @@
 
 (defclass disk-container (monitor)
   ((disk-list :accessor disk-list :initarg :disk-list :initform nil)
-   (ignore-list :reader ignore-list :initarg :ignore-list) 
-   )
+   (ignore-list :reader ignore-list :initarg :ignore-list))
   (:default-initargs :interval 600 :ignore-list (list "tmpfs"))) 
 
-(defmethod alert-level ((kit disk-container))
-  (reduce #'max (disk-list kit) :initial-value 0 :key #'alert-level))
+(defmethod initialize-instance :after ((instance disk-container) &key)
+  ;; set the alert-level to the max of the children
+  (setf (alert-level instance)
+        (reduce #'max (disk-list instance) :key 'alert-level :initial-value 0)))
+
+;; now a slot in disk-container
+;; (defmethod alert-level ((kit disk-container))
+;;   (reduce #'max (disk-list kit) :initial-value 0 :key #'alert-level))
 
 (defclass host (equipment)
   ((passwd :reader passwd :initarg :passwd)
@@ -255,4 +274,21 @@
 (defmethod initial-enqueue ((object monitor))
   (noctool-scheduler:schedule object (+ 1
 					(get-universal-time)
-					(random (interval mon)))))
+					(random (interval object)))))
+
+(defmethod update-alert ((thing disk-container))
+  (format t "updating alert for ~A~%" thing)
+  (setf (alert-level thing)
+        (reduce #'max (disk-list thing)
+                :key 'alert-level :initial-value 0)))
+
+(defmethod update-alert ((thing host))
+  (format t "updating alert for ~A~%" thing)
+  (setf (alert-level thing)
+        (reduce #'max (monitors thing)
+                :key 'alert-level :initial-value 0)))
+
+(defmethod (setf alert-level) :AFTER (new (alert-level alert-level))
+  (when (slot-exists-p alert-level 'parent)
+    (if (parent alert-level)
+        (update-alert (parent alert-level)))))
--- /project/noctool/cvsroot/source/config.lisp	2008/06/12 06:11:01	1.8
+++ /project/noctool/cvsroot/source/config.lisp	2008/08/26 15:54:29	1.9
@@ -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*))))
+    `(let ((*disk-container* (car (noctool::make-monitor 'noctool::disk-container ,*config-object* :parent ,*config-object*))))
        ,@(mapcar #'macroexpand diskspec))))
 
 (defnested disk (path disk-percent &optional (inodes-percent 90))
@@ -116,7 +116,8 @@
 				 :device ,path
 				 :equipment ,*config-object*
 				 :disk-percent ,disk-percent
-				 :inodes-percent ,inodes-percent)))
+				 :inodes-percent ,inodes-percent
+                                 :parent *disk-container*)))
      (noctool::add-graphs platter)
      (push platter (noctool::disk-list *disk-container*))))
 
--- /project/noctool/cvsroot/source/scheduler.lisp	2008/08/13 05:56:29	1.6
+++ /project/noctool/cvsroot/source/scheduler.lisp	2008/08/26 15:54:29	1.7
@@ -145,7 +145,8 @@
 
 (defmethod process :before ((event net.hexapodia.noctool-scheduler:event))
   (let ((obj (net.hexapodia.noctool-scheduler::object event)))
-    (when (or (proxies (equipment obj)) (proxies obj))
+    (when (or (noctool::proxies (noctool::equipment obj)) 
+              (noctool::proxies obj))
       (push obj *network-updates-needed*))))
 
 (defun scheduler-loop ()
--- /project/noctool/cvsroot/source/tests.lisp	2008/07/03 07:30:24	1.5
+++ /project/noctool/cvsroot/source/tests.lisp	2008/08/26 15:54:29	1.6
@@ -76,7 +76,8 @@
                                       :device device
                                       :equipment (equipment monitor)
                                       :disk-max disk
-                                      :interval (interval monitor)))
+                                      :interval (interval monitor)
+                                      :parent monitor))
                  (add-graphs platter)
                  (push platter
                        (disk-list monitor)))



From jprewett at common-lisp.net  Tue Aug 26 16:09:22 2008
From: jprewett at common-lisp.net (jprewett)
Date: Tue, 26 Aug 2008 12:09:22 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080826160922.C02F7D091@common-lisp.net>

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

Modified Files:
	classes.lisp 
Log Message:

removed debugging statements :P



--- /project/noctool/cvsroot/source/classes.lisp	2008/08/26 15:54:29	1.13
+++ /project/noctool/cvsroot/source/classes.lisp	2008/08/26 16:09:21	1.14
@@ -277,13 +277,11 @@
 					(random (interval object)))))
 
 (defmethod update-alert ((thing disk-container))
-  (format t "updating alert for ~A~%" thing)
   (setf (alert-level thing)
         (reduce #'max (disk-list thing)
                 :key 'alert-level :initial-value 0)))
 
 (defmethod update-alert ((thing host))
-  (format t "updating alert for ~A~%" thing)
   (setf (alert-level thing)
         (reduce #'max (monitors thing)
                 :key 'alert-level :initial-value 0)))



From imattsson at common-lisp.net  Wed Aug 27 05:59:17 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 27 Aug 2008 01:59:17 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080827055917.BC7B8620BC@common-lisp.net>

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

Modified Files:
	network.lisp 
Log Message:
IM

Changed the amount of time we accept that an IAM protocol message can have
been in transit. 50 seconds is not too insane for manual testing, but
rather insane for computers, as this leaves open time for third parties to
intercept and such-like. I am not convinced that 5 seconds is vastly better,
mind you.


--- /project/noctool/cvsroot/source/network.lisp	2008/07/03 07:30:24	1.4
+++ /project/noctool/cvsroot/source/network.lisp	2008/08/27 05:59:16	1.5
@@ -133,7 +133,7 @@
 (defun validate-timestring (str)
   (let ((then (parse-timestring str))
 	(now (get-universal-time)))
-    (<= 0 (- now then) 50)))
+    (<= 0 (- now then) 5)))
 
 (defun make-signature (msg password)
   (let ((hmac (ironclad:make-hmac password :sha1)))



From imattsson at common-lisp.net  Wed Aug 27 06:04:47 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 27 Aug 2008 02:04:47 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080827060447.8882D2806C@common-lisp.net>

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

Modified Files:
	network.lisp 
Log Message:
IM

"Oooops". Should be protocol-dispatching, not just reading. Fixed.


--- /project/noctool/cvsroot/source/network.lisp	2008/08/27 05:59:16	1.5
+++ /project/noctool/cvsroot/source/network.lisp	2008/08/27 06:04:44	1.6
@@ -415,7 +415,7 @@
 
 (defmethod noctool-scheduler:process ((event peer-check-event))
   (loop for conn in *connections*
-	do (handle-read conn))
+	do (handle-peer conn))
   (schedule event (1+ (get-universal-time))))
 
 (defun update-peers (monitor-list)



From imattsson at common-lisp.net  Wed Aug 27 06:12:27 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 27 Aug 2008 02:12:27 -0400 (EDT)
Subject: [noctool-cvs] CVS web
Message-ID: <20080827061227.CA72A112E@common-lisp.net>

Update of /project/noctool/cvsroot/web
In directory clnet:/tmp/cvs-serv6194

Modified Files:
	hacking.html 
Log Message:
IM

Added some mumblings about the network layer.


--- /project/noctool/cvsroot/web/hacking.html	2008/05/27 16:34:03	1.4
+++ /project/noctool/cvsroot/web/hacking.html	2008/08/27 06:12:27	1.5
@@ -71,7 +71,7 @@
 
 <h2>Graphs</h2>
 The graph classes come in several sub-classes, depending on how they
-transfer data fromshorter-term storage to longer-term storage. Each
+transfer data from shorter-term storage to longer-term storage. Each
 storage class keeps 300 records and every 12th value added to a
 storage-class initiates a transfer of data to longer-term storage.
 <p>
@@ -129,8 +129,55 @@
 
 The mapping from equipment class to default monitors is done in <tt>default-settings.lisp</tt>.
 
+<h2>Network layer</h2>
+
+The network layer is implemented as a reader/parser/protocol
+dispatcher combo, where the reader is aware of the rough syntactic
+rules and hands over a complete read to the parser. It is done this
+way so incomplete syntactic units can be sent across the network, to
+be completed in a following transmission.
+
+The parser is, for all intents and purposes, CL:READ-FROM-STRING (at
+the moment), though it binds *READ-EVAL* and *READ-BASE*.
+
+The resulting list data structure (whose rough structure is:
+<blockquote>(message <i>protocol-data</i> <i>digest</i>)</blockquote>
+
+The protocol-data is extracted and handed over to the protocl handler
+loop, where different things happen depending on the state of the
+connection.
+
+There are three recognised states for any given connection, they can
+be initial, sent-validation or validated. The state is kept in the
+STATE slot of the connection class.
+
+When a connection is opened, the opening party will send an IAM
+protocol message (that looks roughly like "(iam sender reciever
+20080401T131415)") and sent its own state as sent-validation.
+
+Any incoming connection will be created in the initial state. The main
+difference between the initial and sent-validation states is how they
+react ti an IAM protocol message. In the initial state, this triggers
+teh sending of an IAM message before moving to the validated state, in
+the sent-validation case it does not.
+
+The IAM message is used to tie a connection to a specific peer (as
+configured). Each peer-to-peer connection has one or two secrets
+(either identical or different shared secret(s)), this secret is used
+for a HMAC-SHA1 digest of the protocol-data. The amount of time an
+IAM  message can be outstanding is controlled by VALIDATE-TIMESTRING.
+
+In the validated state, protocol messages are dispatched by looking up
+the protocol message identifier in a hash table (called
+*HANDLER-MAP*). The easiest way to define a new handler is by the
+DEFHANDLER macro, where the lambda-list should match the protocol
+message, in-so-far as the first symbol listed will be used for
+dispatching. Also note that DEFHANDLER will add a CONN argument to the
+lambda list that will be the connection that caused the protocol
+handler to be called during execution.
+
 <div class="footer">
- Last updated on $Id: hacking.html,v 1.4 2008/05/27 16:34:03 imattsson Exp $, by $Author: imattsson $
+ Last updated on $Id: hacking.html,v 1.5 2008/08/27 06:12:27 imattsson Exp $, by $Author: imattsson $
 </div>
 </body>
 </html>



From imattsson at common-lisp.net  Wed Aug 27 10:53:17 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 27 Aug 2008 06:53:17 -0400 (EDT)
Subject: [noctool-cvs] CVS web
Message-ID: <20080827105317.C6A023C20D@common-lisp.net>

Update of /project/noctool/cvsroot/web
In directory clnet:/tmp/cvs-serv2352

Modified Files:
	hacking.html 
Log Message:
IM

Fixed paragraph breaks.


--- /project/noctool/cvsroot/web/hacking.html	2008/08/27 06:12:27	1.5
+++ /project/noctool/cvsroot/web/hacking.html	2008/08/27 10:53:17	1.6
@@ -136,37 +136,37 @@
 rules and hands over a complete read to the parser. It is done this
 way so incomplete syntactic units can be sent across the network, to
 be completed in a following transmission.
-
+<p>
 The parser is, for all intents and purposes, CL:READ-FROM-STRING (at
 the moment), though it binds *READ-EVAL* and *READ-BASE*.
-
+<p>
 The resulting list data structure (whose rough structure is:
 <blockquote>(message <i>protocol-data</i> <i>digest</i>)</blockquote>
-
+<p>
 The protocol-data is extracted and handed over to the protocl handler
 loop, where different things happen depending on the state of the
 connection.
-
+<p>
 There are three recognised states for any given connection, they can
 be initial, sent-validation or validated. The state is kept in the
 STATE slot of the connection class.
-
+<p>
 When a connection is opened, the opening party will send an IAM
 protocol message (that looks roughly like "(iam sender reciever
 20080401T131415)") and sent its own state as sent-validation.
-
+<p>
 Any incoming connection will be created in the initial state. The main
 difference between the initial and sent-validation states is how they
-react ti an IAM protocol message. In the initial state, this triggers
-teh sending of an IAM message before moving to the validated state, in
+react to an IAM protocol message. In the initial state, this triggers
+the sending of an IAM message before moving to the validated state, in
 the sent-validation case it does not.
-
+<p>
 The IAM message is used to tie a connection to a specific peer (as
 configured). Each peer-to-peer connection has one or two secrets
 (either identical or different shared secret(s)), this secret is used
 for a HMAC-SHA1 digest of the protocol-data. The amount of time an
 IAM  message can be outstanding is controlled by VALIDATE-TIMESTRING.
-
+<p>
 In the validated state, protocol messages are dispatched by looking up
 the protocol message identifier in a hash table (called
 *HANDLER-MAP*). The easiest way to define a new handler is by the
@@ -177,7 +177,7 @@
 handler to be called during execution.
 
 <div class="footer">
- Last updated on $Id: hacking.html,v 1.5 2008/08/27 06:12:27 imattsson Exp $, by $Author: imattsson $
+ Last updated on $Id: hacking.html,v 1.6 2008/08/27 10:53:17 imattsson Exp $, by $Author: imattsson $
 </div>
 </body>
 </html>



From imattsson at common-lisp.net  Wed Aug 27 10:54:35 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 27 Aug 2008 06:54:35 -0400 (EDT)
Subject: [noctool-cvs] CVS web
Message-ID: <20080827105435.8D7FB450F3@common-lisp.net>

Update of /project/noctool/cvsroot/web
In directory clnet:/tmp/cvs-serv2508

Modified Files:
	hacking.html 
Log Message:
IM

Also fixed some spleeing errors.


--- /project/noctool/cvsroot/web/hacking.html	2008/08/27 10:53:17	1.6
+++ /project/noctool/cvsroot/web/hacking.html	2008/08/27 10:54:35	1.7
@@ -143,7 +143,7 @@
 The resulting list data structure (whose rough structure is:
 <blockquote>(message <i>protocol-data</i> <i>digest</i>)</blockquote>
 <p>
-The protocol-data is extracted and handed over to the protocl handler
+The protocol-data is extracted and handed over to the protocol handler
 loop, where different things happen depending on the state of the
 connection.
 <p>
@@ -177,7 +177,7 @@
 handler to be called during execution.
 
 <div class="footer">
- Last updated on $Id: hacking.html,v 1.6 2008/08/27 10:53:17 imattsson Exp $, by $Author: imattsson $
+ Last updated on $Id: hacking.html,v 1.7 2008/08/27 10:54:35 imattsson Exp $, by $Author: imattsson $
 </div>
 </body>
 </html>



From imattsson at common-lisp.net  Wed Aug 27 18:07:00 2008
From: imattsson at common-lisp.net (imattsson)
Date: Wed, 27 Aug 2008 14:07:00 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080827180700.68C15450F3@common-lisp.net>

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

Modified Files:
	tests.lisp 
Log Message:
IM

Slight re-work of parse-df and an auxilliary filtering function, merging
initial non-numeric "fields" together.


--- /project/noctool/cvsroot/source/tests.lisp	2008/08/26 15:54:29	1.6
+++ /project/noctool/cvsroot/source/tests.lisp	2008/08/27 18:06:59	1.7
@@ -32,12 +32,21 @@
 
 (defgeneric process-disk (monitor host))
 
+(defun parse-gobble (list)
+  (let* ((pos 0)
+	(first (loop for element in list
+		     for lpos from 1
+		     while (not (parse-integer element :junk-allowed t))
+		     do (setf pos lpos)
+		     collect element)))
+    (cons (format nil "~{~a~^ ~}" first) (subseq list pos))))
+
 (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)
+       for split = (parse-gobble (split-line line))
        with last = NIL
        for len = (+ (length split) (length last))
        while line



From imattsson at common-lisp.net  Fri Aug 29 17:29:47 2008
From: imattsson at common-lisp.net (imattsson)
Date: Fri, 29 Aug 2008 13:29:47 -0400 (EDT)
Subject: [noctool-cvs] CVS source
Message-ID: <20080829172947.C1DD04E030@common-lisp.net>

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

Modified Files:
	tests.lisp 
Log Message:
IM

Unbroke PARSE-GOBBLE when handed a split list starting with a digit field.


--- /project/noctool/cvsroot/source/tests.lisp	2008/08/27 18:06:59	1.7
+++ /project/noctool/cvsroot/source/tests.lisp	2008/08/29 17:29:45	1.8
@@ -31,6 +31,7 @@
 		      (if (>= (alert-level monitor) *alerting*) 5 1)))))))))
 
 (defgeneric process-disk (monitor host))
+(defgeneric process-df (host pty))
 
 (defun parse-gobble (list)
   (let* ((pos 0)
@@ -39,7 +40,8 @@
 		     while (not (parse-integer element :junk-allowed t))
 		     do (setf pos lpos)
 		     collect element)))
-    (cons (format nil "~{~a~^ ~}" first) (subseq list pos))))
+    (cond ((zerop pos) list)
+	  (t (cons (format nil "~{~a~^ ~}" first) (subseq list pos))))))
 
 (defun parse-df (pty)
   "parse output from df from the given pty"
@@ -63,6 +65,9 @@
            (setf last NIL)))
     ret))
 
+(defmethod process-df (host pty)
+  (declare (ignore host))
+  (parse-df pty))
 
 (defmethod process-disk ((monitor disk-container) (host linux-host))
   (with-pty (pty (make-ssh-command "df" (address host) (username host)))