scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

* added dns-check-nameservers 

* fixed alists in send-receive-message-tcp
* fixed and added documentation
This commit is contained in:
cresh 2003-08-19 14:36:08 +00:00
parent c42a467ce5
commit 6f52781aa6
3 changed files with 131 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
doc/latex/dns.tex
View File

@ -149,6 +149,14 @@ accept. \var{Nameserver} is either a \ipaddr or a dotted IP string.
resolve these FQDNs.
\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}
This section describes a set of data structures and procedures which

135
scheme/lib/dns.scm
View File

@ -30,17 +30,25 @@
; if it is a domainname, its ip is looked up on a nameserver listed in
; /etc/resolv.conf.
;
; (dns-find-nameserver) --> <ip-address32>
; this parses the /etc/resolv.conf file and returns the first found
; nameserver in address32 format.
; (dns-find-nameserver-list) --> <ip-string list>
; this parses the /etc/resolv.conf file and returns the found
; 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-ip <ip-string | ip-address32> [nameserver]) --> <name>
; (dns-lookup-nameserver <name> [nameserver])
; (dns-lookup-name <name> [nameserver list] [use-cache?]) --> <ip-address32>
; (dns-lookup-ip <ip-string | ip-address32> [nameserver list] [use-cache?])
; --> <name>
; (dns-lookup-nameserver <name> [nameserver list] [use-cache?])
; --> <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>
;
; dns-lookup-name, dns-lookup-ip, dns-lookup-nameserver and
@ -57,7 +65,7 @@
; /etc/resolv.conf.
;
;
; (dns-lookup <name | ip-string | ip-address32> <type> [nameserver])
; (dns-lookup <name | ip-string | ip-address32> <type> [nameserver list])
; --> <dns-message>
; (show-dns-message <dns-message) --> the whole message, human readable
;
@ -780,9 +788,7 @@
;; here: via TCP
(define (send-receive-message-tcp nameservers query)
(receive (reply hit-ns other-nss)
(let ((sockets (filter
socket?
(map
(let ((sockets (map
(lambda (nameserver)
(let ((sock (create-socket protocol-family/internet
socket-type/stream))
@ -797,8 +803,18 @@
(lambda ()
(connect-socket-no-wait sock addr)
sock))))))
nameservers))))
(let* ((ws (map socket:outport sockets))
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
@ -1240,6 +1256,99 @@
(dns-error 'no-nameservers)
(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.
;; if a nameserver-name is given and not a nameserver-ip

1
scheme/packages.scm
View File

@ -155,6 +155,7 @@
ip-string->address32 ; converts a ip-string in an address32
dns-find-nameserver ; returns a nameserver
dns-find-nameserver-list ; returns a list of nameservers
dns-check-nameservers ; checks for working nameservers
socket-address->fqdn
host-fqdn
system-fqdn))