substitute: Better abbreviate substitute URL in progress report.
Suggested by Danny Milosavljevic <dannym@scratchpost.org>. * guix/build/download.scm (nar-uri-abbreviation): New procedure. * guix/scripts/substitute.scm (process-substitution): Use it instead of 'store-path-abbreviation'.master
parent
3e31ec827a
commit
cf5e58297d
|
@ -42,6 +42,7 @@
|
||||||
current-terminal-columns
|
current-terminal-columns
|
||||||
progress-proc
|
progress-proc
|
||||||
uri-abbreviation
|
uri-abbreviation
|
||||||
|
nar-uri-abbreviation
|
||||||
store-path-abbreviation))
|
store-path-abbreviation))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
@ -222,6 +223,17 @@ abbreviation of URI showing the scheme, host, and basename of the file."
|
||||||
uri-as-string))
|
uri-as-string))
|
||||||
uri-as-string))
|
uri-as-string))
|
||||||
|
|
||||||
|
(define (nar-uri-abbreviation uri)
|
||||||
|
"Abbreviate URI, which is assumed to be the URI of a nar as served by Hydra
|
||||||
|
and 'guix publish', something like
|
||||||
|
\"http://example.org/nar/1ldrllwbna0aw5z8kpci4fsvbd2w8cw4-texlive-bin-2015\"."
|
||||||
|
(let* ((uri (if (string? uri) (string->uri uri) uri))
|
||||||
|
(path (basename (uri-path uri))))
|
||||||
|
(if (and (> (string-length path) 33)
|
||||||
|
(char=? (string-ref path 32) #\-))
|
||||||
|
(string-drop path 33)
|
||||||
|
path)))
|
||||||
|
|
||||||
(define (ftp-fetch uri file)
|
(define (ftp-fetch uri file)
|
||||||
"Fetch data from URI and write it to FILE. Return FILE on success."
|
"Fetch data from URI and write it to FILE. Return FILE on success."
|
||||||
(let* ((conn (ftp-open (uri-host uri)))
|
(let* ((conn (ftp-open (uri-host uri)))
|
||||||
|
|
|
@ -32,7 +32,7 @@
|
||||||
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
|
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
|
||||||
#:use-module ((guix build download)
|
#:use-module ((guix build download)
|
||||||
#:select (current-terminal-columns
|
#:select (current-terminal-columns
|
||||||
progress-proc uri-abbreviation
|
progress-proc uri-abbreviation nar-uri-abbreviation
|
||||||
open-connection-for-uri
|
open-connection-for-uri
|
||||||
close-connection
|
close-connection
|
||||||
store-path-abbreviation byte-count->string))
|
store-path-abbreviation byte-count->string))
|
||||||
|
@ -896,11 +896,11 @@ DESTINATION as a nar file. Verify the substitute against ACL."
|
||||||
(dl-size (or download-size
|
(dl-size (or download-size
|
||||||
(and (equal? comp "none")
|
(and (equal? comp "none")
|
||||||
(narinfo-size narinfo))))
|
(narinfo-size narinfo))))
|
||||||
(progress (progress-proc (uri-abbreviation uri)
|
(progress (progress-proc (uri->string uri)
|
||||||
dl-size
|
dl-size
|
||||||
(current-error-port)
|
(current-error-port)
|
||||||
#:abbreviation
|
#:abbreviation
|
||||||
store-path-abbreviation)))
|
nar-uri-abbreviation)))
|
||||||
(progress-report-port progress raw)))
|
(progress-report-port progress raw)))
|
||||||
((input pids)
|
((input pids)
|
||||||
(decompressed-port (and=> (narinfo-compression narinfo)
|
(decompressed-port (and=> (narinfo-compression narinfo)
|
||||||
|
|
Loading…
Reference in New Issue