[noctool-cvs] CVS source
imattsson
imattsson at common-lisp.net
Mon Sep 13 09:24:21 UTC 2010
Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv22608
Modified Files:
classes.lisp config.lisp graph-monitors.lisp graphing.lisp
network-globals.lisp noctool.asd packages.lisp tests.lisp
Log Message:
IM
Check-in for SNMP probing functionality (so far, the only thing implemented
is MIB-II interface probing (for octets, discards and error rates).
Requires CL-Net-SNMP (http://common-lisp.net/project/cl-net-snmp/), the
versions I have used are:
asn.1 4.14
snmp 5.19
usocket-udp 2.4
--- /project/noctool/cvsroot/source/classes.lisp 2009/04/28 17:53:07 1.24
+++ /project/noctool/cvsroot/source/classes.lisp 2010/09/13 09:24:21 1.25
@@ -152,6 +152,7 @@
((processes :accessor processes :initarg processes :initform NIL)))
(defun find-all (item sequence &rest args &key (start 0) end key (test #'eql) test-not)
+ (declare (ignorable test-not item args))
(loop for x in (subseq sequence start end)
when (apply test (if key (apply key x) x))
collect x))
@@ -181,6 +182,40 @@
(defclass macos-host (unix-host)
())
+(defclass snmp-container (monitor)
+ ((interfaces :accessor interfaces :initarg :interfaces)
+ (version :accessor version :initarg :version)
+ (public :accessor public :initarg :public)
+ (private :accessor private :initarg :private)
+ )
+ (:default-initargs :version :v2c :public "public"
+ :private "private" :interfaces nil))
+
+(defclass snmp-interface (monitor)
+ ((name :reader name :initarg :name)
+ (in-octets :accessor in-octets :initarg :in-octets)
+ (out-octets :accessor out-octets :initarg :out-octets)
+ (in-errors :accessor in-errors :initarg :in-errors)
+ (out-errors :accessor out-errors :initarg :out-errors)
+ (in-discards :accessor in-discards :initarg :in-discards)
+ (out-discards :accessor out-discards :initarg :out-discards)
+ (admin-status :accessor admin-status :initarg :admin-status)
+ (oper-status :accessor oper-status :initarg :oper-status))
+ (:default-initargs :admin-status nil :oper-status nil))
+
+(defmethod initialize-instance :after ((instance snmp-interface) &key)
+ (unless *dont-muck-with-instance* (add-graphs instance)))
+
+(add-graph-info snmp-interface in-octets meter-graph percentile-graph-display)
+(add-graph-info snmp-interface out-octets meter-graph percentile-graph-display)
+(add-graph-info snmp-interface in-errors meter-graph percentile-graph-display)
+(add-graph-info snmp-interface out-errors meter-graph percentile-graph-display)
+(add-graph-info snmp-interface in-discards meter-graph percentile-graph-display)
+(add-graph-info snmp-interface out-discards meter-graph percentile-graph-display)
+
+(defun make-snmp-interface (ifname)
+ (make-instance 'snmp-interface :name ifname))
+
(defmethod store ((graph disk-monitor) &optional filename)
(labels ((fname (subtype) (merge-pathnames
(make-pathname :name (format nil "~a%~a" filename subtype))
@@ -302,6 +337,7 @@
do (post-config-fixup monitor))
))
+
(defgeneric initial-enqueue (object))
(defmethod initial-enqueue ((object equipment))
(loop for mon in (monitors object)
--- /project/noctool/cvsroot/source/config.lisp 2009/02/19 17:33:34 1.15
+++ /project/noctool/cvsroot/source/config.lisp 2010/09/13 09:24:21 1.16
@@ -12,6 +12,7 @@
(defvar *proc-container* nil)
(defvar *my-password* nil)
(defvar *my-name* nil)
+(defvar *snmp-object* nil)
(defun bodge-package ()
(when (find-package *scrap-package-name*)
@@ -149,6 +150,41 @@
(format t "making proc: ~A~% " proc)
(push proc (noctool::processes *proc-container*))))
+(defnested snmp (&rest snmp-spec)
+ :machine
+ (let ((snmp-options nil)
+ (snmp-monitors nil)
+ (*macro-nesting* (cons :snmp *macro-nesting*)))
+ (loop for (option . rest) in snmp-spec
+ do (case option
+ ((version public private) (push (cons option rest) snmp-options))
+ (t (push (cons option rest) snmp-monitors))))
+ `(let ((*snmp-object* (car (noctool::make-monitor 'noctool::snmp-container ,*config-object*))))
+ (loop for (option value) in ',snmp-options
+ do (case option
+ (version (setf (noctool::version *snmp-object*)
+ (cond ((member value
+ '(1 :v1 v1 "v1" "1" :test #'equalp))
+ :v1)
+ ((member value '(2 v2c :v2c "2" "v2c"))
+ :v2c)
+ ((member value '(3 v3 "3" "v3"))
+ :v3)
+ (t (error (format nil "Unknown SNMP version ~a" value))))))
+ (public (setf (noctool::public *snmp-object*) value))
+ (private (setf (noctool::private *snmp-object*) value))))
+ ,@(mapcar #'macroexpand snmp-monitors))))
+
+(defnested interfaces (&rest interface-list)
+ :snmp
+ `(cond ((null ',interface-list) (setf (noctool::interfaces ,*snmp-object*) :all))
+ ((or (equal '(all) ',interface-list)
+ (equal '(:all) ',interface-list))
+ (setf (noctool::interfaces *snmp-object*) :all))
+ (t (setf (noctool::interfaces *snmp-object*)
+ (mapcar #'noctool::make-snmp-interface ',interface-list)))))
+
+
(defnested user (name &optional (passwd nil pw-provided))
:machine
`(progn
--- /project/noctool/cvsroot/source/graph-monitors.lisp 2008/12/22 15:28:53 1.8
+++ /project/noctool/cvsroot/source/graph-monitors.lisp 2010/09/13 09:24:21 1.9
@@ -12,10 +12,11 @@
nil)
(defun nearest-multiplier (n)
- (let ((pow (log n 10)))
- (multiple-value-bind (floor mod)
- (floor pow 3)
- (values (* 3 floor) (mod mod 3)))))
+ (if (zerop n) (values 0 0)
+ (let ((pow (log n 10)))
+ (multiple-value-bind (floor mod)
+ (floor pow 3)
+ (values (* 3 floor) (mod mod 3))))))
(defun date-format (time selector)
(multiple-value-bind (second minute hour date month year day)
@@ -27,7 +28,7 @@
(:long (format nil "~2,'0d-~2,'0d" month date)))))
-(defun draw-grid (image max interval selector scale unit &optional (base 0) (when (get-universal-time)))
+(defun draw-grid (image max interval selector scale unit &key (alpha 1.0) (base 0) (when (get-universal-time)))
(multiple-value-bind (multiplier offset)
(nearest-multiplier max)
(let ((si-mult (cdr (assoc (+ base multiplier) *magnitudes*))))
@@ -35,8 +36,8 @@
(let ((unit-name (format nil "~a~a" si-mult unit))
(mult (expt 10 (+ multiplier (floor offset))))
(mant (mod offset 1)))
- (image:rect image 25 10 325 110 nil 0 0 0)
- (image:text image unit-name 1 1 0 0 0)
+ (image:rect image 25 10 325 110 nil 0 0 0 alpha)
+ (image:text image unit-name 1 1 0 0 0 alpha)
(let ((step (cond ((< mant 0.3) 0.25)
((< mant 0.5) 0.5)
(t 1.0))))
@@ -48,12 +49,12 @@
n
(round
(* n (expt 10 (floor offset)))))))
- (image:line image 25 y 325 y 0 0 0)
+ (image:line image 25 y 325 y 0 0 0 alpha)
(image:text image
(format nil "~d"
value)
0 (- y 4)
- 0 0 0)))))))))
+ 0 0 0 alpha)))))))))
(multiple-value-bind (time-delta boundary)
(case selector
(:short (values interval (* 8 3600)))
@@ -69,10 +70,10 @@
selector)))
(let ((width (image:text image time 0 0 0 0 0 0.0)))
(image:line image (+ x-offset 25) 10 (+ x-offset 25) 110
- 0 0 0)
+ 0 0 0 alpha)
(image:text image time
(- (+ x-offset 25) (truncate width 2)) 113
- 0 0 0))))))))
+ 0 0 0 alpha))))))))
(defmethod show ((graph noctool::ping-monitor) sink format &key (selector :short) (background '(240 240 240))
@@ -96,7 +97,7 @@
:color '(0 0 0 0.0)
:base-x 25 :base-y 110 :height 100 :selector selector)
(graph-ignore percentile)
- (draw-grid image max (interval graph) selector scale "b" 3 (noctool:last-updated graph))
+ (draw-grid image max (interval graph) selector scale "b" :base 3 :when (noctool:last-updated graph))
(loop for disk in disks
for color in *graph-colors*
for text-offset = 125 then (+ text-offset 10)
@@ -124,7 +125,7 @@
:color '(0 0 0 0.0) :base-x 25 :base-y 110 :height 100
:selector selector)
(graph-ignore percentile)
- (draw-grid image max (interval graph) selector scale "b" 3 (noctool:last-updated graph))
+ (draw-grid image max (interval graph) selector scale "b" :base 3 :when (noctool:last-updated graph))
(loop for disk in disks
for color in *graph-colors*
for text-offset = 125 then (+ text-offset 10)
@@ -137,7 +138,58 @@
t (nth 0 color) (nth 1 color)(nth 2 color)))))
image)))
+(defmethod show ((graph noctool::snmp-interface) sink format &key (selector :short) (measure :octets) (background '(192 192 192)) &allow-other-keys)
+ (flet ((measure1 () (case measure
+ (:octets #'noctool::in-octets)
+ (:discards #'noctool::in-discards)
+ (:errors #'noctool::in-errors)))
+ (measure2 () (case measure
+ (:octets #'noctool::out-octets)
+ (:discards #'noctool::out-discards)
+ (:errors #'noctool::out-errors))))
+ (let ((unit (case measure
+ (:octets "b/s")
+ (:discards "discards")
+ (:errors "errors")))
+ (image (image:make-image 350 140))
+ (interval 1))
+ (multiple-value-bind (in-percentile in-max in-scale)
+ (show (funcall (measure1) graph) image nil :height 100 :base-y 110 :base-x 25)
+ (multiple-value-bind (out-percentile out-max out-scale)
+ (show (funcall (measure2) graph) image nil :height 100 :base-y 110 :base-x 25)
+ (apply #'image:rect image 0 0 349 139 t background)
+ (let* (
+;; (scale (/ (if (>= in-max out-max) in-scale out-scale) interval))
+ (max (max in-max out-max))
+ (scale (/ 100 max))
+;; (min (min in-max out-max))
+;; (max (/ (max in-max out-max) interval))
+;; (min (/ (min in-max out-max) interval))
+ (in-color (car *graph-colors*))
+ (out-color (caddr *graph-colors*)))
+
+ (format t "DEBUG: unit is ~s~%in ~f out ~f ~f~%in ~f out ~f ~f~%" unit in-max out-max max in-scale out-scale scale)
+
+ (draw-grid image (* max 8) (interval graph) selector (/ scale 8) unit)
+
+ (show (funcall (measure1) graph) image nil :style :line :scale scale :color in-color :base-x 25 :height 100 :base-y 110 :selector selector)
+ (show (funcall (measure2) graph) image nil :style :plot :scale scale :color out-color :base-x 25 :height 100 :base-y 110 :selector selector)
+
+ (let ((w1 (image:text image (noctool::name graph) 5 130 0 0 0)))
+ (let ((w2 (apply #'image:text image (format nil "~a in" unit) (+ w1 10) 130 in-color)))
+ (apply #'image:text image (format nil "~a out" unit) (+ w2 10) 130 out-color)))
+
+ (draw-grid image (* max 8) (interval graph) selector (/ scale 8) unit :alpha 0.2)
+
+ image))))))
+
+(defmethod show ((graph snmp-monitor) sink format &rest keys &key (selector :short) (measure :octets) &allow-other-keys)
+ (let ((keys (loop for (key val . rest) on keys by #'cddr
+ if (not (member key '(:selector :measure)))
+ append (list key val))))
+ (mapcar (lambda (interface) (apply #'show interface sink format :selector selector :measure measure keys)) (interfaces snmp-monitor))))
+
(defmethod show :around ((graph noctool::monitor) (sink string) format &key (selector :short) scale &allow-other-keys)
(graph-ignore selector scale)
(let ((image (call-next-method)))
- (image:export-to-gif image sink)))
+ (image:export-image image sink)))
--- /project/noctool/cvsroot/source/graphing.lisp 2009/02/05 20:23:22 1.10
+++ /project/noctool/cvsroot/source/graphing.lisp 2010/09/13 09:24:21 1.11
@@ -116,7 +116,7 @@
(bump-ix graph short-ix)
(when (proxies graph)
(loop for proxy in (proxies graph)
- do (noctool-network:graph-update proxy id (noctool:id graph) value))))
+ do (noctool-network:graph-update proxy (noctool:id graph) value))))
(defmethod add-value :after (graph value)
(setf (last-updated graph) (get-universal-time)))
@@ -209,17 +209,24 @@
(long-ix graph)
(* 12 12 (interval graph))))
(t (error "Unknown graph time-period selector ~a" selector)))
-
+
+ (flet ((extract (ix1 ix0)
+ (let ((v1 (aref array ix1))
+ (v0 (aref array ix0)))
+ (if (>= v1 v0)
+ (- v1 v0)
+ v1))))
+
(loop for source from ix below 300
for dest from 0
- do (setf (aref rv dest) (/ (- (aref array (mod (1+ source) 300))
- (aref array source))
+ do (setf (aref rv dest) (/ (- (extract (mod (1+ source) 300)
+ source))
interval)))
(loop for source from 0 below ix
for dest from (- 300 ix)
- do (setf (aref rv dest) (/ (- (aref array (mod (1+ source) 300))
- (aref array source))
- interval)))
+ do (setf (aref rv dest) (/ (- (extract (mod (1+ source) 300)
+ source))
+ interval))))
rv)))
(defmethod extract-display-data ((graph gauge-graph) selector)
--- /project/noctool/cvsroot/source/network-globals.lisp 2008/07/03 07:30:24 1.2
+++ /project/noctool/cvsroot/source/network-globals.lisp 2010/09/13 09:24:21 1.3
@@ -14,4 +14,4 @@
(defvar *reply-structure* (make-hash-table :test 'equal))
-(declaim (ftype (function (peer id value)) update-graph))
+(declaim (ftype (function (t t t)) update-graph))
--- /project/noctool/cvsroot/source/noctool.asd 2009/08/28 05:56:47 1.9
+++ /project/noctool/cvsroot/source/noctool.asd 2010/09/13 09:24:21 1.10
@@ -4,7 +4,9 @@
:author "Ingvar Mattsson / Jim Prewett"
:license "GPL"
:version "0.1"
- :depends-on (:usocket :cl-ppcre :ironclad :image :sb-posix :cl+ssl :cffi)
+ :depends-on (:usocket :cl-ppcre :ironclad :image :sb-posix :cl+ssl
+ :snmp
+ :cffi)
:components ((:file "packages")
(:file "ssh-package")
(:file "ssh-cffi" :depends-on ("ssh-package"))
@@ -18,7 +20,7 @@
(:file "graph-utils" :depends-on ("packages" "graphing"))
(:file "graph-monitors" :depends-on ("packages" "classes"))
(:file "config" :depends-on ("utils" "packages" "classes" "globals" "generics"))
- (:file "utils" :depends-on ("packages" "scheduler"))
+ (:file "utils" :depends-on ("packages" "scheduler" "classes"))
(:file "tests" :depends-on ("packages" "graph-utils" "globals" "classes" "utils" "scheduler"))
(:file "default-settings" :depends-on ("packages" "globals"))
(:file "network-utils" :depends-on ("packages" "network-globals"))
--- /project/noctool/cvsroot/source/packages.lisp 2009/02/19 17:33:34 1.12
+++ /project/noctool/cvsroot/source/packages.lisp 2010/09/13 09:24:21 1.13
@@ -17,14 +17,14 @@
(:use #:cl #:usocket #:net.hexapodia.noctool-scheduler #:net.hexapodia.noctool-graphs
#+sbcl :sb-mop)
(:export
- #: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
+ #: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 #:make-snmp-interface
))
(defpackage #:net.hexapodia.noctool-config
(: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 #:with-format))
+ (:shadow #:load #:interfaces)
+ (:export #:cluster #:ping #:load #:machine #:user #:ip #:ssh-port #:disk #:disks #:disk-ignore #:procs #:proc #:local-password #:local-hostname #:peer #:with-format #:snmp #:public #:private #:version #:interfaces))
(defpackage #:net.hexapodia.noctool-network
(:nicknames #:noctool-network)
--- /project/noctool/cvsroot/source/tests.lisp 2009/03/15 19:48:41 1.20
+++ /project/noctool/cvsroot/source/tests.lisp 2010/09/13 09:24:21 1.21
@@ -275,3 +275,58 @@
(incf new-alert *warning*))
(setf (alert-level monitor)
(decay-alert (alert-level monitor) new-alert)))))
+
+(defmethod process-snmp-interface (interface ifhash session)
+ (let ((if-ix (gethash (name interface) ifhash))
+ (new-alert 0))
+ (labels ((fetch (varname)
+ (car (snmp:snmp-get session
+ (list (format nil "~a.~d" varname if-ix))))))
+ (let ((octets-in (fetch "ifInOctets"))
+ (octets-out (fetch "ifOutOctets"))
+ (errors-in (fetch "ifInErrors"))
+ (errors-out (fetch "ifOutErrors"))
+ (discards-in (fetch "ifInDiscards"))
+ (discards-out (fetch "ifOutDiscards"))
+ (admin-status (fetch "ifAdminStatus"))
+ (oper-status (fetch "ifOperStatus")))
+ (add-value (in-octets interface)
+ (slot-value octets-in 'asn.1::value))
+ (add-value (out-octets interface)
+ (slot-value octets-out 'asn.1::value))
+ (add-value (in-errors interface)
+ (slot-value errors-in 'asn.1::value))
+ (add-value (out-errors interface)
+ (slot-value errors-out 'asn.1::value))
+ (add-value (in-discards interface)
+ (slot-value discards-in 'asn.1::value))
+ (add-value (out-discards interface)
+ (slot-value discards-out 'asn.1::value))
+
+ (when (oper-status interface)
+ (unless (eql (oper-status interface) oper-status)
+ (setf new-alert *alerting*)))
+ (setf (oper-status interface) oper-status)
+
+ (when (admin-status interface)
+ (unless (eql (admin-status interface) admin-status)
+ (setf new-alert *alerting*)))
+ (setf (admin-status interface) admin-status)
+
+ (setf (alert-level interface)
+ (decay-alert (alert-level interface) new-alert))))))
+
+
+
+(defmethod process ((monitor snmp-container))
+ (let ((host (address (equipment monitor))))
+ (snmp:with-open-session (snmp-session host :version (version monitor) :community (public monitor))
+ (let ((ifnames (snmp:snmp-walk snmp-session '("ifDescr")))
+ (ifhash (make-hash-table :test #'equalp)))
+ (when (eql :all (interfaces monitor))
+ (mapcar #'cadr (car ifnames)))
+ (loop for (obj name) in (car ifnames)
+ do (setf (gethash name ifhash) (slot-value obj 'asn.1::value)))
+ (loop for int in (interfaces monitor)
+ do (process-snmp-interface int ifhash snmp-session))
+ ))))
More information about the noctool-cvs
mailing list