summary refs log tree commit diff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-07-20 11:42:02 +0200
committerLudovic Courtès <ludo@gnu.org>2016-07-20 11:42:17 +0200
commit7575655212ecfbcd1f04e429c8a7a41f8720d027 (patch)
tree558982d3cf50ef6b19ef293850de1f485fde66a6 /gnu/system
parent5d4c90ae02f1e0b42d575bba2d828d63aaf79be5 (diff)
parent5f01078129f4eaa4760a14f22761cf357afb6738 (diff)
downloadguix-7575655212ecfbcd1f04e429c8a7a41f8720d027.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/install.scm119
-rw-r--r--gnu/system/linux-container.scm49
-rw-r--r--gnu/system/linux-initrd.scm172
-rw-r--r--gnu/system/locale.scm8
-rw-r--r--gnu/system/mapped-devices.scm34
-rw-r--r--gnu/system/pam.scm61
-rw-r--r--gnu/system/shadow.scm47
-rw-r--r--gnu/system/vm.scm166
8 files changed, 356 insertions, 300 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index de14f6fb4c..734a361c37 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,52 +56,53 @@ under /root/.guix-profile where GUIX is installed."
                                 (manifest
                                  (list (package->manifest-entry guix))))))
     (define build
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build install))
-
-          (define %root "root")
-
-          (setenv "PATH"
-                  (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
-
-          ;; Note: there is not much to gain here with deduplication and there
-          ;; is the overhead of the '.links' directory, so turn it off.
-          (populate-single-profile-directory %root
-                                             #:profile #$profile
-                                             #:closure "profile"
-                                             #:deduplicate? #f)
-
-          ;; Create the tarball.  Use GNU format so there's no file name
-          ;; length limitation.
-          (with-directory-excursion %root
-            (zero? (system* "tar" "--xz" "--format=gnu"
-
-                            ;; Avoid non-determinism in the archive.  Use
-                            ;; mtime = 1, not zero, because that is what the
-                            ;; daemon does for files in the store (see the
-                            ;; 'mtimeStore' constant in local-store.cc.)
-                            "--sort=name"
-                            "--mtime=@1"          ;for files in /var/guix
-                            "--owner=root:0"
-                            "--group=root:0"
-
-                            "--check-links"
-                            "-cvf" #$output
-                            ;; Avoid adding / and /var to the tarball,
-                            ;; so that the ownership and permissions of those
-                            ;; directories will not be overwritten when
-                            ;; extracting the archive.  Do not include /root
-                            ;; because the root account might have a different
-                            ;; home directory.
-                            "./var/guix"
-                            (string-append "." (%store-directory)))))))
+      (with-imported-modules '((guix build utils)
+                               (guix build store-copy)
+                               (gnu build install))
+        #~(begin
+            (use-modules (guix build utils)
+                         (gnu build install))
+
+            (define %root "root")
+
+            (setenv "PATH"
+                    (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
+
+            ;; Note: there is not much to gain here with deduplication and
+            ;; there is the overhead of the '.links' directory, so turn it
+            ;; off.
+            (populate-single-profile-directory %root
+                                               #:profile #$profile
+                                               #:closure "profile"
+                                               #:deduplicate? #f)
+
+            ;; Create the tarball.  Use GNU format so there's no file name
+            ;; length limitation.
+            (with-directory-excursion %root
+              (zero? (system* "tar" "--xz" "--format=gnu"
+
+                              ;; Avoid non-determinism in the archive.  Use
+                              ;; mtime = 1, not zero, because that is what the
+                              ;; daemon does for files in the store (see the
+                              ;; 'mtimeStore' constant in local-store.cc.)
+                              "--sort=name"
+                              "--mtime=@1"        ;for files in /var/guix
+                              "--owner=root:0"
+                              "--group=root:0"
+
+                              "--check-links"
+                              "-cvf" #$output
+                              ;; Avoid adding / and /var to the tarball, so
+                              ;; that the ownership and permissions of those
+                              ;; directories will not be overwritten when
+                              ;; extracting the archive.  Do not include /root
+                              ;; because the root account might have a
+                              ;; different home directory.
+                              "./var/guix"
+                              (string-append "." (%store-directory))))))))
 
     (gexp->derivation "guix-tarball.tar.xz" build
-                      #:references-graphs `(("profile" ,profile))
-                      #:modules '((guix build utils)
-                                  (guix build store-copy)
-                                  (gnu build install)))))
+                      #:references-graphs `(("profile" ,profile)))))
 
 
 (define (log-to-info)
@@ -212,20 +214,20 @@ the user's target storage device rather than on the RAM disk."
 
   (define directory
     (computed-file "configuration-templates"
-                   #~(begin
-                       (mkdir #$output)
-                       (for-each (lambda (file target)
-                                   (copy-file file
-                                              (string-append #$output "/"
-                                                             target)))
-                                 '(#$(file "bare-bones.tmpl")
-                                   #$(file "desktop.tmpl")
-                                   #$(file "lightweight-desktop.tmpl"))
-                                 '("bare-bones.scm"
-                                   "desktop.scm"
-                                   "lightweight-desktop.scm"))
-                       #t)
-                   #:modules '((guix build utils))))
+                   (with-imported-modules '((guix build utils))
+                     #~(begin
+                         (mkdir #$output)
+                         (for-each (lambda (file target)
+                                     (copy-file file
+                                                (string-append #$output "/"
+                                                               target)))
+                                   '(#$(file "bare-bones.tmpl")
+                                     #$(file "desktop.tmpl")
+                                     #$(file "lightweight-desktop.tmpl"))
+                                   '("bare-bones.scm"
+                                     "desktop.scm"
+                                     "lightweight-desktop.scm"))
+                         #t))))
 
   `(("configuration" ,directory)))
 
@@ -391,6 +393,7 @@ Use Alt-F2 for documentation.
                      parted ddrescue
                      grub                  ;mostly so xrefs to its manual work
                      cryptsetup
+                     mdadm
                      btrfs-progs
                      wireless-tools iw wpa-supplicant-minimal iproute
                      ;; XXX: We used to have GNU fdisk here, but as of version
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 3acc579a6b..d3c0036f47 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -87,30 +87,29 @@ that will be shared with the host system."
                                   #:container? #t)))
 
       (define script
-        #~(begin
-            (use-modules (gnu build linux-container)
-                         (guix build utils))
+        (with-imported-modules '((guix config)
+                                 (guix utils)
+                                 (guix combinators)
+                                 (guix build utils)
+                                 (guix build syscalls)
+                                 (guix build bournish)
+                                 (gnu build file-systems)
+                                 (gnu build linux-container))
+          #~(begin
+              (use-modules (gnu build linux-container)
+                           (guix build utils))
 
-            (call-with-container '#$specs
-              (lambda ()
-                (setenv "HOME" "/root")
-                (setenv "TMPDIR" "/tmp")
-                (setenv "GUIX_NEW_SYSTEM" #$os-drv)
-                (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
-                (primitive-load (string-append #$os-drv "/boot")))
-              ;; A range of 65536 uid/gids is used to cover 16 bits worth of
-              ;; users and groups, which is sufficient for most cases.
-              ;;
-              ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
-              #:host-uids 65536)))
+              (call-with-container '#$specs
+                (lambda ()
+                  (setenv "HOME" "/root")
+                  (setenv "TMPDIR" "/tmp")
+                  (setenv "GUIX_NEW_SYSTEM" #$os-drv)
+                  (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
+                  (primitive-load (string-append #$os-drv "/boot")))
+                ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+                ;; users and groups, which is sufficient for most cases.
+                ;;
+                ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+                #:host-uids 65536))))
 
-      (gexp->script "run-container" script
-                    #:modules '((ice-9 match)
-                                (srfi srfi-98)
-                                (guix config)
-                                (guix utils)
-                                (guix build utils)
-                                (guix build syscalls)
-                                (guix build bournish)
-                                (gnu build file-systems)
-                                (gnu build linux-container))))))
+      (gexp->script "run-container" script))))
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 484bce71c4..bbaa5c0f89 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,85 +55,81 @@
                              (guile %guile-static-stripped)
                              (gzip gzip)
                              (name "guile-initrd")
-                             (system (%current-system))
-                             (modules '()))
+                             (system (%current-system)))
   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
 containing GUILE and that evaluates EXP, a G-expression, upon booting.  All
-the derivations referenced by EXP are automatically copied to the initrd.
-
-MODULES is a list of Guile module names to be embedded in the initrd."
+the derivations referenced by EXP are automatically copied to the initrd."
 
   ;; General Linux overview in `Documentation/early-userspace/README' and
   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
 
   (mlet %store-monad ((init (gexp->script "init" exp
-                                          #:modules modules
                                           #:guile guile)))
     (define builder
-      #~(begin
-          (use-modules (gnu build linux-initrd))
+      (with-imported-modules '((guix cpio)
+                               (guix build utils)
+                               (guix build store-copy)
+                               (gnu build linux-initrd))
+        #~(begin
+            (use-modules (gnu build linux-initrd))
 
-          (mkdir #$output)
-          (build-initrd (string-append #$output "/initrd")
-                        #:guile #$guile
-                        #:init #$init
-                        ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
-                        #:gzip (string-append #$gzip "/bin/gzip"))))
+            (mkdir #$output)
+            (build-initrd (string-append #$output "/initrd")
+                          #:guile #$guile
+                          #:init #$init
+                          ;; Copy everything INIT refers to into the initrd.
+                          #:references-graphs '("closure")
+                          #:gzip (string-append #$gzip "/bin/gzip")))))
 
-   (gexp->derivation name builder
-                     #:modules '((guix cpio)
-                                 (guix build utils)
-                                 (guix build store-copy)
-                                 (gnu build linux-initrd))
-                     #:references-graphs `(("closure" ,init)))))
+    (gexp->derivation name builder
+                      #:references-graphs `(("closure" ,init)))))
 
 (define (flat-linux-module-directory linux modules)
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
-    #~(begin
-        (use-modules (ice-9 match) (ice-9 regex)
-                     (srfi srfi-1)
-                     (guix build utils)
-                     (gnu build linux-modules))
+    (with-imported-modules '((guix build utils)
+                             (guix elf)
+                             (gnu build linux-modules))
+      #~(begin
+          (use-modules (ice-9 match) (ice-9 regex)
+                       (srfi srfi-1)
+                       (guix build utils)
+                       (gnu build linux-modules))
 
-        (define (string->regexp str)
-          ;; Return a regexp that matches STR exactly.
-          (string-append "^" (regexp-quote str) "$"))
+          (define (string->regexp str)
+            ;; Return a regexp that matches STR exactly.
+            (string-append "^" (regexp-quote str) "$"))
 
-        (define module-dir
-          (string-append #$linux "/lib/modules"))
+          (define module-dir
+            (string-append #$linux "/lib/modules"))
 
-        (define (lookup module)
-          (let ((name (ensure-dot-ko module)))
-            (match (find-files module-dir (string->regexp name))
-              ((file)
-               file)
-              (()
-               (error "module not found" name module-dir))
-              ((_ ...)
-               (error "several modules by that name"
-                      name module-dir)))))
+          (define (lookup module)
+            (let ((name (ensure-dot-ko module)))
+              (match (find-files module-dir (string->regexp name))
+                ((file)
+                 file)
+                (()
+                 (error "module not found" name module-dir))
+                ((_ ...)
+                 (error "several modules by that name"
+                        name module-dir)))))
 
-        (define modules
-          (let ((modules (map lookup '#$modules)))
-            (append modules
-                    (recursive-module-dependencies modules
-                                                   #:lookup-module lookup))))
+          (define modules
+            (let ((modules (map lookup '#$modules)))
+              (append modules
+                      (recursive-module-dependencies modules
+                                                     #:lookup-module lookup))))
 
-        (mkdir #$output)
-        (for-each (lambda (module)
-                    (format #t "copying '~a'...~%" module)
-                    (copy-file module
-                               (string-append #$output "/"
-                                              (basename module))))
-                  (delete-duplicates modules))))
+          (mkdir #$output)
+          (for-each (lambda (module)
+                      (format #t "copying '~a'...~%" module)
+                      (copy-file module
+                                 (string-append #$output "/"
+                                                (basename module))))
+                    (delete-duplicates modules)))))
 
-  (gexp->derivation "linux-modules" build-exp
-                    #:modules '((guix build utils)
-                                (guix elf)
-                                (gnu build linux-modules))))
+  (gexp->derivation "linux-modules" build-exp))
 
 (define* (base-initrd file-systems
                       #:key
@@ -183,6 +180,7 @@ loaded at boot time in the order in which they appear."
       "usb-storage" "uas"                     ;for the installation image etc.
       "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
       "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
+      "nvme"                                     ;for new SSD NVMe devices
       ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
             '("pata_acpi" "pata_atiixp"    ;for ATA controllers
               "isci")                      ;for SAS controllers like Intel C602
@@ -225,38 +223,38 @@ loaded at boot time in the order in which they appear."
   (mlet %store-monad ((kodir (flat-linux-module-directory linux
                                                           linux-modules)))
     (expression->initrd
-     #~(begin
-         (use-modules (gnu build linux-boot)
-                      (guix build utils)
-                      (guix build bournish)   ;add the 'bournish' meta-command
-                      (srfi srfi-26)
+     (with-imported-modules '((guix build bournish)
+                              (guix build utils)
+                              (guix build syscalls)
+                              (gnu build linux-boot)
+                              (gnu build linux-modules)
+                              (gnu build file-systems)
+                              (guix elf))
+       #~(begin
+           (use-modules (gnu build linux-boot)
+                        (guix build utils)
+                        (guix build bournish) ;add the 'bournish' meta-command
+                        (srfi srfi-26)
 
-                      ;; FIXME: The following modules are for
-                      ;; LUKS-DEVICE-MAPPING.  We should instead propagate
-                      ;; this info via gexps.
-                      ((gnu build file-systems)
-                       #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                        ;; FIXME: The following modules are for
+                        ;; LUKS-DEVICE-MAPPING.  We should instead propagate
+                        ;; this info via gexps.
+                        ((gnu build file-systems)
+                         #:select (find-partition-by-luks-uuid))
+                        (rnrs bytevectors))
 
-         (with-output-to-port (%make-void-port "w")
-           (lambda ()
-             (set-path-environment-variable "PATH" '("bin" "sbin")
-                                            '#$helper-packages)))
+           (with-output-to-port (%make-void-port "w")
+             (lambda ()
+               (set-path-environment-variable "PATH" '("bin" "sbin")
+                                              '#$helper-packages)))
 
-         (boot-system #:mounts '#$(map file-system->spec file-systems)
-                      #:pre-mount (lambda ()
-                                    (and #$@device-mapping-commands))
-                      #:linux-modules '#$linux-modules
-                      #:linux-module-directory '#$kodir
-                      #:qemu-guest-networking? #$qemu-networking?
-                      #:volatile-root? '#$volatile-root?))
-     #:name "base-initrd"
-     #:modules '((guix build bournish)
-                 (guix build utils)
-                 (guix build syscalls)
-                 (gnu build linux-boot)
-                 (gnu build linux-modules)
-                 (gnu build file-systems)
-                 (guix elf)))))
+           (boot-system #:mounts '#$(map file-system->spec file-systems)
+                        #:pre-mount (lambda ()
+                                      (and #$@device-mapping-commands))
+                        #:linux-modules '#$linux-modules
+                        #:linux-module-directory '#$kodir
+                        #:qemu-guest-networking? #$qemu-networking?
+                        #:volatile-root? '#$volatile-root?)))
+     #:name "base-initrd")))
 
 ;;; linux-initrd.scm ends here
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index f9d713e0cf..3bb9f950a8 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -154,10 +154,10 @@ data format changes between libc versions."
                                                                 #:libc libc))
                                      libcs)))
        (gexp->derivation "locale-multiple-versions"
-                         #~(begin
-                             (use-modules (guix build union))
-                             (union-build #$output (list #$@dirs)))
-                         #:modules '((guix build union))
+                         (with-imported-modules '((guix build union))
+                           #~(begin
+                               (use-modules (guix build union))
+                               (union-build #$output (list #$@dirs))))
                          #:local-build? #t
                          #:substitutable? #f)))))
 
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 450b4737ac..732f73cc4b 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -85,9 +85,7 @@
        (modules `((rnrs bytevectors)              ;bytevector?
                   ((gnu build file-systems)
                    #:select (find-partition-by-luks-uuid))
-                  ,@%default-modules))
-       (imported-modules `((gnu build file-systems)
-                           ,@%default-imported-modules)))))))
+                  ,@%default-modules)))))))
 
 (define (device-mapping-service mapped-device)
   "Return a service that sets up @var{mapped-device}."
@@ -101,20 +99,22 @@
 (define (open-luks-device source target)
   "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
 'cryptsetup'."
-  #~(let ((source #$source))
-      (zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup")
-                      "open" "--type" "luks"
-
-                      ;; Note: We cannot use the "UUID=source" syntax here
-                      ;; because 'cryptsetup' implements it by searching the
-                      ;; udev-populated /dev/disk/by-id directory but udev may
-                      ;; be unavailable at the time we run this.
-                      (if (bytevector? source)
-                          (or (find-partition-by-luks-uuid source)
-                              (error "LUKS partition not found" source))
-                          source)
-
-                      #$target))))
+  (with-imported-modules '((gnu build file-systems)
+                           (guix build bournish))
+    #~(let ((source #$source))
+        (zero? (system* (string-append #$cryptsetup "/sbin/cryptsetup")
+                        "open" "--type" "luks"
+
+                        ;; Note: We cannot use the "UUID=source" syntax here
+                        ;; because 'cryptsetup' implements it by searching the
+                        ;; udev-populated /dev/disk/by-id directory but udev may
+                        ;; be unavailable at the time we run this.
+                        (if (bytevector? source)
+                            (or (find-partition-by-luks-uuid source)
+                                (error "LUKS partition not found" source))
+                            source)
+
+                        #$target)))))
 
 (define (close-luks-device source target)
   "Return a gexp that closes TARGET, a LUKS device."
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index 743039daf6..cd7a3427ed 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -23,6 +23,7 @@
   #:use-module (gnu services)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module ((guix utils) #:select (%current-system))
@@ -38,6 +39,13 @@
             pam-entry-module
             pam-entry-arguments
 
+            pam-limits-entry
+            pam-limits-entry-domain
+            pam-limits-entry-type
+            pam-limits-entry-item
+            pam-limits-entry-value
+            pam-limits-entry->string
+
             pam-services->directory
             unix-pam-service
             base-pam-services
@@ -76,6 +84,59 @@
   (arguments  pam-entry-arguments        ; list of string-valued g-expressions
               (default '())))
 
+;; PAM limits entries are used by the pam_limits PAM module to set or override
+;; limits on system resources for user sessions.  The format is specified
+;; here: http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html
+(define-record-type <pam-limits-entry>
+  (make-pam-limits-entry domain type item value)
+  pam-limits-entry?
+  (domain     pam-limits-entry-domain)   ; string
+  (type       pam-limits-entry-type)     ; symbol
+  (item       pam-limits-entry-item)     ; symbol
+  (value      pam-limits-entry-value))   ; symbol or number
+
+(define (pam-limits-entry domain type item value)
+  "Construct a pam-limits-entry ensuring that the provided values are valid."
+  (define (valid? value)
+    (case item
+      ((priority) (number? value))
+      ((nice)     (and (number? value)
+                       (>= value -20)
+                       (<= value 19)))
+      (else       (or (and (number? value)
+                           (>= value -1))
+                      (member value '(unlimited infinity))))))
+  (define items
+    (list 'core      'data       'fsize
+          'memlock   'nofile     'rss
+          'stack     'cpu        'nproc
+          'as        'maxlogins  'maxsyslogins
+          'priority  'locks      'sigpending
+          'msgqueue  'nice       'rtprio))
+  (when (not (member type '(hard soft both)))
+    (error "invalid limit type" type))
+  (when (not (member item items))
+    (error "invalid limit item" item))
+  (when (not (valid? value))
+    (error "invalid limit value" value))
+  (make-pam-limits-entry domain type item value))
+
+(define (pam-limits-entry->string entry)
+  "Convert a pam-limits-entry record to a string."
+  (match entry
+    (($ <pam-limits-entry> domain type item value)
+     (string-join (list domain
+                        (if (eq? type 'both)
+                            "-"
+                            (symbol->string type))
+                        (symbol->string item)
+                        (cond
+                         ((symbol? value)
+                          (symbol->string value))
+                         (else
+                          (number->string value))))
+                  "	"))))
+
 (define (pam-service->configuration service)
   "Return the derivation building the configuration file for SERVICE, to be
 dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index f09e8c24f2..c3948900eb 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -126,17 +126,19 @@
          (name "nobody")
          (uid 65534)
          (group "nogroup")
-         (home-directory "/var/empty")
+         (shell #~(string-append #$shadow "/sbin/nologin"))
+         (home-directory "/nonexistent")
          (system? #t))))
 
 (define (default-skeletons)
   "Return the default skeleton files for /etc/skel.  These files are copied by
 'useradd' in the home directory of newly created user accounts."
   (define copy-guile-wm
-    #~(begin
-        (use-modules (guix build utils))
-        (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
-                   #$output)))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+          (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
+                     #$output))))
 
   (let ((profile (plain-file "bash_profile" "\
 # Honor per-interactive-shell startup file
@@ -170,8 +172,7 @@ alias ll='ls -l'\n"))
         (zlogin    (plain-file "zlogin" "\
 # Honor system-wide environment variables
 source /etc/profile\n"))
-        (guile-wm  (computed-file "guile-wm" copy-guile-wm
-                                  #:modules '((guix build utils))))
+        (guile-wm  (computed-file "guile-wm" copy-guile-wm))
         (xdefaults (plain-file "Xdefaults" "\
 XTerm*utf8: always
 XTerm*metaSendsEscape: true\n"))
@@ -188,22 +189,22 @@ set debug-file-directory ~/.guix-profile/lib/debug\n")))
 (define (skeleton-directory skeletons)
   "Return a directory containing SKELETONS, a list of name/derivation tuples."
   (computed-file "skel"
-                 #~(begin
-                     (use-modules (ice-9 match)
-                                  (guix build utils))
-
-                     (mkdir #$output)
-                     (chdir #$output)
-
-                     ;; Note: copy the skeletons instead of symlinking
-                     ;; them like 'file-union' does, because 'useradd'
-                     ;; would just copy the symlinks as is.
-                     (for-each (match-lambda
-                                 ((target source)
-                                  (copy-recursively source target)))
-                               '#$skeletons)
-                     #t)
-                 #:modules '((guix build utils))))
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (ice-9 match)
+                                    (guix build utils))
+
+                       (mkdir #$output)
+                       (chdir #$output)
+
+                       ;; Note: copy the skeletons instead of symlinking
+                       ;; them like 'file-union' does, because 'useradd'
+                       ;; would just copy the symlinks as is.
+                       (for-each (match-lambda
+                                   ((target source)
+                                    (copy-recursively source target)))
+                                 '#$skeletons)
+                       #t))))
 
 (define (assert-valid-users/groups users groups)
   "Raise an error if USERS refer to groups not listed in GROUPS."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 676e89df98..c31e3a80ef 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -90,6 +90,21 @@
           (options "trans=virtio")
           (check? #f))))
 
+(define %vm-module-closure
+  ;; The closure of (gnu build vm), roughly.
+  ;; FIXME: Compute it automatically.
+  '((gnu build vm)
+    (gnu build install)
+    (gnu build linux-boot)
+    (gnu build linux-modules)
+    (gnu build file-systems)
+    (guix elf)
+    (guix records)
+    (guix build utils)
+    (guix build syscalls)
+    (guix build bournish)
+    (guix build store-copy)))
+
 (define* (expression->derivation-in-linux-vm name exp
                                              #:key
                                              (system (%current-system))
@@ -97,18 +112,6 @@
                                              initrd
                                              (qemu qemu-minimal)
                                              (env-vars '())
-                                             (modules
-                                              '((gnu build vm)
-                                                (gnu build install)
-                                                (gnu build linux-boot)
-                                                (gnu build linux-modules)
-                                                (gnu build file-systems)
-                                                (guix elf)
-                                                (guix records)
-                                                (guix build utils)
-                                                (guix build syscalls)
-                                                (guix build bournish)
-                                                (guix build store-copy)))
                                              (guile-for-build
                                               (%guile-for-build))
 
@@ -128,23 +131,13 @@ When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of type
 DISK-IMAGE-FORMAT (e.g., 'qcow2' or 'raw'), of DISK-IMAGE-SIZE bytes and
 return it.
 
-MODULES is the set of modules imported in the execution environment of EXP.
-
 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 pairs, as for `derivation'.  The files containing the reference graphs are
 made available under the /xchg CIFS share."
   (mlet* %store-monad
-      ((module-dir   (imported-modules modules))
-       (compiled     (compiled-modules modules))
-       (user-builder (gexp->file "builder-in-linux-vm" exp))
+      ((user-builder (gexp->file "builder-in-linux-vm" exp))
        (loader       (gexp->file "linux-vm-loader"
-                                 #~(begin
-                                     (set! %load-path
-                                           (cons #$module-dir %load-path))
-                                     (set! %load-compiled-path
-                                           (cons #$compiled
-                                                 %load-compiled-path))
-                                     (primitive-load #$user-builder))))
+                                 #~(primitive-load #$user-builder)))
        (coreutils -> (canonical-package coreutils))
        (initrd       (if initrd                   ; use the default initrd?
                          (return initrd)
@@ -155,34 +148,34 @@ made available under the /xchg CIFS share."
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build vm))
-
-          (let ((inputs  '#$(list qemu coreutils))
-                (linux   (string-append #$linux "/bzImage"))
-                (initrd  (string-append #$initrd "/initrd"))
-                (loader  #$loader)
-                (graphs  '#$(match references-graphs
-                              (((graph-files . _) ...) graph-files)
-                              (_ #f))))
-
-            (set-path-environment-variable "PATH" '("bin") inputs)
-
-            (load-in-linux-vm loader
-                              #:output #$output
-                              #:linux linux #:initrd initrd
-                              #:memory-size #$memory-size
-                              #:make-disk-image? #$make-disk-image?
-                              #:disk-image-format #$disk-image-format
-                              #:disk-image-size #$disk-image-size
-                              #:references-graphs graphs))))
+      (with-imported-modules %vm-module-closure
+        #~(begin
+            (use-modules (guix build utils)
+                         (gnu build vm))
+
+            (let ((inputs  '#$(list qemu coreutils))
+                  (linux   (string-append #$linux "/bzImage"))
+                  (initrd  (string-append #$initrd "/initrd"))
+                  (loader  #$loader)
+                  (graphs  '#$(match references-graphs
+                                (((graph-files . _) ...) graph-files)
+                                (_ #f))))
+
+              (set-path-environment-variable "PATH" '("bin") inputs)
+
+              (load-in-linux-vm loader
+                                #:output #$output
+                                #:linux linux #:initrd initrd
+                                #:memory-size #$memory-size
+                                #:make-disk-image? #$make-disk-image?
+                                #:disk-image-format #$disk-image-format
+                                #:disk-image-size #$disk-image-size
+                                #:references-graphs graphs)))))
 
     (gexp->derivation name builder
                       ;; TODO: Require the "kvm" feature.
                       #:system system
                       #:env-vars env-vars
-                      #:modules modules
                       #:guile-for-build guile-for-build
                       #:references-graphs references-graphs)))
 
@@ -212,45 +205,46 @@ register INPUTS in the store database of the image so that Guix can be used in
 the image."
   (expression->derivation-in-linux-vm
    name
-   #~(begin
-       (use-modules (gnu build vm)
-                    (guix build utils))
-
-       (let ((inputs
-              '#$(append (list qemu parted grub e2fsprogs)
-                         (map canonical-package
-                              (list sed grep coreutils findutils gawk))
-                         (if register-closures? (list guix) '())))
-
-             ;; This variable is unused but allows us to add INPUTS-TO-COPY
-             ;; as inputs.
-             (to-register
-              '#$(map (match-lambda
-                       ((name thing) thing)
-                       ((name thing output) `(,thing ,output)))
-                      inputs)))
-
-         (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
-         (let* ((graphs     '#$(match inputs
-                                 (((names . _) ...)
-                                  names)))
-                (initialize (root-partition-initializer
-                             #:closures graphs
-                             #:copy-closures? #$copy-inputs?
-                             #:register-closures? #$register-closures?
-                             #:system-directory #$os-derivation))
-                (partitions (list (partition
-                                   (size #$(- disk-image-size
-                                              (* 10 (expt 2 20))))
-                                   (label #$file-system-label)
-                                   (file-system #$file-system-type)
-                                   (bootable? #t)
-                                   (initializer initialize)))))
-           (initialize-hard-disk "/dev/vda"
-                                 #:partitions partitions
-                                 #:grub.cfg #$grub-configuration)
-           (reboot))))
+   (with-imported-modules %vm-module-closure
+     #~(begin
+         (use-modules (gnu build vm)
+                      (guix build utils))
+
+         (let ((inputs
+                '#$(append (list qemu parted grub e2fsprogs)
+                           (map canonical-package
+                                (list sed grep coreutils findutils gawk))
+                           (if register-closures? (list guix) '())))
+
+               ;; This variable is unused but allows us to add INPUTS-TO-COPY
+               ;; as inputs.
+               (to-register
+                '#$(map (match-lambda
+                          ((name thing) thing)
+                          ((name thing output) `(,thing ,output)))
+                        inputs)))
+
+           (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+           (let* ((graphs     '#$(match inputs
+                                   (((names . _) ...)
+                                    names)))
+                  (initialize (root-partition-initializer
+                               #:closures graphs
+                               #:copy-closures? #$copy-inputs?
+                               #:register-closures? #$register-closures?
+                               #:system-directory #$os-derivation))
+                  (partitions (list (partition
+                                     (size #$(- disk-image-size
+                                                (* 10 (expt 2 20))))
+                                     (label #$file-system-label)
+                                     (file-system #$file-system-type)
+                                     (bootable? #t)
+                                     (initializer initialize)))))
+             (initialize-hard-disk "/dev/vda"
+                                   #:partitions partitions
+                                   #:grub.cfg #$grub-configuration)
+             (reboot)))))
    #:system system
    #:make-disk-image? #t
    #:disk-image-size disk-image-size