[cl-net-snmp-cvs] r71 - in trunk: smi snmp

[ctian at common-lisp.net]

Author: ctian
Date: Wed Oct 17 08:25:00 2007
New Revision: 71

Modified:
   trunk/smi/opaque.lisp
   trunk/snmp/session.lisp
   trunk/snmp/snmp-get.lisp
   trunk/snmp/snmp-walk.lisp
Log:
fix sbcl run and (set-socket-option s :receive-timeout :sec 1 :usec 0) is correct.

Modified: trunk/smi/opaque.lisp
==============================================================================
--- trunk/smi/opaque.lisp	(original)
+++ trunk/smi/opaque.lisp	Wed Oct 17 08:25:00 2007
@@ -42,6 +42,7 @@
   (let ((b-1 (read-byte stream))
         (b-2 (read-byte stream))
         (b-3 (read-byte stream)))
+    (declare (ignore b-1 b-2))
     (if (= b-3 4)
       (ber-decode-value stream :float 4)
       (make-instance 'opaque :value nil))))

Modified: trunk/snmp/session.lisp
==============================================================================
--- trunk/snmp/session.lisp	(original)
+++ trunk/snmp/session.lisp	Wed Oct 17 08:25:00 2007
@@ -7,23 +7,23 @@
 
 #-win32
 (defclass session ()
-  ((socket :reader socket
+  ((socket :reader socket-of
            :initarg :socket
            :type socket)
-   (version :reader version
+   (version :reader version-of
 	    :initarg :version
 	    :type integer
 	    :initform *default-version*)))
 
 #+win32
 (defclass session ()
-  ((version :reader version
+  ((version :reader version-of
 	    :initarg :version
 	    :type integer
 	    :initform *default-version*)))
 
 (defclass v1-session (session)
-  ((community :reader community
+  ((community :reader community-of
               :initarg :community
               :type string
               :initform *default-community*))
@@ -66,9 +66,9 @@
 (defun make-session (host &key (class *default-class*)
                                (port *default-port*)
                                (community *default-community*))
-  (let ((socket (make-socket :remote-host host
+  (let ((s (make-socket :remote-host host
                              :remote-port port
                              :type :datagram
                              :ipv6 nil)))
-    (set-socket-option socket :receive-timeout :timeval '(1 0))
-    (make-instance class :socket socket :community community)))
+    (set-socket-option s :receive-timeout :sec 1 :usec 0)
+    (make-instance class :socket s :community community)))

Modified: trunk/snmp/snmp-get.lisp
==============================================================================
--- trunk/snmp/snmp-get.lisp	(original)
+++ trunk/snmp/snmp-get.lisp	Wed Oct 17 08:25:00 2007
@@ -4,7 +4,10 @@
   (:documentation "SNMP Get"))
 
 (defmethod snmp-get ((host string) &rest vars)
-  (apply #'snmp-get (make-session host) vars))
+  (let ((session (make-session host)))
+    (unwind-protect
+        (apply #'snmp-get session vars)
+      (close (socket-of session)))))
 
 #-win32
 (defmethod snmp-get ((session v1-session) &rest vars)
@@ -12,19 +15,20 @@
                                           (object-id x)
                                           (string (resolve x))) nil)) vars)))
     (let ((message (make-instance 'message
-                                  :version (version session)
-                                  :community (community session)
+                                  :version (version-of session)
+                                  :community (community-of session)
                                   :data (make-instance 'get-request-pdu
                                                        :request-id 0
                                                        :variable-bindings vb))))
-      (let ((data (ber-encode message)))
+      (let ((data (ber-encode message))
+            (socket (socket-of session)))
         (socket-send (make-array (length data)
                                  :element-type '(unsigned-byte 8)
                                  :adjustable nil
                                  :initial-contents data
                                  #+lispworks :allocation #+lispworks :static)
-                     (socket session))
-        (let ((message (decode-message (socket session))))
+                     socket)
+        (let ((message (decode-message socket)))
           (mapcar #'second
                   (variable-bindings
                    (message-data message))))))))

Modified: trunk/snmp/snmp-walk.lisp
==============================================================================
--- trunk/snmp/snmp-walk.lisp	(original)
+++ trunk/snmp/snmp-walk.lisp	Wed Oct 17 08:25:00 2007
@@ -4,28 +4,32 @@
   (:documentation "SNMP Walk"))
 
 (defmethod snmp-walk ((host string) var)
-  (snmp-walk (make-session host) var))
+  (let ((session (make-session host)))
+    (unwind-protect
+        (snmp-walk (make-session host) var)
+      (close (socket-of session)))))
 
 #-win32
 (defmethod snmp-walk ((session v1-session) (var object-id))
   "SNMP Walk for v1 and v2c"
   (let ((message (make-instance 'message
-                                :version (version session)
-                                :community (community session)
+                                :version (version-of session)
+                                :community (community-of session)
                                 :data (make-instance 'get-next-request-pdu
                                                      :request-id 0
                                                      :variable-bindings (list nil)))))
     (labels ((iter (v id acc)
                (setf (car (variable-bindings (message-data message))) (list v nil)
                      (request-id (message-data message)) id)
-               (let ((data (ber-encode message)))
+               (let ((data (ber-encode message))
+                     (socket (socket-of session)))
                  (socket-send (make-array (length data)
                                           :element-type '(unsigned-byte 8)
                                           :adjustable nil
                                           :initial-contents data
                                           #+lispworks :allocation #+lispworks :static)
-                              (socket session))
-                 (let ((result (decode-message (socket session))))
+                              socket)
+                 (let ((result (decode-message socket)))
                    (let ((vb (car (variable-bindings (message-data result)))))
                      (if (not (oid-< (car vb) var))
                        (nreverse acc)