1 files changed, 85 insertions, 87 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 484bce71c46..bbaa5c0f893 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,85 +55,81 @@
                             (guile %guile-static-stripped)
                             (gzip gzip)
                             (name "guile-initrd")
-                             (system (%current-system))
+                             (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
@@ -183,6 +180,7 @@ loaded at boot time in the order in which they appear."
      "usb-storage" "uas"                     ;for the installation image etc.
      "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
      "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
+      "nvme"                                     ;for new SSD NVMe devices
      ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
            '("pata_acpi" "pata_atiixp"    ;for ATA controllers
              "isci")                      ;for SAS controllers like Intel C602
@@ -225,38 +223,38 @@ loaded at boot time in the order in which they appear."
  (mlet %store-monad ((kodir (flat-linux-module-directory linux
                                                          linux-modules)))
    (expression->initrd
-     #~(begin
+     (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

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 484bce71c46..bbaa5c0f893 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm
@@ -1,6 +1,7 @@
1	;;; GNU Guix --- Functional package management for GNU	1	;;; GNU Guix --- Functional package management for GNU
2	;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>	2	;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
3	;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>	3	;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
		4	;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
4	;;;	5	;;;
5	;;; This file is part of GNU Guix.	6	;;; This file is part of GNU Guix.
6	;;;	7	;;;
@@ -54,85 +55,81 @@
54	(guile %guile-static-stripped)	55	(guile %guile-static-stripped)
55	(gzip gzip)	56	(gzip gzip)
56	(name "guile-initrd")	57	(name "guile-initrd")
57	(system (%current-system))	58	(system (%current-system)))
58	(modules '()))
59	"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)
60	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
61	the derivations referenced by EXP are automatically copied to the initrd.	61	the derivations referenced by EXP are automatically copied to the initrd."
62
63	MODULES is a list of Guile module names to be embedded in the initrd."
64		62
65	;; General Linux overview in `Documentation/early-userspace/README' and	63	;; General Linux overview in `Documentation/early-userspace/README' and
66	;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.	64	;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
67		65
68	(mlet %store-monad ((init (gexp->script "init" exp	66	(mlet %store-monad ((init (gexp->script "init" exp
69	#:modules modules
70	#:guile guile)))	67	#:guile guile)))
71	(define builder	68	(define builder
72	#~(begin	69	(with-imported-modules '((guix cpio)
73	(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))
74		75
75	(mkdir #$output)	76	(mkdir #$output)
76	(build-initrd (string-append #$output "/initrd")	77	(build-initrd (string-append #$output "/initrd")
77	#:guile #$guile	78	#:guile #$guile
78	#:init #$init	79	#:init #$init
79	;; Copy everything INIT refers to into the initrd.	80	;; Copy everything INIT refers to into the initrd.
80	#:references-graphs '("closure")	81	#:references-graphs '("closure")
81	#:gzip (string-append #$gzip "/bin/gzip"))))	82	#:gzip (string-append #$gzip "/bin/gzip")))))
82		83
83	(gexp->derivation name builder	84	(gexp->derivation name builder
84	#:modules '((guix cpio)	85	#:references-graphs `(("closure" ,init)))))
85	(guix build utils)
86	(guix build store-copy)
87	(gnu build linux-initrd))
88	#:references-graphs `(("closure" ,init)))))
89		86
90	(define (flat-linux-module-directory linux modules)	87	(define (flat-linux-module-directory linux modules)
91	"Return a flat directory containing the Linux kernel modules listed in	88	"Return a flat directory containing the Linux kernel modules listed in
92	MODULES and taken from LINUX."	89	MODULES and taken from LINUX."
93	(define build-exp	90	(define build-exp
94	#~(begin	91	(with-imported-modules '((guix build utils)
95	(use-modules (ice-9 match) (ice-9 regex)	92	(guix elf)
96	(srfi srfi-1)	93	(gnu build linux-modules))
97	(guix build utils)	94	#~(begin
98	(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))
99		99
100	(define (string->regexp str)	100	(define (string->regexp str)
101	;; Return a regexp that matches STR exactly.	101	;; Return a regexp that matches STR exactly.
102	(string-append "^" (regexp-quote str) "$"))	102	(string-append "^" (regexp-quote str) "$"))
103		103
104	(define module-dir	104	(define module-dir
105	(string-append #$linux "/lib/modules"))	105	(string-append #$linux "/lib/modules"))
106		106
107	(define (lookup module)	107	(define (lookup module)
108	(let ((name (ensure-dot-ko module)))	108	(let ((name (ensure-dot-ko module)))
109	(match (find-files module-dir (string->regexp name))	109	(match (find-files module-dir (string->regexp name))
110	((file)	110	((file)
111	file)	111	file)
112	(()	112	(()
113	(error "module not found" name module-dir))	113	(error "module not found" name module-dir))
114	((_ ...)	114	((_ ...)
115	(error "several modules by that name"	115	(error "several modules by that name"
116	name module-dir)))))	116	name module-dir)))))
117		117
118	(define modules	118	(define modules
119	(let ((modules (map lookup '#$modules)))	119	(let ((modules (map lookup '#$modules)))
120	(append modules	120	(append modules
121	(recursive-module-dependencies modules	121	(recursive-module-dependencies modules
122	#:lookup-module lookup))))	122	#:lookup-module lookup))))
123		123
124	(mkdir #$output)	124	(mkdir #$output)
125	(for-each (lambda (module)	125	(for-each (lambda (module)
126	(format #t "copying '~a'...~%" module)	126	(format #t "copying '~a'...~%" module)
127	(copy-file module	127	(copy-file module
128	(string-append #$output "/"	128	(string-append #$output "/"
129	(basename module))))	129	(basename module))))
130	(delete-duplicates modules))))	130	(delete-duplicates modules)))))
131		131
132	(gexp->derivation "linux-modules" build-exp	132	(gexp->derivation "linux-modules" build-exp))
133	#:modules '((guix build utils)
134	(guix elf)
135	(gnu build linux-modules))))
136		133
137	(define* (base-initrd file-systems	134	(define* (base-initrd file-systems
138	#:key	135	#:key
@@ -183,6 +180,7 @@ loaded at boot time in the order in which they appear."
183	"usb-storage" "uas" ;for the installation image etc.	180	"usb-storage" "uas" ;for the installation image etc.
184	"usbhid" "hid-generic" "hid-apple" ;keyboards during early boot	181	"usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
185	"dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions	182	"dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
		183	"nvme" ;for new SSD NVMe devices
186	,@(if (string-match "^(x86_64\|i[3-6]86)-" (%current-system))	184	,@(if (string-match "^(x86_64\|i[3-6]86)-" (%current-system))
187	'("pata_acpi" "pata_atiixp" ;for ATA controllers	185	'("pata_acpi" "pata_atiixp" ;for ATA controllers
188	"isci") ;for SAS controllers like Intel C602	186	"isci") ;for SAS controllers like Intel C602
@@ -225,38 +223,38 @@ loaded at boot time in the order in which they appear."
225	(mlet %store-monad ((kodir (flat-linux-module-directory linux	223	(mlet %store-monad ((kodir (flat-linux-module-directory linux
226	linux-modules)))	224	linux-modules)))
227	(expression->initrd	225	(expression->initrd
228	#~(begin	226	(with-imported-modules '((guix build bournish)
229	(use-modules (gnu build linux-boot)	227	(guix build utils)
230	(guix build utils)	228	(guix build syscalls)
231	(guix build bournish) ;add the 'bournish' meta-command	229	(gnu build linux-boot)
232	(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)
233		238
234	;; FIXME: The following modules are for	239	;; FIXME: The following modules are for
235	;; LUKS-DEVICE-MAPPING. We should instead propagate	240	;; LUKS-DEVICE-MAPPING. We should instead propagate
236	;; this info via gexps.	241	;; this info via gexps.
237	((gnu build file-systems)	242	((gnu build file-systems)
238	#:select (find-partition-by-luks-uuid))	243	#:select (find-partition-by-luks-uuid))
239	(rnrs bytevectors))	244	(rnrs bytevectors))
240		245
241	(with-output-to-port (%make-void-port "w")	246	(with-output-to-port (%make-void-port "w")
242	(lambda ()	247	(lambda ()
243	(set-path-environment-variable "PATH" '("bin" "sbin")	248	(set-path-environment-variable "PATH" '("bin" "sbin")
244	'#$helper-packages)))	249	'#$helper-packages)))
245		250
246	(boot-system #:mounts '#$(map file-system->spec file-systems)	251	(boot-system #:mounts '#$(map file-system->spec file-systems)
247	#:pre-mount (lambda ()	252	#:pre-mount (lambda ()
248	(and #$@device-mapping-commands))	253	(and #$@device-mapping-commands))
249	#:linux-modules '#$linux-modules	254	#:linux-modules '#$linux-modules
250	#:linux-module-directory '#$kodir	255	#:linux-module-directory '#$kodir
251	#:qemu-guest-networking? #$qemu-networking?	256	#:qemu-guest-networking? #$qemu-networking?
252	#:volatile-root? '#$volatile-root?))	257	#:volatile-root? '#$volatile-root?)))
253	#:name "base-initrd"	258	#:name "base-initrd")))
254	#:modules '((guix build bournish)
255	(guix build utils)
256	(guix build syscalls)
257	(gnu build linux-boot)
258	(gnu build linux-modules)
259	(gnu build file-systems)
260	(guix elf)))))
261		259
262	;;; linux-initrd.scm ends here	260	;;; linux-initrd.scm ends here