From imattsson at common-lisp.net Tue Feb 3 14:49:51 2009 From: imattsson at common-lisp.net (imattsson) Date: Tue, 03 Feb 2009 14:49:51 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv27757 Modified Files: tests.lisp Log Message: IM Added some "has this been checked" monitoring to the disk-containe PROCESS method. --- /project/noctool/cvsroot/source/tests.lisp 2009/01/26 02:54:30 1.17 +++ /project/noctool/cvsroot/source/tests.lisp 2009/02/03 14:49:50 1.18 @@ -149,7 +149,15 @@ ((<= (* 0.9 (disk-percent platter)) percent) *warning*) - (t 0)))))))))))))) + (t 0))))))))))) + ;; Check for disks that have not been probed for roughly two intervals + (loop for platter in (disk-list monitors) + with threshold = (- (get-universal-time) + (* 2 (interval monitor))) + do (when (<= (last-updated platter)) + (setf (alert-level platter) + *alerting*))) + ))) (defmethod process ((monitor disk-container)) (without-errors NIL From imattsson at common-lisp.net Fri Feb 6 16:42:42 2009 From: imattsson at common-lisp.net (imattsson) Date: Fri, 06 Feb 2009 16:42:42 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv424 Modified Files: classes.lisp Log Message: IM Added an initform to the MONITOR class, to make detection of "configured, but unmounted disk" easier. --- /project/noctool/cvsroot/source/classes.lisp 2009/02/05 20:23:22 1.19 +++ /project/noctool/cvsroot/source/classes.lisp 2009/02/06 16:42:42 1.20 @@ -73,7 +73,7 @@ (defclass monitor (id-object parented-object alert-level) ((equipment :reader equipment :initarg :equipment) (interval :accessor interval :initarg :interval :initform 300) - (last-updated :accessor last-updated :initarg :last-updated) + (last-updated :accessor last-updated :initarg :last-updated :initform 0) (proxies :accessor proxies :initform nil) ) (:default-initargs :id (gentemp "MON-" (find-package :noctool-symbols)))) From imattsson at common-lisp.net Thu Feb 12 20:41:09 2009 From: imattsson at common-lisp.net (imattsson) Date: Thu, 12 Feb 2009 20:41:09 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv21098 Added Files: fork-test.lisp Log Message: IM Rough test scaffolding to diagnose "crossed streams" issue. --- /project/noctool/cvsroot/source/fork-test.lisp 2009/02/12 20:41:09 NONE +++ /project/noctool/cvsroot/source/fork-test.lisp 2009/02/12 20:41:09 1.1 (defun worker (id lines) (let ((id-string (format nil "~4,'0d" id))) (with-pty (pty (sb-ext:process-pty (sb-ext:run-program "/usr/bin/env" (list "true" id-string) :wait nil :pty t))) (loop for line = (read-line pty nil nil) for count from 0 below lines while line do (progn (unless (string= line id-string) (format t "Thread ~d, expected ~a, saw ~a~%" id id-string line)) (sleep (* 0.1 (random 10)))))))) (defun main (workers &optional (line-count 100)) (loop for n from 1 to workers collect (sb-thread:make-thread #'(lambda () (worker n line-count))))) From download at hpc.unm.edu Thu Feb 12 21:19:58 2009 From: download at hpc.unm.edu (Jim Prewett) Date: Thu, 12 Feb 2009 14:19:58 -0700 (MST) Subject: [noctool-cvs] CVS source In-Reply-To: References: Message-ID: Hi Ingvar, I made a couple of fixes (we should see that commit message any time now). I *can't* get this to give me an error message! :P Jim James E. Prewett Jim at Prewett.org download at hpc.unm.edu Systems Team Leader LoGS: http://www.hpc.unm.edu/~download/LoGS/ Designated Security Officer OpenPGP key: pub 1024D/31816D93 HPC Systems Engineer III UNM HPC 505.277.8210 On Thu, 12 Feb 2009, imattsson wrote: > Update of /project/noctool/cvsroot/source > In directory cl-net:/tmp/cvs-serv21098 > > Added Files: > fork-test.lisp > Log Message: > IM > > Rough test scaffolding to diagnose "crossed streams" issue. > > > > --- /project/noctool/cvsroot/source/fork-test.lisp 2009/02/12 20:41:09 NONE > +++ /project/noctool/cvsroot/source/fork-test.lisp 2009/02/12 20:41:09 1.1 > (defun worker (id lines) > (let ((id-string (format nil "~4,'0d" id))) > (with-pty (pty (sb-ext:process-pty (sb-ext:run-program "/usr/bin/env" (list "true" id-string) :wait nil :pty t))) > (loop for line = (read-line pty nil nil) > for count from 0 below lines > while line > do (progn > (unless (string= line id-string) > (format t "Thread ~d, expected ~a, saw ~a~%" id id-string line)) > (sleep (* 0.1 (random 10)))))))) > > (defun main (workers &optional (line-count 100)) > (loop for n from 1 to workers > collect (sb-thread:make-thread #'(lambda () (worker n line-count))))) > > _______________________________________________ > noctool-cvs mailing list > noctool-cvs at common-lisp.net > http://common-lisp.net/cgi-bin/mailman/listinfo/noctool-cvs > From imattsson at common-lisp.net Wed Feb 18 17:56:12 2009 From: imattsson at common-lisp.net (imattsson) Date: Wed, 18 Feb 2009 17:56:12 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv27841 Modified Files: config.lisp Log Message: IM New CLUSTER macro, all optional stuff has been moved into keyword parameters. In the case of "no optionals given", there should be no change. CLUSTER will now wrap its expansion in a LET with the counter variable bound to low, then SETFed to each incremental value, so sub-forms can correctly use the counter value for formatting. New WITH-FORMAT added (alas, at the moment only catering for CL format strings). Looks (rouyghly like): (with-format ( ...) &body body) The binding specifications are: (varname fmt-string [ ...]) --- /project/noctool/cvsroot/source/config.lisp 2009/02/17 17:48:20 1.13 +++ /project/noctool/cvsroot/source/config.lisp 2009/02/18 17:56:12 1.14 @@ -177,18 +177,23 @@ `(defnested ,mon-class (&rest options) :machine `(noctool::make-monitor ',',mon-class ,*config-object* , at options))) -(defmacro cluster ((fmt low high &optional (name nil) (c-fmt t) (count nil)) form) +(defmacro cluster ((fmt low high &key (counter (gensym "CFGCNT")) (name nil) (c-fmt t)) form) (let ((format-string (if c-fmt (translate-format fmt) fmt)) (name (or name - (get-config-symbol "NAME"))) - (count (or count - (get-config-symbol "COUNT")))) - `(progn - ,@(loop for n from low to high - for realname = (format nil format-string n) - collect (subst n count (subst realname name form)))))) + (get-config-symbol "NAME")))) + `(let ((,counter 0)) + ,@(loop for n from low to high + for realname = (format nil format-string n) + collect `(setf ,counter ,n) + collect (substitute realname name form))))) + +(defmacro with-format (bind-list &body body) + (let ((let-bindings (loop for (var fmt-string . vars) in bind-list + collect `(,var (format nil ,fmt-string , at vars))))) + `(let ,let-bindings + , at body))) (defun load (file) (let ((load-package (bodge-package))) @@ -198,6 +203,7 @@ (*loaded-objects* nil) ) (cl:load file) + (loop for val in *loaded-objects* do (cond ((typep val (find-class 'noctool::equipment)) (noctool::default-monitors val) From imattsson at common-lisp.net Wed Feb 18 17:57:07 2009 From: imattsson at common-lisp.net (imattsson) Date: Wed, 18 Feb 2009 17:57:07 +0000 Subject: [noctool-cvs] CVS source/test-files Message-ID: Update of /project/noctool/cvsroot/source/test-files In directory cl-net:/tmp/cvs-serv27930 Added Files: nested-cluster.cfg Log Message: IM Initial check-in. Attempt to diagnose "nested cluster configs" and with-format stanzas. --- /project/noctool/cvsroot/source/test-files/nested-cluster.cfg 2009/02/18 17:57:07 NONE +++ /project/noctool/cvsroot/source/test-files/nested-cluster.cfg 2009/02/18 17:57:07 1.1 (cluster ("" 1 2 :counter a) (cluster ("" 1 2 :counter b) (with-format ((name "node~d-cpu~d" a b) (ip-addr "172.23.~d.~d" a b)) (machine name linux-host (user "testuser") (ip ip-addr))))) From imattsson at common-lisp.net Thu Feb 19 17:27:17 2009 From: imattsson at common-lisp.net (imattsson) Date: Thu, 19 Feb 2009 17:27:17 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv17473 Modified Files: packages.lisp Log Message: IM Need to export WITH-FORMAT from the noctool-config package! --- /project/noctool/cvsroot/source/packages.lisp 2009/02/05 20:23:22 1.10 +++ /project/noctool/cvsroot/source/packages.lisp 2009/02/19 17:27:17 1.11 @@ -24,7 +24,7 @@ (:nicknames #:noctool-config) (:use #:net.hexapodia.noctool #:net.hexapodia.noctool-graphs #:cl) (:shadow #:load) - (:export #:cluster #:ping #:load #:machine #:user #:ip #:ssh-port #:disk #:disks #:disk-ignore #:procs #:proc #:local-password #:local-hostname #:peer)) + (:export #:cluster #:ping #:load #:machine #:user #:ip #:ssh-port #:disk #:disks #:disk-ignore #:procs #:proc #:local-password #:local-hostname #:peer #:with-format)) (defpackage #:net.hexapodia.noctool-network (:nicknames #:noctool-network) From imattsson at common-lisp.net Thu Feb 19 17:33:34 2009 From: imattsson at common-lisp.net (imattsson) Date: Thu, 19 Feb 2009 17:33:34 +0000 Subject: [noctool-cvs] CVS source Message-ID: Update of /project/noctool/cvsroot/source In directory cl-net:/tmp/cvs-serv17842 Modified Files: classes.lisp packages.lisp config.lisp Log Message: IM Moved most (though not all) :AFTER methods for INITIALIZE-INSTANCE to POST-CONFIG-FIXUP GF methods and inserted a call to that in NOCTOOL-CONFIG:LOAD. --- /project/noctool/cvsroot/source/classes.lisp 2009/02/17 17:48:20 1.21 +++ /project/noctool/cvsroot/source/classes.lisp 2009/02/19 17:33:34 1.22 @@ -29,41 +29,6 @@ (proxies :accessor proxies :initarg :proxies :initform nil)) (:default-initargs :id (gentemp "EQ-" (find-package :noctool-symbols)))) -;; 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 - (unless *dont-muck-with-instance* - (cond ((and (not (slot-boundp instance 'address)) - (not (slot-boundp instance 'name))) - (error "both name and address are unbound for this host!")) - ((not (slot-boundp instance 'address)) - (setf (slot-value instance 'address) - (let ((hostent - (sb-bsd-sockets:host-ent-address - (sb-bsd-sockets:get-host-by-name (name instance))))) - (format NIL "~A.~A.~A.~A" - (aref hostent 0) - (aref hostent 1) - (aref hostent 2) - (aref hostent 3))))) - ((not (slot-boundp instance 'name)) - (setf (slot-value instance 'name) - (sb-bsd-sockets:host-ent-name - (sb-bsd-sockets:get-host-by-address - (let ((arr (make-array '(4)))) - (loop - for i from 0 - for element in - (mapcar #'read-from-string - (cl-ppcre:split #\. (address instance))) - do - (setf (aref arr i) element)) - arr)))))))) (defclass proxy () ((remote-node :reader remote-node :initarg :remote-node) @@ -95,10 +60,6 @@ ) (:default-initargs :low-water 1.0 :high-water 5.0)) -(defmethod initialize-instance :after ((instance load-monitor) &key) - (unless *dont-muck-with-instance* - (add-graphs instance))) - (defclass tcp-monitor (monitor) ((sent-data :reader sent-data :initarg :sent-data :initform nil) (match-data :reader match-data :initarg :match-data :initform nil) @@ -280,6 +241,53 @@ ) (:default-initargs :display-objects nil)) +(defgeneric post-config-fixup (object)) +(defmethod post-config-fixup (object) + ;; Default do-naught method + (values)) + +(defmethod post-config-fixup ((instance load-monitor) &key) + (unless *dont-muck-with-instance* + (add-graphs instance))) + +;; 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 post-config-fixup ((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 + (unless *dont-muck-with-instance* + (cond ((and (not (slot-boundp instance 'address)) + (not (slot-boundp instance 'name))) + (error "both name and address are unbound for this host!")) + ((not (slot-boundp instance 'address)) + (setf (slot-value instance 'address) + (let ((hostent + (sb-bsd-sockets:host-ent-address + (sb-bsd-sockets:get-host-by-name (name instance))))) + (format NIL "~A.~A.~A.~A" + (aref hostent 0) + (aref hostent 1) + (aref hostent 2) + (aref hostent 3))))) + ((not (slot-boundp instance 'name)) + (setf (slot-value instance 'name) + (sb-bsd-sockets:host-ent-name + (sb-bsd-sockets:get-host-by-address + (let ((arr (make-array '(4)))) + (loop + for i from 0 + for element in + (mapcar #'read-from-string + (cl-ppcre:split #\. (address instance))) + do + (setf (aref arr i) element)) + arr)))))) + (loop for monitor in (monitors instance) + do (post-config-fixup monitors)) + )) (defgeneric initial-enqueue (object)) (defmethod initial-enqueue ((object equipment)) --- /project/noctool/cvsroot/source/packages.lisp 2009/02/19 17:27:17 1.11 +++ /project/noctool/cvsroot/source/packages.lisp 2009/02/19 17:33:34 1.12 @@ -17,7 +17,7 @@ (:use #:cl #:usocket #:net.hexapodia.noctool-scheduler #:net.hexapodia.noctool-graphs #+sbcl :sb-mop) (:export - #:proxies #:*proxies* #:*peers* #:*equipment* #:*views* #:*noctool-package* #:id #:last-updated #:unix-host #:linux-host #:cpu-monitor #:load-monitor #:ping-monitor #:remote-node #:decode-base64 #:encode-base64 #:octetify #:destination #:alert-level #:conn #:monitors #:my-name #:my-passwd #:serialize-data #:remote-node #:dst-port #:remote-passwd #:name #:graph-type #:object #:disk-container + #:post-config-fixup #:proxies #:*proxies* #:*peers* #:*equipment* #:*views* #:*noctool-package* #:id #:last-updated #:unix-host #:linux-host #:cpu-monitor #:load-monitor #:ping-monitor #:remote-node #:decode-base64 #:encode-base64 #:octetify #:destination #:alert-level #:conn #:monitors #:my-name #:my-passwd #:serialize-data #:remote-node #:dst-port #:remote-passwd #:name #:graph-type #:object #:disk-container )) (defpackage #:net.hexapodia.noctool-config --- /project/noctool/cvsroot/source/config.lisp 2009/02/18 17:56:12 1.14 +++ /project/noctool/cvsroot/source/config.lisp 2009/02/19 17:33:34 1.15 @@ -205,6 +205,7 @@ (cl:load file) (loop for val in *loaded-objects* + do (post-config-fixup val) do (cond ((typep val (find-class 'noctool::equipment)) (noctool::default-monitors val) (push val *equipment*))