snmp1-cvs February 2007

snmp1-cvs@common-lisp.net

1 participants
3 discussions

[snmp1-cvs] CVS snmp1
by jriise 11 Feb '07

11 Feb '07

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@bread:~/prg/snmp1$ snmptranslate -V ;; NET-SNMP version: 5.2.1.2 ;; johan@bread:~/prg/snmp1$ MIBS=all snmptranslate -Tp > common-mib.dat ;; johan@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"))

1 0

[snmp1-cvs] CVS snmp1
by jriise 03 Feb '07

03 Feb '07

Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv11366 Modified Files: snmp.lisp Log Message: Arms and legs type bug fix --- /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/02/03 17:23:20 1.4 +++ /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/02/03 20:17:16 1.5 @@ -156,15 +156,15 @@ ;; )) (defun udp-send-and-receive (host port timeout repetitions message) -<<<<<<< HEAD/snmp.lisp "send one pqcket and receive one packet. Do timeouts and retries. This function is specific to sbcl" - (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :protocol :udp :type :datagram)) - result - (recvbuf (make-array 2000 :element-type '(unsigned-byte 8)))) - (loop - repeat repetitions - do + (handler-case + (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :protocol :udp :type :datagram)) + result + (recvbuf (make-array 2000 :element-type '(unsigned-byte 8)))) + (loop + repeat repetitions + do (sb-bsd-sockets:socket-send socket message nil :address (list host port)) (setf result (handler-case @@ -174,10 +174,9 @@ (declare (ignore peer-addr)) (subseq buf 0 len))) (timeout () #|(display :hei )|# nil))) - until result) + until result) (sb-BSD-SOCKETS:SOCKET-CLOSE socket) - result - ) + result) (sb-bsd-sockets:socket-error ())))

1 0

[snmp1-cvs] CVS snmp1
by jriise 03 Feb '07

03 Feb '07

Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv23880 Modified Files: ber.lisp snmp.lisp Log Message: Documentation strings. Bug in tag codes. Masked an unfrequent sockets-error --- /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/21 02:25:02 1.3 +++ /project/snmp1/cvsroot/snmp1/ber.lisp 2007/02/03 17:23:20 1.4 @@ -35,15 +35,15 @@ (let ((tag->octet (make-hash-table)) (octet->tag (make-hash-table)) (tag-list (list - (list :integer (+ (* 40 0) 2)) - (list :octet-string (+ (* 40 0) 4)) - (list :null (+ (* 40 0) 5)) - (list :object-identifier (+ (* 40 0) 6)) - (list :ipaddress (+ (* 40 1) 0)) - (list :counter (+ (* 40 1) 1)) - (list :gauge (+ (* 40 1) 2)) - (list :timeticks (+ (* 40 1) 3)) - (list :opaque (+ (* 40 1) 4)) + (list :integer 2) + (list :octet-string 4) + (list :null 5) + (list :object-identifier 6) + (list :ipaddress 64) + (list :counter 65) + (list :gauge 66) + (list :timeticks 67) + (list :opaque 68) (list :sequence #x30) (list :get #xa0) (list :getnext #xa1) --- /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/21 02:25:03 1.3 +++ /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/02/03 17:23:20 1.4 @@ -156,6 +156,7 @@ ;; )) (defun udp-send-and-receive (host port timeout repetitions message) +<<<<<<< HEAD/snmp.lisp "send one pqcket and receive one packet. Do timeouts and retries. This function is specific to sbcl" (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :protocol :udp :type :datagram)) @@ -174,9 +175,10 @@ (subseq buf 0 len))) (timeout () #|(display :hei )|# nil))) until result) - (sb-BSD-SOCKETS:SOCKET-CLOSE socket) - result - )) + (sb-BSD-SOCKETS:SOCKET-CLOSE socket) + result + ) + (sb-bsd-sockets:socket-error ()))) (defun snmp-get-many- (oids &optional (request-id (random 1000)))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

snmp1-cvs February 2007