aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-04-28 23:40:24 +0200
committerLudovic Courtès <ludo@gnu.org>2014-04-28 23:41:08 +0200
commitf6a7b21df7b499e8d304cc96fc949ec889e1eb10 (patch)
tree3647f46b807cc1ba719f6490ee803c6fbdb005e2
parent23f6056b5022ae5051491a3ccecd2fea01105087 (diff)
downloadguix-f6a7b21df7b499e8d304cc96fc949ec889e1eb10.tar
guix-f6a7b21df7b499e8d304cc96fc949ec889e1eb10.tar.gz
system: grub: Rewrite using gexps.
* gnu/system/grub.scm (grub-configuration-file): Rewrite using 'gexp->derivation'. * gnu/system.scm (operating-system-derivation): Adjust accordingly.
-rw-r--r--gnu/system.scm15
-rw-r--r--gnu/system/grub.scm53
2 files changed, 31 insertions, 37 deletions
diff --git a/gnu/system.scm b/gnu/system.scm
index b52daf7917..0b2501392d 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -282,26 +282,25 @@ we're running in the final root."
((profile (operating-system-profile os))
(etc (operating-system-etc-directory os))
(services (sequence %store-monad (operating-system-services os)))
- (boot-drv (operating-system-boot-script os))
- (boot -> (derivation->output-path boot-drv))
+ (boot (operating-system-boot-script os))
(kernel -> (operating-system-kernel os))
(initrd (operating-system-initrd os))
- (initrd-file -> (string-append (derivation->output-path initrd)
- "/initrd"))
+ (initrd-file -> #~(string-append #$initrd "/initrd"))
(entries -> (list (menu-entry
(label (string-append
"GNU system with "
(package-full-name kernel)
" (technology preview)"))
(linux kernel)
- (linux-arguments `("--root=/dev/sda1"
- ,(string-append "--load=" boot)))
+ (linux-arguments
+ (list "--root=/dev/sda1"
+ #~(string-append "--load=" #$boot)))
(initrd initrd-file))))
(grub.cfg (grub-configuration-file entries)))
(file-union "system"
- `(("boot" ,#~#$boot-drv)
+ `(("boot" ,#~#$boot)
("kernel" ,#~#$kernel)
- ("initrd" ,#~(string-append #$initrd "/initrd"))
+ ("initrd" ,initrd-file)
("profile" ,#~#$profile)
("grub.cfg" ,#~#$grub.cfg)
("etc" ,#~#$etc)))))
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 5dc0b85ff2..1893672a2a 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -22,6 +22,7 @@
#:use-module (guix derivations)
#:use-module (guix records)
#:use-module (guix monads)
+ #:use-module (guix gexp)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:export (menu-entry
@@ -40,45 +41,39 @@
(label menu-entry-label)
(linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments
- (default '()))
- (initrd menu-entry-initrd)) ; file name of the initrd
+ (default '())) ; list of string-valued gexps
+ (initrd menu-entry-initrd)) ; file name of the initrd as a gexp
(define* (grub-configuration-file entries
#:key (default-entry 1) (timeout 5)
(system (%current-system)))
"Return the GRUB configuration file for ENTRIES, a list of
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
- (define (prologue kernel)
- (format #f "
-set default=~a
-set timeout=~a
-search.file ~a~%"
- default-entry timeout kernel))
-
- (define (bzImage)
- (any (match-lambda
- (($ <menu-entry> _ linux)
- (package-file linux "bzImage"
- #:system system)))
- entries))
-
- (define entry->text
+ (define entry->gexp
(match-lambda
(($ <menu-entry> label linux arguments initrd)
- (mlet %store-monad ((linux (package-file linux "bzImage"
- #:system system)))
- (return (format #f "menuentry ~s {
- linux ~a ~a
+ #~(format port "menuentry ~s {
+ linux ~a/bzImage ~a
initrd ~a
}~%"
- label
- linux (string-join arguments) initrd))))))
+ #$label
+ #$linux (string-join (list #$@arguments))
+ #$initrd))))
+
+ (define builder
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (format port "
+set default=~a
+set timeout=~a
+search.file ~a/bzImage~%"
+ #$default-entry #$timeout
+ #$(any (match-lambda
+ (($ <menu-entry> _ linux)
+ linux))
+ entries))
+ #$@(map entry->gexp entries))))
- (mlet %store-monad ((kernel (bzImage))
- (body (sequence %store-monad
- (map entry->text entries))))
- (text-file "grub.cfg"
- (string-append (prologue kernel)
- (string-concatenate body)))))
+ (gexp->derivation "grub.cfg" builder))
;;; grub.scm ends here