summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/bootloader.scm3
-rw-r--r--gnu/bootloader/extlinux.scm19
-rw-r--r--gnu/bootloader/grub.scm27
-rw-r--r--gnu/system.scm29
4 files changed, 38 insertions, 40 deletions
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index d5fcf30f056..e080b04568b 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -30,6 +30,7 @@
30 menu-entry-linux 30 menu-entry-linux
31 menu-entry-linux-arguments 31 menu-entry-linux-arguments
32 menu-entry-initrd 32 menu-entry-initrd
33 menu-entry-device-mount-point
33 34
34 bootloader 35 bootloader
35 bootloader? 36 bootloader?
@@ -67,6 +68,8 @@
67 (label menu-entry-label) 68 (label menu-entry-label)
68 (device menu-entry-device ; file system uuid, label, or #f 69 (device menu-entry-device ; file system uuid, label, or #f
69 (default #f)) 70 (default #f))
71 (device-mount-point menu-entry-device-mount-point
72 (default #f))
70 (linux menu-entry-linux) 73 (linux menu-entry-linux)
71 (linux-arguments menu-entry-linux-arguments 74 (linux-arguments menu-entry-linux-arguments
72 (default '())) ; list of string-valued gexps 75 (default '())) ; list of string-valued gexps
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 219b058e53e..e5fdeb5801e 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -38,14 +38,13 @@
38corresponding to old generations of the system." 38corresponding to old generations of the system."
39 39
40 (define all-entries 40 (define all-entries
41 (append entries (map menu-entry->boot-parameters 41 (append entries (bootloader-configuration-menu-entries config)))
42 (bootloader-configuration-menu-entries config)))) 42
43 43 (define (menu-entry->gexp entry)
44 (define (boot-parameters->gexp params) 44 (let ((label (menu-entry-label entry))
45 (let ((label (boot-parameters-label params)) 45 (kernel (menu-entry-linux entry))
46 (kernel (boot-parameters-kernel params)) 46 (kernel-arguments (menu-entry-linux-arguments entry))
47 (kernel-arguments (boot-parameters-kernel-arguments params)) 47 (initrd (menu-entry-initrd entry)))
48 (initrd (boot-parameters-initrd params)))
49 #~(format port "LABEL ~a 48 #~(format port "LABEL ~a
50 MENU LABEL ~a 49 MENU LABEL ~a
51 KERNEL ~a 50 KERNEL ~a
@@ -69,11 +68,11 @@ TIMEOUT ~a~%"
69 (if (> timeout 0) 1 0) 68 (if (> timeout 0) 1 0)
70 ;; timeout is expressed in 1/10s of seconds. 69 ;; timeout is expressed in 1/10s of seconds.
71 (* 10 timeout)) 70 (* 10 timeout))
72 #$@(map boot-parameters->gexp all-entries) 71 #$@(map menu-entry->gexp all-entries)
73 72
74 #$@(if (pair? old-entries) 73 #$@(if (pair? old-entries)
75 #~((format port "~%") 74 #~((format port "~%")
76 #$@(map boot-parameters->gexp old-entries) 75 #$@(map menu-entry->gexp old-entries)
77 (format port "~%")) 76 (format port "~%"))
78 #~()))))) 77 #~())))))
79 78
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 880491c9832..3a3456ca46b 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -316,16 +316,14 @@ code."
316STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu 316STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
317entries corresponding to old generations of the system." 317entries corresponding to old generations of the system."
318 (define all-entries 318 (define all-entries
319 (append entries (map menu-entry->boot-parameters 319 (append entries (bootloader-configuration-menu-entries config)))
320 (bootloader-configuration-menu-entries config)))) 320 (define (menu-entry->gexp entry)
321 321 (let ((device (menu-entry-device entry))
322 (define (boot-parameters->gexp params) 322 (device-mount-point (menu-entry-device-mount-point entry))
323 (let ((device (boot-parameters-store-device params)) 323 (label (menu-entry-label entry))
324 (device-mount-point (boot-parameters-store-mount-point params)) 324 (kernel (menu-entry-linux entry))
325 (label (boot-parameters-label params)) 325 (arguments (menu-entry-linux-arguments entry))
326 (kernel (boot-parameters-kernel params)) 326 (initrd (menu-entry-initrd entry)))
327 (arguments (boot-parameters-kernel-arguments params))
328 (initrd (boot-parameters-initrd params)))
329 ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point. 327 ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
330 ;; Use the right file names for KERNEL and INITRD in case 328 ;; Use the right file names for KERNEL and INITRD in case
331 ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a 329 ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
@@ -341,11 +339,10 @@ entries corresponding to old generations of the system."
341 #$(grub-root-search device kernel) 339 #$(grub-root-search device kernel)
342 #$kernel (string-join (list #$@arguments)) 340 #$kernel (string-join (list #$@arguments))
343 #$initrd)))) 341 #$initrd))))
344
345 (mlet %store-monad ((sugar (eye-candy config 342 (mlet %store-monad ((sugar (eye-candy config
346 (boot-parameters-store-device 343 (menu-entry-device
347 (first all-entries)) 344 (first all-entries))
348 (boot-parameters-store-mount-point 345 (menu-entry-device-mount-point
349 (first all-entries)) 346 (first all-entries))
350 #:system system 347 #:system system
351 #:port #~port))) 348 #:port #~port)))
@@ -362,12 +359,12 @@ set default=~a
362set timeout=~a~%" 359set timeout=~a~%"
363 #$(bootloader-configuration-default-entry config) 360 #$(bootloader-configuration-default-entry config)
364 #$(bootloader-configuration-timeout config)) 361 #$(bootloader-configuration-timeout config))
365 #$@(map boot-parameters->gexp all-entries) 362 #$@(map menu-entry->gexp all-entries)
366 363
367 #$@(if (pair? old-entries) 364 #$@(if (pair? old-entries)
368 #~((format port " 365 #~((format port "
369submenu \"GNU system, old configurations...\" {~%") 366submenu \"GNU system, old configurations...\" {~%")
370 #$@(map boot-parameters->gexp old-entries) 367 #$@(map menu-entry->gexp old-entries)
371 (format port "}~%")) 368 (format port "}~%"))
372 #~())))) 369 #~()))))
373 370
diff --git a/gnu/system.scm b/gnu/system.scm
index 746c511187e..fdb5be287ea 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -112,7 +112,7 @@
112 boot-parameters-initrd 112 boot-parameters-initrd
113 read-boot-parameters 113 read-boot-parameters
114 read-boot-parameters-file 114 read-boot-parameters-file
115 menu-entry->boot-parameters 115 boot-parameters->menu-entry
116 116
117 local-host-aliases 117 local-host-aliases
118 %setuid-programs 118 %setuid-programs
@@ -301,17 +301,15 @@ The object has its kernel-arguments extended in order to make it bootable."
301 root-device))) 301 root-device)))
302 #f))) 302 #f)))
303 303
304(define (menu-entry->boot-parameters menu-entry) 304(define (boot-parameters->menu-entry conf)
305 "Convert a <menu-entry> instance to a corresponding <boot-parameters>." 305 (menu-entry
306 (boot-parameters 306 (label (boot-parameters-label conf))
307 (label (menu-entry-label menu-entry)) 307 (device (boot-parameters-store-device conf))
308 (root-device #f) 308 (device-mount-point (boot-parameters-store-mount-point conf))
309 (bootloader-name 'custom) 309 (linux (boot-parameters-kernel conf))
310 (store-device #f) 310 (linux-arguments (boot-parameters-kernel-arguments conf))
311 (store-mount-point #f) 311 (initrd (boot-parameters-initrd conf))))
312 (kernel (menu-entry-linux menu-entry)) 312
313 (kernel-arguments (menu-entry-linux-arguments menu-entry))
314 (initrd (menu-entry-initrd menu-entry))))
315 313
316 314
317;;; 315;;;
@@ -866,15 +864,16 @@ listed in OS. The C library expects to find it under
866 (store-file-system (operating-system-file-systems os))) 864 (store-file-system (operating-system-file-systems os)))
867 865
868(define* (operating-system-bootcfg os #:optional (old-entries '())) 866(define* (operating-system-bootcfg os #:optional (old-entries '()))
869 "Return the bootloader configuration file for OS. Use OLD-ENTRIES to 867 "Return the bootloader configuration file for OS. Use OLD-ENTRIES
870populate the \"old entries\" menu." 868(which is a list of <menu-entry>) to populate the \"old entries\" menu."
871 (mlet* %store-monad 869 (mlet* %store-monad
872 ((system (operating-system-derivation os)) 870 ((system (operating-system-derivation os))
873 (root-fs -> (operating-system-root-file-system os)) 871 (root-fs -> (operating-system-root-file-system os))
874 (root-device -> (if (eq? 'uuid (file-system-title root-fs)) 872 (root-device -> (if (eq? 'uuid (file-system-title root-fs))
875 (uuid->string (file-system-device root-fs)) 873 (uuid->string (file-system-device root-fs))
876 (file-system-device root-fs))) 874 (file-system-device root-fs)))
877 (entry (operating-system-boot-parameters os system root-device)) 875 (params (operating-system-boot-parameters os system root-device))
876 (entry -> (boot-parameters->menu-entry params))
878 (bootloader-conf -> (operating-system-bootloader os))) 877 (bootloader-conf -> (operating-system-bootloader os)))
879 ((bootloader-configuration-file-generator 878 ((bootloader-configuration-file-generator
880 (bootloader-configuration-bootloader bootloader-conf)) 879 (bootloader-configuration-bootloader bootloader-conf))