* added dns-check-nameservers
* fixed alists in send-receive-message-tcp * fixed and added documentation
This commit is contained in:
parent
c42a467ce5
commit
6f52781aa6
|
@ -149,6 +149,14 @@ accept. \var{Nameserver} is either a \ipaddr or a dotted IP string.
|
||||||
resolve these FQDNs.
|
resolve these FQDNs.
|
||||||
\end{desc}
|
\end{desc}
|
||||||
|
|
||||||
|
\defun{dns-check-nameservers} {[nameserver list]} {\undefined}
|
||||||
|
\begin{desc}
|
||||||
|
\ex{dns-check-namservers} checks if the given nameservers are reachable.
|
||||||
|
If no argument is given, the nameservers in \texttt{/etc/resolv.conf}
|
||||||
|
are checked. Information about the status of the nameservers is printed
|
||||||
|
to the current output port.
|
||||||
|
\end{desc}
|
||||||
|
|
||||||
\section{Low-level Interface}
|
\section{Low-level Interface}
|
||||||
|
|
||||||
This section describes a set of data structures and procedures which
|
This section describes a set of data structures and procedures which
|
||||||
|
|
|
@ -30,17 +30,25 @@
|
||||||
; if it is a domainname, its ip is looked up on a nameserver listed in
|
; if it is a domainname, its ip is looked up on a nameserver listed in
|
||||||
; /etc/resolv.conf.
|
; /etc/resolv.conf.
|
||||||
;
|
;
|
||||||
; (dns-find-nameserver) --> <ip-address32>
|
; (dns-find-nameserver-list) --> <ip-string list>
|
||||||
; this parses the /etc/resolv.conf file and returns the first found
|
; this parses the /etc/resolv.conf file and returns the found
|
||||||
; nameserver in address32 format.
|
; nameserver in a list of dotted strings.
|
||||||
;
|
;
|
||||||
|
; (dns-find-nameserver) --> <ip-string>
|
||||||
|
; this parses the /etc/resolv.conf file and returns the first found
|
||||||
|
; nameserver in dotted string notation.
|
||||||
|
;
|
||||||
|
; (dns-check-namservers [nameserver list]) --> undefined
|
||||||
|
; checks if the given nameservers are reachable. If no argument is given,
|
||||||
|
; the nameservers in /etc/resolv.conf are checked.
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
; (dns-lookup-name <name> [nameserver]) --> <ip-address32>
|
; (dns-lookup-name <name> [nameserver list] [use-cache?]) --> <ip-address32>
|
||||||
; (dns-lookup-ip <ip-string | ip-address32> [nameserver]) --> <name>
|
; (dns-lookup-ip <ip-string | ip-address32> [nameserver list] [use-cache?])
|
||||||
; (dns-lookup-nameserver <name> [nameserver])
|
; --> <name>
|
||||||
|
; (dns-lookup-nameserver <name> [nameserver list] [use-cache?])
|
||||||
; --> <list of ip-address32s of authoritative nameservers>
|
; --> <list of ip-address32s of authoritative nameservers>
|
||||||
; (dns-lookup-mail-exchanger <name> [nameserver])
|
; (dns-lookup-mail-exchanger <name> [nameserver list] [use-cache?])
|
||||||
; --> <list of names of mail-exchangers>
|
; --> <list of names of mail-exchangers>
|
||||||
;
|
;
|
||||||
; dns-lookup-name, dns-lookup-ip, dns-lookup-nameserver and
|
; dns-lookup-name, dns-lookup-ip, dns-lookup-nameserver and
|
||||||
|
@ -57,7 +65,7 @@
|
||||||
; /etc/resolv.conf.
|
; /etc/resolv.conf.
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
; (dns-lookup <name | ip-string | ip-address32> <type> [nameserver])
|
; (dns-lookup <name | ip-string | ip-address32> <type> [nameserver list])
|
||||||
; --> <dns-message>
|
; --> <dns-message>
|
||||||
; (show-dns-message <dns-message) --> the whole message, human readable
|
; (show-dns-message <dns-message) --> the whole message, human readable
|
||||||
;
|
;
|
||||||
|
@ -780,9 +788,7 @@
|
||||||
;; here: via TCP
|
;; here: via TCP
|
||||||
(define (send-receive-message-tcp nameservers query)
|
(define (send-receive-message-tcp nameservers query)
|
||||||
(receive (reply hit-ns other-nss)
|
(receive (reply hit-ns other-nss)
|
||||||
(let ((sockets (filter
|
(let ((sockets (map
|
||||||
socket?
|
|
||||||
(map
|
|
||||||
(lambda (nameserver)
|
(lambda (nameserver)
|
||||||
(let ((sock (create-socket protocol-family/internet
|
(let ((sock (create-socket protocol-family/internet
|
||||||
socket-type/stream))
|
socket-type/stream))
|
||||||
|
@ -797,8 +803,18 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(connect-socket-no-wait sock addr)
|
(connect-socket-no-wait sock addr)
|
||||||
sock))))))
|
sock))))))
|
||||||
nameservers))))
|
nameservers)))
|
||||||
(let* ((ws (map socket:outport sockets))
|
(let* ((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-nameserver-alist (map cons ws nameservers))
|
||||||
(wport-socket-alist (map cons ws sockets)))
|
(wport-socket-alist (map cons ws sockets)))
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
|
@ -1240,6 +1256,99 @@
|
||||||
(dns-error 'no-nameservers)
|
(dns-error 'no-nameservers)
|
||||||
(car ns))))
|
(car ns))))
|
||||||
|
|
||||||
|
;; checks if the nameservers are working, prints a summary
|
||||||
|
(define (dns-check-nameservers . args)
|
||||||
|
(let* ((print-summary
|
||||||
|
(lambda (working-channels non-working-channels)
|
||||||
|
(for-each (lambda (channel)
|
||||||
|
(display "FAIL: ")(display channel)
|
||||||
|
(display " - host not reachable.")(newline))
|
||||||
|
non-working-channels)
|
||||||
|
(for-each (lambda (channel)
|
||||||
|
(display "PASS: ")(display channel)
|
||||||
|
(display " - connection established.")(newline))
|
||||||
|
working-channels)
|
||||||
|
(if (null? working-channels)
|
||||||
|
(begin (display "ERROR: no working nameserver found.")(newline)))))
|
||||||
|
|
||||||
|
(nameservers (if (null? args)
|
||||||
|
(dns-find-nameserver-list)
|
||||||
|
(car args)))
|
||||||
|
(sockets (map
|
||||||
|
(lambda (nameserver)
|
||||||
|
(let ((sock (create-socket protocol-family/internet
|
||||||
|
socket-type/stream))
|
||||||
|
(addr (internet-address->socket-address
|
||||||
|
(ip-string->address32 nameserver) 53)))
|
||||||
|
(call-with-current-continuation
|
||||||
|
(lambda (k)
|
||||||
|
(with-handler (lambda (cond more)
|
||||||
|
(display "FAIL: ")
|
||||||
|
(display nameserver)
|
||||||
|
(display " - no DNS Service available.")
|
||||||
|
(newline)
|
||||||
|
(k #f))
|
||||||
|
(lambda ()
|
||||||
|
(connect-socket-no-wait sock addr)
|
||||||
|
sock))))))
|
||||||
|
nameservers)))
|
||||||
|
|
||||||
|
(let* ((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)))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda ()
|
||||||
|
'nothing-to-be-done-before)
|
||||||
|
(lambda ()
|
||||||
|
(let loop-port-channels ((working-channels '())
|
||||||
|
(non-working-channels '())
|
||||||
|
(tried-channels '())
|
||||||
|
(number-tries 1))
|
||||||
|
(letrec ((delete-list
|
||||||
|
(lambda (elems list)
|
||||||
|
(cond
|
||||||
|
((null? elems) list)
|
||||||
|
((null? list) '())
|
||||||
|
(else (delete-list (cdr elems) (delete (car elems) list))))))
|
||||||
|
(ready (delete-list tried-channels
|
||||||
|
(apply select-port-channels *timeout* ws))))
|
||||||
|
|
||||||
|
(if (or (>= number-tries *max-tries*))
|
||||||
|
(print-summary working-channels
|
||||||
|
(delete-list working-channels
|
||||||
|
(delete-list non-working-channels
|
||||||
|
nameservers)))
|
||||||
|
(let loop-ready-channels ((working-channels working-channels)
|
||||||
|
(non-working-channels non-working-channels)
|
||||||
|
(ready-channels ready))
|
||||||
|
(if (null? ready-channels)
|
||||||
|
(loop-port-channels working-channels
|
||||||
|
non-working-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 (connect-socket-successful? sock)
|
||||||
|
(loop-ready-channels (append working-channels (list hit-ns))
|
||||||
|
non-working-channels (cdr ready-channels))
|
||||||
|
(loop-ready-channels working-channels
|
||||||
|
(append non-working-channels
|
||||||
|
(list hit-ns))
|
||||||
|
(cdr ready-channels))))))))))
|
||||||
|
(lambda ()
|
||||||
|
(for-each close-socket sockets))))))
|
||||||
|
|
||||||
|
|
||||||
;; computes the nameservers argument of the lookup functions.
|
;; computes the nameservers argument of the lookup functions.
|
||||||
;; if a nameserver-name is given and not a nameserver-ip
|
;; if a nameserver-name is given and not a nameserver-ip
|
||||||
|
|
|
@ -155,6 +155,7 @@
|
||||||
ip-string->address32 ; converts a ip-string in an address32
|
ip-string->address32 ; converts a ip-string in an address32
|
||||||
dns-find-nameserver ; returns a nameserver
|
dns-find-nameserver ; returns a nameserver
|
||||||
dns-find-nameserver-list ; returns a list of nameservers
|
dns-find-nameserver-list ; returns a list of nameservers
|
||||||
|
dns-check-nameservers ; checks for working nameservers
|
||||||
socket-address->fqdn
|
socket-address->fqdn
|
||||||
host-fqdn
|
host-fqdn
|
||||||
system-fqdn))
|
system-fqdn))
|
||||||
|
|
Loading…
Reference in New Issue