refactored, and switched to json payloads

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