[noctool-cvs] CVS source
jprewett
jprewett at common-lisp.net
Fri Dec 19 21:14:23 UTC 2008
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))))))
+
More information about the noctool-cvs
mailing list