blob: e2c4b9b4bb9947dcd4c125ab19a5da5569e09ff5 (
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
|
;;;; -*- 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 "linus" "linus" "" "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))))
;; Populate the 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))))
;; Add octets to templ.
(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))))
|
