From imattsson at common-lisp.net Mon Sep 13 09:24:21 2010 From: imattsson at common-lisp.net (imattsson) Date: Mon, 13 Sep 2010 05:24:21 -0400 Subject: [noctool-cvs] CVS source Message-ID: 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)) + ))))