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:
parent
1c3972daa8
commit
d14ecda913
@ -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))))
|
||||
|
@ -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))
|
||||
|
Loading…
Reference in New Issue
Block a user