Author: ctian Date: Wed Oct 17 02:22:06 2007 New Revision: 69 Added: trunk/smi/counter.lisp trunk/smi/gauge.lisp trunk/smi/opaque.lisp Modified: trunk/asn.1/package.lisp trunk/asn.1/syntax.lisp trunk/deliver.lisp trunk/mib/package.lisp trunk/net-snmp.asd trunk/smi/integer.lisp trunk/smi/package.lisp trunk/snmp/package.lisp Log: Add support for counter, gauge, opaque(float) type Modified: trunk/asn.1/package.lisp ============================================================================== --- trunk/asn.1/package.lisp (original) +++ trunk/asn.1/package.lisp Wed Oct 17 02:22:06 2007 @@ -32,3 +32,5 @@ Object-Identifier-Value-value)) (in-package :asn.1) + +(defparameter *version* 1) Modified: trunk/asn.1/syntax.lisp ============================================================================== --- trunk/asn.1/syntax.lisp (original) +++ trunk/asn.1/syntax.lisp Wed Oct 17 02:22:06 2007 @@ -12,9 +12,9 @@ :directory '(:relative "asn.1")) (asdf:component-pathname (asdf:find-system :net-snmp)))) -(defun generate-print-function (ITEM STREAM LEVEL) - (DECLARE (IGNORE LEVEL)) - (FORMAT STREAM "<GPF>")) +(defun generate-print-function (item stream level) + (declare (ignore item level)) + (format stream "<GPF>")) (eval-when (:load-toplevel :execute) (zebu-load-file *asn.1-syntax*)) Modified: trunk/deliver.lisp ============================================================================== --- trunk/deliver.lisp (original) +++ trunk/deliver.lisp Wed Oct 17 02:22:06 2007 @@ -10,8 +10,6 @@ (clc:clc-require :net-snmp) -(mib:build-tree) - ;; Deliver. (deliver 'mib:browser *delivered-image-name* 0 :interface :capi) Modified: trunk/mib/package.lisp ============================================================================== --- trunk/mib/package.lisp (original) +++ trunk/mib/package.lisp Wed Oct 17 02:22:06 2007 @@ -12,3 +12,5 @@ #+lispworks browser)) (in-package :mib) + +(defparameter *version* 1) Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Wed Oct 17 02:22:06 2007 @@ -36,7 +36,10 @@ (:file "timeticks" :depends-on ("package")) (:file "pdu" :depends-on ("package")) (:file "bulk-pdu" :depends-on ("pdu")) - (:file "message" :depends-on ("package"))) + (:file "message" :depends-on ("package")) + (:file "opaque" :depends-on ("integer")) + (:file "counter" :depends-on ("integer")) + (:file "gauge" :depends-on ("integer"))) :depends-on (asn.1)) ;; MIB (:module mib Added: trunk/smi/counter.lisp ============================================================================== --- (empty file) +++ trunk/smi/counter.lisp Wed Oct 17 02:22:06 2007 @@ -0,0 +1,31 @@ +(in-package :smi) + +(defclass counter (general-type) ()) + +(defclass counter32 (counter) ()) + +(defun counter (v) + (make-instance 'counter :value v)) + +(defun counter32 (v) + (make-instance 'counter32 :value v)) + +(defmethod print-object ((obj counter) stream) + (print-unreadable-object (obj stream :type t) + (format stream "~A" (value-of obj)))) + +(defmethod ber-encode ((value counter)) + (assert (<= 0 value 4294967295)) + (multiple-value-bind (v l) (ber-encode-integer value) + (nconc (ber-encode-type 1 0 1) + (ber-encode-length l) + v))) + +(defmethod ber-decode-value ((stream stream) (type (eql :counter)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (make-instance 'counter :value (ber-decode-integer-value stream length))) + +(eval-when (:load-toplevel :execute) + (install-asn.1-type :counter 1 0 1)) Added: trunk/smi/gauge.lisp ============================================================================== --- (empty file) +++ trunk/smi/gauge.lisp Wed Oct 17 02:22:06 2007 @@ -0,0 +1,32 @@ +(in-package :smi) + +(defclass gauge (general-type) ()) + +(defclass gauge32 (gauge) ()) + +(defun gauge (v) + (make-instance 'gauge :value v)) + +(defun gauge32 (v) + (make-instance 'gauge32 :value v)) + +(defmethod print-object ((obj gauge) stream) + (with-slots (value) obj + (print-unreadable-object (obj stream :type t) + (format stream "~A" value)))) + +(defmethod ber-encode ((value gauge)) + (assert (<= 0 value 4294967295)) + (multiple-value-bind (v l) (ber-encode-integer value) + (nconc (ber-encode-type 1 0 2) + (ber-encode-length l) + v))) + +(defmethod ber-decode-value ((stream stream) (type (eql :gauge)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (make-instance 'gauge :value (ber-decode-integer-value stream length))) + +(eval-when (:load-toplevel :execute) + (install-asn.1-type :gauge 1 0 2)) Modified: trunk/smi/integer.lisp ============================================================================== --- trunk/smi/integer.lisp (original) +++ trunk/smi/integer.lisp Wed Oct 17 02:22:06 2007 @@ -1,26 +1,35 @@ (in-package :smi) -(defmethod ber-encode ((value integer)) - (assert (<= 0 value)) +(defun ber-encode-integer (value) + (declare (type integer value)) (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 0 0 2) - (ber-encode-length l) - v)))) + (if (zerop value) + (values (list 0) 1) + (iter value nil 0)))) -(defmethod ber-decode-value ((stream stream) (type (eql :integer)) length) +(defmethod ber-encode ((value integer)) + (assert (<= 0 value)) + (multiple-value-bind (v l) (ber-encode-integer value) + (nconc (ber-encode-type 0 0 2) + (ber-encode-length l) + v))) + +(defun ber-decode-integer-value (stream length) (declare (type stream stream) - (type fixnum length) - (ignore type)) + (type fixnum length)) (labels ((iter (i acc) (if (= i length) acc (iter (1+ i) (logior (ash acc 8) (read-byte stream)))))) (iter 0 0))) +(defmethod ber-decode-value ((stream stream) (type (eql :integer)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (ber-decode-integer-value stream length)) + (eval-when (:load-toplevel :execute) (install-asn.1-type :integer 0 0 2)) Added: trunk/smi/opaque.lisp ============================================================================== --- (empty file) +++ trunk/smi/opaque.lisp Wed Oct 17 02:22:06 2007 @@ -0,0 +1,68 @@ +(in-package :smi) + +(defclass opaque (general-type) ()) + +(defun opaque (v) + (make-instance 'opaque :value v)) + +(defmethod print-object ((obj opaque) stream) + (with-slots (value) obj + (print-unreadable-object (obj stream :type t) + (format stream "~A: ~A" + (type-of value) value)))) + +(defgeneric opaque-length (instance)) + +(defmethod opaque-length ((o opaque)) + (opaque-length (value-of o))) + +(defmethod opaque-length ((f single-float)) + (the fixnum 7)) + +(defmethod encode-opaque ((o single-float)) + (nconc (list #x9f #x78 #x04) + (let ((f (cffi:foreign-alloc :float :initial-element o))) + (unwind-protect + (list (cffi:mem-aref f :uint8 3) + (cffi:mem-aref f :uint8 2) + (cffi:mem-aref f :uint8 1) + (cffi:mem-aref f :uint8 0)) + (cffi:foreign-free f))))) + +(defmethod ber-encode ((value opaque)) + (nconc (ber-encode-type 1 0 4) + (ber-encode-length (opaque-length value)) + (encode-opaque (value-of value)))) + +(defmethod ber-decode-value ((stream stream) (type (eql :opaque)) length) + (declare (type stream stream) + (type fixnum length) + (ignore type)) + (assert (= 7 length)) + (let ((b-1 (read-byte stream)) + (b-2 (read-byte stream)) + (b-3 (read-byte stream))) + (if (= b-3 4) + (ber-decode-value stream :float 4) + (make-instance 'opaque :value nil)))) + +(defmethod ber-decode-value ((stream stream) (type (eql :float)) length) + (let ((f-0 (read-byte stream)) + (f-1 (read-byte stream)) + (f-2 (read-byte stream)) + (f-3 (read-byte stream))) + (let ((f (cffi:foreign-alloc :float :initial-element 0.0))) + (unwind-protect + (progn + (setf (cffi:mem-aref f :uint8 3) f-0 + (cffi:mem-aref f :uint8 2) f-1 + (cffi:mem-aref f :uint8 1) f-2 + (cffi:mem-aref f :uint8 0) f-3) + (make-instance 'opaque :value (cffi:mem-ref f :float))) + (cffi:foreign-free f))))) + +(defmethod ber-encode ((value single-float)) + (ber-encode (make-instance 'opaque :value value))) + +(eval-when (:load-toplevel :execute) + (install-asn.1-type :opaque 1 0 4)) Modified: trunk/smi/package.lisp ============================================================================== --- trunk/smi/package.lisp (original) +++ trunk/smi/package.lisp Wed Oct 17 02:22:06 2007 @@ -23,6 +23,14 @@ message-data request-id ;; timeticks - timeticks ticks hours minutes seconds s/100)) + timeticks ticks hours minutes seconds s/100 + ;; other + opaque gauge counter value-of)) (in-package :smi) + +;;; used by counter, gauge and opaque +(defclass general-type () + ((value :accessor value-of :initarg :value))) + +(defparameter *version* 2) Modified: trunk/snmp/package.lisp ============================================================================== --- trunk/snmp/package.lisp (original) +++ trunk/snmp/package.lisp Wed Oct 17 02:22:06 2007 @@ -8,3 +8,5 @@ snmp-get snmp-walk)) (in-package :snmp) + +(defparameter *version* 1)