[cl-net-snmp-cvs] r69 - in trunk: . asn.1 mib smi snmp
ctian at common-lisp.net
ctian at common-lisp.net
Wed Oct 17 06:22:07 UTC 2007
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)
More information about the Cl-net-snmp-cvs
mailing list