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

concurrent lookup changes

This commit is contained in:
cresh 2002-07-23 08:48:47 +00:00
parent 17a3dac645
commit efab1a3161
2 changed files with 15 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
scheme/lib/dns.scm
View File

@ -41,9 +41,12 @@
; dns-lookup-ip can either be given an ip-string or an ip-address32. ; dns-lookup-ip can either be given an ip-string or an ip-address32.
; ;
; concurrent dns lookup: ; concurrent dns lookup:
; a concurrent lookup to all nameservers in /etc/resolv.conf is started, ; if a list of nameservers is given to the optional <nameserver> argument,
; if the variable dns-concurrent-lookup is given as optional <nameserver> ; a concurrent lookup to all nameservers in this list is started.
; argument. ; The nameservers in this list could either be ip-strings or ip-address32s.
; example: (dns-lookup-name "www.uni-tuebingen.de" (dns-find-nameserver-list))
; starts an concurrent lookup which contacts all nameservers in
; /etc/resolv.conf.
; ;
; ;
; (dns-lookup <name | ip-string | ip-address32> <type> [nameserver]) ; (dns-lookup <name | ip-string | ip-address32> <type> [nameserver])
@ -163,11 +166,7 @@
(else (more)))) (else (more))))
;; concurrent-flag
(define dns-concurrent-lookup 'dns-concurrent-lookup)
;;; -- globals and types ;;; -- globals and types
;; off ;; off
(define *nul* (ascii->char 0)) (define *nul* (ascii->char 0))
@ -997,11 +996,15 @@
;; concurrent-lookup ;; concurrent-lookup
;; starts a <lookup>-lookup to all nameservers in (dns-find-nameserver-list) ;; starts a <lookup>-lookup to all nameservers in (dns-find-nameserver-list)
(define (concurrent-lookup lookup name) (define (concurrent-lookup lookup name nameservers)
(let* ((return 'no-value) (let* ((return 'no-value)
(lock (make-lock)) (lock (make-lock))
(queue (make-queue)) (queue (make-queue))
(nameserver-list (dns-find-nameserver-list))) (nameserver-list (map (lambda (nameserver)
(if (address32? nameserver)
(address32->ip-string nameserver)
nameserver))
nameservers)))
(obtain-lock lock) (obtain-lock lock)
@ -1014,7 +1017,7 @@
(enqueue! queue result) (enqueue! queue result)
;(display "received reply from ")(display nameserver)(display ": ")(display result)(newline) ;(display "received reply from ")(display nameserver)(display ": ")(display result)(newline)
(release-lock lock))))) (release-lock lock)))))
(map (lambda (adr32) (address32->ip-string adr32)) (dns-find-nameserver-list))))) nameserver-list)))
(obtain-lock lock) (obtain-lock lock)
(let loop ((count (length nameserver-list))) (let loop ((count (length nameserver-list)))
@ -1070,8 +1073,8 @@
(lambda (name . args) (lambda (name . args)
(if (null? args) (if (null? args)
(simple-lookup-function name) (simple-lookup-function name)
(if (eq? (car args) dns-concurrent-lookup) (if (list? (car args))
(concurrent-lookup simple-lookup-function name) (concurrent-lookup simple-lookup-function name (car args))
(simple-lookup-function name (car args)))))) (simple-lookup-function name (car args))))))
;; looks up a hostname, returns an ip. ;; looks up a hostname, returns an ip.

1
scheme/packages.scm
View File

@ -189,7 +189,6 @@
dns-lookup-ip ; simple lookup function dns-lookup-ip ; simple lookup function
dns-lookup-nameserver ; simple lookup function dns-lookup-nameserver ; simple lookup function
dns-lookup-mail-exchanger ; simple lookpu function dns-lookup-mail-exchanger ; simple lookpu function
dns-concurrent-lookup ; the concurrent lookup variable
show-dns-message ; prints a human readable dns-msg show-dns-message ; prints a human readable dns-msg
force-ip ; reruns a lookup until a ip is resolved force-ip ; reruns a lookup until a ip is resolved
force-ip-list ; reruns a lookup until a list of ips is resolved force-ip-list ; reruns a lookup until a list of ips is resolved