From bae90dc7e71f2ecfb09a89184915dfeb83473617 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 21 Jun 2016 12:13:30 +0200
Subject: install: Pass a relative file name to 'local-file'.

This is a followup to cbbbb7be0fbaa11ff75bce92f2d82131ff8db104.

* gnu/system/install.scm (/etc/configuration-files): Pass a relative
file name to 'local-file'.
---
 gnu/system/install.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index a72613e9c5..de14f6fb4c 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -208,8 +208,7 @@ (define (/etc/configuration-files _)
   "Return a list of tuples representing configuration templates to add to
 /etc."
   (define (file f)
-    (local-file (search-path %load-path
-                             (string-append "gnu/system/examples/" f))))
+    (local-file (string-append "examples/" f)))
 
   (define directory
     (computed-file "configuration-templates"
-- 
cgit v1.2.3


From ad85791265ba5ae135f6c6aa90a0766620b2f3d0 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Thu, 16 Jun 2016 09:50:32 +0200
Subject: gnu: linux-initrd: Support NVMe devices.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* gnu/system/linux-initrd.scm (base-initrd): Add nvme to linux-modules.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/system/linux-initrd.scm | 2 ++
 1 file changed, 2 insertions(+)

(limited to 'gnu/system')

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 484bce71c4..8339fae7ed 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.
 ;;;
@@ -183,6 +184,7 @@ (define linux-modules
       "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
-- 
cgit v1.2.3


From 4ee96a7912eef8c41c855c680f924dcdba2d9c97 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 3 Jul 2016 23:11:40 +0200
Subject: gnu: Switch to 'with-imported-modules'.

* gnu/services.scm (directory-union): Use 'with-imported-modules'
instead of the '#:modules' argument of 'computed-file'.
* gnu/services/base.scm (udev-rules-union): Likewise.
* gnu/services/dbus.scm (system-service-directory): Likewise.
* gnu/services/desktop.scm (wrapped-dbus-service):
(polkit-directory): Likewise.
* gnu/services/networking.scm (tor-configuration->torrc): Likewise.
* gnu/services/xorg.scm (xorg-configuration-directory): Likewise.
* gnu/system/install.scm (self-contained-tarball): Likewise.
* gnu/system/linux-container.scm (container-script): Likewise.
* gnu/system/linux-initrd.scm (expression->initrd): Likewise, and
remove #:modules parameter.
(flat-linux-module-directory): Use 'with-imported-modules'.
(base-initrd): Likewise.
* gnu/system/locale.scm (locale-directory): Likewise.
* gnu/system/shadow.scm (default-skeletons): Likewise.
* gnu/system/vm.scm (expression->derivation-in-linux-vm): Likewise.
* gnu/tests/base.scm (run-basic-test): Likewise.
* gnu/tests/install.scm (run-install): Likewise.
* doc/guix.texi (Initial RAM Disk): Update 'expression->initrd'
documentation.
---
 doc/guix.texi                  |   6 +-
 gnu/services.scm               |   8 +-
 gnu/services/base.scm          |  60 ++---
 gnu/services/dbus.scm          |  41 ++--
 gnu/services/desktop.scm       |  67 +++---
 gnu/services/networking.scm    |  54 ++---
 gnu/services/xorg.scm          |  42 ++--
 gnu/system/install.scm         | 117 +++++-----
 gnu/system/linux-container.scm |  48 ++--
 gnu/system/linux-initrd.scm    | 170 +++++++-------
 gnu/system/locale.scm          |   8 +-
 gnu/system/shadow.scm          |  72 +++---
 gnu/system/vm.scm              |  46 ++--
 gnu/tests/base.scm             | 514 ++++++++++++++++++++---------------------
 gnu/tests/install.scm          |  82 +++----
 15 files changed, 665 insertions(+), 670 deletions(-)

(limited to 'gnu/system')

diff --git a/doc/guix.texi b/doc/guix.texi
index b315325034..a0014e7112 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10016,15 +10016,11 @@ program.  That gives a lot of flexibility.  The
 program to run in that initrd.
 
 @deffn {Monadic Procedure} expression->initrd @var{exp} @
-       [#:guile %guile-static-stripped] [#:name "guile-initrd"] @
-       [#:modules '()]
+       [#:guile %guile-static-stripped] [#:name "guile-initrd"]
 Return a derivation that builds a Linux initrd (a gzipped cpio archive)
 containing @var{guile} and that evaluates @var{exp}, a G-expression,
 upon booting.  All the derivations referenced by @var{exp} are
 automatically copied to the initrd.
-
-@var{modules} is a list of Guile module names to be embedded in the
-initrd.
 @end deffn
 
 @node GRUB Configuration
diff --git a/gnu/services.scm b/gnu/services.scm
index 50e76df818..661835f68e 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -309,10 +309,10 @@ (define (directory-union name things)
      one)
     (_
      (computed-file name
-                    #~(begin
-                        (use-modules (guix build union))
-                        (union-build #$output '#$things))
-                    #:modules '((guix build union))))))
+                    (with-imported-modules '((guix build union))
+                      #~(begin
+                          (use-modules (guix build union))
+                          (union-build #$output '#$things)))))))
 
 (define* (activation-service->script service)
   "Return as a monadic value the activation script for SERVICE, a service of
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 5eabfec423..d9c60778a1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1138,44 +1138,44 @@ (define (udev-rules-union packages)
   "Return the union of the @code{lib/udev/rules.d} directories found in each
 item of @var{packages}."
   (define build
-    #~(begin
-        (use-modules (guix build union)
-                     (guix build utils)
-                     (srfi srfi-1)
-                     (srfi srfi-26))
+    (with-imported-modules '((guix build union)
+                             (guix build utils))
+      #~(begin
+          (use-modules (guix build union)
+                       (guix build utils)
+                       (srfi srfi-1)
+                       (srfi srfi-26))
 
-        (define %standard-locations
-          '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
+          (define %standard-locations
+            '("/lib/udev/rules.d" "/libexec/udev/rules.d"))
 
-        (define (rules-sub-directory directory)
-          ;; Return the sub-directory of DIRECTORY containing udev rules, or
-          ;; #f if none was found.
-          (find directory-exists?
-                (map (cut string-append directory <>) %standard-locations)))
+          (define (rules-sub-directory directory)
+            ;; Return the sub-directory of DIRECTORY containing udev rules, or
+            ;; #f if none was found.
+            (find directory-exists?
+                  (map (cut string-append directory <>) %standard-locations)))
 
-        (mkdir-p (string-append #$output "/lib/udev"))
-        (union-build (string-append #$output "/lib/udev/rules.d")
-                     (filter-map rules-sub-directory '#$packages))))
+          (mkdir-p (string-append #$output "/lib/udev"))
+          (union-build (string-append #$output "/lib/udev/rules.d")
+                       (filter-map rules-sub-directory '#$packages)))))
 
-  (computed-file "udev-rules" build
-                 #:modules '((guix build union)
-                             (guix build utils))))
+  (computed-file "udev-rules" build))
 
 (define (udev-rule file-name contents)
   "Return a directory with a udev rule file FILE-NAME containing CONTENTS."
   (computed-file file-name
-                 #~(begin
-                     (use-modules (guix build utils))
-
-                     (define rules.d
-                       (string-append #$output "/lib/udev/rules.d"))
-
-                     (mkdir-p rules.d)
-                     (call-with-output-file
-                         (string-append rules.d "/" #$file-name)
-                       (lambda (port)
-                         (display #$contents port))))
-                 #:modules '((guix build utils))))
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (guix build utils))
+
+                       (define rules.d
+                         (string-append #$output "/lib/udev/rules.d"))
+
+                       (mkdir-p rules.d)
+                       (call-with-output-file
+                           (string-append rules.d "/" #$file-name)
+                         (lambda (port)
+                           (display #$contents port)))))))
 
 (define kvm-udev-rule
   ;; Return a directory with a udev rule that changes the group of /dev/kvm to
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 9a4a13d41d..d06b2dde23 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -46,26 +46,27 @@ (define (system-service-directory services)
   "Return the system service directory, containing @code{.service} files for
 all the services that may be activated by the daemon."
   (computed-file "dbus-system-services"
-                 #~(begin
-                     (use-modules (guix build utils)
-                                  (srfi srfi-1))
-
-                     (define files
-                       (append-map (lambda (service)
-                                     (find-files (string-append
-                                                  service
-                                                  "/share/dbus-1/system-services")
-                                                 "\\.service$"))
-                                   (list #$@services)))
-
-                     (mkdir #$output)
-                     (for-each (lambda (file)
-                                 (symlink file
-                                          (string-append #$output "/"
-                                                         (basename file))))
-                               files)
-                     #t)
-                 #:modules '((guix build utils))))
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (guix build utils)
+                                    (srfi srfi-1))
+
+                       (define files
+                         (append-map (lambda (service)
+                                       (find-files
+                                        (string-append
+                                         service
+                                         "/share/dbus-1/system-services")
+                                        "\\.service$"))
+                                     (list #$@services)))
+
+                       (mkdir #$output)
+                       (for-each (lambda (file)
+                                   (symlink file
+                                            (string-append #$output "/"
+                                                           (basename file))))
+                                 files)
+                       #t))))
 
 (define (dbus-configuration-directory services)
   "Return a directory contains the @code{system-local.conf} file for DBUS that
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 2fb08cd1b3..86214a73bf 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -91,30 +91,33 @@ (define wrapper
                              (string-append #$service "/" #$program)
                              (cdr (command-line))))))
 
+  (define build
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+
+          (define service-directory
+            "/share/dbus-1/system-services")
+
+          (mkdir-p (dirname (string-append #$output
+                                           service-directory)))
+          (copy-recursively (string-append #$service
+                                           service-directory)
+                            (string-append #$output
+                                           service-directory))
+          (symlink (string-append #$service "/etc") ;for etc/dbus-1
+                   (string-append #$output "/etc"))
+
+          (for-each (lambda (file)
+                      (substitute* file
+                        (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
+                          _ original-program arguments)
+                         (string-append "Exec=" #$wrapper arguments
+                                        "\n"))))
+                    (find-files #$output "\\.service$")))))
+
   (computed-file (string-append (package-name service) "-wrapper")
-                 #~(begin
-                     (use-modules (guix build utils))
-
-                     (define service-directory
-                       "/share/dbus-1/system-services")
-
-                     (mkdir-p (dirname (string-append #$output
-                                                      service-directory)))
-                     (copy-recursively (string-append #$service
-                                                      service-directory)
-                                       (string-append #$output
-                                                      service-directory))
-                     (symlink (string-append #$service "/etc") ;for etc/dbus-1
-                              (string-append #$output "/etc"))
-
-                     (for-each (lambda (file)
-                                 (substitute* file
-                                   (("Exec[[:blank:]]*=[[:blank:]]*([[:graph:]]+)(.*)$"
-                                     _ original-program arguments)
-                                    (string-append "Exec=" #$wrapper arguments
-                                                   "\n"))))
-                               (find-files #$output "\\.service$")))
-                 #:modules '((guix build utils))))
+                 build))
 
 
 ;;;
@@ -408,15 +411,15 @@ (define %polkit-pam-services
 (define (polkit-directory packages)
   "Return a directory containing an @file{actions} and possibly a
 @file{rules.d} sub-directory, for use as @file{/etc/polkit-1}."
-  (computed-file "etc-polkit-1"
-                 #~(begin
-                     (use-modules (guix build union) (srfi srfi-26))
-
-                     (union-build #$output
-                                  (map (cut string-append <>
-                                            "/share/polkit-1")
-                                       (list #$@packages))))
-                 #:modules '((guix build union))))
+  (with-imported-modules '((guix build union))
+    (computed-file "etc-polkit-1"
+                   #~(begin
+                       (use-modules (guix build union) (srfi srfi-26))
+
+                       (union-build #$output
+                                    (map (cut string-append <>
+                                              "/share/polkit-1")
+                                         (list #$@packages)))))))
 
 (define polkit-etc-files
   (match-lambda
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index af2a60936b..a77ed3bb80 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
 ;;;
@@ -345,39 +345,39 @@ (define (tor-configuration->torrc config)
     (($ <tor-configuration> tor config-file services)
      (computed-file
       "torrc"
-      #~(begin
-          (use-modules (guix build utils)
-                       (ice-9 match))
-
-          (call-with-output-file #$output
-            (lambda (port)
-              (display "\
+      (with-imported-modules '((guix build utils))
+        #~(begin
+            (use-modules (guix build utils)
+                         (ice-9 match))
+
+            (call-with-output-file #$output
+              (lambda (port)
+                (display "\
 # The beginning was automatically added.
 User tor
 DataDirectory /var/lib/tor
 Log notice syslog\n" port)
 
-              (for-each (match-lambda
-                          ((service (ports hosts) ...)
-                           (format port "\
+                (for-each (match-lambda
+                            ((service (ports hosts) ...)
+                             (format port "\
 HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
-                                   service)
-                           (for-each (lambda (tcp-port host)
-                                       (format port "\
+                                     service)
+                             (for-each (lambda (tcp-port host)
+                                         (format port "\
 HiddenServicePort ~a ~a~%"
-                                               tcp-port host))
-                                     ports hosts)))
-                        '#$(map (match-lambda
-                                  (($ <hidden-service> name mapping)
-                                   (cons name mapping)))
-                                services))
-
-              ;; Append the user's config file.
-              (call-with-input-file #$config-file
-                (lambda (input)
-                  (dump-port input port)))
-              #t)))
-      #:modules '((guix build utils))))))
+                                                 tcp-port host))
+                                       ports hosts)))
+                          '#$(map (match-lambda
+                                    (($ <hidden-service> name mapping)
+                                     (cons name mapping)))
+                                  services))
+
+                ;; Append the user's config file.
+                (call-with-input-file #$config-file
+                  (lambda (input)
+                    (dump-port input port)))
+                #t))))))))
 
 (define (tor-shepherd-service config)
   "Return a <shepherd-service> running TOR."
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 9908b9526b..44d12a7e77 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -158,27 +158,27 @@ (define (xorg-configuration-directory modules)
   "Return a directory that contains the @code{.conf} files for X.org that
 includes the @code{share/X11/xorg.conf.d} directories of each package listed
 in @var{modules}."
-  (computed-file "xorg.conf.d"
-                 #~(begin
-                     (use-modules (guix build utils)
-                                  (srfi srfi-1))
-
-                     (define files
-                       (append-map (lambda (module)
-                                     (find-files (string-append
-                                                  module
-                                                  "/share/X11/xorg.conf.d")
-                                                 "\\.conf$"))
-                                   (list #$@modules)))
-
-                     (mkdir #$output)
-                     (for-each (lambda (file)
-                                 (symlink file
-                                          (string-append #$output "/"
-                                                         (basename file))))
-                               files)
-                     #t)
-                 #:modules '((guix build utils))))
+  (with-imported-modules '((guix build utils))
+    (computed-file "xorg.conf.d"
+                   #~(begin
+                       (use-modules (guix build utils)
+                                    (srfi srfi-1))
+
+                       (define files
+                         (append-map (lambda (module)
+                                       (find-files (string-append
+                                                    module
+                                                    "/share/X11/xorg.conf.d")
+                                                   "\\.conf$"))
+                                     (list #$@modules)))
+
+                       (mkdir #$output)
+                       (for-each (lambda (file)
+                                   (symlink file
+                                            (string-append #$output "/"
+                                                           (basename file))))
+                                 files)
+                       #t))))
 
 (define* (xorg-start-command #:key
                              (guile (canonical-package guile-2.0))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index de14f6fb4c..329c7aba32 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -55,52 +55,53 @@ (define* (self-contained-tarball #:key (guix guix))
                                 (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 +213,20 @@ (define (file f)
 
   (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)))
 
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 3acc579a6b..2e20379473 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -87,30 +87,28 @@ (define* (container-script os #:key (mappings '()))
                                   #:container? #t)))
 
       (define script
-        #~(begin
-            (use-modules (gnu build linux-container)
-                         (guix build utils))
+        (with-imported-modules '((guix config)
+                                 (guix utils)
+                                 (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 8339fae7ed..bbaa5c0f89 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -55,85 +55,81 @@ (define* (expression->initrd exp
                              (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
@@ -227,38 +223,38 @@ (define device-mapping-commands
   (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 @@ (define* (locale-directory locales
                                                                 #: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/shadow.scm b/gnu/system/shadow.scm
index b8837c63f0..730a9ee091 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -139,10 +139,11 @@ (define fonts.conf-content
     `(fontconfig (dir "/run/current-system/profile/share/fonts")))
 
   (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
@@ -176,27 +177,26 @@ (define copy-guile-wm
         (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"))
         (fonts.conf (computed-file
                      "fonts.conf"
-                     #~(begin
-                         (use-modules (guix build utils)
-                                      (sxml simple))
-
-                         (define dir
-                           (string-append #$output
-                                          "/fontconfig"))
-
-                         (mkdir-p dir)
-                         (call-with-output-file (string-append dir
-                                                             "/fonts.conf")
-                           (lambda (port)
-                             (sxml->xml '#$fonts.conf-content port))))
-                     #:modules '((guix build utils))))
+                     (with-imported-modules '((guix build utils))
+                       #~(begin
+                           (use-modules (guix build utils)
+                                        (sxml simple))
+
+                           (define dir
+                             (string-append #$output
+                                            "/fontconfig"))
+
+                           (mkdir-p dir)
+                           (call-with-output-file (string-append dir
+                                                                 "/fonts.conf")
+                             (lambda (port)
+                               (sxml->xml '#$fonts.conf-content port)))))))
         (gdbinit   (plain-file "gdbinit" "\
 # Tell GDB where to look for separate debugging files.
 set debug-file-directory ~/.guix-profile/lib/debug\n")))
@@ -211,22 +211,22 @@ (define dir
 (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..fc5eaf5706 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -155,34 +155,34 @@ (define* (expression->derivation-in-linux-vm name exp
 
     (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 modules
+        #~(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)))
 
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 0013b465b4..a6278b25d4 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -70,125 +70,125 @@ (define* (run-basic-test os command #:optional (name "basic"))
 using COMMAND, a gexp that evaluates to a list of strings.  Compare some
 properties of running system to what's declared in OS, an <operating-system>."
   (define test
-    #~(begin
-        (use-modules (gnu build marionette)
-                     (srfi srfi-1)
-                     (srfi srfi-26)
-                     (srfi srfi-64)
-                     (ice-9 match))
-
-        (define marionette
-          (make-marionette #$command))
-
-        (mkdir #$output)
-        (chdir #$output)
-
-        (test-begin "basic")
-
-        (test-assert "uname"
-          (match (marionette-eval '(uname) marionette)
-            (#("Linux" host-name version _ architecture)
-             (and (string=? host-name
-                            #$(operating-system-host-name os))
-                  (string-prefix? #$(package-version
-                                     (operating-system-kernel os))
-                                  version)
-                  (string-prefix? architecture %host-type)))))
-
-        (test-assert "shell and user commands"
-          ;; Is everything in $PATH?
-          (zero? (marionette-eval '(system "
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-1)
+                       (srfi srfi-26)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette #$command))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "basic")
+
+          (test-assert "uname"
+            (match (marionette-eval '(uname) marionette)
+              (#("Linux" host-name version _ architecture)
+               (and (string=? host-name
+                              #$(operating-system-host-name os))
+                    (string-prefix? #$(package-version
+                                       (operating-system-kernel os))
+                                    version)
+                    (string-prefix? architecture %host-type)))))
+
+          (test-assert "shell and user commands"
+            ;; Is everything in $PATH?
+            (zero? (marionette-eval '(system "
 . /etc/profile
 set -e -x
 guix --version
 ls --version
 grep --version
 info --version")
-                                  marionette)))
-
-        (test-assert "accounts"
-          (let ((users (marionette-eval '(begin
-                                           (use-modules (ice-9 match))
-                                           (let loop ((result '()))
-                                             (match (getpw)
-                                               (#f (reverse result))
-                                               (x  (loop (cons x result))))))
-                                        marionette)))
-            (lset= string=?
-                   (map passwd:name users)
-                   (list
-                    #$@(map user-account-name
-                            (operating-system-user-accounts os))))))
-
-        (test-assert "shepherd services"
-          (let ((services (marionette-eval '(begin
-                                              (use-modules (gnu services herd))
-                                              (call-with-values current-services
-                                                append))
-                                           marionette)))
-            (lset= eq?
-                   (pk 'services services)
-                   '(root #$@(operating-system-shepherd-service-names os)))))
-
-        (test-equal "login on tty1"
-          "root\n"
-          (begin
-            (marionette-control "sendkey ctrl-alt-f1" marionette)
-            ;; Wait for the 'term-tty1' service to be running (using
-            ;; 'start-service' is the simplest and most reliable way to do
-            ;; that.)
+                                    marionette)))
+
+          (test-assert "accounts"
+            (let ((users (marionette-eval '(begin
+                                             (use-modules (ice-9 match))
+                                             (let loop ((result '()))
+                                               (match (getpw)
+                                                 (#f (reverse result))
+                                                 (x  (loop (cons x result))))))
+                                          marionette)))
+              (lset= string=?
+                     (map passwd:name users)
+                     (list
+                      #$@(map user-account-name
+                              (operating-system-user-accounts os))))))
+
+          (test-assert "shepherd services"
+            (let ((services (marionette-eval '(begin
+                                                (use-modules (gnu services herd))
+                                                (call-with-values current-services
+                                                  append))
+                                             marionette)))
+              (lset= eq?
+                     (pk 'services services)
+                     '(root #$@(operating-system-shepherd-service-names os)))))
+
+          (test-equal "login on tty1"
+            "root\n"
+            (begin
+              (marionette-control "sendkey ctrl-alt-f1" marionette)
+              ;; Wait for the 'term-tty1' service to be running (using
+              ;; 'start-service' is the simplest and most reliable way to do
+              ;; that.)
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'term-tty1))
+               marionette)
+
+              ;; Now we can type.
+              (marionette-type "root\n\nid -un > logged-in\n" marionette)
+
+              ;; It can take a while before the shell commands are executed.
+              (let loop ((i 0))
+                (unless (or (file-exists? "/root/logged-in") (> i 15))
+                  (sleep 1)
+                  (loop (+ i 1))))
+              (marionette-eval '(use-modules (rnrs io ports)) marionette)
+              (marionette-eval '(call-with-input-file "/root/logged-in"
+                                  get-string-all)
+                               marionette)))
+
+          (test-assert "host name resolution"
+            (match (marionette-eval
+                    '(begin
+                       ;; Wait for nscd or our requests go through it.
+                       (use-modules (gnu services herd))
+                       (start-service 'nscd)
+
+                       (list (getaddrinfo "localhost")
+                             (getaddrinfo #$(operating-system-host-name os))))
+                    marionette)
+              ((((? vector?) ..1) ((? vector?) ..1))
+               #t)
+              (x
+               (pk 'failure x #f))))
+
+          (test-equal "host not found"
+            #f
             (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'term-tty1))
-             marionette)
-
-            ;; Now we can type.
-            (marionette-type "root\n\nid -un > logged-in\n" marionette)
-
-            ;; It can take a while before the shell commands are executed.
-            (let loop ((i 0))
-              (unless (or (file-exists? "/root/logged-in") (> i 15))
-                (sleep 1)
-                (loop (+ i 1))))
-            (marionette-eval '(use-modules (rnrs io ports)) marionette)
-            (marionette-eval '(call-with-input-file "/root/logged-in"
-                                get-string-all)
-                             marionette)))
-
-        (test-assert "host name resolution"
-          (match (marionette-eval
-                  '(begin
-                     ;; Wait for nscd or our requests go through it.
-                     (use-modules (gnu services herd))
-                     (start-service 'nscd)
-
-                     (list (getaddrinfo "localhost")
-                           (getaddrinfo #$(operating-system-host-name os))))
-                  marionette)
-            ((((? vector?) ..1) ((? vector?) ..1))
-             #t)
-            (x
-             (pk 'failure x #f))))
-
-        (test-equal "host not found"
-          #f
-          (marionette-eval
-           '(false-if-exception (getaddrinfo "does-not-exist"))
-           marionette))
-
-        (test-assert "screendump"
-          (begin
-            (marionette-control (string-append "screendump " #$output
-                                               "/tty1.ppm")
-                                marionette)
-            (file-exists? "tty1.ppm")))
-
-        (test-end)
-        (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
-  (gexp->derivation name test
-                    #:modules '((gnu build marionette))))
+             '(false-if-exception (getaddrinfo "does-not-exist"))
+             marionette))
+
+          (test-assert "screendump"
+            (begin
+              (marionette-control (string-append "screendump " #$output
+                                                 "/tty1.ppm")
+                                  marionette)
+              (file-exists? "tty1.ppm")))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
 
 (define %test-basic-os
   (system-test
@@ -243,67 +243,67 @@ (define (run-mcron-test name)
                        (command (system-qemu-image/shared-store-script
                                  os #:graphic? #f)))
     (define test
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (srfi srfi-64)
-                       (ice-9 match))
-
-          (define marionette
-            (make-marionette (list #$command)))
-
-          (define (wait-for-file file)
-            ;; Wait until FILE exists in the guest; 'read' its content and
-            ;; return it.
-            (marionette-eval
-             `(let loop ((i 10))
-                (cond ((file-exists? ,file)
-                       (call-with-input-file ,file read))
-                      ((> i 0)
-                       (sleep 1)
-                       (loop (- i 1)))
-                      (else
-                       (error "file didn't show up" ,file))))
-             marionette))
-
-          (mkdir #$output)
-          (chdir #$output)
-
-          (test-begin "mcron")
-
-          (test-eq "service running"
-            'running!
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'mcron)
-                'running!)
-             marionette))
-
-          ;; Make sure root's mcron job runs, has its cwd set to "/root", and
-          ;; runs with the right UID/GID.
-          (test-equal "root's job"
-            '(0 0)
-            (wait-for-file "/root/witness"))
-
-          ;; Likewise for Alice's job.  We cannot know what its GID is since
-          ;; it's chosen by 'groupadd', but it's strictly positive.
-          (test-assert "alice's job"
-            (match (wait-for-file "/home/alice/witness")
-              ((1000 gid)
-               (>= gid 100))))
-
-          ;; Last, the job that uses a command; allows us to test whether
-          ;; $PATH is sane.  (Note that 'marionette-eval' stringifies objects
-          ;; that don't have a read syntax, hence the string.)
-          (test-equal "root's job with command"
-            "#<eof>"
-            (wait-for-file "/root/witness-touch"))
-
-          (test-end)
-          (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
-    (gexp->derivation name test
-                      #:modules '((gnu build marionette)))))
+      (with-imported-modules '((gnu build marionette))
+        #~(begin
+            (use-modules (gnu build marionette)
+                         (srfi srfi-64)
+                         (ice-9 match))
+
+            (define marionette
+              (make-marionette (list #$command)))
+
+            (define (wait-for-file file)
+              ;; Wait until FILE exists in the guest; 'read' its content and
+              ;; return it.
+              (marionette-eval
+               `(let loop ((i 10))
+                  (cond ((file-exists? ,file)
+                         (call-with-input-file ,file read))
+                        ((> i 0)
+                         (sleep 1)
+                         (loop (- i 1)))
+                        (else
+                         (error "file didn't show up" ,file))))
+               marionette))
+
+            (mkdir #$output)
+            (chdir #$output)
+
+            (test-begin "mcron")
+
+            (test-eq "service running"
+              'running!
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'mcron)
+                  'running!)
+               marionette))
+
+            ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+            ;; runs with the right UID/GID.
+            (test-equal "root's job"
+              '(0 0)
+              (wait-for-file "/root/witness"))
+
+            ;; Likewise for Alice's job.  We cannot know what its GID is since
+            ;; it's chosen by 'groupadd', but it's strictly positive.
+            (test-assert "alice's job"
+              (match (wait-for-file "/home/alice/witness")
+                ((1000 gid)
+                 (>= gid 100))))
+
+            ;; Last, the job that uses a command; allows us to test whether
+            ;; $PATH is sane.  (Note that 'marionette-eval' stringifies objects
+            ;; that don't have a read syntax, hence the string.)
+            (test-equal "root's job with command"
+              "#<eof>"
+              (wait-for-file "/root/witness-touch"))
+
+            (test-end)
+            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+    (gexp->derivation name test)))
 
 (define %test-mcron
   (system-test
@@ -355,90 +355,90 @@ (define mdns-host-name
                      ".local"))
 
     (define test
-      #~(begin
-          (use-modules (gnu build marionette)
-                       (srfi srfi-1)
-                       (srfi srfi-64)
-                       (ice-9 match))
-
-          (define marionette
-            (make-marionette (list #$run)))
-
-          (mkdir #$output)
-          (chdir #$output)
-
-          (test-begin "avahi")
-
-          (test-assert "wait for services"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-
-                (start-service 'nscd)
-
-                ;; XXX: Work around a race condition in nscd: nscd creates its
-                ;; PID file before it is listening on its socket.
-                (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
-                  (let try ()
-                    (catch 'system-error
-                      (lambda ()
-                        (connect sock AF_UNIX "/var/run/nscd/socket")
-                        (close-port sock)
-                        (format #t "nscd is ready~%"))
-                      (lambda args
-                        (format #t "waiting for nscd...~%")
-                        (usleep 500000)
-                        (try)))))
-
-                ;; Wait for the other useful things.
-                (start-service 'avahi-daemon)
-                (start-service 'networking)
-
-                #t)
-             marionette))
-
-          (test-equal "avahi-resolve-host-name"
-            0
-            (marionette-eval
-             '(system*
-               "/run/current-system/profile/bin/avahi-resolve-host-name"
-               "-v" #$mdns-host-name)
-             marionette))
-
-          (test-equal "avahi-browse"
-            0
-            (marionette-eval
-             '(system* "avahi-browse" "-avt")
-             marionette))
-
-          (test-assert "getaddrinfo .local"
-            ;; Wait for the 'avahi-daemon' service and perform a resolution.
-            (match (marionette-eval
-                    '(getaddrinfo #$mdns-host-name)
-                    marionette)
-              (((? vector? addrinfos) ..1)
-               (pk 'getaddrinfo addrinfos)
-               (and (any (lambda (ai)
-                           (= AF_INET (addrinfo:fam ai)))
-                         addrinfos)
-                    (any (lambda (ai)
-                           (= AF_INET6 (addrinfo:fam ai)))
-                         addrinfos)))))
-
-          (test-assert "gethostbyname .local"
-            (match (pk 'gethostbyname
-                       (marionette-eval '(gethostbyname #$mdns-host-name)
-                                        marionette))
-              ((? vector? result)
-               (and (string=? (hostent:name result) #$mdns-host-name)
-                    (= (hostent:addrtype result) AF_INET)))))
-
-
-          (test-end)
-          (exit (= (test-runner-fail-count (test-runner-current)) 0))))
-
-    (gexp->derivation "nss-mdns" test
-                      #:modules '((gnu build marionette)))))
+      (with-imported-modules '((gnu build marionette))
+        #~(begin
+            (use-modules (gnu build marionette)
+                         (srfi srfi-1)
+                         (srfi srfi-64)
+                         (ice-9 match))
+
+            (define marionette
+              (make-marionette (list #$run)))
+
+            (mkdir #$output)
+            (chdir #$output)
+
+            (test-begin "avahi")
+
+            (test-assert "wait for services"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+
+                  (start-service 'nscd)
+
+                  ;; XXX: Work around a race condition in nscd: nscd creates its
+                  ;; PID file before it is listening on its socket.
+                  (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+                    (let try ()
+                      (catch 'system-error
+                        (lambda ()
+                          (connect sock AF_UNIX "/var/run/nscd/socket")
+                          (close-port sock)
+                          (format #t "nscd is ready~%"))
+                        (lambda args
+                          (format #t "waiting for nscd...~%")
+                          (usleep 500000)
+                          (try)))))
+
+                  ;; Wait for the other useful things.
+                  (start-service 'avahi-daemon)
+                  (start-service 'networking)
+
+                  #t)
+               marionette))
+
+            (test-equal "avahi-resolve-host-name"
+              0
+              (marionette-eval
+               '(system*
+                 "/run/current-system/profile/bin/avahi-resolve-host-name"
+                 "-v" #$mdns-host-name)
+               marionette))
+
+            (test-equal "avahi-browse"
+              0
+              (marionette-eval
+               '(system* "avahi-browse" "-avt")
+               marionette))
+
+            (test-assert "getaddrinfo .local"
+              ;; Wait for the 'avahi-daemon' service and perform a resolution.
+              (match (marionette-eval
+                      '(getaddrinfo #$mdns-host-name)
+                      marionette)
+                (((? vector? addrinfos) ..1)
+                 (pk 'getaddrinfo addrinfos)
+                 (and (any (lambda (ai)
+                             (= AF_INET (addrinfo:fam ai)))
+                           addrinfos)
+                      (any (lambda (ai)
+                             (= AF_INET6 (addrinfo:fam ai)))
+                           addrinfos)))))
+
+            (test-assert "gethostbyname .local"
+              (match (pk 'gethostbyname
+                         (marionette-eval '(gethostbyname #$mdns-host-name)
+                                          marionette))
+                ((? vector? result)
+                 (and (string=? (hostent:name result) #$mdns-host-name)
+                      (= (hostent:addrtype result) AF_INET)))))
+
+
+            (test-end)
+            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+    (gexp->derivation "nss-mdns" test)))
 
 (define %test-nss-mdns
   (system-test
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 2c0db41d69..3c83da151a 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -119,43 +119,45 @@ (define* (run-install #:key
                                  os (list target))
                                 #:disk-image-size (* 1500 MiB))))
     (define install
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build marionette))
-
-          (set-path-environment-variable "PATH" '("bin")
-                                         (list #$qemu-minimal))
-
-          (system* "qemu-img" "create" "-f" "qcow2"
-                   #$output #$(number->string target-size))
-
-          (define marionette
-            (make-marionette
-             (cons (which #$(qemu-command system))
-                   (cons* "-no-reboot" "-m" "800"
-                          "-drive"
-                          (string-append "file=" #$image
-                                         ",if=virtio,readonly")
-                          "-drive"
-                          (string-append "file=" #$output ",if=virtio")
-                          (if (file-exists? "/dev/kvm")
-                              '("-enable-kvm")
-                              '())))))
-
-          (pk 'uname (marionette-eval '(uname) marionette))
-
-          ;; Wait for tty1.
-          (marionette-eval '(begin
-                              (use-modules (gnu services herd))
-                              (start 'term-tty1))
-                           marionette)
-
-          (marionette-eval '(call-with-output-file "/etc/litl-config.scm"
-                              (lambda (port)
-                                (write '#$%minimal-os-source port)))
-                           marionette)
-
-          (exit (marionette-eval '(zero? (system "
+      (with-imported-modules '((guix build utils)
+                               (gnu build marionette))
+        #~(begin
+            (use-modules (guix build utils)
+                         (gnu build marionette))
+
+            (set-path-environment-variable "PATH" '("bin")
+                                           (list #$qemu-minimal))
+
+            (system* "qemu-img" "create" "-f" "qcow2"
+                     #$output #$(number->string target-size))
+
+            (define marionette
+              (make-marionette
+               (cons (which #$(qemu-command system))
+                     (cons* "-no-reboot" "-m" "800"
+                            "-drive"
+                            (string-append "file=" #$image
+                                           ",if=virtio,readonly")
+                            "-drive"
+                            (string-append "file=" #$output ",if=virtio")
+                            (if (file-exists? "/dev/kvm")
+                                '("-enable-kvm")
+                                '())))))
+
+            (pk 'uname (marionette-eval '(uname) marionette))
+
+            ;; Wait for tty1.
+            (marionette-eval '(begin
+                                (use-modules (gnu services herd))
+                                (start 'term-tty1))
+                             marionette)
+
+            (marionette-eval '(call-with-output-file "/etc/litl-config.scm"
+                                (lambda (port)
+                                  (write '#$%minimal-os-source port)))
+                             marionette)
+
+            (exit (marionette-eval '(zero? (system "
 . /etc/profile
 set -e -x;
 guix --version
@@ -178,11 +180,9 @@ (define marionette
 guix system init /mnt/etc/config.scm /mnt --no-substitutes
 sync
 reboot\n"))
-                                 marionette))))
+                                   marionette)))))
 
-    (gexp->derivation "installation" install
-                      #:modules '((guix build utils)
-                                  (gnu build marionette)))))
+    (gexp->derivation "installation" install)))
 
 
 (define %test-installed-os
-- 
cgit v1.2.3


From 43dcce8674d9c7d72db4f3f5aae590cea788d5b4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 3 Jul 2016 23:31:14 +0200
Subject: linux-container: Fix list of imported modules.

This fixes a regression introduced in
958dd3ce68733bcd5c1231424c7e4ad39e67594a.

* gnu/system/linux-container.scm (container-script)[script]: Add (guix
combinators) to the list of imported modules.
---
 gnu/system/linux-container.scm | 1 +
 1 file changed, 1 insertion(+)

(limited to 'gnu/system')

diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index 2e20379473..d3c0036f47 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -89,6 +89,7 @@ (define* (container-script os #:key (mappings '()))
       (define script
         (with-imported-modules '((guix config)
                                  (guix utils)
+                                 (guix combinators)
                                  (guix build utils)
                                  (guix build syscalls)
                                  (guix build bournish)
-- 
cgit v1.2.3


From fd129893982dcbda639429fc5b19c3715518ba40 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 4 Jul 2016 23:58:57 +0200
Subject: gnu: Use 'gexp->file' in conjunction with 'with-imported-modules'.

* gnu/services.scm (activation-script): Remove code to set '%load-path'
and use 'with-imported-modules' instead.
(cleanup-gexp): Likewise.
* gnu/system/vm.scm (%vm-module-closure): New variable.
(expression->derivation-in-linux-vm): Remove #:modules.
[loader]: Remove code to set '%load-path'.
[builder]: Use %VM-MODULE-CLOSURE.
(qemu-image): Use 'with-imported-modules'.
---
 gnu/services.scm  |  94 +++++++++++++++++------------------------
 gnu/system/vm.scm | 122 ++++++++++++++++++++++++++----------------------------
 2 files changed, 97 insertions(+), 119 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/services.scm b/gnu/services.scm
index 661835f68e..5479bfae19 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -238,42 +238,33 @@ (define %boot-service
 (define (cleanup-gexp _)
   "Return as a monadic value a gexp to clean up /tmp and similar places upon
 boot."
-  (define %modules
-    '((guix build utils)))
-
-  (mlet %store-monad ((modules  (imported-modules %modules))
-                      (compiled (compiled-modules %modules)))
-    (return #~(begin
-                (eval-when (expand load eval)
-                  ;; Make sure 'use-modules' below succeeds.
-                  (set! %load-path (cons #$modules %load-path))
-                  (set! %load-compiled-path
-                    (cons #$compiled %load-compiled-path)))
-
-                (use-modules (guix build utils))
-
-                ;; Clean out /tmp and /var/run.
-                ;;
-                ;; XXX This needs to happen before service activations, so it
-                ;; has to be here, but this also implicitly assumes that /tmp
-                ;; and /var/run are on the root partition.
-                (letrec-syntax ((fail-safe (syntax-rules ()
-                                             ((_ exp rest ...)
-                                              (begin
-                                                (catch 'system-error
-                                                  (lambda () exp)
-                                                  (const #f))
-                                                (fail-safe rest ...)))
-                                             ((_)
-                                              #t))))
-                  ;; Ignore I/O errors so the system can boot.
-                  (fail-safe
-                   (delete-file-recursively "/tmp")
-                   (delete-file-recursively "/var/run")
-                   (mkdir "/tmp")
-                   (chmod "/tmp" #o1777)
-                   (mkdir "/var/run")
-                   (chmod "/var/run" #o755)))))))
+  (with-monad %store-monad
+    (with-imported-modules '((guix build utils))
+      (return #~(begin
+                  (use-modules (guix build utils))
+
+                  ;; Clean out /tmp and /var/run.
+                  ;;
+                  ;; XXX This needs to happen before service activations, so it
+                  ;; has to be here, but this also implicitly assumes that /tmp
+                  ;; and /var/run are on the root partition.
+                  (letrec-syntax ((fail-safe (syntax-rules ()
+                                               ((_ exp rest ...)
+                                                (begin
+                                                  (catch 'system-error
+                                                    (lambda () exp)
+                                                    (const #f))
+                                                  (fail-safe rest ...)))
+                                               ((_)
+                                                #t))))
+                    ;; Ignore I/O errors so the system can boot.
+                    (fail-safe
+                     (delete-file-recursively "/tmp")
+                     (delete-file-recursively "/var/run")
+                     (mkdir "/tmp")
+                     (chmod "/tmp" #o1777)
+                     (mkdir "/var/run")
+                     (chmod "/var/run" #o755))))))))
 
 (define cleanup-service-type
   ;; Service that cleans things up in /tmp and similar.
@@ -337,29 +328,22 @@ (define (service-activations)
           (cut gexp->file "activate-service" <>)
           gexps))
 
-  (mlet* %store-monad ((actions  (service-activations))
-                       (modules  (imported-modules %modules))
-                       (compiled (compiled-modules %modules)))
+  (mlet* %store-monad ((actions (service-activations)))
     (gexp->file "activate"
-                #~(begin
-                    (eval-when (expand load eval)
-                      ;; Make sure 'use-modules' below succeeds.
-                      (set! %load-path (cons #$modules %load-path))
-                      (set! %load-compiled-path
-                        (cons #$compiled %load-compiled-path)))
-
-                    (use-modules (gnu build activation))
+                (with-imported-modules %modules
+                  #~(begin
+                      (use-modules (gnu build activation))
 
-                    ;; Make sure /bin/sh is valid and current.
-                    (activate-/bin/sh
-                     (string-append #$(canonical-package bash) "/bin/sh"))
+                      ;; Make sure /bin/sh is valid and current.
+                      (activate-/bin/sh
+                       (string-append #$(canonical-package bash) "/bin/sh"))
 
-                    ;; Run the services' activation snippets.
-                    ;; TODO: Use 'load-compiled'.
-                    (for-each primitive-load '#$actions)
+                      ;; Run the services' activation snippets.
+                      ;; TODO: Use 'load-compiled'.
+                      (for-each primitive-load '#$actions)
 
-                    ;; Set up /run/current-system.
-                    (activate-current-system)))))
+                      ;; Set up /run/current-system.
+                      (activate-current-system))))))
 
 (define (gexps->activation-gexp gexps)
   "Return a gexp that runs the activation script containing GEXPS."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index fc5eaf5706..c31e3a80ef 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -90,6 +90,21 @@ (define %linux-vm-file-systems
           (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 @@ (define* (expression->derivation-in-linux-vm name exp
                                              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 @@ (define* (expression->derivation-in-linux-vm name exp
 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,7 +148,7 @@ (define* (expression->derivation-in-linux-vm name exp
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
-      (with-imported-modules modules
+      (with-imported-modules %vm-module-closure
         #~(begin
             (use-modules (guix build utils)
                          (gnu build vm))
@@ -212,45 +205,46 @@ (define* (qemu-image #:key
 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
-- 
cgit v1.2.3


From a91c3fc727ba90d8c9b91f67fb672da2e6b877ad Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 12 Jul 2016 00:38:50 +0200
Subject: services: <shepherd-service> no longer has an 'imported-modules'
 field.

* gnu/services/shepherd.scm (<shepherd-service>)[imported-modules]:
Remove.
(%default-imported-modules): Make private.
(shepherd-service-file): Use 'with-imported-modules'.
(shepherd-configuration-file): Remove 'modules' and the calls to
'imported-modules' and 'compiled-modules'.  Use
'with-imported-modules' instead.
* doc/guix.texi (Shepherd Services): Adjust accordingly.
* gnu/services/base.scm (file-system-shepherd-service): Use
'with-imported-modules'.  Remove 'imported-modules' field.
* gnu/system/mapped-devices.scm (device-mapping-service-type): Remove
'imported-modules'.
(open-luks-device): Use 'with-imported-modules'.
* gnu/tests.scm (marionette-shepherd-service): Remove 'imported-modules'
field and use 'with-imported-modules'.
---
 doc/guix.texi                 |   4 --
 gnu/services/base.scm         | 105 ++++++++++++++++++------------------
 gnu/services/shepherd.scm     |  43 +++++----------
 gnu/system/mapped-devices.scm |  34 ++++++------
 gnu/tests.scm                 | 122 +++++++++++++++++++++---------------------
 5 files changed, 144 insertions(+), 164 deletions(-)

(limited to 'gnu/system')

diff --git a/doc/guix.texi b/doc/guix.texi
index abd294e886..37e854dc59 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -10848,10 +10848,6 @@ where @var{service-name} is one of the symbols in @var{provision}
 This is the list of modules that must be in scope when @code{start} and
 @code{stop} are evaluated.
 
-@item @code{imported-modules} (default: @var{%default-imported-modules})
-This is the list of modules to import in the execution environment of
-the Shepherd.
-
 @end table
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d9c60778a1..02e3b41904 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -229,59 +229,58 @@ (define (file-system-shepherd-service file-system)
         (create? (file-system-create-mount-point? file-system))
         (dependencies (file-system-dependencies file-system)))
     (if (file-system-mount? file-system)
-        (list
-         (shepherd-service
-          (provision (list (file-system->shepherd-service-name file-system)))
-          (requirement `(root-file-system
-                         ,@(map dependency->shepherd-service-name dependencies)))
-          (documentation "Check, mount, and unmount the given file system.")
-          (start #~(lambda args
-                     ;; FIXME: Use or factorize with 'mount-file-system'.
-                     (let ((device (canonicalize-device-spec #$device '#$title))
-                           (flags  #$(mount-flags->bit-mask
-                                      (file-system-flags file-system))))
-                       #$(if create?
-                             #~(mkdir-p #$target)
-                             #~#t)
-                       #$(if check?
-                             #~(begin
-                                 ;; Make sure fsck.ext2 & co. can be found.
-                                 (setenv "PATH"
-                                         (string-append
-                                          #$e2fsprogs "/sbin:"
-                                          "/run/current-system/profile/sbin:"
-                                          (getenv "PATH")))
-                                 (check-file-system device #$type))
-                             #~#t)
-
-                       (mount device #$target #$type flags
-                              #$(file-system-options file-system))
-
-                       ;; For read-only bind mounts, an extra remount is
-                       ;; needed, as per <http://lwn.net/Articles/281157/>,
-                       ;; which still applies to Linux 4.0.
-                       (when (and (= MS_BIND (logand flags MS_BIND))
-                                  (= MS_RDONLY (logand flags MS_RDONLY)))
-                         (mount device #$target #$type
-                                (logior MS_BIND MS_REMOUNT MS_RDONLY))))
-                     #t))
-          (stop #~(lambda args
-                    ;; Normally there are no processes left at this point, so
-                    ;; TARGET can be safely unmounted.
-
-                    ;; Make sure PID 1 doesn't keep TARGET busy.
-                    (chdir "/")
-
-                    (umount #$target)
-                    #f))
-
-          ;; We need an additional module.
-          (modules `(((gnu build file-systems)
-                      #:select (check-file-system canonicalize-device-spec))
-                     ,@%default-modules))
-          (imported-modules `((gnu build file-systems)
-                              (guix build bournish)
-                              ,@%default-imported-modules))))
+        (with-imported-modules '((gnu build file-systems)
+                                 (guix build bournish))
+          (list
+           (shepherd-service
+            (provision (list (file-system->shepherd-service-name file-system)))
+            (requirement `(root-file-system
+                           ,@(map dependency->shepherd-service-name dependencies)))
+            (documentation "Check, mount, and unmount the given file system.")
+            (start #~(lambda args
+                       ;; FIXME: Use or factorize with 'mount-file-system'.
+                       (let ((device (canonicalize-device-spec #$device '#$title))
+                             (flags  #$(mount-flags->bit-mask
+                                        (file-system-flags file-system))))
+                         #$(if create?
+                               #~(mkdir-p #$target)
+                               #~#t)
+                         #$(if check?
+                               #~(begin
+                                   ;; Make sure fsck.ext2 & co. can be found.
+                                   (setenv "PATH"
+                                           (string-append
+                                            #$e2fsprogs "/sbin:"
+                                            "/run/current-system/profile/sbin:"
+                                            (getenv "PATH")))
+                                   (check-file-system device #$type))
+                               #~#t)
+
+                         (mount device #$target #$type flags
+                                #$(file-system-options file-system))
+
+                         ;; For read-only bind mounts, an extra remount is
+                         ;; needed, as per <http://lwn.net/Articles/281157/>,
+                         ;; which still applies to Linux 4.0.
+                         (when (and (= MS_BIND (logand flags MS_BIND))
+                                    (= MS_RDONLY (logand flags MS_RDONLY)))
+                           (mount device #$target #$type
+                                  (logior MS_BIND MS_REMOUNT MS_RDONLY))))
+                       #t))
+            (stop #~(lambda args
+                      ;; Normally there are no processes left at this point, so
+                      ;; TARGET can be safely unmounted.
+
+                      ;; Make sure PID 1 doesn't keep TARGET busy.
+                      (chdir "/")
+
+                      (umount #$target)
+                      #f))
+
+            ;; We need an additional module.
+            (modules `(((gnu build file-systems)
+                        #:select (check-file-system canonicalize-device-spec))
+                       ,@%default-modules)))))
         '())))
 
 (define file-system-service-type
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 5d829e4c38..f35a6bf10a 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -47,9 +47,7 @@ (define-module (gnu services shepherd)
             shepherd-service-stop
             shepherd-service-auto-start?
             shepherd-service-modules
-            shepherd-service-imported-modules
 
-            %default-imported-modules
             %default-modules
 
             shepherd-service-file
@@ -138,9 +136,7 @@ (define-record-type* <shepherd-service>
   (auto-start?   shepherd-service-auto-start?          ;Boolean
                  (default #t))
   (modules       shepherd-service-modules              ;list of module names
-                 (default %default-modules))
-  (imported-modules shepherd-service-imported-modules  ;list of module names
-                    (default %default-imported-modules)))
+                 (default %default-modules)))
 
 (define (shepherd-service-canonical-name service)
   "Return the 'canonical name' of SERVICE."
@@ -203,37 +199,26 @@ (define (shepherd-service-file-name service)
 (define (shepherd-service-file service)
   "Return a file defining SERVICE."
   (gexp->file (shepherd-service-file-name service)
-              #~(begin
-                  (use-modules #$@(shepherd-service-modules service))
-
-                  (make <service>
-                    #:docstring '#$(shepherd-service-documentation service)
-                    #:provides '#$(shepherd-service-provision service)
-                    #:requires '#$(shepherd-service-requirement service)
-                    #:respawn? '#$(shepherd-service-respawn? service)
-                    #:start #$(shepherd-service-start service)
-                    #:stop #$(shepherd-service-stop service)))))
+              (with-imported-modules %default-imported-modules
+                #~(begin
+                    (use-modules #$@(shepherd-service-modules service))
+
+                    (make <service>
+                      #:docstring '#$(shepherd-service-documentation service)
+                      #:provides '#$(shepherd-service-provision service)
+                      #:requires '#$(shepherd-service-requirement service)
+                      #:respawn? '#$(shepherd-service-respawn? service)
+                      #:start #$(shepherd-service-start service)
+                      #:stop #$(shepherd-service-stop service))))))
 
 (define (shepherd-configuration-file services)
   "Return the shepherd configuration file for SERVICES."
-  (define modules
-    (delete-duplicates
-     (append-map shepherd-service-imported-modules services)))
-
   (assert-valid-graph services)
 
-  (mlet %store-monad ((modules  (imported-modules modules))
-                      (compiled (compiled-modules modules))
-                      (files    (mapm %store-monad
-                                      shepherd-service-file
-                                      services)))
+  (mlet %store-monad ((files (mapm %store-monad
+                                   shepherd-service-file services)))
     (define config
       #~(begin
-          (eval-when (expand load eval)
-            (set! %load-path (cons #$modules %load-path))
-            (set! %load-compiled-path
-              (cons #$compiled %load-compiled-path)))
-
           (use-modules (srfi srfi-34)
                        (system repl error-handling))
 
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 @@ (define device-mapping-service-type
        (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 (device-mapping-service mapped-device)
 (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/tests.scm b/gnu/tests.scm
index 1821ac45c5..8abe6c608b 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -80,68 +80,68 @@ (define (marionette-shepherd-service config)
                        (srfi srfi-9 gnu)
                        (guix build syscalls)
                        (rnrs bytevectors)))
-            (imported-modules `((guix build syscalls)
-                                ,@imported-modules))
             (start
-             #~(lambda ()
-                 (define (clear-echo termios)
-                   (set-field termios (termios-local-flags)
-                              (logand (lognot (local-flags ECHO))
-                                      (termios-local-flags termios))))
-
-                 (define (self-quoting? x)
-                   (letrec-syntax ((one-of (syntax-rules ()
-                                             ((_) #f)
-                                             ((_ pred rest ...)
-                                              (or (pred x)
-                                                  (one-of rest ...))))))
-                     (one-of symbol? string? pair? null? vector?
-                             bytevector? number? boolean?)))
-
-                 (match (primitive-fork)
-                   (0
-                    (dynamic-wind
-                      (const #t)
-                      (lambda ()
-                        (let* ((repl    (open-file #$device "r+0"))
-                               (termios (tcgetattr (fileno repl)))
-                               (console (open-file "/dev/console" "r+0")))
-                          ;; Don't echo input back.
-                          (tcsetattr (fileno repl) (tcsetattr-action TCSANOW)
-                                     (clear-echo termios))
-
-                          ;; Redirect output to the console.
-                          (close-fdes 1)
-                          (close-fdes 2)
-                          (dup2 (fileno console) 1)
-                          (dup2 (fileno console) 2)
-                          (close-port console)
-
-                          (display 'ready repl)
-                          (let loop ()
-                            (newline repl)
-
-                            (match (read repl)
-                              ((? eof-object?)
-                               (primitive-exit 0))
-                              (expr
-                               (catch #t
-                                 (lambda ()
-                                   (let ((result (primitive-eval expr)))
-                                     (write (if (self-quoting? result)
-                                                result
-                                                (object->string result))
-                                            repl)))
-                                 (lambda (key . args)
-                                   (print-exception (current-error-port)
-                                                    (stack-ref (make-stack #t) 1)
-                                                    key args)
-                                   (write #f repl)))))
-                            (loop))))
-                      (lambda ()
-                        (primitive-exit 1))))
-                   (pid
-                    pid))))
+             (with-imported-modules `((guix build syscalls)
+                                      ,@imported-modules)
+               #~(lambda ()
+                   (define (clear-echo termios)
+                     (set-field termios (termios-local-flags)
+                                (logand (lognot (local-flags ECHO))
+                                        (termios-local-flags termios))))
+
+                   (define (self-quoting? x)
+                     (letrec-syntax ((one-of (syntax-rules ()
+                                               ((_) #f)
+                                               ((_ pred rest ...)
+                                                (or (pred x)
+                                                    (one-of rest ...))))))
+                       (one-of symbol? string? pair? null? vector?
+                               bytevector? number? boolean?)))
+
+                   (match (primitive-fork)
+                     (0
+                      (dynamic-wind
+                        (const #t)
+                        (lambda ()
+                          (let* ((repl    (open-file #$device "r+0"))
+                                 (termios (tcgetattr (fileno repl)))
+                                 (console (open-file "/dev/console" "r+0")))
+                            ;; Don't echo input back.
+                            (tcsetattr (fileno repl) (tcsetattr-action TCSANOW)
+                                       (clear-echo termios))
+
+                            ;; Redirect output to the console.
+                            (close-fdes 1)
+                            (close-fdes 2)
+                            (dup2 (fileno console) 1)
+                            (dup2 (fileno console) 2)
+                            (close-port console)
+
+                            (display 'ready repl)
+                            (let loop ()
+                              (newline repl)
+
+                              (match (read repl)
+                                ((? eof-object?)
+                                 (primitive-exit 0))
+                                (expr
+                                 (catch #t
+                                   (lambda ()
+                                     (let ((result (primitive-eval expr)))
+                                       (write (if (self-quoting? result)
+                                                  result
+                                                  (object->string result))
+                                              repl)))
+                                   (lambda (key . args)
+                                     (print-exception (current-error-port)
+                                                      (stack-ref (make-stack #t) 1)
+                                                      key args)
+                                     (write #f repl)))))
+                              (loop))))
+                        (lambda ()
+                          (primitive-exit 1))))
+                     (pid
+                      pid)))))
             (stop #~(make-kill-destructor)))))))
 
 (define marionette-service-type
-- 
cgit v1.2.3


From 2d94702ff4133606cda1e51a2c8378a8e79afb9d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Jul 2016 23:42:35 +0200
Subject: system: Change the shell of 'nobody' to 'nologin'.

Fixes <http://bugs.gnu.org/23971>.
Reported by Vincent Legoll <vincent.legoll@gmail.com>.

* gnu/system/shadow.scm (%base-user-accounts): Add 'shell' field.  Set
'home-directory' to "/nonexistent".
---
 gnu/system/shadow.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'gnu/system')

diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 730a9ee091..593117ef36 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -126,7 +126,8 @@ (define %base-user-accounts
          (name "nobody")
          (uid 65534)
          (group "nogroup")
-         (home-directory "/var/empty")
+         (shell #~(string-append #$shadow "/sbin/nologin"))
+         (home-directory "/nonexistent")
          (system? #t))))
 
 (define (default-skeletons)
-- 
cgit v1.2.3


From f0fbf2c11cac98bedcab33a86ed7c477852b6033 Mon Sep 17 00:00:00 2001
From: Andreas Enge <andreas@enge.fr>
Date: Thu, 14 Jul 2016 15:07:49 +0200
Subject: install: Add mdadm to the image.

* gnu/system/install.scm (installation-os)[packages]: Add mdadm.
---
 gnu/system/install.scm | 2 ++
 1 file changed, 2 insertions(+)

(limited to 'gnu/system')

diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 329c7aba32..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.
 ;;;
@@ -392,6 +393,7 @@ (define installation-os
                      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
-- 
cgit v1.2.3


From 909147e43f8c9f8c9b9d33597d5dd83facca699c Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Mon, 12 Oct 2015 07:11:51 +0200
Subject: services: Add pam-limits-service.

* gnu/system/pam.scm (<pam-limits-entry>): New record type.
(pam-limits-entry, pam-limits-entry->string): New procedures.
* gnu/services/base.scm (pam-limits-service-type): New variable.
(pam-limits-service): New procedure.
* doc/guix.texi (Base Services): Document it.
---
 doc/guix.texi         | 30 +++++++++++++++++++++++++
 gnu/services/base.scm | 43 ++++++++++++++++++++++++++++++++++++
 gnu/system/pam.scm    | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 134 insertions(+)

(limited to 'gnu/system')

diff --git a/doc/guix.texi b/doc/guix.texi
index 1c4d57c811..7ea9ddfe35 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17,6 +17,7 @@ Copyright @copyright{} 2015, 2016 Mathieu Lirzin@*
 Copyright @copyright{} 2014 Pierre-Antoine Rault@*
 Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
 Copyright @copyright{} 2015, 2016 Leo Famulari@*
+Copyright @copyright{} 2015, 2016 Ricardo Wurmus@*
 Copyright @copyright{} 2016 Ben Woodcroft@*
 Copyright @copyright{} 2016 Chris Marusich@*
 Copyright @copyright{} 2016 Efraim Flashner
@@ -7570,6 +7571,35 @@ to add @var{device} to the kernel's entropy pool.  The service will fail if
 @var{device} does not exist.
 @end deffn
 
+@anchor{pam-limits-service}
+@cindex session limits
+@cindex ulimit
+@cindex priority
+@deffn {Scheme Procedure} pam-limits-service [#:limits @var{limits}]
+
+Return a service that installs a configuration file for the
+@uref{http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html,
+@code{pam_limits} module}.  The procedure optionally takes a list of
+@code{pam-limits-entry} values, which can be used to specify
+@code{ulimit} limits and nice priority limits to user sessions.
+
+The following limits definition sets two hard and soft limits for all
+login sessions of users in the @code{realtime} group:
+
+@example
+(pam-limits-service
+ (list
+  (pam-limits-entry "@@realtime" 'both 'rtprio 99)
+  (pam-limits-entry "@@realtime" 'both 'memlock 'unlimited)))
+@end example
+
+The first entry increases the maximum realtime priority for
+non-privileged processes; the second entry lifts any restriction of the
+maximum address space that can be locked in memory.  These settings are
+commonly used for real-time audio systems.
+@end deffn
+
+
 @node Scheduled Job Execution
 @subsubsection Scheduled Job Execution
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c9c2594533..805ba7d12c 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -100,6 +101,8 @@ (define-module (gnu services base)
             urandom-seed-service
             rngd-service-type
             rngd-service
+            pam-limits-service-type
+            pam-limits-service
 
             %base-services))
 
@@ -924,6 +927,46 @@ (define* (syslog-service #:key (config-file %default-syslog.conf))
 information on the configuration file syntax."
   (service syslog-service-type config-file))
 
+(define pam-limits-service-type
+  (let ((security-limits
+         ;; Create /etc/security containing the provided "limits.conf" file.
+         (lambda (limits-file)
+           `(("security"
+              ,(computed-file
+                "security"
+                #~(begin
+                    (mkdir #$output)
+                    (stat #$limits-file)
+                    (symlink #$limits-file
+                             (string-append #$output "/limits.conf"))))))))
+        (pam-extension
+         (lambda (pam)
+           (let ((pam-limits (pam-entry
+                              (control "required")
+                              (module "pam_limits.so")
+                              (arguments '("conf=/etc/security/limits.conf")))))
+             (if (member (pam-service-name pam)
+                         '("login" "su" "slim"))
+                 (pam-service
+                  (inherit pam)
+                  (session (cons pam-limits
+                                 (pam-service-session pam))))
+                 pam)))))
+    (service-type
+     (name 'limits)
+     (extensions
+      (list (service-extension etc-service-type security-limits)
+            (service-extension pam-root-service-type
+                               (lambda _ (list pam-extension))))))))
+
+(define* (pam-limits-service #:optional (limits '()))
+  "Return a service that makes selected programs respect the list of
+pam-limits-entry specified in LIMITS via pam_limits.so."
+  (service pam-limits-service-type
+           (plain-file "limits.conf"
+                       (string-join (map pam-limits-entry->string limits)
+                                    "\n"))))
+
 
 ;;;
 ;;; Guix services.
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 @@ (define-module (gnu system pam)
   #: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 @@ (define-module (gnu system pam)
             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 @@ (module     pam-entry-module)          ; file name
   (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."
-- 
cgit v1.2.3