Merge branch 'master' into core-updates

5 files changed, 58 insertions, 11 deletions

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index f7f7edda48..cfe0a37c42 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -463,6 +463,10 @@ host file systems to mount inside the container.  If USER is not #f, each
 target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER
 will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
 ~/.guix-profile to the environment profile."
+  (define (optional-mapping->fs mapping)
+    (and (file-exists? (file-system-mapping-source mapping))
+         (file-system-mapping->bind-mount mapping)))
+
   (mlet %store-monad ((reqs (inputs->requisites
                              (list (direct-store-path bash) profile))))
     (return
@@ -499,11 +503,6 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
                                   (target cwd)
                                   (writable? #t)))
                            '())))
-              ;; When in Rome, do as Nix build.cc does: Automagically
-              ;; map common network configuration files.
-              (if network?
-                  %network-file-mappings
-                  '())
               ;; Mappings for the union closure of all inputs.
               (map (lambda (dir)
                      (file-system-mapping
@@ -512,6 +511,10 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
                       (writable? #f)))
                    reqs)))
             (file-systems (append %container-file-systems
+                                  (if network?
+                                      (filter-map optional-mapping->fs
+                                                  %network-file-mappings)
+                                      '())
                                   (map file-system-mapping->bind-mount
                                        mappings))))
        (exit/status
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 31657326b6..3f20a2e192 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -57,6 +57,8 @@ Invoke the garbage collector.\n"))
   (display (G_ "
       --list-roots       list the user's garbage collector roots"))
   (display (G_ "
+      --list-busy        list store items used by running processes"))
+  (display (G_ "
       --optimize         optimize the store by deduplicating identical files"))
   (display (G_ "
       --list-dead        list dead paths"))
@@ -174,6 +176,10 @@ is deprecated; use '-D'~%"))
                 (lambda (opt name arg result)
                   (alist-cons 'action 'list-roots
                               (alist-delete 'action result))))
+        (option '("list-busy") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'action 'list-busy
+                              (alist-delete 'action result))))
         (option '("list-dead") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'action 'list-dead
@@ -265,6 +271,12 @@ is deprecated; use '-D'~%"))
                   (newline))
                 roots)))
 
+  (define (list-busy)
+    ;; List store items used by running processes.
+    (for-each (lambda (item)
+                (display item) (newline))
+              (busy-store-items)))
+
   (with-error-handling
     (let* ((opts  (parse-options))
            (store (open-connection))
@@ -305,6 +317,9 @@ is deprecated; use '-D'~%"))
         ((list-roots)
          (assert-no-extra-arguments)
          (list-roots))
+        ((list-busy)
+         (assert-no-extra-arguments)
+         (list-busy))
         ((delete)
          (delete-paths store (map direct-store-path paths)))
         ((list-references)
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index cab9a4397b..7ae8638911 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -2,6 +2,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -75,6 +76,7 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
                   (alist-cons 'argument arg result))
                 %default-options))
 
+
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
                             (('argument . value)
@@ -82,11 +84,16 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
                             (_ #f))
                            (reverse opts))))
     (match args
-      ((package-name)
-       (let ((sexp (crate->guix-package package-name)))
+      ((spec)
+       (define-values (name version)
+         (package-name->name+version spec))
+
+       (let ((sexp (crate->guix-package name version)))
          (unless sexp
            (leave (G_ "failed to download meta-data for package '~a'~%")
-                  package-name))
+                  (if version
+                      (string-append name "@" version)
+                      name)))
          sexp))
       (()
        (leave (G_ "too few arguments~%")))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index de5b3fc0ff..920d6c01fe 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -516,6 +516,18 @@ the image."
               `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
                 ,@(append-map symlink->directives '#$symlinks)))
 
+            (define tag
+              ;; Compute a meaningful "repository" name, which will show up in
+              ;; the output of "docker images".
+              (let ((manifest (profile-manifest #$profile)))
+                (let loop ((names (map manifest-entry-name
+                                       (manifest-entries manifest))))
+                  (define str (string-join names "-"))
+                  (if (< (string-length str) 40)
+                      str
+                      (match names
+                        ((_) str)
+                        ((names ... _) (loop names))))))) ;drop one entry
 
             (setenv "PATH" (string-append #$archiver "/bin"))
 
@@ -524,6 +536,7 @@ the image."
                                      (call-with-input-file "profile"
                                        read-reference-graph))
                                 #$profile
+                                #:repository tag
                                 #:database #+database
                                 #:system (or #$target (utsname:machine (uname)))
                                 #:environment environment
@@ -944,7 +957,8 @@ Create a bundle of PACKAGE.\n"))
                                   (list (transform store package) output))
                                  ((? package? package)
                                   (list (transform store package) "out")))
-                               (filter-map maybe-package-argument opts)))
+                               (reverse
+                                (filter-map maybe-package-argument opts))))
            (manifest-file (assoc-ref opts 'manifest)))
       (define properties
         (if (assoc-ref opts 'save-provenance?)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 4591d0f308..daf6fcf947 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -368,8 +368,16 @@ the latest known version of ~a (~a)~%")
                      (upstream-source-version source)))))))
     (#f
      (when warn?
-       (warn-no-updater package)))))
-
+       ;; Distinguish between "no updater" and "failing updater."
+       (match (lookup-updater package updaters)
+         ((? upstream-updater? updater)
+          (warning (package-location package)
+                   (G_ "'~a' updater failed to determine available \
+releases for ~a~%")
+                   (upstream-updater-name updater)
+                   (package-name package)))
+         (#f
+          (warn-no-updater package)))))))
 
 
 ;;;