mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

web: Correctly detect "No route to host" conditions.

Browse source 
* 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 <nikita.karetnikov@gmail.com> at
  <http://lists.gnu.org/archive/html/bug-guix/2012-12/msg00150.html>.
This commit is contained in:
Ludovic Courtès 2012-12-17 00:27:00 +01:00
parent 21982d68ab
commit b9d724982d
1 changed files with 14 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

25
module/web/client.scm
View file

@ -38,6 +38,7 @@
#:use-module (web request) #:use-module (web request)
#:use-module (web response) #:use-module (web response)
#:use-module (web uri) #:use-module (web uri)
#:use-module (srfi srfi-1)
#:export (open-socket-for-uri #:export (open-socket-for-uri
http-get http-get
http-get*)) http-get*))
@ -46,19 +47,21 @@
"Return an open input/output port for a connection to URI." "Return an open input/output port for a connection to URI."
(define addresses (define addresses
(let ((port (uri-port uri))) (let ((port (uri-port uri)))
(getaddrinfo (uri-host uri) (delete-duplicates
(cond (port => number->string) (getaddrinfo (uri-host uri)
(else (symbol->string (uri-scheme uri)))) (cond (port => number->string)
(if port (else (symbol->string (uri-scheme uri))))
AI_NUMERICSERV (if port
0)))) AI_NUMERICSERV
0))
(lambda (ai1 ai2)
(equal? (addrinfo:addr ai1) (addrinfo:addr ai2))))))
(let loop ((addresses addresses)) (let loop ((addresses addresses))
(let* ((ai (car addresses)) (let* ((ai (car addresses))
(s (socket (addrinfo:fam ai) (addrinfo:socktype ai) (s (with-fluids ((%default-port-encoding #f))
(addrinfo:protocol ai)))) ;; Restrict ourselves to TCP.
(set-port-encoding! s "ISO-8859-1") (socket (addrinfo:fam ai) SOCK_STREAM IPPROTO_IP))))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect s (addrinfo:addr ai)) (connect s (addrinfo:addr ai))
@ -71,7 +74,7 @@
(lambda args (lambda args
;; Connection failed, so try one of the other addresses. ;; Connection failed, so try one of the other addresses.
(close s) (close s)
(if (null? addresses) (if (null? (cdr addresses))
(apply throw args) (apply throw args)
(loop (cdr addresses)))))))) (loop (cdr addresses))))))))