From jriise at common-lisp.net Tue Jan 2 23:49:58 2007 From: jriise at common-lisp.net (jriise) Date: Tue, 2 Jan 2007 18:49:58 -0500 (EST) Subject: [snmp1-cvs] CVS snmp1 Message-ID: <20070102234958.4ACC572083@common-lisp.net> Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv4833 Added Files: LICENSE ber.lisp display.lisp package.lisp snmp.lisp snmp1.asd tests.lisp trap-redirector.lisp with-timeout.lisp Log Message: First import of files to common-lisp.net --- /project/snmp1/cvsroot/snmp1/LICENSE 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/LICENSE 2007/01/02 23:49:58 1.1 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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 Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. --- /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/02 23:49:58 1.1 #| 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 |# (in-package "SNMP1") (defun oid-string-to-oid (oid-string) "Convert string in form .1.3.5.6.7.333.233 to oid" (let ((from 0) to (result (make-array 0 :fill-pointer 0))) (loop for x across oid-string while from do (setf to (position #\. oid-string :start (1+ from))) #|(display from to (subseq oid-string from to))|# (vector-push-extend (read-from-string (remove #\. (subseq oid-string from to))) result) (setf from to) ) result)) (defun oid-to-oid-string (oid) "Convert oid to string in form .1.3.5.6.7.333.233" (with-output-to-string (s) (loop for sub-identifier across oid do (write-char #\. s) (prin1 sub-identifier s)))) (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 :sequence #x30) (list :get #xa0) (list :getnext #xa1) (list :response #xa2) (list :set #xa3) (list :trap #xa4)))) [253 lines skipped] --- /project/snmp1/cvsroot/snmp1/display.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/display.lisp 2007/01/02 23:49:58 1.1 [305 lines skipped] --- /project/snmp1/cvsroot/snmp1/package.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/package.lisp 2007/01/02 23:49:58 1.1 [326 lines skipped] --- /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/02 23:49:58 1.1 [438 lines skipped] --- /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/02 23:49:58 1.1 [470 lines skipped] --- /project/snmp1/cvsroot/snmp1/tests.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/tests.lisp 2007/01/02 23:49:58 1.1 [708 lines skipped] --- /project/snmp1/cvsroot/snmp1/trap-redirector.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/trap-redirector.lisp 2007/01/02 23:49:58 1.1 [731 lines skipped] --- /project/snmp1/cvsroot/snmp1/with-timeout.lisp 2007/01/02 23:49:58 NONE +++ /project/snmp1/cvsroot/snmp1/with-timeout.lisp 2007/01/02 23:49:58 1.1 [760 lines skipped] From jriise at common-lisp.net Tue Jan 2 23:55:33 2007 From: jriise at common-lisp.net (jriise) Date: Tue, 2 Jan 2007 18:55:33 -0500 (EST) Subject: [snmp1-cvs] CVS snmp1 Message-ID: <20070102235533.38BA2100D@common-lisp.net> Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv5719 Modified Files: display.lisp Log Message: Added half an attribution for the dbgvht macro. --- /project/snmp1/cvsroot/snmp1/display.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/display.lisp 2007/01/02 23:55:33 1.2 @@ -39,6 +39,8 @@ ,form-coup?? (if ,was-cut-off "..." ""),result) ,result))) + +;; This is from Ro* War**** on c.l.l (defmacro dbgvht ((&optional (where "Unknown Location")) &rest forms) `(progn (format t "~&
DBGV: At ~a
~%" ',where) From jriise at common-lisp.net Wed Jan 3 01:32:05 2007 From: jriise at common-lisp.net (jriise) Date: Tue, 2 Jan 2007 20:32:05 -0500 (EST) Subject: [snmp1-cvs] CVS snmp1 Message-ID: <20070103013205.78C1283060@common-lisp.net> Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv27281 Modified Files: snmp1.asd Log Message: Added (require 'sb-bsd-sockets) for non-slime usage. --- /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/03 01:32:05 1.2 @@ -19,6 +19,7 @@ |# ;; (asdf:operate 'asdf:load-op :snmp1) +(require 'sb-bsd-sockets) (defsystem :snmp1 :name "snmp1" :author "Johan Ur Riise" From jriise at common-lisp.net Wed Jan 3 18:58:37 2007 From: jriise at common-lisp.net (jriise) Date: Wed, 3 Jan 2007 13:58:37 -0500 (EST) Subject: [snmp1-cvs] CVS snmp1 Message-ID: <20070103185837.CDF534E009@common-lisp.net> Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv31447 Modified Files: package.lisp Log Message: Exported a few symbols --- /project/snmp1/cvsroot/snmp1/package.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/package.lisp 2007/01/03 18:58:37 1.2 @@ -18,4 +18,9 @@ |# (defpackage "SNMP1" - (:use "COMMON-LISP" "SB-ALIEN" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-PROFILE")) \ No newline at end of file + (:use "COMMON-LISP" "SB-ALIEN" "SB-DEBUG" "SB-EXT" "SB-GRAY" "SB-PROFILE") + (:export "BER-ENCODE" "BER-DECODE" + "UDP-SEND-AND-RECEIVE" + "SNMPGETNEXT" + "SNMPWALK" + "SNMPGET")) From jriise at common-lisp.net Sat Jan 20 15:55:08 2007 From: jriise at common-lisp.net (jriise) Date: Sat, 20 Jan 2007 10:55:08 -0500 (EST) Subject: [snmp1-cvs] CVS snmp1 Message-ID: <20070120155508.BDEB3390AE@common-lisp.net> Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv8719 Modified Files: ber.lisp snmp.lisp snmp1.asd tests.lisp Added Files: common-mib.dat Log Message: Added dependency to split-string Added symbolic mib translations. Included mib data for the common mibs There is a change to top level interface. Some functions return the translated names. Started using triples of oid, type, value to rebresent varbinds. --- /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/20 15:55:08 1.2 @@ -19,18 +19,10 @@ (in-package "SNMP1") (defun oid-string-to-oid (oid-string) - "Convert string in form .1.3.5.6.7.333.233 to oid" - (let ((from 0) - to - (result (make-array 0 :fill-pointer 0))) - (loop for x across oid-string - while from - do - (setf to (position #\. oid-string :start (1+ from))) - #|(display from to (subseq oid-string from to))|# - (vector-push-extend (read-from-string (remove #\. (subseq oid-string from to))) result) - (setf from to) - ) + "Convert string in form .1.3.5.6.7.333.233 to oid #(1 3 5 6 7 333 233)" + (let ((result (make-array 0 :fill-pointer 0))) + (loop for subidentifier in (split-sequence:split-sequence #\. oid-string :remove-empty-subseqs t) + do (vector-push-extend (read-from-string subidentifier) result)) result)) (defun oid-to-oid-string (oid) @@ -296,12 +288,9 @@ (push (reverse container) result))) ((integer-type-p tag) (push (list tag (ber-decode-integer-value buffer start-value end-value)) result)) ((octet-string-type-p tag) - (push (list tag - ;; return octet array if impossible to convert to string - (handler-case (octets-to-string #1=(subseq buffer start-value end-value)) - (t () #1#))) result)) + (push (list tag (subseq buffer start-value end-value)) result)) ((object-identifier-type-p tag) - (push (list tag (oid-to-oid-string (ber-decode-object-identifier-value buffer start-value end-value))) result)) + (push (list tag (ber-decode-object-identifier-value buffer start-value end-value)) result)) ) (setf start end-value) while (< start input-end)) --- /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/20 15:55:08 1.2 @@ -18,6 +18,111 @@ |# (in-package "SNMP1") +(defparameter *community* "public") +(defparameter *agent-ip* #(127 0 0 1)) +(defparameter *agent-port* 161) +(defparameter *wait* 1) +(defparameter *retries* 3) + +(defun ip-string-to-ip-octets (dotted-quad) + (let ((list (split-sequence:split-sequence #\. dotted-quad)) + (vector (make-array 4))) + (loop for n from 0 for component in list do (setf (aref vector n) (parse-integer component))) + vector)) + +(defun ip-string-to-numeric (dotted-quad) + (let ((octets (ip-string-to-ip-octets dotted-quad)) + (ip-numeric 0)) + (loop for octet across octets do + (setf ip-numeric (+ (* ip-numeric 256) octet))) + ip-numeric)) + +(defun ip-numeric-to-ip-octets (ip-numeric) + (apply #'vector (reverse (loop for x from 1 to 4 + collect (ldb (byte 8 0) ip-numeric) + do (setf ip-numeric (truncate ip-numeric 256)))))) + +(defun ip-octets-to-ip-string (ip-octets) + (format nil "~{~d.~d.~d.~d~}" (loop for o across ip-octets collect o))) + +(defun ip-numeric (ip-some-form) + (typecase ip-some-form + (simple-vector (ip-string-to-numeric (ip-octets-to-ip-string ip-some-form))) + (string (ip-string-to-numeric ip-some-form)) + (otherwise ip-some-form))) + +(defun ip-octets (ip-some-form) + (typecase ip-some-form + (integer (ip-numeric-to-ip-octets ip-some-form)) + (string (ip-string-to-ip-octets ip-some-form)) + (otherwise ip-some-form))) + +(defun ip-string (ip-some-form) + (typecase ip-some-form + (simple-vector (ip-octets-to-ip-string ip-some-form)) + (integer (ip-octets-to-ip-string (ip-numeric-to-ip-octets ip-some-form))) + (otherwise ip-some-form))) + + +;; (defun oid-less (a-in b-in) +;; (cond ((null a-in) nil) +;; ((null b-in) t) +;; (t (loop for a-sub across (oid-string-to-oid a-in) +;; for b-sub across (oid-string-to-oid b-in) +;; when (not (= a-sub b-sub)) do (return-from oid-less (< a-sub b-sub))))) +;; ) + + + +(defun pdu-from-message (decoded-message) + (fourth decoded-message)) + +(defun value-from-encoding (encoding) + (second encoding)) + +(defun request-id (decoded-message) + (value-from-encoding (second (pdu-from-message decoded-message)))) + +;; (defun nreplace-request-id (new-value decoded-message) +;; ;;(888 copied-tree) +;; (let ((interesting-cons (last (second (pdu-from-message decoded-message))))) +;; (rplaca interesting-cons new-value) +;; decoded-message) +;; ) + +(defun varbind-list% (decoded-pdu) + (fifth decoded-pdu)) + +(defun varbind-list (message) + (varbind-list% (pdu-from-message message))) + +;; (defun oid-and-value (varbind) +;; (let ((oid-encoding (second varbind)) +;; (value-encoding (third varbind))) +;; (list (value-from-encoding oid-encoding) (value-from-encoding value-encoding)))) + +(defun compose-varbind-list (oids) + "Create a varbind-list suitable for ber-encode from a list of oids +ignore eny null oids" + (let ((vars (loop for oid in (remove nil oids) collect `(:sequence (:object-identifier ,oid) (:null))))) + (push :sequence vars))) + +(defun varbind-to-triple (varbind) + (let ((requested-oid (second (second varbind))) + (tag (first (third varbind))) + (value (second (third varbind)))) + (list requested-oid tag value))) + +(defun triples-from-decoded-message (decoded-message) + (let ((varbind-list (varbind-list decoded-message))) + (loop for pair in (cdr varbind-list) collect (varbind-to-triple pair)))) + +;; (defun oids-and-values-from-message (message) +;; (let ((varbind-list (varbind-list message))) +;; ;;(mapcar #'oid-and-value varbinds) +;; (loop for pair in (cdr varbind-list) collect (oid-and-value pair) ) +;; )) + (defun udp-send-and-receive (host port timeout repetitions message) "send one pqcket and receive one packet" (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :protocol :udp :type :datagram)) @@ -41,72 +146,210 @@ )) -(defun snmpgetnext (ip community oid) - (let* ((seq (random 1000)) - (pdu `(:getnext (:integer ,seq) - (:integer 0) - (:integer 0) - (:sequence - (:sequence (:object-identifier ,oid) (:null))))) - (req `(:sequence (:integer 0) ; version 1 - (:octet-string ,community) - ,pdu)) - (request-buffer (ber-encode req)) - (response-buffer (udp-send-and-receive - ip - 161 - 1 - 3 - request-buffer))) - ;;(display response-buffer) - (let* ((response (ber-decode response-buffer 0 (length response-buffer))) - (varbinds (fifth (fourth response))) - (varbind (second varbinds))) - ;;(display response) - ;;(display varbinds) - ;;(display varbind) - (values (second varbind) (third varbind))) +(defun snmp-get-many- (oids &optional (request-id (random 1000))) + "Constructs the get pdu, inserts a random request-id if none is +spplied, checks the request-id, decodes the answer" + (let* ((*agent-ip* (if (stringp *agent-ip* )(ip-string-to-ip-octets *agent-ip*) *agent-ip*)) + (varbind-list (compose-varbind-list oids)) + (un-encoded-message `(:sequence (:integer 0) ; version 1 + (:octet-string ,*community*) + (:get (:integer ,request-id) + (:integer 0) + (:integer 0) + ,varbind-list))) + + (response-buffer (udp-send-and-receive + *agent-ip* + *agent-port* + *wait* + *retries* + (ber-encode un-encoded-message))) + (decoded-message (ber-decode response-buffer 0 (length response-buffer)))) + ;;(print un-encoded-message netelements::*stdout*) + (when (eql request-id (request-id decoded-message)) + (triples-from-decoded-message decoded-message)))) +(defun oid-basic-form (oid) + "Convert an oid in diverse symbolic forms, string or already basic form +to the basic form, which is an array" + (cond + ;; ".2.3.4.5.4.5" + ((and (stringp oid) (every #'(lambda (char) (or (digit-char-p char) (char= #\. char))) oid)) + (oid-string-to-oid oid)) + ;; "sysObjectID" + ((and (stringp oid) (not (position #\. oid))) + (oid-from-trailing-subidentifier oid)) + ;; "sysObjectID.0" + ((and (stringp oid) (= (count #\. oid) 1)) + (let ((point-pos (position #\. oid))) + (let* ((symbolic-part (subseq oid 0 point-pos)) + (trailing-digits (subseq oid (1+ point-pos))) + (symbolic-part-oid (oid-from-trailing-subidentifier symbolic-part))) + ;; if tests dont succed, resturn nil + (when (and symbolic-part-oid (every #'digit-char-p trailing-digits)) + (scalar symbolic-part-oid (parse-integer trailing-digits)))))) + ((stringp oid) + (let* ((last-dot (position #\. oid :from-end t)) + (partial-oid (subseq oid 0 last-dot)) + (trailing-digits (subseq oid (1+ last-dot)))) + (if (every #'digit-char-p trailing-digits) + ;;".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0" + (let ((translated-part (oid-from-symbolic-oid partial-oid))) + ;; return 0 if oid not found in hash + (when translated-part + (scalar translated-part (parse-integer trailing-digits)))) + ;;".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID" + (oid-from-symbolic-oid oid)))) + ;;#(1 2 3) + (t oid))) + +(defun snmp-get- (oid) + (let ((triple-list (snmp-get-many- (list (oid-basic-form oid))))) + (first triple-list))) + + + + + + + +;; (defun snmp-getnext (ip community oid) +;; (let* ((seq (random 1000)) +;; (pdu `(:getnext (:integer ,seq) +;; (:integer 0) +;; (:integer 0) +;; (:sequence +;; (:sequence (:object-identifier ,oid) (:null))))) +;; (req `(:sequence (:integer 0) ; version 1 +;; (:octet-string ,community) +;; ,pdu)) +;; (request-buffer (ber-encode req)) +;; (response-buffer (udp-send-and-receive +;; ip +;; 161 +;; 1 +;; 3 +;; request-buffer))) +;; ;;(display response-buffer) +;; (let* ((response (ber-decode response-buffer 0 (length response-buffer))) +;; (varbinds (fifth (fourth response))) +;; (varbind (second varbinds))) +;; ;;(display response) +;; ;;(display varbinds) +;; ;;(display varbind) +;; (values (second varbind) (third varbind))) - )) +;; )) + +;; (defun snmp-getnext2 (ip community oid) +;; (let ((response-buffer (udp-send-and-receive +;; ip +;; 161 +;; 1 +;; 3 +;; (ber-encode `(:sequence (:integer 0) ; version 1 +;; (:octet-string ,community) +;; (:getnext (:integer 12345) +;; (:integer 0) +;; (:integer 0) +;; (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) +;; (ber-decode response-buffer 0 (length response-buffer)))) + + +;; (defun snmp-walk (ip community &optional (start-oid #(0 0)) ) +;; (let ((next-oid start-oid) +;; response-oid +;; value) +;; (loop +;; while next-oid +;; do +;; (multiple-value-setq (response-oid value) (snmp-getnext ip community next-oid)) +;; until (equal next-oid (second response-oid)) +;; do +;; (setf next-oid (second response-oid)) +;; (format t "~s ~s~%" response-oid value)))) + + + +;; (defun triple-to-varbind (triple) +;; (if (third triple) +;; `(:sequence (:object-identifier ,(first triple)) +;; (,(second triple) ,(third triple))) +;; ;; f.ex (#(1 2 3 4 5) :null nil) +;; `(:sequence (:object-identifier ,(first triple)) +;; (,(second triple))))) + + +(defun translate-triple (triple) + (let ((translated-oid (symbolic-oid-from-oid (first triple))) + (tag (second triple)) + (value (third triple))) + (cond ((object-identifier-type-p tag) + (list translated-oid tag (symbolic-oid-from-oid value))) + ((octet-string-type-p tag) + (let ((translated-value + (handler-case (octets-to-string value) + (t () value)))) + (list translated-oid tag translated-value))) + ((integer-type-p tag) + (let ((maybe-translated-value value) + (enum-alist (gethash (first triple) *mib-enums*))) + (unless enum-alist + (setf enum-alist (gethash + (subseq (first triple) 0 (- (length (first triple)) 1)) + *mib-enums*))) + (when enum-alist + (setf maybe-translated-value (cdr (assoc value enum-alist)))) + (list translated-oid tag maybe-translated-value)) + ) + (t (list translated-oid tag value))))) + + +(defun snmp-get-many (oid-list) + (let ((triple-list (snmp-get-many- (mapcar #'oid-basic-form oid-list)))) + (loop for triple in triple-list collect (translate-triple triple)))) + +(defun snmp-get-many-safe- (oid-list identifying-oid in-identifier) + (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list))))) + (let* ((read-identifier-triple (translate-triple (first result+identifier))) + (result (rest result+identifier))) + (when (equal (third read-identifier-triple) in-identifier) + result)))) + +(defun snmp-get-many-safe (oid-list identifying-oid in-identifier) + (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list))))) + (let ((read-identifier-triple (translate-triple (first result+identifier))) + (result (rest result+identifier))) + (when (equal (third read-identifier-triple) in-identifier) + (mapcar #'translate-triple result))))) + + +(defun snmp-get (oid) + "Returns a single value from the agent +It is presented in its most decoded form, +string-form of oid, string form of octet string, and symbolic +value in case of enumeration +The parameter is an oid in array form, dotted-numeric-form, symbolic form +or a trailing subidentifier" + (let ((triple (snmp-get- oid))) + (translate-triple triple))) + + + + +;; (defun snmp-get-% (ip community oid) +;; "" +;; (let ((response-buffer (udp-send-and-receive +;; ip +;; 161 +;; 1 +;; 3 +;; (ber-encode `(:sequence (:integer 0) ; version 1 +;; (:octet-string ,community) +;; (:get (:integer 12345) +;; (:integer 0) +;; (:integer 0) +;; (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) +;; (ber-decode response-buffer 0 (length response-buffer)))) -(defun snmpwalk (ip community &optional (start-oid #(0 0)) ) - (let ((next-oid start-oid) - response-oid - value) - (loop - while next-oid - do - (multiple-value-setq (response-oid value) (snmpgetnext ip community next-oid)) - until (equal next-oid (second response-oid)) - do - (setf next-oid (second response-oid)) - (format t "~s ~s~%" response-oid value)))) -(defun snmpget (ip community oid) - (let ((response-buffer (udp-send-and-receive - ip - 161 - 1 - 3 - (ber-encode `(:sequence (:integer 0) ; version 1 - (:octet-string ,community) - (:get (:integer 12345) - (:integer 0) - (:integer 0) - (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) - (ber-decode response-buffer 0 (length response-buffer)))) - -(defun snmpgetnext2 (ip community oid) - (let ((response-buffer (udp-send-and-receive - ip - 161 - 1 - 3 - (ber-encode `(:sequence (:integer 0) ; version 1 - (:octet-string ,community) - (:getnext (:integer 12345) - (:integer 0) - (:integer 0) - (:sequence (:sequence (:object-identifier ,oid) (:null))))))))) - (ber-decode response-buffer 0 (length response-buffer)))) --- /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/03 01:32:05 1.2 +++ /project/snmp1/cvsroot/snmp1/snmp1.asd 2007/01/20 15:55:08 1.3 @@ -18,6 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA |# +;; (asdf:operate 'asdf:load-op :split-sequence) ;; (asdf:operate 'asdf:load-op :snmp1) (require 'sb-bsd-sockets) (defsystem :snmp1 @@ -28,6 +29,8 @@ :components ((:file "package") (:file "display") (:file "ber") - (:file "snmp"))) + (:file "mib") + (:file "snmp")) + :depends-on ("split-sequence")) --- /project/snmp1/cvsroot/snmp1/tests.lisp 2007/01/02 23:49:58 1.1 +++ /project/snmp1/cvsroot/snmp1/tests.lisp 2007/01/20 15:55:08 1.2 @@ -19,6 +19,15 @@ (in-package "SNMP1") +(defparameter *example-decoded-response* + '(:SEQUENCE (:INTEGER 0) (:OCTET-STRING "public") + (:RESPONSE (:INTEGER 12345) (:INTEGER 0) (:INTEGER 0) + (:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))) + "Used in tests") + + (defun make-buffer () (make-array 300 :element-type '(unsigned-byte 8):fill-pointer 0)) @@ -26,10 +35,6 @@ (:method ((a vector) (b vector)) (and (= (length a) (length b)) (every #'= a b)))) -(defun beiv (xx) - (let ((buffer (make-buffer))) - (ber-encode-integer-value xx buffer))) - (defun test-01 () (format t "obs long value~%") (let ((buffer (make-buffer)) @@ -89,12 +94,6 @@ #(1 3 6 3255)))) -(defun test-10 () - (== #(1 3 5 6 7 333 233) (oid-string-to-oid ".1.3.5.6.7.333.233"))) - -(defun test-11 () - (equal ".1.3.5.6.7.333.233" (oid-to-oid-string #(1 3 5 6 7 333 233)))) - (defun test-12 () (let ((buffer #(5 0))) @@ -181,19 +180,19 @@ (display (subseq buffer 29 53)) (ber-decode buffer 0 (length buffer)))) -(defun test-snmpgetnext () - (snmpgetnext #(127 0 0 1) "public" #(0 0))) +;;(defun test-snmpgetnext () +;; (snmpgetnext #(127 0 0 1) "public" #(0 0))) -(defun test-snmpgetnext2 () - (snmpgetnext2 #(127 0 0 1) "public" #(0 0))) +;;(defun test-snmpgetnext2 () +;; (snmpgetnext2 #(127 0 0 1) "public" #(0 0))) -(defun test-snmpwalk () - (snmpwalk #(127 0 0 1) "public")) +;;(defun test-snmpwalk () +;; (snmpwalk #(127 0 0 1) "public")) -(defun test-snmpget () - (let ((r1 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.2.0")) - (r2 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.5.0"))) - (display r1 r2))) +;;(defun test-snmpget () +;; (let ((r1 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.2.0")) +;; (r2 (snmpget #(127 0 0 1) "public" ".1.3.6.1.2.1.1.5.0"))) +;; (display r1 r2))) (defun expose-bit-7 (octets) @@ -202,37 +201,169 @@ octets)) -(lambda (sym-a sym-b) - (let* ((a (symbol-name sym-a)) - (b (symbol-name sym-b)) - (numeric-a (parse-integer a :start 5 :junk-allowed t)) - (numeric-b (parse-integer b :start 5 :junk-allowed t))) - (cond ((and numeric-a numeric-b) - (< numeric-a numeric-b)) - ((and (not numeric-a) (not numeric-b)) - (string< a b)) - ((identity a) t) - (t nil) - ))) - - -(defun compute-sort-key (sym) - (let ((number (parse-integer (symbol-name sym) :start 5 :junk-allowed t))) - (format nil "~5d~a" (if number number 99999) (symbol-name sym)))) +(defun test-30-pdu-from-message () + (tree-equal (pdu-from-message *example-decoded-response*) + '(:RESPONSE (:INTEGER 12345) (:INTEGER 0) (:INTEGER 0) + (:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10")))) + :test #'equal)) + +(defun test-31-value-from-encoding () + (and (eql 9 (value-from-encoding '(:integer 9))) + (equal ".1.3.6.1.4.1.8072.3.2.10" + (value-from-encoding '(:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))) + + +(defun test-32-request-id () + (let ((copied-tree (copy-tree *example-decoded-response*)) + (expected '(:SEQUENCE (:INTEGER 0) (:OCTET-STRING "public") + (:RESPONSE (:INTEGER 888) (:INTEGER 0) (:INTEGER 0) + (:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))))) + (and (eql 12345 (request-id *example-decoded-response*)) + (tree-equal expected (nreplace-request-id 888 copied-tree) :test #'equal)))) + +(defun test-40-oid-conversions () + (and (equalp #(1 3 5 6 7 333 233) (oid-string-to-oid ".1.3.5.6.7.333.233")) + (equal ".1.3.5.6.7.333.233" (oid-to-oid-string #(1 3 5 6 7 333 233))) + (equalp #(2 3 4) (oid-basic-form ".2.3.4")) + (equalp #(2 3 4) (oid-basic-form #(2 3 4))) + (equalp #(1 3 6 1 2 1 1 2) (oid-basic-form ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID")) + (equalp #(1 3 6 1 2 1 1 2) (oid-basic-form "sysObjectID")) + (equalp #(1 3 6 1 2 1 1 2 0) (oid-basic-form ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0")) + (equalp #(1 3 6 1 2 1 1 2 0) (oid-basic-form "sysObjectID.0")) + (equal ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID" + (symbolic-oid-from-oid #(1 3 6 1 2 1 1 2))) + (equal ".iso.org.dod.internet.mgmt.mib-2.system.sysObjectID.0" + (symbolic-oid-from-oid #(1 3 6 1 2 1 1 2 0))) + (equal ".iso.org.dod.internet.mgmt.mib-2.system.77.0" + (symbolic-oid-from-oid #(1 3 6 1 2 1 1 77 0))) + (equal ".77.6.1.2.1.1.2.0" (symbolic-oid-from-oid #(2 77 6 1 2 1 1 2 0))) + (equal ".iso.2.3.4.5" (symbolic-oid-from-oid #(1 2 3 4 5))))) + + + + + + +;; (defun test-60-snmpget () +;; (and ) +;; (snmp-get ".1.3.6.1.2.1.1.2.0")) + + + +(defun test-33-varbind-list () + (let ((pdu (pdu-from-message *example-decoded-response*)) + (expected '(:SEQUENCE + (:SEQUENCE (:OBJECT-IDENTIFIER ".1.3.6.1.2.1.1.2.0") + (:OBJECT-IDENTIFIER ".1.3.6.1.4.1.8072.3.2.10"))))) + (and (tree-equal expected (varbind-list% pdu) :test #'equal) + (tree-equal expected (varbind-list *example-decoded-response*) :test #'equal)))) + + +(defun test-100-mib-grep () + (equal ".iso.org.dod.internet.mgmt.mib-2.ianaifType" + (mib-grep "ianaifType"))) + +(defun test-101-mib-grep-hashed () + (let ((expected '(".iso.org.dod.internet.mgmt.mib-2.ianaifType" + ".iso.org.dod.internet.mgmt.mib-2.interfaces.ifTable.ifEntry.ifType"))) + (and (equal expected (mib-grep-hashed "ifType")) + (equal expected (mib-grep-hashed "ifType"))))) + +(defun test-102-scalar () + (and (equalp #(1 2 3 4 5 6 0) (scalar #(1 2 3 4 5 6))) + (equalp #(1 2 3 4 5 6 77) (scalar #(1 2 3 4 5 6) 77)))) + + +(defun test-103-subidentifiers () + (and (equalp #("a" "b" "c") (subidentifiers ".a.b.c")) + (equalp #("a" "b" "c") (subidentifiers "a.b.c")) + (equalp #("a" 5 "c" 7) (subidentifiers ".a.5.c.7")) + (equalp #("a" 5 "c" 7) (subidentifiers "a.5.c.7")))) + +(defun test-104-triple () + (and + (equalp '(#(1 2 3) :integer 66) + (varbind-to-triple '(:sequence ( :object-identifier #(1 2 3)) (:integer 66)))) + (equalp '(#(3 4 5) :octet-string #(6 7 8)) + (varbind-to-triple '(:sequence (:object-identifier #(3 4 5)) (:octet-string #(6 7 8))))) + (equalp '(#(3 4 5) :null nil ) + (varbind-to-triple '(:sequence (:object-identifier #(3 4 5)) (:null)))) + (equalp '(#(3 4 5) nil nil ) + (varbind-to-triple '(:sequence (:object-identifier #(3 4 5))))) + (equalp '(:sequence (:object-identifier #(3 4 5)) (:octet-string #(6 7 8))) + (triple-to-varbind '(#(3 4 5) :octet-string #(6 7 8)))) + (equalp '(:sequence (:object-identifier #(3 4 5)) (:null)) + (triple-to-varbind '(#(3 4 5) :null nil ))))) + + +(defun test-250-snmp-get-many- () + (let ((expected '((#(1 3 6 1 2 1 1 9 1 2 2) :object-identifier #(1 3 6 1 6 3 1)) + (#(1 3 6 1 2 1 1 9 1 2 6) :object-identifier #(1 3 6 1 6 3 16 2 2 1))))) + (equalp expected + (snmp-get-many- '(#(1 3 6 1 2 1 1 9 1 2 2) + #( 1 3 6 1 2 1 1 9 1 2 6)) + 12345)))) + +(defun test-350-snmp-get- () + (and (equalp '(#(1 3 6 1 2 1 1 9 1 2 3):object-identifier #(1 3 6 1 2 1 49)) + (snmp-get- #(1 3 6 1 2 1 1 9 1 2 3))) + (equalp '(#(1 3 6 1 2 1 1 9 1 2 6) :object-identifier #(1 3 6 1 6 3 16 2 2 1)) + (snmp-get- #(1 3 6 1 2 1 1 9 1 2 6))) + )) + +(defun test-450-snmp-get () + (and (equalp '(".iso.org.dod.internet.mgmt.mib-2.system.sysORTable.sysOREntry.sysORID.2" + :OBJECT-IDENTIFIER + ".iso.org.dod.internet.snmpV2.snmpModules.snmpMIB") + (snmp-get + ".iso.org.dod.internet.mgmt.mib-2.system.sysORTable.sysOREntry.sysORID.2")) + (equalp '(".iso.org.dod.internet.mgmt.mib-2.system.sysORTable.sysOREntry.sysORID.6" + :OBJECT-IDENTIFIER + ".iso.org.dod.internet.snmpV2.snmpModules.snmpVacmMIB.vacmMIBConformance.vacmMIBGroups.vacmBasicGroup") + (snmp-get ".1.3.6.1.2.1.1.9.1.2.6")))) + +(defun test-451-get-wrong-oid () + ;; shuould not crash randomly. The oid will be nil here + (null (snmp-get "sysObjectOD.0"))) + + + +(defun compute-sort-keys (sym) + (let ((name (symbol-name sym))) + (multiple-value-bind (int eaten) (parse-integer (subseq name 5) :junk-allowed t) + (let ((alfa (subseq name (+ 5 eaten)))) + (values int alfa))))) + + + +(defun test-symbol-less (sym-a sym-b) + (multiple-value-bind (int-a alf-a) (compute-sort-keys sym-a) + (multiple-value-bind (int-b alf-b) (compute-sort-keys sym-b) + (if (eql int-a int-b) + (string< alf-a alf-b) + (< int-a int-b))))) (defun run-tests () ;; All symbols in this package beginning with test and which is a function - (let (test-funcs) + (let (test-funcs + (totres t)) (loop for s being each present-symbol do - (let ((res (search "TEST-" (symbol-name s)))) - (when (and res (= 0 res) (parse-integer (symbol-name s) :start 5 :junk-allowed t) (fboundp s)) - (push s test-funcs)))) - - (setf test-funcs (sort test-funcs #'string< - :key #'compute-sort-key)) + (let ((res (search "TEST-" (symbol-name s)))) + (when (and res (= 0 res) + (parse-integer (symbol-name s) :start 5 :junk-allowed t) + (fboundp s)) + (push s test-funcs)))) + + (setf test-funcs (sort test-funcs #'test-symbol-less)) (loop for sym in test-funcs do - (let ((res (funcall sym))) - (format t "~a: ~a~%" sym (if res "PASSED" "FAILED"))) - ) - ) -) \ No newline at end of file + (let ((res (funcall sym))) + (format t "~a: ~a~%" sym (if res "PASSED" "FAILED")) + (unless res (setf totres nil)))) + totres)) + +(define-symbol-macro tt (run-tests)) + --- /project/snmp1/cvsroot/snmp1/common-mib.dat 2007/01/20 15:55:08 NONE +++ /project/snmp1/cvsroot/snmp1/common-mib.dat 2007/01/20 15:55:08 1.1 +--iso(1) | +--org(3) | +--dod(6) | +--internet(1) | +--directory(1) | +--mgmt(2) | | | +--mib-2(1) | | | +--system(1) | | | | | +-- -R-- String sysDescr(1) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- ObjID sysObjectID(2) | | +-- -R-- TimeTicks sysUpTime(3) | | +-- -RW- String sysContact(4) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -RW- String sysName(5) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -RW- String sysLocation(6) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- INTEGER sysServices(7) | | | Range: 0..127 | | +-- -R-- TimeTicks sysORLastChange(8) | | | Textual Convention: TimeStamp | | | | | +--sysORTable(9) | | | | | +--sysOREntry(1) | | | Index: sysORIndex | | | | | +-- ---- INTEGER sysORIndex(1) | | | Range: 1..2147483647 | | +-- -R-- ObjID sysORID(2) | | +-- -R-- String sysORDescr(3) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- TimeTicks sysORUpTime(4) | | Textual Convention: TimeStamp | | | +--interfaces(2) | | | | | +-- -R-- INTEGER ifNumber(1) | | | | | +--ifTable(2) | | | | | +--ifEntry(1) | | | Index: ifIndex | | | | | +-- -R-- INTEGER ifIndex(1) | | +-- -R-- String ifDescr(2) | | | Textual Convention: DisplayString | | | Size: 0..255 | | +-- -R-- EnumVal ifType(3) | | | Values: other(1), regular1822(2), hdh1822(3), ddn-x25(4), rfc877-x25(5), ethernet-csmacd(6), iso88023-csmacd(7), iso88024-tokenBus(8), iso88025-tokenRing(9), iso88026-man(10), starLan(11), proteon-10Mbit(12), proteon-80Mbit(13), hyperchannel(14), fddi(15), lapb(16), sdlc(17), ds1(18), e1(19), basicISDN(20), primaryISDN(21), propPointToPointSerial(22), ppp(23), softwareLoopback(24), eon(25), ethernet-3Mbit(26), nsip(27), slip(28), ultra(29), ds3(30), sip(31), frame-relay(32) | | +-- -R-- INTEGER ifMtu(4) | | +-- -R-- Gauge ifSpeed(5) | | +-- -R-- String ifPhysAddress(6) | | | Textual Convention: PhysAddress | | +-- -RW- EnumVal ifAdminStatus(7) | | | Values: up(1), down(2), testing(3) | | +-- -R-- EnumVal ifOperStatus(8) | | | Values: up(1), down(2), testing(3) | | +-- -R-- TimeTicks ifLastChange(9) | | +-- -R-- Counter ifInOctets(10) | | +-- -R-- Counter ifInUcastPkts(11) | | +-- -R-- Counter ifInNUcastPkts(12) | | +-- -R-- Counter ifInDiscards(13) | | +-- -R-- Counter ifInErrors(14) | | +-- -R-- Counter ifInUnknownProtos(15) | | +-- -R-- Counter ifOutOctets(16) | | +-- -R-- Counter ifOutUcastPkts(17) | | +-- -R-- Counter ifOutNUcastPkts(18) | | +-- -R-- Counter ifOutDiscards(19) | | +-- -R-- Counter ifOutErrors(20) | | +-- -R-- Gauge ifOutQLen(21) | | +-- -R-- ObjID ifSpecific(22) | | | +--at(3) | | | | | +--atTable(1) | | | | | +--atEntry(1) | | | Index: atIfIndex, atNetAddress | | | | | +-- -RW- INTEGER atIfIndex(1) | | +-- -RW- String atPhysAddress(2) | | | Textual Convention: PhysAddress | | +-- -RW- NetAddr atNetAddress(3) | | | +--ip(4) | | | | | +-- -RW- EnumVal ipForwarding(1) | | | Values: forwarding(1), not-forwarding(2) | | +-- -RW- INTEGER ipDefaultTTL(2) | | +-- -R-- Counter ipInReceives(3) | | +-- -R-- Counter ipInHdrErrors(4) | | +-- -R-- Counter ipInAddrErrors(5) | | +-- -R-- Counter ipForwDatagrams(6) | | +-- -R-- Counter ipInUnknownProtos(7) | | +-- -R-- Counter ipInDiscards(8) | | +-- -R-- Counter ipInDelivers(9) | | +-- -R-- Counter ipOutRequests(10) | | +-- -R-- Counter ipOutDiscards(11) | | +-- -R-- Counter ipOutNoRoutes(12) | | +-- -R-- INTEGER ipReasmTimeout(13) | | +-- -R-- Counter ipReasmReqds(14) | | +-- -R-- Counter ipReasmOKs(15) | | +-- -R-- Counter ipReasmFails(16) | | +-- -R-- Counter ipFragOKs(17) | | +-- -R-- Counter ipFragFails(18) | | +-- -R-- Counter ipFragCreates(19) | | | | | +--ipAddrTable(20) | | | | | | | +--ipAddrEntry(1) | | | | Index: ipAdEntAddr | | | | | | | +-- -R-- IpAddr ipAdEntAddr(1) [4251 lines skipped] From jriise at common-lisp.net Sun Jan 21 02:25:03 2007 From: jriise at common-lisp.net (jriise) Date: Sat, 20 Jan 2007 21:25:03 -0500 (EST) Subject: [snmp1-cvs] CVS snmp1 Message-ID: <20070121022503.1D5E955367@common-lisp.net> Update of /project/snmp1/cvsroot/snmp1 In directory clnet:/tmp/cvs-serv11926 Modified Files: ber.lisp snmp.lisp Log Message: Documentations strings for all functions --- /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/20 15:55:08 1.2 +++ /project/snmp1/cvsroot/snmp1/ber.lisp 2007/01/21 02:25:02 1.3 @@ -53,22 +53,31 @@ (loop for (id value) in tag-list do (setf (gethash id tag->octet) value) (setf (gethash value octet->tag) id)) - (defun encode-tag (tag) (gethash tag tag->octet)) - (defun decode-tag (octet) (gethash octet octet->tag)) + (defun encode-tag (tag) + "Convert a symbolic tag value to an octet" + (gethash tag tag->octet)) + (defun decode-tag (octet) + "Convert a tag octest to its symbolic value" + (gethash octet octet->tag)) ) (defun container-type-p (tag) + "Returns true if the tag is one of the container tags" (member tag (list :sequence :get :getnext :response :set :trap))) (defun integer-type-p (tag) + "Returns true if the tag is one of the ineger type tags" (member tag (list :integer :counter :gauge :timeticks))) (defun octet-string-type-p (tag) + "Returns true if tag is one of the tags that encode octet strings" (member tag (list :octet-string :opaque :ipaddress))) (defun object-identifier-type-p (tag) + "Return true if the tag is :object-identitier" (member tag (list :object-identifier))) (defun null-type-p (tag) + "Returns true if the tag is :null" (member tag (list :null))) (defun decode-length (from-array pos) @@ -163,7 +172,10 @@ (defun ber-decode-object-identifier-value (buffer start end) - ;; return array of subidentifiers + "Decodes part of the octet string array and returns an array of subidentifiers +Each subidentifier can be one or more octets. Each octet that has its seventh +bit set, continues to the next octet. The first octet is special, as it +ecodes the two first subidentifiers." (let ((result (make-array 20 :adjustable t :fill-pointer 0))) ;; first and second oid are special @@ -191,7 +203,10 @@ result)) (defun ber-encode-integer-value (value to-array) - "Push value as integer" + "Push value as integer to the tail oof the array. Every bit of +each octet is used, but we must make sure that the first octet +is less than 128 for positive numbers, as the 7.th bit in the +first octet signals a negative number" (let ((numbytes (ceiling (1+ (integer-length value)) 8))) (loop for pos from (1- numbytes) downto 0 do (vector-push-extend (ldb (byte 8 (* pos 8)) value) to-array)) @@ -199,13 +214,18 @@ (defun ber-encode-octet-string-value (value to-array) - "Push value as octet-string" + "Push value as octet-string. If the value is a string, +the result mitht be longer, depending on the current external +format" (when (typep value 'string) (setf value (string-to-octets value))) (loop for octet across value do (vector-push-extend octet to-array)) to-array) (defun ber-encode-object-identifier-value (in-value to-array) - "Push value as octet-string Return to-array" + "Push value as octet-string Return to-array. The first two +subidentifers go into one octet. Most other subidentifiers go into +one octet each. If a subidentifier is greater than 127, several +octets are usec" (let ((value (if (stringp in-value) (oid-string-to-oid in-value) in-value))) ;; first and second subidentifier compressed into one octet (vector-push-extend (+ (* 40 (aref value 0)) (aref value 1)) to-array) @@ -223,14 +243,17 @@ (defun ber-encode (what &optional buffer) - ;; always one tag, but may be a container + "Encode a single tag and value, or recursively encode a sequence. +Example of input is '(:sequence (:object-identifier #(1 3 4 5 6)) (:integer 42)) +Normally, this function is called on the complete snmp message, which is such +sequence" (unless buffer (setf buffer (make-array 50 :element-type '(unsigned-byte 8) :fill-pointer 0))) (let ((tag (first what)) (encoded-tag (encode-tag (first what))) (start-pos (fill-pointer buffer))) (vector-push-extend encoded-tag buffer) ;; unfortunately we don't know length of length at this time. - ;; Guess length of length is 1, set length to 0 for now + ;; Guess length of length is 1, reserve an octet by pushing a zero to the buffer. (vector-push-extend 0 buffer) (cond ((container-type-p tag) @@ -243,9 +266,9 @@ ;; if length is 127 or less, we can place it directly in the reserved octet (if (< length-of-value 128) (setf (aref buffer (+ start-pos 1)) length-of-value) + ;; our guess was wrong, now we have to move the value some places to the right (let ((length-of-length (ceiling (1+ (integer-length length-of-value)) 8))) (setf (aref buffer (+ start-pos 1)) (logior #b10000000 (ldb (byte 8 0) length-of-length ))) - ;; now we have to move the value some places to the right (adjust-array buffer #1=(+ length-of-length (fill-pointer buffer)) :fill-pointer #1#) (loop for to-pos from (1- (fill-pointer buffer)) downto (+ start-pos length-of-length 2) @@ -260,8 +283,10 @@ buffer) (defun ber-decode (buffer &optional (input-start 0) input-end (level 0)) - ;; the buffer is a single tag, possibly a sequence containing one or more tags - ;; resurn the buffer in list form and length of buffer that is used as second value + "the buffer is an octet string vector received from the net. It normally start with +a sequence containing the rest of the message. When a sequence tag is found, the +function calls itself recursively to decode the contents. +Resurn the buffer in list form and length of buffer that is used as second value" (when (null buffer) (return-from ber-decode)) (unless input-end (setf input-end (length buffer))) (let* ((start input-start) --- /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/20 15:55:08 1.2 +++ /project/snmp1/cvsroot/snmp1/snmp.lisp 2007/01/21 02:25:03 1.3 @@ -18,19 +18,35 @@ |# (in-package "SNMP1") -(defparameter *community* "public") -(defparameter *agent-ip* #(127 0 0 1)) -(defparameter *agent-port* 161) -(defparameter *wait* 1) -(defparameter *retries* 3) +(defparameter *community* "public" + "The default community string used. Assign your own value to this dynamic +variable before you call any snmp functions") +(defparameter *agent-ip* #(127 0 0 1) + "The default ip address of the snmp agent you want to communicate with. +Assign your own value to this before you call any of the snmp functions. +The ip-address can be in any form; dotted quad, integer array or a single +number") +(defparameter *agent-port* 161 + "The default udp port where the agent listens for incoming calls. Change this +if the snmp-agent you try to communicate with listens on another port. Normally +the agent listens on the default port") +(defparameter *wait* 1 + "This is the number of seconds we wait for an snmp agent to answer before +we try again or give up. The time can also be specified with a float.") +(defparameter *retries* 3 + "The maximum number of times we retry a communication with the agent") (defun ip-string-to-ip-octets (dotted-quad) + "Conversion of ip, example 127.0.0.1 as string to #(127 0 0 1). There +is also a from any form to ip octets conversion function" (let ((list (split-sequence:split-sequence #\. dotted-quad)) (vector (make-array 4))) (loop for n from 0 for component in list do (setf (aref vector n) (parse-integer component))) vector)) (defun ip-string-to-numeric (dotted-quad) + "Convert for example 80.68.86.115 as string to a single integer 1346655859. Did +you know that you can paste this integer directly into a web browser?" (let ((octets (ip-string-to-ip-octets dotted-quad)) (ip-numeric 0)) (loop for octet across octets do @@ -38,26 +54,32 @@ ip-numeric)) (defun ip-numeric-to-ip-octets (ip-numeric) + "Convert an ip address expressed as a single intger, to its +octet array form" (apply #'vector (reverse (loop for x from 1 to 4 collect (ldb (byte 8 0) ip-numeric) do (setf ip-numeric (truncate ip-numeric 256)))))) (defun ip-octets-to-ip-string (ip-octets) + "Convert an ip adress, example #(127 0 0 1) to its strign form 127.0.0.1" (format nil "~{~d.~d.~d.~d~}" (loop for o across ip-octets collect o))) (defun ip-numeric (ip-some-form) + "Convert an ip adress in any of the three forms to a single integer" (typecase ip-some-form (simple-vector (ip-string-to-numeric (ip-octets-to-ip-string ip-some-form))) (string (ip-string-to-numeric ip-some-form)) (otherwise ip-some-form))) (defun ip-octets (ip-some-form) + "Convert an ip adress in any of the three forms to an array of four integers" (typecase ip-some-form (integer (ip-numeric-to-ip-octets ip-some-form)) (string (ip-string-to-ip-octets ip-some-form)) (otherwise ip-some-form))) (defun ip-string (ip-some-form) + "Convert an ip adress in any of the three forms to the dotted quad string form" (typecase ip-some-form (simple-vector (ip-octets-to-ip-string ip-some-form)) (integer (ip-octets-to-ip-string (ip-numeric-to-ip-octets ip-some-form))) @@ -75,12 +97,17 @@ (defun pdu-from-message (decoded-message) + "Extract the Protocol Data Unit from a decoded message" (fourth decoded-message)) (defun value-from-encoding (encoding) + "Extract the value from a single encoding, example (:integer 5) produces 5" (second encoding)) (defun request-id (decoded-message) + "Extract the request identifier from a message. We can validate the integrity +of a response by checking that the recieved request-id is the same we used +in he corresponding get/set" (value-from-encoding (second (pdu-from-message decoded-message)))) ;; (defun nreplace-request-id (new-value decoded-message) @@ -91,9 +118,12 @@ ;; ) (defun varbind-list% (decoded-pdu) + "Return the sequence containing all the variable bindings. Note that the input +here is the pdu part of the message, not the whole message" (fifth decoded-pdu)) (defun varbind-list (message) + "Return the sequence containing all the variable bindings from a message" (varbind-list% (pdu-from-message message))) ;; (defun oid-and-value (varbind) @@ -108,12 +138,14 @@ (push :sequence vars))) (defun varbind-to-triple (varbind) + "Reduce a varbind sequence to a list of oid, type and value" (let ((requested-oid (second (second varbind))) (tag (first (third varbind))) (value (second (third varbind)))) (list requested-oid tag value))) (defun triples-from-decoded-message (decoded-message) + "Return the varbinds in a message as a list of oid, type and value triples" (let ((varbind-list (varbind-list decoded-message))) (loop for pair in (cdr varbind-list) collect (varbind-to-triple pair)))) @@ -124,7 +156,8 @@ ;; )) (defun udp-send-and-receive (host port timeout repetitions message) - "send one pqcket and receive one packet" + "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)))) @@ -203,6 +236,8 @@ (t oid))) (defun snmp-get- (oid) + "Request a single value from the agent, but do not transform the +result. Resultt is a triple of object identifier, type and value" (let ((triple-list (snmp-get-many- (list (oid-basic-form oid))))) (first triple-list))) @@ -281,6 +316,9 @@ (defun translate-triple (triple) + "Translate object identifiers in the triple to its symbolic form, +translacte octet strings to strings, and enumerator integers to +symbolic form" (let ((translated-oid (symbolic-oid-from-oid (first triple))) (tag (second triple)) (value (third triple))) @@ -306,10 +344,18 @@ (defun snmp-get-many (oid-list) + "Request one or more values from the agent, parmater is a list of object +identifiers" (let ((triple-list (snmp-get-many- (mapcar #'oid-basic-form oid-list)))) (loop for triple in triple-list collect (translate-triple triple)))) (defun snmp-get-many-safe- (oid-list identifying-oid in-identifier) + "This version of snmp-get takes a list of oid's as ususal, but prepends +the list with the oid in the identifying-oid parameter, and thecks the +returned value with in-identifier parameter. The identifying oid can be +the serial number of the agent device. If the serial number is not as +expected, nil is returned. This version of the function does not translate +the result" (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list))))) (let* ((read-identifier-triple (translate-triple (first result+identifier))) (result (rest result+identifier))) @@ -317,6 +363,11 @@ result)))) (defun snmp-get-many-safe (oid-list identifying-oid in-identifier) + "This version of snmp-get takes a list of oid's as ususal, but prepends +the list with the oid in the identifying-oid parameter, and thecks the +returned value with in-identifier parameter. The identifying oid can be +the serial number of the agent device. If the serial number is not as +expected, nil is returned" (let ((result+identifier (snmp-get-many- (mapcar #'oid-basic-form (cons identifying-oid oid-list))))) (let ((read-identifier-triple (translate-triple (first result+identifier))) (result (rest result+identifier)))