Added msg-id
This commit is contained in:
parent
159301c234
commit
3dc222f3c5
|
@ -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
|
||||||
:sender sender
|
:msg-id msg-id
|
||||||
:request request))
|
:sender sender
|
||||||
|
: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
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
Loading…
Reference in New Issue