Browse Source

Refactored for testability.

Factored out storage into a separate package, and added tests.
master
Niten 1 year ago
parent
commit
fdb04c90f1
  1. 142
      backplane-dns-store.lisp
  2. 33
      backplane-dns.asd
  3. 303
      backplane-dns.lisp
  4. 40
      package.lisp
  5. 161
      test/backplane-dns-test.lisp

142
backplane-dns-store.lisp

@ -0,0 +1,142 @@
(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 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 (select-dao 'dns-domain (:= 'name domain))))
domain
(error 'domain-name-missing :domain domain)))
(defun get-records (domain name type)
(let ((domain-id (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 (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)))

33
backplane-dns.asd

@ -3,15 +3,40 @@
(asdf:defsystem #:backplane-dns
:description "Server to listen on Fudo backplane for DNS updates"
:author "Niten <niten@fudo.org>"
:license "Specify license here"
:version "0.1.0"
:serial t
:depends-on (:alexandria
:arrows
:backplane-dns-store
:backplane-server
:cl-ppcre)
:components ((:file "package")
(:file "backplane-dns"))
:in-order-to ((test-op (test-op :backplane-dns/test))))
(asdf:defsystem #:backplane-dns-store
:description "Storage for Fudo DNS backplane"
:author "Niten <niten@fudo.org>"
:version "0.1.0"
:serial t
:depends-on (:alexandria
:arrows
:cl-ppcre
:ip-utils
:postmodern
:trivia)
:postmodern)
:components ((:file "package")
(:file "backplane-dns")))
(:file "backplane-dns-store")))
(asdf:defsystem #:backplane-dns/test
:description "XMPP Backplane DNS Server Tests"
:author "Niten <niten@fudo.org>"
:depends-on (:arrows
:backplane-dns
:ip-utils
:prove)
:defsystem-depends-on (:prove-asdf)
:components ((:module "test"
:serial t
:components ((:test-file "backplane-dns-test"))))
:perform (asdf:test-op (op c)
(uiop:symbol-call :prove '#:run '#:backplane-dns/test)))

303
backplane-dns.lisp

@ -2,21 +2,15 @@
(in-package #:backplane-dns)
(defun getenv-or-fail (env-var &optional default)
(let ((value (uiop:getenv env-var)))
(if (null value)
(if default
default
(uiop:die 1 "unable to find required env var: ~A" env-var))
value)))
(defvar *dns-store* nil)
(defun symbolize (str) (-> str string-upcase (intern :KEYWORD)))
(defclass dns-request ()
((hostname :initarg :hostname)
(domain :initarg :domain)
(sender :initarg :sender)
(msg-id :initarg :msg-id)))
(msg-id :initarg :msg-id
:reader msg-id)))
(defclass request-change-ipv4 (dns-request)
((ip-address :initarg :ip-address)))
@ -28,139 +22,17 @@
((sshfp :initarg :sshfp)))
(defclass unknown-dns-request (dns-request)
((request-type :initarg :request-type)))
(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 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))
((request-type :initarg :request-type
:reader request-type)))
(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 get-domain (name)
(car (select-dao 'dns-domain (:= 'name name))))
(define-condition backplane-dns-error (error) ())
(define-condition domain-name-missing (backplane-dns-error)
((missing-domain :initarg :domain :reader missing-domain)))
(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)
(id))))
(select-dao 'dns-record
(:and (:= 'name (format nil "~A.~A" host domain))
(:= 'domain-id domain-id)
(:= 'type type)))
(error 'domain-name-missing :domain domain)))
(defun consider-update-content (record content)
(if (equalp (record-content record) content)
t
(progn (setf (record-content record) content)
(update-dao 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))))
(insert-dao (make-instance 'dns-record
:domain-id domain-id
:name (format nil "~A.~A" host domain)
:type type
:content content))))))
(defun set-host-v4ip (host domain v4ip)
(if (not (ipv4-p v4ip))
(error 'invalid-ipv4 :ip v4ip)
(update-host-record-by-type host domain "A" v4ip)))
(define-condition backplane-dns-error (error)
((msg :initarg :msg :initform nil :reader error-msg)))
(defun set-host-v6ip (host domain v6ip)
(if (not (ipv6-p v6ip))
(error 'invalid-ipv6 :ip v6ip)
(update-host-record-by-type host domain "AAAA" v6ip)))
(defun validate-sshfp (sshfp)
(let ((els (split-string 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
nil))))
(defun set-host-sshfp (host domain incoming-sshfps)
(if-let ((domain-id (some-> domain
(get-domain)
(id))))
(let* ((new-sshfps (mapcar #'validate-sshfp incoming-sshfps))
(full-hostname (format nil "~A.~A" host domain))
(sshfp-records (select-dao 'dns-record
(:and (:= 'name full-hostname)
(:= 'domain-id domain-id)
(:= 'type "SSHFP"))))
(existing-sshfps (mapcar #'record-content sshfp-records)))
(if (not (set-difference new-sshfps existing-sshfps))
t
(with-transaction ()
(dolist (record sshfp-records)
(delete-dao record))
(dolist (sshfp new-sshfps)
(insert-dao
(make-instance 'dns-record
:domain-id domain-id
:name full-hostname
:type "SSHFP"
:content sshfp))))))
(error 'domain-name-missing :domain domain)))
(defun split-string (string &optional (char #\Space))
(split-sequence:split-sequence char string))
(define-condition invalid-hostname (backplane-dns-error)
((hostname :initarg :hostname :reader invalid-hostname)))
(let ((hostname-extractor-rx
(cl-ppcre:create-scanner
@ -169,79 +41,73 @@
#\@
(:REGEX ,*hostname-rx*) :END-ANCHOR))))
(defun sender-hostname (sender)
(cl-ppcre:register-groups-bind (hostname nil)
(hostname-extractor-rx sender)
hostname)))
(defmethod backplane-server:handle-message ((message request-change-sshfp))
(with-slots (hostname domain sshfp msg-id) message
(if (not (listp sshfp))
(make-error :msg (format nil "expected list of sshfp records, got: ~A" sshfp)
:msg-id msg-id)
(handler-case
(progn (set-host-sshfp hostname domain sshfp)
(make-success :msg (format nil "set ssh fingerprints for host ~A in domain ~A"
hostname domain)
:msg-id msg-id))
(invalid-sshfp (err)
(make-error :msg (format nil "bad sshfp for host ~A: ~A"
hostname
(sshfp err))))
(domain-name-missing (err)
(make-error :msg (format nil "missing domain name: ~A"
(missing-domain err))
:msg-id msg-id))
(error (text)
(make-error :msg (format nil "unknown error setting host ssh fingerprints: ~A"
text)
:msg-id msg-id))))))
(defmethod backplane-server:handle-message ((message request-change-ipv4))
(with-slots (hostname domain ip-address msg-id) message
(handler-case
(progn (set-host-v4ip 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))
(invalid-ip (err)
(declare (ignorable err))
(make-error :msg (format nil "invalid ipv4: ~A" 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 :msg (format nil "unknown error setting host v4ip: ~A"
text)
:msg-id msg-id)))))
(defmethod backplane-server:handle-message ((message request-change-ipv6))
(with-slots (hostname domain ip-address msg-id) message
(handler-case
(progn (set-host-v6ip 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))
(invalid-ip (err)
(declare (ignorable err))
(make-error :msg (format nil "invalid ipv6: ~A" 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 :msg (format nil "unknown error setting host v6ip: ~A"
text)
:msg-id msg-id)))))
(if-let ((hostname (cl-ppcre:register-groups-bind (extracted-hostname nil)
(hostname-extractor-rx sender)
extracted-hostname)))
hostname
(error 'invalid-hostname
:hostname sender
:msg (format nil "unable to extract hostname from ~A, expecting format host-<hostname>"
sender)))))
(defmethod backplane-server:handle-message ((message dns-request))
(handler-case
(if-let ((store *dns-store*))
(-> message
(handle-dns-message store)
(handle-dns-response (msg-id message)))
(make-error :msg "dns store is not initialized"
:msg-id (msg-id message)))
(domain-name-missing (err)
(make-error :msg (format nil "missing domain name: ~A"
(missing-domain err))
:msg-id (msg-id message)))
(invalid-ip (err)
(make-error :msg (error-msg err)
:msg-id (msg-id message)))
(invalid-sshfp (err)
(make-error :msg (format nil "invalid ssh fingerprint: ~A"
(invalid-sshfp err))
:msg-id (msg-id message)))
(error (e)
(declare (ignorable e))
(make-error :msg (format nil "an unknown error occurred: ~A"
e)
:msg-id (msg-id message)))))
(defgeneric handle-dns-message (message store))
(defmethod handle-dns-message ((message request-change-ipv4) store)
(with-slots (hostname domain ip-address) message
(backplane-dns-store:set-ipv4 store domain hostname ip-address)
(make-instance 'dns-success
:msg (format nil "successfully set ipv4 for ~A.~A to ~A"
hostname domain ip-address))))
(defmethod handle-dns-message ((message request-change-ipv6) store)
(with-slots (hostname domain ip-address) message
(backplane-dns-store:set-ipv6 store domain hostname ip-address)
(make-instance 'dns-success
:msg (format nil "successfully set ipv6 for ~A.~A to ~A"
hostname domain ip-address))))
(defmethod handle-dns-message ((message request-change-sshfp) store)
(with-slots (hostname domain sshfp) message
(backplane-dns-store:set-sshfp store domain hostname sshfp)
(make-instance 'dns-success
:msg (format nil "successfully set sshfps for ~A.~A"
hostname domain))))
(defmethod handle-dns-message ((message unknown-dns-request) store)
(make-instance 'dns-error
:msg (format nil "unknown request to the dns service: ~A"
(request-type 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 msg-id)
(make-instance 'request-change-ipv4
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
:ip-address (cdr (assoc :IP message))
@ -249,7 +115,6 @@
(defmethod parse-dns-message (sender (request (eql :CHANGE_IPV6)) message msg-id)
(make-instance 'request-change-ipv6
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
:ip-address (cdr (assoc :IP message))
@ -257,21 +122,30 @@
(defmethod parse-dns-message (sender (request (eql :CHANGE_SSHFP)) message msg-id)
(make-instance 'request-change-sshfp
:sender sender
:hostname (sender-hostname sender)
:domain (cdr (assoc :DOMAIN message))
:sshfp (cdr (assoc :SSHFP message))
:msg-id msg-id))
(defmethod parse-dns-message (sender request message msg-id)
(make-instance 'unknown-request
:sender sender
(make-instance 'unknown-dns-request
:request-type request
:msg-id msg-id))
(defmethod backplane-server:parse-message (sender (service (eql :DNS)) api-version message msg-id)
(parse-dns-message sender (symbolize (cdr (assoc :REQUEST message))) message msg-id))
(defclass dns-response ()
((msg :initarg :msg :reader msg)))
(defclass dns-success (dns-response) ())
(defclass dns-error (dns-response) ())
(defgeneric handle-dns-response (resp msg-id))
(defmethod handle-dns-response ((resp dns-success) msg-id)
(make-success :msg (msg resp) :msg-id msg-id))
(defmethod handle-dns-response ((resp dns-error) msg-id)
(make-error :msg (msg resp) :msg-id msg-id))
(defun backplane-dns-listen (&key
xmpp-host
xmpp-username
@ -281,10 +155,11 @@
db-username
db-password)
(let ((postmodern:*ignore-unknown-columns* t)
(cl-postgres:*query-log* *standard-output*))
(cl-postgres:*query-log* *standard-output*)
(*dns-store* (make-instance 'backplane-dns-store:postgres-dns-store)))
(postmodern:with-connection (list db-name db-username db-password db-host)
(with-backplane (backplane (backplane-connect xmpp-host xmpp-username xmpp-password))
(xmpp:receive-stanza-loop backplane)))))
(start-listening backplane)))))
(defun read-file-line (filename)
(let ((input (open filename :if-does-not-exist nil)))
@ -292,6 +167,14 @@
(read-line input)
(uiop:die 1 "unable to read file: ~A" filename))))
(defun getenv-or-fail (env-var &optional default)
(let ((value (uiop:getenv env-var)))
(if (null value)
(if default
default
(uiop:die 1 "unable to find required env var: ~A" env-var))
value)))
(defun start-listener-with-env ()
(backplane-dns-listen
:xmpp-host (getenv-or-fail "FUDO_DNS_BACKPLANE_XMPP_HOSTNAME")

40
package.lisp

@ -12,18 +12,48 @@
#:backplane-connect
#:make-error
#:make-success
#:start-listening
#:with-backplane)
(:import-from #:backplane-dns-store
#:invalid-sshfp
#:missing-domain
#:invalid-ip
#:domain-name-missing
#:error-msg)
(:export #:start-listener-with-env
#:backplane-dns-listen
#:parse-message
#:handle-message
#:unknown-dns-request
#:request-change-ipv4
#:request-change-ipv6
#:request-change-sshfp
#:*dns-store*))
(defpackage #:backplane-dns-store
(:use #:cl)
(:import-from #:arrows #:->)
(:import-from #:alexandria #:if-let)
(:import-from #:ip-utils
#:ipv4-p
#:ipv6-p)
(:import-from #:postmodern
#:get-dao
#:select-dao
#:update-dao
#:insert-dao
#:delete-dao
#:with-transaction)
(:export #:start-listener-with-env
#:backplane-dns-listen
#:parse-message))
(:export #:set-ipv4
#:set-ipv6
#:set-sshfp
#:postgres-dns-store
#:invalid-ip
#:invalid-sshfp
#:domain-name-missing
#:missing-domain
#:dns-store
#:sshfp-p
#:error-msg))

161
test/backplane-dns-test.lisp

@ -0,0 +1,161 @@
;;;; backplane-dns-test.lisp
(defpackage #:backplane-dns/test
(:use #:cl
#:backplane-dns
#:prove)
(:import-from #:arrows
#:->)
(:import-from #:ip-utils
#:ipv4-p #:ipv6-p))
(in-package #:backplane-dns/test)
(plan 20)
(defun ipv4-body (ip &key (domain "test.org"))
`((:REQUEST . "change_ipv4")
(:DOMAIN . ,domain)
(:IP . ,ip)))
(defun ipv6-body (ip &key (domain "test.org"))
`((:REQUEST . "change_ipv6")
(:DOMAIN . ,domain)
(:IP . ,ip)))
(defun sshfp-body (sshfps &key (domain "test.org"))
`((:REQUEST . "change_sshfp")
(:DOMAIN . ,domain)
(:SSHFP . ,sshfps)))
(defun parse-request (body &key
(sender "host-tester@backplane.test")
(api-version "1")
(msg-id "1"))
(backplane-server:parse-message sender :DNS api-version body msg-id))
(is-type (parse-request '())
'backplane-dns:unknown-dns-request)
(is-type (parse-request '((:REQUEST . "oops")))
'backplane-dns:unknown-dns-request)
(is-type (parse-request (ipv4-body "1.1.1.1"))
'backplane-dns:request-change-ipv4)
(is-type (parse-request (ipv6-body "a::3"))
'backplane-dns:request-change-ipv6)
(is-type (parse-request (sshfp-body (list "123")))
'backplane-dns:request-change-sshfp)
(defclass simple-test-store (backplane-dns-store:dns-store)
((ops :initform '() :reader ops)))
(defmethod backplane-dns-store:set-ipv4 ((store simple-test-store) domain name ip)
(with-slots (ops) store
(setf ops (cons (cons :set-ipv4 ip) ops))
t))
(defmethod backplane-dns-store:set-ipv6 ((store simple-test-store) domain name ip)
(with-slots (ops) store
(setf ops (cons (cons :set-ipv6 ip) ops))
t))
(defmethod backplane-dns-store:set-sshfp ((store simple-test-store) domain name sshfp)
(with-slots (ops) store
(setf ops (cons (cons :set-sshfp sshfp) ops))
t))
(is-type (let ((backplane-dns:*dns-store* (make-instance 'simple-test-store)))
(backplane-server:handle-message (parse-request (ipv4-body "1.1.1.1"))))
'backplane-server:result/success)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'simple-test-store)))
(backplane-server:handle-message (parse-request (ipv6-body "1:1::1"))))
'backplane-server:result/success)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'simple-test-store)))
(backplane-server:handle-message (parse-request (sshfp-body '("fake-key")))))
'backplane-server:result/success)
(let ((backplane-dns:*dns-store* (make-instance 'simple-test-store))
(ip "1.1.1.1"))
(is (progn (backplane-server:handle-message (parse-request (ipv4-body ip)))
(car (ops backplane-dns:*dns-store*)))
(cons :set-ipv4 ip)))
(let ((backplane-dns:*dns-store* (make-instance 'simple-test-store))
(ip "aa::1"))
(is (progn (backplane-server:handle-message (parse-request (ipv6-body ip)))
(car (ops backplane-dns:*dns-store*)))
(cons :set-ipv6 ip)))
(let ((backplane-dns:*dns-store* (make-instance 'simple-test-store))
(sshfp '("1 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))
(is (progn (backplane-server:handle-message (parse-request (sshfp-body sshfp)))
(car (ops backplane-dns:*dns-store*)))
(cons :set-sshfp sshfp)))
(defclass verifying-test-store (backplane-dns-store:dns-store)
((ops :initform '() :reader ops)))
(defmethod backplane-dns-store:set-ipv4 ((store verifying-test-store) domain name ip)
(if (not (ipv4-p ip))
(error 'backplane-dns-store:invalid-ip
:msg "invalid ipv4")
(with-slots (ops) store
(setf ops (cons (cons :set-ipv4 ip) ops))
t)))
(defmethod backplane-dns-store:set-ipv6 ((store verifying-test-store) domain name ip)
(if (not (ipv6-p ip))
(error 'backplane-dns-store:invalid-ip
:msg "invalid ipv6")
(with-slots (ops) store
(setf ops (cons (cons :set-ipv6 ip) ops))
t)))
(defmethod backplane-dns-store:set-sshfp ((store verifying-test-store) domain name sshfp)
(let ((new-sshfp (mapcar #'backplane-dns-store:sshfp-p sshfp)))
(with-slots (ops) store
(setf ops (cons (cons :set-sshfp new-sshfp) ops))
t)))
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (ipv4-body "1.1.1.1"))))
'backplane-server:result/success)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (ipv6-body "1:1::1"))))
'backplane-server:result/success)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (sshfp-body '("1 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
'backplane-server:result/success)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (ipv4-body "1.1:1.1"))))
'backplane-server:result/error)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (ipv6-body "1:1.:1"))))
'backplane-server:result/error)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (sshfp-body '("oops")))))
'backplane-server:result/error)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (sshfp-body '("1 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
'backplane-server:result/error)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (sshfp-body '("10 2 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
'backplane-server:result/error)
(is-type (let ((backplane-dns:*dns-store* (make-instance 'verifying-test-store)))
(backplane-server:handle-message (parse-request (sshfp-body '("1 0 aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")))))
'backplane-server:result/error)
(finalize)
Loading…
Cancel
Save