Author: ctian Date: Thu Sep 20 20:46:45 2007 New Revision: 48
Modified: trunk/asn.1/mib.lisp trunk/asn.1/oid.lisp trunk/net-snmp.asd Log: MIB Tree Finish
Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Thu Sep 20 20:46:45 2007 @@ -4,16 +4,53 @@
(in-package :asn.1)
-(proclaim '(inline tree-id tree-name tree-object tree-nodes)) -(defun tree-id (node) (car node)) -(defun tree-name (node) (caadr node)) -(defun tree-object (node) (cdadr node)) -(defun tree-nodes (node) (cddr node)) +#| +MIB Tree Structure: + +((NIL NIL NIL) + (((1) ("iso") #<OBJECT-ID .1(.iso)>) + (((3 1) ("org" "iso") #<OBJECT-ID .1.3(.iso.org)>) + (((6 3 1) ("dod" "org" "iso") #<OBJECT-ID .1.3.6(.iso.org.dod)>) + (((1 6 3 1) + ("internet" "dod" "org" "iso") + #<OBJECT-ID .1.3.6.1(.iso.org.dod.internet)>) + (((1 1 6 3 1) + ("directory" "internet" "dod" "org" "iso") + #<OBJECT-ID .1.3.6.1.1(.iso.org.dod.internet.directory)>)) + (((2 1 6 3 1) + ("mgmt" "internet" "dod" "org" "iso") + #<OBJECT-ID .1.3.6.1.2(.iso.org.dod.internet.mgmt)>)) + (((3 1 6 3 1) + ("experimental" "internet" "dod" "org" "iso") + #<OBJECT-ID .1.3.6.1.3(.iso.org.dod.internet.experimental)>)) + (((4 1 6 3 1) + ("private" "internet" "dod" "org" "iso") + #<OBJECT-ID .1.3.6.1.4(.iso.org.dod.internet.private)>) + (((1 4 1 6 3 1) + ("enterprises" "private" "internet" "dod" "org" "iso") + #<OBJECT-ID .1.3.6.1.4.1(.iso.org.dod.internet.private.enterprises)>)))))))) +|# + +;;; Tree -> ( Tree-Data . Tree-Nodes ) +;;; Tree-Data -> ( Tree-ID Tree-Name Tree-Object ) +;;; Tree-ID -> ( number . Tree-ID ) +;;; Tree-Name -> ( string . Tree-Name ) +;;; Tree-Object -> Object-ID [ ID-List Name-List ] + +(defvar *mib-tree* '((() () ())) "MIB Tree") ;; empty tree + +(defvar *mib-index* (make-hash-table :test #'string=) "MIB Name Hash") + +(defun tree-data (node) (car node)) +(defun tree-nodes (node) (cdr node)) +(defun tree-id (node) (first (tree-data node))) +(defun tree-name (node) (second (tree-data node))) +(defun tree-object (node) (third (tree-data node)))
(defun find-node (name &optional (node *mib-tree*)) (declare (type string name)) (labels ((test (n) - (string= name (tree-name n))) + (string= name (car (tree-name n)))) (iter (queue) (if (null queue) nil (let ((head (car queue))) @@ -23,24 +60,50 @@ (if (test node) node (iter (copy-list (tree-nodes node))))))
-(defun make-node (id name &optional (object nil)) - (declare (type fixnum id) - (type string name)) - (list id (cons name object))) - -(defun insert-node (node parent-name) - (let ((parent-node (find-node parent-name))) - (if parent-node - (if (find-if #'(lambda (x) - (= (tree-id node) (tree-id x))) - (tree-nodes parent-node)) - (error "id conflict") - (nconc parent-node (list node))) - (error "cannot find parent")))) +(defgeneric insert-node (parent id name))
-(defmethod print-object ((obj object-id) stream) - (format stream "[~{.~A~}]" (oid-subids obj))) +(defmethod insert-node ((parent-node list) id name) + (if (find-if #'(lambda (x) (= id (car (tree-id x)))) + (tree-nodes parent-node)) + (error "Conflict.") + (let ((tree-id (cons id (tree-id parent-node))) + (tree-name (cons name (tree-name parent-node)))) + (let ((tree-object (make-instance 'object-id :id tree-id :name tree-name))) + (let ((tree-data (list tree-id tree-name tree-object))) + (let ((tree-node (cons tree-data nil))) + (progn + (unless (gethash name *mib-index*) + (setf (gethash name *mib-index*) tree-node)) + (nconc parent-node (cons tree-node nil))))))))) + +(defmethod insert-node ((parent-name string) id name) + (let ((node (gethash parent-name *mib-index*))) + (if node + (insert-node node id name) + (error "No parent node.")))) + +(defgeneric tree-node (id &optional node)) + +(defmethod tree-node ((id integer) &optional (node *mib-tree*)) + (find-if #'(lambda (x) (= id (car (tree-id x)))) + (tree-nodes node))) + +(defmethod tree-node ((id list) &optional (node *mib-tree*)) + (if (endp id) (values node t) + (let ((next (tree-node (car id) node))) + (if next + (tree-node (cdr id) next) + (values id nil)))))
+(defun resolve (oid-list) + ) + +(defmethod print-object ((obj object-id) stream) + (with-slots (rev-ids rev-names) obj + (print-unreadable-object (obj stream :type t) + (format stream "~{.~A~}(~{.~D~})" + (reverse rev-ids) + (reverse rev-names)))))
;;; MIB ;;; @@ -71,9 +134,6 @@ ;;; difficult to read. Once this has been tested, this should be ;;; slightly redesigned.
-(defparameter *mib-tree* '(nil nil (1 ("iso") - (3 ("org") - (6 ("dod"))))))
(defvar *mib-pathname-base* #p"/usr/share/snmp/mibs/")
@@ -122,3 +182,15 @@ :directory '(:relative "asn.1" "test")) (asdf:component-pathname (asdf:find-system :net-snmp)))))
+(defun test-initialize () + (progn + (insert-node *mib-tree* 1 "iso") + (insert-node "iso" 3 "org") + (insert-node "org" 6 "dod") + (insert-node "dod" 1 "internet") + (insert-node "internet" 1 "directory") + (insert-node "internet" 2 "mgmt") + (insert-node "internet" 3 "experimental") + (insert-node "internet" 4 "private") + (insert-node "private" 1 "enterprises") + *mib-tree*))
Modified: trunk/asn.1/oid.lisp ============================================================================== --- trunk/asn.1/oid.lisp (original) +++ trunk/asn.1/oid.lisp Thu Sep 20 20:46:45 2007 @@ -5,21 +5,21 @@ (in-package :asn.1)
(defclass object-id () - ((subids :initform nil :type list :reader oid-subids :initarg :id) + ((rev-ids :initform nil :type list :initarg :id) + (rev-names :initform nil :type list :reader oid-name :initarg :name) (length :initform 0 :type integer :reader oid-length)))
+(defun oid-id (oid) + (declare (type object-id oid)) + (reverse (slot-value 'rev-ids oid))) + (defmethod shared-initialize :after ((obj object-id) slot-names &rest initargs) (declare (ignore slot-names initargs)) - (with-slots (subids length) obj - (setf length (list-length subids)))) - -(defgeneric parse-oid (oids)) - -(defmethod parse-oid ((oids list)) - (make-instance 'object-id :id oids)) + (with-slots (rev-ids length) obj + (setf length (list-length rev-ids))))
-(defmethod parse-oid ((oids string)) - nil) +(defmethod make-object-id (ids) + (make-instance 'object-id :id (reverse ids)))
;;; Note: defdelim and ddfn are copyed from ;;; Page 228 (Figure 17.4), Paul Graham's /On Lisp/. @@ -77,7 +77,7 @@
(defun oid-prefix-p (oid1 oid2) (declare (type object-id oid1 oid2)) - (list-prefix-p (oid-subids oid1) (oid-subids oid2))) + (list-prefix-p (oid-id oid1) (oid-id oid2)))
;;; BER Encode & Decode (:object-identifier)
@@ -94,21 +94,22 @@ (values acc len) (multiple-value-bind (sub-oid sub-length) (number-get (car oids)) (iter (cdr oids) (nconc acc sub-oid) (+ len sub-length)))))) - (with-slots (subids length) value - (multiple-value-bind (v l) - (case length - (0 (values nil 0)) - (1 (number-split (* (first subids) 40) 0 nil 0)) - (2 (number-split (+ (* (first subids) 40) - (second subids)) 0 nil 0)) - (otherwise (apply #'iter - (cddr subids) - (multiple-value-list - (number-split (+ (* (first subids) 40) - (second subids)) 0 nil 0))))) - (nconc (ber-encode-type 0 0 6) - (ber-encode-length l) - v))))) + (with-slots (rev-ids length) value + (let ((subids (reverse rev-ids))) + (multiple-value-bind (v l) + (case length + (0 (values nil 0)) + (1 (number-split (* (first subids) 40) 0 nil 0)) + (2 (number-split (+ (* (first subids) 40) + (second subids)) 0 nil 0)) + (otherwise (apply #'iter + (cddr subids) + (multiple-value-list + (number-split (+ (* (first subids) 40) + (second subids)) 0 nil 0))))) + (nconc (ber-encode-type 0 0 6) + (ber-encode-length l) + v))))))
(defmethod ber-decode-value ((stream stream) (type (eql :object-identifier)) length) (declare (type stream stream) @@ -124,7 +125,7 @@ (iter (left-length acc head-p) (declare (type fixnum left-length) (type list acc)) - (if (zerop left-length) (nreverse acc) + (if (zerop left-length) acc (multiple-value-bind (n l) (get-number 0 1) (if head-p (multiple-value-bind (q r) (floor n 40)
Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Thu Sep 20 20:46:45 2007 @@ -14,20 +14,21 @@ :net-telent-date ; for time conv :iolib ; for network :zebu ; for asn.1 parse + :zebu-compiler ) :components ((:module asn.1 :components ((:file "package") (:file "syntax" :depends-on ("package")) (:file "ber" :depends-on ("package")) (:file "smi" :depends-on ("ber")) (:file "oid" :depends-on ("syntax" "ber")) - (:file "mib" :depends-on ("syntax" "oid")))) - (:file "package") - (:file "constants" :depends-on ("package")) - (:file "typedefs" :depends-on ("constants")) - (:file "snmp-api" :depends-on ("typedefs")) - (:file "load" :depends-on ("snmp-api")) - (:file "asn1" :depends-on ("load")) - (:file "classes" :depends-on ("asn1")))) + (:file "mib" :depends-on ("syntax" "oid")))))) +;; (:file "package") +;; (:file "constants" :depends-on ("package")) +;; (:file "typedefs" :depends-on ("constants")) +;; (:file "snmp-api" :depends-on ("typedefs")) +;; (:file "load" :depends-on ("snmp-api")) +;; (:file "asn1" :depends-on ("load")) +;; (:file "classes" :depends-on ("asn1"))))
(defsystem sabrina :description "Sabrina - Update server status into database"