summaryrefslogtreecommitdiff
path: root/gnu/system/linux-initrd.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/linux-initrd.scm')
-rw-r--r--gnu/system/linux-initrd.scm347
1 files changed, 191 insertions, 156 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 42ca29cb58..b80ff10f1e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -18,19 +18,24 @@
(define-module (gnu system linux-initrd)
#:use-module (guix monads)
+ #:use-module (guix gexp)
#:use-module (guix utils)
#:use-module ((guix store)
#:select (%store-prefix))
+ #:use-module ((guix derivations)
+ #:select (derivation->output-path))
#:use-module (gnu packages cpio)
#:use-module (gnu packages compression)
#:use-module (gnu packages linux)
#:use-module (gnu packages guile)
#:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped))
+ #:use-module (gnu system file-systems)
+ #:use-module (ice-9 match)
#:use-module (ice-9 regex)
+ #:use-module (srfi srfi-1)
#:export (expression->initrd
- qemu-initrd
- gnu-system-initrd))
+ qemu-initrd))
;;; Commentary:
@@ -49,12 +54,14 @@
(name "guile-initrd")
(system (%current-system))
(modules '())
+ (to-copy '())
(linux #f)
(linux-modules '()))
"Return a package that contains a Linux initrd (a gzipped cpio archive)
containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list
-of `.ko' file names to be copied from LINUX into the initrd. MODULES is a
-list of Guile module names to be embedded in the initrd."
+of `.ko' file names to be copied from LINUX into the initrd. TO-COPY is a
+list of additional derivations or packages to copy 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'.
@@ -63,150 +70,157 @@ list of Guile module names to be embedded in the initrd."
;; Return a regexp that matches STR exactly.
(string-append "^" (regexp-quote str) "$"))
- (define builder
- `(begin
- (use-modules (guix build utils)
- (ice-9 pretty-print)
- (ice-9 popen)
- (ice-9 match)
- (ice-9 ftw)
- (srfi srfi-26)
- (system base compile)
- (rnrs bytevectors)
- ((system foreign) #:select (sizeof)))
-
- (let ((guile (assoc-ref %build-inputs "guile"))
- (cpio (string-append (assoc-ref %build-inputs "cpio")
- "/bin/cpio"))
- (gzip (string-append (assoc-ref %build-inputs "gzip")
- "/bin/gzip"))
- (modules (assoc-ref %build-inputs "modules"))
- (gos (assoc-ref %build-inputs "modules/compiled"))
- (scm-dir (string-append "share/guile/" (effective-version)))
- (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
- (effective-version)
- (if (eq? (native-endianness) (endianness little))
- "LE"
- "BE")
- (sizeof '*)
- (effective-version)))
- (out (assoc-ref %outputs "out")))
- (mkdir out)
- (mkdir "contents")
- (with-directory-excursion "contents"
- (copy-recursively guile ".")
- (call-with-output-file "init"
- (lambda (p)
- (format p "#!/bin/guile -ds~%!#~%" guile)
- (pretty-print ',exp p)))
- (chmod "init" #o555)
- (chmod "bin/guile" #o555)
-
- ;; Copy Guile modules.
- (chmod scm-dir #o777)
- (copy-recursively modules scm-dir
- #:follow-symlinks? #t)
- (copy-recursively gos (string-append "lib/guile/"
- (effective-version) "/ccache")
- #:follow-symlinks? #t)
-
- ;; Compile `init'.
- (mkdir-p go-dir)
- (set! %load-path (cons modules %load-path))
- (set! %load-compiled-path (cons gos %load-compiled-path))
- (compile-file "init"
- #:opts %auto-compilation-options
- #:output-file (string-append go-dir "/init.go"))
-
- ;; Copy Linux modules.
- (let* ((linux (assoc-ref %build-inputs "linux"))
- (module-dir (and linux
- (string-append linux "/lib/modules"))))
- (mkdir "modules")
- ,@(map (lambda (module)
- `(match (find-files module-dir
- ,(string->regexp module))
- ((file)
- (format #t "copying '~a'...~%" file)
- (copy-file file (string-append "modules/"
- ,module)))
- (()
- (error "module not found" ,module module-dir))
- ((_ ...)
- (error "several modules by that name"
- ,module module-dir))))
- linux-modules))
-
- ;; Reset the timestamps of all the files that will make it in the
- ;; initrd.
- (for-each (cut utime <> 0 0 0 0)
- (find-files "." ".*"))
-
- (system* cpio "--version")
- (let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
- "-O" (string-append out "/initrd")
- "-H" "newc" "--null")))
- (define print0
- (let ((len (string-length "./")))
- (lambda (file)
- (format pipe "~a\0" (string-drop file len)))))
-
- ;; Note: as per `ramfs-rootfs-initramfs.txt', always add
- ;; directory entries before the files that are inside of it: "The
- ;; Linux kernel cpio extractor won't create files in a directory
- ;; that doesn't exist, so the directory entries must go before
- ;; the files that go in those directories."
- (file-system-fold (const #t)
- (lambda (file stat result) ; leaf
- (print0 file))
- (lambda (dir stat result) ; down
- (unless (string=? dir ".")
- (print0 dir)))
- (const #f) ; up
- (const #f) ; skip
- (const #f)
- #f
- ".")
-
- (and (zero? (close-pipe pipe))
- (with-directory-excursion out
- (and (zero? (system* gzip "--best" "initrd"))
- (rename-file "initrd.gz" "initrd")))))))))
-
- (mlet* %store-monad
- ((source (imported-modules modules))
- (compiled (compiled-modules modules))
- (inputs (lower-inputs
- `(("guile" ,guile)
- ("cpio" ,cpio)
- ("gzip" ,gzip)
- ("modules" ,source)
- ("modules/compiled" ,compiled)
- ,@(if linux
- `(("linux" ,linux))
- '())))))
- (derivation-expression name builder
- #:modules '((guix build utils))
- #:inputs inputs)))
-
-(define* (qemu-initrd #:key
+ (mlet* %store-monad ((source (imported-modules modules))
+ (compiled (compiled-modules modules)))
+ (define builder
+ ;; TODO: Move most of this code to (guix build linux-initrd).
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 pretty-print)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 ftw)
+ (srfi srfi-26)
+ (system base compile)
+ (rnrs bytevectors)
+ ((system foreign) #:select (sizeof)))
+
+ (let ((cpio (string-append #$cpio "/bin/cpio"))
+ (gzip (string-append #$gzip "/bin/gzip"))
+ (modules #$source)
+ (gos #$compiled)
+ (scm-dir (string-append "share/guile/" (effective-version)))
+ (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a"
+ (effective-version)
+ (if (eq? (native-endianness) (endianness little))
+ "LE"
+ "BE")
+ (sizeof '*)
+ (effective-version))))
+ (mkdir #$output)
+ (mkdir "contents")
+ (with-directory-excursion "contents"
+ (copy-recursively #$guile ".")
+ (call-with-output-file "init"
+ (lambda (p)
+ (format p "#!/bin/guile -ds~%!#~%" #$guile)
+ (pretty-print '#$exp p)))
+ (chmod "init" #o555)
+ (chmod "bin/guile" #o555)
+
+ ;; Copy Guile modules.
+ (chmod scm-dir #o777)
+ (copy-recursively modules scm-dir
+ #:follow-symlinks? #t)
+ (copy-recursively gos (string-append "lib/guile/"
+ (effective-version) "/ccache")
+ #:follow-symlinks? #t)
+
+ ;; Compile `init'.
+ (mkdir-p go-dir)
+ (set! %load-path (cons modules %load-path))
+ (set! %load-compiled-path (cons gos %load-compiled-path))
+ (compile-file "init"
+ #:opts %auto-compilation-options
+ #:output-file (string-append go-dir "/init.go"))
+
+ ;; Copy Linux modules.
+ (let* ((linux #$linux)
+ (module-dir (and linux
+ (string-append linux "/lib/modules"))))
+ (mkdir "modules")
+ #$@(map (lambda (module)
+ #~(match (find-files module-dir
+ #$(string->regexp module))
+ ((file)
+ (format #t "copying '~a'...~%" file)
+ (copy-file file (string-append "modules/"
+ #$module)))
+ (()
+ (error "module not found" #$module module-dir))
+ ((_ ...)
+ (error "several modules by that name"
+ #$module module-dir))))
+ linux-modules))
+
+ (let ((store #$(string-append "." (%store-prefix)))
+ (to-copy '#$to-copy))
+ (unless (null? to-copy)
+ (mkdir-p store))
+ ;; XXX: Should we do export-references-graph?
+ (for-each (lambda (input)
+ (let ((target
+ (string-append store "/"
+ (basename input))))
+ (copy-recursively input target)))
+ to-copy))
+
+ ;; Reset the timestamps of all the files that will make it in the
+ ;; initrd.
+ (for-each (cut utime <> 0 0 0 0)
+ (find-files "." ".*"))
+
+ (system* cpio "--version")
+ (let ((pipe (open-pipe* OPEN_WRITE cpio "-o"
+ "-O" (string-append #$output "/initrd")
+ "-H" "newc" "--null")))
+ (define print0
+ (let ((len (string-length "./")))
+ (lambda (file)
+ (format pipe "~a\0" (string-drop file len)))))
+
+ ;; Note: as per `ramfs-rootfs-initramfs.txt', always add
+ ;; directory entries before the files that are inside of it: "The
+ ;; Linux kernel cpio extractor won't create files in a directory
+ ;; that doesn't exist, so the directory entries must go before
+ ;; the files that go in those directories."
+ (file-system-fold (const #t)
+ (lambda (file stat result) ; leaf
+ (print0 file))
+ (lambda (dir stat result) ; down
+ (unless (string=? dir ".")
+ (print0 dir)))
+ (const #f) ; up
+ (const #f) ; skip
+ (const #f)
+ #f
+ ".")
+
+ (and (zero? (close-pipe pipe))
+ (with-directory-excursion #$output
+ (and (zero? (system* gzip "--best" "initrd"))
+ (rename-file "initrd.gz" "initrd")))))))))
+
+ (gexp->derivation name builder
+ #:modules '((guix build utils)))))
+
+(define (file-system->spec fs)
+ "Return a list corresponding to file-system FS that can be passed to the
+initrd code."
+ (match fs
+ (($ <file-system> device mount-point type flags options _ check?)
+ (list device mount-point type flags options check?))))
+
+(define* (qemu-initrd file-systems
+ #:key
guile-modules-in-chroot?
- volatile-root?
- (mounts `((cifs "/store" ,(%store-prefix))
- (cifs "/xchg" "/xchg"))))
+ (qemu-networking? #t)
+ volatile-root?)
"Return a monadic derivation that builds an initrd for use in a QEMU guest
-where the store is shared with the host. MOUNTS is a list of file systems to
-be mounted atop the root file system, where each item has the form:
+where the store is shared with the host. FILE-SYSTEMS is a list of
+file-systems to be mounted by the initrd, possibly in addition to the root
+file system specified on the kernel command line via '--root'.
- (FILE-SYSTEM-TYPE SOURCE TARGET)
+When QEMU-NETWORKING? is true, set up networking with the standard QEMU
+parameters.
+
+When VOLATILE-ROOT? is true, the root file system is writable but any changes
+to it are lost.
When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in
the new root. This is necessary is the file specified as '--load' needs
access to these modules (which is the case if it wants to even just print an
-exception and backtrace!).
-
-When VOLATILE-ROOT? is true, the root file system is writable but any changes
-to it are lost."
+exception and backtrace!)."
(define cifs-modules
;; Modules needed to mount CIFS file systems.
'("md4.ko" "ecb.ko" "cifs.ko"))
@@ -215,35 +229,56 @@ to it are lost."
;; Modules for the 9p paravirtualized file system.
'("9pnet.ko" "9p.ko" "9pnet_virtio.ko"))
+ (define (file-system-type-predicate type)
+ (lambda (fs)
+ (string=? (file-system-type fs) type)))
+
(define linux-modules
;; Modules added to the initrd and loaded from the initrd.
`("virtio.ko" "virtio_ring.ko" "virtio_pci.ko"
"virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko"
- ,@(if (assoc-ref mounts 'cifs)
+ ,@(if (find (file-system-type-predicate "cifs") file-systems)
cifs-modules
'())
- ,@(if (assoc-ref mounts '9p)
+ ,@(if (find (file-system-type-predicate "9p") file-systems)
virtio-9p-modules
+ '())
+ ,@(if volatile-root?
+ '("fuse.ko")
+ '())))
+
+ (define helper-packages
+ ;; Packages to be copied on the initrd.
+ `(,@(if (find (lambda (fs)
+ (string-prefix? "ext" (file-system-type fs)))
+ file-systems)
+ (list e2fsck/static)
+ '())
+ ,@(if volatile-root?
+ (list unionfs-fuse/static)
'())))
(expression->initrd
- `(begin
- (use-modules (guix build linux-initrd))
-
- (boot-system #:mounts ',mounts
- #:linux-modules ',linux-modules
- #:qemu-guest-networking? #t
- #:guile-modules-in-chroot? ',guile-modules-in-chroot?
- #:volatile-root? ',volatile-root?))
+ #~(begin
+ (use-modules (guix build linux-initrd)
+ (guix build utils)
+ (srfi srfi-26))
+
+ (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)
+ #:linux-modules '#$linux-modules
+ #:qemu-guest-networking? #$qemu-networking?
+ #:guile-modules-in-chroot? '#$guile-modules-in-chroot?
+ #:volatile-root? '#$volatile-root?))
#:name "qemu-initrd"
#:modules '((guix build utils)
(guix build linux-initrd))
+ #:to-copy helper-packages
#:linux linux-libre
#:linux-modules linux-modules))
-(define (gnu-system-initrd)
- "Initrd for the GNU system itself, with nothing QEMU-specific."
- (qemu-initrd #:guile-modules-in-chroot? #f
- #:mounts '()))
-
;;; linux-initrd.scm ends here
generated by cgit v1.2.3 (git 2.45.2) at 2024-08-07 02:03:48 +0000