From 3dc222f3c54bdff88da5fb90bd588293380cd300 Mon Sep 17 00:00:00 2001 From: Niten Date: Fri, 13 Nov 2020 17:27:44 -0800 Subject: [PATCH] Added msg-id --- backplane-dns.lisp | 51 +++++++++++++++++++++++++-------------- backplane-server.lisp | 56 ++++++++++++++++++++++++++----------------- 2 files changed, 67 insertions(+), 40 deletions(-) diff --git a/backplane-dns.lisp b/backplane-dns.lisp index 9326fd7..d397d10 100644 --- a/backplane-dns.lisp +++ b/backplane-dns.lisp @@ -120,49 +120,64 @@ hostname))) (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 (progn (set-host-v4ip hostname domain ip-address) - (make-success (format nil "ipv4 for host ~a in domain ~a set to ~a" - hostname domain ip-address))) + (make-success :msg (format nil "ipv4 for host ~a in domain ~a set to ~a" + 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) - (make-error (format nil "unknown error setting host v4ip: ~A" - text)))))) + (make-error :msg (format nil "unknown error setting host v4ip: ~A" + text) + :msg-id msg-id))))) (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 (progn (set-host-v6ip hostname domain ip-address) - (make-success (format nil "ipv6 for host ~a in domain ~a set to ~a" - hostname domain ip-address))) + (make-success :msg (format nil "ipv6 for host ~a in domain ~a set to ~a" + 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) - (make-error (format nil "unknown error setting host v6ip: ~A" - text)))))) + (make-error :msg (format nil "unknown error setting host v6ip: ~A" + 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")) -(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 + :msg-id msg-id :sender sender :hostname (sender-hostname sender) :domain (cdr (assoc :DOMAIN 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 + :msg-id msg-id :sender sender :hostname (sender-hostname sender) :domain (cdr (assoc :DOMAIN 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 - :sender sender - :request request)) + :msg-id msg-id + :sender sender + :request request)) -(defmethod parse-message (sender (service (eql :DNS)) api-version message) - (parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message)) +(defmethod parse-message (sender (service (eql :DNS)) api-version message msg-id) + (parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message msg-id)) (defun backplane-dns-listen (&key xmpp-host diff --git a/backplane-server.lisp b/backplane-server.lisp index 5af9b5a..9a7156f 100644 --- a/backplane-server.lisp +++ b/backplane-server.lisp @@ -5,14 +5,18 @@ ;; request (defclass request () - ((sender :initarg :sender))) + ((sender :initarg :sender) + (msg-id :initarg :msg-id + :reader msg-id))) (defclass unknown-request (request) ((request :initarg :request :reader request))) (defclass result () - ((message :initarg :message))) + ((message :initarg :message) + (msg-id :initarg :msg-id + :reader msg-id))) ;; result @@ -22,52 +26,60 @@ (defun error-p (obj) (typep obj (find-class 'result/error))) (defun success-p (obj) (typep obj (find-class 'result/success))) -(defun make-success (&optional msg) - (make-instance 'result/success :message msg)) +(defun make-success (&key msg msg-id) + (make-instance 'result/success + :message msg + :msg-id msg-id)) -(defun make-error (&optional msg) - (make-instance 'result/error :message msg)) +(defun make-error (&key msg msg-id) + (make-instance 'result/error + :message msg + :msg-id msg-id)) (defgeneric render-result (result)) (defmethod render-result ((res result/success)) - (with-slots (message) res - (if message - (format nil "OK: ~A" message) - "OK"))) + (with-slots (message msg-id) res + (let ((msg (if message (format nil ":~A" message) "")) + (msgid (if msg-id (format nil " (~A)" msg-id) ""))) + (format nil "OK~A~A" msgid msg)))) (defmethod render-result ((res result/error)) - (with-slots (message) res - (if message - (format nil "ERROR: ~A" message) - "ERROR"))) + (with-slots (message msg-id) res + (let ((msg (if message (format nil ":~A" message) "")) + (msgid (if msg-id (format nil " (~A)" msg-id) ""))) + (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.")) -(defmethod parse-message (sender service api-version message) - (make-error (format nil "unsupported service: ~A" service))) +(defmethod parse-message (sender service api-version message msg-id) + (make-error :msg (format nil "unsupported service: ~A" service) + :msg-id msg-id)) (defun decode-message (message-str) (handler-case (cl-json:decode-json-from-string message-str) (json:json-syntax-error (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 dispatch-parse-message (message sender) (if-let ((api-version (cdr (assoc :VERSION message))) - (service (symbolize (cdr (assoc :SERVICE message))))) - (parse-message sender service api-version (cdr (assoc :PAYLOAD message))) - (make-error (format nil "missing api_version or service name in request in message")))) + (service (symbolize (cdr (assoc :SERVICE message)))) + (msg-id (cdr (assoc :MSGID 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) (: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)))) + (make-error :msg (format nil "unknown request: ~A" (request message)) + :msg-id (msg-id message))) (defmacro success-> (init &rest forms) (let ((blocksym (gensym)))