[cl-net-snmp-cvs] r51 - trunk/asn.1

[ctian at common-lisp.net]

Author: ctian
Date: Sat Sep 22 10:47:20 2007
New Revision: 51

Removed:
   trunk/asn.1/stream-test.lisp
Modified:
   trunk/asn.1/ber.lisp
   trunk/asn.1/mib.lisp
   trunk/asn.1/oid.lisp
   trunk/asn.1/syntax.lisp
Log:
Some bugfix

Modified: trunk/asn.1/ber.lisp
==============================================================================
--- trunk/asn.1/ber.lisp	(original)
+++ trunk/asn.1/ber.lisp	Sat Sep 22 10:47:20 2007
@@ -60,8 +60,11 @@
         (setf tags (labels ((iter (acc)
                               (setf byte (read-byte stream))
                               (incf type-length)
-                              (let ((temp (logior (ash acc 7) (ldb (byte 7 0) byte))))
-                                (if (= (ldb (byte 1 7) byte) 1) (iter temp) temp))))
+                              (let ((temp (logior (ash acc 7)
+						  (ldb (byte 7 0) byte))))
+                                (if (= (ldb (byte 1 7) byte) 1)
+				    (iter temp)
+				    temp))))
                      (iter 0))))
       (values (get-asn.1-type class p/c tags)
               type-length))))
@@ -134,9 +137,9 @@
    (length :type integer :accessor ber-length)
    (position :type integer :initform 0 :accessor ber-position)))
 
-(defmethod shared-initialize :after ((instance ber-stream) slot-names &rest initargs)
+(defmethod shared-initialize :after ((obj ber-stream) slot-names &rest initargs)
   (declare (ignore slot-names initargs))
-  (setf (ber-length instance) (length (ber-sequence instance))))
+  (setf (ber-length obj) (length (ber-sequence obj))))
 
 (defmethod stream-read-byte ((instance ber-stream))
   (if (= (ber-position instance) (ber-length instance))

Modified: trunk/asn.1/mib.lisp
==============================================================================
--- trunk/asn.1/mib.lisp	(original)
+++ trunk/asn.1/mib.lisp	Sat Sep 22 10:47:20 2007
@@ -29,10 +29,7 @@
     (init-mib-tree)
     *mib-tree*))
 
-(eval-when (:load-toplevel :execute)
-  (init-mib-tree))
-
-(defun init-mib-tree ()  
+(defun init-mib-tree ()
   (insert-node *mib-tree* 1 "iso")
   (insert-node "iso" 3 "org")
   (insert-node "org" 6 "dod"))
@@ -55,7 +52,8 @@
                    (tree-nodes parent-node))
     (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-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
@@ -89,7 +87,9 @@
        r))))
 
 (defmethod resolve ((name string))
-  (gethash name *mib-index*))
+  (let ((node (gethash name *mib-index*)))
+    (when node
+      (reverse (tree-id node)))))
 
 (defmethod print-object ((obj object-id) stream)
   (with-slots (rev-ids rev-names) obj
@@ -123,3 +123,6 @@
               (make-pathname :name name :type "asn"
                              :directory '(:relative "asn.1" "test"))
               (asdf:component-pathname (asdf:find-system :net-snmp)))))
+
+(eval-when (:load-toplevel :execute)
+  (init-mib-tree))

Modified: trunk/asn.1/oid.lisp
==============================================================================
--- trunk/asn.1/oid.lisp	(original)
+++ trunk/asn.1/oid.lisp	Sat Sep 22 10:47:20 2007
@@ -56,14 +56,14 @@
                  (ber-encode-length l)
                  v))))))
 
-(defmethod ber-decode-value ((stream stream) (type (eql :object-identifier)) length)
-  (declare (type stream stream)
+(defmethod ber-decode-value ((s stream) (type (eql :object-identifier)) length)
+  (declare (type stream s)
            (type fixnum length)
            (ignore type))
   (if (zerop length)
       (make-instance 'objet-id)
     (labels ((get-number (acc len)
-               (let* ((byte (read-byte stream))
+               (let* ((byte (read-byte s))
                       (val (logior (ash acc 7) (logand byte 127))))
                  (if (< byte 128) (values val len)
                    (get-number val (1+ len)))))

Modified: trunk/asn.1/syntax.lisp
==============================================================================
--- trunk/asn.1/syntax.lisp	(original)
+++ trunk/asn.1/syntax.lisp	Sat Sep 22 10:47:20 2007
@@ -1,14 +1,16 @@
 (in-package :asn.1)
 
-(defvar *asn.1-syntax-source* (merge-pathnames
-                               (make-pathname :name "asn.1" :type "zb"
-                                              :directory '(:relative "asn.1"))
-                               (asdf:component-pathname (asdf:find-system :net-snmp))))
+(defvar *asn.1-syntax-source*
+  (merge-pathnames
+   (make-pathname :name "asn.1" :type "zb"
+		  :directory '(:relative "asn.1"))
+   (asdf:component-pathname (asdf:find-system :net-snmp))))
 
-(defparameter *asn.1-syntax* (merge-pathnames
-                              (make-pathname :name "asn.1" :type "tab"
-                                             :directory '(:relative "asn.1"))
-                              (asdf:component-pathname (asdf:find-system :net-snmp))))
+(defparameter *asn.1-syntax*
+  (merge-pathnames
+   (make-pathname :name "asn.1" :type "tab"
+		  :directory '(:relative "asn.1"))
+   (asdf:component-pathname (asdf:find-system :net-snmp))))
 
 (eval-when (:load-toplevel :execute)
   (zebu-load-file *asn.1-syntax*))