http/ftp: Tweak to avoid depending on libc's NSS.

* guix/build/http.scm (open-connection-for-uri): New procedure.
  (http-fetch): Use it.  Pass the result as a #:port argument to
  `http-get'.
  Add hack to modify the `set-port-encoding!' binding in (web response).

* guix/ftp-client.scm (ftp-open): Add optional `port' parameter,
  defaulting to 21.  When calling `getaddrinfo', convert PORT to a
  string and pass AI_NUMERICSERV when PORT is a number.
This commit is contained in:
Ludovic Courtès 2012-10-18 22:21:26 +02:00
parent 1c3972daa8
commit d14ecda913
2 changed files with 59 additions and 5 deletions

View File

@ -29,13 +29,61 @@
;;;
;;; Code:
(define (open-connection-for-uri uri)
"Return an open input/output port for a connection to URI.
This is the same as Guile's `open-socket-for-uri', except that we always
use a numeric port argument, to avoid the need to go through libc's NSS,
which is not available during bootstrap."
(define addresses
(let ((port (or (uri-port uri)
(case (uri-scheme uri)
((http) 80) ; /etc/services, not for me!
(else
(error "unsupported URI scheme" uri))))))
(getaddrinfo (uri-host uri)
(number->string port)
AI_NUMERICSERV)))
(let loop ((addresses addresses))
(let* ((ai (car addresses))
(s (with-fluids ((%default-port-encoding #f))
(socket (addrinfo:fam ai) (addrinfo:socktype ai)
(addrinfo:protocol ai)))))
(catch 'system-error
(lambda ()
(connect s (addrinfo:addr ai))
;; Buffer input and output on this port.
(setvbuf s _IOFBF)
;; Enlarge the receive buffer.
(setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024))
s)
(lambda args
;; Connection failed, so try one of the other addresses.
(close s)
(if (null? addresses)
(apply throw args)
(loop (cdr addresses))))))))
;; XXX: This is an awful hack to make sure the (set-port-encoding! p
;; "ISO-8859-1") call in `read-response' passes, even during bootstrap
;; where iconv is not available.
(module-define! (resolve-module '(web response))
'set-port-encoding!
(lambda (p e) #f))
(define (http-fetch url file)
"Fetch data from URL and write it to FILE. Return FILE on success."
;; FIXME: Use a variant of `http-get' that returns a port instead of
;; loading everything in memory.
(let-values (((resp bv)
(http-get (string->uri url) #:decode-body? #f)))
(let*-values (((uri)
(string->uri url))
((connection)
(open-connection-for-uri uri))
((resp bv)
(http-get uri #:port connection #:decode-body? #f)))
(call-with-output-file file
(lambda (p)
(put-bytevector p bv))))

View File

@ -80,12 +80,18 @@
((331) (%ftp-command (string-append "PASS " pass) 230 port))
(else (throw 'ftp-error port command code message))))))
(define (ftp-open host)
"Open an FTP connection to HOST, and return it."
(define* (ftp-open host #:optional (port 21))
"Open an FTP connection to HOST on PORT (a service-identifying string,
or a TCP port number), and return it."
;; Use 21 as the default PORT instead of "ftp", to avoid depending on
;; libc's NSS, which is not available during bootstrap.
(catch 'getaddrinfo-error
(lambda ()
(define addresses
(getaddrinfo host "ftp"))
(getaddrinfo host
(if (number? port) (number->string port) port)
(if (number? port) AI_NUMERICSERV 0)))
(let loop ((addresses addresses))
(let* ((ai (car addresses))