sunet/scheme/dnsd/resolver.scm

754 lines
25 KiB
Scheme
Raw Permalink Normal View History

2006-11-12 13:21:33 -05:00
; ----------------
; --- Resolver ---
; ----------------
; A DNS-Server based on the RFCs: 1034 / 1035
; This file is part of the Scheme Untergrund Networking package
; Copyright (c) 2005/2006 by Norbert Freudemann
; <nofreude@informatik.uni-tuebingen.de>
; For copyright information, see the file COPYING which comes with
; the distribution.
; Interface:
; ----------
;(dnsd-ask-resolver-rec message protocol dnsd-options)
;(dnsd-ask-resolver-direct message list-of-nameservers protocol dnsd-options)
;; The modified send-receive-message socket-interface from dns.scm:
;; ----------------------------------------------------------------
;; Delete the given element(s) from the list:
;; TYPE: list x list -> list
(define (delete-list elems list)
(cond
((null? elems) list)
((null? list) '())
(else (delete-list (cdr elems) (delete (car elems) list)))))
;; dnsd wants the message, not the dns-error codes.
(define (dnsd-acceptable? reply query)
(if (not (= (header-id (message-header reply))
(header-id (message-header query))))
(error "send-receive-message: Bad reply-ID from server.")))
(define (dnsd-send-receive-message-tcp nameserver query dnsd-options)
(send-receive-message-tcp-int nameserver query dnsd-acceptable? dnsd-options))
(define (send-receive-message-tcp-int nameservers query accept? dnsd-options)
(receive
(reply hit-ns other-nss)
(let* ((sockets (map (lambda (nameserver)
(let ((sock (create-socket protocol-family/internet
socket-type/stream))
(addr (internet-address->socket-address
nameserver 53)))
;; Ignore return value and select unconditionally later
(with-fatal-error-handler*
(lambda (condition decline) #f)
(lambda ()
(connect-socket-no-wait sock addr) sock))))
nameservers))
(nameservers (let loop ((sockets sockets)
(nss nameservers))
(cond
((or (null? sockets) (null? nss)) '())
((socket? (car sockets))
(cons (car nss) (loop (cdr sockets) (cdr nss))))
(else (loop (cdr sockets) (cdr nss))))))
(sockets (filter socket? sockets))
(ws (map socket:outport sockets))
(wport-nameserver-alist (map cons ws nameservers))
(wport-socket-alist (map cons ws sockets)))
(with-fatal-error-handler*
(lambda (condition decline)
(for-each close-socket sockets)
decline)
(lambda ()
(dynamic-wind
(lambda () 'nothing-to-be-done-before)
(lambda ()
(let loop-port-channels ((tried-channels '())
(number-tries 1))
;; No channels left to try?
(if (or (null? (delete-list tried-channels ws))
(= (length tried-channels) (length ws))
(>= number-tries
(dnsd-options-socket-max-tries dnsd-options)))
(values query #f nameservers)
(let ((ready
(apply select-ports
(dnsd-options-socket-timeout dnsd-options)
ws)))
(let loop-ready-channels ((ready-channels ready))
(if (null? ready-channels)
(loop-port-channels (append tried-channels ready)
(+ number-tries 1))
(let* ((w (car ready-channels))
(hit-ns
(cdr (assoc w wport-nameserver-alist)))
(sock (cdr (assoc w wport-socket-alist))))
(if (not (connect-socket-successful? sock))
(loop-ready-channels (cdr ready-channels))
(let ((query-string (list->string
(add-size-tag
(message-source query))))
(r (socket:inport sock)))
(with-fatal-error-handler*
(lambda (condition decline)
(loop-ready-channels (cdr ready-channels)))
(lambda ()
(display query-string w)
(force-output w)
(let ((a (read-char r))
(b (read-char r)))
(let ((len (octet-pair->number a b)))
(let ((s (read-string len r)))
(if (and (not (= 0 (string-length s)))
(not (= len (string-length s))))
(error 'unexpected-eof-from-server))
(values (parse (string->list s)) hit-ns
(delete hit-ns nameservers))))))))))))))))
(lambda () (for-each close-socket sockets))))))
(accept? reply query)
(values reply hit-ns other-nss)))
(define (dnsd-send-receive-message-udp nameserver query dnsd-options)
(send-receive-message-udp-int nameserver query dnsd-acceptable? dnsd-options))
(define (send-receive-message-udp-int nameservers query accept? dnsd-options)
(receive
(reply hit-ns other-nss)
(let* ((sockets (map (lambda (nameserver)
(let ((sock (create-socket protocol-family/internet
socket-type/datagram))
(addr (internet-address->socket-address
nameserver 53)))
(connect-socket sock addr)
sock))
nameservers))
(rs (map socket:inport sockets))
(ws (map socket:outport sockets)))
(with-fatal-error-handler*
(lambda (condition decline)
(for-each close-socket sockets)
decline)
(lambda ()
(dynamic-wind
(lambda () 'nothing-to-be-done-before)
(lambda ()
(let ((query-string (list->string (message-source query)))
(rsv (list->vector rs))
(rport-nameserver-alist (map cons rs nameservers))
(rport-socket-alist (map cons rs sockets)))
(for-each (lambda (w) (display query-string w)) ws)
(for-each force-output ws)
(let loop-port-channels ((tried-channels '())
(number-tries 1))
(let ((rs-new (delete-list tried-channels rs)))
(if (or (null? rs-new)
(>= number-tries (dnsd-options-socket-max-tries dnsd-options))
(= (length tried-channels) (length rs)))
(values query #f nameservers)
(let ((ready (apply select-ports
(dnsd-options-socket-timeout dnsd-options)
rs-new)))
(let loop-ready-channels ((ready-channels ready))
(if (null? ready-channels)
(loop-port-channels (append tried-channels ready)
(+ number-tries 1))
(let* ((r (car ready-channels))
(hit-ns (cdr (assoc r rport-nameserver-alist))))
(if (not (connect-socket-successful?
(cdr (assoc r rport-socket-alist))))
(loop-ready-channels (cdr ready-channels))
;; 512 is the maximum udp-message size:
(let ((answer (string->list (read-string/partial 512 r))))
(if (null? answer)
(loop-ready-channels (cdr ready-channels))
(values (parse answer) hit-ns
(delete hit-ns nameservers))))))))))))))
(lambda () (for-each close-socket sockets))))))
(accept? reply query)
(if (flags-truncated? (header-flags (message-header reply)))
(send-receive-message-tcp-int nameservers query accept?)
(values reply hit-ns other-nss))))
(define (dnsd-send-receive-message nameservers query protocol dnsd-options)
((cond
((eq? protocol (network-protocol tcp)) dnsd-send-receive-message-tcp)
((eq? protocol (network-protocol udp)) dnsd-send-receive-message-udp))
nameservers query dnsd-options))
;; Stuff:
;; ------
; Filter a list of rrs of the given type:
; TYPE: list-of-rrs -> list-of-rrs
(define (filter-rr-type type list)
(filter (lambda (e) (eq? (resource-record-type e) type)) list))
;; Randomize a list (needs srfi-1 & srfi-27):
;; TYPE: list -> list
(define (shake-list l)
(define (shake-list-int l res)
(if (null? l)
res
(let ((random-value (random-integer (length l))))
(shake-list-int
(append (take l random-value) (drop l (+ 1 random-value)))
(cons (list-ref l random-value) res)))))
(shake-list-int l '()))
;; Check a message for its response-code:
;; --------------------------------------
;; RCODE-0-Message? (Error-Free)
;; TYPE: message -> boolean
(define (rcode-0-reply? msg)
(eq? 'dns-no-error (flags-response-code (header-flags (message-header msg)))))
;; RCODE-3-Message? (Name-Error (does not exist))
;; TYPE: message -> boolean
(define (rcode-3-reply? msg)
(eq? 'dns-name-error (flags-response-code
(header-flags (message-header msg)))))
;; RCODE-2-Message? Server-Failure
;; TYPE: message -> boolean
(define (rcode-2-reply? msg)
(eq? 'dns-server-failure (flags-response-code
(header-flags (message-header msg)))))
;; RCODE-4-Message? Not Implemented
;; TYPE: message -> boolean
(define (rcode-4-reply? msg)
(eq? 'dns-not-implemented (flags-response-code
(header-flags (message-header msg)))))
;; RCODE-5-Message? (Refused to answer query.)
;; TYPE: message -> boolean
(define (rcode-5-reply? msg)
(eq? 'dns-refused (flags-response-code (header-flags (message-header msg)))))
;; Are there just CNAMEs in the answer-section of a reply?
;; TYPE message -> boolean
(define (cname-answer? msg)
(let ((cnames (fold-right
(lambda (e b)
(or (eq? (message-type cname) (resource-record-type e)) b))
#f (message-answers msg)))
(other (fold-right
(lambda (e b)
(or (not (eq? (message-type cname)
(resource-record-type e))) b))
#f (message-answers msg))))
(if other #f cnames)))
;; Interpreting the results of dbi-lookup-rec - Zone found, but not the name.
;; TYPE res-list-of-db-lookup-rec -> boolean
(define (no-entry? res-l)
(and (null? (car res-l)) (null? (cadr res-l))
(null? (caddr res-l)) (cadddr res-l)))
;; Is the query a cname-question?
;; TYPE: message -> boolean
(define (cname-question? msg)
(eq? (message-type cname) (question-type (car (message-questions msg)))))
;; Create a reply from the internally found (db or cache) information.
;; NOTE: This function is part of the exported functions.
;; TYPE: message x res-list-of-db-lookup-rec x dnsd-options -> message
(define (make-response message r-list dnsd-options)
(let* ((use-recursion? (dnsd-options-use-recursion? dnsd-options))
(error-code (if (no-entry? r-list) 'dns-name-error 'dns-no-error))
(msg-header (message-header message))
(msg-flags (header-flags msg-header))
(anli (car r-list))
(auli (cadr r-list))
(adli (caddr r-list))
(aufl (cadddr r-list)))
(make-message
(make-header (header-id msg-header)
(make-flags
'response
(flags-opcode msg-flags)
aufl
(flags-truncated? msg-flags)
(flags-recursion-desired? msg-flags)
use-recursion?
(flags-zero msg-flags)
error-code)
(header-question-count msg-header)
(length anli)
(length auli)
(length adli))
(message-questions message)
anli auli adli '())))
;; Increment the answer-section (for adding a cname)
;; TYPE: message -> message
(define (msg-inc-answers msg-header)
(let ((msg-flags (header-flags msg-header)))
(make-header (header-id msg-header)
msg-flags
(header-question-count msg-header)
(+ 1 (header-answer-count msg-header))
(header-nameserver-count msg-header)
(header-additional-count msg-header))))
;; Change the type of a question to (message-type cname)
;; TYPE: messag -> message
(define (msg->cname-msg msg)
(let ((q (car (message-questions msg))))
(make-message (message-header msg)
(list (make-question (question-name q)
(message-type cname)
(question-class q)))
(message-answers msg)
(message-nameservers msg)
(message-additionals msg) '())))
;; Assignment procs:
;; -----------------
;; Set the recursion-aviable flag:
;; TYPE: message x boolean -> message
(define (msg-set-recursion-aviable! msg bool)
(set-flags-recursion-available! (header-flags (message-header msg)) bool))
;; Set the response-code of a message:
;; NOTE: This function is part of the exported functions.
;; TYPE: message x rcode -> message
(define (msg-set-rcode! msg code)
(let ((rcode (case code
((0) 'dns-no-error)
((1) 'dns-format-error)
((2) 'dns-server-failure)
((3) 'dns-name-error)
((4) 'dns-not-implemented)
((5) 'dns-refused)
(else code))))
(set-flags-response-code! (header-flags (message-header msg)) rcode)))
;; Direct lookup:
;; --------------
;; Direct lookup of a query asking the given Nameserves:
;; TYPE: message x list-of-address32 tcp/udp x dnsd-options -> message
(define (dnsd-lookup-direct msg ns-list proto dnsd-options)
(receive (msg hit-ip other-ips)
(dnsd-send-receive-message
ns-list
(make-message (message-header msg) (message-questions msg)
(message-answers msg) (message-nameservers msg)
(message-additionals msg) (mc-message->octets msg))
proto dnsd-options)
(if hit-ip
msg
(begin
(dnsd-log (syslog-level info)
"dnsd-direct-lookup. Nameservers ~S not reachable."
ns-list)
(error "dnsd-direct-lookup. No NS reachable.")))))
;; Stuff for recursive lookup:
;; ---------------------------
;; SBELT:
;; ------
;; Fallback nameserver for recursive lookup. This is the default value which
;; can be changed by the dnsd-options:
(define *sbelt*
(list ;(ip-string->address32 "192.5.5.241")
(ip-string->address32 "192.36.148.17")
(ip-string->address32 "192.5.5.241")))
;; Some nameserver IPs:
;; --------------------
;; 192.36.148.17 i.root-servers.net. (for .)
;; 192.5.5.241 f.root-server.net. (for .)
;; 192.5.6.30 A.GTLD-SERVERS.NET. (for .com.
;; 193.159.170.187 deNIC-NS (for .de.)
;; Record-Type for additional information needed by the lookup:
;; cnames is a list of all seen CNAMES to avoid CNAME-loops.
;; ips is a list of used NS-IPs for the query.
;; timestamp is the creation-time of the context and used for timeouts.
(define-record-type context :context
(really-make-context cnames ips timestamp)
context?
(cnames get-context-cnames set-context-cnames!)
(ips get-context-ips set-context-ips!)
(timestamp get-context-timestamp))
;; Makes the lookup-context for a given query.
;; TYPE: message -> context
(define (make-context message)
(really-make-context
(list (question-name (car (message-questions message))))
'()
(time)))
;; Add a name to the context.
;; TYPE: context x string -> context
(define (update-context-cnames! context value)
(set-context-cnames! context (cons value (get-context-cnames context)))
context)
;; Add a IP to the context.
;; TYPE: context x address32 -> context
(define (update-context-ips! context value)
(set-context-ips! context (cons value (get-context-ips context)))
context)
;; Search the SLIST for the best 'nearest' nameserver to query for a message.
;; The nearest server is the server for the domain with the most matching labels
;; seen from the root: 1) www.example.com. 2) example.com. 3) com. 4) . 5) SBELT
;; TYPE: message x dnsd-options -> list-of-nameserver-ips x zone-name-of-ns
(define (search-for-ns-ips msg dnsd-options)
(let* ((q (car (message-questions msg)))
(name (question-name q))
(class (question-class q)))
(let loop ((name name))
(let ((ip-list (dnsd-slist-lookup
(make-simple-query-message name (message-type ns) class)
dnsd-options)))
(if ip-list
(values ip-list name #f)
(if (string=? "." name)
(let* ((sbelt-string (dnsd-options-nameservers dnsd-options))
(sbelt (map ip-string->address32 sbelt-string)))
(if (null? sbelt)
(values *sbelt* name #t)
(values sbelt name #t)))
(loop (cut-name name))))))))
;; Ask the message to some NS from the SLIST. Keep track which NSs were already
;; contacted for the given query in 'context'.
;; TYPE: message x udp/tcp x dnsd-options x context
;; -> message-answer x context x nearest-NS-string x address32
(define (ask-nameservers msg protocol dnsd-options context)
(receive
(ip-list name sbelt?)
(search-for-ns-ips msg dnsd-options)
;; Use only IPs which haven't been tried jet
(let ((good-ips (filter (lambda (e)
(not (fold-right
(lambda (e1 b)
(or b (= e1 e)))
#f (get-context-ips context))))
ip-list)))
;; randomize the list for some simple load-balancing...
(let loop ((good-ips (shake-list good-ips)))
(if (null? good-ips)
(error "ask-nameservers: Tried all known Nameservers.")
(receive
(msg hit-ip other-ips)
(dnsd-send-receive-message
(list (car good-ips))
(make-message (message-header msg) (message-questions msg)
(message-answers msg) (message-nameservers msg)
(message-additionals msg) (mc-message->octets msg))
protocol dnsd-options)
(if hit-ip
(values msg (update-context-ips! context hit-ip)
name hit-ip)
(begin
(if (not sbelt?) (dnsd-blacklist! (car good-ips)))
(loop (cdr good-ips))))))))))
;; Some responses contain nameserver-names but sadly not their IPs.
;; This function searches for those IPs, add the results to the
;; cache and restarts the recursive lookup.
;; TYPE: message x udp/tcp x list-of-rrs x dnsd-options -> unspecific
(define (lookup-nameserver-ips msg protocol ns-rrs dnsd-options)
(let* ((ns-names (map (lambda (e) (resource-record-data-ns-name
(resource-record-data e))) ns-rrs))
(ns-queries (map (lambda (e)
;;(display-debug "Looking for this names: " e)
(make-simple-query-message
e (message-type a)
(question-class
(car (message-questions msg))))) ns-names))
; ;; This step might take a while :-(
; (answers (map (lambda (e)
; (dnsd-ask-resolver-rec e protocol dnsd-options))
; ns-queries))
;; Concurrent lookup of the IPs:
(ch-list (map
(lambda (msg)
(let ((ch-res (make-channel)))
(fork-thread
(lambda ()
(sync (send-rv
ch-res
;; Use dnsd-ask-r... because of the 'good'
;; return value.
(dnsd-ask-resolver-rec msg protocol
dnsd-options)))))
ch-res))
ns-queries))
;; Wait for all results:
(answers (map (lambda (ch) (sync (receive-rv ch))) ch-list))
(good-answers (filter (lambda (e) (rcode-0-reply? e)) answers))
(ip-rrs (map (lambda (msg) (filter-rr-type (message-type a)
(message-answers msg)))
good-answers))
(flat-ns-list (fold-right (lambda (e l) (append e l)) '() ip-rrs)))
(if (null? flat-ns-list)
#f ;TODO: Do we need a strategy to avoid loops if we don't find NS?
(dnsd-slist-update!
(make-message (message-header msg) (message-questions msg)
'() ns-rrs flat-ns-list '())))))
;; Restart dnsd-get-info-int with question-name changed to the cname.
;; TYPE: query-message x response-message x udp/tcp x dnsd-options x context
;; -> respones-message
(define (cname-lookup msg res protocol dnsd-options context)
(let* ((q (car (message-questions msg)))
(msg-name (question-name q))
(cname-rr (fold-right
(lambda (e a)
(if a a
(if (and (eq? (message-type cname)
(resource-record-type e))
(string-ci=? (resource-record-name e)
msg-name))
e a)))
#f (message-answers res)))
(cname (resource-record-data-cname-name
(resource-record-data cname-rr)))
(found-loop? (fold-right (lambda (e b)
(or (string-ci=? cname e) b))
#f (get-context-cnames context))))
(if found-loop? ; Check for CNAME-Loop
(begin ;;(display-debug "Found a CNAME-loop. Aborting!")
(error "Found a CNAME-loop. Aborting recursive lookup."))
(let* ((new-msg (make-message (message-header msg)
(list (make-question cname
(question-type q)
(question-class q)))
'() '() '() '()))
(res (dnsd-get-info-int new-msg protocol dnsd-options
;; Keep timout, allow all IPs again...
(really-make-context
(cons cname (get-context-cnames context))
'()
(get-context-timestamp context))))
(new-res (make-message (msg-inc-answers (message-header res))
(message-questions msg)
(cons cname-rr (message-answers res))
(message-nameservers res)
(message-additionals res) '())))
new-res))))
;; Recursive Lookup as seen in RFC 1034:
;; -------------------------------------
;; 1) Check local information and (if present) return it to the client.
;; 2) Search for server(s) to ask. Wait for a response.
;; 3) Analyze the response:
;; 3.1 cache answers or name error.
;; 3.2 cache delegation info to other servers. Retry.
;; 3.3 if the response shows a CNAME and that is not the
;; answer itself, cache the CNAME, change the SNAME to the
;; canonical name in the CNAME RR and go to step 1.
;; 3.4 servers failure etc.: delete server from cache. Retry.
;; Start the recursive lookup and initialize the first context-list
;; with the name of the question (to avoid CNAME-Loops).
;; TYPE: message x udp/tcp x dnsd-options -> message
(define (dnsd-get-information message protocol dnsd-options)
(dnsd-get-info-int message protocol dnsd-options (make-context message)))
;; TYPE: message x udp/tcp x dnsd-options x context -> message
(define (dnsd-get-info-int message protocol dnsd-options context)
; 1) Search local information:
(let* ((use-cache? (dnsd-options-use-cache? dnsd-options))
(local-res (if use-cache? (dnsd-cache-lookup? message) #f)))
;; Timeout?
(if (> (- (time) (get-context-timestamp context))
(dnsd-options-rec-timeout dnsd-options))
(error "dnsd-get-info-int: Global timeout.")
(if local-res (make-response message local-res dnsd-options)
;; 2) Could be: Search for the best nameserver to ask.
;; Now it's: Ask all servers concurrent and take
;; the first result.
(receive
(rec-res context followed-name hit-ip)
(ask-nameservers message protocol dnsd-options context)
;; 3) Analyze the response:
(let* ((ns-rrs (filter-rr-type (message-type ns)
(message-nameservers rec-res)))
(a-rrs (filter-rr-type (message-type a)
(message-additionals rec-res))))
(cond
;; 3.4) Bad answer: Some NS are to 'lazy' to return cnames
;; and return RCODE 5 instead. The NS of sourceforge.net.
;; are a good bad example.
((rcode-5-reply? rec-res)
(if (not (cname-question? rec-res))
(let ((cname-query
(dnsd-get-information (msg->cname-msg message)
protocol dnsd-options)))
(if (cname-answer? cname-query)
(cname-lookup message cname-query protocol
dnsd-options context)
(begin (dnsd-blacklist! hit-ip)
rec-res)))
(begin (dnsd-blacklist! hit-ip) rec-res)))
;; 3.4) Try again with other servers.
((rcode-2-reply? rec-res)
(dnsd-blacklist! hit-ip)
(dnsd-get-info-int message protocol dnsd-options context))
((rcode-4-reply? rec-res)
(dnsd-blacklist! hit-ip
(dnsd-options-blacklist-value dnsd-options))
(dnsd-get-info-int message protocol dnsd-options context))
(else
;; A "good" reply.
(dnsd-blacklist-unlist! hit-ip dnsd-options)
(cond
;; 3.1) Found a name-error.
((rcode-3-reply? rec-res)
(dnsd-cache-update! rec-res) rec-res)
;; 3.4) Whatever error is left... .
((not (rcode-0-reply? rec-res)) rec-res)
;; 3.1) Found an answer.
((not (null? (message-answers rec-res)))
;; 3.3) CNAME?
(if (and (not (cname-question? rec-res))
(cname-answer? rec-res))
(begin
(dnsd-cache-update! (msg->cname-msg rec-res))
;;(display-debug "Starting CNAME Lookup!")
(cname-lookup message rec-res protocol
dnsd-options context))
;; Returning of not-authoritative data
;; may be a bad habbit...
(if (flags-authoritative?
(header-flags (message-header rec-res)))
rec-res
rec-res)))
(else
;; 3.2) Redirection to other Nameservers?
(cond
((null? ns-rrs) rec-res)
((null? a-rrs)
;; Only nameserver resource-records, search for IPs
(lookup-nameserver-ips rec-res protocol
ns-rrs dnsd-options)
(dnsd-get-info-int message protocol dnsd-options context))
(else
(dnsd-slist-update! rec-res)
(dnsd-get-info-int message protocol
dnsd-options context)))))))))))))
;; ---------------------------------
;; --- Server/Resolver-Interface ---
;; ---------------------------------
;; (dnsd-ask-resolver-direct msg nameserver-list protocol dnsd-options)
;; - Ask a specific nameserver (& don't use the SLIST-Interface.)
;; (E.g. for the AXFR-Update algorihms.)
;;
;; (dnsd-ask-resolver-rec msg protocol dnsd-options)
;; - Ask indirect (and recursive) via the SLIST-Cache.
;; TYPE: message x upd/tcp x dnsd-options -> message
(define (dnsd-ask-resolver-rec msg proto dnsd-options)
(set-message-source! msg (mc-message->octets msg))
(let ((ch-timeout (make-channel))
(ch-res (make-channel)))
(fork-thread
(lambda ()
(sleep (* 1000 (dnsd-options-rec-timeout dnsd-options)))
(sync (send-rv ch-timeout #t))))
(fork-thread
(lambda ()
(with-fatal-error-handler*
(lambda (condition decline)
(dnsd-log (syslog-level debug)
"Error during recursive lookup.")
(msg-set-rcode! msg 2)
msg)
(lambda ()
(sync (send-rv ch-res (dnsd-get-information msg
proto dnsd-options)))))))
(sync
(choose
(wrap (receive-rv ch-timeout)
(lambda (ignore)
(dnsd-log (syslog-level info)
"Timeout during recursive lookup. Current value is ~Ds"
(dnsd-options-rec-timeout dnsd-options))
(msg-set-rcode! msg 2) msg))
(wrap (receive-rv ch-res)
(lambda (value)
value))))))
;; TYPE: message x list-of-address32 x upd/tcp x dnsd-options -> message
(define (dnsd-ask-resolver-direct msg nameservers proto dnsd-options)
(set-message-source! msg (mc-message->octets msg))
(with-fatal-error-handler*
(lambda (condition decline)
(dnsd-log (syslog-level debug)
"Error during direct lookup.")
(msg-set-rcode! msg 2)
msg)
(lambda ()
(dnsd-lookup-direct msg nameservers proto dnsd-options))))