From 6b779207ee627c93fc0dad18ef67c149024fa535 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 21 Jan 2016 22:45:54 +0100 Subject: system: grub: Search root device by label or UUID if possible. Fixes . Reported by Christopher Allan Webber . * gnu/system/grub.scm (eye-candy): Add 'root-fs' parameter. Replace 'search --file' command in the output with whatever 'grub-root-search' returns. (grub-root-search): New procedure. (grub-configuration-file): Add 'store-fs' parameter. Use 'grub-root-search' instead of hard-coded 'search --file' commands. * gnu/system.scm (store-file-system, operating-system-store-file-system): New procedures. (operating-system-grub.cfg): Use it, and adjust call to 'grub-configuration-file'. * tests/system.scm: New file. * Makefile.am (SCM_TESTS): Add it. --- gnu/system.scm | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) (limited to 'gnu/system.scm') diff --git a/gnu/system.scm b/gnu/system.scm index ee0280c069..edcfaf66fe 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -79,6 +79,7 @@ operating-system-locale-libcs operating-system-mapped-devices operating-system-file-systems + operating-system-store-file-system operating-system-activation-script operating-system-derivation @@ -678,12 +679,34 @@ listed in OS. The C library expects to find it under (package-version kernel) " (alpha)")) +(define (store-file-system file-systems) + "Return the file system object among FILE-SYSTEMS that contains the store." + (match (filter (lambda (fs) + (and (file-system-mount? fs) + (not (memq 'bind-mount (file-system-flags fs))) + (string-prefix? (file-system-mount-point fs) + (%store-prefix)))) + file-systems) + ((and candidates (head . tail)) + (reduce (lambda (fs1 fs2) + (if (> (string-length (file-system-mount-point fs1)) + (string-length (file-system-mount-point fs2))) + fs1 + fs2)) + head + candidates)))) + +(define (operating-system-store-file-system os) + "Return the file system that contains the store of OS." + (store-file-system (operating-system-file-systems os))) + (define* (operating-system-grub.cfg os #:optional (old-entries '())) "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the \"old entries\" menu." (mlet* %store-monad ((system (operating-system-derivation os)) (root-fs -> (operating-system-root-file-system os)) + (store-fs -> (operating-system-store-file-system os)) (kernel -> (operating-system-kernel os)) (root-device -> (if (eq? 'uuid (file-system-title root-fs)) (uuid->string (file-system-device root-fs)) @@ -698,7 +721,8 @@ listed in OS. The C library expects to find it under "/boot") (operating-system-kernel-arguments os))) (initrd #~(string-append #$system "/initrd")))))) - (grub-configuration-file (operating-system-bootloader os) entries + (grub-configuration-file (operating-system-bootloader os) + store-fs entries #:old-entries old-entries))) (define (operating-system-parameters-file os) -- cgit v1.2.3