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]
