aboutsummaryrefslogtreecommitdiff
path: root/gnu/system.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-01-21 22:45:54 +0100
committerLudovic Courtès <ludo@gnu.org>2016-01-22 00:02:52 +0100
commit6b779207ee627c93fc0dad18ef67c149024fa535 (patch)
tree9a4fa6759add87f0bcd943e72bddae960e749a82 /gnu/system.scm
parent3738d8700ff84e16bfd8609efbd4db6933b414f1 (diff)
downloadguix-6b779207ee627c93fc0dad18ef67c149024fa535.tar
guix-6b779207ee627c93fc0dad18ef67c149024fa535.tar.gz
system: grub: Search root device by label or UUID if possible.
Fixes <http://bugs.gnu.org/22281>. Reported by Christopher Allan Webber <cwebber@dustycloud.org>. * 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.
Diffstat (limited to 'gnu/system.scm')
-rw-r--r--gnu/system.scm26
1 files changed, 25 insertions, 1 deletions
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)