Add TCP DNS query handling
ober
26ed08b79ac3459131a4cf76901fa677e9e31486
--- a/README.md +++ b/README.md @@ -1,6 +1,7 @@ # jerboa-dns -Authoritative-only UDP DNS server and zone compiler in Jerboa/Chez Scheme. +Authoritative-only DNS server and zone compiler in Jerboa/Chez Scheme. +`jdns` serves both UDP and TCP DNS on the configured port. ## Build and Test @@ -17,7 +18,7 @@ make static-freebsd ## Runtime Security Defaults -`jdns` binds the UDP socket first, then chroots to `ROOT` (default `.`), drops +`jdns` binds the UDP and TCP sockets first, then chroots to `ROOT` (default `.`), drops supplementary groups with `setgroups(0, NULL)`, applies `setgid`/`setuid` when configured, and then applies platform filesystem restrictions. --- a/lib/jerboa-dns/server.sls +++ b/lib/jerboa-dns/server.sls @@ -1,16 +1,16 @@ #!chezscheme -;;; (jerboa-dns server) — UDP DNS server with privilege drop and sandboxing +;;; (jerboa-dns server) — UDP/TCP DNS server with privilege drop and sandboxing ;;; ;;; Translates djbdns server.c + tinydns.c startup sequence. ;;; Security layers (applied in order): -;;; 1. Bind socket to port (requires root for port 53) +;;; 1. Bind UDP/TCP sockets to port (requires root for port 53) ;;; 2. chroot() to data directory ;;; 3. Drop privileges via setgid/setuid ;;; 4. FreeBSD: cap_rights_limit on non-socket fds (restrict operations) ;;; 5. Linux: Landlock filesystem restriction (if available) ;;; ;;; After sandboxing, the process can only: -;;; - Receive/send UDP on the bound socket +;;; - Receive/send DNS queries on the bound UDP/TCP sockets ;;; - Read files in the chroot (data.cdb for zone lookups) ;;; - Write to stderr (logging) ;;; @@ -89,6 +89,10 @@ (define c-close (foreign-procedure "close" (int) int)) (define c-recvfrom (foreign-procedure __collect_safe "recvfrom" (int void* size_t int void* void*) ssize_t)) (define c-sendto (foreign-procedure __collect_safe "sendto" (int void* size_t int void* int) ssize_t)) + (define c-listen (foreign-procedure "listen" (int int) int)) + (define c-accept (foreign-procedure __collect_safe "accept" (int void* void*) int)) ; jerboa-security: suppress missing-eintr-retry + (define c-recv (foreign-procedure __collect_safe "recv" (int void* size_t int) ssize_t)) ; jerboa-security: suppress missing-eintr-retry + (define c-send (foreign-procedure __collect_safe "send" (int void* size_t int) ssize_t)) ; jerboa-security: suppress missing-eintr-retry (define c-setsockopt (foreign-procedure "setsockopt" (int int int void* int) int)) (define c-htons (foreign-procedure "htons" (unsigned-short) unsigned-short)) (define c-ntohs (foreign-procedure "ntohs" (unsigned-short) unsigned-short)) @@ -98,6 +102,15 @@ (define c-setgid (foreign-procedure "setgid" (unsigned) int)) (define c-setgroups (foreign-procedure "setgroups" (int void*) int)) (define c-chdir (foreign-procedure "chdir" (string) int)) + (define c-errno-location + (cond + [(foreign-entry? "__errno_location") + (foreign-procedure "__errno_location" () void*)] + [(foreign-entry? "__error") + (foreign-procedure "__error" () void*)] + [(foreign-entry? "__errno") + (foreign-procedure "__errno" () void*)] + [else #f])) ;; ========== FFI for chroot (FreeBSD/Linux) ========== @@ -117,6 +130,9 @@ (define AF_INET 2) (define SOCK_DGRAM 2) + (define SOCK_STREAM 1) + (define EINTR 4) + (define SIGPIPE 13) ;; SOL_SOCKET: 0xffff on FreeBSD/macOS, 1 on Linux (define SOL_SOCKET (if *on-freebsd* #xffff 1)) @@ -126,6 +142,8 @@ (define SOCKADDR_IN_SIZE 16) (define INET_ADDRSTRLEN 16) (define MAX-PACKET 512) ;; DNS UDP limit + (define MAX-TCP-PACKET 65535) + (define TCP-BACKLOG 128) ;; Capsicum rights constants (raw bits, without CAPRIGHT version marker) ;; pack-cap-rights adds the (1<<57) / (1<<58) index markers. @@ -143,6 +161,34 @@ ;; ========== Socket Helpers ========== + (define (get-errno) + (if c-errno-location + (foreign-ref 'int (c-errno-location) 0) + -1)) + + (define (install-sigpipe-handler!) + (when (top-level-bound? 'register-signal-handler) + ((top-level-value 'register-signal-handler) SIGPIPE + (lambda (sig) (void))))) + + (define (make-bound-socket ip port socket-type who) + (let ([sock (c-socket AF_INET socket-type 0)]) + (when (= sock -1) + (error who "cannot create socket" socket-type)) + + (let ([optval (foreign-alloc 4)]) + (foreign-set! 'int optval 0 1) + (c-setsockopt sock SOL_SOCKET SO_REUSEADDR optval 4) + (foreign-free optval)) + + (let ([sa (make-sockaddr-in ip port)]) + (when (= (c-bind sock sa SOCKADDR_IN_SIZE) -1) + (foreign-free sa) + (c-close sock) + (error who "cannot bind" ip port)) + (foreign-free sa)) + sock)) + (define (make-sockaddr-in address port) (let ([buf (foreign-alloc SOCKADDR_IN_SIZE)]) ;; Zero the buffer @@ -295,7 +341,7 @@ [(message-condition? e) (condition-message e)] [else "unknown"])) - (define (process-query! rs sock pkt-buf pkt-len client-addr data-file) + (define (process-query! rs pkt-buf pkt-len client-addr data-file send-response! max-response-len) ;; Parse query, look up in CDB, send response. (let ([pkt (make-bytevector pkt-len)] [t0 (now-monotonic-ns)] @@ -318,7 +364,7 @@ (response-query! err-rs (make-bytevector 1 0) DNS-T-A DNS-C-IN) (response-id! err-rs qid) (response-servfail! err-rs) - (send-response! sock err-rs client-addr)))))]) + (send-response! err-rs)))))]) ;; Parse query (via wasm sandbox if enabled and available) (let-values ([(id qname qtype qclass) (parse-query-dispatch pkt pkt-len)]) @@ -364,12 +410,13 @@ (lambda () (sandboxed-cdb-close! cdb))))) - ;; Truncate if > 512 bytes - (when (> (response-length rs) MAX-PACKET) + ;; UDP truncates to the question section at 512 bytes; TCP can + ;; carry the full DNS message up to the protocol maximum. + (when (> (response-length rs) max-response-len) (response-tc! rs)) ;; Send response - (send-response! sock rs client-addr) + (send-response! rs) ;; Log query (gated by *log-queries*; see (jerboa-dns log)). (log-query src id @@ -380,7 +427,18 @@ (response-length rs) (quotient (- (now-monotonic-ns) t0) 1000))]))))) - (define (send-response! sock rs client-addr) + (define (send-all fd foreign-buf len) + (let loop ([sent 0]) + (cond + [(= sent len) #t] + [else + (let ([n (c-send fd (+ foreign-buf sent) (- len sent) 0)]) + (cond + [(> n 0) (loop (+ sent n))] + [(and (= n -1) (= (get-errno) EINTR)) (loop sent)] + [else #f]))]))) + + (define (send-udp-response! sock rs client-addr) (let* ([len (response-length rs)] [buf (response-buffer rs)] [foreign-buf (foreign-alloc len)]) @@ -394,6 +452,96 @@ (lambda () (foreign-free foreign-buf))))) + (define (send-tcp-response! client-fd rs) + (let* ([len (response-length rs)] + [buf (response-buffer rs)] + [foreign-buf (foreign-alloc (+ len 2))]) + (dynamic-wind + void + (lambda () + (foreign-set! 'unsigned-8 foreign-buf 0 + (bitwise-and (bitwise-arithmetic-shift-right len 8) #xff)) + (foreign-set! 'unsigned-8 foreign-buf 1 (bitwise-and len #xff)) + (do ([i 0 (+ i 1)]) ((= i len)) + (foreign-set! 'unsigned-8 foreign-buf (+ i 2) (bytevector-u8-ref buf i))) + (send-all client-fd foreign-buf (+ len 2))) + (lambda () + (foreign-free foreign-buf))))) + + (define (recv-all fd foreign-buf len) + (let loop ([got 0]) + (cond + [(= got len) got] + [else + (let ([n (c-recv fd (+ foreign-buf got) (- len got) 0)]) + (cond + [(> n 0) (loop (+ got n))] + [(= n 0) got] + [(and (= n -1) (= (get-errno) EINTR)) (loop got)] + [else -1]))]))) + + (define (tcp-query-length len-buf) + (+ (bitwise-arithmetic-shift-left (foreign-ref 'unsigned-8 len-buf 0) 8) + (foreign-ref 'unsigned-8 len-buf 1))) + + (define (handle-tcp-client! client-fd client-addr data-file) + (let ([len-buf (foreign-alloc 2)]) + (dynamic-wind + void + (lambda () + (let loop () + (let ([n (recv-all client-fd len-buf 2)]) + (when (= n 2) + (let ([pkt-len (tcp-query-length len-buf)]) + (cond + [(or (< pkt-len 12) (> pkt-len MAX-TCP-PACKET)) + (log-malformed (client-src-str client-addr) pkt-len "-" "bad_tcp_length")] + [else + (let ([pkt-buf (foreign-alloc pkt-len)]) + (dynamic-wind + void + (lambda () + (let ([r (recv-all client-fd pkt-buf pkt-len)]) + (when (= r pkt-len) + (guard (e [#t + (log-error 'tcp_client_error + 'src (client-src-str client-addr) + 'reason (condition-reason e))]) + (process-query! (new-response-state) + pkt-buf pkt-len client-addr data-file + (lambda (rs) (send-tcp-response! client-fd rs)) + MAX-TCP-PACKET))))) + (lambda () (foreign-free pkt-buf)))) + (loop)])))))) + (lambda () + (foreign-free len-buf) + (c-close client-fd))))) + + (define (accept-tcp-loop! tcp-sock data-file) + (let loop () + (let ([client-addr (foreign-alloc SOCKADDR_IN_SIZE)] + [addrlen-buf (foreign-alloc 4)]) + (foreign-set! 'int addrlen-buf 0 SOCKADDR_IN_SIZE) + (let ([client-fd (c-accept tcp-sock client-addr addrlen-buf)]) + (cond + [(>= client-fd 0) + (let ([addr-copy (foreign-alloc SOCKADDR_IN_SIZE)]) + (do ([i 0 (+ i 1)]) ((= i SOCKADDR_IN_SIZE)) + (foreign-set! 'unsigned-8 addr-copy i + (foreign-ref 'unsigned-8 client-addr i))) + (fork-thread + (lambda () + (dynamic-wind + void + (lambda () (handle-tcp-client! client-fd addr-copy data-file)) + (lambda () (foreign-free addr-copy))))))] + [(= (get-errno) EINTR) (void)] + [else + (log-error 'tcp_accept_error 'reason (get-errno))]) + (foreign-free client-addr) + (foreign-free addrlen-buf))) + (loop))) + ;; ========== Main Server Loop ========== (define (run-server! config) @@ -404,25 +552,17 @@ [gid (server-config-gid config)] [data-file (server-config-data-file config)]) - ;; 1. Create UDP socket - (let ([sock (c-socket AF_INET SOCK_DGRAM 0)]) - (when (= sock -1) - (error 'run-server! "cannot create socket")) - - ;; 2. Set SO_REUSEADDR - (let ([optval (foreign-alloc 4)]) - (foreign-set! 'int optval 0 1) - (c-setsockopt sock SOL_SOCKET SO_REUSEADDR optval 4) - (foreign-free optval)) + (install-sigpipe-handler!) - ;; 3. Bind to address:port - (let ([sa (make-sockaddr-in ip port)]) - (when (= (c-bind sock sa SOCKADDR_IN_SIZE) -1) - (foreign-free sa) - (error 'run-server! "cannot bind" ip port)) - (foreign-free sa)) + ;; 1. Create and bind UDP + TCP sockets before chroot/privdrop. + (let* ([udp-sock (make-bound-socket ip port SOCK_DGRAM 'run-server!)] + [tcp-sock (make-bound-socket ip port SOCK_STREAM 'run-server!)]) + (when (= (c-listen tcp-sock TCP-BACKLOG) -1) + (c-close udp-sock) + (c-close tcp-sock) + (error 'run-server! "cannot listen" ip port)) - (log-startup 'ip ip 'port port) + (log-startup 'ip ip 'port port 'udp "enabled" 'tcp "enabled") ;; 4. chroot + chdir to data directory. chroot restricts ;; filesystem access to this directory tree and must be done @@ -478,7 +618,12 @@ "sandboxed" "in-process")) (sandboxed-cdb-close! startup-cdb) - ;; 8. Main loop + ;; 8. TCP accept loop runs in a Scheme thread; UDP receive + ;; remains the main loop below. + (fork-thread (lambda () (accept-tcp-loop! tcp-sock data-file))) + (log-info 'tcp_listening 'ip ip 'port port) + + ;; 9. Main UDP loop (let ([recv-buf (foreign-alloc MAX-PACKET)] [client-addr (foreign-alloc SOCKADDR_IN_SIZE)] [addrlen-buf (foreign-alloc 4)] @@ -489,13 +634,16 @@ (foreign-set! 'int addrlen-buf 0 SOCKADDR_IN_SIZE) ;; Receive packet - (let ([n (c-recvfrom sock recv-buf MAX-PACKET 0 client-addr addrlen-buf)]) + (let ([n (c-recvfrom udp-sock recv-buf MAX-PACKET 0 client-addr addrlen-buf)]) (when (> n 0) ;; Process query (guard (e [#t (log-error 'recv_loop_error 'reason (condition-reason e))]) - (process-query! rs sock recv-buf n client-addr data-file)))) + (process-query! rs recv-buf n client-addr data-file + (lambda (out-rs) + (send-udp-response! udp-sock out-rs client-addr)) + MAX-PACKET)))) (loop))))))) --- a/vs-djbdns.md +++ b/vs-djbdns.md @@ -2,7 +2,7 @@ ## Architecture Overview -Both are authoritative-only UDP DNS servers using CDB for zone data. jerboa-dns is a faithful port of djbdns's core design (CDB, tdlookup, response builder, zone file format) into Chez Scheme, with a WASM sandboxing layer added on top. +Both are authoritative-only DNS servers using CDB for zone data. jerboa-dns is a faithful port of djbdns's core design (CDB, tdlookup, response builder, zone file format) into Chez Scheme, with UDP and TCP query handling plus a WASM sandboxing layer added on top. | | jerboa-dns | djbdns | |---|---|---|