public
/
backplane-dns
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added support for IPv6

This commit is contained in:
Niten 2020-11-13 09:42:17 -08:00
parent c0e4d12fb7
commit 799c35d89f
1 changed files with 64 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
backplane-dns.lisp
View File

@ -56,6 +56,16 @@
(domain :initarg :domain) (domain :initarg :domain)
(ip-address :initarg :ip-address))) (ip-address :initarg :ip-address)))
(defclass change-request-ipv6 (request)
((hostname :initarg :hostname)
(domain :initarg :domain)
(ip-address :initarg :ip-address)))
(defclass change-request-sshfp (request)
((hostname :initarg :hostname)
(domain :initarg :domain)
(sshfp :initarg :sshfp)))
(defclass unknown-request (request) (defclass unknown-request (request)
((text :initarg :text ((text :initarg :text
:reader text))) :reader text)))
@ -81,28 +91,38 @@
(define-condition domain-name-missing (error) (define-condition domain-name-missing (error)
((missing-domain :initarg :domain :reader missing-domain))) ((missing-domain :initarg :domain :reader missing-domain)))
(defun host-a-record (hostname domain) (defun find-host-records-by-type (host domain type)
(if-let ((domain-id (some-> domain (if-let ((domain-id (some-> domain
(get-domain) (get-domain)
(id)))) (id))))
(car (select-dao 'dns-record (select-dao 'dns-record
(:= 'name (format nil "~A.~A" hostname domain)) (:= 'name (format nil "~A.~A" host domain))
(:= 'domain-id domain-id) (:= 'domain-id domain-id)
(:= 'type "A"))) (:= 'type type))
(error 'domain-name-missing :domain domain))) (error 'domain-name-missing :domain domain)))
(defun set-host-v4ip (host domain v4ip) (defun consider-update-content (record content)
(let* ((full-hostname (format nil "~A.~A" host domain)) (if (equalp (record-content record) content)
(a-record (host-a-record host domain))) t
(if a-record (progn (setf (record-content record) content)
(progn (setf (record-content a-record) v4ip) (update-dao record))))
(update-dao a-record))
(defun update-host-record-by-type (host domain type content)
(let ((record (car (find-host-records-by-type host domain type))))
(if record
(consider-update-content record content)
(if-let ((domain-id (some-> domain (get-domain) (id)))) (if-let ((domain-id (some-> domain (get-domain) (id))))
(insert-dao (make-instance 'dns-record (insert-dao (make-instance 'dns-record
:domain-id domain-id :domain-id domain-id
:name full-hostname :name (format nil "~A.~A" host domain)
:type "A" :type type
:content v4ip)))))) :content content))))))
(defun set-host-v4ip (host domain v4ip)
(update-host-record-by-type host domain "A" v4ip))
(defun set-host-v6ip (host domain v6ip)
(update-host-record-by-type host domain "AAAA" v6ip))
(defun split-string (string &optional (char #\Space)) (defun split-string (string &optional (char #\Space))
(split-sequence:split-sequence char string)) (split-sequence:split-sequence char string))
@ -143,6 +163,13 @@
:domain domain :domain domain
:ip-address ip)) :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 (_ (make-instance 'unknown-request
:sender from :sender from
:text (xmpp:body message)))))) :text (xmpp:body message))))))
@ -159,6 +186,16 @@
(make-error (format nil "unknown error setting host v4ip: ~A" (make-error (format nil "unknown error setting host v4ip: ~A"
text)))))) text))))))
(defmethod handle-message ((message change-request-ipv6))
(with-slots (hostname domain ip-address) 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)))
(error (text)
(make-error (format nil "unknown error setting host v6ip: ~A"
text))))))
(defmethod handle-message ((message unknown-request)) (defmethod handle-message ((message unknown-request))
(make-error (format nil "unknown message: ~A" (text message)))) (make-error (format nil "unknown message: ~A" (text message))))
@ -186,8 +223,7 @@
db-host db-host
db-name db-name
db-username db-username
db-password db-password)
db-tls)
(let ((postmodern:*ignore-unknown-columns* t)) (let ((postmodern:*ignore-unknown-columns* t))
(postmodern:with-connection (list db-name db-username db-password db-host) (postmodern:with-connection (list db-name db-username db-password db-host)
(with-backplane xmpp-host xmpp-username xmpp-password (with-backplane xmpp-host xmpp-username xmpp-password