From b9d724982d01899ca09b02f889e7207e06a43803 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 17 Dec 2012 00:27:00 +0100 Subject: [PATCH] web: Correctly detect "No route to host" conditions. * module/web/client.scm (open-socket-for-uri): Delete addrinfos with the same address. Always open SOCK_STREAM/IPPROTO_IP sockets. Fix the error handler's condition to determine what to do. Reported by Nikita Karetnikov at . --- module/web/client.scm | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/module/web/client.scm b/module/web/client.scm index df0a74900..6aedb751e 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -38,6 +38,7 @@ #:use-module (web request) #:use-module (web response) #:use-module (web uri) + #:use-module (srfi srfi-1) #:export (open-socket-for-uri http-get http-get*)) @@ -46,19 +47,21 @@ "Return an open input/output port for a connection to URI." (define addresses (let ((port (uri-port uri))) - (getaddrinfo (uri-host uri) - (cond (port => number->string) - (else (symbol->string (uri-scheme uri)))) - (if port - AI_NUMERICSERV - 0)))) + (delete-duplicates + (getaddrinfo (uri-host uri) + (cond (port => number->string) + (else (symbol->string (uri-scheme uri)))) + (if port + AI_NUMERICSERV + 0)) + (lambda (ai1 ai2) + (equal? (addrinfo:addr ai1) (addrinfo:addr ai2)))))) (let loop ((addresses addresses)) (let* ((ai (car addresses)) - (s (socket (addrinfo:fam ai) (addrinfo:socktype ai) - (addrinfo:protocol ai)))) - (set-port-encoding! s "ISO-8859-1") - + (s (with-fluids ((%default-port-encoding #f)) + ;; Restrict ourselves to TCP. + (socket (addrinfo:fam ai) SOCK_STREAM IPPROTO_IP)))) (catch 'system-error (lambda () (connect s (addrinfo:addr ai)) @@ -71,7 +74,7 @@ (lambda args ;; Connection failed, so try one of the other addresses. (close s) - (if (null? addresses) + (if (null? (cdr addresses)) (apply throw args) (loop (cdr addresses))))))))