public
/
backplane-dns
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

refactored, and switched to json payloads

This commit is contained in:
Niten 2020-11-13 11:11:58 -08:00
parent 799c35d89f
commit c663acdd33
4 changed files with 114 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
backplane-dns.asd
View File

@ -8,6 +8,7 @@
:serial t
:depends-on (:alexandria
:arrows
:cl-json
:cl-ppcre
:cl+ssl
:cl-xmpp
@ -15,4 +16,5 @@
:postmodern
:trivia)
:components ((:file "package")
(:file "backplane-dns")))
(:file "backplane-dns")
(:file "backplane-server")))

101
backplane-dns.lisp
View File

@ -48,9 +48,6 @@
(:table-name domains)
(:keys id))
(defclass request ()
((sender :initarg :sender)))
(defclass change-request-ipv4 (request)
((hostname :initarg :hostname)
(domain :initarg :domain)
@ -66,22 +63,6 @@
(domain :initarg :domain)
(sshfp :initarg :sshfp)))
(defclass unknown-request (request)
((text :initarg :text
:reader text)))
(defclass result ()
((message :initarg :message)))
(defclass result/success (result) ())
(defclass result/error (result) ())
(defun make-success (&optional msg)
(make-instance 'result/success :message msg))
(defun make-error (&optional msg)
(make-instance 'result/error :message msg))
(defparameter *hostname-rx*
"(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9\-]*[A-Za-z0-9])")
@ -138,44 +119,6 @@
(hostname-extractor-rx sender)
hostname)))
(defgeneric render-result (result))
(defmethod render-result ((res result/success))
(with-slots (message) res
(if message
(format nil "OK: ~A" message)
"OK")))
(defmethod render-result ((res result/error))
(with-slots (message) res
(if message
(format nil "ERROR: ~A" message)
"ERROR")))
(defun parse-message (message)
(let ((from (xmpp:from message)))
(trivia:match (split-string (xmpp:body message))
((list "REQUEST-CHANGE-IPV4" domain ip)
(make-instance 'change-request-ipv4
:sender from
:hostname (sender-hostname from)
:domain domain
:ip-address ip))
((list "REQUEST-CHANGE-IPV6" domain ip)
(make-instance 'change-request-ipv6
:sender from
:hostname (sender-hostname from)
:domain domain
:ip-address ip))
(_ (make-instance 'unknown-request
:sender from
:text (xmpp:body message))))))
(defgeneric handle-message (message))
(defmethod handle-message ((message change-request-ipv4))
(with-slots (hostname domain ip-address) message
(handler-case
@ -196,25 +139,30 @@
(make-error (format nil "unknown error setting host v6ip: ~A"
text))))))
(defmethod handle-message ((message unknown-request))
(make-error (format nil "unknown message: ~A" (text message))))
(defgeneric parse-dns-message (sender request message)
(:documentation "Parse a DNS service message of type REQUEST"))
(defmethod xmpp:handle ((conn xmpp:connection) (message xmpp:message))
(xmpp:message conn
(xmpp:from message)
(-> message
(parse-message)
(handle-message)
(render-result))))
(defmethod parse-dns-message (sender (request (eql "change-ipv4")) message)
(make-instance 'change-request-ipv4
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
:ip-address (assoc :IP message)))
(defun with-backplane (xmpp-host xmpp-username xmpp-password f)
(let ((backplane (xmpp:connect-tls :hostname xmpp-host)))
(xmpp:auth backplane
xmpp-username
xmpp-password
(format nil "backplane-~A" (machine-instance))
:mechanism :sasl-plain)
(funcall f backplane)))
(defmethod parse-dns-message (sender (request (eql "change-ipv6")) message)
(make-instance 'change-request-ipv6
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
:ip-address (assoc :IP message)))
(defmethod parse-dns-message (sender request message)
(make-instance 'unknown-request
:sender sender
:request request))
(defmethod parse-message (sender (service (eql "dns")) api-version message)
(parse-dns-message sender (cdr (assoc :REQUEST message)) message))
(defun backplane-dns-listen (&key
xmpp-host
@ -226,9 +174,8 @@
db-password)
(let ((postmodern:*ignore-unknown-columns* t))
(postmodern:with-connection (list db-name db-username db-password db-host)
(with-backplane xmpp-host xmpp-username xmpp-password
(lambda (backplane)
(xmpp:receive-stanza-loop backplane))))))
(let ((backplane (backplane-connect xmpp-host xmpp-username xmpp-password)))
(xmpp:receive-stanza-loop backplane)))))
(defun read-file-line (filename)
(let ((input (open filename :if-does-not-exist nil)))

84
backplane-server.lisp Normal file
View File

@ -0,0 +1,84 @@
;;;; backplane-server.lisp
(in-package #:backplane-dns)
;; request
(defclass request ()
((sender :initarg :sender)))
(defclass unknown-request (request)
((request :initarg :request
:reader request)))
(defclass result ()
((message :initarg :message)))
;; result
(defclass result/success (result) ())
(defclass result/error (result) ())
(defun make-success (&optional msg)
(make-instance 'result/success :message msg))
(defun make-error (&optional msg)
(make-instance 'result/error :message msg))
(defgeneric render-result (result))
(defmethod render-result ((res result/success))
(with-slots (message) res
(if message
(format nil "OK: ~A" message)
"OK")))
(defmethod render-result ((res result/error))
(with-slots (message) res
(if message
(format nil "ERROR: ~A" message)
"ERROR")))
(defgeneric parse-message (sender service api-version message)
(:documentation "Given an incoming message, turn it into the appropriate request."))
(defmethod parse-message (sender service api-version message)
(make-error "unsupported request"))
(defun decode-message (message-str)
(cl-json:decode-json-from-string message-str))
(defun dispatch-parse-message (message sender)
(if-let ((api-version (cdr (assoc :API-VERSION message)))
(service (cdr (assoc :SERVICE message))))
(parse-message sender service api-version (assoc :PAYLOAD message))
(make-error (format nil "missing api-version or service name in request"))))
(defgeneric handle-message (message)
(:documentation "Perform necessary actions to handle a backplane message, and return a result."))
(defmethod handle-message ((message unknown-request))
(make-error (format nil "unknown request: ~A" (request message))))
(defmethod xmpp:handle ((conn xmpp:connection) (message xmpp:message))
(let ((sender (xmpp:from message)))
(xmpp:message conn
(xmpp:from message)
(-> message
(xmpp:body)
(decode-message)
(dispatch-parse-message sender)
(handle-message)
(render-result)))))
(let ((backplane nil))
(defun backplane-connect (xmpp-host xmpp-username xmpp-password)
(if backplane
backplane
(progn (setf backplane (xmpp:connect-tls :hostname xmpp-host))
(xmpp:auth backplane
xmpp-username
xmpp-password
(format nil "backplane-~A" (machine-instance))
:mechanism :sasl-plain)
backplane))))

3
package.lisp
View File

@ -12,5 +12,8 @@
#:select-dao
#:update-dao
#:insert-dao)
(:import-from #:cl-json
#:decode-json-from-string
#:encode-json)
(:export #:start-listener-with-env
#:backplane-dns-listen))