Add s-expression zone format
ober
48fa49d0b918833575b222deac9ee3a949f9bc38
--- a/README.md +++ b/README.md @@ -42,3 +42,31 @@ JDNS_REQUIRE_WASM_CDB=1 `jdns-data` writes a temporary CDB and atomically renames it into place. The server validates the CDB at startup, then reopens it per query so an atomic `data.cdb` replacement is visible without restarting the server. + +## Zone Formats + +`jdns-data` accepts the original tinydns `data` format and a grouped +s-expression format. The s-expression form starts with `(zone ...)`, so the +compiler auto-detects it: + +```scheme +(zone + (domain "example.com" + (soa "ns1.example.com" "1.2.3.4" 259200) + (ns "ns2.example.com" "1.2.3.5" 259200) + (a "1.2.3.4" 86400) + (mx "mail.example.com" 10 "1.2.3.6" 86400) + (txt "v=spf1 include:example.net mx -all" 86400)) + (domain "www.example.com" + (a+ptr "1.2.3.4" 86400)) + (domain "static.example.com" + (cname "www.example.com" 3600)) + (domain "ipv6.example.com" + (aaaa "2001:db8::1" 86400))) +``` + +Compile either format the same way: + +```sh +make jdns-data ARGS="zones/example.sexp data.cdb" +``` --- a/lib/jerboa-dns/zone-compiler.sls +++ b/lib/jerboa-dns/zone-compiler.sls @@ -1,9 +1,8 @@ #!chezscheme ;;; (jerboa-dns zone-compiler) — Zone file to CDB compiler ;;; -;;; Parses DJB-compatible zone file format and compiles to CDB. -;;; Line-based text format where each line's first character determines -;;; the record type. Atomic output via write-to-tmp + rename. +;;; Parses DJB-compatible zone files or jdns s-expression zone files and +;;; compiles to CDB. Atomic output via write-to-tmp + rename. (library (jerboa-dns zone-compiler) (export compile-zone-file! compile-zone-port!) @@ -288,6 +287,185 @@ [else (values full default-ttl)]))) + ;; ========== S-expression Zone Processing ========== + + (define (sexpr-type-name who x) + (cond + [(symbol? x) (string-downcase (symbol->string x))] + [(string? x) (string-downcase x)] + [else (error who "expected symbol or string" x)])) + + (define (sexpr-string who x) + (cond + [(string? x) x] + [(symbol? x) (symbol->string x)] + [else (error who "expected string or symbol" x)])) + + (define (sexpr->uint32 who x) + (let ([n (cond + [(integer? x) x] + [(string? x) (string->number x)] + [else #f])]) + (if (and n (integer? n) (>= n 0) (<= n #xffffffff)) + n + (error who "expected unsigned 32-bit integer" x)))) + + (define (sexpr->uint16 who x) + (let ([n (sexpr->uint32 who x)]) + (if (<= n #xffff) + n + (error who "expected unsigned 16-bit integer" x)))) + + (define (sexpr-uint32-datum? x) + (let ([n (cond + [(integer? x) x] + [(string? x) (string->number x)] + [else #f])]) + (and n (integer? n) (>= n 0) (<= n #xffffffff)))) + + (define (sexpr-split-ttl who args default-ttl) + (cond + [(null? args) (values '() default-ttl)] + [else + (let ([last (car (zone-last-pair args))]) + (if (sexpr-uint32-datum? last) + (values (zone-drop-last args) (sexpr->uint32 who last)) + (values args default-ttl)))])) + + (define (sexpr-require-arity who rec args min-count max-count) + (let ([n (length args)]) + (unless (and (>= n min-count) (<= n max-count)) + (error who "invalid record arity" rec)))) + + (define (process-sexpr-record! writer fqdn rec) + (unless (pair? rec) + (error 'process-sexpr-record! "record must be a list" rec)) + (let ([rtype (sexpr-type-name 'process-sexpr-record! (car rec))] + [args (cdr rec)]) + (cond + [(string=? rtype "soa") + (let-values ([(data ttl) (sexpr-split-ttl 'soa args TTL-NS)]) + (sexpr-require-arity 'soa rec data 1 2) + (add-soa-ns-record! writer fqdn + (if (= (length data) 2) (sexpr-string 'soa (cadr data)) "") + (sexpr-string 'soa (car data)) + ttl))] + + [(string=? rtype "ns") + (let-values ([(data ttl) (sexpr-split-ttl 'ns args TTL-NS)]) + (sexpr-require-arity 'ns rec data 1 2) + (add-ns-record! writer fqdn + (if (= (length data) 2) (sexpr-string 'ns (cadr data)) "") + (sexpr-string 'ns (car data)) + ttl))] + + [(string=? rtype "a") + (let-values ([(data ttl) (sexpr-split-ttl 'a args TTL-POSITIVE)]) + (sexpr-require-arity 'a rec data 1 1) + (add-a-record! writer fqdn (sexpr-string 'a (car data)) ttl))] + + [(or (string=? rtype "a+ptr") (string=? rtype "aptr")) + (let-values ([(data ttl) (sexpr-split-ttl 'a+ptr args TTL-POSITIVE)]) + (sexpr-require-arity 'a+ptr rec data 1 1) + (add-a-ptr-record! writer fqdn (sexpr-string 'a+ptr (car data)) ttl))] + + [(string=? rtype "mx") + (begin + (sexpr-require-arity 'mx rec args 1 4) + (let ([mx-name (sexpr-string 'mx (car args))] + [priority 10] + [ip ""] + [ttl TTL-POSITIVE] + [rest (cdr args)]) + (case (length rest) + [(0) (void)] + [(1) + (if (sexpr-uint32-datum? (car rest)) + (set! priority (sexpr->uint16 'mx (car rest))) + (set! ip (sexpr-string 'mx (car rest))))] + [(2) + (if (sexpr-uint32-datum? (car rest)) + (begin + (set! priority (sexpr->uint16 'mx (car rest))) + (if (sexpr-uint32-datum? (cadr rest)) + (set! ttl (sexpr->uint32 'mx (cadr rest))) + (set! ip (sexpr-string 'mx (cadr rest))))) + (begin + (set! ip (sexpr-string 'mx (car rest))) + (set! ttl (sexpr->uint32 'mx (cadr rest)))))] + [else + (set! priority (sexpr->uint16 'mx (car rest))) + (set! ip (sexpr-string 'mx (cadr rest))) + (set! ttl (sexpr->uint32 'mx (caddr rest)))]) + (add-mx-record! writer fqdn ip mx-name priority ttl)))] + + [(string=? rtype "cname") + (let-values ([(data ttl) (sexpr-split-ttl 'cname args TTL-POSITIVE)]) + (sexpr-require-arity 'cname rec data 1 1) + (add-cname-record! writer fqdn (sexpr-string 'cname (car data)) ttl))] + + [(string=? rtype "ptr") + (let-values ([(data ttl) (sexpr-split-ttl 'ptr args TTL-POSITIVE)]) + (sexpr-require-arity 'ptr rec data 1 1) + (add-ptr-record! writer fqdn (sexpr-string 'ptr (car data)) ttl))] + + [(string=? rtype "txt") + (let-values ([(data ttl) (sexpr-split-ttl 'txt args TTL-POSITIVE)]) + (sexpr-require-arity 'txt rec data 1 1) + (add-txt-record! writer fqdn (sexpr-string 'txt (car data)) ttl))] + + [(string=? rtype "aaaa") + (let-values ([(data ttl) (sexpr-split-ttl 'aaaa args TTL-POSITIVE)]) + (sexpr-require-arity 'aaaa rec data 1 1) + (add-aaaa-record! writer fqdn (sexpr-string 'aaaa (car data)) ttl))] + + [(or (string=? rtype "aaaa+ptr") (string=? rtype "aaaaptr")) + (let-values ([(data ttl) (sexpr-split-ttl 'aaaa+ptr args TTL-POSITIVE)]) + (sexpr-require-arity 'aaaa+ptr rec data 1 1) + (add-aaaa-ptr-record! writer fqdn (sexpr-string 'aaaa+ptr (car data)) ttl))] + + [else + (error 'process-sexpr-record! "unknown s-expression record type" rec)]))) + + (define (process-sexpr-domain! writer form) + (unless (and (pair? form) (>= (length form) 2)) + (error 'process-sexpr-domain! "domain form must be (domain name records ...)" form)) + (let ([fqdn (sexpr-string 'domain (cadr form))]) + (for-each + (lambda (rec) + (process-sexpr-record! writer fqdn rec)) + (cddr form)))) + + (define (process-sexpr-zone! writer datum) + (unless (and (pair? datum) + (string=? (sexpr-type-name 'process-sexpr-zone! (car datum)) "zone")) + (error 'process-sexpr-zone! "expected (zone ...)" datum)) + (for-each + (lambda (form) + (unless (and (pair? form) + (string=? (sexpr-type-name 'process-sexpr-zone! (car form)) "domain")) + (error 'process-sexpr-zone! "expected domain form" form)) + (process-sexpr-domain! writer form)) + (cdr datum))) + + (define (skip-line! port) + (let loop ([ch (read-char port)]) + (unless (or (eof-object? ch) (char=? ch #\newline)) + (loop (read-char port))))) + + (define (skip-leading-space-and-comments! port) + (let loop () + (let ([ch (peek-char port)]) + (cond + [(eof-object? ch) ch] + [(char-whitespace? ch) + (read-char port) + (loop)] + [(or (char=? ch #\;) (char=? ch #\#)) + (skip-line! port) + (loop)] + [else ch])))) + ;; ========== Line Processing ========== (define (process-zone-line! writer line) @@ -394,13 +572,16 @@ ;; Compile zone data from port to CDB file (let* ([tmp-path (string-append output-path ".tmp")] [writer (open-cdb-writer tmp-path)]) - (let loop () - (let ([line (get-line input-port)]) - (unless (eof-object? line) - (let ([trimmed (string-trim line)]) - (when (> (string-length trimmed) 0) - (process-zone-line! writer trimmed))) - (loop)))) + (let ([ch (skip-leading-space-and-comments! input-port)]) + (if (and (not (eof-object? ch)) (char=? ch #\()) + (process-sexpr-zone! writer (read input-port)) + (let loop () + (let ([line (get-line input-port)]) + (unless (eof-object? line) + (let ([trimmed (string-trim line)]) + (when (> (string-length trimmed) 0) + (process-zone-line! writer trimmed))) + (loop)))))) (cdb-finish! writer) ;; Chez/POSIX rename atomically replaces an existing output file. (rename-file tmp-path output-path))) --- a/tests/zone-compiler-test.ss +++ b/tests/zone-compiler-test.ss @@ -96,6 +96,59 @@ (cdb-reader-close! r)) +;; ========== S-expression Zone Format Tests ========== + +(call-with-output-file test-zone-path ; jerboa-security: suppress call-with-output-file-overwrite-fail + (lambda (p) + (display "(zone\n" p) + (display " (domain \"sexp.example\"\n" p) + (display " (soa \"ns1.sexp.example\" \"1.2.3.4\" 259200)\n" p) + (display " (ns \"ns2.sexp.example\" \"1.2.3.5\" 259200)\n" p) + (display " (a \"1.2.3.4\" 86400)\n" p) + (display " (mx \"mail.sexp.example\" 10 \"1.2.3.6\" 86400)\n" p) + (display " (txt \"v=spf1 include:example.net mx -all\" 86400))\n" p) + (display " (domain \"www.sexp.example\"\n" p) + (display " (a+ptr \"1.2.3.4\" 86400))\n" p) + (display " (domain \"static.sexp.example\"\n" p) + (display " (cname \"www.sexp.example\" 3600))\n" p) + (display " (domain \"v6.sexp.example\"\n" p) + (display " (aaaa \"2001:db8::2\" 86400)))\n" p)) + 'replace) +(compile-zone-file! test-zone-path test-cdb-path) +(let ([r (open-cdb-reader test-cdb-path)]) + (let* ([key (dns-domain-from-dot "sexp.example")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check-true (find-value vals DNS-T-SOA)) + (check-true (find-value vals DNS-T-NS)) + (check-true (find-value vals DNS-T-A)) + (check-true (find-value vals DNS-T-MX)) + (check-true (find-value vals DNS-T-TXT))) + (let* ([key (dns-domain-from-dot "www.sexp.example")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check-true (find-value vals DNS-T-A))) + (let* ([key (dns-domain-from-dot "static.sexp.example")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check-true (find-value vals DNS-T-CNAME))) + (let* ([key (dns-domain-from-dot "v6.sexp.example")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check-true (find-value vals DNS-T-AAAA))) + (cdb-reader-close! r)) + +;; Restore the original fixture for the lookup engine tests below. +(call-with-output-file test-zone-path ; jerboa-security: suppress call-with-output-file-overwrite-fail + (lambda (p) + (display ".example.com:1.2.3.4:ns1.example.com:259200\n" p) + (display "&example.com:1.2.3.5:ns2.example.com:259200\n" p) + (display "+example.com:1.2.3.4:86400\n" p) + (display "=www.example.com:1.2.3.4:86400\n" p) + (display "@example.com:1.2.3.6:mail.example.com:10:86400\n" p) + (display "Cstatic.example.com:www.example.com:86400\n" p) + (display "'example.com:v=spf1 mx -all:86400\n" p) + (display "3ipv6.example.com:20010db8000000000000000000000001:86400\n" p) + (display "+*.example.com:1.2.3.99:86400\n" p)) + 'replace) +(compile-zone-file! test-zone-path test-cdb-path) + ;; ========== Lookup Engine Tests ========== (let ([r (open-cdb-reader test-cdb-path)] new file mode 100644 --- /dev/null +++ b/zones/example.sexp @@ -0,0 +1,20 @@ +(zone + (domain "example.com" + (soa "a.ns.example.com" "93.184.216.34" 259200) + (ns "b.ns.example.com" "93.184.216.35" 259200) + (a "93.184.216.34" 86400) + (mx "mail.example.com" 10 "93.184.216.50" 86400) + (txt "v=spf1 mx -all" 86400)) + + (domain "api.example.com" + (a "93.184.216.40" 86400)) + + (domain "www.example.com" + (a+ptr "93.184.216.34" 86400) + (aaaa "2001:db8::1" 86400)) + + (domain "static.example.com" + (cname "www.example.com" 3600)) + + (domain "*.example.com" + (a "93.184.216.34" 86400)))