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