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.
---
 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 +++++------
 6 files changed, 228 insertions(+), 233 deletions(-)

(limited to 'gnu/system')

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 @@ under /root/.guix-profile where GUIX is installed."
                                 (manifest
                                  (list (package->manifest-entry guix))))))
     (define build
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build install))
-
-          (define %root "root")
-
-          (setenv "PATH"
-                  (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
-
-          ;; Note: there is not much to gain here with deduplication and there
-          ;; is the overhead of the '.links' directory, so turn it off.
-          (populate-single-profile-directory %root
-                                             #:profile #$profile
-                                             #:closure "profile"
-                                             #:deduplicate? #f)
-
-          ;; Create the tarball.  Use GNU format so there's no file name
-          ;; length limitation.
-          (with-directory-excursion %root
-            (zero? (system* "tar" "--xz" "--format=gnu"
-
-                            ;; Avoid non-determinism in the archive.  Use
-                            ;; mtime = 1, not zero, because that is what the
-                            ;; daemon does for files in the store (see the
-                            ;; 'mtimeStore' constant in local-store.cc.)
-                            "--sort=name"
-                            "--mtime=@1"          ;for files in /var/guix
-                            "--owner=root:0"
-                            "--group=root:0"
-
-                            "--check-links"
-                            "-cvf" #$output
-                            ;; Avoid adding / and /var to the tarball,
-                            ;; so that the ownership and permissions of those
-                            ;; directories will not be overwritten when
-                            ;; extracting the archive.  Do not include /root
-                            ;; because the root account might have a different
-                            ;; home directory.
-                            "./var/guix"
-                            (string-append "." (%store-directory)))))))
+      (with-imported-modules '((guix build utils)
+                               (guix build store-copy)
+                               (gnu build install))
+        #~(begin
+            (use-modules (guix build utils)
+                         (gnu build install))
+
+            (define %root "root")
+
+            (setenv "PATH"
+                    (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
+
+            ;; Note: there is not much to gain here with deduplication and
+            ;; there is the overhead of the '.links' directory, so turn it
+            ;; off.
+            (populate-single-profile-directory %root
+                                               #:profile #$profile
+                                               #:closure "profile"
+                                               #:deduplicate? #f)
+
+            ;; Create the tarball.  Use GNU format so there's no file name
+            ;; length limitation.
+            (with-directory-excursion %root
+              (zero? (system* "tar" "--xz" "--format=gnu"
+
+                              ;; Avoid non-determinism in the archive.  Use
+                              ;; mtime = 1, not zero, because that is what the
+                              ;; daemon does for files in the store (see the
+                              ;; 'mtimeStore' constant in local-store.cc.)
+                              "--sort=name"
+                              "--mtime=@1"        ;for files in /var/guix
+                              "--owner=root:0"
+                              "--group=root:0"
+
+                              "--check-links"
+                              "-cvf" #$output
+                              ;; Avoid adding / and /var to the tarball, so
+                              ;; that the ownership and permissions of those
+                              ;; directories will not be overwritten when
+                              ;; extracting the archive.  Do not include /root
+                              ;; because the root account might have a
+                              ;; different home directory.
+                              "./var/guix"
+                              (string-append "." (%store-directory))))))))
 
     (gexp->derivation "guix-tarball.tar.xz" build
-                      #:references-graphs `(("profile" ,profile))
-                      #:modules '((guix build utils)
-                                  (guix build store-copy)
-                                  (gnu build install)))))
+                      #:references-graphs `(("profile" ,profile)))))
 
 
 (define (log-to-info)
@@ -212,20 +213,20 @@ the user's target storage device rather than on the RAM disk."
 
   (define directory
     (computed-file "configuration-templates"
-                   #~(begin
-                       (mkdir #$output)
-                       (for-each (lambda (file target)
-                                   (copy-file file
-                                              (string-append #$output "/"
-                                                             target)))
-                                 '(#$(file "bare-bones.tmpl")
-                                   #$(file "desktop.tmpl")
-                                   #$(file "lightweight-desktop.tmpl"))
-                                 '("bare-bones.scm"
-                                   "desktop.scm"
-                                   "lightweight-desktop.scm"))
-                       #t)
-                   #:modules '((guix build utils))))
+                   (with-imported-modules '((guix build utils))
+                     #~(begin
+                         (mkdir #$output)
+                         (for-each (lambda (file target)
+                                     (copy-file file
+                                                (string-append #$output "/"
+                                                               target)))
+                                   '(#$(file "bare-bones.tmpl")
+                                     #$(file "desktop.tmpl")
+                                     #$(file "lightweight-desktop.tmpl"))
+                                   '("bare-bones.scm"
+                                     "desktop.scm"
+                                     "lightweight-desktop.scm"))
+                         #t))))
 
   `(("configuration" ,directory)))
 
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 @@ that will be shared with the host system."
                                   #:container? #t)))
 
       (define script
-        #~(begin
-            (use-modules (gnu build linux-container)
-                         (guix build utils))
+        (with-imported-modules '((guix config)
+                                 (guix utils)
+                                 (guix 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 @@
                              (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 @@ loaded at boot time in the order in which they appear."
   (mlet %store-monad ((kodir (flat-linux-module-directory linux
                                                           linux-modules)))
     (expression->initrd
-     #~(begin
-         (use-modules (gnu build linux-boot)
-                      (guix build utils)
-                      (guix build bournish)   ;add the 'bournish' meta-command
-                      (srfi srfi-26)
+     (with-imported-modules '((guix build bournish)
+                              (guix build utils)
+                              (guix build syscalls)
+                              (gnu build linux-boot)
+                              (gnu build linux-modules)
+                              (gnu build file-systems)
+                              (guix elf))
+       #~(begin
+           (use-modules (gnu build linux-boot)
+                        (guix build utils)
+                        (guix build bournish) ;add the 'bournish' meta-command
+                        (srfi srfi-26)
 
-                      ;; FIXME: The following modules are for
-                      ;; LUKS-DEVICE-MAPPING.  We should instead propagate
-                      ;; this info via gexps.
-                      ((gnu build file-systems)
-                       #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                        ;; FIXME: The following modules are for
+                        ;; LUKS-DEVICE-MAPPING.  We should instead propagate
+                        ;; this info via gexps.
+                        ((gnu build file-systems)
+                         #:select (find-partition-by-luks-uuid))
+                        (rnrs bytevectors))
 
-         (with-output-to-port (%make-void-port "w")
-           (lambda ()
-             (set-path-environment-variable "PATH" '("bin" "sbin")
-                                            '#$helper-packages)))
+           (with-output-to-port (%make-void-port "w")
+             (lambda ()
+               (set-path-environment-variable "PATH" '("bin" "sbin")
+                                              '#$helper-packages)))
 
-         (boot-system #:mounts '#$(map file-system->spec file-systems)
-                      #:pre-mount (lambda ()
-                                    (and #$@device-mapping-commands))
-                      #:linux-modules '#$linux-modules
-                      #:linux-module-directory '#$kodir
-                      #:qemu-guest-networking? #$qemu-networking?
-                      #:volatile-root? '#$volatile-root?))
-     #:name "base-initrd"
-     #:modules '((guix build bournish)
-                 (guix build utils)
-                 (guix build syscalls)
-                 (gnu build linux-boot)
-                 (gnu build linux-modules)
-                 (gnu build file-systems)
-                 (guix elf)))))
+           (boot-system #:mounts '#$(map file-system->spec file-systems)
+                        #:pre-mount (lambda ()
+                                      (and #$@device-mapping-commands))
+                        #:linux-modules '#$linux-modules
+                        #:linux-module-directory '#$kodir
+                        #:qemu-guest-networking? #$qemu-networking?
+                        #:volatile-root? '#$volatile-root?)))
+     #:name "base-initrd")))
 
 ;;; linux-initrd.scm ends here
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index f9d713e0cf..3bb9f950a8 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -154,10 +154,10 @@ data format changes between libc versions."
                                                                 #:libc libc))
                                      libcs)))
        (gexp->derivation "locale-multiple-versions"
-                         #~(begin
-                             (use-modules (guix build union))
-                             (union-build #$output (list #$@dirs)))
-                         #:modules '((guix build union))
+                         (with-imported-modules '((guix build union))
+                           #~(begin
+                               (use-modules (guix build union))
+                               (union-build #$output (list #$@dirs))))
                          #:local-build? #t
                          #:substitutable? #f)))))
 
diff --git a/gnu/system/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 @@
     `(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 @@ alias ll='ls -l'\n"))
         (zlogin    (plain-file "zlogin" "\
 # Honor system-wide environment variables
 source /etc/profile\n"))
-        (guile-wm  (computed-file "guile-wm" copy-guile-wm
-                                  #:modules '((guix build utils))))
+        (guile-wm  (computed-file "guile-wm" copy-guile-wm))
         (xdefaults (plain-file "Xdefaults" "\
 XTerm*utf8: always
 XTerm*metaSendsEscape: true\n"))
         (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 @@ set debug-file-directory ~/.guix-profile/lib/debug\n")))
 (define (skeleton-directory skeletons)
   "Return a directory containing SKELETONS, a list of name/derivation tuples."
   (computed-file "skel"
-                 #~(begin
-                     (use-modules (ice-9 match)
-                                  (guix build utils))
-
-                     (mkdir #$output)
-                     (chdir #$output)
-
-                     ;; Note: copy the skeletons instead of symlinking
-                     ;; them like 'file-union' does, because 'useradd'
-                     ;; would just copy the symlinks as is.
-                     (for-each (match-lambda
-                                 ((target source)
-                                  (copy-recursively source target)))
-                               '#$skeletons)
-                     #t)
-                 #:modules '((guix build utils))))
+                 (with-imported-modules '((guix build utils))
+                   #~(begin
+                       (use-modules (ice-9 match)
+                                    (guix build utils))
+
+                       (mkdir #$output)
+                       (chdir #$output)
+
+                       ;; Note: copy the skeletons instead of symlinking
+                       ;; them like 'file-union' does, because 'useradd'
+                       ;; would just copy the symlinks as is.
+                       (for-each (match-lambda
+                                   ((target source)
+                                    (copy-recursively source target)))
+                                 '#$skeletons)
+                       #t))))
 
 (define (assert-valid-users/groups users groups)
   "Raise an error if USERS refer to groups not listed in GROUPS."
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 676e89df98..fc5eaf5706 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -155,34 +155,34 @@ made available under the /xchg CIFS share."
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
-      #~(begin
-          (use-modules (guix build utils)
-                       (gnu build vm))
-
-          (let ((inputs  '#$(list qemu coreutils))
-                (linux   (string-append #$linux "/bzImage"))
-                (initrd  (string-append #$initrd "/initrd"))
-                (loader  #$loader)
-                (graphs  '#$(match references-graphs
-                              (((graph-files . _) ...) graph-files)
-                              (_ #f))))
-
-            (set-path-environment-variable "PATH" '("bin") inputs)
-
-            (load-in-linux-vm loader
-                              #:output #$output
-                              #:linux linux #:initrd initrd
-                              #:memory-size #$memory-size
-                              #:make-disk-image? #$make-disk-image?
-                              #:disk-image-format #$disk-image-format
-                              #:disk-image-size #$disk-image-size
-                              #:references-graphs graphs))))
+      (with-imported-modules 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)))
 
-- 
cgit v1.2.3