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

Use select-port-channels. TCP works now.

This commit is contained in:
mainzelm 2002-12-06 12:52:23 +00:00
parent 7e6da5347e
commit 0b57b16fe9
1 changed files with 28 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
scheme/lib/dns.scm
View File

@ -808,33 +808,30 @@
sock))
nameservers)))
(let* ((ws (map socket:outport sockets))
(wsv (list->vector ws))
(wport-nameserver-alist (map cons ws nameservers))
(wport-socket-alist (map cons ws sockets)))
(dynamic-wind
(lambda () #f)
(lambda ()
(receive (ignore-r write-ready ignore-e)
;;; TODO this should circumvent the buffer
(select '#() wsv '#())
(let* ((w (vector-ref write-ready 0))
(hit-ns (cdr (assoc w wport-nameserver-alist)))
(sock (cdr (assoc w wport-socket-alist))))
(if (not (connect-socket-successful? sock))
(dns-error 'bad-nameserver hit-ns))
(let ((query-string (list->string query))
(r (socket:inport sock)))
(display (list->string (add-size-tag query)) 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 (not (= len (string-length s)))
(dns-error 'unexpected-eof-from-server))
(let* ((ready-ports (apply select-port-channels #f ws))
(w (car ready-ports))
(hit-ns (cdr (assoc w wport-nameserver-alist)))
(sock (cdr (assoc w wport-socket-alist))))
(if (not (connect-socket-successful? sock))
(dns-error 'bad-nameserver hit-ns))
(let ((query-string (list->string query))
(r (socket:inport sock)))
(display (list->string (add-size-tag query)) 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 (not (= len (string-length s)))
(dns-error 'unexpected-eof-from-server))
(values (string->list s)
hit-ns
(delete hit-ns nameservers)))))))))
(delete hit-ns nameservers))))))))
(lambda ()
(for-each close-socket sockets)))))
(reply-acceptable? reply query)
@ -865,17 +862,15 @@
(rport-socket-alist (map cons rs sockets)))
(for-each (lambda (w) (display query-string w)) ws)
(for-each force-output ws)
(receive (read-ready ignore-w ignore-e)
;;; TODO this should circumvent the buffer
(select rsv '#() '#())
(let* ((r (vector-ref read-ready 0))
(hit-ns (cdr (assoc r rport-nameserver-alist))))
(if (not (connect-socket-successful? (cdr (assoc r rport-socket-alist))))
(dns-error 'bad-nameserver hit-ns))
(let* ((ready (apply select-port-channels #f rs))
(r (car ready))
(hit-ns (cdr (assoc r rport-nameserver-alist))))
(if (not (connect-socket-successful? (cdr (assoc r rport-socket-alist))))
(dns-error 'bad-nameserver hit-ns))
;;; 512 is the maximum udp-message size:
(values (string->list (read-string/partial 512 r))
hit-ns
(delete hit-ns nameservers))))))
(values (string->list (read-string/partial 512 r))
hit-ns
(delete hit-ns nameservers)))))
(lambda ()
(for-each close-socket sockets)))))
(reply-acceptable? reply query)
@ -1074,6 +1069,9 @@
;; TODO: cache result
(define (parse-resolv.conf)
;; accumulate nameserver entries
;; domain and search are mutual exclusive, take the last
(define (adjust-result rev-result have-search-or-domain? nameservers)
(cond ((null? rev-result)
(if (null? nameservers)