-
Notifications
You must be signed in to change notification settings - Fork 2
/
server-walk.lisp
192 lines (179 loc) · 7.4 KB
/
server-walk.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
;;;; -*- Mode: Lisp -*-
;;;; $Id$
;;;; snmp-walk (get-next) support for snmp-server
;;; [C] [B] [A]
;;; system +-> sysDescr --> sysDescr.0
;;; |
;;; +-> sysORID +-> sysORID.1 [G]
;;; | [F] |
;;; | +-> sysORID.2 [D]
;;; | |
;;; | +-> sysORID.3 [E]
;;; +-> sysXXX
;;; [H]
;;; binghe: snmp-walk (get-next) on server-side is quite complicated, I find five types:
;;;
;;; 1. GetNext an "scalar-variable" (sysDescr.0):
;;; we should walk from A to B, then call the dispatch function on sysDescr
;;;
;;; 2. GetNext on "oid leaf" (sysDescr or sysORID):
;;; we should detect this leaf is a scalar-variable or table by call its dispatch
;;; on NIL, then decide return sysDescr.0 or sysORID.1
;;;
;;; 3. GetNext on "oid trunk" (system):
;;; we should find next dispatched oid (from C to B), and then go to "Type 2"
;;;
;;; 4. GetNext in a table (sysORID.1 or sysORID.2):
;;; we should find its table leaf (sysORID) first, then list all its table enties
;;; (by call leaf's dispatch on NIL), then find the next entry of current entry
;;; and return it.
;;;
;;; 5. GetNext in a table's last entry (sysORID.3):
;;; To detect this case, we should use Type 4's method, when the next entry of current
;;; entry is out of current table, we go to "Type 3"
(in-package :snmp)
(defun mklist (obj)
(if (listp obj) obj (list obj)))
(defmethod process-object-id ((oid object-id) (flag (eql :get-next)))
;; First, find the target oid
(destructuring-bind (next-oid dispatch-function args)
(cond ((oid-scalar-variable-p oid) ; Type 1
(find-first (find-sibling (oid-parent oid))))
((oid-leaf-p oid) ; Type 2
(or (find-first oid)
(find-first (find-sibling oid))))
((oid-trunk-p oid) ; Type 3
(find-first (find-next oid)))
(t (find-next-entry oid))) ; Type 4 or 5
(if next-oid
(list next-oid (funcall dispatch-function *server* args))
(list oid (smi :end-of-mibview)))))
;;; B -> F
(defun find-sibling (oid)
(declare (type object-id oid))
(let* ((walk-table (server-walk-table *server*))
(walk-list (gethash oid walk-table)))
(if walk-list
(cadr walk-list)
(find-next oid))))
;;; (B -> A) or (F -> G)
(defun find-first (oid)
(declare (type (or object-id null) oid))
(let* ((dispatch-table (server-dispatch-table *server*))
(dispatch-function (gethash oid dispatch-table)))
(if (null dispatch-function)
(list nil nil nil)
(let ((entries (funcall dispatch-function *server*)))
(etypecase entries
(integer
(cond ((zerop entries) ; B -> A
(list (oid (list oid 0))
dispatch-function
t))
(t ; F -> G
(list (oid (list oid 1))
dispatch-function
(list 1)))))
(list ; F -> G
(let ((first-entry (mklist (car entries))))
(list (oid (cons oid first-entry))
dispatch-function
first-entry))))))))
;;; (C -> B)
(defun find-next (oid &optional (dispatch-table
(server-dispatch-table *server*)))
"Find next dispatched object-id or nil"
(declare (type object-id oid))
(labels ((iter (oid)
(unless (null oid)
(let ((next (oid-next oid)))
(if (gethash next dispatch-table)
next
(iter next))))))
(iter oid)))
;;; (G -> D) or (E -> H)
(defun find-next-entry (oid)
(declare (type object-id oid))
(let ((dispatch-table (server-dispatch-table *server*)))
(multiple-value-bind (leaf ids) (oid-find-leaf oid)
(let ((dispatch-function (gethash leaf dispatch-table)))
(if (null dispatch-function)
(find-first (find-next leaf))
(let ((entries (funcall dispatch-function *server*)))
(etypecase entries
(integer
(let ((current-entry (car ids)))
(if (< current-entry entries)
(let ((next-entry (1+ current-entry)))
(list (oid (list leaf next-entry))
dispatch-function
(list next-entry)))
(find-first (find-sibling leaf)))))
(list
(let ((current-entry (find-in-list ids entries)))
(if current-entry
;; find in middle or last
(let ((next-entry (mklist (cadr current-entry))))
(if next-entry
;; find in middle: return next
(list (oid (cons leaf next-entry))
dispatch-function
next-entry)
;; find in last: byebye
(find-first (find-sibling leaf))))
;; invalid entry, just go first
(find-first leaf)))))))))))
;;; used by find-next-entry
(defun find-in-list (current all)
(declare (type list current all))
(labels ((iter (e)
(if (null e)
nil
(if (equal (mklist (car e))
current)
e
(iter (cdr e))))))
(iter all)))
;; A simpler version of PROCESS-OBJECT-ID for SIMPLE-OID
(defmethod process-object-id ((oid simple-oid) (flag (eql :get-next)))
;; First, find the target oid
(destructuring-bind (next-oid dispatch-function args)
(cond ((oid-scalar-variable-p oid) ; Type 1
(find-first (find-sibling (oid-parent oid))))
(t (find-next-entry-for-simple-oid oid))) ; Type 4 or 5
(if next-oid
(list next-oid (funcall dispatch-function *server* args))
(list oid (smi :end-of-mibview)))))
;;; (G -> D) or (E -> H)
(defun find-next-entry-for-simple-oid (oid)
(declare (type simple-oid oid))
(let* ((dispatch-table (server-dispatch-table *server*))
(leaf (oid-parent oid))
(ids (nthcdr (oid-length leaf) (oid-number-list oid))))
(let ((dispatch-function (gethash leaf dispatch-table)))
(if (null dispatch-function)
(find-first (find-next leaf))
(let ((entries (funcall dispatch-function *server*)))
(etypecase entries
(integer
(let ((current-entry (car ids)))
(if (< current-entry entries)
(let ((next-entry (1+ current-entry)))
(list (oid (list leaf next-entry))
dispatch-function
(list next-entry)))
(find-first (find-sibling leaf)))))
(list
(let ((current-entry (find-in-list ids entries)))
(if current-entry
;; find in middle or last
(let ((next-entry (mklist (cadr current-entry))))
(if next-entry
;; find in middle: return next
(list (oid (cons leaf next-entry))
dispatch-function
next-entry)
;; find in last: byebye
(find-first (find-sibling leaf))))
;; invalid entry, just go first
(find-first leaf))))))))))