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.
author: Ludovic Courtès <ludo@gnu.org> 2016-07-03 23:11:40 +0200
committer: Ludovic Courtès <ludo@gnu.org> 2016-07-12 22:47:08 +0200
commit: 4ee96a7912eef8c41c855c680f924dcdba2d9c97 (patch)
tree: 3a327f5c28ae0fbfdb135ceb96be8d799422a577 /gnu/system/linux-initrd.scm
parent: 0bb9929eaa3f963ae75478e789723f9e8582116b (diff)
1 files changed, 83 insertions, 87 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 8339fae7eda..bbaa5c0f893 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))
+                             (system (%current-system)))
-                             (modules '()))
  "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.
+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."
  ;; 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
+      (with-imported-modules '((guix cpio)
-          (use-modules (gnu build linux-initrd))
+                               (guix build utils)
+                               (guix build store-copy)
+                               (gnu build linux-initrd))
+        #~(begin
+            (use-modules (gnu build linux-initrd))
-          (mkdir #$output)
+            (mkdir #$output)
-          (build-initrd (string-append #$output "/initrd")
+            (build-initrd (string-append #$output "/initrd")
-                        #:guile #$guile
+                          #:guile #$guile
-                        #:init #$init
+                          #:init #$init
-                        ;; Copy everything INIT refers to into the initrd.
+                          ;; Copy everything INIT refers to into the initrd.
-                        #:references-graphs '("closure")
+                          #:references-graphs '("closure")
-                        #:gzip (string-append #$gzip "/bin/gzip"))))
+                          #:gzip (string-append #$gzip "/bin/gzip")))))
-   (gexp->derivation name builder
+    (gexp->derivation name builder
-                     #:modules '((guix cpio)
+                      #:references-graphs `(("closure" ,init)))))
-                                 (guix build utils)
-                                 (guix build store-copy)
-                                 (gnu build linux-initrd))
-                     #: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
+    (with-imported-modules '((guix build utils)
-        (use-modules (ice-9 match) (ice-9 regex)
+                             (guix elf)
-                     (srfi srfi-1)
+                             (gnu build linux-modules))
-                     (guix build utils)
+      #~(begin
-                     (gnu build linux-modules))
+          (use-modules (ice-9 match) (ice-9 regex)
+                       (srfi srfi-1)
+                       (guix build utils)
+                       (gnu build linux-modules))
-        (define (string->regexp str)
+          (define (string->regexp str)
-          ;; Return a regexp that matches STR exactly.
+            ;; Return a regexp that matches STR exactly.
-          (string-append "^" (regexp-quote str) "$"))
+            (string-append "^" (regexp-quote str) "$"))
-        (define module-dir
+          (define module-dir
-          (string-append #$linux "/lib/modules"))
+            (string-append #$linux "/lib/modules"))
-        (define (lookup module)
+          (define (lookup module)
-          (let ((name (ensure-dot-ko module)))
+            (let ((name (ensure-dot-ko module)))
-            (match (find-files module-dir (string->regexp name))
+              (match (find-files module-dir (string->regexp name))
-              ((file)
+                ((file)
-               file)
+                 file)
-              (()
+                (()
-               (error "module not found" name module-dir))
+                 (error "module not found" name module-dir))
-              ((_ ...)
+                ((_ ...)
-               (error "several modules by that name"
+                 (error "several modules by that name"
-                      name module-dir)))))
+                        name module-dir)))))
-        (define modules
+          (define modules
-          (let ((modules (map lookup '#$modules)))
+            (let ((modules (map lookup '#$modules)))
-            (append modules
+              (append modules
-                    (recursive-module-dependencies modules
+                      (recursive-module-dependencies modules
-                                                   #:lookup-module lookup))))
+                                                     #:lookup-module lookup))))
-        (mkdir #$output)
+          (mkdir #$output)
-        (for-each (lambda (module)
+          (for-each (lambda (module)
-                    (format #t "copying '~a'...~%" module)
+                      (format #t "copying '~a'...~%" module)
-                    (copy-file module
+                      (copy-file module
-                               (string-append #$output "/"
+                                 (string-append #$output "/"
-                                              (basename module))))
+                                                (basename module))))
-                  (delete-duplicates modules))))
+                    (delete-duplicates modules)))))
-  (gexp->derivation "linux-modules" build-exp
+  (gexp->derivation "linux-modules" build-exp))
-                    #:modules '((guix build utils)
-                                (guix elf)
-                                (gnu build linux-modules))))
 (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
+     (with-imported-modules '((guix build bournish)
-         (use-modules (gnu build linux-boot)
+                              (guix build utils)
-                      (guix build utils)
+                              (guix build syscalls)
-                      (guix build bournish)   ;add the 'bournish' meta-command
+                              (gnu build linux-boot)
-                      (srfi srfi-26)
+                              (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
+                        ;; FIXME: The following modules are for
-                      ;; LUKS-DEVICE-MAPPING.  We should instead propagate
+                        ;; LUKS-DEVICE-MAPPING.  We should instead propagate
-                      ;; this info via gexps.
+                        ;; this info via gexps.
-                      ((gnu build file-systems)
+                        ((gnu build file-systems)
-                       #:select (find-partition-by-luks-uuid))
+                         #:select (find-partition-by-luks-uuid))
-                      (rnrs bytevectors))
+                        (rnrs bytevectors))
-         (with-output-to-port (%make-void-port "w")
+           (with-output-to-port (%make-void-port "w")
-           (lambda ()
+             (lambda ()
-             (set-path-environment-variable "PATH" '("bin" "sbin")
+               (set-path-environment-variable "PATH" '("bin" "sbin")
-                                            '#$helper-packages)))
+                                              '#$helper-packages)))
-         (boot-system #:mounts '#$(map file-system->spec file-systems)
+           (boot-system #:mounts '#$(map file-system->spec file-systems)
-                      #:pre-mount (lambda ()
+                        #:pre-mount (lambda ()
-                                    (and #$@device-mapping-commands))
+                                      (and #$@device-mapping-commands))
-                      #:linux-modules '#$linux-modules
+                        #:linux-modules '#$linux-modules
-                      #:linux-module-directory '#$kodir
+                        #:linux-module-directory '#$kodir
-                      #:qemu-guest-networking? #$qemu-networking?
+                        #:qemu-guest-networking? #$qemu-networking?
-                      #:volatile-root? '#$volatile-root?))
+                        #:volatile-root? '#$volatile-root?)))
-     #:name "base-initrd"
+     #: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)))))
 ;;; linux-initrd.scm ends here
author	Ludovic Courtès <ludo@gnu.org>	2016-07-03 23:11:40 +0200
committer	Ludovic Courtès <ludo@gnu.org>	2016-07-12 22:47:08 +0200
commit	4ee96a7912eef8c41c855c680f924dcdba2d9c97 (patch)
tree	3a327f5c28ae0fbfdb135ceb96be8d799422a577 /gnu/system/linux-initrd.scm
parent	0bb9929eaa3f963ae75478e789723f9e8582116b (diff)

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 8339fae7eda..bbaa5c0f893 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm
@@ -55,85 +55,81 @@
55	(guile %guile-static-stripped)	55	(guile %guile-static-stripped)
56	(gzip gzip)	56	(gzip gzip)
57	(name "guile-initrd")	57	(name "guile-initrd")
58	(system (%current-system))	58	(system (%current-system)))
59	(modules '()))
60	"Return a derivation that builds a Linux initrd (a gzipped cpio archive)	59	"Return a derivation that builds a Linux initrd (a gzipped cpio archive)
61	containing GUILE and that evaluates EXP, a G-expression, upon booting. All	60	containing GUILE and that evaluates EXP, a G-expression, upon booting. All
62	the derivations referenced by EXP are automatically copied to the initrd.	61	the derivations referenced by EXP are automatically copied to the initrd."
63
64	MODULES is a list of Guile module names to be embedded in the initrd."
65		62
66	;; General Linux overview in `Documentation/early-userspace/README' and	63	;; General Linux overview in `Documentation/early-userspace/README' and
67	;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.	64	;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
68		65
69	(mlet %store-monad ((init (gexp->script "init" exp	66	(mlet %store-monad ((init (gexp->script "init" exp
70	#:modules modules
71	#:guile guile)))	67	#:guile guile)))
72	(define builder	68	(define builder
73	#~(begin	69	(with-imported-modules '((guix cpio)
74	(use-modules (gnu build linux-initrd))	70	(guix build utils)
		71	(guix build store-copy)
		72	(gnu build linux-initrd))
		73	#~(begin
		74	(use-modules (gnu build linux-initrd))
75		75
76	(mkdir #$output)	76	(mkdir #$output)
77	(build-initrd (string-append #$output "/initrd")	77	(build-initrd (string-append #$output "/initrd")
78	#:guile #$guile	78	#:guile #$guile
79	#:init #$init	79	#:init #$init
80	;; Copy everything INIT refers to into the initrd.	80	;; Copy everything INIT refers to into the initrd.
81	#:references-graphs '("closure")	81	#:references-graphs '("closure")
82	#:gzip (string-append #$gzip "/bin/gzip"))))	82	#:gzip (string-append #$gzip "/bin/gzip")))))
83		83
84	(gexp->derivation name builder	84	(gexp->derivation name builder
85	#:modules '((guix cpio)	85	#:references-graphs `(("closure" ,init)))))
86	(guix build utils)
87	(guix build store-copy)
88	(gnu build linux-initrd))
89	#:references-graphs `(("closure" ,init)))))
90		86
91	(define (flat-linux-module-directory linux modules)	87	(define (flat-linux-module-directory linux modules)
92	"Return a flat directory containing the Linux kernel modules listed in	88	"Return a flat directory containing the Linux kernel modules listed in
93	MODULES and taken from LINUX."	89	MODULES and taken from LINUX."
94	(define build-exp	90	(define build-exp
95	#~(begin	91	(with-imported-modules '((guix build utils)
96	(use-modules (ice-9 match) (ice-9 regex)	92	(guix elf)
97	(srfi srfi-1)	93	(gnu build linux-modules))
98	(guix build utils)	94	#~(begin
99	(gnu build linux-modules))	95	(use-modules (ice-9 match) (ice-9 regex)
		96	(srfi srfi-1)
		97	(guix build utils)
		98	(gnu build linux-modules))
100		99
101	(define (string->regexp str)	100	(define (string->regexp str)
102	;; Return a regexp that matches STR exactly.	101	;; Return a regexp that matches STR exactly.
103	(string-append "^" (regexp-quote str) "$"))	102	(string-append "^" (regexp-quote str) "$"))
104		103
105	(define module-dir	104	(define module-dir
106	(string-append #$linux "/lib/modules"))	105	(string-append #$linux "/lib/modules"))
107		106
108	(define (lookup module)	107	(define (lookup module)
109	(let ((name (ensure-dot-ko module)))	108	(let ((name (ensure-dot-ko module)))
110	(match (find-files module-dir (string->regexp name))	109	(match (find-files module-dir (string->regexp name))
111	((file)	110	((file)
112	file)	111	file)
113	(()	112	(()
114	(error "module not found" name module-dir))	113	(error "module not found" name module-dir))
115	((_ ...)	114	((_ ...)
116	(error "several modules by that name"	115	(error "several modules by that name"
117	name module-dir)))))	116	name module-dir)))))
118		117
119	(define modules	118	(define modules
120	(let ((modules (map lookup '#$modules)))	119	(let ((modules (map lookup '#$modules)))
121	(append modules	120	(append modules
122	(recursive-module-dependencies modules	121	(recursive-module-dependencies modules
123	#:lookup-module lookup))))	122	#:lookup-module lookup))))
124		123
125	(mkdir #$output)	124	(mkdir #$output)
126	(for-each (lambda (module)	125	(for-each (lambda (module)
127	(format #t "copying '~a'...~%" module)	126	(format #t "copying '~a'...~%" module)
128	(copy-file module	127	(copy-file module
129	(string-append #$output "/"	128	(string-append #$output "/"
130	(basename module))))	129	(basename module))))
131	(delete-duplicates modules))))	130	(delete-duplicates modules)))))
132		131
133	(gexp->derivation "linux-modules" build-exp	132	(gexp->derivation "linux-modules" build-exp))
134	#:modules '((guix build utils)
135	(guix elf)
136	(gnu build linux-modules))))
137		133
138	(define* (base-initrd file-systems	134	(define* (base-initrd file-systems
139	#:key	135	#:key
@@ -227,38 +223,38 @@ loaded at boot time in the order in which they appear."
227	(mlet %store-monad ((kodir (flat-linux-module-directory linux	223	(mlet %store-monad ((kodir (flat-linux-module-directory linux
228	linux-modules)))	224	linux-modules)))
229	(expression->initrd	225	(expression->initrd
230	#~(begin	226	(with-imported-modules '((guix build bournish)
231	(use-modules (gnu build linux-boot)	227	(guix build utils)
232	(guix build utils)	228	(guix build syscalls)
233	(guix build bournish) ;add the 'bournish' meta-command	229	(gnu build linux-boot)
234	(srfi srfi-26)	230	(gnu build linux-modules)
		231	(gnu build file-systems)
		232	(guix elf))
		233	#~(begin
		234	(use-modules (gnu build linux-boot)
		235	(guix build utils)
		236	(guix build bournish) ;add the 'bournish' meta-command
		237	(srfi srfi-26)
235		238
236	;; FIXME: The following modules are for	239	;; FIXME: The following modules are for
237	;; LUKS-DEVICE-MAPPING. We should instead propagate	240	;; LUKS-DEVICE-MAPPING. We should instead propagate
238	;; this info via gexps.	241	;; this info via gexps.
239	((gnu build file-systems)	242	((gnu build file-systems)
240	#:select (find-partition-by-luks-uuid))	243	#:select (find-partition-by-luks-uuid))
241	(rnrs bytevectors))	244	(rnrs bytevectors))
242		245
243	(with-output-to-port (%make-void-port "w")	246	(with-output-to-port (%make-void-port "w")
244	(lambda ()	247	(lambda ()
245	(set-path-environment-variable "PATH" '("bin" "sbin")	248	(set-path-environment-variable "PATH" '("bin" "sbin")
246	'#$helper-packages)))	249	'#$helper-packages)))
247		250
248	(boot-system #:mounts '#$(map file-system->spec file-systems)	251	(boot-system #:mounts '#$(map file-system->spec file-systems)
249	#:pre-mount (lambda ()	252	#:pre-mount (lambda ()
250	(and #$@device-mapping-commands))	253	(and #$@device-mapping-commands))
251	#:linux-modules '#$linux-modules	254	#:linux-modules '#$linux-modules
252	#:linux-module-directory '#$kodir	255	#:linux-module-directory '#$kodir
253	#:qemu-guest-networking? #$qemu-networking?	256	#:qemu-guest-networking? #$qemu-networking?
254	#:volatile-root? '#$volatile-root?))	257	#:volatile-root? '#$volatile-root?)))
255	#:name "base-initrd"	258	#:name "base-initrd")))
256	#:modules '((guix build bournish)
257	(guix build utils)
258	(guix build syscalls)
259	(gnu build linux-boot)
260	(gnu build linux-modules)
261	(gnu build file-systems)
262	(guix elf)))))
263		259
264	;;; linux-initrd.scm ends here	260	;;; linux-initrd.scm ends here