Support relative TXT owners in sexp zones
ober
8d323798d0099dd92deb857fb5064ad99c545878
--- a/README.md +++ b/README.md @@ -56,7 +56,8 @@ compiler auto-detects it: (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)) + (txt "v=spf1 include:example.net mx -all" 86400) + (txt "_dmarc" "v=DMARC1; p=none" 86400)) (domain "www.example.com" (a+ptr "1.2.3.4" 86400)) (domain "static.example.com" @@ -65,6 +66,10 @@ compiler auto-detects it: (aaaa "2001:db8::1" 86400))) ``` +TXT records can optionally start with a relative owner name. For example, +`(txt "_dmarc" "v=DMARC1; p=none")` inside `example.com` compiles as a TXT +record for `_dmarc.example.com`. + Compile either format the same way: ```sh --- a/lib/jerboa-dns/zone-compiler.sls +++ b/lib/jerboa-dns/zone-compiler.sls @@ -337,6 +337,12 @@ (unless (and (>= n min-count) (<= n max-count)) (error who "invalid record arity" rec)))) + (define (sexpr-relative-fqdn owner fqdn) + (let ([owner (sexpr-string 'txt owner)]) + (if (string=? owner "@") + fqdn + (string-append owner "." fqdn)))) + (define (process-sexpr-record! writer fqdn rec) (unless (pair? rec) (error 'process-sexpr-record! "record must be a list" rec)) @@ -411,8 +417,13 @@ [(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))] + (sexpr-require-arity 'txt rec data 1 2) + (if (= (length data) 1) + (add-txt-record! writer fqdn (sexpr-string 'txt (car data)) ttl) + (add-txt-record! writer + (sexpr-relative-fqdn (car data) fqdn) + (sexpr-string 'txt (cadr data)) + ttl)))] [(string=? rtype "aaaa") (let-values ([(data ttl) (sexpr-split-ttl 'aaaa args TTL-POSITIVE)]) --- a/tests/zone-compiler-test.ss +++ b/tests/zone-compiler-test.ss @@ -106,7 +106,8 @@ (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 " (txt \"v=spf1 include:example.net mx -all\" 86400)\n" p) + (display " (txt \"_dmarc\" \"v=DMARC1; p=none\" 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) @@ -132,6 +133,9 @@ (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))) + (let* ([key (dns-domain-from-dot "_dmarc.sexp.example")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check-true (find-value vals DNS-T-TXT))) (cdb-reader-close! r)) ;; Restore the original fixture for the lookup engine tests below. --- a/zones/example.sexp +++ b/zones/example.sexp @@ -4,7 +4,8 @@ (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)) + (txt "v=spf1 mx -all" 86400) + (txt "_dmarc" "v=DMARC1; p=none" 86400)) (domain "api.example.com" (a "93.184.216.40" 86400))