162 lines
6.2 KiB
Common Lisp
162 lines
6.2 KiB
Common Lisp
;;;; 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)
|