/[snmp1]/snmp1/snmp.lisp
ViewVC logotype

Contents of /snmp1/snmp.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (show annotations)
Fri Mar 23 21:17:19 2007 UTC (7 years, 1 month ago) by jriise
Branch: MAIN
CVS Tags: HEAD
Changes since 1.5: +11 -18 lines
Changed license from GPL to LLGPL
1 ;; -*- mode: Lisp; coding: utf-8; -*-
2
3 ;; SNMP1 - Simple Network Management Protocol for Common Lisp
4
5 ;; This software is Copyright (c) Johan Ur Riise 2007
6 ;; Johan Ur Riise grants you the rights to distribute
7 ;; and use this software as governed by the terms
8 ;; of the Lisp Lesser GNU Public License
9 ;; (http://opensource.franz.com/preamble.html),
10 ;; known as the LLGPL.
11
12 (in-package "SNMP1")
13
14 (defparameter *community* "public"
15 "The default community string used. Assign your own value to this dynamic
16 variable before you call any snmp functions")
17 (defparameter *agent-ip* #(127 0 0 1)
18 "The default ip address of the snmp agent you want to communicate with.
19 Assign your own value to this before you call any of the snmp functions.
20 The ip-address can be in any form; dotted quad, integer array or a single
21 number")
22 (defparameter *agent-port* 161
23 "The default udp port where the agent listens for incoming calls. Change this
24 if the snmp-agent you try to communicate with listens on another port. Normally
25 the agent listens on the default port")
26 (defparameter *wait* 1
27 "This is the number of seconds we wait for an snmp agent to answer before
28 we try again or give up. The time can also be specified with a float.")
29 (defparameter *retries* 3
30 "The maximum number of times we retry a communication with the agent")
31
32 (defun ip-string-to-ip-octets (dotted-quad)
33 "Conversion of ip, example 127.0.0.1 as string to #(127 0 0 1). There
34 is also a from any form to ip octets conversion function"
35 (let ((list (split-sequence:split-sequence #\. dotted-quad))
36 (vector (make-array 4)))
37 (loop for n from 0 for component in list do (setf (aref vector n) (parse-integer component)))
38 vector))
39
40 (defun ip-string-to-numeric (dotted-quad)
41 "Convert for example 80.68.86.115 as string to a single integer 1346655859. Did
42 you know that you can paste this integer directly into a web browser?"
43 (let ((octets (ip-string-to-ip-octets dotted-quad))
44 (ip-numeric 0))
45 (loop for octet across octets do
46 (setf ip-numeric (+ (* ip-numeric 256) octet)))
47 ip-numeric))
48
49 (defun ip-numeric-to-ip-octets (ip-numeric)
50 "Convert an ip address expressed as a single intger, to its
51 octet array form"
52 (apply #'vector (reverse (loop for x from 1 to 4
53 collect (ldb (byte 8 0) ip-numeric)
54 do (setf ip-numeric (truncate ip-numeric 256))))))
55
56 (defun ip-octets-to-ip-string (ip-octets)
57 "Convert an ip adress, example #(127 0 0 1) to its strign form 127.0.0.1"
58 (format nil "~{~d.~d.~d.~d~}" (loop for o across ip-octets collect o)))
59
60 (defun ip-numeric (ip-some-form)
61 "Convert an ip adress in any of the three forms to a single integer"
62 (typecase ip-some-form
63 (simple-vector (ip-string-to-numeric (ip-octets-to-ip-string ip-some-form)))
64 (string (ip-string-to-numeric ip-some-form))
65 (otherwise ip-some-form)))
66
67 (defun ip-octets (ip-some-form)
68 "Convert an ip adress in any of the three forms to an array of four integers"
69 (typecase ip-some-form
70 (integer (ip-numeric-to-ip-octets ip-some-form))
71 (string (ip-string-to-ip-octets ip-some-form))
72 (otherwise ip-some-form)))
73
74 (defun ip-string (ip-some-form)
75 "Convert an ip adress in any of the three forms to the dotted quad string form"
76 (typecase ip-some-form
77 (simple-vector (ip-octets-to-ip-string ip-some-form))
78 (integer (ip-octets-to-ip-string (ip-numeric-to-ip-octets ip-some-form)))
79 (otherwise ip-some-form)))
80
81
82 ;; (defun oid-less (a-in b-in)
83 ;; (cond ((null a-in) nil)
84 ;; ((null b-in) t)
85 ;; (t (loop for a-sub across (oid-string-to-oid a-in)
86 ;; for b-sub across (oid-string-to-oid b-in)
87 ;; when (not (= a-sub b-sub)) do (return-from oid-less (< a-sub b-sub)))))
88 ;; )
89
90
91
92 (defun pdu-from-message (decoded-message)
93 "Extract the Protocol Data Unit from a decoded message"
94 (fourth decoded-message))
95
96 (defun value-from-encoding (encoding)
97 "Extract the value from a single encoding, example (:integer 5) produces 5"
98 (second encoding))
99
100 (defun request-id (decoded-message)
101 "Extract the request identifier from a message. We can validate the integrity
102 of a response by checking that the recieved request-id is the same we used
103 in he corresponding get/set"
104 (value-from-encoding (second (pdu-from-message decoded-message))))
105
106 ;; (defun nreplace-request-id (new-value decoded-message)
107 ;; ;;(888 copied-tree)
108 ;; (let ((interesting-cons (last (second (pdu-from-message decoded-message)))))
109 ;; (rplaca interesting-cons new-value)
110 ;; decoded-message)
111 ;; )
112
113 (defun varbind-list% (decoded-pdu)
114 "Return the sequence containing all the variable bindings. Note that the input
115 here is the pdu part of the message, not the whole message"
116 (fifth decoded-pdu))
117
118 (defun varbind-list (message)
119 "Return the sequence containing all the variable bindings from a message"
120 (varbind-list% (pdu-from-message message)))
121
122 ;; (defun oid-and-value (varbind)
123 ;; (let ((oid-encoding (second varbind))
124 ;; (value-encoding (third varbind)))
125 ;; (list (value-from-encoding oid-encoding) (value-from-encoding value-encoding))))
126
127 (defun compose-varbind-list (oids)
128 "Create a varbind-list suitable for ber-encode from a list of oids
129 ignore eny null oids"
130 (let ((vars (loop for oid in (remove nil oids) collect `(:sequence (:object-identifier ,oid) (:null)))))
131 (push :sequence vars)))
132
133 (defun varbind-to-triple (varbind)
134 "Reduce a varbind sequence to a list of oid, type and value"
135 (let ((requested-oid (second (second varbind)))
136 (tag (first (third varbind)))
137 (value (second (third varbind))))
138 (list requested-oid tag value)))
139
140 (defun triples-from-decoded-message (decoded-message)
141 "Return the varbinds in a message as a list of oid, type and value triples"
142 (let ((varbind-list (varbind-list decoded-message)))
143 (loop for pair in (cdr varbind-list) collect (varbind-to-triple pair))))
144
145 ;; (defun oids-and-values-from-message (message)
146 ;; (let ((varbind-list (varbind-list message)))
147 ;; ;;(mapcar #'oid-and-value varbinds)
148 ;; (loop for pair in (cdr varbind-list) collect (oid-and-value pair) )
149 ;; ))
150
151 (defun udp-send-and-receive (host port timeout repetitions message)
152 "send one pqcket and receive one packet. Do timeouts and retries.
153 This function is specific to sbcl"
154 (handler-case
155 (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :protocol :udp :type :datagram))
156 result
157 (recvbuf (make-array 2000 :element-type '(unsigned-byte 8))))
158 (loop
159 repeat repetitions
160 do
161 (sb-bsd-sockets:socket-send socket message nil :address (list host port))
162 (setf result
163 (handler-case
164 (with-timeout timeout
165 (multiple-value-bind (buf len peer-addr)
166 (sb-bsd-sockets:socket-receive socket recvbuf 2000)
167 (declare (ignore peer-addr))
168 (subseq buf 0 len)))
169 (timeout () #|(display :hei )|# nil)))
170 until result)
171 (sb-BSD-SOCKETS:SOCKET-CLOSE socket)
172 result)
173 (sb-bsd-sockets:socket-error ())))
174
175
176 (defun snmp-get-many- (oids &optional (request-id (random 1000)))
177 "Constructs the get pdu, inserts a random request-id if none is
178 spplied, checks the request-id, decodes the answer"
179 (let* ((*agent-ip* (if (stringp *agent-ip* )(ip-string-to-ip-octets *agent-ip*) *agent-ip*))
180 (varbind-list (compose-varbind-list oids))
181 (un-encoded-message `(:sequence (:integer 0) ; version 1
182 (:octet-string ,*community*)
183 (:get (:integer ,request-id)
184 (:integer 0)
185 (:integer 0)
186 ,varbind-list)))
187
188 (response-buffer (udp-send-and-receive
189 *agent-ip*
190 *agent-port*
191 *wait*
192 *retries*
193 (ber-encode un-encoded-message)))
194 (decoded-message (ber-decode response-buffer 0 (length response-buffer))))
195 ;;(print un-encoded-message netelements::*stdout*)
196 (when (eql request-id (request-id decoded-message))
197 (triples-from-decoded-message decoded-message))))
198 (defun oid-basic-form (oid)
199 "Convert an oid in diverse symbolic forms, string or already basic form
200 to the basic form, which is an array"
201 (cond
202 ;; ".2.3.4.5.4.5"
203 ((and (stringp oid) (every #'(lambda (char) (or (digit-char-p char) (char= #\. char))) oid))
204 (oid-string-to-oid oid))
205 ;; "sysObjectID"
206 ((and (stringp oid) (not (position #\. oid)))
207 (oid-from-trailing-subidentifier oid))
208 ;; "sysObjectID.0"
209 ((and (stringp oid) (= (count #\. oid) 1))
210 (let ((point-pos (position #\. oid)))
211 (let* ((symbolic-part (subseq oid 0 point-pos))
212 (trailing-digits (subseq oid (1+ point-pos)))
213 (symbolic-part-oid (oid-from-trailing-subidentifier symbolic-part)))
214 ;; if tests dont succed, resturn nil
215 (when (and symbolic-part-oid (every #'digit-char-p trailing-digits))
216 (scalar symbolic-part-oid (parse-integer trailing-digits))))))
217 ((stringp oid)
218 (let* ((last-dot (position #\. oid :from-end t))
219 (partial-oid (subseq oid 0 last-dot))
220 (trailing-digits (subseq oid (1+ last-dot))))
221 (if (every #'digit-char-p trailing-digits)
222 ;;".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0"
223 (let ((translated-part (oid-from-symbolic-oid partial-oid)))
224 ;; return 0 if oid not found in hash
225 (when translated-part
226 (scalar translated-part (parse-integer trailing-digits))))
227 ;;".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID"
228 (oid-from-symbolic-oid oid))))
229 ;;#(1 2 3)
230 (t oid)))
231
232 (defun snmp-get- (oid)
233 "Request a single value from the agent, but do not transform the
234 result. Resultt is a triple of object identifier, type and value"
235 (let ((triple-list (snmp-get-many- (list (oid-basic-form oid)))))
236 (first triple-list)))
237
238
239
240
241
242
243
244 ;; (defun snmp-getnext (ip community oid)
245 ;; (let* ((seq (random 1000))
246 ;; (pdu `(:getnext (:integer ,seq)
247 ;; (:integer 0)
248 ;; (:integer 0)
249 ;; (:sequence
250 ;; (:sequence (:object-identifier ,oid) (:null)))))
251 ;; (req `(:sequence (:integer 0) ; version 1
252 ;; (:octet-string ,community)
253 ;; ,pdu))
254 ;; (request-buffer (ber-encode req))
255 ;; (response-buffer (udp-send-and-receive
256 ;; ip
257 ;; 161
258 ;; 1
259 ;; 3
260 ;; request-buffer)))
261 ;; ;;(display response-buffer)
262 ;; (let* ((response (ber-decode response-buffer 0 (length response-buffer)))
263 ;; (varbinds (fifth (fourth response)))
264 ;; (varbind (second varbinds)))
265 ;; ;;(display response)
266 ;; ;;(display varbinds)
267 ;; ;;(display varbind)
268 ;; (values (second varbind) (third varbind)))
269
270
271 ;; ))
272
273 ;; (defun snmp-getnext2 (ip community oid)
274 ;; (let ((response-buffer (udp-send-and-receive
275 ;; ip
276 ;; 161
277 ;; 1
278 ;; 3
279 ;; (ber-encode `(:sequence (:integer 0) ; version 1
280 ;; (:octet-string ,community)
281 ;; (:getnext (:integer 12345)
282 ;; (:integer 0)
283 ;; (:integer 0)
284 ;; (:sequence (:sequence (:object-identifier ,oid) (:null)))))))))
285 ;; (ber-decode response-buffer 0 (length response-buffer))))
286
287
288 ;; (defun snmp-walk (ip community &optional (start-oid #(0 0)) )
289 ;; (let ((next-oid start-oid)
290 ;; response-oid
291 ;; value)
292 ;; (loop
293 ;; while next-oid
294 ;; do
295 ;; (multiple-value-setq (response-oid value) (snmp-getnext ip community next-oid))
296 ;; until (equal next-oid (second response-oid))
297 ;; do
298 ;; (setf next-oid (second response-oid))
299 ;; (format t "~s ~s~%" response-oid value))))
300
301
302
303 ;; (defun triple-to-varbind (triple)
304 ;; (if (third triple)
305 ;; `(:sequence (:object-identifier ,(first triple))
306 ;; (,(second triple) ,(third triple)))
307 ;; ;; f.ex (#(1 2 3 4 5) :null nil)
308 ;; `(:sequence (:object-identifier ,(first triple))
309 ;; (,(second triple)))))
310
311
312 (defun translate-triple (triple)
313 "Translate object identifiers in the triple to its symbolic form,
314 translacte octet strings to strings, and enumerator integers to
315 symbolic form"
316 (let ((translated-oid (symbolic-oid-from-oid (first triple)))
317 (tag (second triple))
318 (value (third triple)))
319 (cond ((object-identifier-type-p tag)
320 (list translated-oid tag (symbolic-oid-from-oid value)))
321 ((octet-string-type-p tag)
322 (let ((translated-value
323 (handler-case (octets-to-string value)
324 (t () value))))
325 (list translated-oid tag translated-value)))
326 ((integer-type-p tag)
327 (let ((maybe-translated-value value)
328 (enum-alist (gethash (first triple) *mib-enums*)))
329 (unless enum-alist
330 (setf enum-alist (gethash
331 (subseq (first triple) 0 (- (length (first triple)) 1))
332 *mib-enums*)))
333 (when enum-alist
334 (setf maybe-translated-value (cdr (assoc value enum-alist))))
335 (list translated-oid tag maybe-translated-value))
336 )
337 (t (list translated-oid tag value)))))
338
339
340 (defun snmp-get-many (oid-list)
341 "Request one or more values from the agent, parmater is a list of object
342 identifiers"
343 (let ((triple-list (snmp-get-many- (mapcar #'oid-basic-form oid-list))))
344 (loop for triple in triple-list collect (translate-triple triple))))
345
346 (defun snmp-get-many-safe- (oid-list identifying-oid in-identifier)
347 "This version of snmp-get takes a list of oid's as ususal, but prepends
348 the list with the oid in the identifying-oid parameter, and thecks the
349 returned value with in-identifier parameter. The identifying oid can be
350 the serial number of the agent device. If the serial number is not as
351 expected, nil is returned. This version of the function does not translate
352 the result"
353 (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list)))))
354 (let* ((read-identifier-triple (translate-triple (first result+identifier)))
355 (result (rest result+identifier)))
356 (when (equal (third read-identifier-triple) in-identifier)
357 result))))
358
359 (defun snmp-get-many-safe (oid-list identifying-oid in-identifier)
360 "This version of snmp-get takes a list of oid's as ususal, but prepends
361 the list with the oid in the identifying-oid parameter, and thecks the
362 returned value with in-identifier parameter. The identifying oid can be
363 the serial number of the agent device. If the serial number is not as
364 expected, nil is returned"
365 (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list)))))
366 (let ((read-identifier-triple (translate-triple (first result+identifier)))
367 (result (rest result+identifier)))
368 (when (equal (third read-identifier-triple) in-identifier)
369 (mapcar #'translate-triple result)))))
370
371
372 (defun snmp-get (oid)
373 "Returns a single value from the agent
374 It is presented in its most decoded form,
375 string-form of oid, string form of octet string, and symbolic
376 value in case of enumeration
377 The parameter is an oid in array form, dotted-numeric-form, symbolic form
378 or a trailing subidentifier"
379 (let ((triple (snmp-get- oid)))
380 (translate-triple triple)))
381
382
383
384
385 ;; (defun snmp-get-% (ip community oid)
386 ;; ""
387 ;; (let ((response-buffer (udp-send-and-receive
388 ;; ip
389 ;; 161
390 ;; 1
391 ;; 3
392 ;; (ber-encode `(:sequence (:integer 0) ; version 1
393 ;; (:octet-string ,community)
394 ;; (:get (:integer 12345)
395 ;; (:integer 0)
396 ;; (:integer 0)
397 ;; (:sequence (:sequence (:object-identifier ,oid) (:null)))))))))
398 ;; (ber-decode response-buffer 0 (length response-buffer))))
399
400

  ViewVC Help
Powered by ViewVC 1.1.5