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@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@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))))