blob: b6128518fa886e5f5778bb72402f8050dcf028e4 (
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
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
|
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; 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 string ;FIXME: smallint or enum
: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 "{}")
(nexthop :col-type (or db-null inet) :accessor nexthop :initform "0.0.0.0")
(bgp-octets :col-type string :accessor bgp-octets)) ; FIXME: binary to save space.
(:metaclass dao-class)
(:keys id))
;; Database.
;; Create table by evaluating
;; (connect-toplevel "bgpstore" "bgpstore" "bgpstore" "localhost")
;; (execute (dao-table-definition 'bgp-message))
;; XML.
;; node elements have dom:tag-name
;; text elements have dom:data
(defun prefix-pair (node)
)
(defun new-bgp-message (templ pref)
(let ((msg (make-instance 'bgp-message
:prefix (car pref)
:label (cadr pref))))
;; FIXME: Use accessor functions.
;; FIXME2: Move this to a method of the class.
(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 xml-top-elem-from-octets (xml-octets)
(dom:document-element
(cxml:parse xml-octets (cxml-dom:make-dom-builder))))
(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".
;(print (describe top-elem))
(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"))
(time (aref (dom:get-elements-by-tag-name top-elem "TIME") 0)))
;; Populate new-prefs.
(when (> (length prefixes) 0)
(setf new-prefs
(concatenate
'list
new-elements
(map 'list
(lambda (p)
(list (dom:data (aref (dom:child-nodes p) 0))
(dom:get-attribute p "label")))
prefixes))))
;; TIMESTAMP and PRECISION_TIME --> template.
(let ((ts (aref (dom:get-elements-by-tag-name time "TIMESTAMP") 0))
(pt (aref (dom:get-elements-by-tag-name time "PRECISION_TIME") 0)))
(setf (timestamp templ)
(dom:data (aref (dom:child-nodes ts) 0)))
(setf (precision-time templ)
(dom:data (aref (dom:child-nodes pt) 0))))
;; AS-PATH --> template. Note that we want AS_PATH->AS
;; only, to avoid getting COMMUNITY->AS.
(setf (path templ)
(let ((as-paths (dom:get-elements-by-tag-name update
"AS_PATH")))
(if (= 0 (length as-paths))
"{}"
(let ((str "{"))
(map nil (lambda (node)
(let ((as (dom:data (aref (dom:child-nodes node) 0))))
(setf str (concatenate 'string
str
(format nil "~A," as)))))
(dom:child-nodes (aref as-paths 0)))
(concatenate 'string
(subseq str 0 (- (length str) 1))
"}")))))
;; NEXT_HOP --> template.
(setf (nexthop templ)
(let ((nexthops (dom:get-elements-by-tag-name
update "NEXT_HOP")))
(if (= 0 (length nexthops))
"0.0.0.0"
(dom:data (aref (dom:child-nodes (aref nexthops 0)) 0)))))
;; OCTETS --> template.
(when (> (length octet-msgs) 0)
(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 new-prefs and the 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))))))
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))))
|
