Added msg-id

This commit is contained in:
Niten 2020-11-13 17:27:44 -08:00
parent 159301c234
commit 3dc222f3c5
2 changed files with 67 additions and 40 deletions

View File

@ -120,49 +120,64 @@
hostname))) hostname)))
(defmethod handle-message ((message change-request-ipv4)) (defmethod handle-message ((message change-request-ipv4))
(with-slots (hostname domain ip-address) message (with-slots (hostname domain ip-address msg-id) message
(handler-case (handler-case
(progn (set-host-v4ip hostname domain ip-address) (progn (set-host-v4ip hostname domain ip-address)
(make-success (format nil "ipv4 for host ~a in domain ~a set to ~a" (make-success :msg (format nil "ipv4 for host ~a in domain ~a set to ~a"
hostname domain ip-address))) hostname domain ip-address)
:msg-id msg-id))
(domain-name-missing (err)
(make-error :msg (format nil "missing domain name: ~A"
(missing-domain err))
:msg-id msg-id))
(error (text) (error (text)
(make-error (format nil "unknown error setting host v4ip: ~A" (make-error :msg (format nil "unknown error setting host v4ip: ~A"
text)))))) text)
:msg-id msg-id)))))
(defmethod handle-message ((message change-request-ipv6)) (defmethod handle-message ((message change-request-ipv6))
(with-slots (hostname domain ip-address) message (with-slots (hostname domain ip-address msg-id) message
(handler-case (handler-case
(progn (set-host-v6ip hostname domain ip-address) (progn (set-host-v6ip hostname domain ip-address)
(make-success (format nil "ipv6 for host ~a in domain ~a set to ~a" (make-success :msg (format nil "ipv6 for host ~a in domain ~a set to ~a"
hostname domain ip-address))) hostname domain ip-address)
:msg-id msg-id))
(domain-name-missing (err)
(make-error :msg (format nil "missing domain name: ~A"
(missing-domain err))
:msg-id msg-id))
(error (text) (error (text)
(make-error (format nil "unknown error setting host v6ip: ~A" (make-error :msg (format nil "unknown error setting host v6ip: ~A"
text)))))) text)
:msg-id msg-id)))))
(defgeneric parse-dns-message (sender request message) (defgeneric parse-dns-message (sender request message msg-id)
(:documentation "Parse a DNS service message of type REQUEST")) (:documentation "Parse a DNS service message of type REQUEST"))
(defmethod parse-dns-message (sender (request (eql :CHANGE_IPV4)) message) (defmethod parse-dns-message (sender (request (eql :CHANGE_IPV4)) message msg-id)
(make-instance 'change-request-ipv4 (make-instance 'change-request-ipv4
:msg-id msg-id
:sender sender :sender sender
:hostname (sender-hostname sender) :hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message)) :domain (cdr (assoc :DOMAIN message))
:ip-address (cdr (assoc :IP message)))) :ip-address (cdr (assoc :IP message))))
(defmethod parse-dns-message (sender (request (eql :CHANGE_IPV6)) message) (defmethod parse-dns-message (sender (request (eql :CHANGE_IPV6)) message msg-id)
(make-instance 'change-request-ipv6 (make-instance 'change-request-ipv6
:msg-id msg-id
:sender sender :sender sender
:hostname (sender-hostname sender) :hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message)) :domain (cdr (assoc :DOMAIN message))
:ip-address (cdr (assoc :IP message)))) :ip-address (cdr (assoc :IP message))))
(defmethod parse-dns-message (sender request message) (defmethod parse-dns-message (sender request message msg-id)
(make-instance 'unknown-request (make-instance 'unknown-request
:msg-id msg-id
:sender sender :sender sender
:request request)) :request request))
(defmethod parse-message (sender (service (eql :DNS)) api-version message) (defmethod parse-message (sender (service (eql :DNS)) api-version message msg-id)
(parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message)) (parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message msg-id))
(defun backplane-dns-listen (&key (defun backplane-dns-listen (&key
xmpp-host xmpp-host

View File

@ -5,14 +5,18 @@
;; request ;; request
(defclass request () (defclass request ()
((sender :initarg :sender))) ((sender :initarg :sender)
(msg-id :initarg :msg-id
:reader msg-id)))
(defclass unknown-request (request) (defclass unknown-request (request)
((request :initarg :request ((request :initarg :request
:reader request))) :reader request)))
(defclass result () (defclass result ()
((message :initarg :message))) ((message :initarg :message)
(msg-id :initarg :msg-id
:reader msg-id)))
;; result ;; result
@ -22,52 +26,60 @@
(defun error-p (obj) (typep obj (find-class 'result/error))) (defun error-p (obj) (typep obj (find-class 'result/error)))
(defun success-p (obj) (typep obj (find-class 'result/success))) (defun success-p (obj) (typep obj (find-class 'result/success)))
(defun make-success (&optional msg) (defun make-success (&key msg msg-id)
(make-instance 'result/success :message msg)) (make-instance 'result/success
:message msg
:msg-id msg-id))
(defun make-error (&optional msg) (defun make-error (&key msg msg-id)
(make-instance 'result/error :message msg)) (make-instance 'result/error
:message msg
:msg-id msg-id))
(defgeneric render-result (result)) (defgeneric render-result (result))
(defmethod render-result ((res result/success)) (defmethod render-result ((res result/success))
(with-slots (message) res (with-slots (message msg-id) res
(if message (let ((msg (if message (format nil ":~A" message) ""))
(format nil "OK: ~A" message) (msgid (if msg-id (format nil " (~A)" msg-id) "")))
"OK"))) (format nil "OK~A~A" msgid msg))))
(defmethod render-result ((res result/error)) (defmethod render-result ((res result/error))
(with-slots (message) res (with-slots (message msg-id) res
(if message (let ((msg (if message (format nil ":~A" message) ""))
(format nil "ERROR: ~A" message) (msgid (if msg-id (format nil " (~A)" msg-id) "")))
"ERROR"))) (format nil "ERROR~A~A" msgid msg))))
(defgeneric parse-message (sender service api-version message) (defgeneric parse-message (sender service api-version message msg-id)
(:documentation "Given an incoming message, turn it into the appropriate request.")) (:documentation "Given an incoming message, turn it into the appropriate request."))
(defmethod parse-message (sender service api-version message) (defmethod parse-message (sender service api-version message msg-id)
(make-error (format nil "unsupported service: ~A" service))) (make-error :msg (format nil "unsupported service: ~A" service)
:msg-id msg-id))
(defun decode-message (message-str) (defun decode-message (message-str)
(handler-case (handler-case
(cl-json:decode-json-from-string message-str) (cl-json:decode-json-from-string message-str)
(json:json-syntax-error (err) (json:json-syntax-error (err)
(declare (ignorable err)) (declare (ignorable err))
(make-error (format nil "invalid json string: ~A" message-str))))) (make-error :msg (format nil "invalid json string: ~A" message-str)))))
(defun symbolize (str) (-> str string-upcase (intern :KEYWORD))) (defun symbolize (str) (-> str string-upcase (intern :KEYWORD)))
(defun dispatch-parse-message (message sender) (defun dispatch-parse-message (message sender)
(if-let ((api-version (cdr (assoc :VERSION message))) (if-let ((api-version (cdr (assoc :VERSION message)))
(service (symbolize (cdr (assoc :SERVICE message))))) (service (symbolize (cdr (assoc :SERVICE message))))
(parse-message sender service api-version (cdr (assoc :PAYLOAD message))) (msg-id (cdr (assoc :MSGID message))))
(make-error (format nil "missing api_version or service name in request in message")))) (parse-message sender service api-version (cdr (assoc :PAYLOAD message)) msg-id)
(make-error :msg (format nil "missing api_version, msgid, or service name in request in message")
:msg-id msg-id)))
(defgeneric handle-message (message) (defgeneric handle-message (message)
(:documentation "Perform necessary actions to handle a backplane message, and return a result.")) (:documentation "Perform necessary actions to handle a backplane message, and return a result."))
(defmethod handle-message ((message unknown-request)) (defmethod handle-message ((message unknown-request))
(make-error (format nil "unknown request: ~A" (request message)))) (make-error :msg (format nil "unknown request: ~A" (request message))
:msg-id (msg-id message)))
(defmacro success-> (init &rest forms) (defmacro success-> (init &rest forms)
(let ((blocksym (gensym))) (let ((blocksym (gensym)))