[snmp1-cvs] CVS snmp1

jriise jriise at common-lisp.net
Sun Feb 11 23:56:19 UTC 2007


Update of /project/snmp1/cvsroot/snmp1
In directory clnet:/tmp/cvs-serv5794

Added Files:
	mib.lisp 
Log Message:
Added file mib.lisp




--- /project/snmp1/cvsroot/snmp1/mib.lisp	2007/02/11 23:56:19	NONE
+++ /project/snmp1/cvsroot/snmp1/mib.lisp	2007/02/11 23:56:19	1.1
;; -*- mode: Lisp; coding: utf-8; -*-
(in-package :snmp1)
#|
SNMP1 - Simple Network Management Protocol for Common Lisp
Copyright (C) 2007  Johan Ur Riise

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
|#


;; You can index your own mibfiles using snmptranslate from the
;; net-snmp package.
;;
;; This is found on http://net-snmp.sourceforge.net/
;; and on debian-derived distributions
;; as package snmp.

;; johan at bread:~/prg/snmp1$ snmptranslate -V
;; NET-SNMP version: 5.2.1.2
;; johan at bread:~/prg/snmp1$ MIBS=all snmptranslate -Tp > common-mib.dat
;; johan at bread:~/prg/snmp1$


(defparameter *mib-symbolic* nil 
  "Example entry: #(1 3 6 1 2) = \".iso.org.dod.internet.mgmt\"")
(defparameter *mib-numericv* nil 
  "Example entry: \".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID\" = #(1 3 6 1 2 1 1 2)")
(defparameter *mib-full-id-from-subid* nil
  "Example entry: \"ipRouteIfIndex\" = (#(1 3 6 1 2 1 4 21 1 2))")
(defparameter *mib-type* nil
  "Example entry: #(1 3 6 1 2 1 3 1 1 3) = \"NetAddr\"")
(defparameter *mib-enums* nil
  "Example entry: #(1 3 6 1 2 1 4 21 1 8) = ((3 . \"direct\") (2 . \"invalid\") (1 . \"other\"))")
(defparameter *mib-grep-result-hash* nil
  "This is used by mib-grep-hashed. The key is the list of keys used in the call,
and the value is the result. The hashtable is used only when the exact same call is made
a second time")


;; The initial size of the hashtables are important for the speed of loading.
;; The sizes here are adjusted to load the common-mib.dat file, but if you have
;; a bigger collections of mib files to load, you should increase them.

(defun reset-hashes ()
  "Create new empty hashtables for  mib translations
Sizes are large enough to hold the contents of common-mib.dat"
  (setf *mib-symbolic* (make-hash-table :test 'equalp :size 3000))
  (setf *mib-numericv* (make-hash-table :test 'equal :size 3000))
  (setf *mib-full-id-from-subid* (make-hash-table :test 'equal :size 1500))
  (setf *mib-type* (make-hash-table :test 'equalp :size 1500))
  (setf *mib-enums* (make-hash-table :test 'equalp :size 500))
  (setf *mib-grep-result-hash* (make-hash-table :test 'equalp)))


(defun mib-grep (&rest substrings)
  "Parameters: one ore more strings.
Returns all the symbolic oid's where every input string is a substring."
  (let (result)
    (maphash (lambda (key val)
	       (declare (ignore val))
	       (let (xx) 
		 (loop for substring in substrings do
		      (when (search substring key) (push substring xx)))
		 (when (= (length substrings) (length xx))
		   (push key result))))
	     *mib-numericv*)
    result
    ))

(defun mib-grep-trailing (&rest substrings)
 "A version of mib-grep that only returns the trailing subidentifier of
the symbolic oid's that are found"
  (loop for oid in (apply #'mib-grep substrings) collect
        (loop for sub in (split-sequence:SPLIT-SEQUENCE  #\. oid) finally (return sub))))

(defun mib-grep-hashed (&rest substrings)
  "Parameters: one ore more strings.
Returns all the symbolic oid's where every input string is a substring.
The function is memoized, so it can be used in producction code.
If you make several broad greps, the hash-table would fill quickly"
  (let ((memoized-result (gethash substrings *mib-grep-result-hash*)))
    (if memoized-result
	memoized-result
	(let ((glorified-result (apply #'mib-grep substrings)))
	  (when glorified-result
	    (setf (gethash substrings *mib-grep-result-hash*) 
		  glorified-result))))))

(defun oid-from-trailing-subidentifier (symbolic-subidentifier)
  "Parameter is a string naming the last subidentifier of some oid
Returns the oid of the full identifier, a list of oid's
if it is not unique"
  (let ((result (gethash symbolic-subidentifier *mib-full-id-from-subid*)))
    (if (eql 1 (length result))
	(first result)
	result)))

(defun symbolic-oid-from-oid-full (oid)
  "Returns the oid in symbolic form. The input oid is either in string form or in vector from
Looks for smaller hits if the full oid is not found in hash"
  (let ((*print-pretty* nil)
        (oid (if (stringp oid) (oid-string-to-oid oid) oid))
        symbolic-part
        numeric-part
        )
    ;; divide the string in a consecutive smaller first part, which is translated
    ;; and a larger rest part, which is just converted to oid-string
    (loop repeat 30 for i from (length oid) above 0
         ;colle(symbolic-oid-from-oid #(1 2 3 4 5))ct (list (subseq oid 0 i) (subseq oid i))
       do
         (setf symbolic-part (gethash (subseq oid 0 i) *mib-symbolic*))
         (setf numeric-part (subseq oid i))
       until symbolic-part)
    (concatenate 'string symbolic-part (oid-to-oid-string numeric-part))))


(defun symbolic-oid-from-oid (oid)
  "Returns the oid in symbolic form. The input oid is either in string form or in vector from
Looks for smaller hits if the full oid is not found in hash
Result is minimum 2 subidentifiers, minimum 1 symbolic"
  (let ((*print-pretty* nil)
	(oid (if (stringp oid) (oid-string-to-oid oid) oid))
	symbolic-part
	numeric-part
	)
    ;; divide the string in a consecutive smaller first part, which is translated
    ;; and a larger rest part, which is just converted to oid-string
    (loop repeat 30 for i from (length oid) above 0 
	 ;colle(symbolic-oid-from-oid #(1 2 3 4 5))ct (list (subseq oid 0 i) (subseq oid i))
       do
	 (setf symbolic-part (gethash (subseq oid 0 i) *mib-symbolic*))
	 (setf numeric-part (subseq oid i))
       until symbolic-part)
    
    (let* ((symbolic-part-strings (split-sequence:split-sequence #\. symbolic-part)))
      (if (> (length symbolic-part-strings) 1)
          (let* ((last-symbolic (first (last symbolic-part-strings)))
                 (two-last-list (subseq symbolic-part-strings (- (length symbolic-part-strings) 2)))
                 (two-last (format nil "~a.~a" (first two-last-list)(second two-last-list))))
            (if (= 0 (length numeric-part))
                two-last
                (concatenate 'string 
                             last-symbolic
                             (oid-to-oid-string numeric-part))))
          (concatenate 'string 
                       symbolic-part
                       (oid-to-oid-string numeric-part))))))





(defun oid-from-symbolic-oid (symbolic-oid)
 "Takes a symbolic oid and returns it in numeric vector form"
  (gethash symbolic-oid *mib-numericv*))

(defun scalar (oid &optional (number 0))
 "Reurns a new array same as input, but a single number appended to the end."
  (let ((new-array (make-array (1+ (length oid)) :initial-element 0)))
   (loop for el across oid for i from 0 do
	(setf (aref new-array i) (aref oid i))
	(setf (aref new-array (1- (length new-array))) number))
   new-array))


;; (defun subidentifiers (oid-string)
;;   "Return subidientifiers in an array, convert to numeric if possible"
;;   (let ((pos (if (char= (aref oid-string 0) #\.) 1 0))
;; 	next-dot
;; 	(result (make-array 10 :adjustable t :fill-pointer 0))
;; 	)
;;     (loop repeat 10
;;        do
;; 	 (setf next-dot (position #\. oid-string :start pos))
;; 	 (let (subidentifier)
;; 	   (if next-dot 
;; 	       (setf subidentifier (subseq oid-string pos next-dot))
;; 	       (setf subidentifier (subseq oid-string pos)))
;; 	   (if (every #'digit-char-p subidentifier)
;; 	       (vector-push-extend (parse-integer subidentifier) result)
;; 	       (vector-push-extend subidentifier result)))
;;        while next-dot
;;        do (setf pos (1+ next-dot))
;; 	 )
;;      result))

(defun oid-symbols-to-dot-notation% (oid-symbol-array)
  "Convert an array of symbolic subidentifiers to a single string in form .1.3.5.6.7.333.233"
  (with-output-to-string (s)    
    (loop for sub-identifier across oid-symbol-array do
	 (write-char #\. s)
	 (princ sub-identifier s))))


(defun read-snmptranslate-output-Tp (file)
  "Reads a file produced by net-snmps snmptranslate and populates hashes
You might want to reset the hashes first with (reset-hashes)"
  (with-open-file (stream file)
    (let ((current-level 0)
          current-symbol
          current-numeric
          (current-symbolic-levels (make-array 100))
          (current-numeric-levels (make-array 100))
          
          )
    (loop for i from 0 
          for line = #1=(read-line stream nil nil) then #1#
          while line
          do 
          (let* ((level-string-pos (search "+--" line))
                 )
            (if level-string-pos
                ;; a node
                (let ((level (/ level-string-pos 3))
                      (leaf (char= #\  (aref line (+ level-string-pos 3))))
                      )
                  (setf current-level level)
                  (if leaf 
                      (let* ((interesting-part (subseq line (* 3 current-level)))
                             (paren-pos (position #\( interesting-part))
                             (current-type-string (subseq interesting-part
                                                          #2=9
                                                          (position #\  interesting-part :start #2#)))
                             )
                        
                        (setf current-numeric (parse-integer interesting-part :start (1+ paren-pos) :junk-allowed t))
                        (setf current-symbol (subseq interesting-part 
                                                     19
                                                     paren-pos))
                        
                        #3=(progn(setf (aref current-symbolic-levels current-level) current-symbol)
                                 (setf (aref current-numeric-levels current-level) current-numeric))
                        
                        (setf (gethash (subseq current-numeric-levels 0 (1+ current-level))
                                       *mib-type*) 
                              current-type-string)
                        ;; trailing subindentifier
                        (let* ((list #4=(gethash current-symbol *mib-full-id-from-subid*))
                               (talking-about (subseq current-numeric-levels 0 (1+ current-level))))
                          (unless (find talking-about list :test 'equalp)
                            (push talking-about list)
                            (setf #4# list))))
                      (let ((paren-pos (position #\( line)))
                        (setf current-symbol (subseq line (+ 3 (* 3 current-level)) paren-pos ))
                        (setf current-numeric (parse-integer line :start (1+ paren-pos) :junk-allowed t))
                        #3#
                        )
                      )
                  ;; leaf and other nodes
                  (let ((oid-string (oid-symbols-to-dot-notation%
                                     (subseq current-symbolic-levels 0 (1+ current-level))))
                        (oid-number-array (subseq current-numeric-levels 0 (1+ current-level)))) 
                    (setf (gethash oid-number-array
                                   *mib-symbolic*
                                   )
                          oid-string
                                    )
                    (setf (gethash oid-string
                                   *mib-numericv*
                                   )
                          oid-number-array
                        )
                    )
                  ;;(format t "~s ~s~%" 
                  ;;        (oid-to-oid-string(subseq current-numeric-levels 0 (1+ current-level)))
                  ;;        (oid-symbol-to-dot-notation (subseq current-symbolic-levels 0 (1+ current-level)))
                  ;;        )
                  )
                
                ;; descriptions of the previous node
                (let* ((startpos (* 3 current-level)))
                  (unless (> startpos (length line)) 
                    (let ((juicy (subseq line (* 3 current-level))))
                      
                      (when (eql 9 (search "Values" juicy))
                        ;;(format t "~s ~s ~%" current-symbol juicy)
                        (let ((pos 16) ; start just befor first enum
                              comma-pos
                              enum-list)
                          (loop do
                                (setf comma-pos (position #\, juicy :start pos))
                                ;;
                                while comma-pos
                                ;;
                                do
                                ;;(display pos comma-pos)
                                ;;(format t "~a~%"(subseq juicy pos comma-pos))
                                (let* ((start-enum-symbol (position-if #'alpha-char-p juicy :start pos))
                                       (end-enum-symbol (position #\( juicy :start pos))
                                       (enum-value (parse-integer juicy :start (1+ end-enum-symbol) :junk-allowed t))
                                       (enum-symbol (subseq juicy start-enum-symbol end-enum-symbol))
                                       )
                                  ;;(format t "enum-name: ~a enum-value: ~d~%" 
                                  ;;enum-symbol
                                  ;;enum-value)
                                  (push (cons enum-value enum-symbol) enum-list)
                                  )
                                
                                ;; 
                                (setf pos (1+ comma-pos)))
                          (setf (gethash (subseq current-numeric-levels 0 (1+ current-level))
                                         *mib-enums*)
                                enum-list)
                          ;;(format t "~s%~s~%" 
                          ;;        (subseq current-numeric-levels 0 (1+ current-level)) 
                          ;;        enum-list)
                          )
                        )
                      )
                    ))
                
                
                ))))))


;; This takes .6 seconds on a 64 bit 2000MHz portable when it is running at
;; full speed, but it takes 1.5 seconds if the processor starts out at 800MHz
;; power saving speed.


;; useful when the lisp can find the file in its current directory
;;(progn (reset-hashes) (read-snmptranslate-output-tp "common-mib.dat"))










More information about the Snmp1-cvs mailing list