Merge branch 'staging' into core-updates

9 files changed, 123 insertions, 50 deletions

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index ba143ad16b..8fa700c883 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -65,7 +65,7 @@
 
 (define %default-log-urls
   ;; Default base URLs for build logs.
-  '("http://ci.guix.info/log"))
+  '("http://ci.guix.gnu.org/log"))
 
 ;; XXX: The following procedure cannot be in (guix store) because of the
 ;; dependency on (guix derivations).
@@ -370,7 +370,10 @@ a checkout of the Git repository at the given URL."
                       (package
                         (inherit old)
                         (source (git-checkout (url url)
-                                              (recursive? #t)))))))))
+                                              (recursive? #t)))))))
+             (_
+              (leave (G_ "~a: invalid Git URL replacement specification~%")
+                     spec))))
          replacement-specs))
 
   (define rewrite
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 99c351ae43..c1341628a8 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -341,7 +341,7 @@ for the corresponding packages."
                      (list (package->manifest-entry* package output))))
                   (('package 'package (? string? spec))
                    (package-environment-inputs
-                    (specification->package+output spec)))
+                    (transform (specification->package+output spec))))
                   (('expression mode str)
                    ;; Add all the outputs of the package STR evaluates to.
                    (packages->outputs (read/eval str) mode))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 2a7b84b847..802b26c64c 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -724,6 +724,10 @@ please email '~a'~%")
                       (alist-cons 'profile-name arg result))
                      (_
                       (leave (G_ "~a: unsupported profile name~%") arg)))))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
+
          (option '(#\v "verbosity") #t #f
                  (lambda (opt name arg result)
                    (let ((level (string->number* arg)))
@@ -769,6 +773,9 @@ Create a bundle of PACKAGE.\n"))
       --profile-name=NAME
                          populate /var/guix/profiles/.../NAME"))
   (display (G_ "
+  -r, --root=FILE        make FILE a symlink to the result, and register it
+                         as a garbage collector root"))
+  (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (G_ "
       --bootstrap        use the bootstrap binaries to build the pack"))
@@ -882,7 +889,11 @@ Create a bundle of PACKAGE.\n"))
                                  (leave (G_ "~a: unknown pack format~%")
                                         pack-format))))
                  (localstatedir? (assoc-ref opts 'localstatedir?))
-                 (profile-name   (assoc-ref opts 'profile-name)))
+                 (profile-name   (assoc-ref opts 'profile-name))
+                 (gc-root        (assoc-ref opts 'gc-root)))
+            (when (null? (manifest-entries manifest))
+              (warning (G_ "no packages specified; building an empty pack~%")))
+
             (run-with-store store
               (mlet* %store-monad ((profile (profile-derivation
                                              manifest
@@ -919,6 +930,11 @@ Create a bundle of PACKAGE.\n"))
                                        #:dry-run? dry-run?)
                   (munless dry-run?
                     (built-derivations (list drv))
+                    (mwhen gc-root
+                      (register-root* (match (derivation->output-paths drv)
+                                        (((names . items) ...)
+                                         items))
+                                      gc-root))
                     (return (format #t "~a~%"
                                     (derivation->output-path drv))))))
               #:system (assoc-ref opts 'system))))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index aa27984ea2..06e4cf5b9c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -180,9 +180,9 @@ hooks\" run when building the profile."
 ;;;
 
 (define (find-packages-by-description regexps)
-  "Return two values: the list of packages whose name, synopsis, or
-description matches at least one of REGEXPS sorted by relevance, and the list
-of relevance scores."
+  "Return two values: the list of packages whose name, synopsis, description,
+or output matches at least one of REGEXPS sorted by relevance, and the list of
+relevance scores."
   (let ((matches (fold-packages (lambda (package result)
                                   (if (package-superseded package)
                                       result
diff --git a/guix/scripts/processes.scm b/guix/scripts/processes.scm
index 6a2f603599..a2ab017490 100644
--- a/guix/scripts/processes.scm
+++ b/guix/scripts/processes.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -103,9 +103,16 @@ processes."
   (let ((directory (string-append "/proc/"
                                   (number->string (process-id process))
                                   "/fd")))
-    (map (lambda (fd)
-           (readlink (string-append directory "/" fd)))
-         (or (scandir directory string->number) '()))))
+    (filter-map (lambda (fd)
+                  ;; There's a TOCTTOU race here, hence the 'catch'.
+                  (catch 'system-error
+                    (lambda ()
+                      (readlink (string-append directory "/" fd)))
+                    (lambda args
+                      (if (= ENOENT (system-error-errno args))
+                          #f
+                          (apply throw args)))))
+                (or (scandir directory string->number) '()))))
 
 ;; Daemon session.
 (define-record-type <daemon-session>
@@ -151,15 +158,22 @@ active sessions, and the master 'guix-daemon' process."
                      (= pid (process-parent-id process))))
               processes))
 
-    (values (map (lambda (process)
-                   (match (process-command process)
-                     ((argv0 (= string->number client) _ ...)
-                      (let ((files (process-open-files process)))
-                        (daemon-session process
-                                        (lookup-process client)
-                                        (lookup-children (process-id process))
-                                        (filter lock-file? files))))))
-                 children)
+    (define (child-process->session process)
+      (match (process-command process)
+        ((argv0 (= string->number client) _ ...)
+         (let ((files  (process-open-files process))
+               (client (lookup-process client)))
+           ;; After a client has died, there's a window during which its
+           ;; corresponding 'guix-daemon' process is still alive, in which
+           ;; case 'lookup-process' returns #f.  In that case ignore the
+           ;; session.
+           (and client
+                (daemon-session process client
+                                (lookup-children
+                                 (process-id process))
+                                (filter lock-file? files)))))))
+
+    (values (filter-map child-process->session children)
             master)))
 
 (define (daemon-session->recutils session port)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 3929cd402e..2d428546c9 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -203,6 +203,10 @@ true, display what would be built without actually building it."
   (define update-profile
     (store-lift build-and-use-profile))
 
+  (define guix-command
+    ;; The 'guix' command before we've built the new profile.
+    (which "guix"))
+
   (mlet %store-monad ((manifest (channel-instances->manifest instances)))
     (mbegin %store-monad
       (update-profile profile manifest
@@ -211,17 +215,18 @@ true, display what would be built without actually building it."
       (munless dry-run?
         (return (newline))
         (return (display-profile-news profile #:concise? #t))
-        (match (which "guix")
-          (#f (return #f))
-          (str
-           (let ((new (map (cut string-append <> "/bin/guix")
-                           (list (user-friendly-profile profile)
-                                 profile))))
-             (unless (member str new)
-               (display-hint (format #f (G_ "After setting @code{PATH}, run
+        (if guix-command
+            (let ((new (map (cut string-append <> "/bin/guix")
+                            (list (user-friendly-profile profile)
+                                  profile))))
+              ;; Is the 'guix' command previously in $PATH the same as the new
+              ;; one?  If the answer is "no", then suggest 'hash guix'.
+              (unless (member guix-command new)
+                (display-hint (format #f (G_ "After setting @code{PATH}, run
 @command{hash guix} to make sure your shell refers to @file{~a}.")
-                                     (first new))))
-             (return #f))))))))
+                                      (first new))))
+              (return #f))
+            (return #f))))))
 
 (define (honor-lets-encrypt-certificates! store)
   "Tell Guile-Git to use the Let's Encrypt certificates."
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 797a76db3f..135398ba48 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -1061,7 +1061,7 @@ found."
     (#f
      ;; This can only happen when this script is not invoked by the
      ;; daemon.
-     '("http://ci.guix.info"))))
+     '("http://ci.guix.gnu.org"))))
 
 (define substitute-urls
   ;; List of substitute URLs.
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3c3d6cbd5f..60c1ca5c9a 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -756,13 +757,17 @@ checking this by themselves in their 'check' procedure."
 
 (define* (system-derivation-for-action os action
                                        #:key image-size file-system-type
-                                       full-boot? mappings)
+                                       full-boot? container-shared-network?
+                                       mappings)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
      (operating-system-derivation os))
     ((container)
-     (container-script os #:mappings mappings))
+     (container-script
+      os
+      #:mappings mappings
+      #:shared-network? container-shared-network?))
     ((vm-image)
      (system-qemu-image os #:disk-image-size image-size))
     ((vm)
@@ -781,7 +786,7 @@ checking this by themselves in their 'check' procedure."
                         #:disk-image-size image-size
                         #:file-system-type file-system-type))
     ((docker-image)
-     (system-docker-image os #:register-closures? #t))))
+     (system-docker-image os))))
 
 (define (maybe-suggest-running-guix-pull)
   "Suggest running 'guix pull' if this has never been done before."
@@ -826,6 +831,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
                          image-size file-system-type full-boot?
+                         container-shared-network?
                          (mappings '())
                          (gc-root #f))
   "Perform ACTION for OS.  INSTALL-BOOTLOADER? specifies whether to install
@@ -834,6 +840,8 @@ target root directory; IMAGE-SIZE is the size of the image to be built, for
 the 'vm-image' and 'disk-image' actions.  The root file system is created as a
 FILE-SYSTEM-TYPE file system.  FULL-BOOT? is used for the 'vm' action; it
 determines whether to boot directly to the kernel or to the bootloader.
+CONTAINER-SHARED-NETWORK? determines if the container will use a separate
+network namespace.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
 building anything.
@@ -883,6 +891,7 @@ static checks."
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
+                                                #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
 
        ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
@@ -1020,6 +1029,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (G_ "
+  -N, --network          for 'container', allow containers to access the network"))
+  (display (G_ "
   -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
                          and 'build', make FILE a symlink to the result, and
                          register it as a garbage collector root"))
@@ -1066,6 +1077,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'image-size (size->number arg)
                                result)))
+         (option '(#\N "network") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'container-shared-network? #t result)))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
@@ -1129,22 +1143,30 @@ Some ACTIONS support additional ARGS.\n"))
 ACTION must be one of the sub-commands that takes an operating system
 declaration as an argument (a file name.)  OPTS is the raw alist of options
 resulting from command-line parsing."
+  (define (ensure-operating-system file-or-exp obj)
+    (unless (operating-system? obj)
+      (leave (G_ "'~a' does not return an operating system~%")
+             file-or-exp))
+    obj)
+
   (let* ((file        (match args
                         (() #f)
                         ((x . _) x)))
          (expr        (assoc-ref opts 'expression))
          (system      (assoc-ref opts 'system))
-         (os          (cond
-                       ((and expr file)
-                        (leave
-                         (G_ "both file and expression cannot be specified~%")))
-                       (expr
-                        (read/eval expr))
-                       (file
-                        (load* file %user-module
-                                    #:on-error (assoc-ref opts 'on-error)))
-                       (else
-                        (leave (G_ "no configuration specified~%")))))
+         (os          (ensure-operating-system
+                       (or file expr)
+                       (cond
+                        ((and expr file)
+                         (leave
+                          (G_ "both file and expression cannot be specified~%")))
+                        (expr
+                         (read/eval expr))
+                        (file
+                         (load* file %user-module
+                                #:on-error (assoc-ref opts 'on-error)))
+                        (else
+                         (leave (G_ "no configuration specified~%"))))))
 
          (dry?        (assoc-ref opts 'dry-run?))
          (bootloader? (assoc-ref opts 'install-bootloader?))
@@ -1182,6 +1204,8 @@ resulting from command-line parsing."
                              #:file-system-type (assoc-ref opts 'file-system-type)
                              #:image-size (assoc-ref opts 'image-size)
                              #:full-boot? (assoc-ref opts 'full-boot?)
+                             #:container-shared-network?
+                             (assoc-ref opts 'container-shared-network?)
                              #:mappings (filter-map (match-lambda
                                                       (('file-system-mapping . m)
                                                        m)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 4b12f9550e..78b8674e0c 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -252,7 +252,7 @@ are queued~%")
 ;;;
 
 (define (show-help)
-  (display (G_ "Usage: guix weather [OPTIONS]
+  (display (G_ "Usage: guix weather [OPTIONS] [PACKAGES ...]
 Report the availability of substitutes.\n"))
   (display (G_ "
       --substitute-urls=URLS
@@ -469,6 +469,20 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
 ;;;
 
 (define (guix-weather . args)
+  (define (package-list opts)
+    ;; Return the package list specified by OPTS.
+    (let ((file (assoc-ref opts 'manifest))
+          (base (filter-map (match-lambda
+                              (('argument . spec)
+                               (specification->package spec))
+                              (_
+                               #f))
+                            opts)))
+      (if (and (not file) (null? base))
+          (all-packages)
+          (append base
+                  (if file (load-manifest file) '())))))
+
   (with-error-handling
     (parameterize ((current-terminal-columns (terminal-columns)))
       (let* ((opts     (parse-command-line args %options
@@ -481,10 +495,7 @@ SERVER.  Display information for packages with at least THRESHOLD dependents."
                                           opts)
                          (() (list (%current-system)))
                          (systems systems)))
-             (packages (let ((file (assoc-ref opts 'manifest)))
-                         (if file
-                             (load-manifest file)
-                             (all-packages))))
+             (packages (package-list opts))
              (items    (with-store store
                          (parameterize ((%graft? #f))
                            (concatenate