[snmp1-cvs] CVS snmp1

Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv8719

Modified Files: ber.lisp snmp.lisp snmp1.asd tests.lisp Added Files: common-mib.dat Log Message: Added dependency to split-string Added symbolic mib translations. Included mib data for the common mibs There is a change to top level interface. Some functions return the translated names. Started using triples of oid, type, value to rebresent varbinds.

--- /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/20 15:55:08 1.2 @@ -19,18 +19,10 @@ (in-package "SNMP1")

(defun oid-string-to-oid (oid-string) - "Convert string in form .1.3.5.6.7.333.233 to oid" - (let ((from 0) - to - (result (make-array 0 :fill-pointer 0))) - (loop for x across oid-string - while from - do - (setf to (position #. oid-string :start (1+ from))) - #|(display from to (subseq oid-string from to))|# - (vector-push-extend (read-from-string (remove #. (subseq oid-string from to))) result) - (setf from to) - ) + "Convert string in form .1.3.5.6.7.333.233 to oid #(1 3 5 6 7 333 233)" + (let ((result (make-array 0 :fill-pointer 0))) + (loop for subidentifier in (split-sequence:split-sequence #. oid-string :remove-empty-subseqs t) + do (vector-push-extend (read-from-string subidentifier) result)) result))

(defun oid-to-oid-string (oid) @@ -296,12 +288,9 @@ (push (reverse container) result))) ((integer-type-p tag) (push (list tag (ber-decode-integer-value buffer start-value end-value)) result)) ((octet-string-type-p tag) - (push (list tag - ;; return octet array if impossible to convert to string - (handler-case (octets-to-string #1=(subseq buffer start-value end-value)) - (t () #1#))) result)) + (push (list tag (subseq buffer start-value end-value)) result)) ((object-identifier-type-p tag) - (push (list tag (oid-to-oid-string (ber-decode-object-identifier-value buffer start-value end-value))) result)) + (push (list tag (ber-decode-object-identifier-value buffer start-value end-value)) result)) ) (setf start end-value) while (< start input-end)) --- /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/20 15:55:08 1.2 @@ -18,6 +18,111 @@ |# (in-package "SNMP1")

+(defparameter *community* "public") +(defparameter *agent-ip* #(127 0 0 1)) +(defparameter *agent-port* 161) +(defparameter *wait* 1) +(defparameter *retries* 3) + +(defun ip-string-to-ip-octets (dotted-quad) + (let ((list (split-sequence:split-sequence #. dotted-quad)) + (vector (make-array 4))) + (loop for n from 0 for component in list do (setf (aref vector n) (parse-integer component))) + vector)) + +(defun ip-string-to-numeric (dotted-quad) + (let ((octets (ip-string-to-ip-octets dotted-quad)) + (ip-numeric 0)) + (loop for octet across octets do + (setf ip-numeric (+ (* ip-numeric 256) octet))) + ip-numeric)) + +(defun ip-numeric-to-ip-octets (ip-numeric) + (apply #'vector (reverse (loop for x from 1 to 4 + collect (ldb (byte 8 0) ip-numeric) + do (setf ip-numeric (truncate ip-numeric 256)))))) + +(defun ip-octets-to-ip-string (ip-octets) + (format nil "~{~d.~d.~d.~d~}" (loop for o across ip-octets collect o))) + +(defun ip-numeric (ip-some-form) + (typecase ip-some-form + (simple-vector (ip-string-to-numeric (ip-octets-to-ip-string ip-some-form))) + (string (ip-string-to-numeric ip-some-form)) + (otherwise ip-some-form))) + +(defun ip-octets (ip-some-form) + (typecase ip-some-form + (integer (ip-numeric-to-ip-octets ip-some-form)) + (string (ip-string-to-ip-octets ip-some-form)) + (otherwise ip-some-form))) + +(defun ip-string (ip-some-form) + (typecase ip-some-form + (simple-vector (ip-octets-to-ip-string ip-some-form)) + (integer (ip-octets-to-ip-string (ip-numeric-to-ip-octets ip-some-form))) + (otherwise ip-some-form))) + + +;; (defun oid-less (a-in b-in) +;; (cond ((null a-in) nil) +;; ((null b-in) t) +;; (t (loop for a-sub across (oid-string-to-oid a-in) +;; for b-sub across (oid-string-to-oid b-in) +;; when (not (= a-sub b-sub)) do (return-from oid-less (< a-sub b-sub))))) +;; ) + + + +(defun pdu-from-message (decoded-message) + (fourth decoded-message)) + +(defun value-from-encoding (encoding) + (second encoding)) + +(defun request-id (decoded-message) + (value-from-encoding (second (pdu-from-message decoded-message)))) + +;; (defun nreplace-request-id (new-value decoded-message) +;; ;;(888 copied-tree) +;; (let ((interesting-cons (last (second (pdu-from-message decoded-message))))) +;; (rplaca interesting-cons new-value) +;; decoded-message) +;; ) + +(defun varbind-list% (decoded-pdu) + (fifth decoded-pdu)) + +(defun varbind-list (message) + (varbind-list% (pdu-from-message message))) + +;; (defun oid-and-value (varbind) +;; (let ((oid-encoding (second varbind)) +;; (value-encoding (third varbind))) +;; (list (value-from-encoding oid-encoding) (value-from-encoding value-encoding)))) + +(defun compose-varbind-list (oids) + "Create a varbind-list suitable for ber-encode from a list of oids +ignore eny null oids" + (let ((vars (loop for oid in (remove nil oids) collect `(:sequence (:object-identifier ,oid) (:null))))) + (push :sequence vars))) + +(defun varbind-to-triple (varbind) + (let ((requested-oid (second (second varbind))) + (tag (first (third varbind))) + (value (second (third varbind)))) + (list requested-oid tag value))) + +(defun triples-from-decoded-message (decoded-message) + (let ((varbind-list (varbind-list decoded-message))) + (loop for pair in (cdr varbind-list) collect (varbind-to-triple pair)))) + +;; (defun oids-and-values-from-message (message) +;; (let ((varbind-list (varbind-list message))) +;; ;;(mapcar #'oid-and-value varbinds) +;; (loop for pair in (cdr varbind-list) collect (oid-and-value pair) ) +;; )) + (defun udp-send-and-receive (host port timeout repetitions message) "send one pqcket and receive one packet" (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :protocol :udp :type :datagram)) @@ -41,72 +146,210 @@ ))

-(defun snmpgetnext (ip community oid) - (let* ((seq (random 1000)) - (pdu `(:getnext (:integer ,seq) - (:integer 0) - (:integer 0) - (:sequence - (:sequence (:object-identifier ,oid) (:null))))) - (req `(:sequence (:integer 0) ; version 1 - (:octet-string ,community) - ,pdu)) - (request-buffer (ber-encode req)) - (response-buffer (udp-send-and-receive - ip - 161 - 1 - 3 - request-buffer))) - ;;(display response-buffer) - (let* ((response (ber-decode response-buffer 0 (length response-buffer))) - (varbinds (fifth (fourth response))) - (varbind (second varbinds))) - ;;(display response) - ;;(display varbinds) - ;;(display varbind) - (values (second varbind) (third varbind))) +(defun snmp-get-many- (oids &optional (request-id (random 1000))) + "Constructs the get pdu, inserts a random request-id if none is +spplied, checks the request-id, decodes the answer" + (let* ((*agent-ip* (if (stringp *agent-ip* )(ip-string-to-ip-octets *agent-ip*) *agent-ip*)) + (varbind-list (compose-varbind-list oids)) + (un-encoded-message `(:sequence (:integer 0) ; version 1 + (:octet-string ,*community*) + (:get (:integer ,request-id) + (:integer 0) + (:integer 0) + ,varbind-list))) + + (response-buffer (udp-send-and-receive + *agent-ip* + *agent-port* + *wait* + *retries* + (ber-encode un-encoded-message))) + (decoded-message (ber-decode response-buffer 0 (length response-buffer)))) + ;;(print un-encoded-message netelements::*stdout*) + (when (eql request-id (request-id decoded-message)) + (triples-from-decoded-message decoded-message)))) +(defun oid-basic-form (oid) + "Convert an oid in diverse symbolic forms, string or already basic form +to the basic form, which is an array" + (cond + ;; ".2.3.4.5.4.5" + ((and (stringp oid) (every #'(lambda (char) (or (digit-char-p char) (char= #. char))) oid)) + (oid-string-to-oid oid)) + ;; "sysObjectID" + ((and (stringp oid) (not (position #. oid))) + (oid-from-trailing-subidentifier oid)) + ;; "sysObjectID.0" + ((and (stringp oid) (= (count #. oid) 1)) + (let ((point-pos (position #. oid))) + (let* ((symbolic-part (subseq oid 0 point-pos)) + (trailing-digits (subseq oid (1+ point-pos))) + (symbolic-part-oid (oid-from-trailing-subidentifier symbolic-part))) + ;; if tests dont succed, resturn nil + (when (and symbolic-part-oid (every #'digit-char-p trailing-digits)) + (scalar symbolic-part-oid (parse-integer trailing-digits)))))) + ((stringp oid) + (let* ((last-dot (position #. oid :from-end t)) + (partial-oid (subseq oid 0 last-dot)) + (trailing-digits (subseq oid (1+ last-dot)))) + (if (every #'digit-char-p trailing-digits) + ;;".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0" + (let ((translated-part (oid-from-symbolic-oid partial-oid))) + ;; return 0 if oid not found in hash + (when translated-part + (scalar translated-part (parse-integer trailing-digits)))) + ;;".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID" + (oid-from-symbolic-oid oid)))) + ;;#(1 2 3) + (t oid))) + +(defun snmp-get- (oid) + (let ((triple-list (snmp-get-many- (list (oid-basic-form oid))))) + (first triple-list))) + + + + + + + +;; (defun snmp-getnext (ip community oid) +;; (let* ((seq (random 1000)) +;; (pdu `(:getnext (:integer ,seq) +;; (:integer 0) +;; (:integer 0) +;; (:sequence +;; (:sequence (:object-identifier ,oid) (:null))))) +;; (req `(:sequence (:integer 0) ; version 1 +;; (:octet-string ,community) +;; ,pdu)) +;; (request-buffer (ber-encode req)) +;; (response-buffer (udp-send-and-receive +;; ip +;; 161 +;; 1 +;; 3 +;; request-buffer))) +;; ;;(display response-buffer) +;; (let* ((response (ber-decode response-buffer 0 (length response-buffer))) +;; (varbinds (fifth (fourth response))) +;; (varbind (second varbinds))) +;; ;;(display response) +;; ;;(display varbinds) +;; ;;(display varbind) +;; (values (second varbind) (third varbind)))

- )) +;; )) + +;; (defun snmp-getnext2 (ip community oid) +;; (let ((response-buffer (udp-send-and-receive +;; ip +;; 161 +;; 1 +;; 3 +;; (ber-encode `(:sequence (:integer 0) ; version 1 +;; (:octet-string ,community) +;; (:getnext (:integer 12345) +;; (:integer 0) +;; (:integer 0) +;; (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) +;; (ber-decode response-buffer 0 (length response-buffer)))) + + +;; (defun snmp-walk (ip community &optional (start-oid #(0 0)) ) +;; (let ((next-oid start-oid) +;; response-oid +;; value) +;; (loop +;; while next-oid +;; do +;; (multiple-value-setq (response-oid value) (snmp-getnext ip community next-oid)) +;; until (equal next-oid (second response-oid)) +;; do +;; (setf next-oid (second response-oid)) +;; (format t "~s ~s~%" response-oid value)))) + + + +;; (defun triple-to-varbind (triple) +;; (if (third triple) +;; `(:sequence (:object-identifier ,(first triple)) +;; (,(second triple) ,(third triple))) +;; ;; f.ex (#(1 2 3 4 5) :null nil) +;; `(:sequence (:object-identifier ,(first triple)) +;; (,(second triple))))) + + +(defun translate-triple (triple) + (let ((translated-oid (symbolic-oid-from-oid (first triple))) + (tag (second triple)) + (value (third triple))) + (cond ((object-identifier-type-p tag) + (list translated-oid tag (symbolic-oid-from-oid value))) + ((octet-string-type-p tag) + (let ((translated-value + (handler-case (octets-to-string value) + (t () value)))) + (list translated-oid tag translated-value))) + ((integer-type-p tag) + (let ((maybe-translated-value value) + (enum-alist (gethash (first triple) *mib-enums*))) + (unless enum-alist + (setf enum-alist (gethash + (subseq (first triple) 0 (- (length (first triple)) 1)) + *mib-enums*))) + (when enum-alist + (setf maybe-translated-value (cdr (assoc value enum-alist)))) + (list translated-oid tag maybe-translated-value)) + ) + (t (list translated-oid tag value))))) + + +(defun snmp-get-many (oid-list) + (let ((triple-list (snmp-get-many- (mapcar #'oid-basic-form oid-list)))) + (loop for triple in triple-list collect (translate-triple triple)))) + +(defun snmp-get-many-safe- (oid-list identifying-oid in-identifier) + (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list))))) + (let* ((read-identifier-triple (translate-triple (first result+identifier))) + (result (rest result+identifier))) + (when (equal (third read-identifier-triple) in-identifier) + result)))) + +(defun snmp-get-many-safe (oid-list identifying-oid in-identifier) + (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list))))) + (let ((read-identifier-triple (translate-triple (first result+identifier))) + (result (rest result+identifier))) + (when (equal (third read-identifier-triple) in-identifier) + (mapcar #'translate-triple result))))) + + +(defun snmp-get (oid) + "Returns a single value from the agent +It is presented in its most decoded form, +string-form of oid, string form of octet string, and symbolic +value in case of enumeration +The parameter is an oid in array form, dotted-numeric-form, symbolic form +or a trailing subidentifier" + (let ((triple (snmp-get- oid))) + (translate-triple triple))) + + + + +;; (defun snmp-get-% (ip community oid) +;; "" +;; (let ((response-buffer (udp-send-and-receive +;; ip +;; 161 +;; 1 +;; 3 +;; (ber-encode `(:sequence (:integer 0) ; version 1 +;; (:octet-string ,community) +;; (:get (:integer 12345) +;; (:integer 0) +;; (:integer 0) +;; (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) +;; (ber-decode response-buffer 0 (length response-buffer))))

-(defun snmpwalk (ip community &optional (start-oid #(0 0)) ) - (let ((next-oid start-oid) - response-oid - value) - (loop - while next-oid - do - (multiple-value-setq (response-oid value) (snmpgetnext ip community next-oid)) - until (equal next-oid (second response-oid)) - do - (setf next-oid (second response-oid)) - (format t "~s ~s~%" response-oid value))))

-(defun snmpget (ip community oid) - (let ((response-buffer (udp-send-and-receive - ip - 161 - 1 - 3 - (ber-encode `(:sequence (:integer 0) ; version 1 - (:octet-string ,community) - (:get (:integer 12345) - (:integer 0) - (:integer 0) - (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) - (ber-decode response-buffer 0 (length response-buffer)))) - -(defun snmpgetnext2 (ip community oid) - (let ((response-buffer (udp-send-and-receive - ip - 161 - 1 - 3 - (ber-encode `(:sequence (:integer 0) ; version 1 - (:octet-string ,community) - (:getnext (:integer 12345) - (:integer 0) - (:integer 0) - (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) - (ber-decode response-buffer 0 (length response-buffer)))) --- /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/03 01:32:05 1.2 +++ /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/20 15:55:08 1.3 @@ -18,6 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA |#

+;; (asdf:operate 'asdf:load-op :split-sequence) ;; (asdf:operate 'asdf:load-op :snmp1) (require 'sb-bsd-sockets) (defsystem :snmp1 @@ -28,6 +29,8 @@ :components ((:file "package") (:file "display") (:file "ber") - (:file "snmp"))) + (:file "mib") + (:file "snmp")) + :depends-on ("split-sequence"))

--- /project/snmp1/cvsroot/snmp1/tests.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/tests.lisp 2007/01/20 15:55:08 1.2 @@ -19,6 +19,15 @@

(in-package "SNMP1")

+(defparameter *example-decoded-response* + '(:SEQUENCE (:INTEGER 0) (:OCTET-STRING "public") + (:RESPONSE (:INTEGER 12345) (:INTEGER 0) (:INTEGER 0) + (:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))) + "Used in tests") + + (defun make-buffer () (make-array 300 :element-type '(unsigned-byte 8):fill-pointer 0))

@@ -26,10 +35,6 @@ (:method ((a vector) (b vector)) (and (= (length a) (length b)) (every #'= a b))))

-(defun beiv (xx) - (let ((buffer (make-buffer))) - (ber-encode-integer-value xx buffer))) - (defun test-01 () (format t "obs long value~%") (let ((buffer (make-buffer)) @@ -89,12 +94,6 @@ #(1 3 6 3255))))

-(defun test-10 () - (== #(1 3 5 6 7 333 233) (oid-string-to-oid ".1.3.5.6.7.333.233"))) - -(defun test-11 () - (equal ".1.3.5.6.7.333.233" (oid-to-oid-string #(1 3 5 6 7 333 233)))) -

(defun test-12 () (let ((buffer #(5 0))) @@ -181,19 +180,19 @@ (display (subseq buffer 29 53)) (ber-decode buffer 0 (length buffer))))

-(defun test-snmpgetnext () - (snmpgetnext #(127 0 0 1) "public" #(0 0))) +;;(defun test-snmpgetnext () +;; (snmpgetnext #(127 0 0 1) "public" #(0 0)))

-(defun test-snmpgetnext2 () - (snmpgetnext2 #(127 0 0 1) "public" #(0 0))) +;;(defun test-snmpgetnext2 () +;; (snmpgetnext2 #(127 0 0 1) "public" #(0 0)))

-(defun test-snmpwalk () - (snmpwalk #(127 0 0 1) "public")) +;;(defun test-snmpwalk () +;; (snmpwalk #(127 0 0 1) "public"))

-(defun test-snmpget () - (let ((r1 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.2.0")) - (r2 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.5.0"))) - (display r1 r2))) +;;(defun test-snmpget () +;; (let ((r1 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.2.0")) +;; (r2 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.5.0"))) +;; (display r1 r2)))

(defun expose-bit-7 (octets) @@ -202,37 +201,169 @@ octets))

-(lambda (sym-a sym-b) - (let* ((a (symbol-name sym-a)) - (b (symbol-name sym-b)) - (numeric-a (parse-integer a :start 5 :junk-allowed t)) - (numeric-b (parse-integer b :start 5 :junk-allowed t))) - (cond ((and numeric-a numeric-b) - (< numeric-a numeric-b)) - ((and (not numeric-a) (not numeric-b)) - (string< a b)) - ((identity a) t) - (t nil) - ))) - - -(defun compute-sort-key (sym) - (let ((number (parse-integer (symbol-name sym) :start 5 :junk-allowed t))) - (format nil "~5d~a" (if number number 99999) (symbol-name sym)))) +(defun test-30-pdu-from-message () + (tree-equal (pdu-from-message *example-decoded-response*) + '(:RESPONSE (:INTEGER 12345) (:INTEGER 0) (:INTEGER 0) + (:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10")))) + :test #'equal)) + +(defun test-31-value-from-encoding () + (and (eql 9 (value-from-encoding '(:integer 9))) + (equal ".1.3.6.1.4.1.8072.3.2.10" + (value-from-encoding '(:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))) + + +(defun test-32-request-id () + (let ((copied-tree (copy-tree *example-decoded-response*)) + (expected '(:SEQUENCE (:INTEGER 0) (:OCTET-STRING "public") + (:RESPONSE (:INTEGER 888) (:INTEGER 0) (:INTEGER 0) + (:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))))) + (and (eql 12345 (request-id *example-decoded-response*)) + (tree-equal expected (nreplace-request-id 888 copied-tree) :test #'equal)))) + +(defun test-40-oid-conversions () + (and (equalp #(1 3 5 6 7 333 233) (oid-string-to-oid ".1.3.5.6.7.333.233")) + (equal ".1.3.5.6.7.333.233" (oid-to-oid-string #(1 3 5 6 7 333 233))) + (equalp #(2 3 4) (oid-basic-form ".2.3.4")) + (equalp #(2 3 4) (oid-basic-form #(2 3 4))) + (equalp #(1 3 6 1 2 1 1 2) (oid-basic-form ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID")) + (equalp #(1 3 6 1 2 1 1 2) (oid-basic-form "sysObjectID")) + (equalp #(1 3 6 1 2 1 1 2 0) (oid-basic-form ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0")) + (equalp #(1 3 6 1 2 1 1 2 0) (oid-basic-form "sysObjectID.0")) + (equal ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID" + (symbolic-oid-from-oid #(1 3 6 1 2 1 1 2))) + (equal ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0" + (symbolic-oid-from-oid #(1 3 6 1 2 1 1 2 0))) + (equal ".iso.org.dod.internet.mgmt.mib-2.system.77.0" + (symbolic-oid-from-oid #(1 3 6 1 2 1 1 77 0))) + (equal ".77.6.1.2.1.1.2.0" (symbolic-oid-from-oid #(2 77 6 1 2 1 1 2 0))) + (equal ".iso.2.3.4.5" (symbolic-oid-from-oid #(1 2 3 4 5))))) + + + + + + +;; (defun test-60-snmpget () +;; (and ) +;; (snmp-get ".1.3.6.1.2.1.1.2.0")) + + + +(defun test-33-varbind-list () + (let ((pdu (pdu-from-message *example-decoded-response*)) + (expected '(:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))) + (and (tree-equal expected (varbind-list% pdu) :test #'equal) + (tree-equal expected (varbind-list *example-decoded-response*) :test #'equal)))) + + +(defun test-100-mib-grep () + (equal ".iso.org.dod.internet.mgmt.mib-2.ianaifType" + (mib-grep "ianaifType"))) + +(defun test-101-mib-grep-hashed () + (let ((expected '(".iso.org.dod.internet.mgmt.mib-2.ianaifType" + ".iso.org.dod.internet.mgmt.mib-2.interfaces.ifTable.ifEntry.ifType"))) + (and (equal expected (mib-grep-hashed "ifType")) + (equal expected (mib-grep-hashed "ifType"))))) + +(defun test-102-scalar () + (and (equalp #(1 2 3 4 5 6 0) (scalar #(1 2 3 4 5 6))) + (equalp #(1 2 3 4 5 6 77) (scalar #(1 2 3 4 5 6) 77)))) + + +(defun test-103-subidentifiers () + (and (equalp #("a" "b" "c") (subidentifiers ".a.b.c")) + (equalp #("a" "b" "c") (subidentifiers "a.b.c")) + (equalp #("a" 5 "c" 7) (subidentifiers ".a.5.c.7")) + (equalp #("a" 5 "c" 7) (subidentifiers "a.5.c.7")))) + +(defun test-104-triple () + (and + (equalp '(#(1 2 3) :integer 66) + (varbind-to-triple '(:sequence ( :object-identifier #(1 2 3)) (:integer 66)))) + (equalp '(#(3 4 5) :octet-string #(6 7 8)) + (varbind-to-triple '(:sequence (:object-identifier #(3 4 5)) (:octet-string #(6 7 8))))) + (equalp '(#(3 4 5) :null nil ) + (varbind-to-triple '(:sequence (:object-identifier #(3 4 5)) (:null)))) + (equalp '(#(3 4 5) nil nil ) + (varbind-to-triple '(:sequence (:object-identifier #(3 4 5))))) + (equalp '(:sequence (:object-identifier #(3 4 5)) (:octet-string #(6 7 8))) + (triple-to-varbind '(#(3 4 5) :octet-string #(6 7 8)))) + (equalp '(:sequence (:object-identifier #(3 4 5)) (:null)) + (triple-to-varbind '(#(3 4 5) :null nil ))))) + + +(defun test-250-snmp-get-many- () + (let ((expected '((#(1 3 6 1 2 1 1 9 1 2 2) :object-identifier #(1 3 6 1 6 3 1)) + (#(1 3 6 1 2 1 1 9 1 2 6) :object-identifier #(1 3 6 1 6 3 16 2 2 1))))) + (equalp expected + (snmp-get-many- '(#(1 3 6 1 2 1 1 9 1 2 2) + #( 1 3 6 1 2 1 1 9 1 2 6)) + 12345)))) + +(defun test-350-snmp-get- () + (and (equalp '(#(1 3 6 1 2 1 1 9 1 2 3):object-identifier #(1 3 6 1 2 1 49)) + (snmp-get- #(1 3 6 1 2 1 1 9 1 2 3))) + (equalp '(#(1 3 6 1 2 1 1 9 1 2 6) :object-identifier #(1 3 6 1 6 3 16 2 2 1)) + (snmp-get- #(1 3 6 1 2 1 1 9 1 2 6))) + )) + +(defun test-450-snmp-get () + (and (equalp '(".iso.org.dod.internet.mgmt.mib-2.system.sysORTable.sysOREntry.sysORID.2" + :OBJECT-IDENTIFIER + ".iso.org.dod.internet.snmpV2.snmpModules.snmpMIB") + (snmp-get + ".iso.org.dod.internet.mgmt.mib-2.system.sysORTable.sysOREntry.sysORID.2")) + (equalp '(".iso.org.dod.internet.mgmt.mib-2.system.sysORTable.sysOREntry.sysORID.6" + :OBJECT-IDENTIFIER + ".iso.org.dod.internet.snmpV2.snmpModules.snmpVacmMIB.vacmMIBConformance.vacmMIBGroups.vacmBasicGroup") + (snmp-get ".1.3.6.1.2.1.1.9.1.2.6")))) + +(defun test-451-get-wrong-oid () + ;; shuould not crash randomly. The oid will be nil here + (null (snmp-get "sysObjectOD.0"))) + + + +(defun compute-sort-keys (sym) + (let ((name (symbol-name sym))) + (multiple-value-bind (int eaten) (parse-integer (subseq name 5) :junk-allowed t) + (let ((alfa (subseq name (+ 5 eaten)))) + (values int alfa))))) + + + +(defun test-symbol-less (sym-a sym-b) + (multiple-value-bind (int-a alf-a) (compute-sort-keys sym-a) + (multiple-value-bind (int-b alf-b) (compute-sort-keys sym-b) + (if (eql int-a int-b) + (string< alf-a alf-b) + (< int-a int-b)))))

(defun run-tests () ;; All symbols in this package beginning with test and which is a function - (let (test-funcs) + (let (test-funcs + (totres t)) (loop for s being each present-symbol do - (let ((res (search "TEST-" (symbol-name s)))) - (when (and res (= 0 res) (parse-integer (symbol-name s) :start 5 :junk-allowed t) (fboundp s)) - (push s test-funcs)))) - - (setf test-funcs (sort test-funcs #'string< - :key #'compute-sort-key)) + (let ((res (search "TEST-" (symbol-name s)))) + (when (and res (= 0 res) + (parse-integer (symbol-name s) :start 5 :junk-allowed t) + (fboundp s)) + (push s test-funcs)))) + + (setf test-funcs (sort test-funcs #'test-symbol-less)) (loop for sym in test-funcs do - (let ((res (funcall sym))) - (format t "~a: ~a~%" sym (if res "PASSED" "FAILED"))) - ) - ) -) \ No newline at end of file + (let ((res (funcall sym))) + (format t "~a: ~a~%" sym (if res "PASSED" "FAILED")) + (unless res (setf totres nil)))) + totres)) + +(define-symbol-macro tt (run-tests)) +

--- /project/snmp1/cvsroot/snmp1/common-mib.dat 2007/01/20 15:55:08 NONE +++ /project/snmp1/cvsroot/snmp1/common-mib.dat 2007/01/20 15:55:08 1.1 +--iso(1) | +--org(3) | +--dod(6) | +--internet(1) | +--directory(1) | +--mgmt(2) | | | +--mib-2(1) | | | +--system(1) | | | | | +-- -R-- String sysDescr(1) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- ObjID sysObjectID(2) | | +-- -R-- TimeTicks sysUpTime(3) | | +-- -RW- String sysContact(4) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -RW- String sysName(5) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -RW- String sysLocation(6) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- INTEGER sysServices(7) | | | Range: 0..127 | | +-- -R-- TimeTicks sysORLastChange(8) | | | Textual Convention: TimeStamp | | | | | +--sysORTable(9) | | | | | +--sysOREntry(1) | | | Index: sysORIndex | | | | | +-- ---- INTEGER sysORIndex(1) | | | Range: 1..2147483647 | | +-- -R-- ObjID sysORID(2) | | +-- -R-- String sysORDescr(3) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- TimeTicks sysORUpTime(4) | | Textual Convention: TimeStamp | | | +--interfaces(2) | | | | | +-- -R-- INTEGER ifNumber(1) | | | | | +--ifTable(2) | | | | | +--ifEntry(1) | | | Index: ifIndex | | | | | +-- -R-- INTEGER ifIndex(1) | | +-- -R-- String ifDescr(2) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- EnumVal ifType(3) | | | Values: other(1), regular1822(2), hdh1822(3), ddn-x25(4), rfc877-x25(5), ethernet-csmacd(6), iso88023-csmacd(7), iso88024-tokenBus(8), iso88025-tokenRing(9), iso88026-man(10), starLan(11), proteon-10Mbit(12), proteon-80Mbit(13), hyperchannel(14), fddi(15), lapb(16), sdlc(17), ds1(18), e1(19), basicISDN(20), primaryISDN(21), propPointToPointSerial(22), ppp(23), softwareLoopback(24), eon(25), ethernet-3Mbit(26), nsip(27), slip(28), ultra(29), ds3(30), sip(31), frame-relay(32) | | +-- -R-- INTEGER ifMtu(4) | | +-- -R-- Gauge ifSpeed(5) | | +-- -R-- String ifPhysAddress(6) | | | Textual Convention: PhysAddress | | +-- -RW- EnumVal ifAdminStatus(7) | | | Values: up(1), down(2), testing(3) | | +-- -R-- EnumVal ifOperStatus(8) | | | Values: up(1), down(2), testing(3) | | +-- -R-- TimeTicks ifLastChange(9) | | +-- -R-- Counter ifInOctets(10) | | +-- -R-- Counter ifInUcastPkts(11) | | +-- -R-- Counter ifInNUcastPkts(12) | | +-- -R-- Counter ifInDiscards(13) | | +-- -R-- Counter ifInErrors(14) | | +-- -R-- Counter ifInUnknownProtos(15) | | +-- -R-- Counter ifOutOctets(16) | | +-- -R-- Counter ifOutUcastPkts(17) | | +-- -R-- Counter ifOutNUcastPkts(18) | | +-- -R-- Counter ifOutDiscards(19) | | +-- -R-- Counter ifOutErrors(20) | | +-- -R-- Gauge ifOutQLen(21) | | +-- -R-- ObjID ifSpecific(22) | | | +--at(3) | | | | | +--atTable(1) | | | | | +--atEntry(1) | | | Index: atIfIndex, atNetAddress | | | | | +-- -RW- INTEGER atIfIndex(1) | | +-- -RW- String atPhysAddress(2) | | | Textual Convention: PhysAddress | | +-- -RW- NetAddr atNetAddress(3) | | | +--ip(4) | | | | | +-- -RW- EnumVal ipForwarding(1) | | | Values: forwarding(1), not-forwarding(2) | | +-- -RW- INTEGER ipDefaultTTL(2) | | +-- -R-- Counter ipInReceives(3) | | +-- -R-- Counter ipInHdrErrors(4) | | +-- -R-- Counter ipInAddrErrors(5) | | +-- -R-- Counter ipForwDatagrams(6) | | +-- -R-- Counter ipInUnknownProtos(7) | | +-- -R-- Counter ipInDiscards(8) | | +-- -R-- Counter ipInDelivers(9) | | +-- -R-- Counter ipOutRequests(10) | | +-- -R-- Counter ipOutDiscards(11) | | +-- -R-- Counter ipOutNoRoutes(12) | | +-- -R-- INTEGER ipReasmTimeout(13) | | +-- -R-- Counter ipReasmReqds(14) | | +-- -R-- Counter ipReasmOKs(15) | | +-- -R-- Counter ipReasmFails(16) | | +-- -R-- Counter ipFragOKs(17) | | +-- -R-- Counter ipFragFails(18) | | +-- -R-- Counter ipFragCreates(19) | | | | | +--ipAddrTable(20) | | | | | | | +--ipAddrEntry(1) | | | | Index: ipAdEntAddr | | | | | | | +-- -R-- IpAddr ipAdEntAddr(1)

[4251 lines skipped]