Commit 33aaac7a authored by Simon Leinen's avatar Simon Leinen
Browse files

Initial commit

parents
CVS/
*~
*.o
This diff is collapsed.
default: dist
pkg = sysman
PACKAGE = lisp-snmp
RM = rm -f
CC = gcc
LD = ld
LDSHAREDFLAGS = -shared
CSHAREDFLAGS = -fpic
CDEBUGFLAGS = -O -g -W
CFLAGS = $(CDEBUGFLAGS) $(CSHAREDFLAGS)
ETAGS = etags
.SUFFIXES: .so
LISP_SOURCES = \
defsys.lisp \
asn1/package.lisp snmp/package.lisp \
asn1/defs.lisp dependent.lisp \
ber/defs.lisp ber/decode.lisp ber/encode.lisp \
low/ip.lisp low/udp.lisp \
mib/defs.lisp mib/read.lisp mib/oid-reader.lisp \
agent/generic/mib-instr.lisp \
agent/generic/main.lisp agent/generic/mib-2.lisp \
snmp/low.lisp snmp/pdu.lisp \
snmp/session.lisp snmp/errors.lisp snmp/api.lisp \
snmp/v2p/party.lisp snmp/v2p/context.lisp snmp/v2p/errors.lisp \
snmp/v2p/api.lisp \
mib-2.lisp snmp/netstat.lisp \
agent/lispm/lispm-agent.lisp agent/lispm/lispm-agent-mib-2.lisp \
agent/sgi/sgi-agent.lisp \
test.lisp
### rfc1514.lisp
ALL_SRCS = Makefile $(LISP_SOURCES) objects.defs doc/sysman.texi
DISTRIBUTABLES = README \
$(LISP_SOURCES) objects.defs \
doc/sysman.texi doc/sysman.ps
dist: $(DISTRIBUTABLES)
-$(RM) ,foo
tar cf - $(DISTRIBUTABLES) | gzip > ,foo \
&& mv ,foo $(PACKAGE).tar.gz \
&& ls -l $(PACKAGE).tar.gz
targz: ../$(pkg).tar.gz
../$(pkg).tar.gz: $(ALL_SRCS) RCS/*
( cd .. && tar cf - $(patsubst %,$(pkg)/%,$(ALL_SRCS)) $(pkg)/RCS ) | gzip > ../$(pkg).tar.gz
.o.so:
$(LD) $(LDSHAREDFLAGS) -o $@ $<
tags: TAGS
TAGS: $(LISP_SOURCES)
$(ETAGS) $(LISP_SOURCES)
doc:; cd doc && $(MAKE) $(MFLAGS);
doc/sysman.ps: doc/sysman.texi; cd doc && $(MAKE) $(MFLAGS) sysman.ps
clean:
$(RM) *.bin *.ibin *.sparcf *.sgif *.fasl *.mfasl *.o *.so
$(RM) *~
$(RM) TAGS
Lisp-SNMP -*- text -*-
---------
Author: Simon Leinen <simon@switch.ch>
The code in this directory implements the SNMP (version 1) protocol in
Common Lisp. It provides the following functionality:
* Encoding and decoding a subset of ASN.1 using BER (Basic Encoding
Rules). The supported subset is sufficient for SNMPv1.
* Sending SNMP requests (GET, SET or GET-NEXT) to a remote host via
UDP, and decoding the responses.
* Symbolics Lisp Machine only: supports a large subset of MIB-2 as an
agent. Only read access is currently supported.
* NEW: Interoperability with the Silicon Graphics IRIX 5.3 scheme of
remote sub agents. You can write a subagent in Lisp that handles a
MIB subtree. The IRIX SNMP agent will forward requests for this
subtree to your code, and will forward your response to the original
requestor. You can have multiple such subagents running in the same
Lisp image.
The code has been tested under CMU Common Lisp 17f and Allegro Common
Lisp (4.2, 4.3, and 5.0) on Silicon Graphics and Sun workstations.
It used to run on Symbolics Lisp Machines running Genera 8.2 as well,
but it's been a long time since I tested that, so I may have broken
something in the meantime.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File Name: sysman:src;agent;generic;errors.lisp
;;; Description: Condition definitions for SNMP agents
;;; Author: Simon Leinen <simon@switch.ch>
;;; Date Created: 28-Mar-1999
;;; RCS $Header: /home/leinen/CVS/lisp-snmp/agent/generic/errors.lisp,v 1.6 2002/08/11 21:50:28 leinen Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :snmp)
(define-condition snmp-agent-error (snmp-error)
())
(define-condition snmp-agent-request-error (snmp-agent-error)
((request :initarg :request
:reader snmp-agent-request-error-request)))
(define-condition snmp-request-bad-community-error (snmp-agent-request-error)
((community :initarg :community
:reader snmp-error-community))
(:report (lambda (c stream)
(format stream "Bad community ~S"
(snmp-error-community c)))))
(define-condition snmp-bad-version-error (snmp-agent-request-error)
((requested-version :initarg :requested-version
:reader snmp-error-requested-version))
(:report (lambda (c stream)
(format stream "Requested version ~D not supported"
(snmp-error-requested-version c)))))
(define-condition snmp-agent-unrecognized-pdu-type-error (snmp-agent-request-error)
((pdu-type :initarg :pdu-type
:reader snmp-error-pdu-type))
(:report (lambda (c stream)
(format stream "PDU type ~D not recognized"
(snmp-error-pdu-type c)))))
(define-condition snmp-malformed-pdu-error (snmp-agent-request-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Malformed PDU"))))
(define-condition snmpv1-malformed-pdu-error (snmp-agent-request-error)
()
(:report (lambda (c stream)
(declare (ignore c))
(format stream "Malformed SNMPv1 PDU"))))
(define-condition snmp-get-bulk-illegal-max-repetitions (snmp-agent-request-error)
((max-repetitions :initarg :max-repetitions
:reader snmp-error-max-repetitions))
(:report (lambda (c stream)
(let ((max-repetitions (snmp-error-max-repetitions c)))
(format stream "Illegal value ~D for max-repetitions:~%~
should never be less than zero"
max-repetitions)))))
(define-condition snmp-get-bulk-illegal-non-repeaters (snmp-agent-request-error)
((non-repeaters :initarg :non-repeaters :reader snmp-error-non-repeaters))
(:report (lambda (c stream)
(let ((non-repeaters (snmp-error-non-repeaters c)))
(format stream "Illegal value ~D for non-repeaters:~%"
non-repeaters)
(cond ((< non-repeaters 0)
(format stream "non-repeaters should never be less than zero"))
(t (format stream "non-repeaters greater than number of bindings")))))))
(define-condition snmp-agent-specific-variable-error (snmp-agent-request-error)
((variable-index :initarg :index
:type integer
:reader snmp-agent-specific-variable-error-variable-index)))
(define-condition snmp-agent-no-such-name-error
(snmp-agent-specific-variable-error)
()
(:report (lambda (c stream)
(format stream "No such name for binding ~D (~D)"
(snmp-agent-specific-variable-error-variable-index c)
(pdu-request-id
(snmp-agent-request-error-request c))))))
(defmethod snmp-agent-specific-variable-error-error-status
((c snmp-agent-no-such-name-error))
error-status-no-such-name)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File Name: agent.lisp
;;; Description: SNMP Agent
;;; Author: Simon Leinen (simon@liasun1)
;;; Date Created: 30-May-92
;;; RCS $Header: /home/leinen/CVS/lisp-snmp/agent/generic/main.lisp,v 1.34 2003/12/29 10:12:34 leinen Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This used to only work under Genera, but after six and a half
;;; years I generalized it so that it works under Allegro at least.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :snmp)
(defstruct (snmp-agent-state
#-Genera
(:include udp-session)
(:predicate nil)
(:copier nil)
(:conc-name sas-))
(start-up-time
(get-internal-real-time))
(in-pkts 0 :type (unsigned-byte 32))
(out-pkts 0 :type (unsigned-byte 32))
(in-bad-versions 0 :type (unsigned-byte 32))
(in-bad-community-names 0 :type (unsigned-byte 32))
(in-bad-community-uses 0 :type (unsigned-byte 32))
(in-asn-parse-errs 0 :type (unsigned-byte 32))
(in-too-bigs 0 :type (unsigned-byte 32))
(in-no-such-names 0 :type (unsigned-byte 32))
(in-bad-values 0 :type (unsigned-byte 32))
(in-read-onlys 0 :type (unsigned-byte 32))
(in-gen-errs 0 :type (unsigned-byte 32))
(in-total-req-vars 0 :type (unsigned-byte 32))
(in-total-set-vars 0 :type (unsigned-byte 32))
(in-get-requests 0 :type (unsigned-byte 32))
(in-get-nexts 0 :type (unsigned-byte 32))
(in-set-requests 0 :type (unsigned-byte 32))
(in-get-responses 0 :type (unsigned-byte 32))
(in-traps 0 :type (unsigned-byte 32))
(out-too-bigs 0 :type (unsigned-byte 32))
(out-no-such-names 0 :type (unsigned-byte 32))
(out-bad-values 0 :type (unsigned-byte 32))
(out-gen-errs 0 :type (unsigned-byte 32))
(out-get-requests 0 :type (unsigned-byte 32))
(out-get-nexts 0 :type (unsigned-byte 32))
(out-set-requests 0 :type (unsigned-byte 32))
(out-get-responses 0 :type (unsigned-byte 32))
(out-traps 0 :type (unsigned-byte 32))
(enable-authen-traps nil :type t))
(defstruct (snmpxc-agent-state
(:include snmp-agent-state)
(:copier nil)
(:predicate nil))
(community-table))
(defstruct (snmpv1/2c-agent-state
(:include snmpxc-agent-state)
(:copier nil)
(:predicate nil))
(in-get-bulks 0 :type (unsigned-byte 32)))
(defvar *the-snmp-agent*)
(defun close-snmp-agent (agent)
(close-udp-session agent))
#+Genera
(setq *the-snmp-agent* (make-snmp-agent-state))
#+Genera
(net:define-server :snmp (:medium :datagram
:request-array (request start end))
(let ((agent *the-snmp-agent*)
(neti:*server-debug-flag* t))
(multiple-value-bind (return-p response)
(agent-process-incoming-packet
*the-snmp-agent* request start end)
(when return-p
(send-response agent response)))))
(defun run-agent (&rest agent-args &key
(port default-snmp-udp-port)
(backgroundp t)
&allow-other-keys)
(setq agent-args (remprop :port agent-args))
(setq agent-args (remprop :backgroundp agent-args))
(let ((agent (apply #'make-snmpv1/2c-agent-state
:local-port port
agent-args)))
(initialize-udp-session agent)
(setq *the-snmp-agent* agent)
(if backgroundp
(progn
#+allegro
(mp:process-run-function
"SNMP Agent"
#'(lambda () (agent-loop agent :close-on-terminate t)))
#-allegro
(agent-loop agent :close-on-terminate t))
(agent-loop agent :close-on-terminate t))))
(defun agent-loop (agent &key close-on-terminate)
(let ((*the-snmp-agent* agent))
(unwind-protect
(loop
#+allegro
(mp:wait-for-input-available
(list (socket:socket-os-fd (sas-socket agent)))
:whostate "Waiting for request PDU")
(multiple-value-bind (pdu start end return-address)
(receive-packet agent t)
(multiple-value-bind (respond-p response)
(agent-process-incoming-packet agent pdu start end)
(when respond-p
(send-packet-to agent response return-address)))))
(when close-on-terminate
(close-snmp-agent agent)))))
(defun agent-process-incoming-packet (agent pdu start end)
(counter32-incf (sas-in-pkts agent))
(handler-case
(let ((request (decode-pdu pdu :start start :end end)))
(cond ((consp request)
(unless (and (integerp (first request))
(stringp (second request))
(endp (cdddr request)))
(error 'snmpv1-malformed-pdu-error
:request (subseq pdu start end)))
(unless (or (= (first request) snmp-version-1)
(= (first request) snmp-version-2c))
(signal 'snmp-bad-version-error
:request pdu
:requested-version (first request)))
(multiple-value-prog1
(snmpxc-reply request agent (first request))
(counter32-incf (sas-out-pkts agent))))
(t (signal 'snmp-malformed-pdu-error
:request pdu))))
(asn.1:asn-error (c)
(declare (ignore c))
(counter32-incf (sas-in-asn-parse-errs agent)) nil)
(snmp-bad-version-error (c)
(declare (ignore c))
(counter32-incf (sas-in-bad-versions agent)) nil)
(snmp-request-bad-community-error (c)
(declare (ignore c))
(counter32-incf (sas-in-bad-community-names agent)) nil)
(snmp-agent-no-such-name-error (c)
(counter32-incf (sas-in-no-such-names agent))
(let ((response (make-error-pdu c)))
(incf (sas-out-get-responses agent))
(values t response)))))
(defmethod make-error-pdu ((c snmp-agent-specific-variable-error))
(let ((request (snmp-agent-request-error-request c)))
(let ((version (pdu-snmp-version request))
(community (pdu-snmp-community request))
(type (pdu-type request))
(request-id (pdu-request-id request))
(bindings (pdu-bindings request)))
(encode-pdu
(list version community
(make-typed-asn-tuple
pdu-type-response
(list request-id
(snmp-agent-specific-variable-error-error-status c)
(snmp-agent-specific-variable-error-variable-index c)
bindings)))))))
(defun snmpxc-reply (request agent version)
(let ((snmp-version (pdu-snmp-version request))
(community (pdu-snmp-community request))
(type (pdu-type request))
(request-id (pdu-request-id request))
(bindings (pdu-bindings request)))
(unless (= snmp-version version)
(signal 'snmp-bad-version-error
:request request :requested-version snmp-version))
(let ((view (snmpxc-community->view community agent)))
(unless view
(signal 'snmp-request-bad-community-error
:request request :community community))
(let ((new-bindings
(snmp-response agent type bindings view version request)))
(when new-bindings
(let ((response (encode-pdu
(list version community
(make-typed-asn-tuple
pdu-type-response
(list request-id 0 0
new-bindings))))))
(incf (sas-out-get-responses agent))
(values t response)))))))
(defmethod snmpxc-community->view (community agent)
(cond ((string= community "public") t)
(t nil)))
(defun snmp-response (agent type bindings view version request)
(case type
((#.pdu-type-get-request)
(counter32-incf (sas-in-get-requests agent))
(new-bindings-for-get-request agent bindings view request))
((#.pdu-type-get-next-request)
(counter32-incf (sas-in-get-nexts agent))
(new-bindings-for-get-next-request agent bindings view request))
((#.pdu-type-get-bulk-request)
(cond ((= version snmp-version-1)
(counter32-incf (sas-in-asn-parse-errs agent))
nil)
(t (counter32-incf (snmpv1/2c-agent-state-in-get-bulks agent))
(new-bindings-for-get-bulk-request agent bindings view request))))
(otherwise
(counter32-incf (sas-in-asn-parse-errs agent))
nil)))
(defun new-bindings-for-get-request (agent bindings view request)
(sequential-new-bindings
bindings agent view request
#'get-response-binding))
(defun new-bindings-for-get-next-request (agent bindings view request)
(sequential-new-bindings
bindings agent view request
#'get-next-response-binding))
(defconstant max-supported-repetitions 10)
(defun new-bindings-for-get-bulk-request (agent bindings view request)
(let ((non-repeaters (pdu-non-repeaters request))
(max-repetitions (pdu-max-repetitions request)))
(when (> max-repetitions max-supported-repetitions)
(setq max-repetitions max-supported-repetitions))
(when (< max-repetitions 0)
(signal 'snmp-get-bulk-illegal-max-repetitions
:request request
:max-repetitions max-repetitions))
(when (or (< non-repeaters 0)
(> non-repeaters (length bindings)))
(signal 'snmp-get-bulk-illegal-non-repeaters
:request request
:non-repeaters non-repeaters))
(let ((non-repeaters (subseq bindings 0 non-repeaters))
(repeaters (subseq bindings non-repeaters)))
(let ((result '()))
(setq result (revappend
(sequential-new-bindings
non-repeaters agent view request
#'get-next-response-binding)
result))
(dotimes (i max-repetitions)
;;TODO: Handle termination condition (response packet too big)
(let ((new-bindings
(sequential-new-bindings
repeaters agent view request
#'get-next-response-binding)))
(setq result (revappend new-bindings result))
(setq repeaters new-bindings)
(when (every #'(lambda (x)
(eq (cadr x) +end-of-mib-view+))
new-bindings)
(return))))
(nreverse result)))))
(defun sequential-new-bindings (bindings agent view request mapfn)
(do ((variable-counter 1 (1+ variable-counter))
(b bindings (rest b))
(new-bindings '()))
((endp b) (nreverse new-bindings))
(let ((binding (first b)))
(push (funcall mapfn binding agent view request variable-counter)
new-bindings))))
(defun get-response-binding (binding agent view request variable-counter)
(list (car binding)
(or (mib-get-value
*mib*
(object-id-subids
(first binding))
agent
view)
(signal 'snmp-agent-no-such-name-error
:request request
:index variable-counter))))
(defun get-next-response-binding (binding agent view request variable-counter)
(multiple-value-bind
(oid value)
(mib-get-next-value
*mib*
(object-id-subids
(first binding))
agent
view)
(if oid
(list (make-object-id oid) value)
(if (= (pdu-snmp-version request) snmp-version-1)
(signal 'snmp-agent-no-such-name-error
:request request
:index variable-counter)
(list (make-object-id oid) +end-of-mib-view+)))))
;;; -*- Package: SNMP; mode: Common-Lisp -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File Name: generic-mib-2.lisp
;;; Description: Generic MIB 2 Instrumentation
;;; Author: Simon Leinen (simon@switch.ch)
;;; Date Created: 31-Jan-1999
;;; RCS $Header: /home/leinen/CVS/lisp-snmp/agent/generic/mib-2.lisp,v 1.4 2003/12/29 10:12:45 leinen Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :snmp)
(eval-when (:compile-toplevel :execute)
(setq *readtable* *snmp-readtable*))
(def-scalar-variable [sysDescr] (agent)
(machine-type))
(def-scalar-variable [sysObjectID] (agent)
'#.(make-object-id '(1 3 6 1 4 1 4 1 2 1 6 9 3 5 2 7 7)))
(def-scalar-variable [sysUpTime] (agent)
(make-timeticks
(truncate (* #.(/ 100 internal-time-units-per-second)
(- (get-internal-real-time)
(sas-start-up-time agent))))))
(def-scalar-variable [sysServices] (agent)
#.(logior (expt 2 (1- 4)) ;end-to-end
(expt 2 (1- 7)))) ;applications
;;;; the `snmp' group
(def-scalar-variable [snmpInPkts] (agent)
(make-counter32 (sas-in-pkts agent)))
(def-scalar-variable [snmpOutPkts] (agent)
(make-counter32 (sas-out-pkts agent)))
(def-scalar-variable [snmpInBadVersions] (agent)
(make-counter32 (sas-in-bad-versions agent)))
(def-scalar-variable [snmpInBadCommunityNames] (agent)
(make-counter32 (sas-in-bad-community-names agent)))
(def-scalar-variable [snmpInBadCommunityUses] (agent)
(make-counter32 (sas-in-bad-community-uses agent)))
(def-scalar-variable [snmpInASNParseErrs] (agent)
(make-counter32 (sas-in-asn-parse-errs agent)))
(def-scalar-variable [snmpInTooBigs] (agent)
(make-counter32 (sas-in-too-bigs agent)))
(def-scalar-variable [snmpInNoSuchNames] (agent)
(make-counter32 (sas-in-no-such-names agent)))
(def-scalar-variable [snmpInBadValues] (agent)
(make-counter32 (sas-in-bad-values agent)))
(def-scalar-variable [snmpInReadOnlys] (agent)
(make-counter32 (sas-in-read-onlys agent)))
(def-scalar-variable [snmpInGenErrs] (agent)
(make-counter32 (sas-in-gen-errs agent)))
(def-scalar-variable [snmpInTotalReqVars] (agent)
(make-counter32 (sas-in-total-req-vars agent)))
(def-scalar-variable [snmpInTotalSetVars] (agent)
(make-counter32 (sas-in-total-set-vars agent)))
(def-scalar-variable [snmpInGetRequests] (agent)
(make-counter32 (sas-in-get-requests agent)))
(def-scalar-variable [snmpInGetNexts] (agent)
(make-counter32 (sas-in-get-nexts agent)))
(def-scalar-variable [snmpInSetRequests] (agent)
(make-counter32 (sas-in-set-requests agent)))
(def-scalar-variable [snmpInGetResponses] (agent)
(make-counter32 (sas-in-get-responses agent)))
(def-scalar-variable [snmpInTraps] (agent)
(make-counter32 (sas-in-traps agent)))
(def-scalar-variable [snmpOutTooBigs] (agent)
(make-counter32 (sas-out-too-bigs agent)))
(def-scalar-variable [snmpOutNoSuchNames] (agent)
(make-counter32 (sas-out-no-such-names agent)))
(def-scalar-variable [snmpOutBadValues] (agent)
(make-counter32 (sas-out-bad-values agent)))
(def-scalar-variable [snmpOutGenErrs] (agent)
(make-counter32 (sas-out-gen-errs agent)))
(def-scalar-variable [snmpOutGetRequests] (agent)
(make-counter32 (sas-out-get-requests agent)))
(def-scalar-variable [snmpOutGetNexts] (agent)
(make-counter32 (sas-out-get-nexts agent)))
(def-scalar-variable [snmpOutSetRequests] (agent)
(make-counter32 (sas-out-set-requests agent)))
(def-scalar-variable [snmpOutGetResponses] (agent)
(make-counter32 (sas-out-get-responses agent)))
(def-scalar-variable [snmpOutTraps] (agent)
(make-counter32 (sas-out-traps agent)))
(def-scalar-variable [snmpEnableAuthenTraps] (agent)
(if (sas-enable-authen-traps agent) 1 2))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; File Name: mib-instr.lisp
;;; Description: Instrumentation for MIBs
;;; Author: Simon Leinen (simon@lia.di.epfl.ch)
;;; Date Created: 2-Nov-93
;;; RCS $Header: /home/leinen/CVS/lisp-snmp/agent/generic/mib-instr.lisp,v 1.13 2003/12/29 10:13:26 leinen Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :snmp)
(defclass mib-variable ()
((name :reader mib-variable-name
:initarg :name
:type string)))
(defun mib-variable-p (x) (typep x 'mib-variable))
(defmethod print-object ((var mib-variable) stream)
(if (slot-boundp var 'name)
(print-unreadable-object (var stream :type t)
(princ (mib-variable-name var) stream))
(print-unreadable-object (var stream :type t :identity t))))