From 373afd140a28eb706282fd4891e2e75b507b18aa Mon Sep 17 00:00:00 2001 From: Linus Nordberg Date: Fri, 21 Aug 2009 16:47:09 +0200 Subject: Restructure and add bgpview. There's one package, BGP-LOGGER, defined in src/package.lisp. There are two systems, BGPSTORE and BGPVIEW, defined in bgpstore.asd and bgpview.asd respectively. The package exports START-BGPSTORE, START-BGPVIEW and their STOP- counterparts. --- src/bgpstore.asd | 10 --- src/bgpstore.lisp | 31 ---------- src/bgpstore/bgpstore.lisp | 128 +++++++++++++++++++++++++++++++++++++++ src/bgpview/bgpview.lisp | 41 +++++++++++++ src/data.lisp | 147 --------------------------------------------- src/defs.lisp | 55 +++++++++++++++++ src/package.lisp | 12 ++-- src/playground.lisp | 58 +++++++----------- src/start-bgpstore.sh | 26 -------- src/util.lisp | 2 + 10 files changed, 254 insertions(+), 256 deletions(-) delete mode 100644 src/bgpstore.asd delete mode 100644 src/bgpstore.lisp create mode 100644 src/bgpstore/bgpstore.lisp create mode 100644 src/bgpview/bgpview.lisp delete mode 100644 src/data.lisp create mode 100644 src/defs.lisp delete mode 100755 src/start-bgpstore.sh (limited to 'src') diff --git a/src/bgpstore.asd b/src/bgpstore.asd deleted file mode 100644 index 7b239f3..0000000 --- a/src/bgpstore.asd +++ /dev/null @@ -1,10 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- - -(asdf:defsystem #:bgpstore - :name "bgpstore" - :version "0.1" - :depends-on (#:cxml #:usocket #:postmodern) - :components ((:file "package") - (:file "util" :depends-on ("package")) - (:file "data" :depends-on ("util")) - (:file "bgpstore" :depends-on ("data")))) diff --git a/src/bgpstore.lisp b/src/bgpstore.lisp deleted file mode 100644 index 16cd696..0000000 --- a/src/bgpstore.lisp +++ /dev/null @@ -1,31 +0,0 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- - -(defparameter *db-spec* '("bgpstore" "bgpstore" "bgpstore" "localhost" )) - -(defun marker (mark) - (format t mark) - (force-output)) - -(defun start-bgpstore (host port) - (with-connection *db-spec* - (let ((reader (new-reader host port)) - (count 0)) - (marker (format nil "~A: bgpstore started " - (iso-date (get-universal-time) t))) - (do ((e (next-xml-blurb reader "BGP_MESSAGE") - (next-xml-blurb reader "BGP_MESSAGE"))) - ((null e)) - (dolist (obj (new-entries (xml-top-elem-from-octets e))) - (insert-dao obj) - (incf count) - (if (= 0 (mod count 10000)) - (marker (format nil "~%~A: ~A " - (iso-date (get-universal-time) t) - count)) - (if (= 0 (mod count 1000)) - (marker "*") - (if (= 0 (mod count 100)) - (marker ".")))))) - (close-reader)))) - -(defun stop-bgpstore ()) diff --git a/src/bgpstore/bgpstore.lisp b/src/bgpstore/bgpstore.lisp new file mode 100644 index 0000000..eb4fc2a --- /dev/null +++ b/src/bgpstore/bgpstore.lisp @@ -0,0 +1,128 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- + +(in-package :bgp-logger) + +(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)))) + +(defun marker (mark) + (format t mark) + (force-output)) + +(defun start-bgpstore (host port) + (with-connection *db-spec* + (let ((reader (new-reader host port)) + (count 0)) + (marker (format nil "~A: bgpstore started " + (iso-date (get-universal-time) t))) + (do ((e (next-xml-blurb reader "BGP_MESSAGE") + (next-xml-blurb reader "BGP_MESSAGE"))) + ((null e)) + (dolist (obj (new-entries (xml-top-elem-from-octets e))) + (insert-dao obj) + (incf count) + (if (= 0 (mod count 10000)) + (marker (format nil "~%~A: ~A " + (iso-date (get-universal-time) t) + count)) + (if (= 0 (mod count 1000)) + (marker "*") + (if (= 0 (mod count 100)) + (marker ".")))))) + (close-reader)))) + +(defun stop-bgpstore ()) + +;;;; diff --git a/src/bgpview/bgpview.lisp b/src/bgpview/bgpview.lisp new file mode 100644 index 0000000..d6adce4 --- /dev/null +++ b/src/bgpview/bgpview.lisp @@ -0,0 +1,41 @@ +(in-package :bgp-logger) + +(defwebapp bgpview-app + :prefix "/bgpview" + :description "FIXME: description of bgpview app" + :autostart nil + :debug t) + +(defstore *bgpview-store* :prevalence + (merge-pathnames (make-pathname :directory '(:relative "data")) + (asdf-system-directory :bgpview))) + +(defun db-test (&rest args) + (declare (ignore args)) + (with-connection *db-spec* + (let ((msgs (query-dao 'bgp-message + (:limit + (:select 'timestamp 'prefix 'label 'path 'nexthop + :from 'bgp-message) + 20)))) + ;(dolist (m msgs) (make-instance 'dataform :data m))))) + (render-object-view msgs '(table bgp-message))))) + +(defun init-user-session (comp) + (setf (composite-widgets comp) + (list "Welcome to BGP View" + (make-instance 'composite + :widgets (list "First widget." + (lambda (&rest args) + (declare (ignore args)) + (with-html + (:p "Second widget."))) + #'db-test))))) + +(defun start-bgpview (&rest args) + (apply #'start-weblocks args) + (start-webapp 'bgpview-app)) + +(defun stop-bgpview () + (stop-webapp 'bgpview-app) + (stop-weblocks)) diff --git a/src/data.lisp b/src/data.lisp deleted file mode 100644 index b612851..0000000 --- a/src/data.lisp +++ /dev/null @@ -1,147 +0,0 @@ -;;;; -*- 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)))) - diff --git a/src/defs.lisp b/src/defs.lisp new file mode 100644 index 0000000..a02a7e9 --- /dev/null +++ b/src/defs.lisp @@ -0,0 +1,55 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- + +(in-package :bgp-logger) + +;; FIXME: Remove password. +(defparameter *db-spec* '("bgpstore" "bgpstore" "bgpstore" "localhost" )) + +;; 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)) diff --git a/src/package.lisp b/src/package.lisp index 522607c..13bdf74 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1,5 +1,7 @@ -(defpackage #:bgpstore - (:use #:cl #:asdf #:postmodern) ;can't use #:dom -- it exports LENGTH :( - (:documentation "Store BGP updates in SQL database.") - (:export :start-bgpstore - :stop-bgpstore)) +(defpackage #:bgp-logger + (:use :cl :asdf :postmodern :weblocks) ;can't use #:dom -- it exports LENGTH :( + (:shadowing-import-from :postmodern #:commit-transaction) + (:shadowing-import-from :weblocks #:text) + (:documentation "Store BGP updates in SQL database and view them in web.") + (:export :start-bgpstore :stop-bgpstore + :start-bgpview :stop-bgpview)) diff --git a/src/playground.lisp b/src/playground.lisp index 4936cd0..9db5db4 100644 --- a/src/playground.lisp +++ b/src/playground.lisp @@ -1,3 +1,4 @@ +;;;; Parsing XML. (require 'cxml) (require 'usocket) (require 'cl-xmlspam) @@ -64,7 +65,8 @@ (:end-element (format t "}~%")) (:characters (format t (klacks:current-characters s)))) (klacks:consume s)))) -;; + +;; Read stream from socket. (let ((sock (usocket:socket-connect "victoria.tug.nordu.net" 50001 @@ -77,52 +79,22 @@ (format t "Closing socket.~%") (usocket:socket-close sock)) -;;;; -(defun read-stream-into-list (host port) - (let ((reader (new-reader host port)) +(defun play () + (let ((reader (new-reader "victoria.tug" 50001)) (xmls-builder (cxml-xmls:make-xmls-builder))) (do ((e (next-xml-blurb reader "BGP_MESSAGE") (next-xml-blurb reader "BGP_MESSAGE"))) ((null e)) (print (cxml:parse e xmls-builder))) (close-reader))) - -;; -(let ((s nil)) - (defun file-reader (fn) - (when s - (close s)) - (setf s (open fn :element-type '(unsigned-byte 8))) - (lambda (n) - (read-byte s nil))) - (defun close-file () - (close s))) -;; -(defun read-file-into-list (fn) - (let ((reader (file-reader fn)) - (xmls-builder (cxml-xmls:make-xmls-builder))) - (do ((e (next-xml-blurb reader "BGP_MESSAGE") - (next-xml-blurb reader "BGP_MESSAGE"))) - ((null e)) - (print (cxml:parse e xmls-builder))) - (close-file))) ;; (next-xml-blurb (new-reader "victoria.tug.nordu.net" 50001) "BGP_MESSAGE") -;;;; Pattern matching using fare-matcher. -(require :fare-matcher) -(let ((expr '(foo bar))) - (letm - (list a b) ;pattern - expr - (list a b))) -(let ((expr '(foo kaka bar))) - (match - expr - ((list a b) (list 'plain a b)) - ((list a 'kaka b) (list 'cookie a b)))) - ;;;; db +;; To connect to database, wrap your db call(s) in WITH-CONNECTION, +;; passing a spec on the form '(database user password host), see +;; http://common-lisp.net/project/postmodern/postmodern.html. + ;; SQL "select * from bgp_message where timestamp != 0 order by id desc limit 3;" @@ -138,4 +110,16 @@ (dolist (m (select-dao 'bgp-message (:= 'label "NANN"))) (format t "~A ~A ~A~%" (timestamp m) (prefix m) (label m))) +(with-connection '("bgpstore" "bgpstore" "bgpstore" "localhost" ) + (length (select-dao 'bgp-message (:= 'prefix "91.206.67.0/24")))) +(length (query (:limit (:select 'prefix + :from 'bgp-message + :where (:= 'prefix "91.206.67.0/24")) + 10))) +(query-dao 'bgp-message (:limit (:select 'prefix + :from 'bgp-message + :where (:= 'prefix "91.206.67.0/24")) + 13)) + (length (select-dao 'bgp-message)) + diff --git a/src/start-bgpstore.sh b/src/start-bgpstore.sh deleted file mode 100755 index 599068e..0000000 --- a/src/start-bgpstore.sh +++ /dev/null @@ -1,26 +0,0 @@ -#! /bin/sh - -HOST=$1 -PORT=$2 -DB_DB=$3 -DB_USER=$4 -DB_PW=$5 -DB_HOST=$6 - -[ -z "$HOST" ] && HOST=victoria.tug.nordu.net -[ -z "$PORT" ] && PORT=50001 - -[ -z "$DB_DB" ] && DB_DB=linus -[ -z "$DB_USER" ] && DB_USER=linus -[ -z "$DB_PW" ] && DB_PW= -[ -z "$DB_HOST" ] && DB_HOST=localhost - -# FIXME: The (use-package 'postmodern) should've been taken care of in -# package.lisp. Why doesn't it work? - -sbcl --no-userinit \ - --eval "(require 'asdf)" \ - --eval "(asdf:oos 'asdf:load-op 'postmodern)" \ - --eval "(use-package 'postmodern)" \ - --eval "(require 'bgpstore)" \ - --eval "(let ((*db-spec* '(\"$DB_DB\" \"$DB_USER\" \"$DB_PW\" \"$DB_HOST\"))) (start-bgpstore \"$HOST\" $PORT))" diff --git a/src/util.lisp b/src/util.lisp index c6e446c..90816a5 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -1,5 +1,7 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(in-package :bgp-logger) + (defparameter *debug* nil) (defun next-xml-blurb (reader tag) -- cgit v1.1