[cl-net-snmp-cvs] r10 - trunk

[ctian at common-lisp.net]

Author: ctian
Date: Mon Apr  2 14:11:13 2007
New Revision: 10

Modified:
   trunk/classes.lisp
   trunk/constants.lisp
Log:
* add +asn-counter32+ type
* add snmp-msg-get-list method to request more than one snmp var at once.


Modified: trunk/classes.lisp
==============================================================================
--- trunk/classes.lisp	(original)
+++ trunk/classes.lisp	Mon Apr  2 14:11:13 2007
@@ -40,38 +40,63 @@
     (progn
       (setf c-oids (foreign-alloc 'c-oid :count +max-oid-len+)
 	    c-oid-len (foreign-alloc 'c-size-type :initial-element +max-oid-len+))
-      (if (eq (elt name 0) #\.)
+      (if (and (> (length name) 0)
+	       (eq (elt name 0) #\.))
 	  (c-read-objid name c-oids c-oid-len)
 	  (c-get-node name c-oids c-oid-len))
       (setf length (mem-ref c-oid-len 'c-size-type)))))
 
 (defmethod snmp-msg-get ((s snmp-session) (o oid))
+  (car (snmp-msg-get-list s (list o))))
+
+(defmethod snmp-msg-get ((s snmp-session) (o string))
+  (snmp-msg-get s (make-instance 'oid :name o)))
+
+(defmethod snmp-msg-get ((s string) (o string))
+  (snmp-msg-get (make-instance 'snmp-session :peername s) o))
+
+(defmethod snmp-msg-get-list ((s snmp-session) (oids list))
   (let ((ss (c-snmp-open (slot-value s 'c-session)))
 	(pdu (c-snmp-pdu-create +snmp-msg-get+))
 	(response (foreign-alloc :pointer :initial-element (null-pointer)))
-	value)
+	values)
     (progn
-      (c-snmp-add-null-var pdu
-			   (slot-value o 'c-oids)
-			   (mem-ref (slot-value o 'c-oid-len) 'c-size-type))
+      ;; 1. fill oids into request pdu
+      (dolist (o oids)
+	(let ((real-o (typecase o
+			(oid o)
+			(string (make-instance 'oid :name o))
+			(t (make-instance 'oid :name "")))))
+	  (c-snmp-add-null-var pdu
+			       (slot-value real-o 'c-oids)
+			       (mem-ref (slot-value real-o 'c-oid-len) 'c-size-type))))
+      ;; 2. get results from response pdu
       (let ((status (c-snmp-synch-response ss pdu response)))
-	(if (and (= status +snmp-stat-success+)
-		 (= (foreign-slot-value (mem-aref response :pointer) 'c-snmp-pdu 'c-errstat)
-		    +snmp-err-noerror+))
-	    (let ((vars (foreign-slot-value (mem-aref response :pointer)
-					    'c-snmp-pdu 'c-variables)))
-	      (if (= (foreign-slot-value vars 'c-variable-list 'c-type) +asn-octet-str+)
-		  (setf value (foreign-string-to-lisp
-			       (foreign-slot-value vars 'c-variable-list 'c-val)
-			       (foreign-slot-value vars 'c-variable-list 'c-val-len)))
-		  (setf value "(not a string, unsupport yet..)")))))
+	(setf values
+	      (if (and (= status +snmp-stat-success+)
+		       (= (foreign-slot-value (mem-aref response :pointer) 'c-snmp-pdu 'c-errstat)
+			  +snmp-err-noerror+))
+		  (loop for vars =  (foreign-slot-value (mem-aref response :pointer)
+							'c-snmp-pdu 'c-variables)
+		     then (foreign-slot-value vars 'c-variable-list 'c-next-variable)
+		     until (null-pointer-p vars)
+		     collect (snmp-var->value vars)))))
       (c-snmp-pdu-free (mem-aref response :pointer))
       (c-snmp-close ss)
-      value)))
-
-(defmethod snmp-msg-get ((s snmp-session) (o string))
-  (snmp-msg-get s (make-instance 'oid :name o)))
+      values)))
 
-(defmethod snmp-msg-get ((s string) (o string))
-  (snmp-msg-get (make-instance 'snmp-session :peername s) o))
+(defmethod snmp-msg-get-list ((s string) (oids list))
+  (snmp-msg-get-list (make-instance 'snmp-session :peername s) oids))
 
+(defmacro snmp-var->value (var)
+  (let ((v (gensym)))
+    `(let ((,v ,var))
+       (case (foreign-slot-value ,v 'c-variable-list 'c-type)
+	 (,+asn-octet-str+
+	  (foreign-string-to-lisp
+	   (foreign-slot-value ,v 'c-variable-list 'c-val)
+	   (foreign-slot-value ,v 'c-variable-list 'c-val-len)))
+	 (,+asn-counter32+
+	  (mem-ref (foreign-slot-value ,v 'c-variable-list 'c-val)
+		   :uint32))
+	 (otherwise :others)))))

Modified: trunk/constants.lisp
==============================================================================
--- trunk/constants.lisp	(original)
+++ trunk/constants.lisp	Mon Apr  2 14:11:13 2007
@@ -16,6 +16,7 @@
 (defconstant +asn-object-id+	#x06)
 (defconstant +asn-sequence+	#x10)
 (defconstant +asn-set+		#x11)
+(defconstant +asn-counter32+	#x41)
 
 (defconstant +asn-universal+	#b00000000)
 (defconstant +asn-application+	#b01000000)