WIP.

1 files changed, 80 insertions, 46 deletions

diff --git a/src/data.lisp b/src/data.lisp
index 4674638..138fea7 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -11,64 +11,98 @@
 ; (require 'postmodern)
 ; (use-package 'postmodern)
 (defclass bgp-message ()
-   (
-    ;;TIME
-    (timestamp :col-type integer)
-    (datetime :col-type (or db-null string))
-    (precision_time :col-type (or db-null integer))
+  ((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))
 
-    ;; PEERING
-    (src_addr :col-type string)
-    (dst_addr :col-type string)
-    (src_port :col-type string)
-    (dst_port :col-type string)
-    (src_as :col-type (or db-null string))
-    (dst_as :col-type (or db-null string))
+;; (connect-toplevel "linus" "linus" "" "localhost")
+;; (execute (dao-table-definition 'bgp-message))
 
-    ;; OCTET_MSG
-    (oct-marker :col-type string)
-    (oct-length :col-type integer)
-    (oct-type :col-type integer) ; FIXME: is there an enum or small integer?
-    (oct-octets :col-type string)
+;; 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} } } 
 
-    ;; ASCII_MSG
-    (asc-marker :col-type string)
-    (asc-length :col-type integer)
-    (asc-type :col-type integer) ; FIXME: is there an enum or small integer?
-    )
+;; elements: dom:tag-name
+;; text: dom:data
 
-   (:metaclass dao-class)
-   (:keys timestamp))
+(defun prefix (node)
+  (list	(dom:data (aref (dom:child-nodes node) 0))
+	(dom:get-attribute node "label")))
 
-;; (connect-toplevel "linus" "linus" "" "localhost")
-;; (execute (dao-table-definition 'bgp-message))
+(defun xml-top-elem-from-octets (xml-octets)
+  (dom:document-element
+   (cxml:parse xml-octets (cxml-dom:make-dom-builder))))
 
-;; 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} } } 
+(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))))
 
-(defun new-entry (xml-doc)
+	    ;; 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-ctxt nil)
 	(cur-name nil))
     (do ((key (klacks:peek s) (klacks:peek s)))
 	((null key) e)
       (case key
-	(:start-element (let ((tag (klacks:current-qname s)))
-			  (setf cur-ctxt (cond
-					   ((string= tag "OCTET_MSG") "OCT-")
-					   ((string= tag "ASCII_MSG") "ASC-")
-					   (t cur-ctxt)))
-			  (setf cur-name (concatenate 'string cur-ctxt tag))))
-	(:end-element (let ((tag (klacks:current-qname s)))
-			(when *debug2* (print tag))
-			(setf cur-ctxt (cond
-					 ((string= tag "OCTET_MSG") nil)
-					 ((string= tag "ASCII_MSG") nil)
-					 (t cur-ctxt)))
-			(setf cur-name nil)))
-	(:characters (progn
-		       (when *debug2* (format t "cur-name: ~A, cur-ctxt: ~A~%" cur-name cur-ctxt))
-		       (setf (slot-value e (intern cur-name))
-			     (klacks:current-characters s)))))
+	(: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))))
+