[lisp-snmp] Misc fiddles for new OID types

[John F. <jf...@ms...>]

Dear Chun Tian,

Here are the misc helpers I put in to deal with the new OID types.

Maybe you would like to fix them up or correct them?

ASN.1 patch

Index: runtime/object-id.lisp
===================================================================
--- runtime/object-id.lisp	(revision 766)
+++ runtime/object-id.lisp	(working copy)
@@ -113,8 +113,9 @@
   (slot-boundp oid 'parent))
 
 (defun oid-module-p (oid)
-  (declare (type object-id oid))
-  (slot-boundp oid 'module))
+  (typecase oid
+    (object-id
+     (slot-boundp oid 'module))))
 
 (defun oid-syntax-p (oid)
   (declare (type object-id oid))
@@ -124,17 +125,29 @@
   (declare (type object-id oid))
   (symbol-name (oid-name oid)))
 
-(defun oid-name-list (oid)
-  (declare (type object-id oid))
+(defgeneric oid-name-list (oid))
+(defmethod oid-name-list ((oid object-id))
   (labels ((iter (o acc)
              (if (slot-boundp o 'parent)
-                 (iter (oid-parent o) (cons (if (slot-boundp o 'name)
-                                                (oid-name-string o)
-                                              (oid-value o))
-                                            acc))
-               acc)))
+                 (iter (oid-parent o) 
+		       (cons (if (slot-boundp o 'name)
+				 (oid-name-string o)
+				 (oid-value o))
+			     acc))
+		 acc)))
     (iter oid nil)))
 
+(defun oid-number-sublist (oid)
+  (nthcdr 
+   (if (oid-parent-p oid)
+       (oid-length (oid-parent oid))
+       0)
+   (oid-number-list oid)))
+
+(defmethod oid-name-list ((oid simple-oid))
+  (append (when (oid-parent-p oid) (oid-name-list (oid-parent oid))) 
+	  (oid-number-sublist oid)))
+
 (defmethod plain-value ((object simple-oid) &key default)
   (declare (ignore default))
   (oid-number-list object))
Index: runtime/oid-walk.lisp
===================================================================
--- runtime/oid-walk.lisp	(revision 766)
+++ runtime/oid-walk.lisp	(working copy)
@@ -85,10 +85,25 @@
        (zerop (hash-table-count (oid-children oid)))))
 
 (defun oid-trunk-p (oid)
-  (declare (type object-id oid))
   (and (slot-boundp oid 'name)
        (plusp (hash-table-count (oid-children oid)))))
 
+(defun oid-find-base (oid)
+  (labels ((iter (o acc)
+	     (typecase o
+	       (null (values nil acc))
+	       (object-id
+		(if (slot-boundp o 'name)
+		    (values o acc)
+		    (let ((p (oid-parent o))
+			  (v (oid-value o)))
+		      (iter p (cons v acc)))))
+	       (simple-oid
+		(iter (when (oid-parent-p o) (oid-parent o)) 
+		      (append (oid-number-sublist o) acc))))))
+    (iter oid nil)))
+
+
 (defun oid-find-leaf (oid)
   "Find the leaf node in a oid's all parents"
   (declare (type object-id oid))



PS. Thanks for fixing runtime/ipaddress to not barf on length != 4.

BTW 
(loop for i from 1 upto length
    collect (read-byte stream)) 

is the same as

(loop repeat length
        collect (read-byte stream))