From cf5e58297d441e5e8f93e104f23eb3d18b2b51c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 20 Apr 2016 23:01:41 +0200
Subject: [PATCH] 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'.
---
guix/build/download.scm | 12 ++++++++++++
guix/scripts/substitute.scm | 6 +++---
2 files changed, 15 insertions(+), 3 deletions(-)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index fe7a453c89b..fec4cec3e82 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -42,6 +42,7 @@ (define-module (guix build download)
current-terminal-columns
progress-proc
uri-abbreviation
+ nar-uri-abbreviation
store-path-abbreviation))
;;; Commentary:
@@ -222,6 +223,17 @@ (define (elide-path)
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)
"Fetch data from URI and write it to FILE. Return FILE on success."
(let* ((conn (ftp-open (uri-host uri)))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index db0416b0c0a..0f0677fb224 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -32,7 +32,7 @@ (define-module (guix scripts substitute)
#:use-module ((guix build utils) #:select (mkdir-p dump-port))
#:use-module ((guix build download)
#:select (current-terminal-columns
- progress-proc uri-abbreviation
+ progress-proc uri-abbreviation nar-uri-abbreviation
open-connection-for-uri
close-connection
store-path-abbreviation byte-count->string))
@@ -896,11 +896,11 @@ (define* (process-substitution store-item destination
(dl-size (or download-size
(and (equal? comp "none")
(narinfo-size narinfo))))
- (progress (progress-proc (uri-abbreviation uri)
+ (progress (progress-proc (uri->string uri)
dl-size
(current-error-port)
#:abbreviation
- store-path-abbreviation)))
+ nar-uri-abbreviation)))
(progress-report-port progress raw)))
((input pids)
(decompressed-port (and=> (narinfo-compression narinfo)
--
GitLab