From c663acdd339042f2859088bd9ca9d842c2770f1d Mon Sep 17 00:00:00 2001 From: Niten Date: Fri, 13 Nov 2020 11:11:58 -0800 Subject: [PATCH] refactored, and switched to json payloads --- backplane-dns.asd | 4 +- backplane-dns.lisp | 101 ++++++++++-------------------------------- backplane-server.lisp | 84 +++++++++++++++++++++++++++++++++++ package.lisp | 3 ++ 4 files changed, 114 insertions(+), 78 deletions(-) create mode 100644 backplane-server.lisp diff --git a/backplane-dns.asd b/backplane-dns.asd index cc4d683..121692f 100644 --- a/backplane-dns.asd +++ b/backplane-dns.asd @@ -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"))) diff --git a/backplane-dns.lisp b/backplane-dns.lisp index 8949681..2cc9d4c 100644 --- a/backplane-dns.lisp +++ b/backplane-dns.lisp @@ -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))) diff --git a/backplane-server.lisp b/backplane-server.lisp new file mode 100644 index 0000000..e0949f6 --- /dev/null +++ b/backplane-server.lisp @@ -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)))) diff --git a/package.lisp b/package.lisp index 499167c..d18ac26 100644 --- a/package.lisp +++ b/package.lisp @@ -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))