substitute: Remove redundant fetch arguments.

It's just called in one place, with hardcoded argument values, so just inline
them.

* guix/scripts/substitute.scm (fetch): Remove arguments that don't vary, copy
the values from the call site in process-substitution.
(process-substitution): Remove unnecessary argument values from fetch call.
This commit is contained in:
Christopher Baines 2021-01-07 20:40:50 +00:00
parent 7c85877fdf
commit b9d058e3f7
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577

View file

@ -169,18 +169,12 @@ (define-syntax-rule (with-timeout duration handler body ...)
(sigaction SIGALRM SIG_DFL)
(apply values result)))))
(define* (fetch uri #:key (buffered? #t) (timeout? #t)
(keep-alive? #f))
(define (fetch uri)
"Return a binary input port to URI and the number of bytes it's expected to
provide.
When PORT is true, use it as the underlying I/O port for HTTP transfers; when
PORT is false, open a new connection for URI. When KEEP-ALIVE? is true, the
connection (typically PORT) is kept open once data has been fetched from URI."
provide."
(case (uri-scheme uri)
((file)
(let ((port (open-file (uri-path uri)
(if buffered? "rb" "r0b"))))
(let ((port (open-file (uri-path uri) "r0b")))
(values port (stat:size (stat port)))))
((http https)
(guard (c ((http-get-error? c)
@ -192,17 +186,15 @@ (define* (fetch uri #:key (buffered? #t) (timeout? #t)
;; sudo tc qdisc add dev eth0 root netem delay 1500ms
;; and then cancel with:
;; sudo tc qdisc del dev eth0 root
(with-timeout (if timeout?
%fetch-timeout
0)
(with-timeout %fetch-timeout
(begin
(warning (G_ "while fetching ~a: server is somewhat slow~%")
(uri->string uri))
(warning (G_ "try `--no-substitutes' if the problem persists~%")))
(http-fetch uri #:text? #f
#:open-connection open-connection-for-uri/maybe
#:keep-alive? keep-alive?
#:buffered? buffered?
#:keep-alive? #t
#:buffered? #f
#:verify-certificate? #f))))
(else
(leave (G_ "unsupported substitute URI scheme: ~a~%")
@ -727,8 +719,7 @@ (define (dump-file/deduplicate* . args)
(let*-values (((raw download-size)
;; 'guix publish' without '--cache' doesn't specify a
;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
(fetch uri #:buffered? #f #:timeout? #f
#:keep-alive? #t))
(fetch uri))
((progress)
(let* ((dl-size (or download-size
(and (equal? compression "none")