Skip to content
Snippets Groups Projects
Commit cf5e5829 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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'.
parent 3e31ec82
No related branches found
No related tags found
No related merge requests found
...@@ -42,6 +42,7 @@ (define-module (guix build download) ...@@ -42,6 +42,7 @@ (define-module (guix build download)
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 @@ (define (elide-path) ...@@ -222,6 +223,17 @@ (define (elide-path)
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 @@ (define-module (guix scripts substitute) ...@@ -32,7 +32,7 @@ (define-module (guix scripts substitute)
#: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 @@ (define* (process-substitution store-item destination ...@@ -896,11 +896,11 @@ (define* (process-substitution store-item destination
(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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment