DNS backplane listener. Connects to a Jabber server and listens for updates from hosts.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

142 lines
4.8 KiB

(in-package #:backplane-dns-store)
(defclass dns-store () ())
;; This seems silly since it's empty, but it enables testing
(defclass postgres-dns-store (dns-store) ())
(defclass dns-record ()
((id :col-type integer
:col-identity t
:reader id)
(domain-id :col-type integer
:col-name "domain_id"
:initarg :domain-id
:reader domain-id)
(name :col-type (varchar 255)
:initarg :name
:reader record-name)
(type :col-type (varchar 10)
:initarg :type
:reader record-type)
(content :col-type (varchar 65535)
:initarg :content
:accessor record-content))
(:metaclass postmodern:dao-class)
(:table-name "records")
(:keys id))
(defclass dns-domain ()
((id :col-type integer
:col-identity t
:reader domain-id)
(name :col-type (varchar 255)
:initarg :name
:reader domain-name)
(master :col-type (or (varchar 128) db-null)
:initarg :master
:reader domain-master)
(type :col-type (varchar 6)
:initarg :type
:reader domain-type))
(:metaclass postmodern:dao-class)
(:table-name domains)
(:keys id))
(define-condition backplane-dns-store-error () ())
(define-condition domain-name-missing (backplane-dns-store-error)
((missing-domain :initarg :domain
:reader missing-domain)))
(define-condition invalid-sshfp (backplane-dns-store-error)
((sshfp :initarg :sshfp
:reader invalid-sshfp)))
(define-condition invalid-ip (backplane-dns-store-error)
((ip :initarg :ip
:reader invalid-ip)
(msg :initarg :msg
:reader error-msg)))
(defun get-domain (domain)
(if-let ((domain (car (select-dao 'dns-domain (:= 'name domain)))))
domain
(error 'domain-name-missing :domain domain)))
(defun get-records (domain name type)
(let ((domain-id (domain-id (get-domain domain))))
(select-dao 'dns-record (:and (:= 'domain-id domain-id)
(:= 'name (format nil "~A.~A" name domain))
(:= 'type type)))))
(defun update-record-content (record content)
(if (equalp (record-content record) content)
(id record)
(progn (setf (record-content record) content)
(update-dao record)
(id record))))
(defun insert-record (domain name type content)
(let ((domain-id (domain-id (get-domain domain))))
(insert-dao (make-instance 'dns-record
:domain-id domain-id
:name (format nil "~A.~A" name domain)
:type type
:content content))
t))
(defun insert-or-update-record (domain name type content)
(if-let ((record (car (get-records domain name type))))
(update-record-content record content)
(insert-record domain name type content)))
(defun replace-records (domain name type contents)
(let ((records (get-records domain name type)))
(if (set-difference contents (mapcar #'record-content records))
(with-transaction ()
(dolist (record records)
(delete-dao record))
(dolist (content contents)
(insert-record domain name type content)))
t)))
(defgeneric set-ipv4 (store domain name ip))
(defgeneric set-ipv6 (store domain name ip))
(defgeneric set-sshfp (store domain name sshfp))
(defmethod set-ipv4 ((store postgres-dns-store)
(domain string)
(name string)
(ip string))
(if (ipv4-p ip)
(insert-or-update-record domain name "A" ip)
(error :invalid-ip ip
:msg (format nil "not a valid v4 ip: ~A" ip))))
(defmethod set-ipv6 ((store postgres-dns-store)
(domain string)
(name string)
(ip string))
(if (ipv6-p ip)
(insert-or-update-record domain name "AAAA" ip)
(error :invalid-ip ip
:msg (format nil "not a valid v6 ip: ~A" ip))))
(defun sshfp-p (sshfp)
(let ((els (split-sequence:split-sequence #\Space sshfp)))
(if (not (= (length els) 3))
(error 'invalid-sshfp :sshfp sshfp)
(if (and (< 0 (parse-integer (car els)) 9)
(< 0 (parse-integer (cadr els)) 9)
(cl-ppcre:scan "^[A-Fa-f0-9]{32,256}$" (caddr els)))
sshfp
(error 'invalid-sshfp :sshfp sshfp)))))
(defmethod set-sshfp ((store postgres-dns-store)
(domain string)
(name string)
(sshfps list))
(if-let ((new-sshfps (mapcar #'sshfp-p sshfps)))
(replace-records domain name "SSHFP" new-sshfps)))