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

Properly depend on backplane-server and ip-utils

Browse Source
This commit is contained in:
niten
2020-11-24 11:51:03 -08:00
parent c552394e55
commit d9e13bae16
4 changed files with 24 additions and 208 deletions
Download Patch File Download Diff File Expand all files Collapse all files
backplane-dns.lisp
+11 -63
View File
@@ -10,6 +10,8 @@
(uiop:die 1 "unable to find required env var: ~A" env-var))
value)))
(defun symbolize (str) (-> str string-upcase (intern :KEYWORD)))
(defclass dns-record ()
((id :col-type integer
:col-identity t
@@ -66,76 +68,22 @@
(defparameter *hostname-rx*
"(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9\-]*[A-Za-z0-9])")
(defun ipv4-elements (str)
(handler-case
(mapcar #'parse-integer (split-string str #\.))
(sb-int:simple-parse-error (_)
(declare (ignorable _)) nil)))
(defun ipv4-p (str)
(let ((iplst (ipv4-elements str)))
(and (= (length iplst) 4)
(every (lambda (n) (<= 0 n 255))
iplst))))
(defun ipv4 (str)
(if (not (ipv4-p str))
nil
(let ((els (ipv4-elements str)))
(loop for el in (reverse els)
for i from 0 to (length els)
sum (ash el (* i 8)) into total
finally (return total)))))
(defun ipv6-elements (str)
(flet ((split-bytes (str) (split-string str #\:))
(parse-hex (str) (if (equal str "") 0 (parse-integer str :radix 16))))
(let ((parts (mapcar #'split-bytes (cl-ppcre:split "::"
(cl-ppcre:regex-replace "::$"
str
"::0")))))
(trivia:match parts
((list only) (mapcar #'parse-hex only))
((list first last) (let ((middle (make-list
(- 8 (length first)
(length last))
:initial-element "0")))
(mapcar #'parse-hex (append first middle last))))
(_ nil)))))
(defun ipv6 (str)
(let ((els (ipv6-elements str)))
(if (/= 8 (length els))
nil
(loop for el in (reverse els)
for i from 0 to (length els)
sum (ash el (* i 16)) into total
finally (return total)))))
(defun ipv6-p (str)
(handler-case
(ipv6 str)
(sb-int:simple-parse-error (e)
(declare (ignorable e))
nil)))
(defun get-domain (name)
(car (select-dao 'dns-domain (:= 'name name))))
(define-condition domain-name-missing (error)
(define-condition backplane-dns-error (error) ())
(define-condition domain-name-missing (backplane-dns-error)
((missing-domain :initarg :domain :reader missing-domain)))
(define-condition invalid-ip (error)
((ip :initarg :ip)))
(define-condition invalid-ipv4 (invalid-ip) ())
(define-condition invalid-ipv6 (invalid-ip) ())
(define-condition invalid-sshfp (error)
(define-condition invalid-sshfp (backplane-dns-error)
((sshfp :initarg :sshfp
:reader sshfp)))
(define-condition invalid-ip (backplane-dns-error)
((ip :initarg :ip
:reader ip)))
(defun find-host-records-by-type (host domain type)
(if-let ((domain-id (some-> domain
(get-domain)
@@ -332,7 +280,7 @@
(let ((postmodern:*ignore-unknown-columns* t)
(cl-postgres:*query-log* *standard-output*))
(postmodern:with-connection (list db-name db-username db-password db-host)
(let ((backplane (backplane-connect xmpp-host xmpp-username xmpp-password)))
(with-backplane (backplane (backplane-connect xmpp-host xmpp-username xmpp-password))
(xmpp:receive-stanza-loop backplane)))))
(defun read-file-line (filename)