Merge branch 'master' into core-updates

5 files changed, 62 insertions, 25 deletions

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index fa56853fd1..7011a279d3 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -18,8 +18,8 @@
 
 (define-module (gnu system file-systems)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (guix records)
-  #:use-module (guix store)
   #:use-module ((gnu build file-systems)
                 #:select (string->uuid uuid->string))
   #:re-export (string->uuid
@@ -63,7 +63,11 @@
             file-system-mapping-target
             file-system-mapping-writable?
 
-            %store-mapping))
+            file-system-mapping->bind-mount
+
+            %store-mapping
+            %network-configuration-files
+            %network-file-mappings))
 
 ;;; Commentary:
 ;;;
@@ -95,6 +99,20 @@
   (dependencies     file-system-dependencies      ; list of <file-system>
                     (default '())))               ; or <mapped-device>
 
+;; Note: This module is used both on the build side and on the host side.
+;; Arrange not to pull (guix store) and (guix config) because the latter
+;; differs from user to user.
+(define (%store-prefix)
+  "Return the store prefix."
+  (cond ((resolve-module '(guix store) #:ensure #f)
+         =>
+         (lambda (store)
+           ((module-ref store '%store-prefix))))
+        ((getenv "NIX_STORE")
+         => identity)
+        (else
+         "/gnu/store")))
+
 (define %not-slash
   (char-set-complement (char-set #\/)))
 
@@ -352,6 +370,21 @@ TARGET in the other system."
   (writable? file-system-mapping-writable?        ;Boolean
              (default #f)))
 
+(define (file-system-mapping->bind-mount mapping)
+  "Return a file system that realizes MAPPING, a <file-system-mapping>, using
+a bind mount."
+  (match mapping
+    (($ <file-system-mapping> source target writable?)
+     (file-system
+       (mount-point target)
+       (device source)
+       (type "none")
+       (flags (if writable?
+                  '(bind-mount)
+                  '(bind-mount read-only)))
+       (check? #f)
+       (create-mount-point? #t)))))
+
 (define %store-mapping
   ;; Mapping of the host's store into the guest.
   (file-system-mapping
@@ -359,4 +392,23 @@ TARGET in the other system."
    (target (%store-prefix))
    (writable? #f)))
 
+(define %network-configuration-files
+  ;; List of essential network configuration files.
+  '("/etc/resolv.conf"
+    "/etc/nsswitch.conf"
+    "/etc/services"
+    "/etc/hosts"))
+
+(define %network-file-mappings
+  ;; List of file mappings for essential network files.
+  (filter-map (lambda (file)
+                (file-system-mapping
+                 (source file)
+                 (target file)
+                 ;; XXX: On some GNU/Linux systems, /etc/resolv.conf is a
+                 ;; symlink to a file in a tmpfs which, for an unknown reason,
+                 ;; cannot be bind mounted read-only within the container.
+                 (writable? (string=? file "/etc/resolv.conf"))))
+              %network-configuration-files))
+
 ;;; file-systems.scm ends here
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 7df7d4615a..b18b8be6d7 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -27,7 +27,7 @@
   #:use-module (guix download)
   #:use-module (gnu artwork)
   #:use-module (gnu system file-systems)
-  #:autoload   (gnu packages grub) (grub)
+  #:autoload   (gnu packages bootloaders) (grub)
   #:autoload   (gnu packages compression) (gzip)
   #:autoload   (gnu packages gtk) (guile-cairo guile-rsvg)
   #:use-module (ice-9 match)
@@ -108,7 +108,7 @@ denoting a file name."
   grub-configuration make-grub-configuration
   grub-configuration?
   (grub            grub-configuration-grub           ; package
-                   (default (@ (gnu packages grub) grub)))
+                   (default (@ (gnu packages bootloaders) grub)))
   (device          grub-configuration-device)        ; string
   (menu-entries    grub-configuration-menu-entries   ; list
                    (default '()))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index ad234fd9c1..3ec343570a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -28,11 +28,11 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages package-management)
   #:use-module (gnu packages disk)
-  #:use-module (gnu packages grub)
   #:use-module (gnu packages texinfo)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages nvi)
@@ -388,7 +388,7 @@ Use Alt-F2 for documentation.
      (base-pam-services #:allow-empty-passwords? #t))
 
     (packages (cons* (canonical-package glibc) ;for 'tzselect' & co.
-                     parted ddrescue
+                     parted gptfdisk ddrescue
                      grub                  ;mostly so xrefs to its manual work
                      cryptsetup
                      mdadm
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 24e61c3ead..bceea41332 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,25 +30,10 @@
   #:use-module (gnu services)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
-  #:export (mapping->file-system
-            system-container
+  #:export (system-container
             containerized-operating-system
             container-script))
 
-(define (mapping->file-system mapping)
-  "Return a file system that realizes MAPPING."
-  (match mapping
-    (($ <file-system-mapping> source target writable?)
-     (file-system
-       (mount-point target)
-       (device source)
-       (type "none")
-       (flags (if writable?
-                  '(bind-mount)
-                  '(bind-mount read-only)))
-       (check? #f)
-       (create-mount-point? #t)))))
-
 (define (containerized-operating-system os mappings)
   "Return an operating system based on OS for use in a Linux container
 environment.  MAPPINGS is a list of <file-system-mapping> to realize in the
@@ -66,7 +51,7 @@ containerized OS."
             (operating-system-file-systems os)))
 
   (define (mapping->fs fs)
-    (file-system (inherit (mapping->file-system fs))
+    (file-system (inherit (file-system-mapping->bind-mount fs))
       (needed-for-boot? #t)))
 
   (operating-system (inherit os)
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 1e680b85a2..8a35f7fbc5 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -31,6 +31,7 @@
   #:use-module ((gnu build vm)
                 #:select (qemu-command))
   #:use-module (gnu packages base)
+  #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages bash)
@@ -38,7 +39,6 @@
   #:use-module (gnu packages qemu)
   #:use-module (gnu packages disk)
   #:use-module (gnu packages zile)
-  #:use-module (gnu packages grub)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages package-management)
   #:use-module ((gnu packages make-bootstrap)