[cl-net-snmp-cvs] r63 - in trunk: . asn.1 mib smi snmp
ctian at common-lisp.net
ctian at common-lisp.net
Fri Sep 28 02:46:37 UTC 2007
Author: ctian
Date: Thu Sep 27 22:46:35 2007
New Revision: 63
Added:
trunk/Makefile
trunk/deliver.lisp
trunk/smi/timeticks.lisp
trunk/snmp/snmp-get.lisp
trunk/snmp/snmp-walk.lisp
Modified:
trunk/asn.1/ber.lisp
trunk/mib/build.lisp
trunk/mib/package.lisp
trunk/mib/tree.lisp
trunk/net-snmp.asd
trunk/smi/message.lisp
trunk/smi/oid.lisp
trunk/smi/package.lisp
trunk/snmp/constants.lisp
trunk/snmp/package.lisp
trunk/snmp/session.lisp
Log:
prerelease, snmp-get can work now
Added: trunk/Makefile
==============================================================================
--- (empty file)
+++ trunk/Makefile Thu Sep 27 22:46:35 2007
@@ -0,0 +1,4 @@
+clean:
+ find . -name "*~" -exec rm {} \;
+ find . -name "*.64ufasl" -exec rm {} \;
+
Modified: trunk/asn.1/ber.lisp
==============================================================================
--- trunk/asn.1/ber.lisp (original)
+++ trunk/asn.1/ber.lisp Thu Sep 27 22:46:35 2007
@@ -108,8 +108,8 @@
(dotimes (i l-or-n)
(setf acc (logior (ash acc 8)
(read-byte stream)))
- (incf length-length)
- acc)))))
+ (incf length-length))
+ acc))))
(values res length-length)))))
(defgeneric ber-encode (value))
Added: trunk/deliver.lisp
==============================================================================
--- (empty file)
+++ trunk/deliver.lisp Thu Sep 27 22:46:35 2007
@@ -0,0 +1,17 @@
+(in-package :cl-user)
+
+(load-all-patches)
+
+;;; Where we are going to deliver the image.
+
+(defvar *delivered-image-name* "mbrowse")
+
+;;; Load the "application".
+
+(clc:clc-require :net-snmp)
+
+(mib:build-mib-tree)
+
+;; Deliver.
+
+(deliver 'mib:browser *delivered-image-name* 5 :interface :capi)
Modified: trunk/mib/build.lisp
==============================================================================
--- trunk/mib/build.lisp (original)
+++ trunk/mib/build.lisp Thu Sep 27 22:46:35 2007
@@ -109,7 +109,7 @@
(let ((oid (car i)) (name (cdr i)))
(insert-node (resolve-parent oid) (car (last oid)) name)))))
-(defun build-mib-tree ()
+(defun build-tree ()
(dolist (i *mib-list* t)
(format t "Parsing ~A" i)
(read-mib (mib-pathname i))
Modified: trunk/mib/package.lisp
==============================================================================
--- trunk/mib/package.lisp (original)
+++ trunk/mib/package.lisp Thu Sep 27 22:46:35 2007
@@ -7,7 +7,7 @@
(:export *mib-tree* *mib-index*
tree-id tree-name tree-object tree-node
insert-node resolve
- reset-mib-tree build-mib-tree
+ reset-tree build-tree
read-mib parse
#+lispworks browser))
Modified: trunk/mib/tree.lisp
==============================================================================
--- trunk/mib/tree.lisp (original)
+++ trunk/mib/tree.lisp Thu Sep 27 22:46:35 2007
@@ -79,8 +79,11 @@
r))))
(defmethod resolve ((name string))
- (reverse
- (tree-id (gethash name *mib-index*))))
+ (let ((names (cl-ppcre:split "\\." name)))
+ (cond ((gethash (first names) *mib-index*)
+ (make-instance 'object-id :id (nconc (reverse (mapcar #'parse-integer (cdr names)))
+ (tree-id (gethash (first names) *mib-index*)))))
+ (t nil))))
(defmethod print-object ((obj object-id) stream)
(with-slots (rev-ids rev-names) obj
@@ -115,7 +118,7 @@
:directory '(:relative "asn.1" "test"))
(asdf:component-pathname (asdf:find-system :net-snmp)))))
-(defun reset-mib-tree ()
+(defun reset-tree ()
(setf *mib-tree* (list (list nil nil nil)))
(setf *mib-index* (make-hash-table :test #'equal))
(insert-node *mib-tree* 0 "zero")
@@ -123,4 +126,4 @@
(values *mib-tree* *mib-index*))
(eval-when (:load-toplevel :execute)
- (reset-mib-tree))
+ (reset-tree))
Modified: trunk/net-snmp.asd
==============================================================================
--- trunk/net-snmp.asd (original)
+++ trunk/net-snmp.asd Thu Sep 27 22:46:35 2007
@@ -4,56 +4,60 @@
(defpackage com.netease.snmp.system
(:nicknames snmp.system)
- (:use :common-lisp :asdf))
+ (:use :common-lisp :asdf)
+ (:export #+lispworks make-fli-templates))
(in-package :snmp.system)
(defsystem net-snmp
:description "Simple Network Manangement Protocol"
- :version "0.8"
+ :version "1.0"
:author "Chun Tian (binghe) <binghe.lisp at gmail.com>"
:depends-on (:cl-fad ; for directory and file
:cl-ppcre ; for oid resolve
:ironclad ; for v3 support
:net-telent-date ; for time convert
- #-(and lispworks win32) :iolib
+ #-win32 :iolib ; for networking
:zebu) ; for mib parse
:components (;; ASN.1
(:module asn.1
:components ((:file "package")
- (:file "syntax" :depends-on ("package"))
- (:file "ber" :depends-on ("package"))))
+ (:file "syntax" :depends-on ("package"))
+ (:file "ber" :depends-on ("package"))))
;; SMI
(:module smi
:components ((:file "package")
- (:file "null" :depends-on ("package"))
- (:file "integer" :depends-on ("package"))
- (:file "string" :depends-on ("package"))
- (:file "sequence" :depends-on ("package"))
- (:file "ipaddr" :depends-on ("package"))
- (:file "oid" :depends-on ("package"))
- (:file "pdu" :depends-on ("package"))
- (:file "bulk-pdu" :depends-on ("pdu"))
- (:file "message" :depends-on ("package")))
+ (:file "null" :depends-on ("package"))
+ (:file "integer" :depends-on ("package"))
+ (:file "string" :depends-on ("package"))
+ (:file "sequence" :depends-on ("package"))
+ (:file "ipaddr" :depends-on ("package"))
+ (:file "oid" :depends-on ("package"))
+ (:file "timeticks" :depends-on ("package"))
+ (:file "pdu" :depends-on ("package"))
+ (:file "bulk-pdu" :depends-on ("pdu"))
+ (:file "message" :depends-on ("package")))
:depends-on (asn.1))
;; MIB
(:module mib
:components ((:file "package")
- (:file "tree" :depends-on ("package"))
- (:file "build" :depends-on ("tree"))
+ (:file "tree" :depends-on ("package"))
+ (:file "build" :depends-on ("tree"))
#+lispworks
- (:file "browser" :depends-on ("tree")))
+ (:file "browser" :depends-on ("tree")))
:depends-on (smi))
;; SNMP
(:module snmp
:components ((:file "package")
(:file "constants" :depends-on ("package"))
- (:file "session" :depends-on ("constants")))
+ (:file "session" :depends-on ("constants"))
+ (:file "snmp-get" :depends-on ("session"))
+ (:file "snmp-walk" :depends-on ("session")))
:depends-on (asn.1 smi mib))))
(defsystem net-snmp-devel
:description "SNMP Develop"
- :version "0.1"
+ :version "1.0"
:author "Chun Tian (binghe) <binghe.lisp at gmail.com>"
:depends-on (:net-snmp
:zebu-compiler) ; for asn.1 syntax compile
@@ -62,6 +66,7 @@
:components ((:file "devel")))))
;; (fli:start-collecting-template-info)
-;;(defun make-fli-templates ()
-;; (with-open-file (stream "fli-templates.lisp" :direction :output)
-;; (fli:print-collected-template-info :output-stream stream)))
+#+lispworks
+(defun make-fli-templates ()
+ (with-open-file (stream "fli-templates.lisp" :direction :output)
+ (fli:print-collected-template-info :output-stream stream)))
Modified: trunk/smi/message.lisp
==============================================================================
--- trunk/smi/message.lisp (original)
+++ trunk/smi/message.lisp Thu Sep 27 22:46:35 2007
@@ -3,12 +3,12 @@
(defclass message ()
((version :type integer
:initarg :version
- :reader version)
+ :reader message-version)
(community :type string
:initarg :community
- :reader comminity)
+ :reader message-comminity)
(data :initarg :data
- :reader data)))
+ :reader message-data)))
(defmethod ber-encode ((value message))
(with-slots (version community data) value
Modified: trunk/smi/oid.lisp
==============================================================================
--- trunk/smi/oid.lisp (original)
+++ trunk/smi/oid.lisp Thu Sep 27 22:46:35 2007
@@ -5,7 +5,7 @@
(in-package :smi)
(defclass object-id ()
- ((rev-ids :initform nil :type list :initarg :id)
+ ((rev-ids :initform nil :type list :reader oid-revid :initarg :id)
(rev-names :initform nil :type list :reader oid-name :initarg :name)
(length :initform 0 :type integer :reader oid-length)))
@@ -13,9 +13,10 @@
(declare (type object-id oid))
(reverse (slot-value 'rev-ids oid)))
-(defmethod shared-initialize :after ((obj object-id) slot-names &rest initargs)
- (declare (ignore slot-names initargs))
- (with-slots (rev-ids length) obj
+(defmethod initialize-instance :after ((instance object-id)
+ &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
+ (with-slots (rev-ids length) instance
(setf length (list-length rev-ids))))
(defmethod make-object-id (ids)
@@ -80,3 +81,12 @@
(eval-when (:load-toplevel :execute)
(install-asn.1-type :object-identifier 0 0 6))
+
+(defun oid-< (oid-1 oid-2)
+ "test if oid-1 is oid-2's child"
+ (let ((o-1 (oid-revid oid-1))
+ (o-2 (oid-revid oid-2))
+ (o-1-len (oid-length oid-1))
+ (o-2-len (oid-length oid-2)))
+ (if (<= o-1-len o-2-len) nil
+ (equal o-2 (nthcdr (- o-1-len o-2-len) o-1)))))
Modified: trunk/smi/package.lisp
==============================================================================
--- trunk/smi/package.lisp (original)
+++ trunk/smi/package.lisp Thu Sep 27 22:46:35 2007
@@ -3,7 +3,10 @@
(defpackage com.netease.smi
(:nicknames smi)
(:use :common-lisp :asn.1 #-(and lispworks win32) :net.sockets)
- (:export object-id oid make-object-id rev-ids rev-names
+ (:export ;; object-id
+ object-id oid make-object-id rev-ids rev-names
+ oid-<
+ ;; pdu
get-request-pdu
get-next-request-pdu
response-pdu
@@ -11,8 +14,15 @@
inform-request-pdu
snmpv2-trap-pdu
report-pdu
+ error-status
+ error-index
+ ;; message
message
- decode-message))
+ decode-message
+ variable-bindings
+ message-data
+ request-id
+ ;; timeticks
+ timeticks ticks hours minutes seconds s/100))
(in-package :smi)
-
Added: trunk/smi/timeticks.lisp
==============================================================================
--- (empty file)
+++ trunk/smi/timeticks.lisp Thu Sep 27 22:46:35 2007
@@ -0,0 +1,51 @@
+(in-package :smi)
+
+(defclass timeticks ()
+ ((ticks :type fixnum :initarg :ticks :initform 0 :reader ticks)
+ (hours :type fixnum)
+ (minutes :type fixnum)
+ (seconds :type fixnum)
+ (seconds/100 :type fixnum)))
+
+(defmethod print-object ((obj timeticks) stream)
+ (with-slots (ticks hours minutes seconds seconds/100) obj
+ (print-unreadable-object (obj stream :type t)
+ (format stream "(~D) ~D:~2,'0D:~2,'0D.~2,'0D"
+ ticks hours minutes seconds seconds/100))))
+
+(defmethod initialize-instance :after ((instance timeticks)
+ &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
+ (with-slots (ticks hours minutes seconds seconds/100) instance
+ (multiple-value-bind (s s/100) (floor ticks 100)
+ (setf seconds/100 s/100)
+ (multiple-value-bind (h s) (floor s 3600) ; hours
+ (setf hours h)
+ (multiple-value-bind (m s) (floor s 60) ; minutes
+ (setf minutes m
+ seconds s))))))
+
+(defmethod ber-encode ((tvalue timeticks))
+ (let ((value (ticks tvalue)))
+ (labels ((iter (n acc l)
+ (if (zerop n) (values acc l)
+ (multiple-value-bind (q r) (floor n 256)
+ (iter q (cons r acc) (1+ l))))))
+ (multiple-value-bind (v l) (if (zerop value)
+ (values (list 0) 1)
+ (iter value nil 0))
+ (nconc (ber-encode-type 1 0 3)
+ (ber-encode-length l)
+ v)))))
+
+(defmethod ber-decode-value ((stream stream) (type (eql :timeticks)) length)
+ (declare (type stream stream)
+ (type fixnum length)
+ (ignore type))
+ (labels ((iter (i acc)
+ (if (= i length) acc
+ (iter (1+ i) (logior (ash acc 8) (read-byte stream))))))
+ (make-instance 'timeticks :ticks (iter 0 0))))
+
+(eval-when (:load-toplevel :execute)
+ (install-asn.1-type :timeticks 1 0 3))
Modified: trunk/snmp/constants.lisp
==============================================================================
--- trunk/snmp/constants.lisp (original)
+++ trunk/snmp/constants.lisp Thu Sep 27 22:46:35 2007
@@ -40,18 +40,18 @@
(defconstant +asn-double+ (logior +asn-application+ 9))
;;; from snmp.h
-(defconstant +snmp-version-1+ 0)
+(defconstant +snmp-version-1+ 0)
(defconstant +snmp-version-2c+ 1)
-(defconstant +snmp-version-3+ 3)
+(defconstant +snmp-version-3+ 3)
(defconstant +snmp-sec-model-any+ 0)
(defconstant +snmp-sec-model-snmpv1+ 1)
(defconstant +snmp-sec-model-snmpv2c+ 2)
(defconstant +snmp-sec-model-usm+ 3)
-(defconstant +snmp-sec-level-noauth+ 1)
+(defconstant +snmp-sec-level-noauth+ 1)
(defconstant +snmp-sec-level-authnopriv+ 2)
-(defconstant +snmp-sec-level-authpriv+ 3)
+(defconstant +snmp-sec-level-authpriv+ 3)
;; PDU types in SNMPv1, SNMPsec, SNMPv2p, SNMPv2c, SNMPv2u, SNMPv2*, and SNMPv3
(defconstant +snmp-msg-get+
Modified: trunk/snmp/package.lisp
==============================================================================
--- trunk/snmp/package.lisp (original)
+++ trunk/snmp/package.lisp Thu Sep 27 22:46:35 2007
@@ -2,7 +2,8 @@
(defpackage :com.netease.snmp
(:nicknames snmp)
- (:use :common-lisp)
- (:export v1-session v2c-session v3-session))
+ (:use :common-lisp :smi :asn.1 :mib #-win32 :net.sockets #-win32 :io.streams)
+ (:export v1-session v2c-session v3-session
+ snmp-get snmp-walk))
(in-package :snmp)
Modified: trunk/snmp/session.lisp
==============================================================================
--- trunk/snmp/session.lisp (original)
+++ trunk/snmp/session.lisp Thu Sep 27 22:46:35 2007
@@ -1,21 +1,41 @@
(in-package :snmp)
+#-win32
(defclass session ()
- ((peername :reader peername
- :initarg :peername
- :type string)
+ ((socket :reader socket
+ :initarg :socket
+ :type socket)
(version :reader version
:initarg :version
:type integer
- :initform +snmp-version-2c+)))
+ :initform +snmp-version-1+)))
+
+#+win32
+(defclass session ()
+ ((version :reader version
+ :initarg :version
+ :type integer
+ :initform +snmp-version-1+)))
(defclass v1-session (session)
((community :reader community
:initarg :community
:type string
- :initform "public")))
+ :initform "public"))
+ (:documentation "SNMP v1 session, community based"))
-(defclass v2c-session (v1-session) ())
+(defmethod initialize-instance :after ((instance v1-session)
+ &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
+ (setf (slot-value instance 'version) +snmp-version-1+))
+
+(defclass v2c-session (v1-session) ()
+ (:documentation "SNMP v2c session, community based"))
+
+(defmethod initialize-instance :after ((instance v2c-session)
+ &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
+ (setf (slot-value instance 'version) +snmp-version-2c+))
(defclass v3-session (session)
((security-name :reader security-name
@@ -30,4 +50,10 @@
:type (member :hmac-md5 :hmac-sha1)
:initform :hmac-md5)
(passphrase :initarg :passphrase
- :type string)))
+ :type string))
+ (:documentation "SNMP v3 session, user security model"))
+
+(defmethod initialize-instance :after ((instance v3-session)
+ &rest initargs &key &allow-other-keys)
+ (declare (ignore initargs))
+ (setf (slot-value instance 'version) +snmp-version-3+))
Added: trunk/snmp/snmp-get.lisp
==============================================================================
--- (empty file)
+++ trunk/snmp/snmp-get.lisp Thu Sep 27 22:46:35 2007
@@ -0,0 +1,38 @@
+(in-package :snmp)
+
+(defgeneric snmp-get (object &rest vars)
+ (:documentation "SNMP Get"))
+
+(defmethod snmp-get ((host string) &rest vars)
+ (let ((socket (make-socket :remote-host host
+ :remote-port 161
+ :type :datagram
+ :ipv6 nil)))
+ (let ((session (make-instance 'v2c-session
+ :socket socket
+ :community "public")))
+ (values (apply #'snmp-get session vars)
+ session))))
+
+#-win32
+(defmethod snmp-get ((session v1-session) &rest vars)
+ (let ((vb (mapcar #'(lambda (x) (list (etypecase x
+ (object-id x)
+ (string (resolve x))) nil)) vars)))
+ (let ((message (make-instance 'message
+ :version (version session)
+ :community (community session)
+ :data (make-instance 'get-request-pdu
+ :request-id 0
+ :variable-bindings vb))))
+ (let ((data (ber-encode message)))
+ (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))))
+ (mapcar #'second
+ (variable-bindings
+ (message-data message))))))))
Added: trunk/snmp/snmp-walk.lisp
==============================================================================
--- (empty file)
+++ trunk/snmp/snmp-walk.lisp Thu Sep 27 22:46:35 2007
@@ -0,0 +1,64 @@
+(in-package :snmp)
+
+(defgeneric snmp-walk (object var)
+ (:documentation "SNMP Walk"))
+
+#-win32
+(defmethod snmp-walk ((host string) var)
+ (let ((socket (make-socket :remote-host host
+ :remote-port 161
+ :type :datagram
+ :ipv6 nil)))
+ (let ((session (make-instance 'v1-session
+ :socket socket
+ :community "public")))
+ (values (snmp-walk session var) session))))
+
+#-win32
+(defmethod snmp-walk ((session v1-session) (var object-id))
+ (labels ((iter (acc)
+ (let ((message (make-instance 'message
+ :version (version session)
+ :community (community session)
+ :data (make-instance 'get-next-request-pdu
+ :request-id 0
+ :variable-bindings (list (list var nil))))))
+ (let ((data (ber-encode message)))
+ (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))))
+ (if (= (error-status (message-data result)) +snmp-err-nosuchname+)
+ (nreverse acc)
+ (iter (cons (car (variable-bindings (message-data result))) acc))))))))
+ (iter nil)))
+
+#-win32
+(defmethod snmp-walk ((session v2c-session) (var object-id))
+ (labels ((iter (acc)
+ (let ((message (make-instance 'message
+ :version (version session)
+ :community (community session)
+ :data (make-instance 'get-next-request-pdu
+ :request-id 0
+ :variable-bindings (list (list var nil))))))
+ (let ((data (ber-encode message)))
+ (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))))
+ (let ((vb (car (variable-bindings (message-data result)))))
+ (if (null (second vb))
+ (nreverse acc)
+ (iter (cons vb acc)))))))))
+ (iter nil)))
+
+(defmethod snmp-walk ((session v1-session) (var string))
+ (let ((oid (resolve var)))
+ (when oid (snmp-walk session oid))))
More information about the Cl-net-snmp-cvs
mailing list