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*))