Enable FreeBSD fiber TCP builds
ober
375410f03f3b9fa722074b1990f239a0bbb79b3e
--- a/.jerbuild +++ b/.jerbuild @@ -11,7 +11,10 @@ (libdirs "lib") (ffi-symbols "support/ffi-symbols.gen") ;; Build the sandboxed DNS/CDB wasm payloads before embedding. -(pre-build "sh wasm/build.sh") +(pre-build "bash wasm/build.sh") +(os-libs + (Darwin "-lm -lpthread -lncurses -liconv") + (FreeBSD "-lm -lpthread -lncurses -L/usr/local/lib -liconv -lutil")) (rust-crates ("@bundle/jerboa-native-rs/Cargo.toml" features: "tls,crypto,wasm" new file mode 100644 --- /dev/null +++ b/.jerbuild-jdns-data @@ -0,0 +1,14 @@ +;; Build the standalone tinydns-data-compatible CDB compiler. + +(entry "bin/jdns-data.ss") +(output "jdns-data") +(libdirs "lib") +(ffi-symbols "support/ffi-symbols.gen") +(pre-build "bash wasm/build.sh") +(os-libs + (Darwin "-lm -lpthread -lncurses -liconv") + (FreeBSD "-lm -lpthread -lncurses -L/usr/local/lib -liconv -lutil")) +(rust-crates + ("@bundle/jerboa-native-rs/Cargo.toml" + features: "tls,crypto,wasm" + no-default-features: #t)) --- a/Makefile +++ b/Makefile @@ -32,7 +32,7 @@ all: binary # FFI symbol list from that archive and relink. A static main.c sets # JERBOA_STATIC=1 so the std modules use the registered symbols, not dlopen. binary: - @touch support/ffi-symbols.gen + @: > support/ffi-symbols.gen $(JERBUILD) build sh support/gen-ffi-symbols.sh $(JERBUILD) build --- a/lib/jerboa-dns/server.ss +++ b/lib/jerboa-dns/server.ss @@ -48,6 +48,9 @@ (jerboa-dns wasm-dns) (jerboa-dns log) (jerboa-dns cdb-cache) + (prefix (only (std fiber) + make-fiber-runtime fiber-spawn fiber-runtime-run! fiber-sleep) + builtin-fiber:) (only (std native-loader) native-loader-ensure-libc-symbol!)) ;; ========== Platform Detection ========== @@ -161,8 +164,8 @@ (def TCP-IO-TIMEOUT -2) (def DEFAULT-CDB-RELOAD-MS 1000) - ;; Loaded dynamically so static jdns binaries can still run without - ;; needing external Jerboa library files at startup. + ;; Fiber support is imported statically so standalone binaries include it; + ;; the state guard still lets startup fall back if initialization fails. (def *fiber-support-state* 'unknown) (def *make-fiber-runtime* #f) (def *fiber-spawn* #f) @@ -205,17 +208,14 @@ (log-info 'tcp_fibers_unavailable 'reason (condition-reason e)) #f]) - ;; Load (std fiber) directly into a fresh, isolated environment - ;; rather than importing into the global interaction-environment. - ;; (environment ...) raises if the module is unavailable, which the - ;; guard above turns into the 'unavailable state. Bindings are then - ;; read from that controlled environment, and the state flag is set - ;; only after every lookup succeeds. - (let ([env (environment '(std fiber))]) - (set! *make-fiber-runtime* (eval 'make-fiber-runtime env)) - (set! *fiber-spawn* (eval 'fiber-spawn env)) - (set! *fiber-runtime-run!* (eval 'fiber-runtime-run! env)) - (set! *fiber-sleep* (eval 'fiber-sleep env))) + ;; Bind from the prefixed static import. This keeps the standalone + ;; binary's dependency graph explicit, and the state flag is set only + ;; after every binding succeeds. + (begin + (set! *make-fiber-runtime* builtin-fiber:make-fiber-runtime) + (set! *fiber-spawn* builtin-fiber:fiber-spawn) + (set! *fiber-runtime-run!* builtin-fiber:fiber-runtime-run!) + (set! *fiber-sleep* builtin-fiber:fiber-sleep)) (set! *fiber-support-state* 'available) #t)])) --- a/lib/jerboa-dns/zone-compiler.ss +++ b/lib/jerboa-dns/zone-compiler.ss @@ -70,14 +70,27 @@ ;; ========== Record Type Handlers ========== + (def (numeric-dotted-ip? ip-str) + (and (> (string-length ip-str) 0) + (let loop ([i 0]) + (cond + [(= i (string-length ip-str)) #t] + [else + (let ([ch (string-ref ip-str i)]) + (and (or (char=? ch #\.) (char-numeric? ch)) + (loop (+ i 1))))])))) + (def (add-a-record! writer fqdn ip-str ttl) - ;; + record: A only + ;; + record: A only. djbdns/tinydns-data ignores malformed numeric + ;; dotted addresses like 166.84.7; keep doing that for legacy data. (let ([key (make-cdb-key fqdn)] [ip (ip4-from-string ip-str)]) - (unless ip - (error 'add-a-record! "invalid IPv4 address" fqdn ip-str)) - (let ([val (make-cdb-value DNS-T-A CDB-FLAG-NORMAL ttl ip)]) - (cdb-add! writer key (bytevector-length key) val (bytevector-length val))))) + (cond + [ip + (let ([val (make-cdb-value DNS-T-A CDB-FLAG-NORMAL ttl ip)]) + (cdb-add! writer key (bytevector-length key) val (bytevector-length val)))] + [(numeric-dotted-ip? ip-str) (void)] + [else (error 'add-a-record! "invalid IPv4 address" fqdn ip-str)]))) (def (add-a-ptr-record! writer fqdn ip-str ttl) ;; = record: A + PTR @@ -209,6 +222,48 @@ (bytevector-copy! text-bytes src rdata (+ dst 1) chunk) (loop (+ src chunk) (+ dst 1 chunk) (- remaining chunk)))])))) + (def (octal-digit? ch) + (let ([n (char->integer ch)]) + (and (>= n (char->integer #\0)) + (<= n (char->integer #\7))))) + + (def (octal-digit-value ch) + (- (char->integer ch) (char->integer #\0))) + + (def (tinydns-raw-rdata text) + ;; Generic ':' records carry wire-format RDATA with tinydns octal + ;; escapes, e.g. \051 for a TXT segment length byte. + (let* ([len (string-length text)] + [buf (make-bytevector len 0)]) + (let loop ([i 0] [out 0]) + (cond + [(>= i len) + (let ([result (make-bytevector out 0)]) + (bytevector-copy! buf 0 result 0 out) + result)] + [(and (char=? (string-ref text i) #\\) + (< (+ i 3) len) + (octal-digit? (string-ref text (+ i 1))) + (octal-digit? (string-ref text (+ i 2))) + (octal-digit? (string-ref text (+ i 3)))) + (bytevector-u8-set! + buf out + (+ (* 64 (octal-digit-value (string-ref text (+ i 1)))) + (* 8 (octal-digit-value (string-ref text (+ i 2)))) + (octal-digit-value (string-ref text (+ i 3))))) + (loop (+ i 4) (+ out 1))] + [else + (let ([ch (string-ref text i)]) + (bytevector-u8-set! buf out (bitwise-and (char->integer ch) #xff)) + (loop (+ i 1) (+ out 1)))])))) + + (def (add-generic-record! writer fqdn rtype raw-rdata ttl) + (let* ([key (make-cdb-key fqdn)] + [rdata (tinydns-raw-rdata raw-rdata)] + [val (make-cdb-value rtype CDB-FLAG-NORMAL ttl rdata)]) + (cdb-add! writer key (bytevector-length key) + val (bytevector-length val)))) + (def (add-aaaa-record! writer fqdn ip6-str ttl) ;; 3 record: AAAA only (let ([key (make-cdb-key fqdn)] @@ -258,6 +313,20 @@ [(null? (cdr lst)) '()] [else (cons (car lst) (zone-drop-last (cdr lst)))])) + (def (tail-text+ttl fields start-idx default-ttl) + ;; Text/raw-data fields may contain colons. Treat the last field as TTL + ;; only when it is a valid unsigned integer and text remains before it. + (let* ([parts (list-tail fields start-idx)] + [last (and (pair? parts) (car (zone-last-pair parts)))] + [ttl (and last (string->number last))]) + (cond + [(null? parts) (values "" default-ttl)] + [(and (> (length parts) 1) + ttl (integer? ttl) (>= ttl 0) (<= ttl #xffffffff)) + (values (string-join (zone-drop-last parts) ":") ttl)] + [else + (values (string-join parts ":") default-ttl)]))) + (def (tail-data+ttl fields start-idx default-ttl) ;; For fields whose data may contain colons, treat the last field as ;; TTL only when removing it leaves a valid IPv6 address and the full @@ -541,11 +610,18 @@ ;; ' = TXT [(#\') + (let ([fqdn (field-ref fields 0 "")]) + (let-values ([(text ttl) (tail-text+ttl fields 1 TTL-POSITIVE)]) + (when (and (not (string=? fqdn "")) (not (string=? text ""))) + (add-txt-record! writer fqdn text ttl))))] + + ;; : = generic raw RDATA + [(#\:) (let ([fqdn (field-ref fields 0 "")] - [text (field-ref fields 1 "")] - [ttl (field->int fields 2 TTL-POSITIVE)]) - (when (and (not (string=? fqdn "")) (not (string=? text ""))) - (add-txt-record! writer fqdn text ttl)))] + [rtype (field->uint16 fields 1 0)]) + (let-values ([(raw-rdata ttl) (tail-text+ttl fields 2 TTL-POSITIVE)]) + (when (and (not (string=? fqdn "")) (> rtype 0)) + (add-generic-record! writer fqdn rtype raw-rdata ttl))))] ;; 3 = AAAA [(#\3) --- a/support/gen-ffi-symbols.sh +++ b/support/gen-ffi-symbols.sh @@ -5,7 +5,8 @@ # present for THIS platform + feature set (e.g. epoll on Linux, kqueue on # macOS). The output is .gitignored — it is a build artifact, not source. set -e -JH="$(jerbuild --jerboa-home 2>/dev/null)" +JERBUILD_BIN="${JERBUILD:-jerbuild}" +JH="$("$JERBUILD_BIN" --jerboa-home 2>/dev/null)" A="$JH/jerboa-native-rs/target/release/libjerboa_native.a" OUT="$(dirname "$0")/ffi-symbols.gen" if [ ! -f "$A" ]; then --- a/tests/zone-compiler-test.ss +++ b/tests/zone-compiler-test.ss @@ -65,9 +65,12 @@ (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 "+badnum.example.com:166.84.7\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 "'colon.example.com:rua=mailto:me@example.com\n" p) + (display ":generic.example.com:16:\\010hello\\072mx:60\n" p) (display "3ipv6.example.com:20010db8000000000000000000000001:86400\n" p) (display "+*.example.com:1.2.3.99:86400\n" p))) @@ -92,6 +95,11 @@ [vals (cdb-find-all r key 0 (bytevector-length key))]) (check-true (> (length vals) 0))) + ;; Legacy malformed numeric A data compiles but does not emit a record. + (let* ([key (dns-domain-from-dot "badnum.example.com")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check (length vals) => 0)) + ;; CNAME for static.example.com (let* ([key (dns-domain-from-dot "static.example.com")] [vals (cdb-find-all r key 0 (bytevector-length key))]) @@ -102,6 +110,20 @@ [vals (cdb-find-all r key 0 (bytevector-length key))]) (check-true (> (length vals) 0))) + ;; TXT records may contain literal colons and omit TTL. + (let* ([key (dns-domain-from-dot "colon.example.com")] + [vals (cdb-find-all r key 0 (bytevector-length key))]) + (check-true (find-value vals DNS-T-TXT))) + + ;; Generic ':' TXT record keeps raw wire-format RDATA. + (let* ([key (dns-domain-from-dot "generic.example.com")] + [vals (cdb-find-all r key 0 (bytevector-length key))] + [val (find-value vals DNS-T-TXT)]) + (check-true val) + (check (bytevector-length val) => 16) + (check (bytevector-u8-ref val 7) => 8) + (check (bytevector-u8-ref val 13) => (char->integer #\:))) + (cdb-reader-close! r)) ;; ========== S-expression Zone Format Tests ========== @@ -152,9 +174,12 @@ (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 "+badnum.example.com:166.84.7\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 "'colon.example.com:rua=mailto:me@example.com\n" p) + (display ":generic.example.com:16:\\010hello\\072mx:60\n" p) (display "3ipv6.example.com:20010db8000000000000000000000001:86400\n" p) (display "+*.example.com:1.2.3.99:86400\n" p))) (compile-zone-file! test-zone-path test-cdb-path)