Merge branch 'master' into core-updates

5 files changed, 53 insertions, 9 deletions

diff --git a/guix/colors.scm b/guix/colors.scm
index 7949cf5763..b63ac37027 100644
--- a/guix/colors.scm
+++ b/guix/colors.scm
@@ -31,6 +31,8 @@
 
             colorize-string
             highlight
+            dim
+
             color-rules
             color-output?
             isatty?*))
@@ -133,14 +135,16 @@ that subsequent output will not have any colors in effect."
        (not (getenv "NO_COLOR"))
        (isatty?* port)))
 
-(define %highlight-color (color BOLD))
+(define (coloring-procedure color)
+  "Return a procedure that applies COLOR to the given string."
+  (lambda* (str #:optional (port (current-output-port)))
+    "Return STR with extra ANSI color attributes if PORT supports it."
+    (if (color-output? port)
+        (colorize-string str color)
+        str)))
 
-(define* (highlight str #:optional (port (current-output-port)))
-  "Return STR with extra ANSI color attributes to highlight it if PORT
-supports it."
-  (if (color-output? port)
-      (colorize-string str %highlight-color)
-      str))
+(define highlight (coloring-procedure (color BOLD)))
+(define dim (coloring-procedure (color DARK)))
 
 (define (colorize-matches rules)
   "Return a procedure that, when passed a string, returns that string
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index d8fe71ce12..22cd75ea0b 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -33,6 +33,7 @@
   #:use-module (web uri)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-14)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (rnrs bytevectors)
@@ -54,9 +55,23 @@
        (url-fetch url file #:mirrors %mirrors)))
     file))
 
+(define (ensure-valid-store-file-name name)
+  "Replace any character not allowed in a stror name by an underscore."
+
+  (define valid
+    ;; according to nix/libstore/store-api.cc
+    (string->char-set (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                                     "abcdefghijklmnopqrstuvwxyz"
+                                     "0123456789" "+-._?=")))
+  (string-map (lambda (c)
+                (if (char-set-contains? valid c) c #\_))
+              name))
+
+
 (define* (download-to-store* url #:key (verify-certificate? #t))
   (with-store store
     (download-to-store store url
+                       (ensure-valid-store-file-name (basename url))
                        #:verify-certificate? verify-certificate?)))
 
 (define %default-options
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f03741aa9e..1a58d43e5c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -39,6 +39,7 @@
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:autoload   (guix describe) (package-provenance)
+  #:autoload   (guix store roots) (gc-roots)
   #:use-module ((guix build utils)
                 #:select (directory-exists? mkdir-p))
   #:use-module (ice-9 format)
@@ -359,6 +360,8 @@ Install, remove, or upgrade packages in a single transaction.\n"))
                          switch to a generation matching PATTERN"))
   (display (G_ "
   -p, --profile=PROFILE  use PROFILE instead of the user's default profile"))
+  (display (G_ "
+      --list-profiles    list the user's profiles"))
   (newline)
   (display (G_ "
       --allow-collisions do not treat collisions in the profile as an error"))
@@ -458,6 +461,11 @@ command-line option~%")
                    (values (cons `(query list-generations ,arg)
                                  result)
                            #f)))
+         (option '("list-profiles") #f #f
+                 (lambda (opt name arg result arg-handler)
+                   (values (cons `(query list-profiles #t)
+                                 result)
+                           #f)))
          (option '(#\d "delete-generations") #f #t
                  (lambda (opt name arg result arg-handler)
                    (values (alist-cons 'delete-generations arg
@@ -750,6 +758,19 @@ processed, #f otherwise."
                              (string<? name1 name2))))))
          #t))
 
+      (('list-profiles _)
+       (let ((profiles (delete-duplicates
+                        (filter-map (lambda (root)
+                                      (and (or (zero? (getuid))
+                                               (user-owned? root))
+                                           (generation-profile root)))
+                                    (gc-roots)))))
+         (leave-on-EPIPE
+          (for-each (lambda (profile)
+                      (display (user-friendly-profile profile))
+                      (newline))
+                    (sort profiles string<?)))))
+
       (('search _)
        (let* ((patterns (filter-map (match-lambda
                                       (('query 'search rx) rx)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 2b7b991b50..0372278705 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -249,7 +249,7 @@ PORT."
     (channel-news-entry-body entry))
 
   (display-news-entry-title entry language port)
-  (format port (G_ "    commit ~a~%")
+  (format port (dim (G_ "    commit ~a~%"))
           (channel-news-entry-commit entry))
   (newline port)
   (format port "    ~a~%"
diff --git a/guix/self.scm b/guix/self.scm
index 7b0634e8b6..207e80d842 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -124,7 +124,11 @@ NODE's modules, under their FHS directories: share/guile/site and lib/guile."
           (symlink #$(node-compiled node) object))))
 
   (computed-file (string-append (node-name node) "-modules")
-                 build))
+                 build
+                 #:options '(#:local-build? #t
+
+                             ;; "Building" it locally is faster.
+                             #:substitutable? #f)))
 
 (define (node-fold proc init nodes)
   (let loop ((nodes nodes)