;; 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))))