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

ctian at common-lisp.net ctian at common-lisp.net
Thu Jun 7 06:23:55 UTC 2007


Author: ctian
Date: Thu Jun  7 02:23:53 2007
New Revision: 20

Added:
   trunk/advance.lisp
   trunk/zilong.lisp
Modified:
   trunk/asn1.lisp
   trunk/classes.lisp
   trunk/load.lisp
   trunk/net-snmp.asd
   trunk/package.lisp
   trunk/snmp-api.lisp
Log:
use cffi again, since I can patch it to support 64bit lispworks

Added: trunk/advance.lisp
==============================================================================
--- (empty file)
+++ trunk/advance.lisp	Thu Jun  7 02:23:53 2007
@@ -0,0 +1,2 @@
+(in-package :org.net-snmp)
+

Modified: trunk/asn1.lisp
==============================================================================
--- trunk/asn1.lisp	(original)
+++ trunk/asn1.lisp	Thu Jun  7 02:23:53 2007
@@ -6,30 +6,15 @@
    c-oids
    c-oid-len))
 
-#-lispworks
 (defmethod shared-initialize :after ((instance oid) slot-names &rest initargs)
   (declare (ignore slot-names initargs))
   (with-slots (name length c-oids c-oid-len) instance
     (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 (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))
+      (c-read-objid name c-oids c-oid-len)
       (setf length (mem-ref c-oid-len 'c-size-type)))))
 
-#+lispworks
-(defmethod shared-initialize :after ((instance oid) slot-names &rest initargs)
-  (declare (ignore slot-names initargs))
-  (with-slots (name length c-oids c-oid-len) instance
-    (progn
-      (setf c-oids (fli:allocate-foreign-object :type 'oid :nelems +max-oid-len+)
-            c-oid-len (fli:allocate-foreign-object :type 'size-t))
-      (read-objid name c-oids c-oid-len)
-      (setf length (fli:dereference c-oid-len)))))
-
-#-lispworks
 (defun snmp-var->value (v)
   (case (foreign-slot-value v 'c-variable-list 'c-type)
     ;; ASN_INTEGER
@@ -42,19 +27,3 @@
       (foreign-slot-value v 'c-variable-list 'c-val)
       (foreign-slot-value v 'c-variable-list 'c-val-len)))
     (otherwise :others)))
-
-#+lispworks
-(defun snmp-var->value (v)
-  (case (fli:foreign-slot-value v 'type)
-    ;; ASN_INTEGER
-    (#x02
-     (fli:dereference
-      (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val)
-                              'integer)))
-    ;; ASN_OCTET_STR
-    (#x04
-     (fli:convert-from-foreign-string
-      (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val)
-                              'string)
-      :length (fli:foreign-slot-value v 'val-len)))
-    (otherwise (fli:foreign-slot-value v 'type))))

Modified: trunk/classes.lisp
==============================================================================
--- trunk/classes.lisp	(original)
+++ trunk/classes.lisp	Thu Jun  7 02:23:53 2007
@@ -42,7 +42,6 @@
 	       :initform "01234567")
    c-session))
 
-#-lispworks
 (defmethod shared-initialize :after ((instance snmp-session) slot-names &rest initargs)
   (declare (ignore slot-names initargs))
   (with-slots (peername version c-session) instance
@@ -101,49 +100,6 @@
 			 (error "Error generating Ku from authentication pass phrase.")))))))
 	    (t (error "unknown snmp version!"))))))
 
-#+lispworks
-(defmethod shared-initialize :after ((instance snmp-session) slot-names &rest initargs)
-  (declare (ignore slot-names initargs))
-  (with-slots (peername version c-session) instance
-    (progn
-      (setf c-session (fli:allocate-foreign-object :type 'netsnmp-session))
-      (snmp-sess-init c-session)
-      (setf (fli:foreign-slot-value c-session 'peername) (fli:convert-to-foreign-string peername)
-            (fli:foreign-slot-value c-session 'version) version)
-      (cond ((or (= version +snmp-version-1+)
-		 (= version +snmp-version-2c+))
-	     (with-slots (community) instance
-               (setf (fli:foreign-slot-value c-session 'community) (fli:convert-to-foreign-string community)
-                     (fli:foreign-slot-value c-session 'community-len) (length community))))
-	    ;; SNMPv3 support
-	    ((= version +snmp-version-3+)
-	     (with-slots (security-name security-auth-proto passphrase) instance
-               (progn
-                 (setf (fli:foreign-slot-value c-session 'security-name) (fli:convert-to-foreign-string security-name)
-                       (fli:foreign-slot-value c-session 'security-name-len) (length security-name)
-                       ;; we only support authNoPriv now
-                       (fli:foreign-slot-value c-session 'security-level) +snmp-sec-level-authnopriv+
-                       (fli:foreign-slot-value c-session 'security-auth-key-len) +usm-auth-ku-len+)
-                 (case security-auth-proto
-                   (:hmac-md5
-                    (setf (fli:foreign-slot-value c-session 'security-auth-proto) +usm-hmac-md5-auth-protocol+
-                          (fli:foreign-slot-value c-session 'security-auth-proto-len) +usm-hmac-md5-auth-protocol-len+))
-                   (:hmac-sha1
-                    (setf (fli:foreign-slot-value c-session 'security-auth-proto) +usm-hmac-sha1-auth-protocol+
-                          (fli:foreign-slot-value c-session 'security-auth-proto-len) +usm-hmac-sha1-auth-protocol-len+)))
-                 (fli:with-foreign-string (c-passphrase c-passphrase-len byte-count)
-                     passphrase
-                   (declare (ignore byte-count))
-                   (if (/= (generate-ku (fli:foreign-slot-value c-session 'security-auth-proto)
-                                        (fli:foreign-slot-value c-session 'security-auth-proto-len)
-                                        c-passphrase
-                                        c-passphrase-len
-                                        (fli:foreign-array-pointer (fli:foreign-slot-pointer c-session 'security-auth-key) 0)
-                                        (fli:foreign-slot-pointer c-session 'security-auth-key-len))
-                           +snmp-err-success+)
-                       (error "Error generating Ku from authentication pass phrase."))))))
-	    (t (error "unknown snmp version!"))))))
-
 (defmethod snmp-msg-get ((s snmp-session) (o oid))
   (car (snmp-msg-get-list s (list o))))
 
@@ -156,7 +112,6 @@
 (defmethod snmp-msg-get ((s string) (o oid))
   (snmp-msg-get (make-instance 'snmp-session :peername s) o))
 
-#-lispworks
 (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+))
@@ -176,47 +131,21 @@
       (let ((status (c-snmp-synch-response ss pdu response)))
         (setf values
               (if (and (= status +snmp-stat-success+)
-                       (= (foreign-slot-value (mem-aref response :pointer) 'c-snmp-pdu 'c-errstat)
+                       (= (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)
+                  (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)
       values)))
 
-#+lispworks
-(defmethod snmp-msg-get-list ((s snmp-session) (oids list))
-  (let ((ss (snmp-open (slot-value s 'c-session)))
-        (pdu (snmp-pdu-create +snmp-msg-get+))
-        values)
-    (fli:with-dynamic-foreign-objects ((response (:pointer netsnmp-pdu)))
-      (progn
-        ;; 1. fill oids into request pdu
-        (dolist (o oids)
-          (let ((real-o (typecase o
-                          (oid o)
-                          (string (make-instance 'oid :name o))
-                          (t (error "unknown oid type")))))
-            (snmp-add-null-var pdu
-                               (slot-value real-o 'c-oids)
-                               (fli:dereference (slot-value real-o 'c-oid-len)))))
-        ;; 2. get results from response pdu
-        (let ((status (snmp-synch-response ss pdu response)))
-          (setf values
-                (if (and (= status +snmp-stat-success+)
-                         (= (fli:foreign-slot-value (fli:dereference response) 'errstat)
-                            +snmp-err-noerror+))
-                    (loop for vars = (fli:foreign-slot-value (fli:dereference response)
-                                                             'variables)
-                          then (fli:foreign-slot-value vars 'next-variable)
-                          until (fli:null-pointer-p vars)
-                          collect (snmp-var->value vars)))))
-        (snmp-free-pdu (fli:dereference response))
-        (snmp-close ss)
-        values))))
-
 (defmethod snmp-msg-get-list ((s string) (oids list))
   (snmp-msg-get-list (make-instance 'snmp-session :peername s) oids))

Modified: trunk/load.lisp
==============================================================================
--- trunk/load.lisp	(original)
+++ trunk/load.lisp	Thu Jun  7 02:23:53 2007
@@ -1,6 +1,5 @@
 (in-package :org.net-snmp)
 
 (eval-when (:load-toplevel)
-  (init-snmp "snmpapp")
+  (c-snmp-init "snmpapp")
   (format t "Net-SNMP Initialized.~%"))
-

Modified: trunk/net-snmp.asd
==============================================================================
--- trunk/net-snmp.asd	(original)
+++ trunk/net-snmp.asd	Thu Jun  7 02:23:53 2007
@@ -1,41 +1,36 @@
 ;;;; -*- Mode: Lisp -*-
 
+(in-package :cl-user)
+
 (defpackage :net-snmp-system
   (:use :cl :asdf))
 
 (in-package :net-snmp-system)
 
-(require "foreign-parser")
-(require "sql")
-          
 (defsystem net-snmp
   :description "Common Lisp interface for Net-SNMP"
-  :version "0.5"
+  :version "0.6"
   :author "Chun Tian (binghe) <binghe.lisp at gmail.com>"
-  :depends-on (#-lispworks :cffi)
+  :depends-on (:cffi)
   :components ((:file "package")
 	       (:file "constants" :depends-on ("package"))
-	       #-lispworks (:file "typedefs" :depends-on ("constants"))
-               #+lispworks (:file "net-snmp-dff" :depends-on ("constants"))
-               #+lispworks (:file "lw-dff" :depends-on ("net-snmp-dff"))
-               #+lispworks (:file "load" :depends-on ("lw-dff"))
-               #-lispworks (:file "snmp-api" :depends-on ("constants" "typedefs"))
-	       (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "load"))
-	       (:file "classes" :depends-on ("asn1"))))
+	       (:file "typedefs" :depends-on ("constants"))
+               (:file "snmp-api" :depends-on ("typedefs"))
+               (:file "load" :depends-on ("snmp-api"))
+               (:file "asn1" :depends-on ("load"))
+	       (:file "classes" :depends-on ("asn1"))
+               (:file "advance" :depends-on ("classes"))))
 
 (defsystem sabrina
   :description "Sabrina - Update server status into database"
   :version "0.1"
   :author "Chun Tian (binghe) <binghe.lisp at gmail.com>"
   :depends-on (:net-snmp
-               :net-telent-date)
-  :components ((:file "sabrina")))
-
-(defun make-fli-dff ()
-  (foreign-parser:process-foreign-file "net-snmp.h"
-                                       :dff "net-snmp-dff.lisp"
-                                       :case-sensitive :split-name
-                                       :package :org.net-snmp))
+               :net-telent-date
+               :hunchentoot
+               :clsql-postgresql)
+  :components ((:file "sabrina")
+               (:file "zilong" :depends-on ("sabrina"))))
 
 ;; (fli:start-collecting-template-info)
 (defun make-fli-templates ()

Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp	(original)
+++ trunk/package.lisp	Thu Jun  7 02:23:53 2007
@@ -2,7 +2,7 @@
 
 (defpackage :org.net-snmp
   (:nicknames :snmp)
-  (:use :cl #-lispworks :cffi)
+  (:use :cl :cffi)
   (:export
    ;; class
    snmp-session oid
@@ -16,13 +16,8 @@
 
 (in-package :org.net-snmp)
 
-#-lispworks
 (eval-when (:compile-toplevel :load-toplevel)
   (define-foreign-library libsnmp
     (:unix "libsnmp.so")
     (t (:default "libsnmp")))
   (use-foreign-library libsnmp))
-
-#+lispworks
-(eval-when (:compile-toplevel :load-toplevel)
-  (fli:register-module "libsnmp.so"))

Modified: trunk/snmp-api.lisp
==============================================================================
--- trunk/snmp-api.lisp	(original)
+++ trunk/snmp-api.lisp	Thu Jun  7 02:23:53 2007
@@ -1,11 +1,6 @@
 (in-package :org.net-snmp)
 
-(eval-when (:compile-toplevel :load-toplevel)
-  (defcfun ("init_snmp" c-snmp-init) :void (type :string)))
-
-(eval-when (:load-toplevel :execute)
-  (progn (c-snmp-init "snmpapp")
-	 (format t "c-snmp-init called.~%")))
+(defcfun ("init_snmp" c-snmp-init) :void (type :string))
 
 ;;;
 ;;; Initializes the session structure.

Added: trunk/zilong.lisp
==============================================================================
--- (empty file)
+++ trunk/zilong.lisp	Thu Jun  7 02:23:53 2007
@@ -0,0 +1,2 @@
+(in-package :org.net-snmp.sabrina)
+



More information about the Cl-net-snmp-cvs mailing list