blob: 138fea7b436070ff95b0ce6fe01ac6f867916f34 (
plain)
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
|
;; http://common-lisp.net/project/postmodern/
(defparameter *xmlns* "urn:ietf:params:xml:ns:xfb-0.1")
(defparameter *version* 0.1)
;; XML attributes, all required:
;; (xmlns :col-type string :initform *xmlns*)
;; (version :col-type string :initform *version*)
;; (length :col-type string :initarg length)
; (require 'postmodern)
; (use-package 'postmodern)
(defclass bgp-message ()
((id :col-type serial)
(timestamp :col-type integer :accessor :timestamp :initform 0)
(precision-time :col-type (or db-null smallint) :accessor :precision-time :initform 0)
(prefix :col-type cidr :accessor :prefix :initarg :prefix)
(label :col-type smallint :accessor :label :initarg :label
:documentation "1-NANN, 2-WITH, 3-DANN, 4-DUPW, 5-DPATH, 6-SPATH")
(path :col-type (or db-null integer[]) :accessor :path :initform nil)
(nexthop :col-type (or db-null inet) :accessor :nexthop :initform "")
(bgp-octets :col-type string :accessor bgp-octets)) ; FIXME: binary to save space.
(:metaclass dao-class)
(:keys id))
;; (connect-toplevel "linus" "linus" "" "localhost")
;; (execute (dao-table-definition 'bgp-message))
;; BGP_MESSAGE {TIME {TIMESTAMP {1245842681} DATETIME {2009-06-24T11:24:41Z} PRECISION_TIME {185} } PEERING {SRC_ADDR {193.10.255.88} SRC_PORT {179} SRC_AS {2603} DST_ADDR {193.10.252.3} DST_PORT {179} DST_AS {2603} } ASCII_MSG {MARKER {FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF} LENGTH {87} TYPE {UPDATE} UPDATE {WITHDRAWN_LEN {24} WITHDRAWN {PREFIX {92.46.244/23} PREFIX {95.59.2/23} PREFIX {95.59.4/22} PREFIX {95.59.8/23} PREFIX {89.218.218/23} PREFIX {89.218.220/23} } PATH_ATTRIBUTES_LEN {36} PATH_ATTRIBUTES {ATTRIBUTE {FLAGS {TRANSITIVE {} } LENGTH {1} TYPE {ORIGIN} ORIGIN {IGP} } ATTRIBUTE {FLAGS {TRANSITIVE {} } LENGTH {8} TYPE {AS_PATH} AS_PATH {AS {1299} AS {702} AS {3216} } } ATTRIBUTE {FLAGS {TRANSITIVE {} } LENGTH {4} TYPE {NEXT_HOP} NEXT_HOP {213.248.97.93} } ATTRIBUTE {FLAGS {TRANSITIVE {} } LENGTH {4} TYPE {LOCAL_PREF} LOCAL_PREF {80} } ATTRIBUTE {FLAGS {OPTIONAL {} TRANSITIVE {} } LENGTH {4} TYPE {COMMUNITIES} COMMUNITIES {COMMUNITY {AS {2603} VALUE {666} } } } } NLRI {PREFIX {95.30.48/22} } } } OCTET_MSG {MARKER {FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF} LENGTH {87} TYPE {UPDATE} OCTETS {FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF0057020018175C2EF4175F3B02165F3B04175F3B081759DADA1759DADC0024400101004002080203051302BE0C90400304D5F8615D40050400000050C008040A2B029A165F1E30} } }
;; elements: dom:tag-name
;; text: dom:data
(defun prefix (node)
(list (dom:data (aref (dom:child-nodes node) 0))
(dom:get-attribute node "label")))
(defun xml-top-elem-from-octets (xml-octets)
(dom:document-element
(cxml:parse xml-octets (cxml-dom:make-dom-builder))))
(defun new-bgp-message (templ pref)
(let ((msg (make-instance 'bgp-message
:prefix (car pref)
:label (cadr pref))))
(setf (slot-value msg 'timestamp) (slot-value templ 'timestamp)
(slot-value msg 'precision-time) (slot-value templ 'precision-time)
(slot-value msg 'path) (slot-value templ 'path)
(slot-value msg 'nexthop) (slot-value templ 'nexthop)
(slot-value msg 'bgp-octets) (slot-value templ 'bgp-octets))
msg))
(defun new-entries (top-elem)
"Return BGP-MESSAGE's, one per prefix mentioned in TOP-ELEM.
TOP-ELEM is an XML document element."
;; We assume that top-elem is "BGP_MESSAGE".
(let ((updates (dom:get-elements-by-tag-name top-elem "UPDATE"))
(new-elements nil))
(when (> (length updates) 0)
(let ((update (aref updates 0)))
(when (string= (dom:tag-name (dom:parent-node update)) "ASCII_MSG")
(let ((templ (make-instance 'bgp-message))
(new-prefs nil)
(octet-msgs (dom:get-elements-by-tag-name top-elem "OCTET_MSG"))
(prefixes (dom:get-elements-by-tag-name top-elem "PREFIX")))
;;(format t "found update, prefixes=~A~%" prefixes)
(when (> (length prefixes) 0)
(setf new-prefs
(concatenate
'list
new-elements
(map 'list (lambda (pref)
(prefix pref))
prefixes))))
;; todo: create new elements and populate template
(when (> (length octet-msgs) 0)
;;(format t "found octet-msg~%")
(let* ((oct (aref (dom:get-elements-by-tag-name
(aref octet-msgs 0) "OCTETS")
0))
(txt (aref (dom:child-nodes oct) 0)))
(setf (bgp-octets templ) (dom:data txt))))
;; Create new elements from template.
(format t "templ: ~A~%" (describe templ))
(format t "new-prefs: ~A~%" new-prefs)
(dolist (p new-prefs)
(push (new-bgp-message templ p) new-elements))
))))
;; Return new elements.
new-elements))
(defun new-entry-klacks (xml-doc)
"Return a fresh BGP-MESSAGE built from XML-DOC (array of unsigned bytes)."
(let ((s (cxml:make-source xml-doc))
(e (make-instance 'bgp-message))
(cur-name nil))
(do ((key (klacks:peek s) (klacks:peek s)))
((null key) e)
(case key
(:start-element (setf cur-name (klacks:current-qname s)))
(:end-element (setf cur-name nil))
(:characters (let ((txt (klacks:current-characters s)))
(unless (or (string= cur-name "OCTET_MSG"))
(setf (slot-value e (intern cur-name)) txt)))))
(klacks:consume s))))
|
